diff options
| -rw-r--r-- | data/08/example3.txt | 10 | ||||
| -rw-r--r-- | day08.lisp | 99 |
2 files changed, 109 insertions, 0 deletions
diff --git a/data/08/example3.txt b/data/08/example3.txt new file mode 100644 index 0000000..5b3fa58 --- /dev/null +++ b/data/08/example3.txt @@ -0,0 +1,10 @@ +LR + +11A = (11B, XXX) +11B = (XXX, 11Z) +11Z = (11B, XXX) +22A = (22B, XXX) +22B = (22C, 22C) +22C = (22Z, 22Z) +22Z = (22B, 22B) +XXX = (XXX, XXX) 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 |