blob: 292ca38dcdd7b8bd83edc70667db7c7a25f7325c (
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
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
|
#!/usr/bin/guile -s
!#
(add-to-load-path (format #f "~a/2024" (getcwd)))
;(add-to-load-path (format #f "~a/.." (dirname (current-filename))))
(use-modules
(aoc-utils)
(srfi srfi-1)
(srfi srfi-9)
(srfi srfi-64)
(ice-9 regex)
(ice-9 getopt-long))
(define (xmas? lst)
(or (equal? lst '(#\X #\M #\A #\S))
(equal? lst '(#\S #\A #\M #\X))))
(define (check-south matrix x y)
(let ((to-check (list (matrix-ref matrix x y)
(matrix-ref matrix x (+ 1 y))
(matrix-ref matrix x (+ 2 y))
(matrix-ref matrix x (+ 3 y)))))
(xmas? to-check)))
(define (check-east matrix x y)
(let ((to-check (list (matrix-ref matrix x y)
(matrix-ref matrix (+ 1 x) y)
(matrix-ref matrix (+ 2 x) y)
(matrix-ref matrix (+ 3 x) y))))
(xmas? to-check)))
(define (check-south-east matrix x y)
(let ((to-check (list (matrix-ref matrix x y)
(matrix-ref matrix (+ 1 x) (+ 1 y))
(matrix-ref matrix (+ 2 x) (+ 2 y))
(matrix-ref matrix (+ 3 x) (+ 3 y)))))
(xmas? to-check)))
(define (check-south-west matrix x y)
(let ((to-check (list (matrix-ref matrix x y)
(matrix-ref matrix (- x 1) (+ 1 y))
(matrix-ref matrix (- x 2) (+ 2 y))
(matrix-ref matrix (- x 3) (+ 3 y)))))
(xmas? to-check)))
(define (part1 matrix)
(let ((retval 0))
(do ((x 0 (1+ x)))
((> x (1- (matrix-width matrix))))
(do ((y 0 (1+ y)))
((> y (1- (matrix-height matrix))))
(if (check-south matrix x y)
(set! retval (1+ retval)))
(if (check-east matrix x y)
(set! retval (1+ retval)))
(if (check-south-east matrix x y)
(set! retval (1+ retval)))
(if (check-south-west matrix x y)
(set! retval (1+ retval)))))
retval))
;; Part 2
(define (x-mas? lst1 lst2)
(or (and (equal? lst1 '(#\M #\A #\S))
(equal? lst2 '(#\M #\A #\S)))
(and (equal? lst1 '(#\S #\A #\M))
(equal? lst2 '(#\S #\A #\M)))
(and (equal? lst1 '(#\S #\A #\M))
(equal? lst2 '(#\M #\A #\S)))
(and (equal? lst1 '(#\M #\A #\S))
(equal? lst2 '(#\S #\A #\M)))))
(define (check-cross matrix x y)
(let ((diagonal1 (list (matrix-ref matrix (- x 1) (- y 1))
(matrix-ref matrix x y)
(matrix-ref matrix (+ x 1) (+ y 1))))
(diagonal2 (list (matrix-ref matrix (+ x 1) (- y 1))
(matrix-ref matrix x y)
(matrix-ref matrix (- x 1) (+ y 1)))))
(x-mas? diagonal1 diagonal2)))
(define (part2 matrix)
(let ((retval 0))
(do ((x 0 (1+ x)))
((> x (1- (matrix-width matrix))))
(do ((y 0 (1+ y)))
((> y (1- (matrix-height matrix))))
(if (equal? (matrix-ref matrix x y) #\A)
(if (check-cross matrix x y)
(set! retval (1+ retval))))))
retval))
(define option-spec
'((help (single-char #\h) (value #f))
(test (single-char #\t) (value #f))))
(define (help)
(display "main.scm [options] [FILE]
-h, --help Display this help.
-t, --test Run test suite
"))
(define (run-parts filename)
(let ((input (make-matrix (file->matrix filename))))
(display "Part1: ")
(display (part1 input))
(newline)
(display "Part2: ")
(display (part2 input))
(newline)))
(define (main)
(let* ((options (getopt-long (command-line) option-spec))
(help-wanted? (option-ref options 'help #f))
(test-wanted? (option-ref options 'test #f))
(files (option-ref options '() '())))
(cond (help-wanted? (help))
(test-wanted? (run-tests))
((= (length files) 1) (run-parts (car files)))
(else (help)))))
(main)
|
