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

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

(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.

(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.

   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.

  ;; 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?

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

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...]

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...]

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.

For the particular case n=1, the latter property gives us:
        (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.

(define (subsets-v0 l n)
  (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 1))))
     (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))))

We must note first that the procedure is faulty. The verification
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 '())))

which was called 'combos' in his article. The function completely
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.

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