4
$\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
    $\begingroup$ I have merged your follow-up question with this one; and have also incorporated changes suggested by @BobHanlon . $\endgroup$ – QuantumDot Dec 27 '14 at 15:57
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$
  • 1
    $\begingroup$ I'm not entirely sure that belasarius is what I need. $\endgroup$ – Eleven-Eleven Dec 21 '14 at 23:53
  • $\begingroup$ @Eleven-Eleven I finished my answer. Please check if the result is correct. $\endgroup$ – QuantumDot Dec 21 '14 at 23:57
  • $\begingroup$ @Eleven-Eleven I fixed a typo in my answer: 1/n! to 1/k!. $\endgroup$ – QuantumDot Dec 22 '14 at 0:05
  • $\begingroup$ I have replaced with what I needed and It seems that my sum is always 0 $\endgroup$ – Eleven-Eleven Dec 22 '14 at 1:41
  • 1
    $\begingroup$ @Eleven-Eleven I have edited my answer: please review. $\endgroup$ – QuantumDot Dec 27 '14 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$
  • $\begingroup$ Nicely done! Alternatively, one could have used FrobeniusSolve[] to generate the indices… $\endgroup$ – J. M. will be back soon Aug 14 '15 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 '15 at 5:45
  • $\begingroup$ I see what you mean; not using Permutations[] helps quite a bit. :) $\endgroup$ – J. M. will be back soon Aug 14 '15 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$
  • $\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$ – Eleven-Eleven Dec 21 '14 at 23:52
  • $\begingroup$ @Eleven-Eleven Give me a few minutes $\endgroup$ – Dr. belisarius Dec 21 '14 at 23:53
  • $\begingroup$ Okay thanks @belisarius! $\endgroup$ – Eleven-Eleven Dec 21 '14 at 23:55
  • 1
    $\begingroup$ @belisarius is there not a $1/k!$ missing? $\endgroup$ – QuantumDot Dec 21 '14 at 23:58
  • $\begingroup$ @QuantumDot yup, editing, thanks $\endgroup$ – Dr. belisarius Dec 21 '14 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.