e3dc1e5b762c

GRPH
[view raw] [browse files]
author Steve Losh <steve@stevelosh.com>
date Sat, 03 Nov 2018 16:39:10 -0400
parents 11df545d1a41
children 8de2e6d7c9d9
branches/tags (none)
files .hgignore rosalind.asd src/problems/cons.lisp src/problems/grph.lisp src/utils.lisp

Changes

--- a/.hgignore	Sat Nov 03 14:41:39 2018 -0400
+++ b/.hgignore	Sat Nov 03 16:39:10 2018 -0400
@@ -2,3 +2,4 @@
 
 scratch.lisp
 lisp.prof
+digraph.png
--- a/rosalind.asd	Sat Nov 03 14:41:39 2018 -0400
+++ b/rosalind.asd	Sat Nov 03 16:39:10 2018 -0400
@@ -12,6 +12,7 @@
 
                :1am
                :alexandria
+               :cl-digraph
                :iterate
                :losh
                :str
@@ -38,5 +39,6 @@
                                            (:file "iprb")
                                            (:file "iev")
                                            (:file "fibd")
-                                           (:file "cons")))))))
+                                           (:file "cons")
+                                           (:file "grph")))))))
 
--- a/src/problems/cons.lisp	Sat Nov 03 14:41:39 2018 -0400
+++ b/src/problems/cons.lisp	Sat Nov 03 16:39:10 2018 -0400
@@ -74,12 +74,12 @@
 
     (if-first-time
       (setf length (length dna)
-            result (make-profile-matrix length))
+            result (make-profile-matrix% length))
       (assert (= length (length dna)) ()
         "The ~:R DNA string in the supplied FASTA data has ~D bases (expected ~D)."
         n (length dna) length))
 
-    (pmincf profile-matrix dna)
+    (pmincf result dna)
 
     (finally (return result))))
 
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/problems/grph.lisp	Sat Nov 03 16:39:10 2018 -0400
@@ -0,0 +1,41 @@
+(in-package :rosalind)
+
+(defparameter *input-grph* ">Rosalind_0498
+AAATAAA
+>Rosalind_2391
+AAATTTT
+>Rosalind_2323
+TTTTCCC
+>Rosalind_0442
+AAATCCC
+>Rosalind_5013
+GGGTGGG")
+
+(defparameter *output-grph* "Rosalind_0498 Rosalind_2391
+Rosalind_0498 Rosalind_0442
+Rosalind_2391 Rosalind_2323
+")
+
+
+(define-problem grph (data stream)
+    *input-grph*
+    *output-grph*
+  (let* ((data (read-fasta-into-hash-table data))
+         (graph (digraph:make-digraph
+                  :test #'equal
+                  :initial-vertices (alexandria:hash-table-keys data))))
+    (maphash (lambda (lk lv)
+               (maphash (lambda (rk rv)
+                          (unless (string= lk rk)
+                            (when (strings-overlap-p 3 lv rv)
+                              (digraph:insert-edge graph lk rk))))
+                        data))
+             data)
+    ;; (ql:quickload :cl-digraph.dot)
+    ;; (digraph.dot:draw graph)
+    (with-output-to-string (s)
+      (iterate (for (l . r) :in (digraph:edges graph))
+               (format s "~A ~A~%" l r)))))
+
+
+
--- a/src/utils.lisp	Sat Nov 03 14:41:39 2018 -0400
+++ b/src/utils.lisp	Sat Nov 03 16:39:10 2018 -0400
@@ -53,6 +53,20 @@
   (gathering (alexandria:map-permutations #'gather items)))
 
 
+(defun strings-overlap-p (k left right)
+  "Return whether `left` and `right` overlap (in order) by exactly `k` characters.
+
+    (strings-overlap-p 3 \"abcdef\"
+                            \"defhi\") ; => T
+
+    (strings-overlap-p 2 \"abcdef\"
+                             \"defhi\") ; => NIL
+
+  "
+  (string= left right
+           :start1 (- (length left) k)
+           :end2 k))
+
 (defmacro-driver (FOR var SEED seed THEN then)
   "Bind `var` to `seed` initially, then to `then` on every iteration.
 
@@ -276,6 +290,11 @@
                                                  (values l d)
                                                  (terminate)))))))))
 
+(defun read-fasta-into-hash-table (source)
+  "Return everything in the FASTA `source` as a hash table of labels to data."
+  (iterate (for (label data) :in-fasta source)
+           (collect-hash (label data) :test #'equal)))
+
 
 ;;;; Testing ------------------------------------------------------------------
 (defmacro define-test (problem input output &optional (test 'string=))