Services & Resources / Wolfram Forums / MathGroup Archive
-----

MathGroup Archive 2009

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

Search the Archive

Re: Re: generating submultisets with repeated elements

  • To: mathgroup at smc.vnet.net
  • Subject: [mg103829] Re: [mg103799] Re: generating submultisets with repeated elements
  • From: David Bevan <david.bevan at pb.com>
  • Date: Thu, 8 Oct 2009 07:51:13 -0400 (EDT)
  • References: <hadc3d$bjo$1@smc.vnet.net> <200910061202.IAA19756@smc.vnet.net>

Ray,

That's an interesting and useful trick.

It's as fast as coding "next multiset" in a compiled loop:

MSN3Base =
   Compile[{{n, _Integer}, {k, _Integer}},
      Module[{h, ss = ConstantArray[1, k]},
         Table[
            (
               h = k;
               While[n === ss[[h]], h--];
               ss = Join[Take[ss, h-1],
                         ConstantArray[ss[[h]]+1, k-h+1]]
            ),
            {Binomial[n+k-1, k]-1}
         ]
      ]
   ];
MSN3[n_, k_] := Prepend[MSN3Base[n, k], ConstantArray[1, k]]


Length[subsets[20,8]]//Timing
{3.656,2220075}

Length[MSN3[20,8]]//Timing
{3.562,2220075}

Thanks.

David %^>


> -----Original Message-----
> From: Ray Koopman [mailto:koopman at sfu.ca]
> Sent: 6 October 2009 13:03
> To: mathgroup at smc.vnet.net
> Subject: [mg103799] Re: generating submultisets with repeated elements
>
> Here's some "roll your own nested loops" code.
> It's faster than the "accumulator" approach.
>
> subsets[n_,1] := Transpose@{Range@n};
> subsets[n_,k_] := ToExpression["Flatten[Table["<>
> StringTake[ToString@Table[Which[
> j==0, "i"<>ToString@#& /@ Range@k,
> j==1, {"i1",n},
> True, {"i"<>ToString@j,"i"<>ToString[j-1],n}],
> {j,0,k}],{2,-2}]<>"],"<>ToString[k-1]<>"]"]
>
> coinsets[s_,k_] := s[[#]]& /@ Join@@(subsets[Length@s,#]&/@Range@k)
>
> coinSets[s_,k_] := Flatten[Table[subMultiSets[s,i],{i,k}],1];
> subMultiSets[s_,k_] := smsLoop[{},s,k];
> smsLoop[{ts___},{x_},1] := {{ts,x}};
> smsLoop[t:{ts___},{x_,xs___},1] := Prepend[smsLoop[t,{xs},1],{ts,x}];
> smsLoop[{ts___},s:{x_},k_] := smsLoop[{ts,x},s,k-1];
> smsLoop[t:{ts___},s:{x_,xs___},k_] := Join[smsLoop[{ts,x},s,k-1],
>                                            smsLoop[t,{xs},k]]
>
> coinsets[{1,3,4,9},3]
> % == coinSets[{1,3,4,9},3]
>
> {{1},{3},{4},{9},{1,1},{1,3},{1,4},{1,9},{3,3},{3,4},{3,9},{4,4},
>  {4,9},{9,9},{1,1,1},{1,1,3},{1,1,4},{1,1,9},{1,3,3},{1,3,4},{1,3,9},
>  {1,4,4},{1,4,9},{1,9,9},{3,3,3},{3,3,4},{3,3,9},{3,4,4},{3,4,9},
>  {3,9,9},{4,4,4},{4,4,9},{4,9,9},{9,9,9}}
> True
>
> Timing@Length@coinsets[Range@20,7]
> {6.69 Second,888029}
>
> Timing@Length@coinSets[Range@20,7]
> {11.03 Second,888029}
>


  • Prev by Date: Re: Limiting the number of messages
  • Next by Date: Re: How to find which variable caused the trigger in Manipulate[]
  • Previous by thread: Re: Re: generating submultisets with repeated elements
  • Next by thread: Re: Re: Re: generating submultisets with