Services & ResourcesWolfram ForumsMathGroup Archive

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

Re: Re: generating submultisets with repeated elements

• To: mathgroup at smc.vnet.net
• Subject: [mg103814] Re: [mg103799] Re: generating submultisets with repeated elements
• From: "Kurt TeKolste" <tekolste at fastmail.us>
• Date: Wed, 7 Oct 2009 07:03:09 -0400 (EDT)
• References: <hadc3d$bjo$1@smc.vnet.net> <200910061202.IAA19756@smc.vnet.net>

It would seem that the emphasis in the Mathematica literature on using
the allegedly highly efficient functions available in Mathematica might
be a bit overstated.  Limitations of memory and time seem to require
falling back to something more akin to the classical procedural
programming style when the problem gets large.

On Tue, 06 Oct 2009 08:02 -0400, "Ray Koopman" <koopman at sfu.ca> wrote:
> 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}
> 
> On Oct 5, 10:58 am, David Bevan <david.be... at pb.com> wrote:
> > Dan, Adriano, Kurt,
> >
> > Thanks for the feedback.
> >
> > Here are some performance results:
> >
> > (* Dan *)
> >
> > Length[multiSetsUpToK[Range[20],7]]//Timing
> >
> > {18.14,888029}
> >
> > (* Adriano *)
> >
> > Length[coinSetsAdriano[Range[20],7]]//Timing
> >
> > {9.516,888029}
> >
> > (* Kurt *)
> >
> > Length[coinSetsKurt[Range[20],7]]//Timing
> >
> > Subsets::toomany: The number of subsets (189407486533) indicated by Subsets=
> > [{1,1,1,1,1,1,1,2,2,2,<<130>>},{1,7}] is too large; it must be a machine in=
> > teger.
> >
> > And with my code:
> >
> > Length[coinSets[Range[20],7]]//Timing
> >
> > {5.063,888029}
> >
> > My 'accumulator' approach seems to be quite effective!
> >
> > However, I'm sure this can be improved significantly with the technique use=
> > d for KSubsets without too much difficulty.
> >
> > David %^>
> 
Regards,
Kurt Tekolste

• References:
  • Re: generating submultisets with repeated elements
    • From: Ray Koopman <koopman@sfu.ca>