blob: 6069859c64990bfb9a9a68e9f87c1b8e288e5775 (
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
|
#lang racket
(require advent-of-code
fancy-app
threading)
(struct posn (x y) #:transparent)
(define initial-map
(for*/hash ([(row y) (in-indexed (in-lines (open-aoc-input (find-session) 2022 23 #:cache #true)))]
[(col x) (in-indexed row)]
#:when (equal? col #\#))
(values (posn x y) #t)))
(define/match (neighbors-in direction p)
[('north (posn x (app sub1 y*))) (list (posn (sub1 x) y*) (posn x y*) (posn (add1 x) y*))]
[('south (posn x (app add1 y*))) (list (posn (sub1 x) y*) (posn x y*) (posn (add1 x) y*))]
[('east (posn (app add1 x*) y)) (list (posn x* (add1 y)) (posn x* y) (posn x* (sub1 y)))]
[('west (posn (app sub1 x*) y)) (list (posn x* (add1 y)) (posn x* y) (posn x* (sub1 y)))])
(define/match (move-to direction p)
[('stay p) p]
[('north (posn x y)) (posn x (sub1 y))]
[('south (posn x y)) (posn x (add1 y))]
[('east (posn x y)) (posn (add1 x) y)]
[('west (posn x y)) (posn (sub1 x) y)])
(define (propose-movements elves dirs)
(for/hash ([(elf _) (in-hash elves)])
(define dir-candidates
(for/list ([dir dirs]
#:do [(define neighbors (neighbors-in dir elf))]
#:unless (ormap (curry hash-has-key? elves) neighbors))
dir))
(define chosen-dir
(match dir-candidates
['() 'stay]
[(== dirs) 'stay]
[(cons dir _) dir]))
(values elf chosen-dir)))
(define (try-proposed-movements elves)
(define moved-elves (make-hash))
(for ([(elf dir) (in-hash elves)])
(hash-update! moved-elves (move-to dir elf) (cons elf _) '()))
(define reconciled-elves (make-hash))
(for ([(posn elves) (in-hash moved-elves)])
(match elves
; if there's only one elf at a coordinate, leave it there
[(list _) (hash-set! reconciled-elves posn #t)]
; if there's many elves at one coordinate, back them up to their previous spot
[many-elves
(for ([elf (in-list many-elves)])
(hash-set! reconciled-elves elf #t))]))
reconciled-elves)
;; part 1
(define (count-empty-spots elves)
(define elf-posns (hash-keys elves))
(match-define (list x-min _ ... x-max) (sort (map posn-x elf-posns) <))
(match-define (list y-min _ ... y-max) (sort (map posn-y elf-posns) <))
(for*/sum ([y (inclusive-range y-min y-max)] [x (inclusive-range x-min x-max)])
(if (hash-has-key? elves (posn x y)) 0 1)))
(for/fold ([elves initial-map] [dirs '(north south west east)] #:result (count-empty-spots elves))
([_rnd (in-range 10)])
(values (~> elves (propose-movements dirs) try-proposed-movements)
(append (cdr dirs) (list (car dirs)))))
;; part 2
(for/fold ([elves initial-map] [dirs '(north south west east)] [rnd 1] #:result rnd)
([_rnd (in-naturals)])
(define elves-proposed (propose-movements elves dirs))
; elves have stopped moving if they all conclude they want to stay put
#:break (~> elves-proposed hash-values remove-duplicates (equal? '(stay)))
(values (try-proposed-movements elves-proposed) (append (cdr dirs) (list (car dirs))) (add1 rnd)))
|