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