From Newsgroup: comp.lang.lisp

B. Pym wrote:

B. Pym wrote:

Ken Tilton wrote:

Ooh! Ooh! Lemme try again!

(defun collect-repeats-simple (sorted-list &key (test 'eql))
(loop with acc and tail
for a in sorted-list
for b in (cdr sorted-list)

if (funcall test a b)
if acc do (setf tail (rplacd tail (list b)))
else do (setf acc (list* a (setf tail (list b))))
else when acc collect acc into result
and do (setf acc nil)

finally (return (nconc result
(when acc (list acc))))))

God I love rplaca/d!

His definition is buggy.

(collect-repeats-simple '(4 5 5 5 5 5 5 5 8 8))
===>
((5 5 5) (8 8))

Gauche Scheme

(use srfi-1) ;; span

(define (collect-repeats sorted-list)
(if (null? sorted-list)
()
(let1 this (car sorted-list)
(receive (these those)
(span (cut equal? <> this) sorted-list)
(if (null? (cdr these))
(collect-repeats those)
(cons these (collect-repeats those)))))))

(collect-repeats '(0 0 2 4 5 5 5 5 5 5 5 8 8))
===>
((0 0) (5 5 5 5 5 5 5) (8 8))

Without using "span":

(define (collect-repeats sorted-list)
(define (need-new-group x accum)
(or (null? accum)
(not (equal? x (caar accum)))))
(define (foo x accum)
(if (need-new-group x accum)
(cons (list x) accum)
`((,x ,@(car accum)) ,@(cdr accum))))
(reverse
(remove (lambda(x) (null? (cdr x)))
(fold foo '() sorted-list))))



--- Synchronet 3.21d-Linux NewsLink 1.2