Rocksolid Light

News from da outaworlds

mail  files  register  groups  login

Message-ID:  

BOFH excuse #315: The recent proliferation of Nuclear Testing

comp / comp.lang.lisp / Re: tasters wanted

SubjectAuthor
* Re: tasters wantedB. Pym
+* Re: tasters wantedB. Pym
|`* Re: tasters wantedB. Pym
| `* Re: tasters wantedB. Pym
|  +* Re: tasters wantedB. Pym
|  |`- Re: tasters wantedKaz Kylheku
|  `* Re: tasters wantedB. Pym
|   `- Re: tasters wantedJeff Barnett
`- Re: tasters wantedKaz Kylheku

1
Subject: Re: tasters wanted
From: B. Pym
Newsgroups: comp.lang.lisp
Organization: A noiseless patient Spider
Date: Thu, 18 Jul 2024 17:55 UTC
Path: eternal-september.org!news.eternal-september.org!.POSTED!not-for-mail
From: Nobody447095@here-nor-there.org (B. Pym)
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=
View all headers

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

Subject: Re: tasters wanted
From: B. Pym
Newsgroups: comp.lang.lisp
Organization: A noiseless patient Spider
Date: Thu, 18 Jul 2024 21:59 UTC
References: 1
Path: eternal-september.org!news.eternal-september.org!.POSTED!not-for-mail
From: Nobody447095@here-nor-there.org (B. Pym)
Newsgroups: comp.lang.lisp
Subject: Re: tasters wanted
Date: Thu, 18 Jul 2024 21:59:42 -0000 (UTC)
Organization: A noiseless patient Spider
Lines: 28
Message-ID: <v7c38d$2jti1$1@dont-email.me>
References: <v7bkuk$2hcim$1@dont-email.me>
MIME-Version: 1.0
Content-Type: text/plain; charset=iso-8859-1
Injection-Date: Thu, 18 Jul 2024 23:59:42 +0200 (CEST)
Injection-Info: dont-email.me; posting-host="e3005d10dbae2efb5a40377df304e982";
logging-data="2750017"; mail-complaints-to="abuse@eternal-september.org"; posting-account="U2FsdGVkX183Smuxv43YFjaPqLxa9wBN"
User-Agent: XanaNews/1.18.1.6
Cancel-Lock: sha1:tFiGALpkxMuuxPcQDiOaif92x6s=
View all headers

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

Subject: Re: tasters wanted
From: Kaz Kylheku
Newsgroups: comp.lang.lisp
Organization: A noiseless patient Spider
Date: Fri, 19 Jul 2024 17:09 UTC
References: 1
Path: eternal-september.org!news.eternal-september.org!.POSTED!not-for-mail
From: 643-408-1753@kylheku.com (Kaz Kylheku)
Newsgroups: comp.lang.lisp
Subject: Re: tasters wanted
Date: Fri, 19 Jul 2024 17:09:21 -0000 (UTC)
Organization: A noiseless patient Spider
Lines: 49
Message-ID: <20240719100337.314@kylheku.com>
References: <v7bkuk$2hcim$1@dont-email.me>
Injection-Date: Fri, 19 Jul 2024 19:09:21 +0200 (CEST)
Injection-Info: dont-email.me; posting-host="329fa895c5d6908477a80b789f62a073";
logging-data="3237795"; mail-complaints-to="abuse@eternal-september.org"; posting-account="U2FsdGVkX1/Whw7vXr4gbdiGUsWEClU9ATYVvzgiZR0="
User-Agent: slrn/pre1.0.4-9 (Linux)
Cancel-Lock: sha1:HIenfFM7WqlVzxVsGhevf831VYk=
View all headers

On 2024-07-18, B. Pym <Nobody447095@here-nor-there.org> wrote:
> 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))

This is the TXR Lisp interactive listener of TXR 294.
Quit with :quit or Ctrl-D on an empty line. Ctrl-X ? for cheatsheet.
If you get your macros hot enough, you get syntactic caramel!
1> [partition-by identity '(2 2 3 4 5 5 7 8 8 9)]
((2 2) (3) (4) (5 5) (7) (8 8) (9))
2> (remove-if (opip len (eq 1))
[partition-by identity '(2 2 3 4 5 5 7 8 8 9)])
((2 2) (5 5) (8 8))
3> (keep-if [chain len pred plusp]
[partition-by identity '(2 2 3 4 5 5 7 8 8 9)])
((2 2) (5 5) (8 8))

--
TXR Programming Language: http://nongnu.org/txr
Cygnal: Cygwin Native Application Library: http://kylheku.com/cygnal
Mastodon: @Kazinator@mstdn.ca

Subject: Re: tasters wanted
From: B. Pym
Newsgroups: comp.lang.lisp
Organization: A noiseless patient Spider
Date: Thu, 15 Aug 2024 02:26 UTC
References: 1 2
Path: eternal-september.org!news.eternal-september.org!.POSTED!not-for-mail
From: Nobody447095@here-nor-there.org (B. Pym)
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=
View all headers

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

Subject: Re: tasters wanted
From: B. Pym
Newsgroups: comp.lang.lisp
Organization: A noiseless patient Spider
Date: Thu, 15 Aug 2024 06:11 UTC
References: 1 2 3
Path: eternal-september.org!news.eternal-september.org!.POSTED!not-for-mail
From: Nobody447095@here-nor-there.org (B. Pym)
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=
View all headers

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

Subject: Re: tasters wanted
From: B. Pym
Newsgroups: comp.lang.lisp
Organization: A noiseless patient Spider
Date: Thu, 15 Aug 2024 18:41 UTC
References: 1 2 3 4
Path: eternal-september.org!news.eternal-september.org!.POSTED!not-for-mail
From: Nobody447095@here-nor-there.org (B. Pym)
Newsgroups: comp.lang.lisp
Subject: Re: tasters wanted
Date: Thu, 15 Aug 2024 18:41:04 -0000 (UTC)
Organization: A noiseless patient Spider
Lines: 78
Message-ID: <v9li3s$1285c$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: Thu, 15 Aug 2024 20:41:04 +0200 (CEST)
Injection-Info: dont-email.me; posting-host="8dad861bfe843a3d57c9af5848302e29";
logging-data="1122476"; mail-complaints-to="abuse@eternal-september.org"; posting-account="U2FsdGVkX1/ZQbquj+O5F0zy7y/cnhod"
User-Agent: XanaNews/1.18.1.6
Cancel-Lock: sha1:pkLJByVNmNBL+rTW7maVvClmlj8=
View all headers

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

Gauche Scheme

(use srfi-1) ;; span

(define (collect-repeats sorted)
(let1 accum '()
(while (pair? sorted)
(receive (taken rejected)
(span (cut equal? <> (car sorted)) sorted)
(and (pair? (cdr taken)) (push! accum taken))
(set! sorted rejected)))
(reverse accum)))

Subject: Re: tasters wanted
From: Kaz Kylheku
Newsgroups: comp.lang.lisp
Organization: A noiseless patient Spider
Date: Thu, 15 Aug 2024 20:19 UTC
References: 1 2 3 4 5
Path: eternal-september.org!news.eternal-september.org!.POSTED!not-for-mail
From: 643-408-1753@kylheku.com (Kaz Kylheku)
Newsgroups: comp.lang.lisp
Subject: Re: tasters wanted
Date: Thu, 15 Aug 2024 20:19:40 -0000 (UTC)
Organization: A noiseless patient Spider
Lines: 95
Message-ID: <20240815131441.142@kylheku.com>
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>
<v9li3s$1285c$1@dont-email.me>
Injection-Date: Thu, 15 Aug 2024 22:19:40 +0200 (CEST)
Injection-Info: dont-email.me; posting-host="b4c6df34be59dc862712455049efdae8";
logging-data="1148457"; mail-complaints-to="abuse@eternal-september.org"; posting-account="U2FsdGVkX1/eEj1rhB1xfQ3/vPLZmIBnPd1UV19S1I4="
User-Agent: slrn/pre1.0.4-9 (Linux)
Cancel-Lock: sha1:e4ujwDlnR1zyN4H27NyQG3jbndw=
View all headers

On 2024-08-15, B. Pym <Nobody447095@here-nor-there.org> wrote:
> 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)))
>
> Gauche Scheme
>
> (use srfi-1) ;; span
>
> (define (collect-repeats sorted)
> (let1 accum '()
> (while (pair? sorted)
> (receive (taken rejected)
> (span (cut equal? <> (car sorted)) sorted)
> (and (pair? (cdr taken)) (push! accum taken))
> (set! sorted rejected)))
> (reverse accum)))

I don't feel that all your squirmy wiggling above is improving on:

1> (keep-if [chain len pred plusp]
[partition-by identity '(2 4 4 0 5 5 5 5 8 8 8 6)])
((4 4) (5 5 5 5) (8 8 8))
2> (keep-if [chain len pred plusp]
[partition-by identity '(4 4 0 5 5 5 5 8 8 8)])
((4 4) (5 5 5 5) (8 8 8))

that I already posted elsethread.

--
TXR Programming Language: http://nongnu.org/txr
Cygnal: Cygwin Native Application Library: http://kylheku.com/cygnal
Mastodon: @Kazinator@mstdn.ca

Subject: Re: tasters wanted
From: B. Pym
Newsgroups: comp.lang.lisp
Organization: A noiseless patient Spider
Date: Sat, 17 Aug 2024 18:24 UTC
References: 1 2 3 4
Path: eternal-september.org!news.eternal-september.org!.POSTED!not-for-mail
From: Nobody447095@here-nor-there.org (B. Pym)
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=
View all headers

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

Subject: Re: tasters wanted
From: Jeff Barnett
Newsgroups: comp.lang.lisp
Organization: A noiseless patient Spider
Date: Sun, 18 Aug 2024 05:19 UTC
References: 1 2 3 4 5
Path: eternal-september.org!news.eternal-september.org!.POSTED!not-for-mail
From: jbb@notatt.com (Jeff Barnett)
Newsgroups: comp.lang.lisp
Subject: Re: tasters wanted
Date: Sat, 17 Aug 2024 23:19:28 -0600
Organization: A noiseless patient Spider
Lines: 35
Message-ID: <v9s092$2996i$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>
<v9qpth$20hhm$1@dont-email.me>
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8; format=flowed
Content-Transfer-Encoding: 7bit
Injection-Date: Sun, 18 Aug 2024 07:19:30 +0200 (CEST)
Injection-Info: dont-email.me; posting-host="e83f565442c57ba8a0f2e764ec9a33b0";
logging-data="2401490"; mail-complaints-to="abuse@eternal-september.org"; posting-account="U2FsdGVkX18jcroIEAtuxv9il/XPoGcA9NW/BuwvBXI="
User-Agent: Mozilla Thunderbird
Cancel-Lock: sha1:8wz4UopuSHkptzpx8VWa8V+DY3U=
X-Antivirus-Status: Clean
In-Reply-To: <v9qpth$20hhm$1@dont-email.me>
Content-Language: en-US
X-Antivirus: AVG (VPS 240817-12, 8/17/2024), Outbound message
View all headers

On 8/17/2024 12:24 PM, B. Pym wrote:
> B. Pym wrote:
<SNIP SNIP>
>>
>> (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)))

Shorter!!!!!!! Shorter because you moved the and clause embedded in the
collect clause into the same line as the collect operator. Good work.

I take from your recent barrage of similarly helpful postings that you
are once again between employers. It's probably good to keep in shape
doing all these coding exercises.
--
Jeff Barnett

1

rocksolid light 0.9.8
clearnet tor