Re: k-permutations enumeration
- To: mathgroup at smc.vnet.net
- Subject: [mg116377] Re: k-permutations enumeration
- From: Ray Koopman <koopman at sfu.ca>
- Date: Sat, 12 Feb 2011 05:20:11 -0500 (EST)
----- Daniel Lichtblau <danl at wolfram.com> wrote: > Daniel Lichtblau wrote: >> Ray Koopman wrote: >>> On Feb 10, 2:23 am, Michal Kvasnicka <michal.kvasni... at gmail.com> >>> wrote: >>>> How can I find the number of k-permutations of n objects, >>>> where there are x types of objects, and r1, r2, r3 ... rx give >>>> the number of each type of object? >>>> >>>> Example: >>>> I have 20 letters from the alphabet. There are some duplicates - >>>> 4 of them are a, 5 of them are b, 8 of them are c, and 3 are d. >>>> How many unique 15-letter permutations can I make? >>>> >>>> In the example: >>>> >>>> n = 20 >>>> k = 15 >>>> x = 4 >>>> r1 = 4, r2 = 5, r3 = 8, r4 = 3 >>>> >>>> Furthermore, if there isn't a straightforward solution: how >>>> efficiently can this problem be solved? Any Mathematica code? >>> >>> Please disregard my previous post, which counted only >>> "words" containing all of the x different "letters". >>> >>> k = 15; r = {4,5,8,3}; >>> Tr[Multinomial@@@Select[Tuples[Range[0,#]&/@r],Tr@#==k&]] >>> >>> 187957770 >> >> Another approach is to use an exponential generating function. >> It seems to be fairly fast. >> >> multvals = {4, 5, 8, 3}; >> select = 15; >> factors = Map[summand[x, #] &, multvals]; >> Coefficient[Factorial[select]*Times @@ factors, x^select] >> >> 187957770 >> >> Daniel Lichtblau >> Wolfram Research > > Ray Koopman pointed out to me that I forgot to show the definition of > summand. (He even provided me with a shorter variant, which I will use. > How thoughtful.) > > summand[x_,n_] := Sum[x^r/r!,{r,0,n}] > > Daniel Lichtblau > Wolfram Research Here's a faster version of my algorithm: k = 15; r = {4,5,8,3}; AbsoluteTiming[ Tr[ Multinomial @@@ (Pick[#,Total@Transpose@#,k]&)@ Tuples[Range[0,#]&/@r] ] ] {0.002100 Second, 187957770} That's more than 3x as fast as the original, and almost as fast as Daniel's approach: multvals = {4, 5, 8, 3}; select = 15; summand[x_,n_] := Sum[x^r/r!,{r,0,n}]; AbsoluteTiming[ factors = Map[summand[x, #] &, multvals]; Coefficient[Factorial[select]*Times @@ factors, x^select] ] {0.002008 Second, 187957770}