Subsets of a list
Thomas Baruchel
Hi, I wrote a function doing the following:
it takes a list and an integer as arguments and returns a list of lists
which are all different subsets of length n from the given list:
(subset '(1 2 3 4) 2)
--> ((1 2) (1 3) (1 4) (2 3) ( 2 4) (3 4))
I would like to have your comments: can I improve the function
(that I use very much; all advice to have quicker or anything better
will be fine).
[The sublists are not given in a "pretty" order, because I don't need it;
since I take them are subsets (and not lists), (4 2) is for me the
same as (2 4)]
(define (subsets l n)
(let ((subsets* '()))
(letrec ((subsets0 (lambda (l2 l* n2)
(if (zero? n2) (set! subsets* (cons l* subsets*))
(do ((i 0 (+ i 1)))
((> i (- (length l2) n2)) subsets*)
(subsets0 (list-tail l2 (+ i 1))
(cons (list-ref l2 i) l*) (- n2 1)))))))
(subsets0 l '() n))))
--
QlpoOTFBWSZTWcwiz1oAAC1fgHQTwOeABVAABAT7Zp4lMAC4hET1DQNGhoBoyGaQYyaZAyaG
QZGmBGDTJE01NMTJkZDQaAUhm7W8Wu9WYGQZg2Vd+s8PsaiAZJoF5jaDsEQUaCEQHgnxdw5H
siRDfoqLyg4gHe6/TCLCgm0gY3zjVSswgknIk85qBbV7GNcqz8yWcUOcrT4SlYICcQUgKxM2
gumlEIhPgCSCC4gUHVb3pREx/vdlGkW5r2P5Z+LuSKcKEhmEWetA | mimencode + bzip2
ol...@pobox.com
> it takes a list and an integer as arguments and returns a list of lists
> which are all different subsets of length n from the given list:
> (subset '(1 2 3 4) 2)
> --> ((1 2) (1 3) (1 4) (2 3) ( 2 4) (3 4))
subset '() n ==> '() : there are no subsets in an empty set
subset l 0 ==> '(()): the only subset of size (cardinality 0) is an
empty set
subset (a . tail) n ==> { (a . x) | x <- subset tail (n-1) } Union
subset tail n
that is, subsets of size n will either contain the element a, or will
not contain it.
This mathematical definition directly translates to Scheme.
(define (subset l n)
(cond
((<= n 0) '(()))
((null? l) '())
((= n 1) (map list l))
(else
(append
(let ((hd (car l)))
(map
(lambda (lst) (cons hd lst))
(subset (cdr l) (- n 1))))
(subset (cdr l) n)))))
The solution is purely functional.
Note, the code has an optimization for the case n=1, in which case the
answer is a set of all singleton subsets.
Example:
(display (subset '(1 2 3 4) 0))
===> (())
(display (subset '(1 2 3 4) 1))
===> ((1) (2) (3) (4))
(display (subset '(1 2 3 4) 2))
===> ((1 2) (1 3) (1 4) (2 3) (2 4) (3 4))
(display (subset '(1 2 3 4) 3))
===> ((1 2 3) (1 2 4) (1 3 4) (2 3 4))
(display (subset '(1 2 3 4) 4))
===> ((1 2 3 4))
(display (subset '(1 2 3 4) 5))
===> ()
The cardinalities of the answers above form the Pascal triangle, btw.
George Caswell
> Brest, le mardi 8 janvier
>
> Hi, I wrote a function doing the following:
> it takes a list and an integer as arguments and returns a list of lists
> which are all different subsets of length n from the given list:
>
> (subset '(1 2 3 4) 2)
> --> ((1 2) (1 3) (1 4) (2 3) ( 2 4) (3 4))
>
> I would like to have your comments: can I improve the function
> (that I use very much; all advice to have quicker or anything better
> will be fine).
> [The sublists are not given in a "pretty" order, because I don't need it;
> since I take them are subsets (and not lists), (4 2) is for me the
> same as (2 4)]
>
> (define (subsets l n)
> (let ((subsets* '()))
> (letrec ((subsets0 (lambda (l2 l* n2)
> (if (zero? n2) (set! subsets* (cons l* subsets*))
> (do ((i 0 (+ i 1)))
> ((> i (- (length l2) n2)) subsets*)
> (subsets0 (list-tail l2 (+ i 1))
> (cons (list-ref l2 i) l*) (- n2 1)))))))
> (subsets0 l '() n))))
>
The basic problem here is that certain subsets are being calculated more
than once: Let's say you have a set like this:
(define l '(a b c d e f g))
And you want the subsets of size 3. First, you'll calculate all the subsets
which start with 'a, defined as 'a prepended onto the subsets of size 2
starting after 'a. The first subset of size 2 you generate will start with
'b, and when you've generated all those, you'll generate those that start at
'c, and so on.
When you're done generating the subsets that start with 'a, you'll generate
the subsets of size 3 that start with 'b, and then (once again) you'll
generate the subsets of size 2 that start with 'c. In fact, all the subsets
you generate as the recursive step of creating sets of size 3 starting with 'b
will have already been generated, as part of the recursive step for 'a. That
causes your time-complexity to skyrocket as n gets larger.
Sometime when I've had a little more sleep and a little less coffee I'll
try to put together a solution. But the problem is similar to the simple (but
highly wasteful) definition of the Fibonacci series:
(define (fibs n)
(cond ((eq? n 0) 0)
((eq? n 1) 1)
(else (+ (fibs (- n 1)) (fibs (- n 2))))))
Any (fibs x) where x is between 0 and n may be calculated many, many times,
when it needn't be calculated more than once. Likewise, there's no need to
calculate the list of sets of size n from l including l's first element more
than once.
---GEC
Projects page: http://home.maine.rr.com/tetsujin/
(M-x depeche-mode)
"Must... Finish... Zaku..."
John David Stone
> I wrote a function doing the following:
> it takes a list and an integer as arguments and returns a list of lists
> which are all different subsets of length n from the given list:
>
> (subset '(1 2 3 4) 2)
> --> ((1 2) (1 3) (1 4) (2 3) ( 2 4) (3 4))
>
> I would like to have your comments: can I improve the function
> (that I use very much; all advice to have quicker or anything better
> will be fine).
Here's a version that appears to be faster. It uses an accumulator
instead of a non-local variable and uses recursion over the list l2 rather
than over positions in that list, thus avoiding all of the calls to
LIST-REF and LIST-TAIL.
(define (combos l n)
(letrec ((subsets0 (lambda (l2 l* n2 acc)
(if (zero? n2)
(cons l* acc)
(do ((rest l2 (cdr rest))
(available (length l2) (- available 1))
(acc acc (subsets0 (cdr rest)
(cons (car rest) l*)
(- n2 1)
acc)))
((< available n2) acc))))))
(subsets0 l '() n '()))))
Using Chez Scheme 6.1 under Linux on a 700MHz Pentium III, COMBOS
took 250 ms of cpu time to find all the ten-element subsets of a
twenty-element set; SUBSETS took 460 ms.
--
John David Stone - Lecturer in Computer Science and Philosophy
Manager of the Mathematics Local-Area Network
Grinnell College - Grinnell, Iowa 50112 - USA
st...@cs.grinnell.edu - http://www.cs.grinnell.edu/~stone/
Max Hailperin
...
[tree-recursive procedure to find subsets of size n from a list, l]
> The basic problem here is that certain subsets are being calculated more
Actually, there is no big efficiency gain to be had in this case,
because the list that is the result is of length C(|l|, n), so it is
inevitable that any procedure for consing up that list will take time
of that order -- all that you can do is improve the constant factor.
The big win, through dynamic programming or memoization, is only
possible if the problem is changed to something like counting how many
subsets there are.
George Caswell
Hrm, I guess you're right, though I wouldn't have thought so. My brain's
having a little difficulty with why that's the case.
Anyway, my implementation, "subs" uses up a lot of heap space compared to,
say, "combos" posted by John Stone, and incurs more garbage collection, but
still comes out faster:
(define (expand xs sets)
(if (or (null? xs) (null? sets))
()
(cons
(apply append (map (lambda (set) (map (lambda (s) (cons (car xs)
s)) set)) (cdr sets)))
(expand (cdr xs) (cdr sets)))
))
(define (subs xs n)
(cond ((eq? 0 n) ())
(else
(do ((i 1 (+ i 1))
(acc (map (lambda (x) (list (list x))) xs) (expand xs acc)))
((= i n) (apply append acc))))))
Sorry if I spread a bunch of misinformation with that tree-recursion
comparison: I'm still not sure why I'm wrong, but I had the same problem with
the Monty Hall thing.
John David Stone
> Anyway, my implementation, "subs" uses up a lot of heap space compared to,
> say, "combos" posted by John Stone, and incurs more garbage collection, but
> still comes out faster:
>
> (define (expand xs sets)
> (if (or (null? xs) (null? sets))
> ()
> (cons
> (apply append (map (lambda (set) (map (lambda (s) (cons (car xs)
> s)) set)) (cdr sets)))
> (expand (cdr xs) (cdr sets)))
> ))
>
> (define (subs xs n)
> (cond ((eq? 0 n) ())
> (else
> (do ((i 1 (+ i 1))
> (acc (map (lambda (x) (list (list x))) xs) (expand xs acc)))
> ((= i n) (apply append acc))))))
I used SUBS to find all the ten-element subsets of a twenty-element
set, in the same environment (Chez Scheme 6.1, Linux, 700MHz Pentium III)
where SUBSETS took 460 ms and COMBOS took 250 ms for the same task. SUBS
took 990 ms.
Alamo Petrofsky
>
> Here's a version that appears to be faster. It uses an accumulator
> instead of a non-local variable and uses recursion over the list l2 rather
> than over positions in that list, thus avoiding all of the calls to
> LIST-REF and LIST-TAIL.
But it seems you still make a lot of calls to LENGTH, which similarly
do needless list traversals. Here's how I would write it:
;; Returns all n-length subsets of the list l.
(define (subsets l n)
;; ss prepends each n-length subset of l to little-acc, and returns
;; a list of the resulting sets, prepended to big-acc. len must be
;; the length of l.
(let ss ((l l) (len (length l)) (n n) (little-acc '()) (big-acc '()))
(cond ((zero? n) (cons little-acc big-acc))
((< len n) big-acc)
(else (ss (cdr l) (- len 1) (- n 1) (cons (car l) little-acc)
(ss (cdr l) (- len 1) n little-acc big-acc))))))
Is that faster or slower on your system?
-al
George Caswell
> George Caswell <tets...@maine.rr.com> writes:
>
> > Anyway, my implementation, "subs" uses up a lot of heap space compared to,
> > say, "combos" posted by John Stone, and incurs more garbage collection, but
> > still comes out faster:
> >
> > (define (expand xs sets)
> > (if (or (null? xs) (null? sets))
> > ()
> > (cons
> > (apply append (map (lambda (set) (map (lambda (s) (cons (car xs)
> > s)) set)) (cdr sets)))
> > (expand (cdr xs) (cdr sets)))
> > ))
> >
> > (define (subs xs n)
> > (cond ((eq? 0 n) ())
> > (else
> > (do ((i 1 (+ i 1))
> > (acc (map (lambda (x) (list (list x))) xs) (expand xs acc)))
> > ((= i n) (apply append acc))))))
>
> I used SUBS to find all the ten-element subsets of a twenty-element
> set, in the same environment (Chez Scheme 6.1, Linux, 700MHz Pentium III)
> where SUBSETS took 460 ms and COMBOS took 250 ms for the same task. SUBS
> took 990 ms.
>
Strange... I'd attribute it to garbage collection time - though in any
case, on the tests I ran subs was only marginally faster than combos anyway.
Oh, well, back to the drawing board. :)
George Caswell
> I used SUBS to find all the ten-element subsets of a twenty-element
> set, in the same environment (Chez Scheme 6.1, Linux, 700MHz Pentium III)
> where SUBSETS took 460 ms and COMBOS took 250 ms for the same task. SUBS
> took 990 ms.
>
These are my results: ys is a 20 element set. subs2 is a variation on
subs that stores data differently.
> (define a (subs2 ys 10))
;Evaluation took 1760 mSec (0 in gc) 2469846 cells work, 1236201 env, 534
bytes other
#<unspecified>
> (define a (combos ys 10))
;Evaluation took 2740 mSec (30 in gc) 675120 cells work, 4721385 env, 34 bytes
other
#<unspecified>
> (define a (subs ys 10))
;Evaluation took 1880 mSec (10 in gc) 2663988 cells work, 1242383 env, 34
bytes other
On my interpreter (SCM), subs and subs2 take less time, but use around 4
times as many storage cells for intermediate values. It's a tradeoff that's
advantageous on some interpreters, I guess.
Is Chez Scheme in Debian?
Listing for subs2 follows:
(define (subs-base xs)
(if (null? xs)
()
(let* ((rest (subs-base (cdr xs)))
(first (if (null? rest) () (car rest))))
(cons (cons (list (car xs)) first) rest)
)))
(define (subs-expand xs sets)
(if (or (null? xs) (null? sets) (null? (cdr sets)))
()
(let* ((rest (subs-expand (cdr xs) (cdr sets)))
(first (if (null? rest) () (car rest))))
(cons
(append (map (lambda (x) (cons (car xs) x)) (cadr sets)) first)
rest
))))
(define (subs2 xs n)
(if (eq? 0 n)
()
(do ((i 1 (+ i 1))
(acc (subs-base xs) (subs-expand xs acc)))
((eqv? i n) (car acc)))
))
Eli Barzilay
> > (define a (subs2 ys 10))
> ;Evaluation took 1760 mSec (0 in gc) 2469846 cells work, 1236201 env, 534
> bytes other
> #<unspecified>
> > (define a (combos ys 10))
> ;Evaluation took 2740 mSec (30 in gc) 675120 cells work, 4721385 env, 34 bytes
> other
> #<unspecified>
> > (define a (subs ys 10))
> ;Evaluation took 1880 mSec (10 in gc) 2663988 cells work, 1242383 env, 34
> bytes other
There is a really nice lesson here -- you have this fight over who's
code runs faster, tweaking your code into something more and more
complex, while Oleg wrote a version which is clearly superior in its
clarity (as he shown it to be directly related to the definition).
So, you must have tried his code too, getting to a conclusion that it
is useless if you care about speed... I tried it too (s1=subsets,
s2=subs, s3=subs2, s4=combos, s5=subset):
| > (define a '(a b c d e f g h i j k l m n o p q r s t u v w x y z))
| > (time (begin (s1 a 8) #f))
| cpu time: 25520 real time: 25485 gc time: 7580
| > (time (begin (s2 a 8) #f))
| cpu time: 10730 real time: 10715 gc time: 5640
| > (time (begin (s3 a 8) #f))
| cpu time: 7290 real time: 7245 gc time: 2610
| > (time (begin (s4 a 8) #f))
| cpu time: 13720 real time: 13710 gc time: 500
| > (time (begin (s5 a 8) #f))
| cpu time: 66130 real time: 66334 gc time: 41470
and it definitely looks like his solution beats the hell out of the
rest in a worst running time competition... (And again, wins at
clarity -- the lines in each solution (all re-indented in the same
style) are s1=9, s2=14, s3=18, s4=12, and s5=8 lines.)
The thing is that once you realize that the solution is functional,
you can simply memoize it, and get:
| > (time (begin (s6 a 8) #f))
| cpu time: 5440 real time: 5454 gc time: 1700
clearly beating the rest...
[I always wonder why does everyone teach dynamic programming with
stupid matrices where memoization lets you keep your program exactly
the same and getting the same benefits...]
--
((lambda (x) (x x)) (lambda (x) (x x))) Eli Barzilay:
http://www.barzilay.org/ Maze is Life!
Eli Barzilay
> > (define a (subs2 ys 10))
> ;Evaluation took 1760 mSec (0 in gc) 2469846 cells work, 1236201 env, 534
> bytes other
> #<unspecified>
> > (define a (combos ys 10))
> ;Evaluation took 2740 mSec (30 in gc) 675120 cells work, 4721385 env, 34 bytes
> other
> #<unspecified>
> > (define a (subs ys 10))
> ;Evaluation took 1880 mSec (10 in gc) 2663988 cells work, 1242383 env, 34
> bytes other
There is a really nice lesson here -- you have this fight over whose
code runs faster, tweaking your code into something more and more
complex, while Oleg wrote a version which is clearly superior in its
clarity (as he has shown it to be directly following the definition).
ol...@pobox.com
finding all subsets of a given size from a given set. We start with
the mathematical definition of the problem, which leads to a simple,
correct but inefficient solution. We then try to systematically
optimize the function until we end up with the fastest function, which
is notably faster than other solutions proposed so far. The final,
fastest solution is still pure functional. We also demonstrate that
the choice of the interpreter does matter in relative performance of
various algorithms.
We start with the definition of the problem: given a set 'l' and a
number 'n', return the set of all subsets of 'l' of cardinality
'n'. Sets are represented by lists.
Suppose a function "subsets LIST N" is a solution. This function should
possess the following properties, which follow from the definition:
(subsets l 0) ==> '(()); the only subset of size (cardinality 0) is the
empty set. Note that l may be the empty set: the empty
set is its own (improper) subset.
(subsets '() n) if n>0 ==> '() ; there are no non-empty subsets in an empty set
(subsets (a . tail) n) ==> { (a . x) | x <- (subsets tail (n-1)) } Union
(subsets tail n)
that is, subsets of size n will either contain the element a, or will
not contain it.
(subsets '() 1) ==> '()
(subsets (a . tail) 1) ==> {a} Union (subsets tail 1)
in other words,
(subsets l 1) ==> { {x} | x <- l }
thus (subsets l 1) is a set of all singleton subsets.
This mathematical definition directly translates to Scheme.
(cond
((<= n 0) '(()))
((null? l) '())
((= n 1) (map list l))
(else
(append
(let ((hd (car l)))
(map
(lambda (lst) (cons hd lst))
(subsets-v0 (cdr l) n)))))
Next we need to design a set of validation tests.
(subset '(1 2 3 4) 0) ===> (())
(subset '(1 2 3 4) 1) ===> ((1) (2) (3) (4))
(subset '(1 2 3 4) 2) ===> ((1 2) (1 3) (1 4) (2 3) (2 4) (3 4))
(subset '(1 2 3 4) 3) ===> ((1 2 3) (1 2 4) (1 3 4) (2 3 4))
(subset '(1 2 3 4) 4) ===> ((1 2 3 4))
(subset '(1 2 3 4) 5) ===> ()
The test driver 'verify' is given in the Appendix. The function subset0
passes the test.
As the performance benchmark, we will take the one suggested by
John David Stone: finding all subsets of size 10 of a 20-element set.
(let ((n (time (subsets
'(1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20) 10))))
#f)
As the baseline, we take the function by Thomas Baruchel:
(define (subsets-v1 l n)
(let ((subsets* '()))
(letrec ((subsets0 (lambda (l2 l* n2)
(if (zero? n2) (set! subsets* (cons l* subsets*))
(do ((i 0 (+ i 1)))
((> i (- (length l2) n2)) subsets*)
(subsets0 (list-tail l2 (+ i 1))
(cons (list-ref l2 i) l*) (- n2 1)))))))
(subsets0 l '() n))))
tests (procedure verify?) reveal that when n is 0, the subsets-v1
returns <void> (i.e., unspecified result) rather than the expected
'().
Benchmarking subsets-v1 on Pentium III Xeon 500 MHz/128 MB; FreeBSD
4.0-RELEASE, Gambit-C 3.0 _interpreter_ gives: 6295 ms CPU time, 54.6
MB of allocated memory.
Benchmarking of subsets-v0 gives: 285023 ms CPU time, 263.1 MB of
allocated memory.
Clearly there is something wrong with subsets-v0. The culprit is not
difficult to spot: 'map' and 'append', which repeatedly scan the list,
generating garbage along the way. Both 'map' and 'append' can be
avoided if we re-write the recursive equation using an
accumulator-passing style. That is, instead of returning the list of
subsets, we will accept an accumulator and return the union of the
accumulator and the found subsets. Thus we introduce a function
(loop l n prev-els accum)
===> accum U { prev-els U x | x <- (subsets l n) }
We see that
(loop (a . tail) n prev-els accum)
===> accum U { prev-els U x | x <- (subsets (a . tail) n) }
... see the definition of (subsets (a . tail) n) above ...
===> accum U { prev-els U {a} U x | x <- (subsets tail (n-1)) } U
{ prev-els U x | x <- (subsets tail n) }
===> accum U { (prev-els U {a}) U x | x <- (subsets tail (n-1)) } U
{ prev-els U x | x <- (subsets tail n) }
... definition of loop ...
===> (loop tail (n-1) (prev-els U {a}) accum) U
{ prev-els U x | x <- (subsets tail n) }
===> (loop tail n prev-els accum')
where accum' = (loop tail (n-1) (prev-els U {a}) accum)
Thus we can transform subsets-v0 into subsets-v20:
(define (subsets-v20 l n)
(let loop ((l l) (n n) (prev-els '()) (accum '()))
(cond
((<= n 0) (cons prev-els accum))
((null? l) accum)
((= n 1)
(let fold ((l l) (accum accum))
(if (null? l) accum
(fold (cdr l) (cons (cons (car l) prev-els) accum)))))
(else
(loop (cdr l) n prev-els
; new accum
(loop (cdr l) (- n 1) (cons (car l) prev-els) accum))))))
Note that we also transformed (map list l) (for the case n = 1). In an
accumulator-passing style, map became fold, as expected. I believe it
is possible to translate subsets-v0 into subsets-v20 _mechanically_,
using the fusion property. But not today.
The function subsets-v20 verifies. The benchmark gives: 14090 ms CPU
time, 317.9 MB allocated memory. Re-writing subsets-v0 into the
accumulator-passing style improved the performance 20 times! Yet not
enough to beat the imperative baseline subsets-v1.
John David Stone suggested the following function:
(define (subsets-v3 l n)
(letrec ((subsets0 (lambda (l2 l* n2 acc)
(if (zero? n2)
(cons l* acc)
(do ((rest l2 (cdr rest))
(available (length l2) (- available 1))
(acc acc (subsets0 (cdr rest)
(cons (car rest) l*)
(- n2 1)
acc)))
((< available n2) acc))))))
(subsets0 l '() n '())))
verifies. The benchmark runs at 8070 ms CPU time and allocates 162.1
MB of memory.
Comparison of subsets-v3 with subsets-v0 shows that the two functions are
rather similar. However, subsets-v3 uses an extra optimization: it
takes advantage of a stronger property that
(subsets l n) ==> '() whenever n > (length l)
This property is obvious, and can be derived from the basic
equations. However, it can save a lot of effort. To see if this is
important indeed, we try to take an advantage of the property in our
subsets-v20. Of course we don't want to compute (length l) every time
we need it. We determine it only once, and remember to decrement
whenever we take (cdr l).
(define (subsets-v21 l n)
(let loop ((l l) (ln (length l)) (n n) (prev-els '()) (accum '()))
(cond
((<= n 0) (cons prev-els accum))
((< ln n) accum)
((= n 1)
(let fold ((l l) (accum accum))
(if (null? l) accum
(fold (cdr l) (cons (cons (car l) prev-els) accum)))))
(else
(loop (cdr l) (- ln 1) n prev-els
; new accum
(loop (cdr l) (- ln 1) (- n 1) (cons (car l) prev-els) accum))))))
The function verifies and runs the benchmark at 7660 ms CPU time and
164.3 MB of allocated memory. Not so bad! We manage to beat the
subsets-v3 although not the baseline. Gambit is not Chez Scheme, it
runs subsets-v3 slower than it runs the baseline.
Now we have stumbled on the optimization principle: roll-out, i.e.,
rely on more special, derived properties. BTW, this principle runs
opposite to the usual mathematical approach of distilling a set of
premises to the bare minimum.
Let us derive another special case, and take advantage of it:
(subset l (length l)) ==> (list l)
There is only one subset of l of cardinality (length l), which is l
itself.
(define (subsets-v22 l n)
(let loop ((l l) (ln (length l)) (n n) (prev-els '()) (accum '()))
(cond
((<= n 0) (cons prev-els accum))
((< ln n) accum)
((= ln n) (cons (append l prev-els) accum))
((= n 1)
(let fold ((l l) (accum accum))
(if (null? l) accum
(fold (cdr l) (cons (cons (car l) prev-els) accum)))))
(else
(loop (cdr l) (- ln 1) n prev-els
; new accum
(loop (cdr l) (- ln 1) (- n 1) (cons (car l) prev-els) accum))))))
The function verifies and runs the benchmark at 4965 ms of CPU time
and 97.2 MB of allocated memory. This is the absolute record: we
manage to beat the baseline!
Let us push the envelope further, and take advantage of another
special case:
(subset l (- (length l) 1)) ==>
{ l \ {x} | x <- l }
In Scheme terms,
(define (subsets-v23 l n)
(let loop ((l l) (ln (length l)) (n n) (prev-els '()) (accum '()))
(cond
((<= n 0) (cons prev-els accum))
((< ln n) accum)
((= ln n) (cons (append l prev-els) accum))
((= ln (+ 1 n))
(let fold ((l l) (seen prev-els) (accum accum))
(if (null? l) accum
(fold (cdr l) (cons (car l) seen)
(cons
(append (cdr l) seen)
accum)))))
((= n 1)
(let fold ((l l) (accum accum))
(if (null? l) accum
(fold (cdr l) (cons (cons (car l) prev-els) accum)))))
(else
(loop (cdr l) (- ln 1) n prev-els
; new accum
(loop (cdr l) (- ln 1) (- n 1) (cons (car l) prev-els) accum))))))
The function verifies and runs at 4132 ms of CPU time and 72.4 MB of
allocated memory. We're 50% faster than the baseline, the record so
far.
The following table summarizes the performance benchmark: user running
times in seconds. The table also reports the results for another
Scheme interpreter, Bigloo 2.4b:
/usr/bin/time bigloo -i /tmp/b5.scm
The latter results include the cost of starting up the interpreter.
Procedure Gambit-C Bigloo 2.4b Bigloo 2.4b
interpreter, s interpreter, s compiler, s
subsets-v0 285.0 11.59 5.62 3.14
subsets-v1 6.3 5.45 2.22 0.34
subsets-v3 8.1 4.78 0.96 0.27
subsets-v20 14.1 5.53 0.96 0.26
subsets-v21 7.7 4.88 0.66 0.26
subsets-v22 5.0 3.18 0.62 0.25
subsets-v23 4.1 2.86 0.82 0.25
subsets-v1 is the baseline, written by Thomas Baruchel
subsets-v3 is written by John David Stone (which was called combos)
Platform: Pentium III Xeon 500 MHz/128 MB; FreeBSD 4.0-RELEASE
The column for the compiled code has two sub-columns. The left
subcolumns refers to the code compiled using the default Bigloo
flags. The right subcolumn refers to the code compiled with -Obench
-unsafe flags. The running time of the compiled code includes the
start-up time.
The table shows that there is some variation between the
interpreters. subsets-v3 is slower than the baseline on Gambit-C yet
is faster on Bigloo. Still subsets-v23 is the absolute interpreted
leader so far. It is gratifying to see that the leader is pure
functional, and it was derived systematically.
But this was just tinkering around the edges. Please see the next
article.
Appendix. The verification framework
; Compare two lists l1 and l2 modulo the order of elements
; "pred? X Y" is the predicate used to test equivalence of elements
; of l1 and l2
(define (set-equal? pred? l1 l2)
(if (null? l1) (null? l2)
(let loop ((l2-to-see l2) (l2-seen '()))
(and (pair? l2-to-see)
(if (pred? (car l1) (car l2-to-see))
(set-equal? pred? (cdr l1) (append (cdr l2-to-see) l2-seen))
(loop (cdr l2-to-see) (cons (car l2-to-see) l2-seen)))))))
; Test two powersets for equality
(define (pset-equal? ps1 ps2)
(set-equal? (lambda (s1 s2) (set-equal? equal? s1 s2)) ps1 ps2))
(define test-cases
'( ; arguments expected result
( ((1 2 3 4) 0) . (()) )
( ((1 2 3 4) 1) . ((1) (2) (3) (4)) )
( ((1 2 3 4) 2) . ((1 2) (1 3) (1 4) (2 3) (2 4) (3 4)) )
( ((1 2 3 4) 3) . ((1 2 3) (1 2 4) (1 3 4) (2 3 4)) )
( ((1 2 3 4) 4) . ((1 2 3 4)) )
( ((1 2 3 4) 5) . () )
))
(define (verify subsets-fn)
(for-each
(lambda (tcase)
(let ((result (apply subsets-fn (car tcase)))
(expected (cdr tcase)))
(if (or (not (list? result)) (not (pset-equal? result expected)))
(for-each display
(list "Error: for arguments " (car tcase)
" expected: " expected
" found: " result #\newline)))))
test-cases))
Eli Barzilay
> [...]
> In Scheme terms,
> (define (subsets-v23 l n)
> [...])
When I tried it on my machine, it still runs slower (~9.6 secs) than
the memoization of the simple solution (~7.9 secs) [the numbers are
different than in my other post since I'm on a different machine].
I don't want to jump to conclusions, it's too late so chances are high
that I'm missing something, plus I don't have all those
implementations installed to try... So can you check how your
configuration runs the simple memoized version?
I assume that gambit and bigloo provide `eq?' hash tables... The
interface shouldn't be difficult to mimic if it's different -- there's
make-hash-table, (hash-table-put! table key val) and
(hash-table-get table key failure-thunk). A nice point is that an
efficient `eq?' table is enough since the simple code only calls
itself on cdr's of l.
;;--------------------------------------------------------------------
(define (memoize2 f)
(let ((table (make-hash-table)))
(lambda (x y)
(let ((table2 (hash-table-get table x
(lambda ()
(let ((t (make-hash-table)))
(hash-table-put! table x t)
t)))))
(hash-table-get table2 y
(lambda ()
(let ((r (f x y)))
(hash-table-put! table2 y r)
r)))))))
(define (msubset l n)
(cond ((<= n 0) '(()))
((null? l) '())
((= n 1) (map list l))
(else (append (let ((hd (car l)))
(map (lambda (lst) (cons hd lst))
(msubset (cdr l) (- n 1))))
(msubset (cdr l) n)))))
(set! msubset (memoize2 msubset))
;;--------------------------------------------------------------------