> > I would like to submit a recipe to the lisp cookbook (http://cl-
> > cookbook.sourceforge.net/). So before poisoning the unsuspected, I
> > thought that the expert tasters could inspect this for obvious
> > errors.
> >
> > The routine parses a sorted list and returns a list of duplicates.
> > Thus, for the following list
> > (-1 0 0 1 1 2 3 3 3 4 5 8 9 9 10 11 11)
> > the routine returns
> > ((0 0) (1 1) (3 3 3) (9 9) (11 11)
> >
> > What follows is a simplified version:
> >
> > (defun collect-repeats-simple (sorted-list)
> > (loop
> > with repeats = nil
> > and acc = nil
> > for a in sorted-list
> > for b in (cdr sorted-list)
> >
> > when (and (not repeats)
> > (equal a b))
> > do (progn
> > (setf acc (list a b))
> > (setf repeats t))
> >
> > else
> > when repeats
> > when (equal a b)
> > do (push b acc)
> > else
> > collect acc into result and
> > do (progn
> > (setf acc nil)
> > (setf repeats nil))
> >
> > finally (print (if acc (append result (list acc))
> > result))))
> >
> >
> > A more complete version would allow for the key and test keywords. My
> > version of the defun is:
> > (defun collect-repeats (sorted-list &key (key #'(lambda (arg) arg))
> > (test #'equal))
> > (Is there a more concise way to specify the default key?)
>
> (lambda (arg) arg) is identity is Common Lisp.
>
> However, I don't understand why everybody here seems to be so obsessed
> with loop solutions full of non-functional setf's that have so many
> lines that they don't fit on my screen while elegant recursive
> solutions exist? Is it because Paul Graham's "ANSI Common Lisp" was my
> first book that I don't like loops and do like recursion?
>
> (defun collect-repeats-simple (sorted-list &optional (acc nil))
> (cond
> ((null sorted-list)
> (remove-if (lambda (l)
> (null (cdr l))) (reverse acc)))
> ((equal (car sorted-list)
> (caar acc))
> (push (car sorted-list) (car acc))
> (collect-repeats-simple (cdr sorted-list) acc))
> (t (collect-repeats-simple (cdr sorted-list)
> (cons (list (car sorted-list)) acc)))))

Gauche Scheme:

(define (repeats sorted)
(let ((tmp '()) (res '()))
(define (accept)
(when (pair? (cdr tmp)) (push! res tmp))
(set! tmp '()))
(dolist (x sorted)
(when (and (pair? tmp) (not (equal? x (car tmp))))
(accept))
(push! tmp x))
(accept)
(reverse res)))

(repeats '(x a a b b 0 c c))
===>
((a a) (b b) (c c))