subsets (recursion homework)
- To: mathgroup at smc.vnet.net
- Subject: [mg9461] subsets (recursion homework)
- From: Daniel Lichtblau <danl>
- Date: Thu, 6 Nov 1997 02:40:07 -0500
- Organization: Wolfram Research, Inc.
- Sender: owner-wri-mathgroup at wolfram.com
Joana Nunes de Almeida wrote:
>
> Hello,
>
> I'm doing a project for my Programming course, but I'm having some
> trouble whith one of the exercises.
> I must define a function where when we put in a list the function gives
> back the different parts of the list.
>
> exp: parts[{1,2}]
> gives: [{1,2},{1},{2},{}]
>
> NB: I must define the function recursivly
Ana Morao wrote:
>
> Hi! My name=B4s Ana and I=B4m starting programming with mathematica ver=
sion
> 2.2.
>
> I have to solve a question, any help will be very appreciated!!!!
>
> I want to define a function that alows me to do the example with any
> conjunct of elements. I have to use recursive programming
>
> Eg.: partes[{}]={{}}
> partes[{1,2,3}]={{},{1},{2},{3},{1,2},{2,3},{1,2,3}}
>
>
> Thanks in advanced
>
> Ana Morao
I answered one by e-mail, before deciding it might be a mistake to give
out homework solutions. I'll describe the basic idea below. If we want
to get the power set (set of all subsets) of a set of k elements, we
can remove one element, get the power set of what remains, then take
the union of this with the subsets formed by augmenting all of these
with the removed element. I believe the method used in the standard
package DiscreteMath`Combinatorica` is along these lines. So a
recursive definition will define the result for the empty set, then
define the result for a set of positive length in terms of the result
for a set of length one less.
The actual code to do this is quite simple. I'm including it mostly
because there are a few other things I'd like to say about the subset
generation problem (and if you hand in my code for your homework, you
mostly cheat yourself).
subsets1[{}]={{}};
subsets1[x_List]/;Length[x]>0 :=
With[{x1=First[x],subp=subsets1[Rest[x]]},
Union[subp, Map[Append[#,x1]&,subp]]] subsets1[{a,b,c,d}] (* to
check the code *)
For a timing test I do
aa = Array[a,17];
In[5]:= Timing[s1 = subsets1[aa];] Out[5]= {13.67 Second, Null}
In[6]:= LeafCount[s1]
Out[6]= 2359297
In[8]:= Length[s1]
Out[8]= 131072
This is on a Pentium Pro running under Linux. I would hesitate to do
this for significantly larger sets. Even 20 elements gave my machine
some memory management problems (probably a problem in how we installed
the OS, but even so, a few more elements brings us to a
mucho-meg-memory requirement).
Whenever I use Append I wonder if there is not a more efficient method.
For example, the reference guide notes for Append in the manual
indicate one might prefer to nest lists and use Flatten when done.
subsets2[{}]={{}};
subsets2[x_List]/;Length[x]>0 :=
With[{x1=First[x],subp=subsets2[Rest[x]]},
Map[Flatten,Union[subp, Map[{#,x1}&,subp]]]]
This works fine, but is a bit slower than subsets1. I believe this is
because subsets1 is not far from optimal even using Append (now I've
made that claim, no doubt some responses will contain faster methods).
We use Append 2^k times (less one for the base case), and this is in
fact the number of distinct subsets we require, so it is hard to come
up with a more efficient constructor. Moral: nest-and-Flatten is fine
for appending incessantly to the same list, but is not so good when one
does O(1) Append per list.
The question called for a recursive algorithm. Actually, it is quite a
challenge (for me) to provide one that is not recursive. One way to do
this is by making a Sequence of iterators, forming all possible {0,1}
strings of length k, then using these to form subsets. It took me some
fiddling with Flatten and other primitives before I got this working,
and I am certain it can be done better, but here goes:
subsets3[{}]={{}};
subsets3[x_List] /; Length[x]>0 :=
Module[{k,indx,indices,n=Length[x],l1},
indx = Array[k,n];
indices = Apply[Sequence, Map[{#,0,1}&, indx]];
l1 = Partition[Flatten[Table[k[j], Evaluate[indices], {j,1,n}]],
n]= ;
Map[Flatten, Table[If [l1[[m,j]]==1, x[[j]], {}],
{m,1,2^n},{j,1,n}]]
]
subsets3[{a,b,c,d}]
This ran about twelve times slower than the first method, and I was not
at all surprised. A different non-recursive algorithm might emulate
subsets1 but using a simple loop instead of recursion to get the
one-less-element case. But I doubt it would improve speed because the
recursive call is made only n times for an input of length n, hence
subroutine overhead is minimal. If instead we use some loop we run the
risk that complicated code will contain some subtle slowness.
Let me change the topic a bit. It is reasonable to ask why one might
want the power set of a given set of k elements. For many purposes it
might be better simply to work with the integers Range[0, 2^k-1] as
elements. A value m in this range can represent a given subset by its
binary string, where 1's stand for those elements in the subset. I
believe this goes under the name of "indicator function" or something
equally polysyllabic. I mention all this mostly to illustrate a bit of
nice new bit-operation functionality in our version under development.
For example, say we have a set of 100 elements. We can use integers in
the range from 0 to 2^100-1 to represent subsets, and take a random
subset of, say, 128 elements in the power set (that is, subset whose
elements are subsets of the original set). Actually, there is nonsero
probability that my subset contains stricly fewer than 128 elements,
but this is still okay for the examples below.
k = 100;
len = 128;
subs = Union[Table[Random[Integer,{0,2^k-1}], {len}]];
A reasonable question might be: "How many elements of subs contain the
third element of the original set?" To answer this we represent the
elements of the original set as "bit masks", that is, integer powers of
two.
masks = Table[2^m, {m,0,k-1}];
So the third element of the set is masks[[3]], which is 2^2, or 4. We
form the function that takes an integer and computes its bit-wise AND
with masks[[3]]. We Map this function over the subset list subs, then
count the number of elements in the result that are positive. The
bit-wise operation has masked out all but the third binary digit of
each member of subs, so the positive values resulting (all will be 4)
are from those member that have a third binary digit set.
func = BitAnd[masks[[3]],#]&
In[26]:= Count[Map[func, subs], _?Positive] Out[26]= 72
Okay, easy enough. How about "How many members of subs contain the sixth
and eleventh elements of the original set, but not the fourteenth?"
(one might expect on average that this would be about an eighth of the
number of elements in subs). Same idea.
func2 = BitAnd[masks[[6]]+masks[[11]]+masks[[14]], #]& crit =
(#==masks[[6]]+masks[[11]])&
In[31]:= Count[Map[func2, subs], _?crit] Out[31]= 13
What about "How many elements contain at least two from among the
fourth, tenth, twentyeighth, and fifty-first elements of the original
set?" As before, we first mask appropriately.
func3 = BitAnd[masks[[4]]+masks[[10]]+masks[[28]]+masks[[51]],#]&
Now we simply Count all those masked values whose DigitCount is at least
two (by default the new function DigitCount will look at binary
digits).
In[38]:= Count[Map[func3, subs], _?(DigitCount[#]>=2&)] Out[38]=
79
Daniel Lichtblau
Wolfram Research
danl at wolfram.com