1 files changed, 70 insertions, 0 deletions
diff --git a/AoC2022/20/solver.lisp b/AoC2022/20/solver.lisp
new file mode 100644
index 0000000..f341a43
--- /dev/null
+++ b/AoC2022/20/solver.lisp
@@ -0,0 +1,70 @@
+(ql:quickload '(fiveam uiop))
+
+(defparameter *msg* #(1 2 -3 3 -2 0 4))
+
+(defun directional-pointers (size)
+  (let ((forward (make-array size))
+        (reverse (make-array size)))
+    (dotimes (i size)
+      (setf (svref forward i) (mod (1+ i) size)
+            (svref reverse i) (mod (1- i) size)))
+    (values forward reverse)))
+
+(defun follow-pointer (pointer index count)
+  (if (zerop count)
+      index
+      (follow-pointer pointer (svref pointer index) (1- count))))
+
+(defun move! (forward reverse element-idx shift)
+  "FORWARD is the leading array, not necessarily forward movement"
+  (let ((next-element (svref forward element-idx))
+        (prev-element (svref reverse element-idx)))
+    ;; remove element from sequence
+    (setf (svref reverse next-element) prev-element)
+    (setf (svref forward prev-element) next-element))
+  (let* ((amount (1+ (mod (1- shift) (1- (length forward)))))
+         (target-index (follow-pointer forward element-idx amount)))
+    (psetf (svref reverse element-idx) target-index
+           (svref reverse (svref forward target-index)) element-idx
+           (svref forward element-idx) (svref forward target-index)
+           (svref forward target-index) element-idx))
+  (values forward reverse))
+
+(defun shuffle! (forward reverse element-idx shift)
+  (cond
+    ((zerop shift))
+    ((plusp shift)
+     (move! forward reverse element-idx shift))
+    ((move! reverse forward element-idx (abs shift))))
+  (values forward reverse))
+
+(defun shuffle-pointers (msg)
+  (multiple-value-bind (forward reverse) (directional-pointers (length msg))
+    (dotimes (element-idx (length msg))
+      ;; (format t "st: ~a f: ~a r: ~a~%" (ordered-series msg forward) forward reverse)
+      (shuffle! forward reverse element-idx (svref msg element-idx)))
+    ;; (format t "st: ~a f: ~a r: ~a~%" (ordered-series msg forward) forward reverse)
+    (values forward reverse)))
+
+(defun ordered-series (msg forward)
+  (let* ((len (length msg))
+         (series (make-array len)))
+    (do ((i (position 0 msg) (svref forward i))
+         (count 0 (1+ count)))
+        ((<= len count) series)
+      (setf (svref series count)
+            (svref msg i)))))
+
+(defun solver (message)
+  (let ((new-array
+          (ordered-series message (shuffle-pointers message))))
+    (+
+     (svref new-array (mod 1000 (length new-array)))
+     (svref new-array (mod 2000 (length new-array)))
+     (svref new-array (mod 3000 (length new-array))))))
+
+
+(fiveam:test solutions
+  (fiveam:is (= 3 (solver *msg*)))
+  (fiveam:is (= 7225 (solver
+                      (map 'vector #'parse-integer (uiop:read-file-lines "input"))))))