diff options
Diffstat (limited to '2021/19/code.tl')
| -rw-r--r-- | 2021/19/code.tl | 164 |
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)))) |