How can I evaluate only a single step of a recursive function?

Question

Let's say have a simple recursive function for the Fibonacci sequence

f[0] := 1
f[1] := 1
f[n_] := f[n - 1] + f[n - 2]

but I want to see how it will expand in a given number of steps, but not all the way through. For example, let's say that I want to take f[n+1] and use my rules to expand it into f[n] + f[n-1], and then expand those to f[n-1] + 2*f[n-2] + f[n-3].

Ideally I'd like to know if there's a way to do something like apply the expansion twice to get to the second result, but doing so manually in two steps would be fine as well.

The reason why I'm interested in doing this is that I'm using Mathematica to sort of help me with proofs where I just need to manipulate lots of expressions using simple transformation rules, which means I need to see the steps in between, not just the final result (I hope this makes sense.)

Answer 1

One way is to use an extra argument that acts as a switch.

Clear[f];
f[0] = 1;
f[1] = 1;
f[n_, True] := f[n - 1] + f[n - 2]

Example:

f7 = f[7, True]

(* Out[329]= f[5] + f[6] *)

To proceed another step, can do a replacement.

f7 /. f[aa_] :> f[aa, True]

(* Out[330]= f[3] + 2 f[4] + f[5] *)

Can use Nest to repeat this n times.

Nest[# /. f[aa_] :> f[aa, True] &, f7, 3]

(* Out[332]= 4 + 2 f[2] + 2 (3 + f[2]) + f[3] *)

Answer 2

If we are willing to confine ourselves to functions like the example f which:

1. is defined using DownValues only, and
2. has no special attributes such as HoldAll, etc.

... then the following lifting function might be useful:

ClearAll[stepper]
SetAttributes[stepper, HoldAll]
stepper[f_Symbol] :=
  Module[{rules, g}
  , rules =
      Rule @@@ Cases[DownValues[f], (l_ :> r_) :> ((Hold[r] /. f -> g) /. _[rr_] :> Hold[l, rr])]
  ; Function[Null, Defer[#]&[Unevaluated@# /. rules] /. g -> f, HoldAll]
  ]

stepper[f] returns an evaluator function which, when applied to an expression, evaluates the expression normally except that the rules associated with f are not invoked recursively. So, for example:

sf = stepper[f];


f[3] // sf
(* f[1] + f[2] *)

f[1] + f[2] // sf
(* 1 + f[0] + f[1] *)

1 + f[0] + f[1] // sf
(* 3 *)


f[n+1] // sf
(* f[-1+n] + f[n] *)

f[-1+n] + f[n] // sf
(* f[-3+n] + 2*f[-2+n] + f[-1+n] *)

f[-3+n] + 2*f[-2+n] + f[-1+n] // sf
(* f[-5+n] + f[-4+n] + f[-3+n] + 2*(f[-4+n] + f[-3+n]) + f[-2+n] *)

Evaluation using stepper[f] proceeds as follows:

1. The DownValues of f are copied and transformed so that all right-hand-side occurrences of f are replaced with an inert symbol (this occurs once).
2. An expression is evaluated by applying the transformed down-value rules, forestalling any recursive application of f since it no longer appears in any of the rule bodies.
3. The result is wrapped in Defer.
4. f is restored in place of all occurrences of the inert symbol within the deferred expression.

The implementation of stepper is complicated somewhat by the need to dodge some inconvenient variable renaming within scoping constructs and to prevent early evaluation of the right-hand-sides of rules.

This methodology could be applied to a more elaborate evaluator that handles symbol attributes, UpValues, and so on. But the evaluator complexity grows rapidly with these extra features and the exhibited form of stepper might be useful enough as is.

Answer 3

The answers are great. I wanted to add that the problem you are trying to solve fits way better with replacement rules than function definitions, so switching to those can provide a more understandable answer

Clear[f];
frules = {f[0 | 1] :> 1, f[n_] :> f[n - 1] + f[n - 2]};

f[7] /. frules (* same as f[7]//ReplaceAll[frules] *)
f[7] /. frules /. frules
Nest[ReplaceAll[frules], f[7], 3]
(* f[5] + f[6] *)
(* f[3] + 2 f[4] + f[5] *)
(* f[1] + f[2] + f[3] + 2 (f[2] + f[3]) + f[4] *)

Now, if you already begin with the function f defined.

f[0] := 1
f[1] := 1
f[n_] := f[n - 1] + f[n - 2]

You can extract the rules by using DownValues as @WReach did.

frules = DownValues[f];

But then you have to take care to avoid f applying its own definitions automatically. You can either replace the f symbol in the rules by another one that isn't defined. You can also do the replacements inside a Block where f becomes undefined and wrap the results in Hold (or equivalent). You can clear f. Personally I would perhaps do something that I haven't seen on the site (or not much, or don't recall) so it may be interesting to mention: block a dialog

Block[{f}, Dialog[]];

And now fall back to the original answer

f[7] /. frules (* same as f[7]//ReplaceAll[frules] *)
f[7] /. frules /. frules
Nest[ReplaceAll[frules], f[7], 3]

When you are done, Return[] (or more robustly, ExitDialog@Unevaluated@Abort[]

Answer 4

If you're using M10, you could do it with Inactivate (which formats more nicely in Mathematica than it does here in plain text.)

Inactivate[f[7] /. #, f] &[DownValues[f]]
(* Inactive[f][5] + Inactive[f][6] *)

Then Nest it:

Clear[step];
SetAttributes[step, HoldFirst];
step[e_] := step[e, 1]
step[e_, n_] := Inactivate[Nest[Function[{x}, x /. #], e, n], f] &[DownValues[f]]

step[f[7], 2]
(* Inactive[f][3] + 2 Inactive[f][4] + Inactive[f][5] *)

Answer 5

Not paticularly elegant for reading but with minimal programming effort we can write

f[0] = a;
f[1] = b;
f[k_] := HoldForm[f[k - 1] + f[k - 2]]

ff[n_] := NestList[ReleaseHold, f[n], n - 1]

Example

ff[7] // Column

$\begin{array}{l} f[7-1]+f[7-2] \\ (f[5-1]+f[5-2])+(f[6-1]+f[6-2]) \\ (f[3-1]+f[3-2])+2 (f[4-1]+f[4-2])+(f[5-1]+f[5-2]) \\ b+3 (f[2-1]+f[2-2])+3 (f[3-1]+f[3-2])+(f[4-1]+f[4-2]) \\ 3 a+7 b+4 (f[2-1]+f[2-2])+(f[3-1]+f[3-2]) \\ 7 a+12 b+(f[2-1]+f[2-2]) \\ 8 a+13 b \\ \end{array}$

Regards, Wolfgang

Answer 6

h[f[0]] := f[0];
h[f[1]] := f[1];
h[f[x_]] := f[x - 1] + f[x - 2];
nst[n_, num_] := 
 Total@Nest[Cases[#, f[y_] :> h[f[y]], Infinity] &,{f[n]}, num]

Testing:

Table[nst[10, j], {j, 0, 9}] // TableForm