# HG changeset patch # User Steve Losh # Date 1576877039 18000 # Node ID 814719fdaa0d3906ec6b1d9853218f23b6abf7fe # Parent ad32169fc54c551478a3e819798c8827bb25f420# Parent f94bcb40467614422884e1d59d167f24153182ec Merge. diff -r f94bcb404676 -r 814719fdaa0d src/problems/dna.lisp --- a/src/problems/dna.lisp Fri Mar 01 15:31:38 2019 -0500 +++ b/src/problems/dna.lisp Fri Dec 20 16:23:59 2019 -0500 @@ -38,4 +38,7 @@ (gethash #\G results 0) (gethash #\T results 0)))) -;; (problem-dna "AT") + +#; Scratch -------------------------------------------------------------------- + +(problem-dna "AT") diff -r f94bcb404676 -r 814719fdaa0d src/problems/rear.lisp --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/problems/rear.lisp Fri Dec 20 16:23:59 2019 -0500 @@ -0,0 +1,66 @@ +(in-package :rosalind) + +(defparameter *input-rear* "1 2 3 4 5 6 7 8 9 10 +3 1 5 2 7 4 9 6 10 8 + +3 10 8 2 5 4 7 1 6 9 +5 2 3 1 7 4 10 8 6 9 + +8 6 7 9 4 1 3 10 2 5 +8 2 7 6 9 1 5 3 10 4 + +3 9 10 4 1 8 6 7 5 2 +2 9 8 5 1 7 3 4 6 10 + +1 2 3 4 5 6 7 8 9 10 +1 2 3 4 5 6 7 8 9 10") + +(defparameter *output-rear* "9 4 5 7 0") + +(defun bounds-list (start end &key (min-length 0)) + "Return a list of all subseq bounds between `start` and `end`." + (iterate outer + (for s :from start :below end) + (iterate (for e :from (+ s min-length) :to end) + (in outer (collect (cons s e)))))) + +(defun nreverse-vector (vector &key start end) + (iterate (for i :from start) + (for j :downfrom (1- end)) + (repeat (floor (- end start) 2)) + (rotatef (aref vector i) + (aref vector j))) + vector) + +(defun reverse-vector (vector &key start end) + (nreverse-vector (copy-seq vector) :start start :end end)) + +(defun reversals (vector &key start end) + (iterate (for (s . e) :in (bounds-list start end :min-length 2)) + (collect (reverse-vector vector :start s :end e)))) + +(defun reversals-required (from to) + (iterate + (with remaining = (make-queue)) ; queue of (score . state) + (initially (enqueue (cons 0 from) remaining)) + (for (n . v) = (dequeue remaining)) + (for start = (mismatch v to)) + (for end = (mismatch v to :from-end t)) + (when (null start) + (return n)) + (incf n) + (dolist (r (reversals v :start start :end end)) + (enqueue (cons n r) remaining)))) + +(define-problem rear (data string) + *input-rear* + *output-rear* + (let ((pairs (-<> data + (str:split (format nil "~2%") <>) + (mapcar (curry #'str:split #\newline) <>) + (mapcar (curry #'mapcar #'read-all-from-string) <>) + (mapcar (curry #'mapcar (rcurry #'coerce 'vector)) <>)))) + (iterate (for (from to) :in pairs) + (collect (time (reversals-required from to)))))) + + diff -r f94bcb404676 -r 814719fdaa0d src/problems/subs.lisp --- a/src/problems/subs.lisp Fri Mar 01 15:31:38 2019 -0500 +++ b/src/problems/subs.lisp Fri Dec 20 16:23:59 2019 -0500 @@ -17,6 +17,3 @@ (collect (1+ pos) :into result) (finally (return (str:join " " result)))))) -;; (problem-subs) -;; (solve subs) - diff -r f94bcb404676 -r 814719fdaa0d src/problems/tree.lisp --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/problems/tree.lisp Fri Dec 20 16:23:59 2019 -0500 @@ -0,0 +1,49 @@ +(in-package :rosalind) + +;; For every edge we add we can link up two previously-unconnected trees. If we +;; have N separate trees, we just need N-1 edges to connect them. So the +;; problem reduces itself down to just counting the distinct subgraphs of the +;; given graph. Some day I really need to add that as a utility function to +;; cl-digraph. + +(defparameter *input-tree* + "10 +1 2 +2 8 +4 10 +5 9 +6 10 +7 9") + +(defparameter *output-tree* + "3") + +(defun subgraph-vertices (graph start) + (gathering (digraph:map-depth-first #'gather graph start))) + +(defun subgraphs (graph) + "Return a list of lists of vertices of the distinct subgraphs of `graph`." + (let ((graph (digraph:copy-digraph graph))) + (iterate + (for (values vertex found) = (digraph:arbitrary-vertex graph)) + (while found) + (for subgraph = (subgraph-vertices graph vertex)) + (collect subgraph) + (map nil (curry #'digraph:remove-vertex graph) subgraph)))) + +(define-problem tree (data stream) + *input-tree* + *output-tree* + (let ((graph (digraph:make-digraph + :initial-vertices (alexandria:iota (read data) :start 1)))) + (iterate + (for line :in-stream data :using #'read-line) + (for (a b) = (read-all-from-string line)) + (digraph:insert-edge graph a b) + (digraph:insert-edge graph b a)) + (1- (length (subgraphs graph))))) + + +#; Scratch -------------------------------------------------------------------- + +(problem-tree) diff -r f94bcb404676 -r 814719fdaa0d src/utils.lisp --- a/src/utils.lisp Fri Mar 01 15:31:38 2019 -0500 +++ b/src/utils.lisp Fri Dec 20 16:23:59 2019 -0500 @@ -405,5 +405,7 @@ (pbcopy (aesthetic-string (funcall problem input))))) (defmacro solve (name) + (assert (symbolp name) () + "Usage: (solve foo)~%foo should not be quoted.") `(solve% ',(symb 'problem- name)))