Recursive function with array of variables

Question

I am trying to create a recursive function which works with an increasing array of variables. Since the formula is quite complex, i will try to simplify my example to the core of my problem.

The initial value of the array should be $f[\{1\}]=2$ and all other arrays with a single element should have the value $0$.

When an array of size $n$ is given to the function, it will reduce the size of the array to $n-1$ by dropping the first element. So if an array with the values $\{0,0,1,0,2\}$ is given, it will reduce it to $\{0,1,0,2\}$, or more generally the array $\{r_5 ,r_4 ,r_3 ,r_2 ,r_1\}$ will be reduced to $\{r_4 ,r_3 ,r_2 ,r_1\}$. The computation in this case should be: $$f[\{r_5 ,r_4 ,r_3 ,r_2 ,r_1\}]=(r_4 -1)*f[\{r_4 -1,r_3 ,r_2 ,r_1\}]+(r_3 -1)*f[\{r_4 ,r_3 -1,r_2 ,r_1\}]+(r_2 -1)*f[\{r_4 ,r_3 ,r_2 -1,r_1\}]+(r_1 -1)*f[\{r_4 ,r_3 ,r_2 ,r_1-1\}]$$

To speed up the computation, the function should memorize results and arrays containing a negative element ($-1$) should not be computed and instead given the value 0.

My attempt so far starts with:

f[r_] := f[r] = With[{n = Length[r], k = Rest[r]}

...

To change the values of the $r_i$, I generated a For-Loop (from $1$ to $n$) containing:

f[ReplacePart[k, -i -> Part[k, -i] - 1]]

Any help is highly appreciated.

Answer 1

I'd let the pattern matcher do most of the work. First, the recursion start:

f[{1}] = 2
f[{_}] = 0

Now the actual recursion:

f[{x_, rest__}] :=
   f[{x, rest}] = If[Min[{x,rest}]<0, 0,
                     ({rest}-1).Table[f[ReplacePart[{rest},
                                                    k -> ({rest}[[k]]-1)]],
                                      {k, 1, Length[{rest}]}]]

Explanation:

_ matches any single expression, therefore {_} matches every list containing a single expression. However for f[{1}] you have a better match from the first definition, therefore that is used in that case.

If you have more than one element in the list, the second term matches: The _ matches the first expression, and rest__ matches the other expressions, replacing each occurrence of rest on the right hand side by that expression sequence.

{rest}-1 subtracts 1 from any element of {rest}, and list1.list2 multiplies corresponding elements of the two lists, and adds the results.

The rest should be clear, I think.

Answer 2

Here is a refactoring of celtschk's code; it is both shorter and faster:

f[{1}] = 2;
f[{_}] = 0;
f[x_List] /; Min[x] < 0 = 0;
mem : f[{_, x__}] := mem =
  ({x} - 1).Table[f @ MapAt[# - 1 &, {x}, i], {i, Length @ {x}}]

Test:

{4, 6, 5, 8, 5, 2, 5, 1, 5, 9, 0, 5, 3, 5, 2, 7, 3} // f // AbsoluteTiming

{1.312075, 22727314469007948800}