4

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.

Community
  • 1
Andrew Cheong
  • 3,576
  • 17
  • 42

2 Answers2

5

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;

enter image description here

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

rm -rf
  • 88,781
  • 21
  • 293
  • 472
  • 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. – Andrew Cheong Mar 01 '14 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 01 '14 at 15:23
1

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_] := (
   Language`ExtendedFullDefinition[new] = 
     Language`ExtendedFullDefinition[old] /. HoldPattern[old] :> new;
   ClearAll[old];
   );
SetAttributes[EvaluateHeadOnce, HoldAll];
EvaluateHeadOnce[head_Symbol, expr_] := Module[{headsFound = 0, copy, resetter},
  TraceScan[
   If[
     headsFound++ == 1,
     MoveSymbol[head, copy];
     SetAttributes[resetter, HoldAll];
     resetter[input_] := (MoveSymbol[copy, head]; $Pre =.; input);
 $Pre = resetter;
     Return[ReleaseHold@#]
     ] &,
   expr,
   head[___]
   ]
  ]

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,

EvaluateHeadOnce[factorial, %]
(* 2 + 3 (20 factorial[3] + factorial[7]) *)

But, might there be a more elegant method?

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.

Andrew Cheong
  • 3,576
  • 17
  • 42