blob: 6e402c392c57c745bf767a3cd66250ed3b55410e (
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
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
|
(library (lib)
(export solve-part1 solve-part2)
(import (chezscheme))
; Split list at first delimiter into `prefix' and `suffix'
; Return value is a pair like `((p r e f i x) s u f f i x)'
(define (list-split-left delimiter? xs)
(let loop ((prefix '())
(suffix xs))
(if (null? suffix)
(cons prefix suffix)
(let ((x (car suffix)))
(if (delimiter? x)
; Found first delimiter, so return immediately
(cons prefix (cdr suffix))
; `x' isn't a delimiter, so append it to `prefix'
(loop (append prefix (list x)) (cdr suffix)))))))
; Split list at given delimiter into list of sublists
(define (list-split delimiter? xs)
(let loop ((pieces '())
(rest xs))
(if (null? rest)
; Fix order and remove all empty sublists from output
; (which are caused by consecutive delimiters in `xs')
(reverse (remp null? pieces))
; Extract next piece from `rest' and prepend it to `pieces'
(let ((next (list-split-left delimiter? rest)))
(loop (cons (car next) pieces) (cdr next))))))
; Split string at whitespace into list of words
(define (string-split str)
(map list->string (list-split char-whitespace? (string->list str))))
; Evaluate a test of the form: `rval' `test' `rlit'
(define (satisfied? rval test rlit)
(cond
((string=? test "<" ) (< rval rlit))
((string=? test "<=") (<= rval rlit))
((string=? test "==") ( = rval rlit))
((string=? test ">=") (>= rval rlit))
((string=? test ">" ) (> rval rlit))
(else (not (= rval rlit)))))
; To copy the register state list from one cycle to the next, the usual
; `(apply list xs)' trick isn't good enough, because `xs' contains pairs.
(define (list-deep-copy xs)
(if (not (pair? xs))
xs
(cons (list-deep-copy (car xs)) (list-deep-copy (cdr xs)))))
; Execute one instruction (`words') given current state (`registers-old')
(define (execute words registers-old)
; Make a copy of the input state, to be modified and returned.
; The state is an association list of (register . value) pairs.
(define registers-new (list-deep-copy registers-old))
; "Parse" the instruction, which has the following form:
; `wreg' (inc|dec) `wlit' if `rreg' `test' `rlit'
(define wreg (list-ref words 0))
(define inc? (string=? "inc" (list-ref words 1)))
(define wlit (string->number (list-ref words 2)))
(define rreg (list-ref words 4))
(define test (list-ref words 5))
(define rlit (string->number (list-ref words 6)))
; If register `wreg' isn't initialized yet, set it to zero
(if (not (assoc wreg registers-old))
(set! registers-new (cons (cons wreg 0) registers-new)))
; If register `rreg' isn't initialized yet, set it to zero
(if (not (assoc rreg registers-old))
(set! registers-new (cons (cons rreg 0) registers-new)))
; Read the values stored in registers `rreg' and `wreg'
(let ((wval (cdr (assoc wreg registers-new)))
(rval (cdr (assoc rreg registers-new))))
(if (satisfied? rval test rlit)
; If the test condition is true, apply the increment/decrement
(set-cdr! (assoc wreg registers-new)
(if inc?
(+ wval wlit)
(- wval wlit))))
; Return the new state
registers-new))
; Execute the "program" and return the history of register states
(define (solve-puzzle lines)
(let loop ((instructions (map string-split lines))
(registers '())
(history '()))
(if (null? instructions)
history
(let ((state (execute (car instructions) registers)))
(loop (cdr instructions) state (cons state history))))))
(define (solve-part1 lines)
(define history (solve-puzzle lines))
(apply max (map cdr (car history))))
(define (solve-part2 lines)
(define history (solve-puzzle lines))
(let loop ((states history)
(highest -999999))
(if (null? states)
highest
(loop (cdr states) (max highest (apply max (map cdr (car states))))))))
)
|
