From 71e1e965a3228c03e4cd5e4b9a609e301779abcb Mon Sep 17 00:00:00 2001
From: Alexandre Jesus <adbjesus@gmail.com>
Date: Sat, 16 Dec 2023 15:12:35 +0000
Subject: day08

---
 day08.lisp | 99 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 99 insertions(+)
 create mode 100644 day08.lisp

(limited to 'day08.lisp')

diff --git a/day08.lisp b/day08.lisp
new file mode 100644
index 0000000..af749e2
--- /dev/null
+++ b/day08.lisp
@@ -0,0 +1,99 @@
+(defstruct mymap left right)
+
+(defstruct problem instructions maps)
+
+(defun remove-spaces (string)
+  (coerce (loop for c across string
+                if (char/= c #\Space)
+                  collect c) 'string))
+
+(defun parse-mymap (string)
+  (let* ((string (remove-spaces string))
+         (posequal (position #\= string :test #'char=))
+         (poscomma (position #\, string :start (1+ posequal)))
+         (key (subseq string 0 posequal))
+         (left (subseq string (1+ (1+ posequal)) poscomma))
+         (right (subseq string (1+ poscomma) (1- (length string)))))
+    (values key (make-mymap :left left :right right))))
+
+(defun parse-maps (stream)
+  (let ((ht (make-hash-table :test 'equal)))
+    (loop for line = (read-line stream nil)
+          while line
+          if (< 0 (length line))
+            do (multiple-value-bind (key mymap) (parse-mymap line)
+                 (setf (gethash key ht) mymap)))
+    ht))
+
+(defun parse-problem (filespec)
+  (with-open-file (stream filespec)
+    (let* ((instructions (read-line stream) )
+           (maps (parse-maps stream)))
+      (make-problem :instructions instructions :maps maps))))
+
+(defun count-path (problem start end)
+  (let ((instructions (problem-instructions problem))
+        (maps (problem-maps problem)))
+    (labels ((f (&optional (i 0) (current start) (acc 0))
+               (if (equal current end)
+                   acc
+                   (let* ((instruction (aref instructions i))
+                          (currentmap (gethash current maps))
+                          (nxt (if (char= #\L instruction)
+                                   (mymap-left currentmap)
+                                   (mymap-right currentmap))))
+                     (f (mod (1+ i) (array-total-size instructions)) nxt (1+ acc))))))
+      (f))))
+
+(defun solve1 (filespec)
+  (let ((problem (parse-problem filespec)))
+    (count-path problem (subseq "AAA" 0) (subseq "ZZZ" 0))))
+
+(defun ends-with (string char)
+  (char= char (aref string (1- (array-total-size string)))))
+
+(defun find-starts (maps char)
+  (loop for string being each hash-key of maps
+        if (ends-with string char)
+          collect string))
+
+(defun find-possible (maps instructions start endchar)
+  (loop with res = '()
+        and vis = '()
+        and n = (length instructions)
+        for current = start then next
+        for count = 0 then (1+ count)
+        for i = 0 then (mod (1+ i) n)
+        as final = (ends-with current endchar)
+        as instruction = (aref instructions i)
+        as cmap = (gethash current maps)
+        as next = (if (char= instruction #\L) (mymap-left cmap) (mymap-right cmap))
+        as mem = (member (list current i) vis :test #'equal :key #'cdr)
+        if (and final mem)
+          do (push (list (caar mem) (- count (caar mem))) res)
+        if (and final mem (= (length vis) (length res)))
+           return res
+        if (and final (not mem))
+          do (push (list count current i) vis)))
+
+(defun count-multiple-paths (problem startchar endchar)
+  (let* ((instructions (problem-instructions problem))
+         (maps (problem-maps problem))
+         (starts (find-starts maps startchar)))
+    (let ((loops (mapcar (lambda (start) (find-possible maps instructions start endchar))
+                         starts)))
+      (when (every (lambda (l) (and (= 1 (length l)) (= (caar l) (cadar l)))) loops)
+        ;; LCM only makes sense if there is exactly 1 loop for each
+        ;; path and that loop has the same start and period (which is
+        ;; the case for the input)
+        (apply #'lcm (mapcar #'caar loops))))))
+
+(defun solve2 (filespec)
+  (let ((problem (parse-problem filespec)))
+    (count-multiple-paths problem #\A #\Z)))
+
+(print (solve1 "data/08/example.txt"))  ;; 2
+(print (solve1 "data/08/example2.txt")) ;; 6
+(print (solve1 "data/08/input.txt"))    ;; 21883
+(print (solve2 "data/08/example3.txt")) ;; 6 (nil for this code)
+(print (solve2 "data/08/input.txt"))    ;; 12833235391111
-- 
cgit v1.2.3