# Nested sum depending on parameter

I would like to create a function
f[r_, x_]
which returns \begin{align*}\sum_{i_{r-1} = 1}^{f^{r-1}} \sum_{i_{r-2}=1}^{f^{r-2}} \cdots \sum_{i_2 = 1}^{f^2} \sum_{i_1 = 1}^{f} \frac{ \binom{n}{i_1} i_1! \begin{Bmatrix} f \\ i_1\end{Bmatrix} }{n^f} \cdot \frac{ \binom{n}{i_2} i_2! \begin{Bmatrix} f \cdot i_1 \\ i_2\end{Bmatrix} }{n^{f \cdot i_1}} \cdots \frac{ \binom{n}{i_{r-1}} i_{r-1}! \begin{Bmatrix} f \cdot i_{r-2} \\ i_{r-1}\end{Bmatrix} }{n^{f \cdot i_{r-2}}} \cdot \frac{ \binom{n}{x} x! \begin{Bmatrix} f \cdot i_{r-1} \\ x\end{Bmatrix} }{n^{f \cdot i_{r-1}}}\end{align*} where $\begin{Bmatrix} a \\ b\end{Bmatrix}$ represents the Stirling numbers of the second kind.

My problem is to automatize the creation of new sums as a function of $r$.

How should I proceed to create this function?

Thanks for any help

Edit: I tried to inspire myself from this question to solve it, and I have the following code for the moment:

n = 1000;
f = 4;
g[x_, y_] := (Binomial[n, y]*y!*StirlingS2[f*x, y])/n^(f*x);
computeP[r_, x_] := Module[,
sumRanges = Table[f^i, {i, 1, r}];
iterator = Table[{k[m], 1, sumRanges[[m]]}, {m, r}];
ind = First /@ iterator;
N[Sum[g[Sequence@ind - 1, Sequence @ ind],
Evaluate[Sequence @@ iterator]]]
]


The problem is that I am not familiar with the syntax /@, @, @@ so I do not really understand what I am coding.

• @Feyre I updated the post to show you what I have done so far. – Laurent Hayez Dec 4 '16 at 14:36
• Highlight the symbol you do not unserstand (like @ or /@ or #) and press F1, this will show you what function these symbols represent. – bill s Dec 4 '16 at 23:57

Instead of trying to understand all the levels of Map and Apply, let's try a little string hacking.

Suppose r=6 giving five levels of Sum. Introduce i0 and i6 to make pattern more uniform, you must manually keep that i6 in sync with r=6.

r=6;i0=1;i6=x;
"Sum["<>
StringDrop[StringJoin[Table[
"Binomial[n,i"<>ToString[subscript]<>"]"<>
"*i"<>ToString[subscript]<>"!*"<>
"StirlingS2[f*i"<>ToString[subscript-1]<>",i"<>ToString[subscript]<>"]"<>
"/n^(f*i"<>ToString[subscript-1]<>")*",
{subscript,1,r}]],-1]<>
"," <>
StringDrop[StringJoin[Table[
"{i"<>ToString[subscript]<>",1,"<>"f^"<>ToString[subscript]<>"},",
{subscript,1,r-1}]],-1] <>
"]"


When you evaluate that you get the string

"Sum[
Binomial[n,i1]*i1!*StirlingS2[f*i0,i1]/n^(f*i0)*
Binomial[n,i2]*i2!*StirlingS2[f*i1,i2]/n^(f*i1)*
Binomial[n,i3]*i3!*StirlingS2[f*i2,i3]/n^(f*i2)*
Binomial[n,i4]*i4!*StirlingS2[f*i3,i4]/n^(f*i3)*
Binomial[n,i5]*i5!*StirlingS2[f*i4,i5]/n^(f*i4)*
Binomial[n,i6]*i6!*StirlingS2[f*i5,i6]/n^(f*i5),
{i1,1,f^1},{i2,1,f^2},{i3,1,f^3},{i4,1,f^4},{i5,1,f^5}]"


If you wrap ToExpression[] around that string and define the whole thing as a function then I think you get your desired result.

And if you change that to r=12 and i12=x then it gives you eleven nested Sums.

You should carefully check all this to make certain that I haven't let any errors slip into the code.

EDIT

An alternate method that accomplishes the same thing while being shorter, easier to read and thus perhaps less error prone. Just have to watch for string replace collisions.

r = 6; i0 = 1; i6 = x;
"Sum[" <>
StringDrop[StringJoin[Table[StringReplace[
"Binomial[n,iz]*iz!*StirlingS2[f*iy,iz]/n^(f*iy)*",
{"z"->ToString[s], "y"->ToString[s-1]}], {s,1,r}]],-1]<>
","<>
StringDrop[StringJoin[Table[StringReplace[
"{iz,1,f^z},", "z"->ToString[s]], {s,1,r-1}]],-1]<>
"]"

• Awesome! This does the work just as I need! String hacking was a fine idea. Thank you very much. – Laurent Hayez Dec 4 '16 at 21:06
• @Laurent Hayez I realized there was a shorter, less error prone method tand I appended that to the first solution. – Bill Dec 4 '16 at 23:57