# HG changeset patch # User Steve Losh # Date 1541277550 14400 # Node ID e3dc1e5b762c9990f364410dc8b15136b0eaf4e2 # Parent 11df545d1a41b6e89b83e4ab951bb5438903a8c9 GRPH diff -r 11df545d1a41 -r e3dc1e5b762c .hgignore --- 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 diff -r 11df545d1a41 -r e3dc1e5b762c rosalind.asd --- 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"))))))) diff -r 11df545d1a41 -r e3dc1e5b762c src/problems/cons.lisp --- 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)))) diff -r 11df545d1a41 -r e3dc1e5b762c src/problems/grph.lisp --- /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))))) + + + diff -r 11df545d1a41 -r e3dc1e5b762c src/utils.lisp --- 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=))