blob: 0543a76c5b0dc23c256939a93e023801bdd07a4f (
plain) (
blame)
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
|
(defstruct problem workflows parts)
(defstruct rule var op value res)
(defun read-rule (string)
(if (not (position #\: string))
(make-rule :res (subseq string 0 (1- (length string))))
(multiple-value-bind (value ind) (parse-integer string :start 2 :junk-allowed t)
(make-rule :var (aref string 0)
:op (aref string 1)
:value value
:res (subseq string (1+ ind))))))
(defun split-by-char (char string &key (start 0))
(loop for i = start then (1+ j)
as j = (position char string :start i)
collect (subseq string i j)
while j))
(defun read-workflow (string)
(let* ((aux (position #\{ string))
(name (subseq string 0 aux))
(rules (mapcar #'read-rule (split-by-char #\, string :start (1+ aux)))))
(cons name rules)))
(defun read-workflows (stream)
(let ((ht (make-hash-table :test #'equalp)))
(loop for line = (read-line stream nil)
while (> (length line) 0)
do (let ((workflow (read-workflow line)))
(setf (gethash (car workflow) ht) (cdr workflow))))
ht))
(defun read-part (string)
(loop for i = 0 then (1+ j)
as j = (position #\= string :start i)
while j
collect (let ((num (parse-integer string :start (1+ j) :junk-allowed t))
(chr (aref string (1- j))))
(cons chr num))))
(defun read-parts (stream)
(loop for line = (read-line stream nil)
while line
collect (read-part line)))
(defun read-problem (filespec)
(with-open-file (stream filespec)
(make-problem :workflows (read-workflows stream) :parts (read-parts stream))))
(defun part-accepted-p (part workflows &optional (entry "in"))
(let ((rules (gethash entry workflows)))
(loop for rule in rules
as rvar = (rule-var rule)
as rop = (rule-op rule)
as rvalue = (rule-value rule)
as rres = (rule-res rule)
as pvalue = (assoc rvar part)
if (or (not rvar)
(and (equal rop #\<) (< (cdr pvalue) rvalue))
(and (equal rop #\>) (> (cdr pvalue) rvalue)))
return (cond ((equalp rres "A") t)
((equalp rres "R") nil)
(t (part-accepted-p part workflows rres))))))
(defun solve1 (filespec)
(let ((problem (read-problem filespec)))
(loop for p in (problem-parts problem)
if (part-accepted-p p (problem-workflows problem))
sum (reduce #'+ (mapcar #'cdr p)))))
(defun range-size (range)
(assert (<= (car range) (cdr range)))
(1+ (- (cdr range) (car range))))
(defun subrange (value op range)
(if
(equal op #\<)
(when (< (car range) value)
(cons (car range) (min (cdr range) (1- value))))
(when (> (cdr range) value)
(cons (max (car range) (1+ value)) (cdr range)))))
(defun inv-subrange (value op range)
(if
(equal op #\<)
(subrange (1- value) #\> range)
(subrange (1+ value) #\< range)))
(defun range-combinations (workflows rulename ranges)
(cond ((equalp rulename "A") (reduce #'* (mapcar #'range-size (mapcar #'cdr ranges))))
((equalp rulename "R") 0)
(t (let ((rules (gethash rulename workflows)))
(loop for rule in rules
as rvar = (rule-var rule)
as rop = (rule-op rule)
as rvalue = (rule-value rule)
as rres = (rule-res rule)
as range = (cdr (assoc rvar ranges))
as sub = (when rvalue (subrange rvalue rop range))
if sub
sum (range-combinations workflows rres
(mapcar
(lambda (range)
(if (equal rvar (car range))
(cons rvar sub)
range))
ranges))
if (not rvar)
sum (range-combinations workflows rres ranges)
;; update subrange
do (when rvar
(setf ranges (copy-tree ranges))
(setf (cdr (assoc rvar ranges)) (inv-subrange rvalue rop range))))))))
(defun solve2 (filespec)
(let* ((problem (read-problem filespec))
(workflows (problem-workflows problem)))
(range-combinations workflows "in"
'((#\x . (1 . 4000))
(#\m . (1 . 4000))
(#\a . (1 . 4000))
(#\s . (1 . 4000))))))
(print (solve1 "data/19/example.txt")) ;; 19114
(print (solve1 "data/19/input.txt")) ;; 495298
(print (solve2 "data/19/example.txt")) ;; 167409079868000
(print (solve2 "data/19/input.txt")) ;; 132186256794011
|
