Services & Resources / Wolfram Forums
-----
 /
MathGroup Archive
2006
*January
*February
*March
*April
*May
*June
*July
*August
*September
*October
*November
*December
*Archive Index
*Ask about this page
*Print this page
*Give us feedback
*Sign up for the Wolfram Insider

MathGroup Archive 2006

[Date Index] [Thread Index] [Author Index]

Search the Archive

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


  • Prev by Date: Re: Listing the partitions of a set
  • Next by Date: Another older one that is a treat : a triangular von Koch type fractal
  • Previous by thread: Re: Listing the partitions of a set
  • Next by thread: Re: Listing the partitions of a set