Re: tasters wanted

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!

Testing:

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

Gauche Scheme

(use gauche.collection) ;; fold2

(define (monotonic the-list :key (test equal?))
  (receive (tmp result)
    (fold2
      (^(x tmp result)
        (if (or (null? tmp) (test x (car tmp)))
          (values (cons x tmp) result)
          (values (list x) (cons tmp result))))
      '() '()
      the-list)
    (reverse (map reverse
      (if (pair? tmp) (cons tmp result) result)))))

(monotonic '(0 2 3 4 0 5 7 9 6) :test >)
  ===>
((0 2 3 4) (0 5 7 9) (6))

(define (collect-repeats sorted-list :key (test equal?))
  (remove (^x (null? (cdr x)))
    (monotonic sorted-list :test test)))

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

(collect-repeats '(2 2 3 4 5 5 7 8 8 9))
  ===>
((2 2) (5 5) (8 8))