如何将子树中的节点与一个 child 合并？
How to combine nodes in a subtree with one child?
我有一个树作为嵌套列表：
(A (B (C (D word) (E word))) (F (G word)))
我想在子树有一个 child 格式 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")) 周围有额外的括号？
此外，我仍在努力获得符号 "Parent+Child"
额外的括号来自于调用 (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。
好的，首先，现在已经是 1970 年了，我们发明了使用抽象的概念。我们可以为对象使用有意义的名称，而不是充满 car、cdr 和 cons 的代码：我们将处理名为 nodes[=46= 的对象] 其中每个节点是 tree 或 leaf。一棵树有一个名字和一个分支列表（分支列表就是列表，那里不需要抽象），叶子没有定义的结构：它们只是不是树。
(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))
注意这是一个函数：它以一个节点为参数，returns一个节点，可能是同一个节点，但不修改节点。
现在：
> (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
我有一个树作为嵌套列表：
(A (B (C (D word) (E word))) (F (G word)))
我想在子树有一个 child 格式 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")) 周围有额外的括号？
此外，我仍在努力获得符号 "Parent+Child"
额外的括号来自于调用 (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。
好的，首先，现在已经是 1970 年了，我们发明了使用抽象的概念。我们可以为对象使用有意义的名称，而不是充满 car、cdr 和 cons 的代码：我们将处理名为 nodes[=46= 的对象] 其中每个节点是 tree 或 leaf。一棵树有一个名字和一个分支列表（分支列表就是列表，那里不需要抽象），叶子没有定义的结构：它们只是不是树。
(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))
注意这是一个函数：它以一个节点为参数，returns一个节点，可能是同一个节点，但不修改节点。
现在：
> (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