From 439b3f328c7fa55a6d7e1dc3637bbe19a244299a Mon Sep 17 00:00:00 2001
From: Oscar Najera <hi@oscarnajera.com>
Date: Sun, 15 Jan 2023 16:06:29 +0100
Subject: track faces

---
 AoC2022/22/solver.lisp | 125 ++++++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 124 insertions(+), 1 deletion(-)

(limited to 'AoC2022/22/solver.lisp')

diff --git a/AoC2022/22/solver.lisp b/AoC2022/22/solver.lisp
index 431158a..efab725 100644
--- a/AoC2022/22/solver.lisp
+++ b/AoC2022/22/solver.lisp
@@ -1,4 +1,4 @@
-(ql:quickload '(fiveam uiop arrows))
+(ql:quickload '(fiveam uiop arrows trivia))
 
 (defun parse-instructions (str &optional (start 0))
   (multiple-value-bind (action str-pos)
@@ -103,3 +103,126 @@
 (fiveam:test solutions
   (fiveam:is (= 6032 (solver "eg-in")))
   (fiveam:is (= 159034 (solver "input"))))
+
+(defun face-coords (state face-length)
+  (with-slots (x-pos y-pos) state
+    (multiple-value-bind (x-face x-coord)
+        (floor x-pos face-length)
+      (multiple-value-bind (y-face y-coord)
+          (floor y-pos face-length)
+        (list x-face y-face x-coord y-coord)))))
+
+(defun cube-advance (field state face-length)
+  (destructuring-bind (x-face y-face x-coord y-coord) (face-coords state (floor (array-dimension field 0) 3))
+    (let ((new-x (+ x-coord (case direction (< -1) (> 1) (t 0))))
+          (new-y (+ y-coord (case direction (^ -1) (v 1) (t 0))))))
+    (if (and
+         (<= 0 new-x face-length)
+         (<= 0 new-y face-length))
+        (make-state :x-pos (+ new-x (* x-face face-length))
+                    :y-pos (+ new-y (* y-face face-length)) :direction direction))
+
+
+    (with-slots (direction x-pos y-pos) state
+      (floor (+ x-pos
+                (case direction (< -1) (> 1) (t 0)))
+             face-length)
+      (floor (+ y-pos
+                (case direction (^ -1) (v 1) (t 0)))
+             face-lendth)
+      (destructuring-bind (new-x new-y)
+          (case direction
+            (^ -1) (list x-pos (floor (1- y-pos) face-length))
+            (v 1) (list x-pos (floor (1+ y-pos) face-length))
+            (> 1)  (list (floor (1+ x-pos) face-length) y-pos)
+            (< -1)  (list (floor (1- x-pos) face-length) y-pos))
+        (let ((new-state (make-state :x-pos new-x :y-pos new-y :direction direction)))
+          (if (aref field new-y new-x)
+              new-state
+              (cube-advance field new-state)))))))
+
+(values (values 5 6) (values 9 2))
+
+(floor (array-dimension (create-field "eg-in") 0) 3)
+
+(let ((a 5))
+  (trivia:match (list 5 6 2)
+    ((trivia:guard (list 5 op 2)
+                   (= op (1+ a))) 'hu)))
+
+;;; Cube face layout
+;;;   1
+;;; 234
+;;;   56
+;;; face coords
+;;; 1=2 0
+;;; 2=0 1
+;;; 3=1 1
+;;; 4=2 1
+;;; 5=2 2
+;;; 6=3 2
+
+(trivia:match (list x-face y-face direction)
+  ;; Face 1
+  ((list 2 0 '>) (list 3 2 '<)) ;; 1-6
+  ((list 2 0 'v) (list 2 1 'v)) ;; 1-4
+  ((list 2 0 '<) (list 1 1 'v)) ;; 1-3
+  ((list 2 0 '^) (list 0 1 'v)) ;; 1-2
+  ;; Face 2
+  ((list 0 1 '>) (list 1 1 '>)) ;; 2-3
+  ((list 0 1 'v) (list 2 2 '^)) ;; 2-5
+  ((list 0 1 '<) (list 3 2 '^)) ;; 2-6
+  ((list 0 1 '^) (list 2 0 'v)) ;; 2-1
+  ;; Face 3
+  ((list 1 1 '>) (list 2 1 '>)) ;; 3-4
+  ((list 1 1 'v) (list 2 2 '>)) ;; 3-5
+  ((list 1 1 '<) (list 0 1 '<)) ;; 3-2
+  ((list 1 1 '^) (list 2 0 '>)) ;; 3-1
+  ;; Face 4
+  ((list 2 1 '>) (list 3 2 'v)) ;; 4-6
+  ((list 2 1 'v) (list 2 2 'v)) ;; 4-5
+  ((list 2 1 '<) (list 1 1 '<)) ;; 4-3
+  ((list 2 1 '^) (list 2 0 '^)) ;; 4-1
+  ;; Face 5
+  ((list 2 2 '>) (list 3 2 '>)) ;; 5-6
+  ((list 2 2 'v) (list 0 1 '^)) ;; 5-2
+  ((list 2 2 '<) (list 1 1 '^)) ;; 5-3
+  ((list 2 2 '^) (list 2 1 '^)) ;; 5-4
+  ;; Face 6
+  ((list 3 2 '>) (list 2 0 '<)) ;; 6-1
+  ((list 3 2 'v) (list 0 1 '>)) ;; 6-2
+  ((list 3 2 '<) (list 2 2 '<)) ;; 6-5
+  ((list 3 2 '^) (list 2 1 '<)) ;; 6-4
+  )
+
+(trivia:match '(> 5)
+  ((list '> op) 6))
+
+(let ((fl 4))
+  (destructuring-bind (x-face y-face x-coord y-coord) (list 2 0 -1 1)
+    (trivia:match (list x-face y-face x-coord y-coord)
+      ;; Face 1 to its 4 neighbors 6,4,3,2
+      ((trivia:guard
+        (list 2 0 x y) ;; Neighbor 6
+        (= (* 3 fl) x))
+       (make-state :x-pos (1- (* 4 fl)) :y-pos (- (* 3 fl) y 1) :direction '<))
+      ((trivia:guard ;; neighbor 4 is contiguous; no change
+        (list 2 0 x y)
+        (= fl y))
+       (make-state :x-pos (+ x  (* 2 fl)) :y-pos fl :direction 'v))
+      ((list 2 0 -1 y) ;; Neighbor 3
+       (make-state :x-pos (+ y fl) :y-pos fl :direction 'v))
+      ((list 2 0 x -1) ;; neighbor 2
+       (make-state :x-pos (- fl x) :y-pos fl :direction 'v))
+      ;; Face 2 to its 4 neighbors 3,5,6,1
+      ((trivia:guard ;; Neighbor 3 contiguous
+        (list 0 1 x y)
+        (= x fl))
+       (make-state :x-pos fl :y-pos (+ y fl) :direction '>))
+      ((trivia:guard ;; Neighbor 5
+        (list 0 1 x y)
+        (= y (* 2 fl)))
+       (make-state :x-pos (- fl x 1) :y-pos (1- (* 3 fl)) :direction '^))
+
+
+    )))
-- 
cgit v1.2.3