Looking for an algorithm to rearrange a list

Question

I've been trying to figure out an algorithm that will do the following:

The algorithm will be handed a list like this:

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

It will then concatenate the list containing the element start with all lists up to the list containing the element end. The list returned then should look like this:

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

The algorithm must be able to handle lists containing start within other lists containing start.

Edit:

What I have now is this:

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

but it's not working. Maybe I should list or append instead of consing?

Edit 2:

The program above shouldn't work since I'm trying to get the first element from a non-list. This is what I have come up with so far:

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

This is the result I'm getting:

(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

I'm also a relative beginner to CL, but this seemed like an interesting challenge, so I had a go at it. Experienced lispers, comments please on this code! @user1176517, if you find any bugs, let me know!

A couple comments first: I wanted to make it O(n), not O(n^2), so I made the recursive functions return both the head and tail (i.e. last cons) of the lists resulting from recursively processing the branches of the tree. This way, in conc-lists-start, I can nconc the last cons of one list onto the first cons of another, without nconc having to walk down a list. I used multiple return values to do this, which unfortunately bloats the code a fair bit. In order to make sure that tail is the last cons of the resulting list, I need to check whether the cdr is null before recurring.

There are two recursive functions which process the tree: conc-lists and conc-lists-first. When conc-lists sees a (start), recursive processing continues with conc-lists-start. Likewise, when conc-lists-start sees an (end), recursive processing continues with conc-lists.

I'm sure it could use more comments... I may add more later.

Here's the working code:

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