blob: 9796f214736b474a6301ff8f86cfc8bfc69cf9ba (
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
|
(define-module (day04)
#:use-module (ice-9 rdelim)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-41))
(define-record-type <point> (point i j) point?
(i point-i)
(j point-j))
(define (square i1 j1 i2 j2)
(define (row i)
(stream-map (cut point i <>) (stream-range j1 j2)))
(stream-concat (stream-map row (stream-range i1 i2))))
(define (array-point arr pt)
(array-ref arr (point-i pt) (point-j pt)))
(define (point-add pt i j)
(point (+ (point-i pt) i) (+ (point-j pt) j)))
(define* (read-input #:optional (port (current-input-port)))
(define (read-lines acc)
(define line (read-line port))
(if (and (not (eof-object? line)) (> (string-length line) 0))
(read-lines (cons line acc))
acc))
(define strings (reverse! (read-lines '())))
(define string->char-codes (compose (cut map char->integer <>) string->list))
(list->typed-array 'u8 2 (map string->char-codes strings)))
(define xmas (map char->integer (string->list "XMAS")))
(define directions '((-1 -1) (-1 0) (-1 1) (0 -1) (0 1) (1 -1) (1 0) (1 1)))
(define (start-word? arr pt di dj)
(let loop ((pt pt) (lst xmas))
(or (null-list? lst)
(and (= (array-point arr pt) (first lst))
(loop (point-add pt di dj) (cdr lst))))))
(define (count-xmas arr)
(define-values (m n) (apply values (array-dimensions arr)))
(define (compute-range dx size)
(stream-range (if (< dx 0) (* -3 dx) 0)
(if (> dx 0) (- size (* 3 dx)) size)))
(define (count-dir di dj)
(define-values (istart ipast) (compute-range di m))
(define-values (jstart jpast) (compute-range dj n))
(stream-length (stream-filter (cut start-word? arr <> di dj)
(square istart jstart ipast jpast))))
(stream-fold + 0 (stream-map (cut apply count-dir <>)
(list->stream directions))))
(define (is-x-mas? arr pt)
(and (= (array-point arr pt) (char->integer #\A))
(let loop ((nm 0) (diffs '((1 1) (1 -1) (-1 1) (-1 -1))))
(if (null-list? diffs)
(= nm 2)
(let ((cur (array-point arr (apply point-add pt (car diffs)))))
(case (integer->char cur)
((#\M) (and (< nm 2) (loop (+ nm 1) (cdr diffs))))
((#\S) (loop nm (cdr diffs)))
(else #f)))))
(not (= (array-point arr (point-add pt 1 1))
(array-point arr (point-add pt -1 -1))))))
(define (count-x-mas arr)
(define-values (m n) (apply values (array-dimensions arr)))
(stream-length (stream-filter (cut is-x-mas? arr <>)
(square 1 1 (- m 1) (- n 1)))))
(define part1 (compose count-xmas read-input))
(define part2 (compose count-x-mas read-input))
|
