# Arbitrary depth patterns/rules

Temporary message: I am now really confused. I am not sure how using Power and Unevaluated together works in the examples below.

While answering this question, I stumbled upon the following.

We have

Power[Unevaluated[
Power[Power[Power[Power[Power[Times[1, a1], a2], a3], a4], a5],
a6]], a7]


-> Power[Power[Power[Power[Power[Power[a1,a2],a3],a4],a5],a6],a7]

Where there seems to be some rule involving deeply nested patterns at work (correct me if I'm wrong). Compare this with

Power[Unevaluated[
Power[Power[Power[Power[Power[Times[2, a1], a2], a3], a4], a5],
a6]], a7]


-> Power[Unevaluated[Power[Power[Power[Power[Power[Times[2,a1],a2],a3],a4],a5],a6]],a7]

Where nothing happens. Note also that

a2 = 3;
Power[Unevaluated[Power[Times[2, a1], a2]], a3]


-> Power[Unevaluated[Power[Times[2, a1], a2]], a3]

But that

Clear[a1, a2];
a1 = 3;
Power[Unevaluated[Power[Times[2, a1], a2]], a3]


-> Power[Power[6,a2],a3]

Most importantly, note that

Clear[a1, a2, a3, f];
f[1] = 2;
Power[Unevaluated[Power[f[1], a2]], a3]


-> Power[Power[2,a2],a3]

Whereas

Clear[a1, a2, a3, f];
f[] = 2;
Power[Unevaluated[Power[f[], a2]], a3] // FullForm


-> Power[Unevaluated[Power[f[],a2]],a3]

We have

FullForm /@
Trace[Power[Unevaluated[Power[Power[Times[1, b], c], d]], e],
TraceOriginal -> True] // Column


->

(*output*)
HoldForm[Power[Unevaluated[Power[Power[Times[1,b],c],d]],e]]
List[HoldForm[Power]]
List[HoldForm[e]]
HoldForm[Power[Power[Power[Times[1,b],c],d],e]]
HoldForm[Power[Power[Power[b,c],d],e]]
List[HoldForm[Power]]
List[HoldForm[Power[Power[b,c],d]]]
List[HoldForm[e]]
HoldForm[Power[Power[Power[b,c],d],e]]


I am not sure if what to conclude from this.

Note that

Power[Hold[Times[1, 2]], 2] // FullForm


-> Power[Hold[Times[1,2]],2]

so that Times is of course not cleared if there is a function with attribute HoldAll surrounding it. Note that the test functions below also depend on this.

Not so important: Tools

The following are tools to play with larger expressions like this

(*warning! might clear unexpected variables!*)
Clear @@ Names["arg*" | "a" | "b"]

SetAttributes[holderToken, HoldAll];
tester = And[First[#] == {}, Length[#[[2]]] == kkkk + 1,
Last[#] == {}] &;
Function[
ReplaceAll[
Unevaluated@Unevaluated@
Cases[
#,
]
,
]
];

expression :=
With[{compoWithHeldArg =
Unevaluated @@
(
DeleteCases[
Hold@
Evaluate[(Composition @@

Array[With[{argu = Symbol["arg" <> ToString[#]]},
Function @@ {argu, Power[argu, a[#]]}] &, kkkk])[
holderToken[Times[1, b]]]]
,
]
)
}
,

Power[compoWithHeldArg, a[0]]

];


We then have

kkkk = 12;


-> True

and

kkkk=12;
expression // FullForm


-> Power[Power[Power[Power[Power[Power[Power[Power[Power[Power[Power[Power[Power[b,a[12]],a[11]],a[10]],a[9]],a[8]],a[7]],a[6]],a[5]],a[4]],a[3]],a[2]],a[1]],a[0]]

and we see that

     Unevaluated @@
(
DeleteCases[
Hold@
Evaluate[(Composition @@

Array[With[{argu = Symbol["arg" <> ToString[#]]},
Function @@ {argu, Power[argu, a[#]]}] &, kkkk])[
holderToken[Times[1, b]]]]
,
]
)//FullForm


-> Unevaluated[Power[Power[Power[Power[Power[Power[Power[Power[Power[Power[Power[Power[Times[1,b],a[12]],a[11]],a[10]],a[9]],a[8]],a[7]],a[6]],a[5]],a[4]],a[3]],a[2]],a[1]]]

Where the Times is still present. So indeed applying Power[#,2]& to the expression above clears the Times.

Deep pattern

If we don't want to make any replacements, but just a deep pattern, we can recursively define a pattern as follows

Clear[patt];
patt = (_?AtomQ) | f[x_ /; MatchQ[x, patt]];


We then have

MatchQ[f[f[1]], patt]


(-> True)

A function that acts a bit like Power

Maybe something similar is going on with Power. That is, there is some pattern that searches in a deep way (maybe some kind of expressions that it can simplify), but the rule applied is trivial. I am confused and I thought the Times that was found was actually replaced by the same rule that (/whose pattern) found it. Now I am not sure if we should even speak of a rule in this case.

I can make a function that works (at least a bit) like Power in very limited cases.

ClearAll[shortCondition]
SetAttributes[shortCondition, HoldAll]
shortCondition[x_] :=
MatchQ[Unevaluated[x],
HoldPattern[
Times[___, 1, ___] | power[xxxx_ /; shortCondition[xxxx], _]]]

ClearAll[power]
power[x_ /; shortCondition[x], n_] := power[x, n]


We then have

power[Unevaluated[power[Times[1, 2], e]], d]


-> power[power[2, e], d]

-> power[2, 2]

Whereas

power[Unevaluated[power[Times[2, 2], e]], d]


-> power[Unevaluated[power[Times[2, 2], e]], d]

However, I think we should conclude from the Trace further above that Power works a little differently.

The new question is: How can we simulate the behavior of Power, especially the aspect of it that seems to apply rules deeply in the expression that is one of its arguments.

.

.

.

.

.

Old text, which seems to distract now

The more complicated problem of also making a non trivial replacement seems very difficult, but I'd still like to know if somebody knows if there is a way.

If we also want to make a replacement , that makes things difficult. In the example in which f has a recursive pattern, we might want to replace the atom found by 0. In the example of power we might want to replace Times[a_,1,b_] by Times[a,b]. I think it is pretty unlikely that there is an elegant way of doing things. I had some hope that there would be a way make replacements in a general way, as I believed Power might work in this way. Now I don't think Power works in this way, but I still curious.

As a small remark, not that we of course have

MatchQ[f[f[1]], (___f)[1]]


-> False

and

MatchQ[Unevaluated[Sequence[f, f, f][1]], ___[1]]


Repeated and PatternSequence also seemed like they were maybe the way to go. But maybe not.

The question was: Is it possible to define a rule in such a way that it determines whether an expression is of the form

f[___, f[___, ...[f[___, x_head ,___]] ,___], ___]


where the ...[] means that f is applied an arbitrary number of times in this way, and "do something with x on the RHS"?

To clarify, we might want to define something like

f[___, f[___, ...[f[___, x_Integer ,___]] ,___], ___]:= x


Or in case of power

power[power[z...[Times[1,x_]],y_],z1_]:=power[power[z[x],y],z1]


where I have given the pattern of "repetitively applying power" the name z.

A way of writing this in that might be parseable by Mathematica could be

z...power[Times[1,x_],y_]:=z[x,y]


Possibly the answer is: maybe in version 13. But any feedback is welcome :)

-
A general advice: stay away from Unevaluated, and use Hold and friends instead. Another one: things like Cases[Unevaluated[expr],s:(your-pattern):>Hold[s],Infinity] should provide sufficient tools to destructure and analyze any expression safely, with no evaluation leaks. –  Leonid Shifrin Apr 21 '13 at 20:37
This discussion may also be helpful. –  Leonid Shifrin Apr 21 '13 at 20:39
Ah thanks for the feedback :). Yeah passing around multiple Unevaluated's because you think you know when they will be stipped seems like a dangerous idea. I'm sorry if I showed too much of my personal explorations, when the question was really not about this use of Unevaluated. However, I like the construction With[{something=Unevaluated@@{expr}},_]. I will now look at that discussion. –  Jacob Akkerboom Apr 21 '13 at 20:43
@LeonidShifrin excuse me, it seems I was mistaken about what was going on. See my edits before bending your minds to it :) –  Jacob Akkerboom Apr 21 '13 at 21:34
Gosh, that's a long question. Skimming it, this may be related: mathematica.stackexchange.com/q/11045/121 -- I'll go back to reading now. –  Mr.Wizard Apr 22 '13 at 1:34

### Second try

Perhaps this is the behavior you are interested in. If a definition does not match the original expression is returned, with Unevaluated intact. If however the definition is applied the Unevaluated is stripped.

f[a_, b_] /; NumericQ[a] := {a, b}

f[Unevaluated["inert"], 2]

f[Unevaluated[2 + 2], 2]

f[Unevaluated["inert"], 2]

{4, 2}


This could be combined with Villegas-Gayley to produce behavior similar to your Power example:

g[a_, b_] /; NumericQ[a] && ! TrueQ[$ginner] := Block[{$ginner = True}, g[a, b]]

g[Unevaluated["inert"], 2]

g[Unevaluated[2 + 2], 2]

g[Unevaluated["inert"], 2]

g[4, 2]


I didn't read the majority of your question (sorry) but I will focus on this:

The question is: Is it possible to define a rule in such a way that it determines whether an expression is of the form

f[___, f[___, ...[f[___, x_head ,___]] ,___], ___]


where the ...[] means that f is applied an arbitrary number of times in this way, and "do something with x on the RHS"?

This may be acceptable to you:

Hold[ff[ff[ff[ff[ff[gg[1, a1], a2], a3], a4], a5], a6]];

Flatten[%, ∞, ff] /. _[gg[x__], ___] :> found[x]

found[1, a1]


If this does not work for you I'd appreciate your explaining why directly.

-
thanks for looking at it! Sadly, this is not really what I want. In particular, this cannot explain the behavior of Power, as we have that in Power[Unevalauted[Power[Times[1,2],d]],e] some rule appears to be applied to strip Times, but if we surround Times or the Power "on the inside" with Hold, nothing happens. –  Jacob Akkerboom Apr 22 '13 at 9:14
@Jacob I guess I don't understand what the question is about. Why are you sticking Unevaluated in there? What are you actually trying to do? –  Mr.Wizard Apr 22 '13 at 10:14
@Jacob I swear I'm not trying to be stupid or suborn, but I don't get it. "But the rule in case of Power seems so unlike anything I have seemed and so powerful, I wanted to learn more about it." What seems so powerful? Perhaps you are looking for Attributes, such as Flat, Orderless, OneIdentity etc.? –  Mr.Wizard Apr 22 '13 at 11:04
I am sorry for causing unnecessary confusion by asking so many questions at once. It is the result of that I thought I understood something, which I probably do not understand so well. Compare Power[Unevaluated[Power[Times[2, a1], a2]], a3] with Power[Unevaluated[Power[Times[1, a1], a2]], a3] In the first case a head Unevaluated remains and in the second case it gets removed. This should have been an example at the start of the question from the beginning. –  Jacob Akkerboom Apr 22 '13 at 11:19
@Jacob Thank you; now I understand at least part of what you're curious about. That is indeed unusual. Perhaps you could rewrite to the question to be far simpler now? –  Mr.Wizard Apr 22 '13 at 11:31