7
$\begingroup$

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.

$\endgroup$
8
$\begingroup$

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.

$\endgroup$
  • $\begingroup$ You're missing the nonnegative condition and the memoization, but otherwise it looks ok :) $\endgroup$ – Teake Nutma Aug 26 '14 at 15:22
  • $\begingroup$ @TeakeNutma: I've now added both. Thank you for noting. $\endgroup$ – celtschk Aug 26 '14 at 15:27
  • $\begingroup$ I think the code is missing the closing bracket of the if-condition. It seems very fast and i hope i can extend it to match the actual formula. :) $\endgroup$ – kon Aug 26 '14 at 16:37
  • $\begingroup$ @kon: Indeed, that closing bracket was missing (reminder to self: don't skip testing, even for simple changes!). Thank you for noting, and for the accept. $\endgroup$ – celtschk Aug 27 '14 at 8:11
6
$\begingroup$

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}
$\endgroup$
  • $\begingroup$ You seem to be a little bit absent lately. I hope everything is well and that you are just harvesting trees in the Oregon woods ? $\endgroup$ – eldo Oct 6 '14 at 0:44
  • $\begingroup$ @eldo Thanks for noticing. I am well, just a bit busy with things, and also enjoying the last of the warm sunny weather for the year. If last year is an indicator I'll be a bit absent until January, but I'll still be available when needed. $\endgroup$ – Mr.Wizard Oct 6 '14 at 18:40

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.