Re: How to work with In?
- To: mathgroup at smc.vnet.net
- Subject: [mg114034] Re: How to work with In?
- From: Leonid Shifrin <lshifr at gmail.com>
- Date: Sat, 20 Nov 2010 18:28:48 -0500 (EST)
Hi kj,
I also needed the fixed - number -of- steps - evaluation often. So, a while
ago I wrote a
tiny experimental partial evaluator. It gives one several options to have a
tighter control over evaluation. One can, for example, specify, which
user-defined functions must be "expanded" at which step, or one can enable
evaluation of only system functions but not user-defined ones,
or one can disable evaluation of system functions, etc. The evaluation of
system functions is harder to control in this approach, since their global
definitions (DownValues etc) are not exposed to the user. Anyways, below is
the code and several examples of how it can be used (code is as-is, I don't
claim it is bug-free):
ClearAll[symbolicHead];
SetAttributes[symbolicHead, HoldAll];
symbolicHead[f_Symbol[___]] := f;
symbolicHead[f_[___]] := symbolicHead[Unevaluated[f]];
symbolicHead[f_] := Head[f];
ClearAll[partialEval];
SetAttributes[partialEval, HoldAll];
partialEval[a_Symbol] /; OwnValues[a] =!= {} :=
Unevaluated[partialEval[a]] /. OwnValues[a];
partialEval[a : f_Symbol[___]] /; DownValues[f] =!= {} :=
Unevaluated[partialEval[a]] /. DownValues[f];
partialEval[a_] :=
With[{sub =
SubValues[
Evaluate[symbolicHead[a]]]}, (Unevaluated[partialEval[a]] /.
sub) /; sub =!= {}];
Clear[joinHeld];
joinHeld[a___Hold] :=
Hold @@ Replace[Hold[a], Hold[x___] :> Sequence[x], {1}];
ClearAll[getSymbolsContained];
getSymbolsContained[held : Hold[expr_]] :=
joinHeld @@
Union[Cases[held,
x_Symbol /; Context[x] =!= "System`" :> Hold[x], {1, Infinity},
Heads -> True]];
ClearAll[expansionRules];
expansionRules[expr_: Hold, symbs : Hold[symbolsToExpand : __]] :=
runtimeBlock[symbs,
withBlockedUserSymbols[
Flatten[
Map[{HoldPattern[#] :>
With[{eval = partialEval[#]}, eval /; True],
x_ /; symbolicHead[x] === Unevaluated[#] :>
With[{eval = partialEval[x]}, eval /; True]} &,
List @@ symbs], 1]]];
ClearAll[expandOneStep];
expandOneStep[expr_: Hold, symbs : Hold[]] := expr;
expandOneStep[expr_: Hold, symbs : Hold[symbolsToExpand : __]] :=
expr /. expansionRules[expr, symbs] //.
HoldPattern[partialEval[x__]] :> x;
ClearAll[expandNSteps];
SetAttributes[expandNSteps, HoldFirst];
Options[expandNSteps] = {RunSystemFunctions -> True,
PreExecuteSystemFunctions -> True};
Module[{expandNStepAux},
SetAttributes[expandNStepAux, HoldFirst];
expandNSteps[fst_, sec_, opts : OptionsPattern[]] :=
With[{f =
If[TrueQ[OptionValue[RunSystemFunctions]],
executeSystemFunctions, # &],
preExecF =
If[TrueQ[OptionValue[PreExecuteSystemFunctions]],
executeSystemFunctions, # &]},
expandNStepAux[fst, sec, f , preExecF ]];
expandNStepAux[expr_, n_Integer?Positive, f_, preExecF_] :=
Nest[f[expandOneStep[#, getSymbolsContained[#]]] &,
preExecF@Hold[expr], n];
expandNStepAux[expr_, expandAtSteps : {Hold[__] ..}, f_,
preExecF_] :=
Fold[f[expandOneStep[##]] &, preExecF@Hold[expr], expandAtSteps]
];
ClearAll[runtimeBlock];
SetAttributes[runtimeBlock, HoldRest];
runtimeBlock[heldvars : Hold[___Symbol], code_] :=
Block @@ Append[
Replace[heldvars, Hold[vars___] :> Hold[{vars}], {0}],
Unevaluated[code]];
ClearAll[withBlockedUserSymbols];
SetAttributes[withBlockedUserSymbols, HoldAll];
withBlockedUserSymbols[code_] :=
runtimeBlock[getSymbolsContained[Hold[code]], code];
ClearAll[executeSystemFunctions];
executeSystemFunctions[Hold[expr_]] :=
withBlockedUserSymbols[Hold[Evaluate[expr]]];
ClearAll[evaluateAtPattern];
evaluateAtPattern[held : Hold[_], patt_] :=
withBlockedUserSymbols[
held /. (x : patt) :> With[{eval = x}, eval /; True]];
evaluateAtPattern[held : Hold[_], patterns : {__}] :=
Fold[evaluateAtPattern, held, patterns];
Here are some examples:
In[890]:= Clear[f, g]
In[891]:= f[x_] := x^2;
In[892]:= g[x_] := x^3;
In[893]:= evaluateAtPattern[Hold[g[Map[f, Range[10]]]], _Range]
Out[893]= Hold[g[f /@ {1, 2, 3, 4, 5, 6, 7, 8, 9, 10}]]
In[894]:= expr =
evaluateAtPattern[Hold[g[Map[f, Range[10]]]], {_Range, _Map}]
Out[894]= Hold[
g[{f[1], f[2], f[3], f[4], f[5], f[6], f[7], f[8], f[9], f[10]}]]
In[895]:= oneStepFExpanded = expandOneStep[expr, Hold[f]]
Out[895]= Hold[g[{1^2, 2^2, 3^2, 4^2, 5^2, 6^2, 7^2, 8^2, 9^2, 10^2}]]
In[896]:= oneStepGExpanded = expandOneStep[expr, Hold[g]]
Out[896]= Hold[{f[1], f[2], f[3], f[4], f[5], f[6], f[7], f[8], f[9],
f[10]}^3]
In[897]:= twoStepExpanded = expandOneStep[oneStepExpanded , Hold[g]]
Out[897]= Hold[{1^2, 2^2, 3^2, 4^2, 5^2, 6^2, 7^2, 8^2, 9^2, 10^2}^3]
In[898]:= expandNSteps[g[Map[f, Range[10]]], 1]
Out[898]= Hold[{f[1]^3, f[2]^3, f[3]^3, f[4]^3, f[5]^3, f[6]^3,
f[7]^3, f[8]^3, f[9]^3, f[10]^3}]
In[899]:= expandNSteps[g[Map[f, Range[10]]], 1,
RunSystemFunctions -> False]
Out[899]= Hold[{f[1], f[2], f[3], f[4], f[5], f[6], f[7], f[8], f[9],
f[10]}^3]
In[900]:= expandNSteps[g[Map[f, Range[10]]], 1,
RunSystemFunctions -> False, PreExecuteSystemFunctions -> False]
Out[900]= Hold[(f /@ Range[10])^3]
In[901]:= expandNSteps[g[Map[f, Range[10]]], 2]
Out[901]= Hold[{1, 64, 729, 4096, 15625, 46656, 117649, 262144,
531441, 1000000}]
In[902]:= expandNSteps[g[Map[f, Range[10]]], {Hold[f], Hold[g]}]
Out[902]= Hold[{1, 64, 729, 4096, 15625, 46656, 117649, 262144,
531441, 1000000}]
In[903]:= expandNSteps[g[Map[f, Range[10]]], {Hold[f], Hold[g]},
PreExecuteSystemFunctions -> False]
Out[903]= Hold[{f[1]^3, f[2]^3, f[3]^3, f[4]^3, f[5]^3, f[6]^3,
f[7]^3, f[8]^3, f[9]^3, f[10]^3}]
In[904]:= expandNSteps[g[Map[f, Range[10]]], {Hold[g], Hold[f]}]
Out[904]= Hold[{1, 64, 729, 4096, 15625, 46656, 117649, 262144,
531441, 1000000}]
In[905]:= expandNSteps[g[Map[f, Range[10]]], {Hold[f]},
PreExecuteSystemFunctions -> False]
Out[905]= Hold[
g[{f[1], f[2], f[3], f[4], f[5], f[6], f[7], f[8], f[9], f[10]}]]
In[906]:= expandNSteps[g[Map[f, Range[10]]], {Hold[f]}]
Out[906]= Hold[g[{1, 4, 9, 16, 25, 36, 49, 64, 81, 100}]]
In[907]:= evaluateAtPattern[twoStepExpanded , _Power]
Out[907]= Hold[{1, 64, 729, 4096, 15625, 46656, 117649, 262144,
531441, 1000000}]
In[908]:= evaluateAtPattern[twoStepExpanded , Power[_, _?EvenQ]]
Out[908]= Hold[{1, 4, 9, 16, 25, 36, 49, 64, 81, 100}^3]
In[909]:= executeSystemFunctions[oneStepFExpanded ]
Out[909]= Hold[g[{1, 4, 9, 16, 25, 36, 49, 64, 81, 100}]]
In[910]:= executeSystemFunctions[oneStepGExpanded ]
Out[910]= Hold[{f[1]^3, f[2]^3, f[3]^3, f[4]^3, f[5]^3, f[6]^3,
f[7]^3, f[8]^3, f[9]^3, f[10]^3}]
In[911]:= expandAll[g[Map[f, Range[10]]]]
Out[911]= Hold[{1, 64, 729, 4096, 15625, 46656, 117649, 262144,
531441, 1000000}]
Here is how your problem can be solved (in a way, the way it is done is a
generalization of Albert's suggestion):
In[912]:= expandNSteps[
Table[With[{i = i}, Hold[In[i]]], {i, 500, 510}], {Hold[In]}]
Out[912]= Hold[{Hold[
Nest[executeSystemFunctions[
expandOneStep[#1, getSymbolsContained[#1]]] &,
Hold[g[f /@ Range[10]]], 4]],
Hold[Nest[
executeSystemFunctions[
expandOneStep[#1, getSymbolsContained[#1]]] &,
Hold[g[f /@ Range[10]]], 4]], Hold[ClearAll[symbolicHead];],
Hold[SetAttributes[symbolicHead, HoldAll];],
Hold[symbolicHead[f_Symbol[___]] := f;],
Hold[symbolicHead[f_[___]] := symbolicHead[Unevaluated[f]];],
Hold[symbolicHead[f_] := Head[f];], Hold[ClearAll[partialEval];],
Hold[SetAttributes[partialEval, HoldAll];],
Hold[a_Symbol /; OwnValues[a] =!= {} :=
Unevaluated[a] /. OwnValues[a];],
Hold[a : f_Symbol[___] /; DownValues[f] =!= {} :=
Unevaluated[a] /. DownValues[f];]}]
One thing to realize is that this custom evaluator is different from the
main Mathematica's one, so you generally should not expect for example
expandAll to give you the same results as those obtained by just evaluating
an expression without Hold-s normally. Another point is that the performance
of this toy evaluator will surely be much worse than that of the standard
one.
Regards,
Leonid
On Sat, Nov 20, 2010 at 2:12 PM, kj <no.email at please.post> wrote:
> In <ic5opg$70l$1 at smc.vnet.net> Oliver Ruebenkoenig <ruebenko at wolfram.com>
> writes:
>
> >On Fri, 19 Nov 2010, kj wrote:
>
> >> I want to create a list consisting of the (unevaluated) expressions
> >> that were entered in a particular subrange of the In array. I.e.,
> >> what I want is (almost) something like this:
> >>
> >> Table[In[i], {i, 300, 375}]
> >>
> >> except that this won't work, because each In[i] will be evaluated.
> >> This also fails
> >>
> >> Table[Hold[In[i]], {i, 300, 375}]
> >>
> >> because now the i is not evaluated, so the result is a list of
> >> multiple copies of the expression Hold[In[i]].
> >>
> >> How can I do what I'm trying to do?
>
> >I think this is your friend
>
> >Table[With[{i = i}, Hold[In[i]]], {i, 300, 375}]
>
>
> That's one cool trick! Thanks!
>
> Unfortunately, it doesn't solve this problem:
>
> In[31]:= Table[With[{i = i}, Hold[In[i]]], {i, 20, 30}]
>
> Out[31]= {Hold[In[20]], Hold[In[21]], Hold[In[22]], Hold[In[23]],
> Hold[In[24]], Hold[In[25]], Hold[In[26]], Hold[In[27]], Hold[In[28]],
> Hold[In[29]], Hold[In[30]]}
>
> I need each of In[20], In[21], ..., In[30] to be processed by the
> kernel exactly once before clamping the result with Hold.
>
> By the way, being able to limit the level of evaluation to a precise
> number of "passes", greater than zero, but not all the way to full
> evaluation, is something I find myself needing very often.
>
> ~kj
>
>