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
121
122
123
|
(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 commas into list of substrings
(define (string-split str)
(define (char-comma? c) (char=? c #\,))
(map list->string (list-split char-comma? (string->list str))))
; Reverse order of numbers in index range `[pos, pos+len)' in state
(define (reverse-range state-old pos len)
(define state-length (vector-length state-old))
; Initialize `state-new' as a copy of `state-old'
(define state-new (apply vector (vector->list state-old)))
(let loop ((i 0)) ; `i' is the offset from `pos'
(if (>= i len)
state-new
(begin
; Copy `state-old[pos+i]' to `state-new[pos+len-i-1]'
(vector-set!
state-new
(mod (+ pos i) state-length)
(vector-ref
state-old
(mod (- (+ pos len) i 1) state-length)))
(loop (+ i 1))))))
; Apply a single round of the (main phase of the) hash function
(define (single-round lengths0 state0 pos0 skip0)
(let loop ((lengths lengths0)
(state state0)
(pos pos0)
(skip skip0))
(if (null? lengths)
; Once we've exhausted `lengths', return the full internal state
(values state pos skip)
; Call `reverse-range' for `(car lengths)', and update state
(loop
(cdr lengths)
(reverse-range state pos (car lengths))
; (We just let `pos' grow, ignoring circularity)
(+ pos (car lengths) skip)
(+ skip 1)))))
; Apply `single-round' `n' times, reusing the full internal state each time
(define (multi-round n lengths state-old pos-old skip-old)
(if (<= n 0)
state-old
(let-values
(((state-new pos-new skip-new)
(single-round lengths state-old pos-old skip-old)))
(multi-round (- n 1) lengths state-new pos-new skip-new))))
; Initialize state and apply `n' rounds of knot-tying algorithm
(define (solve-puzzle n lengths)
(define state0 (list->vector (iota 256)))
(multi-round n lengths state0 0 0))
; Convert "sparse hash" to "dense hash" as per part 2's description
(define (sparse->dense sparse)
; At first, storing `state' as a vector was more convenient
; because of all the indexing, but now a list seems better.
(let loop ((state (vector->list sparse))
(dense '()))
(if (null? state)
(reverse dense)
(loop
; Remove the first 16 elements from `sparse'
(cddddr (cddddr (cddddr (cddddr state))))
(cons
; XOR together the first 16 elements of `sparse'
(apply bitwise-xor
(list-tail (reverse state) (- (length state) 16)))
dense)))))
(define (solve-part1 str)
(define lengths (map string->number (string-split str)))
(define state (solve-puzzle 1 lengths))
(* (vector-ref state 0) (vector-ref state 1)))
(define (solve-part2 str)
; For part 2, `lengths' must be initialized differently
(define lengths
(append (map char->integer (string->list str))
'(17 31 73 47 23)))
(define sparse-hash (solve-puzzle 64 lengths))
(define dense-hash (sparse->dense sparse-hash))
; Convert `dense-hash' into lower-case hexadecimal representation
(let loop ((bytes dense-hash)
(final ""))
(if (null? bytes)
final
(loop
(cdr bytes)
(string-append final (format #f "~(~2,'0x~)" (car bytes)))))))
)
|
