blob: af749e2c89285743324ee6a9c9c9df3bc7023eea (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
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
|
