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
|
(defun read-string (str)
(flow str (mapcar (relate '(#\[ #\] #\,) '(#\( #\) #\space))) read))
(defun read-input (: (name "input"))
(flow name file-get-lines (mapcar read-string)))
(defun ladd (n sn)
(tree-case sn
((a b) ^(,(ladd n a) ,b))
(m (+ n m))))
(defun radd (sn n)
(tree-case sn
((a b) ^(,a ,(radd b n)))
(m (+ m n))))
(defun explode (sn)
(match-case sn
(^(((((,a ,b) ,x) ,y) ,z) ,w) ^((((0 ,(ladd b x)) ,y) ,z) ,w))
(^((((,x (,a ,b)) ,y) ,z) ,w) ^((((,(radd x a) 0) ,(ladd b y)) ,z) ,w))
(^(((,y ((,a ,b) ,x)) ,z) ,w) ^(((,(radd y a) (0 ,(ladd b x))) ,z) ,w))
(^(((,y (,x (,a ,b))) ,z) ,w) ^(((,y (,(radd x a) 0)) ,(ladd b z)) ,w))
(^((,z (((,a ,b) ,x) ,y)) ,w) ^((,(radd z a) ((0 ,(ladd b x)) ,y)) ,w))
(^((,z ((,x (,a ,b)) ,y)) ,w) ^((,z ((,(radd x a) 0) ,(ladd b y))) ,w))
(^((,z (,y ((,a ,b) ,x))) ,w) ^((,z (,(radd y a) (0 ,(ladd b x)))) ,w))
(^((,z (,y (,x (,a ,b)))) ,w) ^((,z (,y (,(radd x a) 0))) ,(ladd b w)))
(^(,w ((((,a ,b) ,x) ,y) ,z)) ^(,(radd w a) (((0 ,(ladd b x)) ,y) ,z)))
(^(,w (((,x (,a ,b)) ,y) ,z)) ^(,w (((,(radd x a) 0) ,(ladd b y)) ,z)))
(^(,w ((,y ((,a ,b) ,x)) ,z)) ^(,w ((,(radd y a) (0 ,(ladd b x))) ,z)))
(^(,w ((,y (,x (,a ,b))) ,z)) ^(,w ((,y (,(radd x a) 0)) ,(ladd b z))))
(^(,w (,z (((,a ,b) ,x) ,y))) ^(,w (,(radd z a) ((0 ,(ladd b x)) ,y))))
(^(,w (,z ((,x (,a ,b)) ,y))) ^(,w (,z ((,(radd x a) 0) ,(ladd b y)))))
(^(,w (,z (,y ((,a ,b) ,x)))) ^(,w (,z (,(radd y a) (0 ,(ladd b x))))))
(^(,w (,z (,y (,x (,a ,b))))) ^(,w (,z (,y (,(radd x a) 0)))))
(@else else)))
(defun splt (sn)
(tree-case sn
((a b)
(let ((as (splt a))
(bs (splt b)))
(cond
((neq a as) ^(,as ,b))
((neq b bs) ^(,a ,bs))
(t sn))))
(m (if (< m 10)
m
(let* ((x (trunc m 2))
(y (- m x)))
^(,x ,y))))))
(defun reduce (sn)
(let (sn*)
(while* (neq sn* sn)
(while* (neq sn* sn)
(shift sn* sn (explode sn)))
(shift sn* sn (splt sn)))
sn))
(defun add (sn0 sn1)
(reduce (list sn0 sn1)))
(defun mag (sn)
(tree-case sn
((a b) (+ (* 3 (mag a)) (* 2 (mag b))))
(m m)))
(defun solve-one (: (name :))
(flow name read-input (reduce-left add) mag))
(defun solve-two (: (name :))
(flow name read-input (comb @1 2)
(mappend [juxt [chain [apf add] mag]
[chain [apf [flipargs add]] mag]])
find-max))
|
