ad32169fc54c

TREE
[view raw] [browse files]
author Steve Losh <steve@stevelosh.com>
date Fri, 20 Dec 2019 16:23:36 -0500
parents c26fa4d063ba
children 814719fdaa0d
branches/tags (none)
files rosalind.asd src/problems/dna.lisp src/problems/rear.lisp src/problems/tree.lisp src/utils.lisp

Changes

--- a/rosalind.asd	Wed Sep 18 11:52:27 2019 -0400
+++ b/rosalind.asd	Fri Dec 20 16:23:36 2019 -0500
@@ -24,6 +24,7 @@
                :1am
                :alexandria
                :cl-digraph
+               :cl-digraph.dot
                :cl-ppcre
                :drakma
                :iterate
--- a/src/problems/dna.lisp	Wed Sep 18 11:52:27 2019 -0400
+++ b/src/problems/dna.lisp	Fri Dec 20 16:23:36 2019 -0500
@@ -38,4 +38,7 @@
             (gethash #\G results 0)
             (gethash #\T results 0))))
 
-;; (problem-dna "AT")
+
+#; Scratch --------------------------------------------------------------------
+
+(problem-dna "AT")
--- a/src/problems/rear.lisp	Wed Sep 18 11:52:27 2019 -0400
+++ b/src/problems/rear.lisp	Fri Dec 20 16:23:36 2019 -0500
@@ -60,6 +60,7 @@
                  (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 (reversals-required from to))))
-  )
+    (iterate (for (from to) :in pairs)
+             (collect (time (reversals-required from to))))))
+
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/problems/tree.lisp	Fri Dec 20 16:23:36 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	Wed Sep 18 11:52:27 2019 -0400
+++ b/src/utils.lisp	Fri Dec 20 16:23:36 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)))