summaryrefslogtreecommitdiffstats
path: root/2021/15/code-orig.tl
blob: 1a1b2f93e59a0341696dc3d23eafa7be1dac9888 (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
(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)))