Path: ...!weretis.net!feeder8.news.weretis.net!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, 15 Aug 2024 06:11:49 -0000 (UTC)
Organization: A noiseless patient Spider
Lines: 64
Message-ID: <v9k670$ru4a$1@dont-email.me>
References: <v7bkuk$2hcim$1@dont-email.me> <v7c38d$2jti1$1@dont-email.me> <v9jovo$q7cm$1@dont-email.me>
MIME-Version: 1.0
Content-Type: text/plain; charset=iso-8859-1
Injection-Date: Thu, 15 Aug 2024 08:11:49 +0200 (CEST)
Injection-Info: dont-email.me; posting-host="95218b5cbc8eab8eca4e48fbfb86126c";
	logging-data="915594"; mail-complaints-to="abuse@eternal-september.org";	posting-account="U2FsdGVkX1/h/aFZyZf+0GnTS8Br/0mL"
User-Agent: XanaNews/1.18.1.6
Cancel-Lock: sha1:cnx4NoyHs0B65+hyE68Xt1f6Cvc=
Bytes: 2680

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