寻找重新排列列表的算法

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是结果列表的最后一个缺点，我需要在cdr重复之前检查是否为空。

有两个处理树的递归函数：conc-lists和conc-lists-first。当conc-lists看到 a 时(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))))