Kazinator's Advent of Code stuff.

1 files changed, 164 insertions, 0 deletions

diff --git a/2021/19/code.tl b/2021/19/code.tl
new file mode 100644
index 0000000..97dd3f3
--- /dev/null
+++ b/2021/19/code.tl
@@ -0,0 +1,164 @@
+(defstruct scanner ()
+  id
+  data
+  rot
+  pref
+  delta
+  nei)
+
+(defun read-input (: (name "input"))
+  (with-stream (s (open-file name))
+    (build
+      (let (scnr)
+        (while-match-case (get-line s)
+          ("")
+          (`@x,@y,@z` (push (vec (toint x) (toint y) (toint z)) scnr.data))
+          (`--- scanner @n ---` (set scnr (new scanner id (toint n))) (add scnr)))))))
+
+(defmacro x (p) ^[,p 0])
+(defmacro y (p) ^[,p 1])
+(defmacro z (p) ^[,p 2])
+
+(defmacro rot-z (p)
+  (with-gensyms (tp)
+    ^(let ((,tp ,p))
+       (vec (- (y ,tp)) (x ,tp) (z ,tp)))))
+
+(defmacro rot-y (p)
+  (with-gensyms (tp)
+    ^(let ((,tp ,p))
+       (vec (z ,tp) (y ,tp) (- (x ,tp))))))
+
+(defmacro rot-x (p)
+  (with-gensyms (tp)
+    ^(let ((,tp ,p))
+       (vec (x ,tp) (- (z ,tp)) (y ,tp)))))
+
+(defmacro psub (p0 p1)
+  (with-gensyms (tp0 tp1)
+    ^(let ((,tp0 ,p0) (,tp1 ,p1))
+       (vec (- (x ,tp0) (x ,tp1))
+            (- (y ,tp0) (y ,tp1))
+            (- (z ,tp0) (z ,tp1))))))
+
+(defmacro padd (p0 p1)
+  (with-gensyms (tp0 tp1)
+    ^(let ((,tp0 ,p0) (,tp1 ,p1))
+       (vec (+ (x ,tp0) (x ,tp1))
+            (+ (y ,tp0) (y ,tp1))
+            (+ (z ,tp0) (z ,tp1))))))
+
+(defmeth scanner gen-rot (sc)
+  (set sc.rot (vec))
+  (dotimes (i 24)
+    (vec-push sc.rot (vec)))
+
+  (each ((rA sc.data))
+    (let* (                        (rB (rot-x rA)) (rC (rot-x rB)) (rD (rot-x rC))
+           (rE (rot-z rA))         (rF (rot-y rE)) (rG (rot-y rF)) (rH (rot-y rG))
+           (rI (rot-z rE))         (rJ (rot-x rI)) (rK (rot-x rJ)) (rL (rot-x rK))
+           (rM (rot-z rI))         (rN (rot-y rM)) (rO (rot-y rN)) (rP (rot-y rO))
+           (rQ (rot-y rA))         (rR (rot-z rQ)) (rS (rot-z rR)) (rT (rot-z rS))
+           (rU (rot-y (rot-y rQ))) (rV (rot-z rU)) (rW (rot-z rV)) (rX (rot-z rW)))
+      (vec-push [sc.rot  0] rA) (vec-push [sc.rot  1] rB)
+      (vec-push [sc.rot  2] rC) (vec-push [sc.rot  3] rD)
+      (vec-push [sc.rot  4] rE) (vec-push [sc.rot  5] rF)
+      (vec-push [sc.rot  6] rG) (vec-push [sc.rot  7] rH)
+      (vec-push [sc.rot  8] rI) (vec-push [sc.rot  9] rJ)
+      (vec-push [sc.rot 10] rK) (vec-push [sc.rot 11] rL)
+      (vec-push [sc.rot 12] rM) (vec-push [sc.rot 13] rN)
+      (vec-push [sc.rot 14] rO) (vec-push [sc.rot 15] rP)
+      (vec-push [sc.rot 16] rQ) (vec-push [sc.rot 17] rR)
+      (vec-push [sc.rot 18] rS) (vec-push [sc.rot 19] rT)
+      (vec-push [sc.rot 20] rU) (vec-push [sc.rot 21] rV)
+      (vec-push [sc.rot 22] rW) (vec-push [sc.rot 23] rX))))
+
+(defun overlap-delta (pvec0 pvec1 amt)
+  (each-prod ((p0 pvec0)
+              (p1 pvec1))
+    (let* ((delta (psub p1 p0))
+           (novl (len (isec pvec0
+                            (mapcar (do psub @1 delta) pvec1)))))
+      (when (>= novl amt)
+        (return delta)))))
+
+(defun overlaps-with (s0 s1 : (amt 12))
+  (for* ((r 0) (r0 [s0.rot (or s0.pref 0)]) (rot1 s1.rot) (n (len rot1)))
+        ((< r n))
+        ((inc r))
+    (whenlet ((delta (overlap-delta r0 [rot1 r] amt)))
+      (return (cons delta r)))))
+
+(defun link-graph (slist)
+  (let ((sf (car slist))
+        (backref)
+        (count 0))
+    (flet ((lnk (s0 s1)
+                (tree-case (overlaps-with s0 s1)
+                  ((delta . r)
+                   (prinl ^(:lap ,s0.id ,s1.id ,r ,delta))
+                   (cond
+                     ((and (neq s0 sf) (null s0.pref))
+                      (push (cons s0 s1) backref))
+                     (t
+                       (set s1.pref r)
+                       (push (list* s1 r delta) s0.nei)))))))
+      (each-match ((@s0 @s1) (comb slist 2))
+        (prinl ^(,(inc count) ,s0.id ,s1.id))
+        (cond
+          ((null s1.pref) (lnk s0 s1))
+          ((null s0.pref) (lnk s1 s0))))
+      (while backref
+        (set count 0)
+        (put-line "backref")
+        (each-match ((@s0 . @s1) (zap backref))
+          (prinl ^(,(inc count) ,s0.id ,s1.id))
+          (cond
+            ((null s1.pref) (lnk s0 s1))
+            ((null s0.pref) (lnk s1 s0))))))
+    (keep-if .nei slist)))
+
+(defun assemble-map (slist)
+  (let ((out (vec)))
+    (labels ((visit (sn r delta)
+               (prinl ^(:visit ,sn.id ,r))
+               (set sn.delta delta)
+               (each ((p [sn.rot r]))
+                 (vec-push out (psub p delta)))
+               (each-match ((@n @nr . @ndelta) sn.nei)
+                 (visit n nr (padd delta ndelta)))))
+      (visit (car slist) 0 #(0 0 0)))
+      (prinl ^(:len out ,(len out)))
+      (uniq out)))
+
+;; answer is 438
+(defun solve-one (: (name :))
+  (flow name
+    read-input
+    (progn (mapdo .(gen-rot) @1) @1)
+    link-graph
+    assemble-map))
+
+(defun manhattan (p)
+  [sum p abs])
+
+(defun max-manhattan-delta (slist)
+  (let ((maxhattan 0))
+    (each-match ((@s0 @s1) (comb slist 2))
+      (prinl  ^(:delta ,s0.id ,s0.delta ,s1.id ,s1.delta))
+      (let ((mhdelta (manhattan (psub s0.delta s1.delta))))
+        (upd maxhattan (max mhdelta))))
+    maxhattan))
+
+;; answer is 11985
+(defun solve-two (: (name :))
+  (flow name
+    read-input
+    (let ((orig @1))
+      (flow orig
+        (progn (mapdo .(gen-rot) @1) @1)
+        link-graph
+        assemble-map)
+      (flow orig
+        (keep-if .delta)
+        max-manhattan-delta))))