| 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) |