1 files changed, 42 insertions, 0 deletions
diff --git a/2021/14/codes.tl b/2021/14/codes.tl
new file mode 100644
index 0000000..dcaccba
--- /dev/null
+++ b/2021/14/codes.tl
@@ -0,0 +1,42 @@
+(defstruct polym ()
+  input
+  rewrites
+  (memo (hash)))
+
+(defun read-input (: (name "input"))
+  (let ((po (new polym)))
+    (each ((line (file-get-lines name)))
+      (match-case line
+        (`@a -> @b` (push `@a@b` po.rewrites))
+        (`@{a 1}@b` (set po.input `@a@b`))))
+    po))
+
+(defmeth polym rec1 (po pair depth : (leftmost t))
+  (placelet ((memo [po.memo ^(,pair ,depth ,leftmost)]))
+    (condlet
+      (((re memo))
+       re)
+      (((rw (and (plusp (pdec depth))
+                 [find pair po.rewrites starts-with])))
+       (match `@{x 1}@{y 1}@{z 1}` rw
+         (let ((lhist po.(rec1 `@x@z` depth leftmost))
+               (rhist po.(rec1 `@z@y` depth nil)))
+           (set memo [hash-uni lhist rhist +]))))
+      (leftmost
+        (set memo (hash-zip pair '(1 1))))
+      (t
+        (set memo (hash-zip (rest 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]))))