Idiomatic way to group a sorted list of integers?

Question

I have a sorted list of integers, (1 2 4 5 6 6 7 8 10 10 10). I want to group them all, so that I get ((1) (2) (4) (5) (6 6) (7) (8) (10 10 10)).

So far I have this, which works:

(let ((current-group (list)) (groups (list)))
  (dolist (n *sorted*)
    (when (and (not (null current-group)) (not (eql (first current-group) n)))
      (push current-group groups)
      (setf current-group (list)))
    (push n current-group))
  (push current-group groups)
  (nreverse groups))

But I'm sure there must be a much more LISPy way to do this. Any ideas?

Answer 1

There's already an accepted answer, but I think it's worth looking at another way of decomposing this problem, although the approach here is essentially the same). First, let's define cut that takes a list and a predicate, and returns the prefix and suffix of the list, where the suffix begins with the first element of the list that satisfies the predicate, and the prefix is everything before that that didn't:

(defun cut (list predicate)
  "Returns two values: the prefix of the list 
containing elements that do no satisfy predicate,
and the suffix beginning with an element that 
satisfies predicate."
  (do ((tail list (rest tail))
       (prefix '() (list* (first tail) prefix)))
      ((or (funcall predicate (first tail))
           (endp tail))
       (values (nreverse prefix) tail))))

(cut '(1 1 1 2 2 3 3 4 5) 'evenp)
;=> (1 1 1) (2 2 3 3 4 5)

(let ((l '(1 1 2 3 4 4 3)))
  (cut l (lambda (x) (not (eql x (first l))))))
;=> (1 1), (2 3 4 4 3)

Then, using cut, we can move down the an input list taking prefixes and suffixes with a predicate that's checking whether an element is not eql to the first element of the list. That is, beginning with (1 1 1 2 3 3) you'd cut with the predicate checking for "not eql to 1", to get (1 1 1) and (2 3 3). You'd add the first to the list of groups, and the second becomes the new tail.

(defun group (list)
  (do ((group '())                           ; group's initial value doesn't get used
       (results '() (list* group results)))  ; empty, but add a group at each iteration
      ((endp list) (nreverse results))       ; return (reversed) results when list is gone
    (multiple-value-setq (group list)        ; update group and list with the prefix
      (cut list                              ; and suffix from cutting list on the 
           (lambda (x)                       ; predicate "not eql to (first list)".
             (not (eql x (first list))))))))

(group '(1 1 2 3 3 3))
;=> ((1 1) (2) (3 3 3))

On implementing cut

I tried to make that cut relatively efficient, insofar as it only makes one pass through the list. Since member returns the entire tail of the list that begins with the found element, you can actually use member with :test-not to get the tail that you want:

(let ((list '(1 1 1 2 2 3)))
  (member (first list) list :test-not 'eql))
;=> (2 2 3)

Then, you can use ldiff to return the prefix that comes before that tail:

(let* ((list '(1 1 1 2 2 3))
       (tail (member (first list) list :test-not 'eql)))
  (ldiff list tail))
;=> (1 1 1)

It's a simple matter, then, to combine the approaches and to return the tail and the prefix as multiples values. This gives a version of cut that takes only the list as an argument, and might be easier to understand (but it's a bit less efficient).

(defun cut (list)
  (let ((tail (member (first list) list :test-not 'eql)))
    (values (ldiff list tail) tail)))

(cut '(1 1 2 2 2 3 3 3))
;=> (1 1), (2 2 2 3 3)

Answer 2

Not that bad. I would write it this way:

(defun group (list)
  (flet ((take-same (item)
           (loop while (and list (eql (first list) item))
                 collect (pop list))))
    (loop while list
          collect (take-same (first list)))))


CL-USER 1 > (group '(1 2 4 5 6 6 7 8 10 10 10))
((1) (2) (4) (5) (6 6) (7) (8) (10 10 10))

Answer 3

I like to use reduce:

(defun group (lst)
  (nreverse
   (reduce (lambda (r e) (if (and (not (null r)) (eql e (caar r)))
                           (cons (cons e (car r)) (cdr r))
                           (cons (list e) r)))
           lst
           :initial-value nil)))

or using push:

(defun group (lst)
  (nreverse
   (reduce (lambda (r e) 
             (cond 
              ((and (not (null r)) (eql e (caar r))) (push e (car r)) r)
              (t (push (list e) r))))
           lst
           :initial-value nil)))