day 12 part 2

12-passage-pathing/code.scm

@@ -1,5 +1,7 @@
 (load "../common.scm")
 
+; graphs in this code are represented by hashtables of node names to list of node names
+
 ; splits string into two at first separator character encountered
 ; returns #f if there is given separator is not present
 (define (split-string str separator)
@@ -12,7 +14,8 @@
 		(substring str (+ i 1) len))
 	  (loop (+ i 1)))))))
 
-(define (add-edge nodes start end)
+; add a directed edge to given graph
+(define (add-edge! nodes start end)
   (hashtable-update! nodes start
 		     (lambda (node)
 		       (if (member end node)
@@ -20,6 +23,7 @@
 			 (cons end node)))
 		     '()))
 
+; build graph from edges defined in a file
 (define (make-graph file)
   (let [(lines (get-lines file))
 	(nodes (make-hashtable string-hash string=? 20))]
@@ -28,37 +32,77 @@
 	(let [(edge (split-string line #\-))]
 	  (let [(start (car edge))
 		(end (cadr edge))]
-	    (add-edge nodes start end)
-	    (add-edge nodes end start))))
+	    (add-edge! nodes start end)
+	    (add-edge! nodes end start))))
       lines)
     nodes))
 
+; big caves are uppercase nodes
 (define (is-big? node)
   (char-upper-case? (string-ref node 0)))
 
-(define (find-paths graph)
-  (let [(paths '())]
-    (let visit [(node "start")
-		(path '())
-		(visited-small '())]
-      (assert (< (length visited-small) 20))
-      (if (string=? node "end")
-	(set! paths (cons (cons node path) paths))
-	(for-each
-	  (lambda (child)
-	    (when (or (is-big? child)
-		      (not (member child visited-small)))
-	      (visit child
-		     (cons node path)
-		     (if (is-big? node)
-		       visited-small
-		       (cons node visited-small)))))
-	  (hashtable-ref graph node '()))))
-    paths))
+; count how many obj there is in lst
+(define (count-members obj lst)
+  (let count [(n 0) (lst lst)]
+    (let [(sub (member obj lst))]
+      (if sub
+	(count (+ n 1) (cdr sub))
+	n))))
+
+; calls visitor for all possible paths in graph
+; with max-small = 1, visits small caves at most once
+; with max-small = 2, visits one small cave at most twice and others at most once
+; with max-small >= 3 or 0, probably garbage
+(define (visit-paths graph max-small visitor)
+  (let visit [(node "start")
+	      (path '())
+	      (max-small max-small)]
+    (if (string=? node "end")
+      (visitor (cons node path))
+      (for-each
+	(lambda (child)
+	  (let [(is-big (is-big? child))]
+	    (when (and (not (string=? child "start"))
+		     (or is-big
+			 (< (count-members child path) max-small)))
+	      (visit child (cons node path)
+		       (if (and (not is-big) (member child path)) 1 max-small)))))
+	(hashtable-ref graph node '())))))
+
+; computes how many possible paths there are in graph
+(define (count-paths graph max-small)
+  (let [(count 0)]
+    (visit-paths graph max-small
+		 (lambda (path)
+		   (set! count (+ 1 count))))
+    count))
+
+; print all possible paths
+(define (print-paths graph max-small)
+  (visit-paths graph max-small
+	       (lambda (path)
+		 (printf "~a~%" (reverse path)))))
+
+;(let [(nodes (make-hashtable string-hash string=? 20))]
+;  (define (add-2! s e)
+;    (add-edge! nodes s e)
+;    (add-edge! nodes e s))
+;  (add-2! "start" "A")
+;  (add-2! "start" "b")
+;  (add-2! "A" "c")
+;  (add-2! "A" "b")
+;  (add-2! "b" "d")
+;  (add-2! "A" "end")
+;  (add-2! "b" "end")
+;  (printf "~a of them at 1 small~%" (count-paths nodes 1))
+;  (printf "~a of them at one 2 small~%" (count-paths nodes 2))
+;  (print-paths nodes 2))
 
 (call-with-input-file
   "input"
   (lambda (file)
     (let [(graph (make-graph file))]
       (printf "part 1:~% ~a paths with at most 1 visit to small caves.~%"
-	      (length (find-paths graph))))))
+		    (count-paths graph 1))
+      (printf "part 2:~% ~a paths with at most 2 visits to small caves.~%"
+		    (count-paths graph 2)))))