--- 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")
--- /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))))))
+
+
--- 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)
-
--- /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)
--- 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)))