day 12 part 1

12-passage-pathing/code.scm

@@ -0,0 +1,64 @@
+(load "../common.scm")
+
+; splits string into two at first separator character encountered
+; returns #f if there is given separator is not present
+(define (split-string str separator)
+  (let [(len (string-length str))]
+    (let loop [(i 0)]
+      (if (= i len)
+	#f
+	(if (char=? (string-ref str i) separator)
+	  (list (substring str 0 i)
+		(substring str (+ i 1) len))
+	  (loop (+ i 1)))))))
+
+(define (add-edge nodes start end)
+  (hashtable-update! nodes start
+		     (lambda (node)
+		       (if (member end node)
+			 node
+			 (cons end node)))
+		     '()))
+
+(define (make-graph file)
+  (let [(lines (get-lines file))
+	(nodes (make-hashtable string-hash string=? 20))]
+    (for-each
+      (lambda (line)
+	(let [(edge (split-string line #\-))]
+	  (let [(start (car edge))
+		(end (cadr edge))]
+	    (add-edge nodes start end)
+	    (add-edge nodes end start))))
+      lines)
+    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))
+
+(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))))))

12-passage-pathing/input

@@ -0,0 +1,22 @@
+zi-end
+XR-start
+zk-zi
+TS-zk
+zw-vl
+zk-zw
+end-po
+ws-zw
+TS-ws
+po-TS
+po-YH
+po-xk
+zi-ws
+zk-end
+zi-XR
+XR-zk
+vl-TS
+start-zw
+vl-start
+XR-zw
+XR-vl
+XR-ws