如何将子树中的节点与一个孩子组合？

Question

我有一棵树作为嵌套列表：

(A (B (C (D word) (E word))) (F (G word)))

当子树有一个子树时，我想合并节点，格式为 Parent+Child，所以结果是：

(A (B+C (D word) (E word)) (F+G word)) 

我目前正在使用递归函数来处理树。我试过了

(defun my-func (tree)

  (cond
    ; base case
    ((null tree) nil)
    ; subtree has one child
    ((and (atom (car tree)) (listp (car(cdr tree))) (= (length (cdr tree)) 1))
      (my-func (cdr tree)))
    ; first element is atom
    ((atom (car tree)) (cons (car tree) (my-func (cdr tree))))
    ; else
    (t (cons (my-func (car tree)) (my-func (cdr tree)))))
)

我的输入是：("A" ("B" ("C" ("D" "word1") ("E" "word2"))) ("F" ("G" "word3")))

输出为：("A" (("C" ("D" "word1") ("E" "word2"))) (("G" "word3")))

我已经接近了，但我现在的问题是：

为什么我在子列表 (("C" ("D" "word1") ("E" "word2"))) 和 (("G" "word3")) 周围有多余的括号？

另外，我还在为获得“父母+孩子”的符号而苦苦挣扎

Answer 1

好的，首先，已经是 1970 年了，我们发明了使用抽象的概念。除了充满car、cdr和cons的代码，我们可以为我们的对象使用有意义的名称：我们将处理名为nodes的对象，其中每个节点都是一个树或叶子。一棵树有一个名称和一个分支列表（分支列表是列表，不需要抽象），叶子没有定义的结构：它们只是不是树。

(defun node-tree-p (o)
  (consp o))

(defun node-leaf-p (o)
  (not (node-tree-p o)))

(defun tree-name (tree)
  (car tree))

(defun tree-branches (tree)
  (cdr tree))

(defun make-tree (name branches)
  (cons name branches))

我将把合并后的树名显式表示为列表（因此，特别是，它们是 列表，因此可以在它们上使用列表函数，我们不需要抽象它们）。因此，我们需要一个函数来合并名称，该函数根据一个名称是否已经是一个列表名称来包装这种繁琐的操作：

(defun coalesce-names (n1 n2)
  (append (if (listp n1) n1 (list n1))
          (if (listp n2) n2 (list n2))))

所以现在我们可以编写一个函数来遍历一棵树并合并可合并的内容：

(defun maybe-coalesce-node (node)
  (if (node-tree-p node)
      ;; it's a tree, which is a candidate
      (if (= (length (tree-branches node)) 1)
          ;; it's got one branch: it's a good candidate
          (let ((branch (first (tree-branches node))))
            (if (node-tree-p branch)
                ;; the branch is a tree: this is coalescable: coalesce
                ;; it and then recurse on the result
                (maybe-coalesce-node (make-tree (coalesce-names (tree-name node)
                                                                (tree-name branch))
                                                (tree-branches branch)))
              ;; the branch is a leaf: this is not coalescable
              node))
        ;; it's a tree, but it has more than one branch, so make a
        ;; tree whose branches have been coalesced
        (make-tree (tree-name node)
                   (mapcar #'maybe-coalesce-node (tree-branches node))))
    ;; it's a leaf, which is not a candidate
    node))

注意，这是一个函数：它以一个节点为参数，返回一个节点，可能是同一个节点，但不会修改节点。

现在：

> (maybe-coalesce-node
   '(a (b 1) (c (d (e 2))) (f (g (h 3) (i 4)))))
(a (b 1) ((c d e) 2) ((f g) (h 3) (i 4)))

因此，这样做的结果是我们可以合并树以生成名称为名称列表的树。现在我们想把这些名字变成字符串。为了做到这一点，让我们编写一个通用的树映射器函数，它将一个函数映射到一个节点上：

(defun map-node (f node)
  ;; map F over the nodes in TOP-NODE.  F should return a node, but it
  ;; may have a different structure than its argument.
  (let ((new-node (funcall f node)))
    (if (node-tree-p new-node)
        (make-tree (tree-name new-node)
                   (mapcar #'(lambda (n)
                               (map-node f n))
                           (tree-branches new-node)))
      new-node)))

现在让我们编写一个重写树名的函数，使用辅助函数来完成这项工作：

(defun stringify-tree-name (name)
  (format nil "~{~A~^+~}" (if (listp name) name (list name))))

(defun maybe-rewrite-node-name (node &key (name-rewriter #'stringify-tree-name))
  (if (node-tree-p node)
      (make-tree (funcall name-rewriter (tree-name node))
                 (tree-branches node))
    node))

现在我们可以合并并重写节点的名称：

> (map-node #'maybe-rewrite-node-name
                       (maybe-coalesce-node
                        '(a (b 1) (c (d (e 2))) (f (g (h 3) (i 4))))))
("a" ("b" 1) ("c+d+e" 2) ("f+g" ("h" 3) ("i" 4)))

---

作为练习：用map-node 重写maybe-coalesce-node。

Answer 2

额外的括号来自于调用(my-func (cdr tree))，因为此时(cadr tree) 是一个列表，所以(cdr tree) 会得到两个括号。 我不确定你所说的 B+C 是什么意思。假设您将它作为字符串“B+C”返回，因此我们将使用format 将它们组合起来。

(defun my-func (tree)
  (cond
    ; base case
    ((null tree) nil)
    ; subtree is an atom
    ((atom tree) tree)
    ; subtree has one 
    ((and (atom (car tree)) (listp (car(cdr tree))) (= (length (cdr tree)) 1))
      (cons (format nil "~a+~a" (car tree) (caadr tree)) (mapcar #'my-func (cdadr tree))) )
    ; first element is atom
    ((atom (car tree))
      (cons (car tree) (mapcar #'my-func (cdr tree))))
    ; else
    (t (cons (my-func (car tree)) (my-func (cdr tree)))))
)

您也可以将 B+C 组合为一个列表，因此请使用 (list (car tree) '+ (caadr)) tree) 而不是 format。