24 views

Skip to first unread message

Feb 6, 2006, 3:52:12 PM2/6/06

to

Hi all,

Consider the problem of turning a list consisting

of a mix between symbols and non-symbols into a

list of lists of the symbol and its following

non-symbols. That is:

Input: ({<symbol> <non-symbol>*} ... )

Output: ((<symbol> (<non-symbol>*)) ...)

Example: (a 1 2 3 b 4 5 c d 8 9 e)

-> ((a (1 2 3)) (b (4 5)) (c ()) (d (8 9)) (e ()))

It is possible to do this in a variety of ways, but

I'd like to see an easy-to-read yet short solution.

--

Jens Axel Søgaard

Feb 6, 2006, 4:11:57 PM2/6/06

to

In article <43e7b6fc$0$38679$edfa...@dread12.news.tele.dk>,

Jens Axel Søgaard <use...@soegaard.net> wrote:

> Example: (a 1 2 3 b 4 5 c d 8 9 e)

> -> ((a (1 2 3)) (b (4 5)) (c ()) (d (8 9)) (e ()))

>

> It is possible to do this in a variety of ways, but

> I'd like to see an easy-to-read yet short solution.

Jens Axel Søgaard <use...@soegaard.net> wrote:

> Example: (a 1 2 3 b 4 5 c d 8 9 e)

> -> ((a (1 2 3)) (b (4 5)) (c ()) (d (8 9)) (e ()))

>

> It is possible to do this in a variety of ways, but

> I'd like to see an easy-to-read yet short solution.

You didn't specify what libraries could be used. If fold-right is

available, I think this is the most obvious solution:

(define (plist->alist plist)

(define (f item acc)

(let ((curr (car acc))

(full (cadr acc)))

(if (symbol? item)

`(() ((,item ,curr) . ,full))

`((,item . ,curr) ,full))))

(cadr (fold-right f '(() ()) plist)))

Opinions may vary as to whether this is easy to read or short...

Lauri

Feb 6, 2006, 4:26:16 PM2/6/06

to

Lauri Alanko wrote:

> In article <43e7b6fc$0$38679$edfa...@dread12.news.tele.dk>,

> Jens Axel Søgaard <use...@soegaard.net> wrote:

>

>>Example: (a 1 2 3 b 4 5 c d 8 9 e)

>> -> ((a (1 2 3)) (b (4 5)) (c ()) (d (8 9)) (e ()))

>>

>>It is possible to do this in a variety of ways, but

>>I'd like to see an easy-to-read yet short solution.

>

> You didn't specify what libraries could be used.

> In article <43e7b6fc$0$38679$edfa...@dread12.news.tele.dk>,

> Jens Axel Søgaard <use...@soegaard.net> wrote:

>

>>Example: (a 1 2 3 b 4 5 c d 8 9 e)

>> -> ((a (1 2 3)) (b (4 5)) (c ()) (d (8 9)) (e ()))

>>

>>It is possible to do this in a variety of ways, but

>>I'd like to see an easy-to-read yet short solution.

>

> You didn't specify what libraries could be used.

All libraries allowed - the less work the better.

> If fold-right is

> available, I think this is the most obvious solution:

>

> (define (plist->alist plist)

> (define (f item acc)

> (let ((curr (car acc))

> (full (cadr acc)))

> (if (symbol? item)

> `(() ((,item ,curr) . ,full))

> `((,item . ,curr) ,full))))

> (cadr (fold-right f '(() ()) plist)))

>

> Opinions may vary as to whether this is easy to read or short...

I like it. Processing the list in reverse didn't even

cross my mind.

Still interested in more solutions.

--

Jens Axel Søgaard

Feb 6, 2006, 4:37:55 PM2/6/06

to

In article <43e7bef8$0$38626$edfa...@dread12.news.tele.dk>,

But then, since most likely someone somewhere has implemented this

already, I could just tell you to use it, and hence you get a zero

line solution. :)

But all right then, let's go mad with SRFI-1:

(define (plist->alist plist)

(if (null? plist)

'()

(let*-values (((sym rest) (car+cdr plist))

((ints tail) (span number? rest)))

`((,sym ,ints) . ,(plist->alist tail)))))

Of course it assumes that the input is well-formed, i.e. consists only

of numbers and symbols and begins with a symbol.

Lauri

Feb 6, 2006, 4:39:14 PM2/6/06

to

=?ISO-8859-1?Q?Jens_Axel_S=F8gaard?= <use...@soegaard.net> writes:

>Lauri Alanko wrote:

>Still interested in more solutions.

>Lauri Alanko wrote:

>Still interested in more solutions.

Your criteria were short code and readable, not efficient, so how about

this one:

(define (p->a plist)

(if (null? plist)

'()

(cons (cons (car plist) (nonsymbols (cdr plist)))

(p->a (flush-nonsymbols (cdr plist))))))

(define (nonsymbols seq)

(cond ((null? seq) '())

((symbol? (car seq)) '())

(else (cons (car seq) (nonsymbols (cdr seq))))))

(define (flush-nonsymbols seq)

(cond ((null? seq) '())

((symbol? (car seq)) seq)

(else (flush-nonsymbols (cdr seq)))))

There ought to be a way to shorten the two helpers, though.

Feb 6, 2006, 4:56:06 PM2/6/06

to

Jens Axel Søgaard wrote:

> Still interested in more solutions.

Here is mine.

(define (plist->alist plist)

(define (->alist ls)

(if (pair? ls)

(let-values (((current done) (->alist (cdr ls))))

(if (symbol? (car ls))

(values '() (cons (list (car ls) current) done))

(values (cons (car ls) current) done)))

(values '() '())))

(let-values (((ignored answer) (->alist plist)))

answer))

Before getting used to let-values, this would've been hard to read

for me, but now I find it easier than the other two posted. Also, it

creates only the pairs used in the final solution.

If you don't like VALUES, the following works too:

(define (plist->alist plist)

(define (->alist ls)

(if (pair? ls)

(let ((current+done (->alist (cdr ls))))

(let ((current (car current+done))

(done (cdr current+done)))

(if (symbol? (car ls))

(cons '() (cons (list (car ls) current) done))

(cons (cons (car ls) current) done))))

'(() . ())))

(cdr (->alist plist)))

-ggem

Feb 6, 2006, 5:00:09 PM2/6/06

to

Lauri Alanko wrote:

> (define (plist->alist plist)

> (if (null? plist)

> '()

> (let*-values (((sym rest) (car+cdr plist))

> ((ints tail) (span number? rest)))

> `((,sym ,ints) . ,(plist->alist tail)))))

I like this one better.

-ggem.

Feb 6, 2006, 5:48:52 PM2/6/06

to

Well, although I much prefer Brian Harvey's modular one, here's what I

would've done myself:

(define (p->a L)

(define (internal L builder)

(if (not (pair? L))

(list (reverse builder))

(let ([L-car (car L)]

[L-cdr (cdr L)])

(if (symbol? L-car)

(cons (reverse builder)

(internal L-cdr (list L-car)))

(internal L-cdr (cons L-car builder))))))

(cdr (internal L (list))))

(a->p '(a 1 2 3 4 5 b 4 5)) ; => ((a 1 2 3 4 5) (b 4 5))

It was funny to see that I encountered the same problem as ggem

(needing to return the 'cdr' of the internal function, instead of the

result itself).

- Jérémie

Feb 6, 2006, 6:43:06 PM2/6/06

to

No libraries, no SRFI-s, just R5RS :-)

(define (p->a l k)

(if (null? l)

(k '() '())

(p->a (cdr l) (lambda (g r)

(if (symbol? (car l))

(k '() (cons (list (car l) g) r))

(k (cons (car l) g) r))))))

(p->a '(a 1 2 3 b 4 5 c d 8 9 e) (lambda (a b) b)) =>

((a (1 2 3)) (b (4 5)) (c ()) (d (8 9)) (e ()))

-- Hrvoje

Feb 7, 2006, 7:00:29 AM2/7/06

to

My solution is not very short, but I consider it to be quite readable. I

like short functions (Forth influence).

jan

;;;

(define (cons-true pred)

(lambda (a b)

(if (pred a) (cons a b) b)))

; return all the sublists of LST that satisfy predicate PRED

(define (pair-filter pred lst)

(pair-fold-right (cons-true pred) '() lst))

(define (car-symbol? lst)

(and (not (null? lst)) (symbol? (car lst))))

(define (symbol-sublists lst)

(pair-filter car-symbol? lst))

(define (not-symbol? x)

(not (symbol? x)))

(define (symbol-and-rest lst)

(list (car lst) (take-while not-symbol? (cdr lst))))

(define (plist->alist lst)

(map symbol-and-rest (symbol-sublists lst)))

;;;

Feb 7, 2006, 7:38:22 AM2/7/06

to

Hmm ... where do "take-while" and "pair-fold-right" come from?

- Jérémie

Feb 7, 2006, 7:45:31 AM2/7/06

to

Jérémie Lumbroso <jeremie....@gmail.com> wrote:

> Hmm ... where do "take-while" and "pair-fold-right" come from?

> Hmm ... where do "take-while" and "pair-fold-right" come from?

SRFI-1, like all good stuff.

Lauri

Feb 7, 2006, 10:14:30 AM2/7/06

to

The expression

(sublist-by-predicate

'(a 1 2 3 b 4 5 c d 8 9 e)

(lambda (cur prev n) (symbol? cur)))

returns

((a 1 2 3) (b 4 5) (c) (d 8 9) (e)) (*)

which is almost the desired result. sublist-by-predicate

is a function from the LAML general library.

It is trivial to obtain

((a (1 2 3)) (b (4 5)) (c ()) (d (8 9)) (e ()))

by mapping (lambda (e) (list (car e) (cdr e))) over the list (*).

For SchemeDoc documentation of sublist-by-predicate see

http://www.cs.aau.dk/~normark/scheme/lib/man/general.html#sublist-by-predicate

Click to the underlying source code via "See also Scheme source code" link.

I often find it worthwhile to generalize the problem before

actually solving it.

--

Kurt Nørmark Phone: +45 9635 8080

Department of Computer Science Direct phone: +45 9635 8896

Aalborg University Fax: +45 9815 9889

Fredrik Bajers Vej 7, Building E E-mail: nor...@cs.aau.dk

DK-9220 Aalborg Ø WWW: http://www.cs.aau.dk/~normark/

DENMARK Office: E4-208

Feb 7, 2006, 10:58:44 AM2/7/06

to

I feel I should throw my newbie-hat into the ring. Who can pass up an

educational opportunity like this, eh?

(define (plist->alist plist)

(if (not (pair? plist))

'()

(let ((split (split-at-symbol (cdr plist))))

(cons (cons (car plist) (list (car split)))

(plist->alist (cdr split))))))

(define (split-at-symbol seq)

(let loop ((values '())

(rest seq))

(if (or (not (pair? rest)) (symbol? (car rest)))

(cons (reverse values) rest)

(loop (cons (car rest) values) (cdr rest)))))

I'm happy with the main function, but it seems like there must be an

easier way to do split-at-symbol. I wish *I'd* thought of reversing

plist before doing any processing. Probably my function does *less*

reversing of pairs overall, but with more calls to reverse.

Instead of

(reverse '(a 1 2 3 b 3 4 c d e 8))

it does

(reverse '(3 2 1))

(reverse '(4 3))

(reverse '(8))

--

Neil Cerutti

The Pastor would appreciate it if the ladies of the congregation

would lend him their electric girdles for the pancake breakfast

next Sunday morning. --Church Bulletin Blooper

Feb 7, 2006, 11:11:56 AM2/7/06

to

In article <slrnduhgsr.1...@FIAD06.norwich.edu>,

Neil Cerutti <lead...@email.com> wrote:

> (define (split-at-symbol seq)

> (let loop ((values '())

> (rest seq))

> (if (or (not (pair? rest)) (symbol? (car rest)))

> (cons (reverse values) rest)

> (loop (cons (car rest) values) (cdr rest)))))

>

> I'm happy with the main function, but it seems like there must be an

> easier way to do split-at-symbol. I wish *I'd* thought of reversing

> plist before doing any processing. Probably my function does *less*

> reversing of pairs overall, but with more calls to reverse.

Neil Cerutti <lead...@email.com> wrote:

> (define (split-at-symbol seq)

> (let loop ((values '())

> (rest seq))

> (if (or (not (pair? rest)) (symbol? (car rest)))

> (cons (reverse values) rest)

> (loop (cons (car rest) values) (cdr rest)))))

>

> I'm happy with the main function, but it seems like there must be an

> easier way to do split-at-symbol. I wish *I'd* thought of reversing

> plist before doing any processing. Probably my function does *less*

> reversing of pairs overall, but with more calls to reverse.

You can implement this without any reversing, and, with multiple

return values, even without any extra consing.

(define (split-at-symbol l)

(if (or (null? l) (symbol? (car l)))

(values '() l)

(let-values (((vals rest) (split-at-symbol (cdr l))))

(values (cons (car l) vals) rest))))

This is not tail-recursive, though, and probably not more efficient,

either.

Lauri

Feb 7, 2006, 11:14:12 AM2/7/06

to

(define (partition ls)

(cond ((null? ls) '())

((null? (cdr ls)) (list ls))

(else

(let ((p (partition (cdr ls))))

(if (symbol? (cadr ls))

(cons (list (car ls)) p)

(cons (cons (car ls)

(car p))

(cdr p)))))))

Cheers

Andre

Feb 7, 2006, 11:58:37 AM2/7/06

to

On 2006-02-06, Hrvoje Blazevic <hrv...@despammed.com> wrote:

> Jens Axel Søgaard wrote:

>> Lauri Alanko wrote:

>>

>>> In article <43e7b6fc$0$38679$edfa...@dread12.news.tele.dk>,

>>> Jens Axel Søgaard <use...@soegaard.net> wrote:

>>>

>>>> Example: (a 1 2 3 b 4 5 c d 8 9 e)

>>>> -> ((a (1 2 3)) (b (4 5)) (c ()) (d (8 9)) (e ()))

>>>>

>>>> It is possible to do this in a variety of ways, but

>>>> I'd like to see an easy-to-read yet short solution.

>

> Jens Axel Søgaard wrote:

>> Lauri Alanko wrote:

>>

>>> In article <43e7b6fc$0$38679$edfa...@dread12.news.tele.dk>,

>>> Jens Axel Søgaard <use...@soegaard.net> wrote:

>>>

>>>> Example: (a 1 2 3 b 4 5 c d 8 9 e)

>>>> -> ((a (1 2 3)) (b (4 5)) (c ()) (d (8 9)) (e ()))

>>>>

>>>> It is possible to do this in a variety of ways, but

>>>> I'd like to see an easy-to-read yet short solution.

>

> No libraries, no SRFI-s, just R5RS :-)

>

> (define (p->a l k)

> (if (null? l)

> (k '() '())

> (p->a (cdr l) (lambda (g r)

> (if (symbol? (car l))

> (k '() (cons (list (car l) g) r))

> (k (cons (car l) g) r))))))

>

>

> (p->a '(a 1 2 3 b 4 5 c d 8 9 e) (lambda (a b) b)) =>

> ((a (1 2 3)) (b (4 5)) (c ()) (d (8 9)) (e ()))

>

> (define (p->a l k)

> (if (null? l)

> (k '() '())

> (p->a (cdr l) (lambda (g r)

> (if (symbol? (car l))

> (k '() (cons (list (car l) g) r))

> (k (cons (car l) g) r))))))

>

>

> (p->a '(a 1 2 3 b 4 5 c d 8 9 e) (lambda (a b) b)) =>

> ((a (1 2 3)) (b (4 5)) (c ()) (d (8 9)) (e ()))

No fair making it shorter by using short symbol names! ;-)

Seriously, if I figure out how that works I'll have learned

something today.

I'll call the internal procedures continueN, where N is the

environment for that continue.

0 (): (p->a '(a 1 b 2) seed) =>

1 (l (a 1 b 2)): (p->a '(1 b 2) continue1) =>

2 (l (1 b 2): (p->a '(b 2) continue2) =>

3 (l (b 2)): (p->a '(2) continue3) =>

4 (l (2): (p->a '() continue4) =>

5 (l (): (continue4 '() '()) =>

Now to unravel the continues, looking up the environment in the list

above.

(continue3 (2) '()) =>

(continue2 '() ((b (2)))) =>

(continue1 (1) ((b (2)))) =>

(seed '() ((a (1)) (b (2)))) =>

((a (1)) (b (2)))

So the procedure argument you added is a way to work on the list

in reverse without reversing any list.

--

Neil Cerutti

A billion here, a billion there, sooner or later it adds up to

real money. --Everett Dirksen

Feb 7, 2006, 1:19:30 PM2/7/06

to

Neil Cerutti wrote:

> On 2006-02-06, Hrvoje Blazevic <hrv...@despammed.com> wrote:

>>(define (p->a l k)

>> (if (null? l)

>> (k '() '())

>> (p->a (cdr l) (lambda (g r)

>> (if (symbol? (car l))

>> (k '() (cons (list (car l) g) r))

>> (k (cons (car l) g) r))))))

>>

>>

>>(p->a '(a 1 2 3 b 4 5 c d 8 9 e) (lambda (a b) b)) =>

>>((a (1 2 3)) (b (4 5)) (c ()) (d (8 9)) (e ()))

>

>

> No fair making it shorter by using short symbol names! ;-)

> On 2006-02-06, Hrvoje Blazevic <hrv...@despammed.com> wrote:

>>(define (p->a l k)

>> (if (null? l)

>> (k '() '())

>> (p->a (cdr l) (lambda (g r)

>> (if (symbol? (car l))

>> (k '() (cons (list (car l) g) r))

>> (k (cons (car l) g) r))))))

>>

>>

>>(p->a '(a 1 2 3 b 4 5 c d 8 9 e) (lambda (a b) b)) =>

>>((a (1 2 3)) (b (4 5)) (c ()) (d (8 9)) (e ()))

>

>

> No fair making it shorter by using short symbol names! ;-)

Generally, you would be right... but, this is just one procedure, and it

does follow certain conventions:

l (or lst) is standardly used for list

k is almost always used for continuation

r is often used for result

g is sometimes (hmm, well I often use it) for group

and p->a was already used by another poster. What can I say--I'm lazy.

But seriously, it is quite common to use one letter names in functional

programming. Just have a look at Hugs prelude library... all x, y, ...

>

> Seriously, if I figure out how that works I'll have learned

> something today.

>

> I'll call the internal procedures continueN, where N is the

> environment for that continue.

>

> 0 (): (p->a '(a 1 b 2) seed) =>

> 1 (l (a 1 b 2)): (p->a '(1 b 2) continue1) =>

> 2 (l (1 b 2): (p->a '(b 2) continue2) =>

> 3 (l (b 2)): (p->a '(2) continue3) =>

> 4 (l (2): (p->a '() continue4) =>

> 5 (l (): (continue4 '() '()) =>

>

> Now to unravel the continues, looking up the environment in the list

> above.

>

> (continue3 (2) '()) =>

> (continue2 '() ((b (2)))) =>

> (continue1 (1) ((b (2)))) =>

> (seed '() ((a (1)) (b (2)))) =>

> ((a (1)) (b (2)))

>

> So the procedure argument you added is a way to work on the list

> in reverse without reversing any list.

>

Not really. In principle, nothing to do with reversing the list. Why

would you think that if you tackle the list from the end, you would have

to reverse the result. To the contrary, the opposite is very often the

case.

This style of programming is called CPS (for continuation passing

style), and reason for using it is often the desire to convert ordinary

recursive calls to tail calls (as is the case in this version of p->a).

The other reason might be to return multiple values from the function,

which is also the case here (in all the continuations that are built

during the recursion). The supplied continuation (lambda (a b) b))

serves only to strip the extra empty group.

This (2nd) reason is nicely explained in the 8th chapter of tLS, where

the authors call it "the collector function" (I think?)

BTW: I do not know if you noticed, but the difference between CPS p->a,

and several other solutions in this thread (those using values and

let-values) is only in the packaging. I used lambda while others used

macros that (somewhere down the line) use lambda...

-- Hrvoje

Feb 7, 2006, 2:06:47 PM2/7/06

to

Assuming valid non-null input:

(define (plist->alist plist)

(let loop ((p (cdr plist)) (s (car plist)) (x '()) (a '()))

(let ((z (cons (list s (reverse x)) a)))

(cond ((null? p) (reverse z))

((symbol? (car p)) (loop (cdr p) (car p) '() z))

(else (loop (cdr p) s (cons (car p) x) a))))))

Feb 7, 2006, 2:32:59 PM2/7/06

to

On 2006-02-07, Hrvoje Blazevic <hrv...@despammed.com> wrote:

> Neil Cerutti wrote:

>> On 2006-02-06, Hrvoje Blazevic <hrv...@despammed.com> wrote:

>>>(define (p->a l k)

>>> (if (null? l)

>>> (k '() '())

>>> (p->a (cdr l) (lambda (g r)

>>> (if (symbol? (car l))

>>> (k '() (cons (list (car l) g) r))

>>> (k (cons (car l) g) r))))))

>>>

>>>

>>>(p->a '(a 1 2 3 b 4 5 c d 8 9 e) (lambda (a b) b)) =>

>>>((a (1 2 3)) (b (4 5)) (c ()) (d (8 9)) (e ()))

> Neil Cerutti wrote:

>> On 2006-02-06, Hrvoje Blazevic <hrv...@despammed.com> wrote:

>>>(define (p->a l k)

>>> (if (null? l)

>>> (k '() '())

>>> (p->a (cdr l) (lambda (g r)

>>> (if (symbol? (car l))

>>> (k '() (cons (list (car l) g) r))

>>> (k (cons (car l) g) r))))))

>>>

>>>

>>>(p->a '(a 1 2 3 b 4 5 c d 8 9 e) (lambda (a b) b)) =>

>>>((a (1 2 3)) (b (4 5)) (c ()) (d (8 9)) (e ()))

>> Seriously, if I figure out how that works I'll have learned

>> something today.

>>

>> I'll call the internal procedures continueN, where N is the

>> environment for that continue.

>>

>> 0 (): (p->a '(a 1 b 2) seed) =>

>> 1 (l (a 1 b 2)): (p->a '(1 b 2) continue1) =>

>> 2 (l (1 b 2): (p->a '(b 2) continue2) =>

>> 3 (l (b 2)): (p->a '(2) continue3) =>

>> 4 (l (2): (p->a '() continue4) =>

>> 5 (l (): (continue4 '() '()) =>

>>

>> Now to unravel the continues, looking up the environment in the list

>> above.

>>

>> (continue3 (2) '()) =>

>> (continue2 '() ((b (2)))) =>

>> (continue1 (1) ((b (2)))) =>

>> (seed '() ((a (1)) (b (2)))) =>

>> ((a (1)) (b (2)))

>>

>> So the procedure argument you added is a way to work on the list

>> in reverse without reversing any list.

>>

>

> Not really. In principle, nothing to do with reversing the list. Why

> would you think that if you tackle the list from the end, you would have

> to reverse the result. To the contrary, the opposite is very often the

> case.

Thanks for the explanation.

The reason I though reversing was important was that,

working from front to back, my procedure would have come up with:

(p->a '(a 1 2 3 b 3 4)) => ((a (3 2 1)) (b (4 3)))

So I had to reverse the values.

If I understand you correctly, the values winding up stable was just a

side benefit of the continuation passing style.

> This (2nd) reason is nicely explained in the 8th chapter of tLS, where

> the authors call it "the collector function" (I think?)

What is tLS?

> BTW: I do not know if you noticed, but the difference between CPS

> p->a, and several other solutions in this thread (those using values

> and let-values) is only in the packaging. I used lambda while others

> used macros that (somewhere down the line) use lambda...

I hadn't noticed that. I am not yet familiar with macros or

let-values, so my eyes glazed over when I looked at them. I'm working

on learning macros. I had not heard of let-values until today.

--

Neil Cerutti

Will the highways on the Internet become more few? --George W.

Bush

Feb 7, 2006, 2:56:26 PM2/7/06

to

That has one of the same bugs I encountered, namely: misremembering

the spec.

(partition '(a 1 2 b 3 4)) => ((a 1 2) (b 3 4))

When it should be ((a (1 2)) (b (3 4))

The fix is trivial, of course.

--

Neil Cerutti

The peace-making meeting scheduled for today has been cancelled

due to a conflict. --Church Bulletin Blooper

Feb 7, 2006, 3:23:55 PM2/7/06

to

Neil Cerutti wrote:

>>>So the procedure argument you added is a way to work on the list

>>>in reverse without reversing any list.

>>>

>>

>>Not really. In principle, nothing to do with reversing the list. Why

>>would you think that if you tackle the list from the end, you would have

>>to reverse the result. To the contrary, the opposite is very often the

>>case.

>

>

> Thanks for the explanation.

>

> The reason I though reversing was important was that,

> working from front to back, my procedure would have come up with:

>

> (p->a '(a 1 2 3 b 3 4)) => ((a (3 2 1)) (b (4 3)))

>

> So I had to reverse the values.

>

> If I understand you correctly, the values winding up stable was just a

> side benefit of the continuation passing style.

>>>So the procedure argument you added is a way to work on the list

>>>in reverse without reversing any list.

>>>

>>

>>Not really. In principle, nothing to do with reversing the list. Why

>>would you think that if you tackle the list from the end, you would have

>>to reverse the result. To the contrary, the opposite is very often the

>>case.

>

>

> Thanks for the explanation.

>

> The reason I though reversing was important was that,

> working from front to back, my procedure would have come up with:

>

> (p->a '(a 1 2 3 b 3 4)) => ((a (3 2 1)) (b (4 3)))

>

> So I had to reverse the values.

>

> If I understand you correctly, the values winding up stable was just a

> side benefit of the continuation passing style.

No. Nothing to do with CPS. It is simply the result of working from the

end. Consing earlier removed element to the already consed elements that

came after it in the list. Remember--the first element consed, was the

last element of the list. The next one consed was the butlast element,

and so on. Therefore they all and up naturally in their right place.

Have a look at this (very ugly) version. It does not use CPS, and yet

reversing is obviously not needed.

(define (p->a l)

(if (null? l)

'(())

(let ((r (p->a (cdr l))))

(if (symbol? (car l))

(cons '() (cons (cons (car l) (list (car r))) (cdr r)))

(cons (cons (car l) (car r)) (cdr r))))))

(cdr (p->a '(a 1 2 3 b 4 5 c d 8 9 e))) =>

((a (1 2 3)) (b (4 5)) (c ()) (d (8 9)) (e ()))

>>This (2nd) reason is nicely explained in the 8th chapter of tLS, where

>>the authors call it "the collector function" (I think?)

>

>

> What is tLS?

The Little Schemer; Daniel P. Friedman, Matthias Felleisen

-- Hrvoje

Feb 7, 2006, 3:57:49 PM2/7/06

to

Jens Axel Søgaard wrote:

It has been very interesting to see the wide range of solutions. This

afternoon I tried to write srfi-42 solutions following the spirit of

each solution. Now I see there are even more solutions :-), so I'll

limit myself to a few examples.

But first, which solutions do people find the easiest to read and

understand?

Second, I see that Kurt has found the problem to occur sufficiently

often to write a library function. What would be a good name for a

function? (Kurt's slightly different problem).

Also I am brewing on a srfi-42 tutorial, so if you have some nice

examples (or nice problems) please send an email.

In the following solutions I assume the following at the beginning.

(require (planet "42.ss" ("soegaard" "srfi.plt"))

(lib "list.ss" "srfi" "1"))

(define (non-symbol? o)

(not (symbol? o)))

My favorite srfi-42 solution is inspired by Jan's solution, which

loops through the sublists (pairs) of the given list, and collects the

ones that start with a symbol.

(define (plist->alist l)

(list-ec (:pairs p l)

(if (symbol? (car p)))

(list (car p) (take-while non-symbol? (cdr p)))))

For those not familiar with srfi-42 here is a quick explanation:

(list-ec ...) make a list

(:pairs p l) bind p to each pair of l in turn

(if (symbol? (car p)) a filter, the following expression

is skipped if (car p) is a non-symbol

(list (car p) an element of the result list

(take-while ...))

Lauri's span-solution inspired this one:

(define (plist->alist l)

(list-ec (:do () (pair? l) ())

(:let-values (symbol more) (car+cdr l))

(:let-values (non-symbols more) (span non-symbol? more))

(begin (set! l more))

(list symbol non-symbols)))

Here (:do () (pair? l) ()) loops while l is a pair. Then symbol,

non-symbols and more is found using car+cdr and span from srfi-1. (If

break is used in stead of span, then one can use symbol? in stead of

non-symbol?). Then l is set to the remaining elements, before the

current segment is made an element of the result list.

It surprised me that none used match. Using it one can forget about

span and break. The syntax is tricky to get right though (thanks,

Ryan!).

(define (plist->alist l)

(list-ec (:do () (pair? l) ())

(:match (symbol (? non-symbol? non-symbols) ... more ...)

l)

(begin (set! l more))

(list symbol non-symbols)))

Here is the solution I made this afternoon.

;;;---------------------

(require (planet "42.ss" ("soegaard" "srfi.plt"))

(lib "list.ss" "srfi" "1"))

(define (non-symbol? o)

(not (symbol? o)))

(define (test name p->a)

(list name

(equal?

(list (p->a '(a 1 2 3 b 4 5 c d 6 7))

(p->a '(a 1 2 3 b 4 5 c d 6 7 e)))

(list '((a (1 2 3)) (b (4 5)) (c ()) (d (6 7)))

'((a (1 2 3)) (b (4 5)) (c ()) (d (6 7)) (e ()))))))

(define-syntax cons!

(syntax-rules ()

[(cons! x var)

(set! var (cons x var))]))

(define-syntax null!

(syntax-rules ()

[(null! var)

(set! var null)]))

;;;

;;; Lauri Alanko - fold-right

;;;

; The idea is to processing the list from the back one

; element at a time.

; Looping is done by fold-right.

; Quasiquote is used to construct the result.

(define (plist->alist plist)

(define (f item acc)

(let ((curr (car acc))

(full (cadr acc)))

(if (symbol? item)

`(() ((,item ,curr) . ,full))

`((,item . ,curr) ,full))))

(cadr (fold-right f '(() ()) plist)))

(test 'Lauri-fold-right plist->alist)

; The Srfi-42 fold-ec is a fold-left, so

; the list is reversed first.

(define (plist->alist l)

(cadr

(fold-ec '(() ())

(: x (reverse l))

x

(lambda (item acc)

(let ((curr (car acc))

(full (cadr acc)))

(if (symbol? item)

`(() ((,item ,curr) . ,full))

`((,item . ,curr) ,full)))))))

(test 'srfi-42-fold-ec plist->alist)

;;;

;;; Lauri Alanko - recursive, span

;;;

; The list is processed one segment at a time.

; Recursion is used to loop through the list.

; Span from srfi-1 is used to find the segment.

; Quasiquote is used to construct the result.

(define (plist->alist plist)

(if (null? plist)

'()

(let*-values (((sym rest) (car+cdr plist))

((ints tail) (span number? rest)))

`((,sym ,ints) . ,(plist->alist tail)))))

(test 'Lauri-span plist->alist)

; The srfi-42 version uses :do (read as: do while)

; to loop through the list.

(define (plist->alist l)

(list-ec (:do () (pair? l) ())

(:let-values (symbol more) (car+cdr l))

(:let-values (non-symbols more) (span non-symbol? more))

(begin (set! l more))

`(,symbol ,non-symbols)))

(test 'srfi-42-span plist->alist)

;;;

;;; Brian Harvey

;;;

; Loops through the list one segment at a time.

; Recursion is used for both looping through the list.

; Easy to read and understand.

; NB: I changed one cons in p->a to list.

(define (p->a plist)

(if (null? plist)

'()

(cons (list (car plist) (nonsymbols (cdr plist)))

(p->a (flush-nonsymbols (cdr plist))))))

(define (nonsymbols seq)

(cond ((null? seq) '())

((symbol? (car seq)) '())

(else (cons (car seq) (nonsymbols (cdr seq))))))

(define (flush-nonsymbols seq)

(cond ((null? seq) '())

((symbol? (car seq)) seq)

(else (flush-nonsymbols (cdr seq)))))

(test 'brian p->a)

; srfi-42 version of the p->a part

(define (p->a l)

(list-ec (:do () (pair? l) ())

(:let symbol (car l))

(:let non-symbols (nonsymbols (cdr l)))

(begin (set! l (flush-nonsymbols (cdr l))))

(list symbol non-symbols)))

(test 'srfi-42-brian p->a)

;;;

;;; ggem

;;;

; The list is processed backwards one element at a time,

; Recursion is used to control the looping.

; "A hand-written fold-right".

(define (plist->alist plist)

(define (->alist ls)

(if (pair? ls)

(let-values (((current done) (->alist (cdr ls))))

(if (symbol? (car ls))

(values '() (cons (list (car ls) current) done))

(values (cons (car ls) current) done)))

(values '() '())))

(let-values (((ignored answer) (->alist plist)))

answer))

(test 'ggem plist->alist)

; We process the list backwards by reversing

; the list from the beginning. The current

; segment is kept in the variable current,

; list-ec takes care of the done segments.

(define (plist->alist l)

(reverse!

(list-ec (:let current '())

(: x (reverse l))

(begin

(when (non-symbol? x)

(cons! x current)))

(if (symbol? x))

(begin0

(list x current)

(null! current)))))

; Introducing reverse-list-ec and :reverse-list would

; make the similarity clearer.

(test 'srfi-42-ggem plist->alist)

;;;

;;; Jan Van Lent

;;;

; Loop backwards over the sublists using pair-fold-right.

; When a symbol is found take-while is used to loop over

; the segment.

(define (cons-true pred)

(lambda (a b)

(if (pred a) (cons a b) b)))

; return all the sublists of LST that satisfy predicate PRED

(define (pair-filter pred lst)

(pair-fold-right (cons-true pred) '() lst))

(define (car-symbol? lst)

(and (not (null? lst)) (symbol? (car lst))))

(define (symbol-sublists lst)

(pair-filter car-symbol? lst))

(define (not-symbol? x)

(not (symbol? x)))

(define (symbol-and-rest lst)

(list (car lst) (take-while not-symbol? (cdr lst))))

(define (plist->alist lst)

(map symbol-and-rest (symbol-sublists lst)))

(test 'jan plist->alist)

; The srfi-42 version uses the generator :pairs

; to loop generate all pairs (sublists) of the list.

(define (plist->alist l)

(list-ec (:pairs p l)

(if (symbol? (car p)))

(list (car p) (take-while non-symbol? (cdr p)))))

(test 'jan-srfi42 plist->alist)

(plist->alist '(a 1 2 3 b 4 5 c d 6 7))

(plist->alist '(a 1 2 3 b 4 5 c d 6 7 e))

Feb 7, 2006, 4:55:26 PM2/7/06

to

I'm new to Scheme. Here's my attempt.

; Recursively build pairs of

; (symbol, list-of-non-symbols)

; Parameters:

; thelist - a list to process

; element-1 - temporary result holder

; holds the first element of a pair

; element-2 - temporary result holder

; holds the second element of a pair (which is a

list)

; running-result - holds a list of pairs found so far

;

(define (make-pairs thelist element-1 element-2 running-result)

(if (null? thelist)

; nothing left to process, return result

running-result

; symbols are the same?

(if (equal? (symbol? element-1) (symbol? (car thelist)))

(let (

(running-result (append running-result (list

`(,element-1 ,element-2))))

(element-1 (car thelist))

(element-2 '())

(thelist (cdr thelist)))

(make-pairs thelist element-1 element-2

running-result))

(let ((element-2 (append element-2 (list (car thelist)))))

(make-pairs (cdr thelist) element-1 element-2

running-result)))))

; test case

(define mylist '(a 1 2 3 b 4 5 c d 8 9 e))

(newline)

(display (make-pairs (cdr mylist) (car mylist) '() '()))

Feb 7, 2006, 6:56:10 PM2/7/06

to

Jens Axel Søgaard <use...@soegaard.net> writes:

> It has been very interesting to see the wide range of solutions.

Here is mine, R5RS, imperative:

(define (plist->alist xs)

(if (null? xs)

'()

(let* ((sym (car xs))

(nums (let loop ((ys (cdr xs)))

(if (or (null? ys) (symbol? (car ys)))

(begin (set! xs ys) '())

(cons (car ys) (loop (cdr ys)))))))

(cons (list sym nums) (plist->alist xs)))))

--

__("< Marcin Kowalczyk

\__/ qrc...@knm.org.pl

^^ http://qrnik.knm.org.pl/~qrczak/

Feb 8, 2006, 10:19:41 AM2/8/06

to

On Mon, 06 Feb 2006 22:26:16 +0100, Jens Axel Søgaard wrote:

> <snip>

> Still interested in more solutions.

> <snip>

> Still interested in more solutions.

Ok, here is my try using srfi-1. It uses unfold. Perhaps it isn't

very readable, because it may be difficult to see what the meaning of

the parameters is, but here it is:

(define (plist->alist l)

(unfold

null?

(lambda (l) (cons (car l)

(take-while number? (cdr l))))

(lambda (l) (drop-while number? (cdr l)))

l))

The following is probably more efficient, but uses receive, and isn't

tail-recursive:

(define (plist->alist l)

(if (null? l) '()

(receive (h t)

(span number? (cdr l))

(cons (cons (car l) h)

(plist->alist t)))))

Kristof Bastiaensen

Feb 25, 2006, 7:29:42 AM2/25/06

to

Jens Axel Søgaard писал(а):

> Example: (a 1 2 3 b 4 5 c d 8 9 e)

> -> ((a (1 2 3)) (b (4 5)) (c ()) (d (8 9)) (e ()))

I'm complete noob in scheme and this is my first program in scheme out

of sicp.

Here it goes:

(define input '(a 1 2 3 b 4 5 c d 8 9 e))

(define (p)

(define (make-list l out-l curr)

(define add-curr (append out-l (list (cons (car curr)

(list (cdr curr))))))

(cond ((null? l) add-curr)

((number? (car l)) (make-list (cdr l) out-l (append curr (list

(car l)))))

((symbol? (car l)) (make-list (cdr l) add-curr (cons (car l)

null)))))

(make-list (cdr input) null (cons (car input) '())))

it doesn't use any libraries and doesn't use recursion, only iteration.

Thanks.

Feb 26, 2006, 3:25:57 PM2/26/06

to

Jens Axel Søgaard wrote:

> ;;;

> ;;; Brian Harvey

> ;;;

>

> ; Loops through the list one segment at a time.

> ; Recursion is used for both looping through the list.

> ; Easy to read and understand.

>

> ; NB: I changed one cons in p->a to list.

>

> (define (p->a plist)

> (if (null? plist)

> '()

> (cons (list (car plist) (nonsymbols (cdr plist)))

> (p->a (flush-nonsymbols (cdr plist))))))

>

> (define (nonsymbols seq)

> (cond ((null? seq) '())

> ((symbol? (car seq)) '())

> (else (cons (car seq) (nonsymbols (cdr seq))))))

>

> (define (flush-nonsymbols seq)

> (cond ((null? seq) '())

> ((symbol? (car seq)) seq)

> (else (flush-nonsymbols (cdr seq)))))

>

> (test 'brian p->a)

>

Hi,

As I saw there was the "misremembering the spec." bug,

I changed p->a too, but not like you did:

(define (p->a plist)

(if (null? plist)

'()

(cons (cons (car plist) (list(nonsymbols (cdr plist))));added list

(p->a (flush-nonsymbols (cdr plist))))))

I putted the list at this specific place cause i only

want to list the nonsymbols.

What i don't understand in your change:

list is taking (car plist), which is a symbol

at first run (the first element of the list is 'a)

so it should result (((a 1 2 3... at least?

But when executing both source code (your modif and mine)

they do the same job... why?

Feb 26, 2006, 6:37:02 PM2/26/06

to

John Doe <some...@world.com> writes:

>> (cons (list (car plist) (nonsymbols (cdr plist)))

>> (p->a (flush-nonsymbols (cdr plist))))))

>> (cons (list (car plist) (nonsymbols (cdr plist)))

>> (p->a (flush-nonsymbols (cdr plist))))))

> (cons (cons (car plist) (list(nonsymbols (cdr plist))));added list

> (p->a (flush-nonsymbols (cdr plist))))))

>But when executing both source code (your modif and mine)

>they do the same job... why?

Suppose plist is (a 1 2 3 b 4 5 6). Then (car plist) is A and

(nonsymbols (cdr plist)) is (1 2 3). I'm saying

(cons (list 'a '(1 2 3)) (p->a ...))

(cons '(a (1 2 3)) (p->a ...))

You're saying

(cons (cons 'a (list '(1 2 3))) (p->a ...))

(cons (cons 'a '((1 2 3))) (p->a ...))

(cons '(a (1 2 3)) (p->a ...))

Feb 27, 2006, 3:45:32 PM2/27/06

to

Here is my version :

(define (tri l)

(let foo ((ll l) (res ()))

(cond ((null? ll) res)

((symbol? (car ll))

(let ((x (let foo2 ((l2 (cdr ll)) (res2 ()))

(cond ((null? l2) (list (list (car ll) res2) ()))

((symbol? (car l2)) (list (list (car ll)

res2) l2))

(else (foo2 (cdr l2) (append res2 (list

(car l2)))))))))

(foo (cadr x) (append res (list (car x))))))

(else '()))))

Reply all

Reply to author

Forward

0 new messages

Search

Clear search

Close search

Google apps

Main menu