Lisp reversal of all continuous sequences of elements

Question

I want to change only continuous sequences, and not all elements of my source list.

Ex: (reverseC '( 1 2 ( 4 5 ) 5 ) ) => ( 2 1 ( 5 4 ) 5 ) (reverseC '(1 4 2 (3 4) 9 6 (7 8)))) => (2 4 1 (4 3) 6 9 (8 7)) 

I was thinking about dividing it into two functions: one to cancel a simple list (1 2 3) → (3 2 1) and one function (main) to define continuous sequences, make a list of them, apply reverse in this list and redo the entire inverted list.

 (defun reverse-list ( lista ) (if (eql lista () ) () (append (reverse-list (cdr lista )) (list ( car lista))) ) ) 

This is the inverse function, but I have no idea how to do another. I am new to Lisp and I came from Prolog, so this is a pretty big change in scenery. Any idea is welcome.

 (defun reverse-more (L) (if (eql L nil) nil (let ( el (car L)) (aux (cdr L))) (if (eql (listp el) nil) ...No idea on the rest of the code ... 

Answer 1

You can do it all at once with a single recursive function with the usual warning that you should approve loop constructs over recursive approaches (see below):

 (defun reverse-consecutive (list &optional acc) (etypecase list ;; BASE CASE ;; return accumulated list (null acc) ;; GENERAL CASE (cons (destructuring-bind (head . tail) list (typecase head (list ;; HEAD is a list: ;; ;; - stop accumulating values ;; - reverse HEAD recursively (LH) ;; - reverse TAIL recursively (LT) ;; ;; Result is `(,@ACC ,LH ,@LT) ;; (nconc acc (list (reverse-consecutive head)) (reverse-consecutive tail))) ;; HEAD is not a list ;; ;; - recurse for the result on TAIL with HEAD ;; in front of ACC ;; (t (reverse-consecutive tail (cons head acc)))))))) 

Exemples

 (reverse-consecutive '(1 2 (3 4) 5 6 (7 8))) => (2 1 (4 3) 6 5 (8 7)) (mapcar #'reverse-consecutive '((1 3 (8 3) 2 ) (1 4 2 (3 4) 9 6 (7 8)) (1 2 (4 5) 5))) => ((3 1 (3 8) 2) (2 4 1 (4 3) 6 9 (8 7)) (2 1 (5 4) 5)) 

Notes

@ Melye77 destructuring-bind expression does the same as [Head|Tail] = List in Prolog. I could write this instead

 (let ((head (first list)) (tail (rest list))) ...) 

Similarly, I prefer to use the (e)typecase over the generic cond whenever possible, because I think it is more accurate.

I could write:

 (if acc (if (listp (first list)) (nconc ...) (reverse-consecutive ...)) acc) 

... but I think it’s less clear and it’s not very good to educate beginners. On the contrary, I find it useful even (especially) for beginners to present the whole range of available designs. For example, the excessive use of recursive functions is not really recommended: there are many existing iteration constructs for sequences that do not depend on the availability of tail call optimizations (which are not guaranteed to be implemented, although they are usually available with corresponding declarations).

Iterative version

Here is an iterative version that uses the standard reverse and nreverse . Contrary to the method described above, the internal lists simply change to the opposite (continuous pieces are found only at the first level of depth):

 (defun reverse-consecutive (list) (let (stack result) (dolist (e list (nreverse result)) (typecase e (list (dolist (s stack) (push s result)) (push (reverse e) result) (setf stack nil)) (t (push e stack)))))) 

Answer 2

There is already an accepted answer , but this seems like a fun task. I tried to distract some of the details a bit and created a map-contig function that calls a function with each continuous list of the input list and determines that the continuous list has passed through the predicate.

 (defun map-contig (function predicate list) "Returns a new list obtained by calling FUNCTION on each sublist of LIST consisting of monotonically non-decreasing elements, as determined by PREDICATE. FUNCTION should return a list." ;; Initialize an empty RESULT, loop until LIST is empty (we'll be ;; popping elements off of it), and finally return the reversed RESULT ;; (since we'll build it in reverse order). (do ((result '())) ((endp list) (nreverse result)) (if (listp (first list)) ;; If the first element is a list, then call MAP-CONTIG on it ;; and push the result into RESULTS. (push (map-contig function predicate (pop list)) result) ;; Otherwise, build up sublist (in reverse order) of contiguous ;; elements. The sublist is finished when either: (i) LIST is ;; empty; (ii) another list is encountered; or (iii) the next ;; element in LIST is non-contiguous. Once the sublist is ;; complete, reverse it (since it in reverse order), call ;; FUNCTION on it, and add the resulting elements, in reverse ;; order, to RESULTS. (do ((sub (list (pop list)) (list* (pop list) sub))) ((or (endp list) (listp (first list)) (not (funcall predicate (first sub) (first list)))) (setf result (nreconc (funcall function (nreverse sub)) result))))))) 

Here is your original example:

 (map-contig 'reverse '< '(1 2 (4 5) 5)) ;=> (2 1 (5 4) 5) 

It is worth noting that this will detect gaps within one sub-list. For example, if we need only continuous sequences of integers (for example, where each subsequent difference is equal to one), we can do this with a special predicate:

 (map-contig 'reverse (lambda (xy) (eql y (1+ x))) '(1 2 3 5 6 8 9 10)) ;=> (3 2 1 6 5 10 9 8) 

If you only want to break when a sublist appears, you can simply use a predicate that always returns true:

 (map-contig 'reverse (constantly t) '(1 2 5 (4 5) 6 8 9 10)) ;=> (5 2 1 (5 4) 10 9 8 6) 

Here is another example where “adjacent” means “has the same sign,” and instead of reversing adjacent sequences, we sort them:

 ;; Contiguous elements are those with the same sign (-1, 0, 1), ;; and the function to apply is SORT (with predicate <). (map-contig (lambda (l) (sort l '<)) (lambda (xy) (eql (signum x) (signum y))) '(-1 -4 -2 5 7 2 (-6 7) -2 -5)) ;=> (-4 -2 -1 2 5 7 (-6 7) -5 -2) 

More prologue approach

 (defun reverse-contig (list) (labels ((reverse-until (list accumulator) "Returns a list of two elements. The first element is the reversed portion of the first section of the list. The second element is the tail of the list after the initial portion of the list. For example: (reverse-until '(1 2 3 (4 5) 6 7 8)) ;=> ((3 2 1) ((4 5) 6 7 8))" (if (or (endp list) (listp (first list))) (list accumulator list) (reverse-until (rest list) (list* (first list) accumulator))))) (cond ;; If LIST is empty, return the empty list. ((endp list) '()) ;; If the first element of LIST is a list, then REVERSE-CONTIG it, ;; REVERSE-CONTIG the rest of LIST, and put them back together. ((listp (first list)) (list* (reverse-contig (first list)) (reverse-contig (rest list)))) ;; Otherwise, call REVERSE-UNTIL on LIST to get the reversed ;; initial portion and the tail after it. Combine the initial ;; portion with the REVERSE-CONTIG of the tail. (t (let* ((parts (reverse-until list '())) (head (first parts)) (tail (second parts))) (nconc head (reverse-contig tail))))))) 

 (reverse-contig '(1 2 3 (4 5) 6 7 8)) ;=> (3 2 1 (5 4) 8 7 6) 

 (reverse-contig '(1 3 (4) 6 7 nil 8 9)) ;=> (3 1 (4) 7 6 nil 9 8) 

Just two notes about this. Firstly, the list * is very similar to cons , in this (list * 'a' (bcd)) returns (abcd) . list ** can take more arguments (e.g. ** (list * 'a' b '(cde)) returns (abcde) ) and, in my opinion, it makes the intent of lists (unlike arbitrary cons-cells) a little more clear. Secondly, another answer explains the use of destructuring-bind ; this approach may be a little shorter if

 (let* ((parts (reverse-until list '())) (head (first parts)) (tail (second parts))) 

were replaced by

 (destructuring-bind (head tail) (reverse-until list '())