Re: Listing the partitions of a set
- To: mathgroup at smc.vnet.net
- Subject: [mg65301] Re: Listing the partitions of a set
- From: "Valeri Astanoff" <astanoff at yahoo.fr>
- Date: Sat, 25 Mar 2006 05:17:36 -0500 (EST)
- References: <e0022d$plp$1@smc.vnet.net>
- Sender: owner-wri-mathgroup at wolfram.com
A solution which is not very fast but does work :
In[1]:=myPartitions[li_List /; VectorQ[li] && Length[li]>0]:=
Module[{n, maxi, sel1, sel2, sel3, sel4},
n = Length[li];
maxi = FromDigits[Rest@(Table[{0,k},{k,1,n}]//Flatten),n+1];
sel1 = (IntegerDigits[#,n+1]& /@ Range[maxi])//.
{a___,0,0,b___} -> {a,0,b};
sel2 = Select[sel1,# == Range[n]||(Rest@Union[#] == Range[n]&&
Total[#] == Total@Range[n] && Last[#]>0)&];
sel3 = Union[sel2 //. ({a___, x_/;x>0, y_/;y>0, b___}/;y<x) ->
{a,y,x,b}];
sel4 = Union[Union[( Split[#,#1>0 && #2>0 && #1 != #2&] /.
{0} -> Sequence[])]& /@ sel3];
sel4 /. Thread[Range[n] -> li]
];
In[2]:=myPartitions[{a,b,c,d}]
Out[2]={{{a,b,c,d}},{{a},{b,c,d}},{{b},{a,c,d}},{{c},{a,b,d}},
{{d},{a,b,c}},{{a,b},{c,d}},{{a,c},{b,d}},{{a,d},{b,c}},
{{a},{b},{c,d}},{{a},{c},{b,d}},{{a},{d},{b,c}},{{b},{c},{a,d}},
{{b},{d},{a,c}},{{c},{d},{a,b}},{{a},{b},{c},{d}}}
In[3]:=Length[%]
Out[3]=15
hth
V.Astanoff