1 files changed, 75 insertions, 0 deletions
diff --git a/2021/18/code.tl b/2021/18/code.tl
new file mode 100644
index 0000000..92b17e3
--- /dev/null
+++ b/2021/18/code.tl
@@ -0,0 +1,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))