Powerset

oleg@pobox.com oleg@pobox.com
Tue, 10 Jun 2003 01:34:40 -0700 (PDT)


The following seems to be a faster version of powerset that delivers
results strictly in the order of increasing cardinality (i.e., all
sets of size 1 first, then of size 2, etc). It seems to run faster
than any other ordered version of powerset posted so far. On GHCi,
length $ powerset [1..22] is computed roughly 4 times faster than
powerset3 given earlier. On Hugs, the powerset below also runs faster,
with less memory consumption and in fewer GC cycles, up to a limit of
18 for the size of the input set. Then something happens. length $
powerset3 [1..19] runs out of memory on my (not current) version of
Hugs too.

The algorithm is more complex, though.

 Suppose we have a list xs
 Let powerset_n xs = filter (\p -> length p == n) $ powerset xs
 Let ps n i = powerset_n $ (tails xs)!!i
     that is, ps n 0 = powerset_n xs
              ps n (length(xs)-n) = [(tails xs)!!(length(xs)-n)]
	      that is, i varies from 0 to (length(xs)-n)
	      
 We observe that
 ps n (i-1) = ps n i ++ (map (x:) $ ps (n-1) i) where x = xs!!(i-1)
 
 Therefore, if we know ps (n-1) i for all i, we can compute ps n i
 from the base condition
	ps n (length(xs)-n) = [(tails xs)!!(length(xs)-n)]
 and then decrementing i.
 This recurrence is the instance of the right fold
 
 psn n psn1 = foldr (\ (psn1i,x) ps@(psni:_) -> (psni ++ (map(x:) psn1i)):ps)
             [[(tails xs)!!(length(xs)-n)]] $
	     zip (tail$init psn1) xs

 We can build ps n from n=0 onwards, given that 
 ps 0 = map (const [[]]) (tails xs)

we then observe that
	 (tails xs)!!(length(xs)-n) === (reverse $ tails xs) !! n

which, after a few simplifications, gives us

import List

powerset [] = [[]]
powerset [x] = [[],[x]]
powerset xs = [] : runit (tail rsxtails) ps0
   where
	xstails = tails xs
	rsxtails = reverse xstails
	ps0 = map (const [[]]) $ tail xstails
	psn tn psn1 = 
	    foldr 
	      (\ xpsn1i ps@(psni:_) -> (xpsn1i++psni):ps)
	      [[tn]] $
	      zipWith (\x psn1i -> map (x:) psn1i) xs (init $ psn1)
	      
        runit [tn] _ = [xs]
	runit (tn:tns) psn1 = newps0 ++ (runit tns newps)
	    where (newps0:newps) = psn tn psn1


There is still some room for improvement left.

Actually, the following is a slightly faster version, showing off lazy
evaluation:

powerset [] = [[]]
powerset [x] = [[],[x]]
powerset xs = [] : runit (tail rsxtails) ps0
   where
	xstails = tails xs
	rsxtails = reverse xstails
	ps0 = map (const [[]]) xstails
	psn tn psn1 = psnew
	   where
	    psnew = [tn]:
	     (zipWith (++)
	      (reverse (zipWith (\x psn1i -> map (x:) psn1i) xs (tail $ reverse$tail $ psn1)))
	      psnew)

        runit [tn] _ = [xs]
	runit (tn:tns) psn1 = (last newps) ++ (runit tns newps)
	    where newps = psn tn psn1