-
Notifications
You must be signed in to change notification settings - Fork 0
/
solution.rkt
120 lines (98 loc) · 3.38 KB
/
solution.rkt
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
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
#lang racket
(provide (all-defined-out))
(require qi
(prefix-in list: racket/list))
(define-flow light? (or (eq? 1) (eq? #\#)))
(define-flow dark? (or (eq? 0) (eq? #\.)))
(define (image-map-xs+ys f)
(flow (~> hash-keys sep
(-< (~> (amp car) f)
(~> (amp cdr) f)))))
(define image->xs+ys (image-map-xs+ys (flow (~> (-< min max) in-inclusive-range))))
(define image->ext-xs+ys (image-map-xs+ys (flow (-< min max))))
(define (make-image . rows)
(define image
(for*/hash ([(row y) (in-indexed rows)]
[(col x) (in-indexed (in-string row))])
(values (cons x y) (px->bit col))))
(~> (image) (-< _ image->ext-xs+ys)))
(define-flow string->image+decoder
(~> (string-split "\n\n") sep
(== _
(~> (string-split "\n") sep make-image))))
(define-flow file->image+decoder
(~> file->string string->image+decoder))
(define-flow bits->integer
(~> (amp ~a)
string-append
(string->number 2)))
(define-switch px->bit
[light? 1]
[dark? 0])
(define-switch bit->px
[light? #\#]
[dark? #\.])
(define (display-image image)
(define-values (xs ys) (image->xs+ys image))
(for ([y ys])
(for ([x xs])
(display (bit->px (hash-ref image (cons x y)))))
(newline)))
(define (neighbors p)
(for*/list ([dy (in-range -1 2)]
[dx (in-range -1 2)])
(~> (p) (-< car cdr) (== (+ dx) (+ dy)) cons)))
(define (enhance-p p image decoder bg)
(~>> (p)
neighbors sep
(amp (hash-ref image _ bg))
bits->integer
(string-ref decoder)
px->bit))
(define (pad-image image xm xM ym yM bg)
(define (update-with-pad image x y)
(~> (x y) cons
(hash-set image _ bg)))
(define rectangles
(list (list (inclusive-range (sub1 xm) (add1 xM))
(inclusive-range (sub1 ym) ym))
(list (inclusive-range (sub1 xm) (add1 xM))
(inclusive-range yM (add1 yM)))
(list (inclusive-range (sub1 xm) xm)
(inclusive-range (sub1 ym) (add1 yM)))
(list (inclusive-range xM (add1 xM))
(inclusive-range (sub1 ym) (add1 yM)))))
(for*/fold ([image image])
([rect (in-list rectangles)]
[x (in-list (car rect))]
[y (in-list (cadr rect))])
(update-with-pad image x y)))
(define (enhance-image image xm xM ym yM decoder bg)
(for/hash ([p (in-hash-keys (pad-image image xm xM ym yM bg))])
(~> (p) (-< _ (enhance-p image decoder bg)))))
(define (compute-bg image xm ym decoder)
(hash-ref image (cons xm ym)))
(define (enhance-image-n n decoder image xm xM ym yM)
(define image* (enhance-image image xm xM ym yM decoder 0))
(for/fold ([image image*]
[xm (sub1 xm)]
[xM (add1 xM)]
[ym (sub1 ym)]
[yM (add1 yM)])
([_ (in-range (sub1 n))])
(values (enhance-image image xm xM ym yM decoder (compute-bg image xm ym decoder))
(sub1 xm) (add1 xM)
(sub1 ym) (add1 yM))))
(define-flow count-light
(~>> hash-values (list:count light?)))
(define (count-light-n n)
(flow (~>> (enhance-image-n n) 1> (ε display-image count-light))))
(define part1* (count-light-n 2))
(define-flow part1 (~> file->image+decoder part1*))
(define part2* (count-light-n 50))
(define-flow part2 (~> file->image+decoder part2*))
(module+ main
(command-line
#:args (input)
(displayln (time (part1 input)))
(displayln (time (part2 input)))))