(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]))))