GISC 练习 11.22d：为什么这是有状态的？

如何解决GISC 练习 11.22d：为什么这是有状态的？

David Touretzky 的“符号计算的温和介绍”的练习 11.22d 指出：

"[...] 编写一个函数 COUNT-BASES 计算 DNA 链中每种类型的碱基数，并返回结果作为表格。您的功能应该适用于单一和双链 DNA。示例：(COUNT-BASES '((G C) (A T) (T A) (T A) (C G))) 应该返回 ((A 3) (T 3) (G 2) (C 2))，而 (COUNT-BASES '(A G T A C T C T)) 应该返回 ((A 2) (T 3) (G 1) (C 2))。 [...]”

我的解决方案：

(defun count-bases (strand)
  (labels ((flatten (tree)
           (cond
             ((atom tree) (list tree))
             (t (append (flatten (car tree))
                        (and (cdr tree) 
                             (flatten (cdr tree))))))))

    (let ((flat-strand (flatten strand))
          (cnt-list '((a 0) (t 0) (c 0) (g 0))))
      (dolist (el flat-strand cnt-list) 
        (incf (cadr (assoc el cnt-list)))))))

所以我们的想法是先压平 STRAND，然后用 assoc 和 incf 计数。

问题是这以某种方式保留了 cnt-list 的状态，如下所示：

(count-bases '((g c) (a t) (t a) (t a) (c g))) ;; ((A 3) (T 3) (C 2) (G 2))
(count-bases '((g c) (a t) (t a) (t a) (c g))) ;; ((A 6) (T 6) (C 4) (G 4))
;; etc

我知道 incf 是 de/constructive，但是 cnt-list 应该在函数返回后重置，对吗？

解决方法

您正在修改未定义行为的引用列表。如果要构造要修改的列表，则应使用 (list ...) 而不是 '(...)。

如果您将 cnt-list 初始化为 (list (list 'a 0) (list 't 0) (list 'c 0) (list 'g 0))，它应该会按预期工作。

可以调用 (copy-tree '((a 0) (t 0) (c 0) (g 0))) 来获得一棵带有新鲜 cons 单元的树。

我认为 Lisp 人倾向于为问题编写过于笼统的解决方案，而对领域知识不够重视。

DNA 链是，好吧，链：它们是碱基或碱基对的链。没有一条链同时包含单个碱基和碱基对。正好有四种可能的碱基。正好有两种可能的碱基对。

因此，虽然能够将链视为通用树并将其展平是很好的，但这实际上并不是一个很好的方法：它处理的对象比 DNA 链实际的通用得多，而且几乎可以肯定不检测要求其处理的数据中的错误。

虽然使用 alist 记录计数很好，而且当我们需要处理具有大量碱基的外星 DNA 时它肯定会很有用，但在这种情况下它实际上并不是很有用。

此外，这两种技术都使程序比它需要的更慢，更简洁。（我怀疑其他答案之一也会将线性问题变成二次问题）。因此，当然，lisp 运行缓慢的古老神话将再次得到强化，这对任何人都没有帮助。

（当然，我们都知道外星 DNA 是 DAG 结构的，所以看起来可能有用的树扁平方法会可怕地重复计算碱基。）

这是一个依赖于一些领域知识的解决方案，并且还对它获得的数据进行了一些检查。您可以使用可选的“更挑剔”参数来调用它，这使得它更加挑剔。它比聪明/一般的答案长，但是，好吧。不可避免地它会有一些白痴错误[它确实]。

(defun count-bases (strand &key (carefully nil))
  (let ((adenine 0) (thymine 0) (guanine 0) (cytosine 0)
        (double (consp (first strand))))
    (dolist (base/pair strand `((a,adenine)
                                (t,thymine)
                                (g,guanine)
                                (c,cytosine)))
      (typecase base/pair
        (symbol
         (when double
           (error "horrible aliens ahavere eaten my brain"))
         (case base/pair
           ((a) (incf adenine))
           ((t) (incf thymine))
           ((g) (incf guanine))
           ((c) (incf cytosine))
           (otherwise (error "aliens have horribly eaten my brain"))))
        (cons
         (unless double
           (error "aliens have eaten my horrible brain"))
         (when carefully
           (unless (member base/pair '((a t) (t a) (c g) (g c)) :test #'equal)
             (error "horrible brains have eaten my alien")))
         (case (first base/pair)
           ((a t) (incf adenine) (incf thymine))
           ((c g) (incf cytosine) (incf guanine))
           (otherwise (error "brains have horribly eaten my alien"))))
        (t
         (error "brains have eaten my horrible alien"))))))