Path: ...!news.nobody.at!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 02:26:01 -0000 (UTC)
Organization: A noiseless patient Spider
Lines: 50
Message-ID: <v9jovo$q7cm$1@dont-email.me>
References: <v7bkuk$2hcim$1@dont-email.me> <v7c38d$2jti1$1@dont-email.me>
MIME-Version: 1.0
Content-Type: text/plain; charset=iso-8859-1
Injection-Date: Thu, 15 Aug 2024 04:26:02 +0200 (CEST)
Injection-Info: dont-email.me; posting-host="7e5ecf5f7253603983f636ec904f7241";
	logging-data="859542"; mail-complaints-to="abuse@eternal-september.org";	posting-account="U2FsdGVkX1/J5k1xyR3zjnbxebzTEqvJ"
User-Agent: XanaNews/1.18.1.6
Cancel-Lock: sha1:PK9CqEzsV+G5krP3jmcAsR72e7Q=
Bytes: 2205

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