Re: generating submultisets with repeated elements
- To: mathgroup at smc.vnet.net
- Subject: [mg103995] Re: generating submultisets with repeated elements
- From: David Bevan <david.bevan at pb.com>
- Date: Thu, 15 Oct 2009 07:15:29 -0400 (EDT)
- References: <ha4r9k$d0h$1@smc.vnet.net>
Leonid, This is certainly the fastest so far: Transpose[Transpose[Subsets[Range[n+k-1],{k}]]-Range[0,k-1]] Thanks. David %^> ________________________________________ From: Leonid Shifrin [lshifr at gmail.com] Sent: 12 October 2009 11:38 To: mathgroup at smc.vnet.net Subject: [mg103995] [mg103917] Re: [mg103883] Re: [mg103861] Re: [mg103827] Re: [mg103806] Re: Hi Bobby, My code does not do anything new, it just optimizes the code and ideas expressed before in this thread. My guess is that you are comparing different things: 1. My code (and David's original coinSets) computes all subsets of length *up to* K, and is already a lump sum of contributions for k=1,2,...,K, while other's code is concerned with a fixed k case (subsets of the fixed length k). It is subMultiSetsNew that has to be compared with other's solutions, in terms of number of subsets. In[1]:= subMultiSetsNew[Range[15],7]//Length Out[1]= 116280 Agrees with your benchmark 2. My code (and David's coinSets) both give subsets of an arbitrary list, while other's code look at the positions - so that code needs another step of extracting elements by their positions in subsets - this step requires additional time. When you add the definition coinSetsNew[n_Integer, k_] := coinSetsNew[Range@n, k] (which wasn't there in my original code), this slows the function down with respect to what it could be, were I interested in just positions: in this case, I would skip the Partition[s[[Flatten[#]]], k] call in subMultiSetsNew (as I do below). When you sum the contributions of different k = 1,...,K, and include the original elements extraction step, the number of subsets will be the same as in David's and mine solutions, while the timings will likely be worse than mine, since more operations are performed in other solutions. Here is the benchmark you did, with the fastest of the previous solutions vs mine (mine with the following modification): Clear[subMultiSetsPositions]; subMultiSetsPositions[s_List, k_] := Transpose[Transpose[Subsets[Range[Length[s] + k - 1], {k}]] - Range[0, k - 1]]; Clear[MSN3, MSN3Base] 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]] In[2] = n = 15; k = 7; Timing@Length@(res1 = MSN3[n, k]) Timing@Length@(res2 = subMultiSetsPositions[Range[n], k]) Out[2]= {0.56, 116280} Out[3]= {0.151, 116280} In[4]:= res1 == res2 Out[4]= True Regards, Leonid. On Sun, Oct 11, 2009 at 1:24 PM, DrMajorBob <btreat1 at austin.rr.com> wrote: > Leonid, > > In my tests, that code returns too many subsets, and so does David's > coinSets... unless Binomial[n + k - 1, k] is the wrong count, and the > earlier methods were wrong. > > << "Combinatorica`"; > > Clear[f, g, test1, test2, test3] > f[set_] := Table[set[[i]] - (i - 1), {i, Length[set]}] > g[set_] := set - Range[0, Length@set - 1] > test1[n_, k_] := f /@ KSubsets[Range[n + k - 1], k] > test2[n_, k_] := g /@ KSubsets[Range[n + k - 1], k] > test3[n_, k_] := g /@ Subsets[Range[n + k - 1], {k}] > > (* David Bevan *) > > msNew[s_List, k_] := > Flatten[Flatten[ > Outer[Inner[ConstantArray, #1, #2, Flatten[List[##], 1] &, 1] &, > Subsets[s, {Length[#[[1]]]}], #, 1], 1] & /@ > Split[Flatten[Permutations /@ IntegerPartitions[k], 1], > Length[#1] == Length[#2] &], 1] > coinSets[s_List, k_] := Join @@ Table[msNew[s, i], {i, k}] > coinSets[n_Integer, k_] := coinSets[Range@n, k] > > (* David Bevan *) > Clear[MSN3, MSN3Base] > 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]] > > (* Ray Koopman *) > > MSN3a[n_, k_] := Join[{Table[1, {k}]}, MSN3Base[n, k]] > > (* Leonid Shifrin: *) > Clear[subMultiSetsNew, coinSetsNew]; > subMultiSetsNew[s_List, k_] := > Partition[s[[Flatten[#]]], k] &@ > Transpose[ > Transpose[Subsets[Range[Length[s] + k - 1], {k}]] - > Range[0, k - 1]]; > coinSetsNew[s_List, k_] := > Flatten[Table[subMultiSetsNew[s, i], {i, k}], 1]; > coinSetsNew[n_Integer, k_] := coinSetsNew[Range@n, k] > > n = 15; k = 7; > Timing@Length@test3[n, k] > Timing@Length@coinSets[n, k] > Timing@Length@MSN3[n, k] > Timing@Length@MSN3a[n, k] > Timing@Length@coinSetsNew[n, k] > Binomial[n + k - 1, k] > > {0.906038, 116280} > > {1.34786, 170543} > > {0.130817, 116280} > > {0.135289, 116280} > > {0.23856, 170543} > > 116280 > > n = 15; k = 10; > Timing@Length@test3[n, k] > Timing@Length@coinSets[n, k] > Timing@Length@MSN3[n, k] > Timing@Length@MSN3a[n, k] > Timing@Length@coinSetsNew[n, k] > Binomial[n + k - 1, k] > > {15.3937, 1961256} > > {29.7325, 3268759} > > {2.47349, 1961256} > > {2.33108, 1961256} > > {5.32499, 3268759} > > 1961256 > > Bobby > > > On Sat, 10 Oct 2009 06:10:29 -0500, Leonid Shifrin <lshifr at gmail.com> > wrote: > > I've made a few more optimizations: >> >> Clear[subMultiSetsNew]; >> subMultiSetsNew[s_, k_] := >> Partition[s[[Flatten[#]]], k] &@ >> Transpose[ >> Transpose[Subsets[Range[Length[s] + k - 1], {k}]] - >> Range[0, k - 1]]; >> >> Clear[coinSetsNew]; >> coinSetsNew[s_, k_] := >> Flatten[Table[subMultiSetsNew[s, i], {i, k}], 1]; >> >> Now (coinSets is David's "accumulator" version): >> >> In[1]:= (res1=coinSets[Range[15],7])//Length//Timing >> >> Out[1]= {2.333,170543} >> >> In[2]:= (res2 = coinSetsNew[Range[15],7])//Length//Timing >> Out[2]= {0.37,170543} >> >> In[3]:= res1==res2 >> >> Out[3]= True >> >> Regards, >> Leonid >> >> >> >> >> >> >> >> On Fri, Oct 9, 2009 at 4:18 AM, David Bevan <david.bevan at pb.com> wrote: >> >> >>> ... and using Subsets[set, {k}] is much faster than KSubsets[set, k] >>> >>> >>> > -----Original Message----- >>> > From: DrMajorBob [mailto:btreat1 at austin.rr.com] >>> > Sent: 8 October 2009 17:05 >>> > To: David Bevan; mathgroup at smc.vnet.net >>> > Cc: bayard.webb at gmail.com >>> > Subject: Re: [mg103827] Re: [mg103806] Re: generating submultisets wi= th >>> > repeated elements >>> > >>> > g is an improvement over f, I think: >>> > >>> > << "Combinatorica`"; >>> > >>> > Clear[f, g, test1, test2] >>> > f[set_] := Table[set[[i]] - (i - 1), {i, Length[set]}] >>> > g[set_] := set - Range[0, Length@set - 1] >>> > test1[n_, k_] := With[{set = Range[n + k - 1]}, >>> > f /@ KSubsets[set, k]] >>> > test2[n_, k_] := With[{set = Range[n + k - 1]}, >>> > g /@ KSubsets[set, k]] >>> > >>> > n = 15; k = 10; >>> > Timing@Length@test1[n, k] >>> > Timing@Length@test2[n, k] >>> > Binomial[n + k - 1, k] >>> > >>> > {32.9105, 1961256} >>> > >>> > {16.3832, 1961256} >>> > >>> > 1961256 >>> > >>> > Bobby >>> > >>> > On Thu, 08 Oct 2009 06:50:51 -0500, David Bevan <david.bevan at pb.com> >>> > wrote: >>> > >>> > > That's an interesting bijection I wasn't aware of. Thanks. >>> > > >>> > > David %^> >>> > > >>> > >> -----Original Message----- >>> > >> From: monochrome [mailto:bayard.webb at gmail.com] >>> > >> Sent: 7 October 2009 12:02 >>> > >> To: mathgroup at smc.vnet.net >>> > >> Subject: [mg103806] Re: generating submultisets with repeated >>> elements >>> > >> >>> > >> I did a little research and found out that there are Choose(n+k-1, >>> k) >>> > >> multisets of size k from a set of size n. This made me think that >>> > >> there should be a mapping from the k-subsets of n+k-1 to the k- >>> > >> multisets of n. A few quick examples led me to the following >>> function: >>> > >> >>> > >> f[set_] := Table[set[[i]] - (i - 1), {i, Length[set]}] >>> > >> >>> > >> This allows the following construction using the KSubsets function >>> > >> from Combinatorica: >>> > >> >>> > >> << "Combinatorica`"; >>> > >> n = 6; >>> > >> k = 3; >>> > >> set = Range[n + k - 1]; >>> > >> Map[f, KSubsets[set, k]] >>> > >> >>> > >> ===OUTPUT=== >>> > >> {{1, 1, 1}, {1, 1, 2}, {1, 1, 3}, {1, 1, 4}, {1, 1, 5}, {1, 1, 6}, >>> {1, >>> > >> 2, 2}, {1, 2, 3}, {1, 2, 4}, {1, 2, 5}, {1, 2, 6}, {1, 3, 3}, {= 1, >>> > >> 3, 4}, {1, 3, 5}, {1, 3, 6}, {1, 4, 4}, {1, 4, 5}, {1, 4, 6}, {1= , >>> 5, >>> > >> 5}, {1, 5, 6}, {1, 6, 6}, {2, 2, 2}, {2, 2, 3}, {2, 2, 4}, {2, = 2, >>> > >> 5}, {2, 2, 6}, {2, 3, 3}, {2, 3, 4}, {2, 3, 5}, {2, 3, 6}, {2, 4= , >>> > >> 4}, {2, 4, 5}, {2, 4, 6}, {2, 5, 5}, {2, 5, 6}, {2, 6, 6}, {3, 3= , >>> > >> 3}, {3, 3, 4}, {3, 3, 5}, {3, 3, 6}, {3, 4, 4}, {3, 4, 5}, {3, 4= , >>> > >> 6}, {3, 5, 5}, {3, 5, 6}, {3, 6, 6}, {4, 4, 4}, {4, 4, 5}, {4, 4= , >>> > >> 6}, {4, 5, 5}, {4, 5, 6}, {4, 6, 6}, {5, 5, 5}, {5, 5, 6}, {5, 6= , >>> > >> 6}, {6, 6, 6}} >>> > >> >>> > > >>> > >>> > >>> > -- >>> > DrMajorBob at yahoo.com >>> >>> >>> >>> >> > > -- > DrMajorBob at yahoo.com >=