blob: 0961b6fbdaf97715ea02a8376da2280b928bb9cc (
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
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
|
(ql:quickload '(fiveam uiop trivia arrows))
(defun distance-1 (a b)
(apply #'+
(mapcar (lambda (e1 e2)
(abs (- e1 e2))) a b)))
(defun boundary-conditions (width height)
"The boundary is a wall meaning 0 & (N-1) are never occupied."
(lambda (x y dir)
(list
dir
(cond
((zerop x) (- width 2))
((= x (- width 1)) 1)
(x))
(cond
((zerop y) (- height 2))
((= y (- height 1)) 1)
(y)))))
(defun wall-p (width height)
(lambda (point)
(destructuring-bind (x y) point
(cond
;; not entry - exit
((or (and (= x 1) (zerop y))
(and (= x (- width 2)) (= y (1- height))))
nil)
;; yes wall or out of map
((or (<= x 0) (<= y 0)
(>= x (1- width))
(>= y (1- height))))))))
(fiveam:test boundaries
(let ((bc (boundary-conditions 6 9)))
(fiveam:is (equal (funcall bc 5 3 t) '(1 3 t)))
(fiveam:is (equal (funcall bc 5 8 t) '(1 1 t)))
(fiveam:is (equal (funcall bc 0 8 t) '(4 1 t)))))
(defun data-input (filename)
(let ((lines (uiop:read-file-lines filename)))
(list
(loop for row in lines
and y from 0
nconc (loop for place across row
and x from 0
unless (or (eq #\# place) (eq #\. place))
collect (list (ecase place
(#\> '>)
(#\< '<)
(#\v 'v)
(#\^ '^))
x y)))
(list (length (car lines))
(length lines)))))
(defun evolve (blizzards boundary)
(mapcar
(lambda (blizzard)
(trivia:match blizzard
((list '> x y) (funcall boundary (1+ x) y '>))
((list '< x y) (funcall boundary (1- x) y '<))
((list 'v x y) (funcall boundary x (1+ y) 'v))
((list '^ x y) (funcall boundary x (1- y) '^))))
blizzards))
(defun elf-moves (elf wallp blizzards)
(destructuring-bind (x y) elf
(arrows:-<>
(list (list (1+ x) y)
(list x (1+ y))
(list (1- x) y)
(list x (1- y))
(list x y))
(delete-if wallp <>)
(set-difference <> (mapcar #'cdr blizzards) :test #'equal))))
(defun cutoff-distance (positions goal)
(loop for p in positions
for dist = (distance-1 goal p)
maximize dist into ma
minimize dist into mi
finally (return (values (max (ceiling (+ ma mi) 2)
(* 1.2 mi)
(* 0.8 ma)
30)
mi ma))))
(defun discard-hopeless-positions (positions goal cutoff-distance)
(delete-if (lambda (p) (< cutoff-distance (distance-1 goal p))) positions))
(defun time-step (time-left walkers goal blizzards bc wallp)
(if (or (zerop time-left) (member goal walkers :test #'equal))
(values time-left blizzards)
(let* ((new-blizzards (evolve blizzards bc))
(new-positions (reduce
(lambda (options point)
(union options (elf-moves point wallp new-blizzards)
:test #'equal))
walkers
:initial-value nil))
(shortened-positions (discard-hopeless-positions new-positions goal
(cutoff-distance new-positions goal))))
(time-step (1- time-left)
shortened-positions
goal new-blizzards bc wallp))))
(destructuring-bind (blizzards (width height)) (data-input "input")
(let ((bc (boundary-conditions width height))
(wallp (wall-p width height))
(goal (list (- width 2) (1- height)))
(elf (list 1 0))
(max-time 400))
(multiple-value-bind (time-left-g blizzards) (time-step max-time (list elf) goal blizzards bc wallp)
(multiple-value-bind (time-left-b blizzards) (time-step max-time (list goal) elf blizzards bc wallp)
(multiple-value-bind (time-left-e blizzards) (time-step max-time (list elf) goal blizzards bc wallp)
(list (- max-time time-left-g)
(- max-time time-left-b)
(- max-time time-left-e)))))
)
)
(+ 299 348 252)
(+ 299 323 277)
|
