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

MathGroup Archive 2009

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

Search the Archive

Re: generating submultisets with repeated elements

  • To: mathgroup at smc.vnet.net
  • Subject: [mg103876] Re: generating submultisets with repeated elements
  • From: Ray Koopman <koopman at sfu.ca>
  • Date: Sat, 10 Oct 2009 07:09:10 -0400 (EDT)
  • References: <hadc3d$bjo$1@smc.vnet.net> <200910061202.IAA19756@smc.vnet.net>

MSN3a[n_,k_] := Join[{Table[1,{k}]},MSN3Base[n,k]]

Timing@Length@MSN3a[20,8]
{6.39 Second,2220075}

Timing@Length@MSN3[20,8]
{7.3 Second,2220075}

On Oct 8, 4:51 am, David Bevan <david.be... at pb.com> wrote:
> 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:koop... at sfu.ca]
>> Sent: 6 October 2009 13:03
>> To: mathgr... at smc.vnet.net
>> Subject:  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: For interest: oil prices with FX for comparison
  • Next by Date: How to find the machine number nearest to an exact number -- N[] fails
  • Previous by thread: Re: Re: Re: generating submultisets with
  • Next by thread: Re: Re: Re: generating submultisets with