X-Git-Url: http://git.jkinsey.net/?p=adventofcode2020.git;a=blobdiff_plain;f=src%2Fday12.lisp;fp=src%2Fday12.lisp;h=0dbfdfcf85db471c3381be10c28f92d462518a93;hp=0000000000000000000000000000000000000000;hb=646650211622736cd7f85f69cdad3a2899cfe153;hpb=955fe99709e9fd567d2a296e8eee7a1c459ea439

diff --git a/src/day12.lisp b/src/day12.lisp
new file mode 100644
index 0000000..0dbfdfc
--- /dev/null
+++ b/src/day12.lisp
@@ -0,0 +1,93 @@
+(asdf:load-system :adventofcode2020)
+(in-package #:adventofcode2020)
+(named-readtables:in-readtable fn-reader)
+
+(defun parse-action (str)
+  (cl-ppcre:register-groups-bind
+    ((λ(char _ 0) action) (#'parse-integer scalar)) ("([NSEWLRF])([0-9]+)" str)
+    (list action scalar)))
+
+(defstruct ship 
+  (heading #\E)
+  (ns-coord 0)
+  (ew-coord 0)
+  (waypoint-ns 1)
+  (waypoint-ew 10))
+
+(defun apply-turn-heading (heading degree)
+  (let ((directions #(#\N #\E #\S #\W))
+        (heading-delta (/ degree 90)))
+    (-<> 
+      (position heading directions)
+      (+ heading-delta)
+      (mod 4)
+      (aref directions <>))))
+
+(defun apply-turn-space (x y degree)
+  (if (= degree 0) (list x y)
+      (destructuring-bind (x y) (apply-turn-space x y (- degree (* (signum degree) 90)))
+        (if (> degree 0)
+            (list y (* -1 x))
+            (list (* -1 y) x)))))
+
+(defun apply-action-ship (ship act-pair)
+  (destructuring-bind (action scalar) act-pair
+    (let ((new-ship (copy-structure ship)))
+      (case action
+        (#\N (setf (ship-ns-coord new-ship) (+ (ship-ns-coord ship) scalar)))
+        (#\S (setf (ship-ns-coord new-ship) (- (ship-ns-coord ship) scalar)))
+        (#\E (setf (ship-ew-coord new-ship) (+ (ship-ew-coord ship) scalar)))
+        (#\W (setf (ship-ew-coord new-ship) (- (ship-ew-coord ship) scalar)))
+        (#\L (setf (ship-heading new-ship) (apply-turn-heading (ship-heading ship) (* -1 scalar))))
+        (#\R (setf (ship-heading new-ship) (apply-turn-heading (ship-heading ship) (* +1 scalar))))
+        (#\F (setf new-ship (apply-action-ship new-ship (list (ship-heading ship) scalar)))))
+      new-ship)))
+
+(defun apply-action-waypoint (ship act-pair)
+  (destructuring-bind (action scalar) act-pair
+    (let ((new-ship (copy-structure ship)))
+      (case action
+        (#\N (setf (ship-waypoint-ns new-ship) (+ (ship-waypoint-ns ship) scalar)))
+        (#\S (setf (ship-waypoint-ns new-ship) (- (ship-waypoint-ns ship) scalar)))
+        (#\E (setf (ship-waypoint-ew new-ship) (+ (ship-waypoint-ew ship) scalar)))
+        (#\W (setf (ship-waypoint-ew new-ship) (- (ship-waypoint-ew ship) scalar)))
+        (#\L (destructuring-bind (x y) (apply-turn-space (ship-waypoint-ew ship) (ship-waypoint-ns ship) (* -1 scalar))
+               (setf (ship-waypoint-ew new-ship) x)
+               (setf (ship-waypoint-ns new-ship) y)))
+        (#\R (destructuring-bind (x y) (apply-turn-space (ship-waypoint-ew ship) (ship-waypoint-ns ship) (* +1 scalar))
+               (setf (ship-waypoint-ew new-ship) x)
+               (setf (ship-waypoint-ns new-ship) y)))
+        (#\F (setf (ship-ns-coord new-ship) (+ (ship-ns-coord ship) (* scalar (ship-waypoint-ns ship))))
+             (setf (ship-ew-coord new-ship) (+ (ship-ew-coord ship) (* scalar (ship-waypoint-ew ship))))))
+      new-ship)))
+
+
+(day 12 input
+  (let ((actions (mapcar #'parse-action (list-from input))))
+    (part1 (let ((final-ship (reduce #'apply-action-ship actions :initial-value (make-ship))))
+             (manhattan-distance (list 0 0) (list (ship-ew-coord final-ship) 
+                                                  (ship-ns-coord final-ship)))))
+    (part2 (let ((final-ship (reduce #'apply-action-waypoint actions :initial-value (make-ship))))
+             (manhattan-distance (list 0 0) (list (ship-ew-coord final-ship) 
+                                                  (ship-ns-coord final-ship)))))))
+
+(def-suite day12)
+(in-suite day12)
+
+(defvar *simple-actions* 
+  '("F10" "N3" "F7" "R90" "F11"))
+
+(test apply-turns-heading
+  (is (equal #\S (apply-turn-heading #\E 90)))
+  (is (equal #\W (apply-turn-heading #\E 180)))
+  (is (equal #\N (apply-turn-heading #\E 270)))
+  (is (equal #\N (apply-turn-heading #\E -90)))
+  (is (equal #\W (apply-turn-heading #\E -180))))
+
+(test apply-actions-ship
+  (is (equalp
+        (make-ship :heading #\S :ns-coord -8 :ew-coord 17)
+        (reduce #'apply-action-ship (mapcar #'parse-action *simple-actions*)
+                :initial-value (make-ship)))))
+
+(run! 'day12)