Skip to main content

summation - Sum over multiple indices


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].



Answer



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



Comments

Popular posts from this blog

front end - keyboard shortcut to invoke Insert new matrix

I frequently need to type in some matrices, and the menu command Insert > Table/Matrix > New... allows matrices with lines drawn between columns and rows, which is very helpful. I would like to make a keyboard shortcut for it, but cannot find the relevant frontend token command (4209405) for it. Since the FullForm[] and InputForm[] of matrices with lines drawn between rows and columns is the same as those without lines, it's hard to do this via 3rd party system-wide text expanders (e.g. autohotkey or atext on mac). How does one assign a keyboard shortcut for the menu item Insert > Table/Matrix > New... , preferably using only mathematica? Thanks! Answer In the MenuSetup.tr (for linux located in the $InstallationDirectory/SystemFiles/FrontEnd/TextResources/X/ directory), I changed the line MenuItem["&New...", "CreateGridBoxDialog"] to read MenuItem["&New...", "CreateGridBoxDialog", MenuKey["m", Modifiers-...

How to thread a list

I have data in format data = {{a1, a2}, {b1, b2}, {c1, c2}, {d1, d2}} Tableform: I want to thread it to : tdata = {{{a1, b1}, {a2, b2}}, {{a1, c1}, {a2, c2}}, {{a1, d1}, {a2, d2}}} Tableform: And I would like to do better then pseudofunction[n_] := Transpose[{data2[[1]], data2[[n]]}]; SetAttributes[pseudofunction, Listable]; Range[2, 4] // pseudofunction Here is my benchmark data, where data3 is normal sample of real data. data3 = Drop[ExcelWorkBook[[Column1 ;; Column4]], None, 1]; data2 = {a #, b #, c #, d #} & /@ Range[1, 10^5]; data = RandomReal[{0, 1}, {10^6, 4}]; Here is my benchmark code kptnw[list_] := Transpose[{Table[First@#, {Length@# - 1}], Rest@#}, {3, 1, 2}] &@list kptnw2[list_] := Transpose[{ConstantArray[First@#, Length@# - 1], Rest@#}, {3, 1, 2}] &@list OleksandrR[list_] := Flatten[Outer[List, List@First[list], Rest[list], 1], {{2}, {1, 4}}] paradox2[list_] := Partition[Riffle[list[[1]], #], 2] & /@ Drop[list, 1] RM[list_] := FoldList[Transpose[{First@li...

plotting - How to draw lines between specified dots on ListPlot?

I would like to create a plot where I have unconnected dots and some connected. So far, I have figured out how to draw the dots. My code is the following: ListPlot[{{1, 1}, {2, 2}, {3, 3}, {4, 4}, {1, 4}, {2, 5}, {3, 6}, {4, 7}, {1, 7}, {2, 8}, {3, 9}, {4, 10}, {1, 10}, {2, 11}, {3, 12}, {4,13}, {2.5, 7}}, Ticks -> {{1, 2, 3, 4}, None}, AxesStyle -> Thin, TicksStyle -> Directive[Black, Bold, 12], Mesh -> Full] I have thought using ListLinePlot command, but I don't know how to specify to the command to draw only selected lines between the dots. Do have any suggestions/hints on how to do that? Thank you. Answer One possibility would be to use Epilog with Line : ListPlot[ {{1, 1}, {2, 2}, {3, 3}, {4, 4}, {1, 4}, {2, 5}, {3, 6}, {4, 7}, {1, 7}, {2, 8}, {3, 9}, {4, 10}, {1, 10}, {2, 11}, {3, 12}, {4, 13}, {2.5, 7}}, Ticks -> {{1, 2, 3, 4}, None}, AxesStyle -> Thin, TicksStyle -> Directive[Black, Bold, 12], Mesh -> Full, Epilog -> { Line[ ...