blob: b32c60a138f38f36a3e2792573e7d2c986bfcbe5 (
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
|
(define-module (day18)
#:use-module (ice-9 match)
#:use-module (ice-9 q)
#:use-module (ice-9 rdelim)
#:use-module (ice-9 regex)
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-11))
(define +line-regex+ (make-regexp "^([0-9]+),([0-9]+)$"))
(define (read-coord port)
(define line (read-line port))
(if (eof-object? line)
(values #f #f)
(let ((mtch (regexp-exec +line-regex+ line)))
(if mtch
(values (string->number (match:substring mtch 1))
(string->number (match:substring mtch 2)))
(error "Expecting pair of integer coordinates 'a,b'." line)))))
(define* (make-map
#:key (port (current-input-port)) (maze-size 71) (steps 1024))
(define mp (make-typed-array 'b #f maze-size maze-size))
(define (iter left)
(unless (zero? left)
(let-values (((i j) (read-coord port)))
(unless i (error "Insufficient input."))
(array-set! mp #t i j))
(iter (- left 1))))
(iter steps)
mp)
(define-record-type <node> (make-node i j dist) node?
(i node-i)
(j node-j)
(dist node-dist))
(define (solve mp)
(define size (car (array-dimensions mp)))
(define visited (make-typed-array 'b #f size size))
(array-copy! mp visited)
(define q (make-q))
(enq! q (make-node (- size 1) (- size 1) 0))
(define (maybe-add! i j dist)
(when (and (array-in-bounds? mp i j) (not (array-ref visited i j)))
(enq! q (make-node i j dist))
(array-set! visited #t i j)))
(define (add-next! node)
(match-let ((($ <node> i j dist) node))
(for-each (lambda (di dj) (maybe-add! (+ i di) (+ j dj) (+ dist 1)))
'(1 -1 0 0) '(0 0 1 -1))))
(let bfs ()
(if (q-empty? q)
#f ; Not connected
(match-let (((and node ($ <node> i j dist)) (deq! q)))
(if (= 0 i j)
dist
(begin (add-next! node) (bfs)))))))
(define (part1 port)
(solve (make-map #:port port)))
(define* (find-cutter
#:key (port (current-input-port)) (maze-size 71))
(define mp (make-typed-array 'b #f maze-size maze-size))
(let iter ()
(let-values (((i j) (read-coord port)))
(if i
(begin (array-set! mp #t i j)
(if (solve mp) (iter) (cons i j)))
#f))))
(define (part2 port)
(find-cutter #:port port))
|
