1 files changed, 48 insertions, 0 deletions
diff --git a/2021/14/code.tl b/2021/14/code.tl
new file mode 100644
index 0000000..0af2ac7
--- /dev/null
+++ b/2021/14/code.tl
@@ -0,0 +1,48 @@
+(defstruct polym ()
+  input
+  rewrites
+  (memo (hash)))
+
+(defun read-input (: (name "input"))
+  (let ((po (new polym)))
+    (each ((line (file-get-lines name)))
+      (match-case line
+        (`@{x 1}@{y 1} -> @z` (push ^((,(intern-fb x)
+                                       ,(intern-fb y))
+                                      ,(intern-fb z))
+                                po.rewrites))
+        (`@{x #/.+/}` -> (set po.input (flow x
+                                         (tuples 1)
+                                         (mapcar intern-fb))))))
+    po))
+
+(defmeth polym rec1 (po pair depth : (leftmost t))
+  (let ((key ^(,pair ,depth ,leftmost)))
+    (condlet
+      (((re [po.memo key]))
+       re)
+      (((rw (and (plusp (pdec depth))
+                 [find pair po.rewrites : car])))
+       (tree-bind ((x y) z) rw
+         (let ((lhist po.(rec1 ^(,x ,z) depth leftmost))
+               (rhist po.(rec1 ^(,z ,y) depth nil)))
+           (set [po.memo key]
+                [hash-uni lhist rhist +]))))
+      (leftmost
+        (hash-zip pair '(1 1)))
+      (t
+        (hash-zip (cdr pair) '(1))))))
+
+(defmeth polym rec (po pairs depth : (leftmost t))
+  (let ((hist (hash)))
+    (each ((p pairs)
+           (c 0))
+      (let ((rhist po.(rec1 p depth (zerop c))))
+        (set hist [hash-uni hist rhist +])))
+    hist))
+
+(defun solve (: (name "input") (depth 10))
+  (let* ((po (read-input name))
+         (hist po.(rec (tuples* 2 po.input) depth)))
+    (- (cdr [find-max hist : cdr])
+       (cdr [find-min hist : cdr]))))