0

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

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

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

4

3 回答 3

0

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

(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作为子列表的列表（在您的示例中，它始终是原子）。我希望它可以帮助您入门。

于 2016-11-08T06:49:35.463 回答
0

这是一个真正的广度优先搜索，它实际上确实替换了最浅的最左边的出现。（不幸的是，@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))
于 2016-11-09T04:01:02.037 回答
0

@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：这不是作业）

于 2016-11-09T03:15:14.673 回答