# Stopping a head from evaluating more than once

While attempting to answer my own question, Is there a way to "hold" prefix / infix / postfix notation?, I came across the need to evaluate a recursive function only one level deep.

For example, consider a factorial function:

factorial[n_Integer /; n >= 0] := If[n >= 2, n*factorial[n - 1], 1]

Normally, expressions using factorial would be fully evaluated:

2 + 3*(factorial[5] + factorial[7])
(* 15482 *)

However, is there a way to evaluate factorial just once, and prevent evaluating any further occurrences? That is, a function, EvaluateHeadOnce:

EvaluateHeadOnce[factorial, 2 + 3*(factorial[5] + factorial[7])]
(* 2 + 3 (5 factorial[4] + factorial[7]) *)

I found a method (self-answered below) but it felt rather... inelegant. I'm curious to see how others would implement such a method, as well as hear criticisms / flaws in my approach.

• This might be what you're looking for: How do I evaluate only one step of an expression?
– rm -rf
Mar 1, 2014 at 15:03
• Apologies for failing to give due credit—@Mr.Wizard's answer in that thread is where I got the TraceScan idea. However, unless I'm mistaken, a "step" in the context of that question is different from that of mine. In mine, I'm looking to evaluate as many steps as needed, until the second instance of a specified head is encountered. Mar 1, 2014 at 15:06

If I understood your requirements correctly, what you need is Defer, which is in the same class of functions as Hold and Unevaluated, but will evaluate if explicitly evaluated. Then, using Trott–Strzebonski:

Clear@factorial
factorial[n_Integer /; n >= 0] := With[{m = n - 1}, If[n >= 2, n*Defer@factorial[m], 1]]
factorial[0] = 0;

(In the lines after In[4], the previous output was explicitly evaluated using Shift+Enter)

• Brilliant! I can't believe I didn't come across Defer while doing my research (sigh). To be pedantic, I was looking for a function EvaluateHeadOnce that could be applied to any existing function f, the way Mr. Wizard's step can be applied to any expression, but that's only a matter of reorganizing your code to an appropriate form, so no need to update it. Thank you very much. Mar 1, 2014 at 15:17
• Version 10 will have a new evaluation control called Inactive (and a corresponding Activate). With that, you can easily wrap a desired head in the recursive expression with Inactivate and every successive Activate will effectively evaluate one step. That might provide slightly better control than Defer, which requires an explicit evaluation. You can also mimic the functionality of Inactive and Activate in v9 with custom functions and appropriate attributes.
– rm -rf
Mar 1, 2014 at 15:23

The only solution I could come up with was to use TraceScan to detect the first evaluation of the symbol, at which point I'd copy the symbol (including all its UpValues, DownValues, etc.) to a temporary place, unset the symbol to prevent further evaluation, and set $Pre to restore the symbol immediately prior to evaluating the next input (as well as unsetting$Pre itself).

MoveSymbol[old_, new_] := (
LanguageExtendedFullDefinition[new] =
LanguageExtendedFullDefinition[old] /. HoldPattern[old] :> new;
ClearAll[old];
);
TraceScan[
If[
SetAttributes[resetter, HoldAll];
resetter[input_] := (MoveSymbol[copy, head]; $$Pre =.; input);$$Pre = resetter;
Return[ReleaseHold@#]
] &,
expr,
]
]

This output is, as desired,

EvaluateHeadOnce[factorial, 2 + 3*(factorial[5] + factorial[7])]
(* 2 + 3 (5 factorial[4] + factorial[7]) *)

and of course, may continue,

I was going to extend the above to take a list of symbols rather than a specific one, but I've decided to wait in case one of the $$Mathematica$$ veterans show up and put my answer to shame.