Question

我在编写树搜索时遇到问题＆amp;替换算法。输入树包含任意嵌套的数据项 - 例如，tree =（1（2 3（4（5））6）），其中1是根，并且每个级别向下嵌入括号中。所以1是＃1级; 2,3,4,6处于＃2（1岁以下），5处处于＃3（4岁以下）。整个树的结构使得任何列表的汽车始终是数据项，其后可以是其他数据项或子树。问题是在树匹配中找到一个数据项（在我的特定情况下是相同的）一个输入项，并用给定的新子树替换现有的旧项 - 例如，（交换子树olditem树.. ）。因此，树每次更换都会增长。但是，搜索必须在树中自上而下进行，只交换找到的第一个这样的olditem，然后退出。

一些观察结果？：1）对于二叉树，搜索顺序（自上而下的访问）通常称为水平顺序，其他可能的搜索顺序是预订，按顺序和后序，但我的树不一定是二进制的。 2）类似于广度优先搜索算法的东西可能有效，但节点是通过树遍历选择的，而不是生成的。 3）标准＆＃34;替代＆＃34;函数仅适用于序列，而不适用于树。 4）＆＃34; subst＆＃34;函数适用于树，但似乎以深度优先的方式遍历替换所有匹配项，并且没有：count关键字（例如＆＃34;替换＆＃34;确实）在第一次替换后停止。

任何帮助编码或甚至构建好方法都将受到赞赏。（还好奇为什么common-lisp没有更多＆＃34;树和＃34;函数用于列表和向量。）

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，并且它不会返回结果列表（您可以在末尾添加它）。您还可以添加其他不错的功能，例如测试功能（equal或您需要的任何功能）。它也适用于car是子列表的列表（在您的示例中，它始终是一个原子）。我希望它可以帮助你开始。

Answer 2

@Leo。就像你简洁的解决方案 - 必须研究它以便理解。与此同时，这是另一个初步的广度优先搜索尝试：

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

自上而下的树搜索＆amp;更换

3 个答案: