Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

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.

share|improve this question
    
This might be what you're looking for: How do I evaluate only one step of an expression? –  rm -rf Mar 1 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. –  Andrew Cheong Mar 1 at 15:06

2 Answers 2

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)

share|improve this answer
    
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 1 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 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_] := (
   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.

share|improve this answer

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

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