blob: a3c47f6becba57b2ad08b98277525db65d7fe0c6 (
plain)
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
|
;; 11:45
;;
(ql:quickload '(fiveam arrows cl-heap))
(defun in-bounds (field position)
(destructuring-bind (maxrow maxcol) (array-dimensions field)
(destructuring-bind (row col) position
(and (< -1 row maxrow)
(< -1 col maxcol)))))
(defun advance (row col dir)
(cons dir
(ecase dir
(up (list (1- row) col))
(lf (list row (1- col)))
(dw (list (1+ row) col))
(rt (list row (1+ col))))))
(defun parse-input (filepath)
(let* ((input (uiop:read-file-lines filepath))
(rows (length input)))
(make-array (list rows (length (car input)))
:initial-contents
(mapcar (lambda (line)
(map 'vector (lambda (c)
(logand 15 (char-code c)))
line))
input))))
(defun backtrack (dir)
(ecase dir
(up 'dw)
(rt 'lf)
(dw 'up)
(lf 'rt)))
(defun next-moves (field tried walker turn-condition)
(destructuring-bind (track dir row col) walker
(arrows:->>
(remove dir '(rt dw lf up) :key #'backtrack)
(mapcar (lambda (d)
(let ((nt (if (eq d dir) (1+ track) 0)))
(when (funcall turn-condition d dir (1+ track))
(destructuring-bind (ndir . np) (advance row col d)
(when (in-bounds field np)
(let ((npath (list* nt ndir np)))
(unless (gethash npath tried)
(setf (gethash npath tried) t)
npath))))))))
(delete nil))))
(defun finish-p (field step)
(destructuring-bind (maxrow maxcol) (array-dimensions field)
(destructuring-bind (row col) (cddr step)
(and (= row (1- maxrow))
(= col (1- maxcol))))))
(defun vdequeue (q)
(cl-heap:pop-heap (slot-value q 'cl-heap:heap)))
(defun walk (options known field turn-condition)
(loop for (pcost current) = (vdequeue options)
while current
until (finish-p field current)
do (dolist (next (next-moves field known current turn-condition))
(cl-heap:enqueue options next (+ (apply #'aref field (cddr next)) pcost)))
finally (return pcost)))
(defun part1-turn (d dir track)
(or (not (eq d dir)) (< track 3)))
(defun part2-turn (d dir track)
(or (and (not (eq d dir))
(>= track 4))
(and (eq d dir)
(< track 10))))
(defun solver (filename turn-condition)
(let* ((field (parse-input filename))
(options (make-instance 'cl-heap:priority-queue))
(known (make-hash-table :test #'equal))
(w (list 10 'rest 0 0)))
(cl-heap:enqueue options w 0)
(walk options known field turn-condition)))
(fiveam:test solutions
(fiveam:is (= 102 (solver "eg-in" #'part1-turn)))
(fiveam:is (= 963 (solver "input" #'part1-turn)))
(fiveam:is (= 94 (solver "eg-in" #'part2-turn)))
(fiveam:is (= 1178 (solver "input" #'part2-turn))))
|
