5
$\begingroup$

I would like to be able to enter the following left hand side of an identity. I can write the right hand side (i think) but am not sure about the left. The Left hand side is

$$\sum_{i_1+i_2+...+i_n=k}\binom{k}{i_1,i_2,...,i_n}\frac{f(i_1)f(i_2)...f(i_n)}{k!}$$

where is a function that extracts coefficients from a previously defined generating function. How do you implement this summation with a sum of multiple indicies equal to a particular $k$?


My particular $\,f$ are called Hypergeometric Bernoulli Numbers. The code I have to generate the numbers is below:

 T[m_, x_] = Sum[x^j/j!, {j, 0, m}];
 g[m_, x_] = x^m/(m! (E^x - T[m - 1, x]));

The hypergeometric bernoulli numbers are extracted using the following

 b[m_, n_, M_] := b[m, n, M] = Coefficient[n! Normal[Series[g[m, x], {x, 0, M}]], x, n];

Now I want to sum over the $n$ term defined in the bernoulli number, so I basically want the $\,f$ I wrote in the formula to be replaced by b[m,i[j],M].

$\endgroup$
1
  • 1
    $\begingroup$ I have merged your follow-up question with this one; and have also incorporated changes suggested by @BobHanlon . $\endgroup$
    – QuantumDot
    Dec 27, 2014 at 15:57

3 Answers 3

5
$\begingroup$

I'm not entirely sure what Eleven-eleven is asking, but I think I can write a function that gives his type-set expression (requiring two input variables n and k).

The first step is to do the math problem. How do you write the sum in a computer-friendly way? Like this: $$\sum_{i_1+i_2+\ldots +i_n = k} = \sum_{i_1=0}^k \sum_{i_2=0}^{k-i_1} \cdots\sum_{i_{n-1}=0}^{k-i_1-i_2\ldots-i_{n-2}}\,,$$ and $i_n = k - i_1 - i_2 -\ldots i_{n-1}$ is fixed.

Now proceed with the sum.

elevenEleven[n_, k_, m_, M_] := 
  Module[{i},
    With[{sumIt = 
      Sequence @@ Table[{i[a], 0, k - Sum[i[b], {b, 1, a - 1}]}, {a, 1, n - 1}]},
      i[n] = k - Sum[i[e], {e, 1, n - 1}];
      Sum[Multinomial @@ Table[i[c], {c, 1, n}] * Product[b[m,i[d],M], {d, 1, n}]/k!, 
      sumIt]
    ]
  ]

Here sumItwill basically generate the iterators for the multi-dimensional Sum in the main body. The statement i[n] = k - Sum[i[e], {e, 1, n - 1}] appearing in the main body enforces $i_n = k - i_1 - i_2 -\ldots i_{n-1}$.

Let's test it for $n=4$, $k=2$, $m=4$ and $M=5$:

elevenEleven[3, 2, 4, 5]

7/50

$\endgroup$
11
  • 1
    $\begingroup$ I'm not entirely sure that belasarius is what I need. $\endgroup$ Dec 21, 2014 at 23:53
  • $\begingroup$ @Eleven-Eleven I finished my answer. Please check if the result is correct. $\endgroup$
    – QuantumDot
    Dec 21, 2014 at 23:57
  • $\begingroup$ @Eleven-Eleven I fixed a typo in my answer: 1/n! to 1/k!. $\endgroup$
    – QuantumDot
    Dec 22, 2014 at 0:05
  • $\begingroup$ I have replaced with what I needed and It seems that my sum is always 0 $\endgroup$ Dec 22, 2014 at 1:41
  • 1
    $\begingroup$ @Eleven-Eleven I have edited my answer: please review. $\endgroup$
    – QuantumDot
    Dec 27, 2014 at 16:01
4
$\begingroup$

Interesting problem. Following is cleaner IMO, and quite a bit faster on larger cases than accepted ans. (e.g. over 1000X faster on {n, k, m, M} = {7, 20, 5, 6}, ~5000X faster on {n, k, m, M} = {8, 21, 6, 7}) :

Module[{f, jp, n = #1, k = #2, m = #3, M = #4}, 
   jp = IntegerPartitions[k, {n}, Range[0, k]];
   f[x_] := f[x] = b[m, x, M];
   Tr[Multinomial @@@ (Tally /@ jp)[[All, All, 2]]*Multinomial @@@ jp*
      Times @@@ Map[f, jp, {2}]]/(k!)] &[n, k, m, M]
$\endgroup$
3
  • $\begingroup$ Nicely done! Alternatively, one could have used FrobeniusSolve[] to generate the indices… $\endgroup$ Aug 14, 2015 at 2:19
  • $\begingroup$ @J. M.: Thanks, coming from you means extra. I find using IntegerPartitions with specified domain faster than FrobeniusSolve for these kind of weak composition problems, In any case, had the "DOH!" moment at dinner, see update that is vastly more efficient... $\endgroup$
    – ciao
    Aug 14, 2015 at 5:45
  • $\begingroup$ I see what you mean; not using Permutations[] helps quite a bit. :) $\endgroup$ Aug 14, 2015 at 5:54
2
$\begingroup$

If the indices run from zero:

n = 4; k = 3;
idxs = Join @@ (Permutations /@ (PadRight[#, n] & /@  IntegerPartitions[k]));
Sum[whatever[i], {i, idxs}]
whatever[s_List] := ( Multinomial @@ s) Times @@ ( f /@ s) / k!

(*

 4 f[0] f[1]^3 + 6 f[0]^2 f[1] f[2] + 2/3 f[0]^3 f[3]

*)

If you want to sum up k from 0 to n:

ClearAll["Global`*"]
n = 4;
idxs[n_, k_] := Join @@ (Permutations /@ (PadRight[#, n] & /@ IntegerPartitions[k]));
whatever[s_List, k_] := ( Multinomial @@ s) Times @@ ( f /@ s)/k!
Sum[whatever[i, k], {k, 0, n}, {i, idxs[n, k]}]

(*

f[0]^4 + 4 f[0]^3 f[1] + 6 f[0]^2 f[1]^2 + 4 f[0] f[1]^3 + f[1]^4 + 
 2 f[0]^3 f[2] + 6 f[0]^2 f[1] f[2] + 6 f[0] f[1]^2 f[2] + 
 3/2 f[0]^2 f[2]^2 + 2/3 f[0]^3 f[3] + 2 f[0]^2 f[1] f[3] + 
 1/6 f[0]^3 f[4]
*)
$\endgroup$
17
  • $\begingroup$ The indices would run from 0. But i'm a little confused about how to implement this with the multinomial coefficient and the function f... $\endgroup$ Dec 21, 2014 at 23:52
  • $\begingroup$ @Eleven-Eleven Give me a few minutes $\endgroup$ Dec 21, 2014 at 23:53
  • $\begingroup$ Okay thanks @belisarius! $\endgroup$ Dec 21, 2014 at 23:55
  • 1
    $\begingroup$ @belisarius is there not a $1/k!$ missing? $\endgroup$
    – QuantumDot
    Dec 21, 2014 at 23:58
  • $\begingroup$ @QuantumDot yup, editing, thanks $\endgroup$ Dec 21, 2014 at 23:59

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.