正在寻找重新排列列表的算法

Question

我一直在尝试找出一种算法，它可以实现以下功能：

算法将收到这样的列表：

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

然后，它将包含元素开始的列表与所有列表连接，直到包含元素结束。然后返回的列表应该是这样的：

((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的相对初学者，但这似乎是一个有趣的挑战，所以我尝试了一下。经验丰富的口译人员，请对此代码发表评论@user1176517，如果你发现任何错误，请告诉我！

首先有几条评论：我想让它成为O（n），而不是O（n^2），所以我让递归函数返回这两个列表的头和尾（即最后的cons），这两个都是递归处理树的分支所产生的。这样，在conc-lists-start中，我可以将一个列表的最后一个cons nconc放到另一个列表中的第一个cons上，而nconc不必沿着列表走下去。我使用了多个返回值来做这件事，不幸的是，这让代码有点膨胀。为了确保tail是结果列表的最后一个cons，我需要在重复出现之前检查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))))