blob: ce850cbd08d4d8b079c5e5aec216522936ed5e4c (
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
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
|
#!/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)
; lists
(srfi srfi-1)
; Multiple values
(srfi srfi-8)
(srfi srfi-9)
(srfi srfi-64)
(ice-9 regex)
(ice-9 getopt-long))
;; utility function
(define (split-input lines)
(let ((rules '())
(pages '()))
(for-each (lambda (line)
(cond ((string-contains line "|") (set! rules (cons line rules)))
((string-contains line ",") (set! pages (cons line pages)))))
lines)
(list rules pages)))
(define (parse-rules lines)
(map (lambda (line)
(map string->number (string-split line #\|)))
lines))
(define (parse-pages lines)
(map (lambda (line)
(map string->number (string-split line #\,)))
lines))
(define (split-pages-at pages idx)
(receive (pre post) (split-at pages idx)
(values pre (cdr post))))
;; Part 1
(define (valid-pages-before? number lst rules)
(= (length (filter (lambda (pair)
(and (= number (second pair))
(member (first pair) lst)))
rules))
(length lst)))
(define (valid-pages-after? number lst rules)
(= (length (filter (lambda (pair)
(and (= number (first pair))
(member (second pair) lst)))
rules))
(length lst)))
(define (right-order? page pages rules)
(let ((idx (element-index page pages)))
(receive (pre post) (split-pages-at pages idx)
(cond ((not (valid-pages-before? page pre rules)) #f)
((not (valid-pages-after? page post rules)) #f)
(else #t)))))
(define (good-page-order pages rules)
"pages are a list of numbers."
(if (every (lambda (e) (eq? e #t))
(map (lambda (page)
(right-order? page pages rules))
pages))
pages
#f))
(define (middle-element lst)
(let ((idx (quotient (length lst) 2)))
(list-ref lst idx)))
(define (part1 input)
(let* ((parts (split-input input))
(rules (parse-rules (first parts)))
(pages (parse-pages (second parts)))
(good-pages (map (lambda (pages-order) (good-page-order pages-order rules)) pages)))
(apply + (filter-map (lambda (good-page) (if good-page
(middle-element good-page)
#f))
good-pages))))
;; Part 2
(define (bad-page-order pages rules)
"pages are a list of numbers."
(if (every (lambda (e) (eq? e #t))
(map (lambda (page)
(right-order? page pages rules))
pages))
#f
pages))
(define (bad-pages pages rules)
(filter (lambda (page-list) (bad-page-order page-list rules)) pages))
(define (find-rule e1 e2 rules)
"Return a matching rule for e1 and e2"
(filter (lambda (pair)
(and (= (first pair) e1)
(= (second pair) e2)))
rules))
(define (rule-compare e1 e2 rules)
"Return less of e1 e2 acording to matching rules."
(if (> (length (find-rule e1 e2 rules)) 0)
#t
#f))
(define (sort-by-rules lst rules)
(sort lst (lambda (e1 e2) (rule-compare e1 e2 rules))))
(define (part2 input)
(let* ((parts (split-input input))
(rules (parse-rules (first parts)))
(pages (parse-pages (second parts))))
(apply + (map (lambda (lst) (middle-element lst))
(map (lambda (lst) (sort-by-rules lst rules)) (bad-pages pages rules))))))
;; Tests
(define (run-tests)
"")
;; Main
(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 (file->list 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)
|
