blob: b541a604da91180bc0b3e0b823092ece96bc0c46 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
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)))
|
