Path: ...!eternal-september.org!feeder3.eternal-september.org!news.eternal-september.org!.POSTED!not-for-mail
From: "B. Pym" <Nobody447095@here-nor-there.org>
Newsgroups: comp.lang.lisp
Subject: Re: tasters wanted
Date: Thu, 18 Jul 2024 17:55:36 -0000 (UTC)
Organization: A noiseless patient Spider
Lines: 57
Message-ID: <v7bkuk$2hcim$1@dont-email.me>
MIME-Version: 1.0
Content-Type: text/plain; charset=iso-8859-1
Injection-Date: Thu, 18 Jul 2024 19:55:37 +0200 (CEST)
Injection-Info: dont-email.me; posting-host="3a24c25a980f7b3f5878d5aa73c34d1d";
	logging-data="2667094"; mail-complaints-to="abuse@eternal-september.org";	posting-account="U2FsdGVkX19DWItVO+EItuVPD56502uz"
User-Agent: XanaNews/1.18.1.6
Cancel-Lock: sha1:gg65/gR559LWz4n3OLifoe864aA=
Bytes: 2249

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