Re: Listing the partitions of a set
- To: mathgroup at smc.vnet.net
- Subject: [mg65304] Re: Listing the partitions of a set
- From: "Valeri Astanoff" <astanoff at yahoo.fr>
- Date: Sat, 25 Mar 2006 05:17:39 -0500 (EST)
- References: <e0022d$plp$1@smc.vnet.net>
- Sender: owner-wri-mathgroup at wolfram.com
A slightly improved version
(thanks to Mr.Ewenchik) :
In[1]:=myPartitions[li_List /; VectorQ[li] && Length[li]>0]:=
Module[{n, maxi, ok, mySort},
n = Length[li];
maxi = FromDigits[Rest@(Table[{0,k},{k,1,n}]//Flatten),n+1];
ok[numbers_List] := Last[numbers] != 0 && And@@
(Count[numbers,#] == 1& /@ Range[n]);
mySort[numbers_List] := (Sort /@ Split[numbers,
#1 != 0 && #2 != 0 && #1 != #2 &])//
Sort // DeleteCases[#,{0}]&;
Union[mySort /@ Select[IntegerDigits[#, n+1]& /@
Range[maxi],ok]] /. Thread[Range[n] -> li]
];
In[2]:=myPartitions[{a,b,c,d,e}]//Timing
Out[2]={74.75 Second,{{{a,b,c,d,e}},{{a},{b,c,d,e}},{{b},{a,c,d,e}},
{{c},{a,b,d,e}},{{d},{a,b,c,e}},{{e},{a,b,c,d}},{{a,b},{c,d,e}},
{{a,c},{b,d,e}},{{a,d},{b,c,e}},{{a,e},{b,c,d}},{{b,c},{a,d,e}},
{{b,d},{a,c,e}},{{b,e},{a,c,d}},{{c,d},{a,b,e}},{{c,e},{a,b,d}},
{{d,e},{a,b,c}},{{a},{b},{c,d,e}},{{a},{c},{b,d,e}},{{a},{d},{b,c,e}},
{{a},{e},{b,c,d}},{{a},{b,c},{d,e}},{{a},{b,d},{c,e}},{{a},{b,e},
{c,d}},{{b},{c},{a,d,e}},{{b},{d},{a,c,e}},{{b},{e},{a,c,d}},
{{b},{a,c},{d,e}},{{b},{a,d},{c,e}},{{b},{a,e},{c,d}},{{c},{d},{a,b,e}},
{{c},{e},{a,b,d}},{{c},{a,b},{d,e}},{{c},{a,d},{b,e}},{{c},{a,e},
{b,d}},{{d},{e},{a,b,c}},{{d},{a,b},{c,e}},{{d},{a,c},{b,e}},
{{d},{a,e},{b,c}},{{e},{a,b},{c,d}},{{e},{a,c},{b,d}},{{e},{a,d},
{b,c}},{{a},{b},{c},{d,e}},{{a},{b},{d},{c,e}},{{a},{b},{e},{c,d}},
{{a},{c},{d},{b,e}},{{a},{c},{e},{b,d}},{{a},{d},{e},{b,c}},
{{b},{c},{d},{a,e}},{{b},{c},{e},{a,d}},{{b},{d},{e},{a,c}},
{{c},{d},{e},{a,b}},{{a},{b},{c},{d},{e}}}}
In[3]:=Length[% // Last]
Out[3]=52
v.a.