Re: tasters wanted

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))))