blob: 0af2ac70b1983cb87f2bd0a5326c97a8ff85d8d5 (
plain)
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
|
(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]))))
|