自上而下的树搜索和替换

Question

我在编写树搜索和替换算法代码时遇到问题。输入树包含任意嵌套的数据项——例如，树 = (1 (2 3 (4 (5)) 6))，其中 1 是根，向下的每一层都嵌入在括号中。所以 1 在第 1 级； 2, 3, 4, 6 在第 2 级（低于 1），5 在第 3 级（低于 4）。整个树的结构使得任何列表的汽车始终是一个数据项，后面可以跟其他数据项或子树。问题是在树中找到匹配（在我的特定情况下为#'equal）输入项的数据项，并用给定的新子树替换现有的旧项——例如，（交换子树旧项树...）。因此，树随着每次更换而生长。但是，搜索必须在树中自上而下进行，只交换找到的第一个这样的旧项目，然后退出。

一些观察？：1）对于二叉树，搜索顺序（自上而下的访问）通常称为级别顺序，其他可能的搜索顺序是前序、中序和后序，但我的树不一定二进制。 2) 广度优先搜索算法之类的东西可能会起作用，但节点是通过树遍历选择的，而不是生成的。 3) 标准 "substitute" 函数仅适用于序列，不适用于树。 4) "subst" 函数适用于树，但似乎以深度优先的方式遍历替换所有匹配项，并且没有 :count 关键字（就像 "substitute" 那样）在第一次替换后停止。

任何帮助编码甚至构建好的方法将不胜感激。（也很好奇为什么 common-lisp 没有更多 "tree" 列表和向量的函数。）

Answer 1

也许我不应该这样做，因为你应该自己做作业，但解释要做什么比展示它要花更长的时间。这是广度优先搜索和替换版本：

(defun search-replace (item new-item lst)
  (when (listp lst)
    (let ((found-item (member item lst)))
      (if found-item
          (rplaca found-item new-item)
          (some #'(lambda (sublst) (search-replace item new-item sublst)) lst) ))))

这个函数是破坏性的，即它会修改原来的列表，因为它使用了rplaca，而不会return结果列表（你可以在最后添加） .您还可以添加其他不错的功能，例如测试功能（equal 或您需要的任何功能）。它也适用于 car 是子列表的列表（在您的示例中它始终是一个原子）。我希望它能帮助你开始。

Answer 2

@狮子座。就像您的简洁解决方案一样——必须研究它才能理解。同时这里是另一个初步的广度优先搜索尝试：

(defun add-tree (newsubtree tree)
  (let ((queue (make-array 0 :adjustable t :fill-pointer t))
        (data (first newsubtree))
        (index 0))
    (vector-push-extend tree queue)
    (loop until (= index (fill-pointer queue))
        do (let ((current-node (elt queue index)))
             (incf index)
             (loop for child in (second current-node)
                 for i from 0
                 if (and (numberp child) (= child data))
                    do (setf (elt (second current-node) i) newsubtree)
                       (return-from add-tree tree)
                    else do (vector-push-extend child queue))))))

(add-tree '(2 (5 6)) '(0 ((1 (3 2 4)) 2)))
(0 ((1 (3 2 4)) (2 (5 6))))

感谢您证实我的直觉，即广度优先是解决此问题的方法。 (ps: 这不是作业)

Answer 3

这是一个真正的广度优先搜索，它实际上替换了最浅的最左边的匹配项。（不幸的是，@Leo 的代码虽然很流畅，但并没有这样做。）

为了好玩，使用循环列表作为队列：

(setf *print-circle* t)

(defun one-element-queue (item)
  (let ((link (list item)))
    (setf (cdr link) link)))

(defun enqueue (item &optional queue)
  (cond ((null queue) (one-element-queue item))
        (t (let ((new-link (cons item (cdr queue))))
             (setf (cdr queue) new-link)))))

(defun enqueue-all (items &optional queue)
  (dolist (item items queue) (setq queue (enqueue item queue))))

(defun dequeue (queue)
  (cond ((eq queue (cdr queue)) (values (car queue) nil))
        (t (let ((item (cadr queue)))
             (setf (cdr queue) (cddr queue))
             (values item queue)))))

(defun node-replace (new-item old-item node)
  (let ((position (position old-item node :test #'equal)))
    (when position (setf (nth position node) new-item))
    position))

(defun tree-replace (new-item old-item tree)
  (loop with queue = (enqueue tree) and node
        while queue
        do (multiple-value-setq (node queue) (dequeue queue))
        until (node-replace new-item old-item node)
        do (setq queue (enqueue-all (remove-if-not #'listp node) queue)))
  tree)

(setq tree '(1 ((5 ((41))) 3 (4 (5)) 5)))

(print (tree-replace 42 5 tree))

自上而下的树搜索和替换

Top-down tree search & replace

search

replace

common-lisp

top-down