algorithm - 寻找重新排列列表的算法

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

但它不起作用。也许我应该列出或附加而不是 coning？

编辑 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)，所以我让递归函数返回 both 头部和尾部(即最后一个缺点)递归处理树的分支所产生的列表。这样，在 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))))