blob: cc24f599cba9fc7c47bb099f28bb8e9fa0659ffa (
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
|
;;6:51
;;7:49
;;
(ql:quickload '(fiveam cl-ppcre arrows))
(defstruct (part (:copier nil))
x m a s)
(defun part-sum (part)
(with-slots (x m a s) part
(+ x m a s)))
(defun copy-part (range-part)
(with-slots (x m a s) range-part
(make-part :x (copy-tree x)
:m (copy-tree m)
:a (copy-tree a)
:s (copy-tree s))))
(defun update-part (range-part slot val)
(let ((new (copy-part range-part)))
(setf (slot-value new slot) val)
new))
(defun part-options (range-part)
(reduce #'* '(x m a s)
:key (lambda (v)
(destructuring-bind (st . end)
(slot-value range-part v)
(1+ (- end st))))))
(defun parse-tests (line-rule)
(loop for test in (cl-ppcre:split "," line-rule)
collect
(cl-ppcre:register-groups-bind ((#'read-from-string prop op val target))
("\(\\w\)\(<|>\)\(\\d+\):\(\\w+\)" test)
(list op prop val target))))
(defun parse-rule (line)
(cl-ppcre:register-groups-bind ((#'read-from-string name)
(#'parse-tests tests)
(#'read-from-string default))
("\(\\w+\){\(.*\),\(\\w+\)}" line)
(list* name default tests)))
(defun parse-file (filename)
(let ((workflows (make-hash-table))
parts)
(dolist (line (uiop:read-file-lines filename))
(cond
((string-equal line ""))
((eq #\{ (aref line 0))
(cl-ppcre:register-groups-bind ((#'parse-integer x m a s))
("{x=\(\\d+\),m=\(\\d+\),a=\(\\d+\),s=\(\\d+\)}" line)
(push (make-part :x x :m m :a a :s s) parts)))
((destructuring-bind (name . rule) (parse-rule line)
(setf (gethash name workflows) rule)))))
(values workflows parts)))
(defun test-part (workflows part &optional (start 'in))
(destructuring-bind (default . tests) (gethash start workflows)
(let ((out (or (loop for (op prop val target) in tests
when (funcall op (slot-value part prop) val)
do (return target))
default)))
(cond ((eq 'A out)
(part-sum part))
((eq 'R out) 0)
((test-part workflows part out))))))
(defun solve (filename)
(multiple-value-bind (workflows parts) (parse-file filename)
(reduce #'+ parts :key (alexandria:curry #'test-part workflows))))
(defun final-options (solutions)
(loop for (r p) on solutions
by #'cddr
when (eq r 'A)
sum (part-options p)))
(fiveam:test parts
(fiveam:is (equal
'((< S 537 GD) (> X 2440 R))
(parse-tests "s<537:gd,x>2440:R" )))
(fiveam:is (= 256000000000000
(final-options (list 'a
(make-part :x (cons 1 4000)
:m (cons 1 4000)
:a (cons 1 4000)
:s (cons 1 4000)))))))
(fiveam:test solutions
(fiveam:is (= 19114 (solve "eg-in")))
(fiveam:is (= 446517 (solve "input"))))
(defun part-2 (workflows start range)
(if (member start '(A R))
(list start range)
(destructuring-bind (df . opts) (gethash start workflows)
(let ((drops
(loop for (op prop val target) in opts
append
(destructuring-bind (st . end) (slot-value range prop)
(part-2 workflows target
(if (eq '< op)
(if (< end val)
(copy-part range)
(progn
(setf (slot-value range prop) (cons val end))
(update-part range prop (cons st (1- val)))))
(if (> st val)
(copy-part range)
(progn
(setf (slot-value range prop) (cons st val))
(update-part range prop (cons (1+ val) end))))))))))
(append (part-2 workflows df range) drops)))))
(defun solve2 (filename)
(let ((workflows (parse-file filename)))
(final-options
(part-2 workflows
'in (make-part :x (cons 1 4000)
:m (cons 1 4000)
:a (cons 1 4000)
:s (cons 1 4000))))))
(fiveam:test solutions2
(fiveam:is (= 167409079868000 (solve2 "eg-in")))
(fiveam:is (= 130090458884662 (solve2 "input"))))
(fiveam:run!)
|
