]> localhost Git - adventofcode2020.git/blob - src/day12.lisp
3e3b5562dea68ab9f8cb27c73780adcf6dc87cfd
[adventofcode2020.git] / src / day12.lisp
1 (asdf:load-system :adventofcode2020)
2 (in-package #:adventofcode2020)
3 (named-readtables:in-readtable :adventofcode2020)
4
5 (defun parse-action (str)
6 (cl-ppcre:register-groups-bind
7 ((λ(char _ 0) action) (#'parse-integer scalar)) ("([NSEWLRF])([0-9]+)" str)
8 (list action scalar)))
9
10 (defstruct ship
11 (heading #\E)
12 (ns-coord 0)
13 (ew-coord 0)
14 (waypoint-ns 1)
15 (waypoint-ew 10))
16
17 (defun apply-turn-heading (heading degree)
18 (let ((directions #(#\N #\E #\S #\W))
19 (heading-delta (/ degree 90)))
20 (-<>
21 (position heading directions)
22 (+ heading-delta)
23 (mod 4)
24 (aref directions <>))))
25
26 (defun apply-turn-space (x y degree)
27 (if (= degree 0) (list x y)
28 (destructuring-bind (x y) (apply-turn-space x y (- degree (* (signum degree) 90)))
29 (if (> degree 0)
30 (list y (* -1 x))
31 (list (* -1 y) x)))))
32
33 (defun apply-action-ship (ship act-pair)
34 (destructuring-bind (action scalar) act-pair
35 (let ((new-ship (copy-structure ship)))
36 (case action
37 (#\N (setf (ship-ns-coord new-ship) (+ (ship-ns-coord ship) scalar)))
38 (#\S (setf (ship-ns-coord new-ship) (- (ship-ns-coord ship) scalar)))
39 (#\E (setf (ship-ew-coord new-ship) (+ (ship-ew-coord ship) scalar)))
40 (#\W (setf (ship-ew-coord new-ship) (- (ship-ew-coord ship) scalar)))
41 (#\L (setf (ship-heading new-ship) (apply-turn-heading (ship-heading ship) (* -1 scalar))))
42 (#\R (setf (ship-heading new-ship) (apply-turn-heading (ship-heading ship) (* +1 scalar))))
43 (#\F (setf new-ship (apply-action-ship new-ship (list (ship-heading ship) scalar)))))
44 new-ship)))
45
46 (defun apply-action-waypoint (ship act-pair)
47 (destructuring-bind (action scalar) act-pair
48 (let ((new-ship (copy-structure ship)))
49 (case action
50 (#\N (setf (ship-waypoint-ns new-ship) (+ (ship-waypoint-ns ship) scalar)))
51 (#\S (setf (ship-waypoint-ns new-ship) (- (ship-waypoint-ns ship) scalar)))
52 (#\E (setf (ship-waypoint-ew new-ship) (+ (ship-waypoint-ew ship) scalar)))
53 (#\W (setf (ship-waypoint-ew new-ship) (- (ship-waypoint-ew ship) scalar)))
54 (#\L (destructuring-bind (x y) (apply-turn-space (ship-waypoint-ew ship) (ship-waypoint-ns ship) (* -1 scalar))
55 (setf (ship-waypoint-ew new-ship) x)
56 (setf (ship-waypoint-ns new-ship) y)))
57 (#\R (destructuring-bind (x y) (apply-turn-space (ship-waypoint-ew ship) (ship-waypoint-ns ship) (* +1 scalar))
58 (setf (ship-waypoint-ew new-ship) x)
59 (setf (ship-waypoint-ns new-ship) y)))
60 (#\F (setf (ship-ns-coord new-ship) (+ (ship-ns-coord ship) (* scalar (ship-waypoint-ns ship))))
61 (setf (ship-ew-coord new-ship) (+ (ship-ew-coord ship) (* scalar (ship-waypoint-ew ship))))))
62 new-ship)))
63
64
65 (day 12 input
66 (let ((actions (mapcar #'parse-action (list-from input))))
67 (part1 (let ((final-ship (reduce #'apply-action-ship actions :initial-value (make-ship))))
68 (manhattan-distance (list 0 0) (list (ship-ew-coord final-ship)
69 (ship-ns-coord final-ship)))))
70 (part2 (let ((final-ship (reduce #'apply-action-waypoint actions :initial-value (make-ship))))
71 (manhattan-distance (list 0 0) (list (ship-ew-coord final-ship)
72 (ship-ns-coord final-ship)))))))
73
74 (def-suite day12)
75 (in-suite day12)
76
77 (defvar *simple-actions*
78 '("F10" "N3" "F7" "R90" "F11"))
79
80 (test apply-turns-heading
81 (is (equal #\S (apply-turn-heading #\E 90)))
82 (is (equal #\W (apply-turn-heading #\E 180)))
83 (is (equal #\N (apply-turn-heading #\E 270)))
84 (is (equal #\N (apply-turn-heading #\E -90)))
85 (is (equal #\W (apply-turn-heading #\E -180))))
86
87 (test apply-actions-ship
88 (is (equalp
89 (make-ship :heading #\S :ns-coord -8 :ew-coord 17)
90 (reduce #'apply-action-ship (mapcar #'parse-action *simple-actions*)
91 :initial-value (make-ship)))))
92
93 (run! 'day12)