summaryrefslogtreecommitdiffstats
path: root/2021/15/code-orig.tl
diff options
context:
space:
mode:
Diffstat (limited to '2021/15/code-orig.tl')
-rw-r--r--2021/15/code-orig.tl86
1 files changed, 86 insertions, 0 deletions
diff --git a/2021/15/code-orig.tl b/2021/15/code-orig.tl
new file mode 100644
index 0000000..1a1b2f9
--- /dev/null
+++ b/2021/15/code-orig.tl
@@ -0,0 +1,86 @@
+(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 nil)
+ (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)
+ (push n que)))
+ (upd que (remq cur))
+ (set cur.visited t
+ cur (find-min que))))
+ (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)))