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
