List manipulation
Jens Axel Søgaard
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
Lauri Alanko
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
Jens Axel Søgaard
> 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
Lauri Alanko
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
Brian Harvey
>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.
ggem
> 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
ggem
> (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.
Jérémie Lumbroso
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
Hrvoje Blazevic
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
Jan Van lent
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)))
;;;
Jérémie Lumbroso
- Jérémie
Lauri Alanko
> Hmm ... where do "take-while" and "pair-fold-right" come from?
SRFI-1, like all good stuff.
Lauri
Kurt Noermark
(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
Neil Cerutti
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
Lauri Alanko
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
Andre
(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
Neil Cerutti
> 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.
>
>
> (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
Hrvoje Blazevic
> 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
pbe...@gmail.com
(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))))))
Neil Cerutti
> 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
Neil Cerutti
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
Hrvoje Blazevic
>>>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
Jens Axel Søgaard
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))
Chui Tey
; 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) '() '()))
Marcin 'Qrczak' Kowalczyk
> 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/
Kristof Bastiaensen
> <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
zzzz
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.
John Doe
> ;;;
> ;;; 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?
Brian Harvey
>> (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 ...))
Trap D
(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 '()))))