blob: 05709ad4b332deac9b15ccd6605c521c9f7f4bf7 (
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
|
#lang racket
(require advent-of-code
threading
data/heap)
(struct state (p heat-lost previous history))
(struct posn (r c))
(define/match (add _p1 _p2)
[((posn r1 c1) (posn r2 c2)) (posn (+ r1 r2) (+ c1 c2))])
(define deltas (list (posn 0 1) (posn 0 -1) (posn 1 0) (posn -1 0)))
(define input (fetch-aoc-input (find-session) 2023 17 #:cache #true))
(define grid
(for*/hash ([(row r) (in-indexed (in-list (string-split input "\n")))]
[(col c) (in-indexed (in-string row))])
(values (posn r c) (~> col string string->number))))
(define goal-posn (~>> grid hash-keys (argmax (λ (p) (+ (posn-r p) (posn-c p))))))
(define (make-key s)
(cons (state-p s) (same-dir s)))
(define (goal? n s)
(and (equal? goal-posn (state-p s))
(>= (length (same-dir s)) n)))
(define (same-dir s)
(define history (state-history s))
(if (empty? history)
'()
(takef history (λ (n) (equal? n (car history))))))
(define (find-good-neighbors min-dist max-dist s)
(match-define (state p hl prev hist) s)
(define (eliminate-bad-neighbors delta)
(define neighbor (add p delta))
(cond
[(or (equal? neighbor prev) (not (hash-has-key? grid neighbor))) #false]
[else
(define same (same-dir s))
(define l (length same))
(cond
[(= max-dist l) (not (equal? delta (car same)))]
[(= l 0) #true]
[(< l min-dist) (equal? delta (car same))]
[else #t])]))
(define (make-state delta)
(define neighbor (add p delta))
(define new-loss (+ hl (hash-ref grid neighbor)))
(state neighbor new-loss p (cons delta hist)))
(~>> deltas (filter eliminate-bad-neighbors) (map make-state)))
(define (find-path neighbor-fn goal-fn)
(define seen (mutable-set))
(define queue (make-heap (λ (a b) (<= (state-heat-lost a) (state-heat-lost b)))))
(heap-add! queue (state (posn 0 0) 0 'none '()))
(let bfs ()
(define s (heap-min queue))
(heap-remove-min! queue)
(define key (make-key s))
(cond
[(set-member? seen key) (bfs)]
[else
(set-add! seen key)
(define neighbors (neighbor-fn s))
(define final (findf goal-fn neighbors))
(if final
(state-heat-lost final)
(begin
(for ([n (in-list neighbors)])
(heap-add! queue n))
(bfs)))])))
;; part 1
(find-path (curry find-good-neighbors 0 3) (curry goal? 1))
;; part 2
(find-path (curry find-good-neighbors 4 10) (curry goal? 4))
|
