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}