blob: d37786e5e4ffc4a04db6d781f2893ebb7c3650d3 (
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
|
#lang racket
(require "../../jj-aoc.rkt"
threading
memoize
algorithms
awesome-list)
(define data (port->lines (open-day 14 2021)))
(define (starting-polymer d)
(~> d
first
string->list
(sliding 2 1)))
(define (first-char d)
(first (first (starting-polymer d))))
(define (starting-counts d)
(~> d
first
frequencies
hash->list
make-hash))
(define (starting-pairs d)
(~>> d
(drop _ 2)
(map (λ~> (substring 0 2) string->list))))
(define (new-pairs d)
(~>> d
(drop _ 2)
(map (λ~> (string-replace " -> " "")
string->list
((match-lambda [(list a b c) (list a c b)]) _)
(sliding 2 1)))))
(define (transform d)
(~>> (map list (starting-pairs d) (new-pairs d))
(append*)
(apply hash)))
(define transformation (transform data))
(define/memo (get-count polymer times)
(match times
[0 (for/fold ([counts (hash)])
([pair (in-list polymer)])
(hash-update counts (second pair) add1 0))]
[_ (for*/fold ([counts (hash)])
([pair (in-list polymer)]
[(c n) (in-hash (get-count (hash-ref transformation pair) (sub1 times)))])
(hash-update counts c (λ~> (+ n)) 0))]))
;; part 1
(define (process-polymer d n)
(~> d
starting-polymer
(get-count _ n)
(hash-update _ (first-char d) add1 0)
hash-values
(sort >)
((λ (l) (- (first l) (last l))))))
(process-polymer data 10)
;; part 2
(process-polymer data 40)
|
