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: Sat, 17 Aug 2024 18:24:51 -0000 (UTC)
Organization: A noiseless patient Spider
Lines: 79
Message-ID: <v9qpth$20hhm$1@dont-email.me>
References: <v7bkuk$2hcim$1@dont-email.me> <v7c38d$2jti1$1@dont-email.me> <v9jovo$q7cm$1@dont-email.me> <v9k670$ru4a$1@dont-email.me>
MIME-Version: 1.0
Content-Type: text/plain; charset=iso-8859-1
Injection-Date: Sat, 17 Aug 2024 20:24:51 +0200 (CEST)
Injection-Info: dont-email.me; posting-host="e7865b2a2b4911949ad7b06e6acc9726";
	logging-data="2115126"; mail-complaints-to="abuse@eternal-september.org";	posting-account="U2FsdGVkX1+KMi+m9Fy2KdyRDLjC7Wx1"
User-Agent: XanaNews/1.18.1.6
Cancel-Lock: sha1:ypQC9/BXvvnSI6CvBTqQjOYXbUU=
Bytes: 3128

B. Pym wrote:

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

Shorter:


(define (collect-repeats sorted)
  (local (accum tmp a)
    (while sorted
      (setq a (sorted 0))
      (setq tmp
        (collect (and (true? sorted) (= a (sorted 0)) (pop sorted))))
      (and (1 tmp) (push tmp accum)))
    (reverse accum)))