Re: tasters wanted

B. Pym wrote:

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

 
newLISP
 
(define (collect-repeats sorted)
  (let (accum '()  tmp '()  a 0)
    (until (empty? (rest sorted))
      (setq a (pop sorted))
      (when (= a (sorted 0))
        (setq tmp (list a))
        (while (and sorted (= a (first sorted)))
          (push (pop sorted) tmp))
        (push tmp accum)))
    (reverse accum)))
 

(collect-repeats '(2 4 4 0 5 5 5 5 8 8 8 6))

((4 4) (5 5 5 5) (8 8 8))

(collect-repeats '( 4 4 0 5 5 5 5 8 8 8 ))

((4 4) (5 5 5 5) (8 8 8))
 

Shorter:

(define (collect-repeats sorted)
  (let (accum '()  tmp '()  a)
    (until (empty? sorted)
      (setq a (sorted 0))
      (setq tmp
        (collect
          (and (true? sorted) (= a (sorted 0)) (pop sorted))))
      (when (> (length tmp) 1) (push tmp accum)))
    (reverse accum)))