Question

我一直试图找出一种能够执行以下操作的算法：

该算法将被递归如下列表：

((start a b c) (d e f (start g h i) (j k l) (end)) (end) (m n o))

然后它将包含元素 start 的列表与包含元素 end 的列表之前的所有列表连接起来。返回的列表应如下所示：

((start a b c (d e f (start g h i (j k l)))) (m n o))

该算法必须能够处理包含 start 的其他列表中包含 start 的列表。

编辑：

我现在拥有的是：

(defun conc-lists (l)
  (cond
      ((endp l) '())
      ((eq (first (first l)) 'start) 
          (cons (cons (first (first l)) (conc-lists (rest (first l))))) 
              (conc-lists (rest l)))
      ((eq (first (first l)) 'end) '())
      (t (cons (first l) (conc-lists (rest l))))))

但它不起作用。也许我应该列出或追加而不是消费？

编辑2：

上面的程序不起作用，因为我试图从非列表中获取第一个元素。这是我到目前为止所提出的：

(defun conc-lists (l)
  (cond
      ((endp l) '())
      ((eq (first (first l)) 'start) 
          (append (cons (first (first l)) (rest (first l))) 
              (conc-lists (rest l))))
      ((eq (first (first l)) 'end) '())
      (t (cons (first l) (conc-lists (rest l))))))

这是我得到的结果：

(conc-lists ((START A B C) (D E F (START G H I) (J K L) (END)) (END) (M N O)))
1. Trace: (CONC-LISTS '((START A B C) (D E F (START G H I) (J K L) (END)) (END) (M N O)))
2. Trace: (CONC-LISTS '((D E F (START G H I) (J K L) (END)) (END) (M N O)))
3. Trace: (CONC-LISTS '((END) (M N O)))
3. Trace: CONC-LISTS ==> NIL
2. Trace: CONC-LISTS ==> ((D E F (START G H I) (J K L) (END)))
1. Trace: CONC-LISTS ==> (START A B C (D E F (START G H I) (J K L) (END)))
(START A B C (D E F (START G H I) (J K L) (END)))

Answer 1

我也是CL的初学者，但这看起来像是一个有趣的挑战，所以我对它有所了解。有经验的lispers，请注意此代码！ @ user1176517，如果您发现任何错误，请告诉我们！

首先评论一下：我想把它做成O（n），而不是O（n ^ 2），所以我做了递归函数返回两者头部和尾部（即最后的缺点）通过递归处理树的分支产生的列表。这样，在conc-lists-start中，我可以nconc将一个列表的最后一个缺点放在另一个列表的第一个缺点上，而nconc不必在列表中向下走。我使用了多个返回值来执行此操作，不幸的是，这会使代码膨胀一些。为了确保tail是结果列表的 last 缺点，我需要在重复之前检查cdr是否为null 。

有两个递归函数处理树：conc-lists和conc-lists-first。当conc-lists看到(start)时，递归处理将继续conc-lists-start。同样，当conc-lists-start看到(end)时，递归处理会继续conc-lists。

我确信它可以使用更多评论......我可能会在以后添加更多评论。

这是工作代码：

;;; conc-lists ;;; runs recursively over a tree, looking for lists which begin with 'start ;;; such lists will be nconc'd with following lists a same level of nesting, ;;; up until the first list which begins with 'end ;;; lists which are nconc'd onto the (start) list are first recursively processed ;;; to look for more (start)s ;;; returns 2 values: head *and* tail of resulting list ;;; DESTRUCTIVELY MODIFIES ARGUMENT! (defun conc-lists (lst) (cond ((or (null lst) (atom lst)) (values lst lst)) ((null (cdr lst)) (let ((head (conc-process-rest lst))) (values head head))) (t (conc-process-rest lst)))) ;;; helper to factor out repeated code (defun conc-process-rest (lst) (if (is-start (car lst)) (conc-lists-start (cdar lst) (cdr lst)) (multiple-value-bind (head tail) (conc-lists (cdr lst)) (values (cons (conc-lists (car lst)) head) tail)))) ;;; conc-lists-start ;;; we have already seen a (start), and are nconc'ing lists together ;;; takes *2* arguments so that 'start can easily be stripped from the ;;; arguments to the initial call to conc-lists-start ;;; recursive calls don't need to strip anything off, so the car and cdr ;;; are just passed directly (defun conc-lists-start (first rest) (multiple-value-bind (head tail) (conc-lists first) (cond ((null rest) (let ((c (list head))) (values c c))) ((is-end (car rest)) (multiple-value-bind (head2 tail2) (conc-lists (cdr rest)) (values (cons head head2) tail2))) (t (multiple-value-bind (head2 tail2) (conc-lists-start (car rest) (cdr rest)) (nconc tail (car head2)) (values (cons head (cdr head2)) tail2)))))) (defun is-start (first) (and (listp first) (eq 'start (car first)))) (defun is-end (first) (and (listp first) (eq 'end (car first))))

寻找重新排列列表的算法

1 个答案: