Search for an algorithm to change the list

I tried to find an algorithm that would do the following:

The algorithm will be provided with a list similar to this:

((start abc) (def (start ghi) (jkl) (end)) (end) (mno)) 

Then it combines the list containing the element, starting from all lists up to the list containing the end of the element. The resulting list should look like this:

 ((start abc (def (start ghi (jkl)))) (mno)) 

The algorithm should be able to process lists containing the beginning in other lists containing the beginning.

Edit:

What I have now:

 (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 does not work. Maybe I should list or add instead of agreeing?

Edit 2:

The program above should not work, as I am trying to get the first item from a non-list. This is what I came 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 get:

 (conc-lists ((START ABC) (DEF (START GHI) (JKL) (END)) (END) (MNO))) 1. Trace: (CONC-LISTS '((START ABC) (DEF (START GHI) (JKL) (END)) (END) (MNO))) 2. Trace: (CONC-LISTS '((DEF (START GHI) (JKL) (END)) (END) (MNO))) 3. Trace: (CONC-LISTS '((END) (MNO))) 3. Trace: CONC-LISTS ==> NIL 2. Trace: CONC-LISTS ==> ((DEF (START GHI) (JKL) (END))) 1. Trace: CONC-LISTS ==> (START ABC (DEF (START GHI) (JKL) (END))) (START ABC (DEF (START GHI) (JKL) (END))) 
+6
source share
1 answer

I'm also a relative newbie to CL, but that seemed like an interesting task, so I went for it. Experienced sheets, comment on this code! @ user1176517 if you find any errors let me know!

First, a couple of comments: I wanted to do this O (n), not O (n ^ 2), so I made recursive functions return both the head and tail (i.e. the last minuses) of the lists as a result of the recursive processing of the tree branch. So in conc-lists-start I can nconc last cons of one list to the first cons of another, without nconc to go down the list. For this, I used several return values, which, unfortunately, inflate the code with an honest bit. To make sure tail is the last minus of the resulting list, I need to check if cdr has a value before repeating.

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

I am sure that he could use more comments ... I can 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 cc))) ((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
source

Source: https://habr.com/ru/post/907159/


All Articles