1 files changed, 87 insertions, 0 deletions
diff --git a/2021/15/code.tl b/2021/15/code.tl
new file mode 100644
index 0000000..b541a60
--- /dev/null
+++ b/2021/15/code.tl
@@ -0,0 +1,87 @@
+(defstruct (coord x y) ()
+  x y)
+
+(defstruct (info coo dist) ()
+  coo
+  dist
+  prev
+  visited
+
+  (:method equal (inf) inf.dist))
+
+(defstruct board ()
+  w h a
+  (memo (hash))
+
+  (:postinit (bo)
+    (assert (eql bo.w bo.h)))
+
+  (:method lambda (me coo)
+    [[me.a coo.y] coo.x])
+
+  (:method lambda-set (me coo nv)
+    (set [[me.a coo.y] coo.x] nv)))
+
+(defun read-input (: (name "input"))
+  (flow (file-get-lines name)
+    vec-list
+    (new board
+         h (len @1)
+         w (len (first @1))
+         a (mapcar (opip (mapcar chr-digit) vec-list) @1))))
+
+(defmeth board ensure-info (bo inf coo : dist)
+  (unless (or (minusp coo.x) (minusp coo.y)
+              (>= coo.x bo.w) (>= coo.y bo.h))
+    (placelet ((pl [inf coo]))
+      (or pl (set pl (new (info coo dist)))))))
+
+(defmeth board shortest-path (bo start goal)
+  (let* ((inf (hash))
+         (c 0)
+         (que (tree))
+         (cur bo.(ensure-info inf start [bo start])))
+    (while (and cur (nequal cur.coo goal))
+      (let* ((coo cur.coo)
+             (ne (remove-if [orf null .visited]
+                            (list bo.(ensure-info inf (new (coord coo.x (succ coo.y))))
+                                  bo.(ensure-info inf (new (coord (succ coo.x) coo.y)))
+                                  bo.(ensure-info inf (new (coord coo.x (pred coo.y))))
+                                  bo.(ensure-info inf (new (coord (pred coo.x) coo.y)))))))
+        (each ((n ne))
+          (unless n.dist
+            (set n.dist (+ cur.dist [bo n.coo])
+                 n.prev cur)
+            (tree-insert que n t)))
+        (let ((tn (tree-peek (tree-begin que))))
+          (set cur.visited t
+               cur (key tn))
+          (tree-delete-specific-node que tn))))
+  (for (out (x bo.(ensure-info inf goal))) (x out) ((set x x.prev))
+    (push x.coo out))))
+
+(defmeth board blow-up (bo mag)
+  (unless (eql mag 1)
+    (let ((ow bo.w)
+          (oh bo.h))
+      (set bo.w (* mag ow)
+           bo.h (* mag oh))
+      (vec-set-length bo.a bo.h)
+      (each ((y 0..bo.h))
+        (if [bo.a y]
+          (vec-set-length [bo.a y] bo.w)
+          (set [bo.a y] (vector bo.w)))
+        (each ((x 0..bo.w))
+          (let* ((c (+ (trunc x ow) (trunc y oh)))
+                 (ox (mod x ow))
+                 (oy (mod y oh)))
+            (set [[bo.a y] x]
+                 (flow [[bo.a oy] ox] pred (+ c) (mod @1 9) succ)))))))
+  bo)
+
+(defun solve (: (name :) (mag 1))
+  (let* ((bo (read-input name).(blow-up mag))
+         (start (new (coord 0 0)))
+         (goal (new (coord (pred bo.w) (pred bo.h))))
+         (path bo.(shortest-path start goal)))
+    (cons (sum (cdr path) bo) path)))