0
$\begingroup$
f[0, 0] = 1;
f[a_, b_] := (Solve[b f[a, b] - f[a, b - 1] == 0, f[a, b]] // 
     Flatten)[[1, 2]] /; b != 0
f[a_, b_] := (Solve[a f[a, b] - f[a - 1, b] == 0, f[a, b]] // 
     Flatten)[[1, 2]] /; a != 0

if we calculate f[0,2], there is a RecursionLimit error. Of course, in this case, it can be solved by writing the recursion formula explicitly, e.g.

f[0, b_] := f[0, b - 1]/b /; b != 0
f[a_, b_] := f[a - 1, b]/a /; a != 0

But if the recursive formula requires solving some equations and the results are lengthy, is there an alternative way besides explicitly writing out the recursive formula?

$\endgroup$

3 Answers 3

-1
$\begingroup$

You can not use the symbol f[a,b] in defining f[a,b]. The following code works:

f[0, 0] = 1;
f[a_, b_] := (Solve[b  x - f[a, b - 1] == 0, x] // Flatten)[[1, 2]] /;
   b != 0
f[a_, b_] := (Solve[a  x - f[a - 1, b] == 0, x] // Flatten)[[1, 2]] /;
   a != 0
$\endgroup$
3
  • 2
    $\begingroup$ Solve inside a delayed assignment is not a good idea. $\endgroup$
    – Roman
    Commented May 27 at 6:23
  • 1
    $\begingroup$ An immediate assignment is much more efficient: Clear[f]; f[0, 0] = 1; f[a_, b_ /; b > 0] = SolveValues[b x - f[a, b - 1] == 0, x][[1]]; f[a_ /; a > 0, b_] = SolveValues[a x - f[a - 1, b] == 0, x][[1]]; and adding memoization (see @BobHanlon's answer) speeds it up further. $\endgroup$
    – Roman
    Commented May 27 at 6:37
  • $\begingroup$ @Roman, I completely agree with you. I just pointed out what caused the infinite loop. $\endgroup$
    – A. Kato
    Commented May 28 at 7:41
3
$\begingroup$

The obvious solution with RSolve or RecurrenceTable do not work (bug?):

RSolve[{f[0, 0] == 1, b f[a, b] == f[a, b - 1], a f[a, b] == f[a - 1, b]}, f[a, b], {a, b}]
(*    RSolve: There are fewer dependent variables than equations, so the system is overdetermined.    *)

RecurrenceTable[{f[0, 0] == 1, b f[a, b] == f[a, b - 1], a f[a, b] == f[a - 1, b]}, f[a, b], {a, 0, 3}, {b, 0, 3}]
(*    RecurrenceTable: There are fewer dependent variables than equations, so the system is overdetermined.    *)

But we can solve it one dimension at a time: first, for fixed $a$,

RSolve[{b fa[b] == fa[b - 1]}, fa[b], b]
(*    {{fa[b] -> C[1]/Pochhammer[2, -1 + b]}}    *)

So let's set a formula for $f_a(b)=f(a,b)$:

f[a_, b_] = c[a]/Pochhammer[2, -1 + b];

and solve for $c(a)$ to get the full formula:

RSolve[{f[0, 0] == 1, a f[a, b] == f[a - 1, b]}, c[a], a]
(*    {{c[a] -> 1/Pochhammer[2, -1 + a]}}    *)

The full solution is

f[a, b] /. First[%] // FullSimplify
(*    1/(Gamma[1 + a] Gamma[1 + b])    *)

which is simply $f(a,b)=\frac{1}{a!b!}$.

$\endgroup$
2
$\begingroup$
$Version

(* "14.0.0 for Mac OS X ARM (64-bit) (December 13, 2023)" *)

Clear["Global`*"]

The approach offered by A. Kato:

f[0, 0] = 1;
f[a_, b_] := (Solve[
      b   x - f[a, b - 1] == 0, x] // Flatten)[[1, 2]] /; b != 0
f[a_, b_] := (Solve[
      a   x - f[a - 1, b] == 0, x] // Flatten)[[1, 2]] /; a != 0

calc1 = AbsoluteTiming[(
    tab1 = Table[f[a, b], {a, 0, 4}, {b, 0, 4}]) // Grid]

enter image description here

Recursion with memoization

f2[0, 0] = 1;
f2[0, b_Integer?Positive] := f2[0, b] = f2[0, b - 1]/b;
f2[a_Integer?Positive, b_Integer?NonNegative] := f2[a, b] = f2[a - 1, b]/a;

calc2 = AbsoluteTiming[(
    tab2 = Table[f2[a, b], {a, 0, 6}, {b, 0, 6}]) // Grid]

enter image description here

Both methods produce the same result.

tab1 === tab2

(* True *)

However, the second approach is far more efficient

calc1[[1]]/calc2[[1]]

(* 67.3106 *)
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.