blob: f3291ae36e85b823be80ab8607e24ce6a46af61c (
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
|
(ql:quickload '(fiveam uiop arrows))
(defun elf-coordinates (filename)
(let ((coord (make-hash-table :test #'equal)))
(with-open-file (input filename)
(loop for line = (read-line input nil nil)
and y from 0
while line
do (loop for point across line
and x from 0
when (eq point #\#)
do (setf (gethash (cons x y) coord) t))))
coord))
(defun bounding-box (elf-coordinates)
(loop for k being the hash-key of elf-coordinates
minimize (car k) into minx
minimize (cdr k) into miny
maximize (car k) into maxx
maximize (cdr k) into maxy
finally (return (list minx miny maxx maxy))))
(defparameter *moves*
(vector (vector (cons -1 -1) (cons 0 -1) (cons 1 -1)) ;; North
(vector (cons -1 1) (cons 0 1) (cons 1 1)) ;; South
(vector (cons -1 -1) (cons -1 0) (cons -1 1)) ;; West
(vector (cons 1 -1) (cons 1 0) (cons 1 1)))) ;; East
(defun draw (elves)
(with-output-to-string (out)
(destructuring-bind (minx miny maxx maxy) (bounding-box elves)
(loop for y from miny to maxy
do (princ #\Newline out)
(loop for x from minx to maxx
do (princ (if (gethash (cons x y) elves)
#\# #\.) out))))))
(defun pair-add (a b)
(cons (+ (car a) (car b))
(+ (cdr a) (cdr b))))
(defun test-move (dir elf others)
(loop for next-dir across dir
never (gethash (pair-add elf next-dir) others)))
(defun all-moves (step elves)
(let ((next-places (make-hash-table :test #'equal)))
(loop for elf being the hash-key of elves
do
(let ((options (loop for dirs below 4
collect (arrows:-> (aref *moves* (mod (+ dirs step) 4))
(test-move elf elves)))))
(unless (or (notany #'null options) ;; all free don't move
(every #'null options)) ;; all blocked don't move
(let ((prop
(arrows:->
(aref *moves* (mod (+ (position t options) step) 4))
(aref 1)
(pair-add elf))))
(setf (gethash prop next-places)
(cons elf (gethash prop next-places)))))))
next-places))
(defun move-elves! (next-places elves)
(loop for target being the hash-key of next-places using (hash-value source)
when (null (cdr source)) ;; no conflicts on target
do (remhash (car source) elves)
(setf (gethash target elves) t)))
(defun empty-ground (elves)
(destructuring-bind (minx miny maxx maxy) (bounding-box elves)
(- (* (1+ (- maxx minx))
(1+ (- maxy miny)))
(hash-table-count elves))))
(defun solver (elves limit)
(loop for step from 0 below limit
for moves = (all-moves step elves)
while (plusp (hash-table-count moves))
do (move-elves! moves elves)
finally (return step)))
(defun part1 (filename)
(let ((elves (elf-coordinates filename)))
(solver elves 10)
(empty-ground elves)))
(fiveam:test solutions
(fiveam:is (= 110 (part1 "eg-in")))
(fiveam:is (= 4052 (part1 "input")))
(fiveam:is (= 20 (1+ (solver (elf-coordinates "eg-in") 1000))))
(fiveam:is (= 978 (1+ (solver (elf-coordinates "input") 1000)))))
|
