Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Lisp reversing all continuous sequences of elements

I want to reverse only the continuous sequences, not all the elements of my original 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 of splitting it into 2 functions: one to reverse a simple list ( 1 2 3 ) -> ( 3 2 1 ) and one function (main) to determine the continuous sequences, make a list out of them, apply reverse on that list and the remake the whole reversed list.

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

This is the reverse function but I have no idea how to do the other one. I'm new to Lisp and I come from Prolog so it's a pretty big change of 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 ...
like image 909
Mocktheduck Avatar asked Nov 27 '15 00:11

Mocktheduck


2 Answers

You can perform all at once with a single recursive function, with the usual warning that you should favor looping 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))

Remarks

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

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

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

I could have written:

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

... but I think it is less clear and not a good thing to teach beginners. On the contrary, I think it is useful, even (especially) for beginners, to introduce the full range of available constructs. For example, overusing recursive functions is actually not recommended: there are plenty of existing iteration constructs for sequences that do not depend on the availability of tail-call optimizations (which are not guaranteed to be implemented, though it is generally available with appropriate declarations).

Iterative version

Here is an iterative version which uses of the standard reverse and nreverse functions. Contrary to the above method, inner lists are simply reversed (contiguous chunks are only detected 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))))))
like image 23
coredump Avatar answered Sep 19 '22 09:09

coredump


There's already an accepted answer, but this seems like a fun challenge. I've tried to abstract some of the details away a bit, and produced a map-contig function that calls a function with each contiguous sublist of the input list, and determines what's a contiguous list via a predicate that's passed in.

(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's 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's your original example:

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

It's worth noting that this will detect discontinuities within a single sublist. For instance, if we only want continuous sequences of integers (e.g., where each successive difference is one), we can do that with a special predicate:

(map-contig 'reverse (lambda (x y) (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 occurs, you can just 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's another example where "contiguous" means "has the same sign", and instead of reversing the contiguous 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 (x y)
              (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)

A more Prolog-ish 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. First, list* is very much like cons, in that (list* 'a '(b c d)) returns (a b c d). list** can take more arguments though (e.g., **(list* 'a 'b '(c d e)) returns (a b c d e)), and, in my opinion, it makes the intent of lists (as opposed to arbitrary cons-cells) a bit clearer. Second, the other answer explained the use of destructuring-bind; this approach could be a little bit shorter if

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

were replaced with

(destructuring-bind (head tail) (reverse-until list '())
like image 136
Joshua Taylor Avatar answered Sep 22 '22 09:09

Joshua Taylor