I would like to be able to have a pattern that matches only expressions that are (alternately: are not) children of certain other elements.
For example, a pattern to match all Lists not within a Graphics object:
{ {1,2,3}, Graphics[Line[{{1,2},{3,4}}]] }
This pattern would match {1,2,3} but not {{1,2},{3,4}}.
There are relatively easy ways to extract expressions matching these criteria, but patterns are not only for extraction, but also for replacement, which is my main use case here (ReplaceAll).
Do you know of any easy, concise, and general ways to do this?
Is it possible to do this at all with just patterns?
I will propose a solution based on expression pre-processing and soft redefinitions of operations using rules, rather than rules themselves. Here is the code:
ClearAll[matchChildren, exceptChildren];
Module[{h, preprocess},
preprocess[expr_, parentPtrn_, lhs_, match : (True | False)] :=
Module[{pos, ptrnPos, lhsPos},
ptrnPos = Position[expr, parentPtrn];
lhsPos = Position[expr, lhs];
pos = Cases[lhsPos, {Alternatives ## PatternSequence ### ptrnPos, __}];
If[! match,pos = Complement[Position[expr, _, Infinity, Heads -> False], pos]];
MapAt[h, expr, pos]];
matchChildren /:
fun_[expr_, matchChildren[parentPtrn_, lhs : Except[_Rule | _RuleDelayed]],
args___] :=
fun[preprocess[expr, parentPtrn, lhs, True], h[lhs], args] //.
h[x_] :> x;
matchChildren /:
fun_[expr_, matchChildren[parentPtrn_, lhs_ :> rhs_], args___] :=
fun[preprocess[expr, parentPtrn, lhs, True], h[lhs] :> rhs, args] //.
h[x_] :> x;
exceptChildren /:
fun_[expr_,exceptChildren[parentPtrn_, lhs : Except[_Rule | _RuleDelayed]],
args___] :=
fun[preprocess[expr, parentPtrn, lhs, False], h[lhs], args] //.
h[x_] :> x;
exceptChildren /:
fun_[expr_, exceptChildren[parentPtrn_, lhs_ :> rhs_], args___] :=
fun[preprocess[expr, parentPtrn, lhs, False], h[lhs] :> rhs, args] //.
h[x_] :> x;
]
A few details on implementation ideas, and how it works. The idea is that, in order to restrict the pattern that should match, we may wrap this pattern in some head (say h), and also wrap all elements matching the original pattern but also being (or not being) within some other element (matching the "parent" pattern) in the same head h. This can be done for generic "child" pattern. Technically, one thing that makes it possible is the intrusive nature of rule application (and function parameter-passing, which have the same semantics in this respect). This allows one to take the rule like x_List:>f[x], matched by generic pattern lhs_:>rhs_, and change it to h[x_List]:>f[x], generically by using h[lhs]:>rhs. This is non-trivial because RuleDelayed is a scoping construct, and only the intrusiveness of another RuleDelayed (or, function parameter-passing) allows us to do the necessary scope surgery. In a way, this is an example of constructive use of the same effect that leads to the leaky functional abstraction in Mathematica. Another technical detail here is the use of UpValues to overload functions that use rules (Cases, ReplaceAll, etc) in the "soft" way, without adding any rules to them. At the same time, UpValues here allow the code to be universal - one code serves many functions that use patterns and rules. Finally, I am using the Module variables as a mechanism for encapsulation, to hide the auxiliary head h and function preprocess. This is a generally very handy way to achieve encapsulation of both functions and data on the scale smaller than a package but larger than a single function.
Here are some examples:
In[171]:= expr = {{1,2,3},Graphics[Line[{{1,2},{3,4}}]]};
In[168]:= expr/.matchChildren[_Graphics,x_List:>f[x]]//FullForm
Out[168]//FullForm= List[List[1,2,3],Graphics[Line[f[List[List[1,2],List[3,4]]]]]]
In[172]:= expr/.matchChildren[_Graphics,x:{__Integer}:>f[x]]//FullForm
Out[172]//FullForm= List[List[1,2,3],Graphics[Line[List[f[List[1,2]],f[List[3,4]]]]]]
In[173]:= expr/.exceptChildren[_Graphics,x_List:>f[x]]//FullForm
Out[173]//FullForm= List[f[List[1,2,3]],Graphics[Line[List[List[1,2],List[3,4]]]]]
In[174]:= expr = (Tan[p]*Cot[p+q])*(Sin[Pi n]+Cos[Pi m])*(Tan[q]+Cot[q]);
In[175]:= expr/.matchChildren[_Plus,x_Tan:>f[x]]
Out[175]= Cot[p+q] (Cot[q]+f[Tan[q]]) (Cos[m \[Pi]]+Sin[n \[Pi]]) Tan[p]
In[176]:= expr/.exceptChildren[_Plus,x_Tan:>f[x]]
Out[176]= Cot[p+q] f[Tan[p]] (Cos[m \[Pi]]+Sin[n \[Pi]]) (Cot[q]+Tan[q])
In[177]:= Cases[expr,matchChildren[_Plus,x_Tan:>f[x]],Infinity]
Out[177]= {f[Tan[q]]}
In[178]:= Cases[expr,exceptChildren[_Plus,x_Tan:>f[x]],Infinity]
Out[178]= {f[Tan[p]]}
In[179]:= Cases[expr,matchChildren[_Plus,x_Tan],Infinity]
Out[179]= {Tan[q]}
In[180]:= Cases[expr,matchChildren[_Plus,x_Tan],Infinity]
Out[180]= {Tan[q]}
It is expected to work with most functions which have the format fun[expr_,rule_,otherArgs___]. In particular, those include Cases,DeleteCases, Replace, ReplaceAll,ReplaceRepeated. I did not generalize to lists of rules, but this should be easy to do. It may not work properly in some subtle cases, e.g. with non-trivial heads and pattern-matching on heads.
According to your explanation in the comment to the acl's answer:
Actually I'd like it to work at any
level in the expression <...>. <...>
what I need is replacement: replace
all expression that match this
"pattern", and leave the rest
unchanged. I guess the simplest
possible solution is finding the
positions of elements, then using
ReplacePart. But this can also get
quite complicated in the end.
I think it could be done in one pass with ReplaceAll. We can rely here on the documented feature of the ReplaceAll: it does not look at the parts of the original expression which were already replaced even if they are replaced by themselves! Citing the Documentation: "ReplaceAll looks at each part of expr, tries all the rules on it, and then goes on to the next part of expr. The first rule that applies to a particular part is used; no further rules are tried on that part, or on any of its subparts."
Here is my solution (whatIwant is what you want to do with matched parts):
replaceNonChildren[lst_List] :=
ReplaceAll[#, {x_List :> whatIwant[x], y_ :> y}] & /# lst
Here is your test case:
replaceNonChildren[{{1, 2, 3}, Graphics[Line[{{1, 2}, {3, 4}}]]}] // InputForm
=> {whatIwant[{1, 2, 3}], Graphics[Line[{{1, 2}, {3, 4}}]]}
Here is a function that replaces only inside certain head (Graphics in this example):
replaceChildren[lst_List] :=
ReplaceAll[#, {y : Graphics[__] :> (y /. x_List :> whatIwant[x])}] & /# lst
Here is a test case:
replaceChildren[{{1, 2, 3}, Graphics[Line[{{1, 2}, {3, 4}}]]}] // InputForm
=> {{1, 2, 3}, Graphics[Line[whatIwant[{{1, 2}, {3, 4}}]]]}
You might write a recursive function that descends an expression tree and acts on the types of expression you want only if inside the right type of sub-expression, while leaving everything else alone. Patterns would be used heavily in the definition of the function.
Consider, for example, the following expression.
test = {{1, 2}, Graphics[{
Point[{{-1, 0}, {1, 0}}],
Line[{{-1, 0}, {1, 0}}]},
Frame -> True,
PlotRange -> {{-1, 1}, {-0.5, 0.5}}]};
Let's suppose that we want to rotate every ordered pair that we see in the first argument of Graphics about the origin through the angle Pi/4, while leaving other points alone. The following function does this.
Clear[f];
f[{x_?NumericQ, y_?NumericQ}] := If[flag === True,
RotationMatrix[Pi/4].{x, y}, {x, y}];
f[Graphics[primitives_, rest___]] := Block[{flag = True},
Graphics[f[primitives], rest]];
f[x_?AtomQ] := x;
f[x_] := f /# x;
Now we check
f[test]
I am probably misunderstanding you, but, if I do understand correctly you want to match all expressions with head List which have the property that, going upwards in the expression tree, we'll never meet a Graphics. I m not sure how to do this in one pass, but if you are willing to match twice, you can do something like
lst = {randhead[5], {1, 2, {3, 5}}, Graphics[Line[{{1, 2}, {3, 4}}]]};
Cases[#, _List] &#Cases[#, Except#Graphics[___]] &#lst
(*
----> {{1, 2, {3, 5}}}
*)
which first selects elements so that the Head isn't Graphics (this is done by Cases[#, Except#Graphics[___]] &, which returns {randhead[5], {1, 2, {3, 5}}}), then selects those with Head List from the returned list. Note that I've added some more stuff to lst.
But presumably you knew this and were after a single pattern to do the job?
In[1]:= SameQ[Dot[1, 2], 1.2]
TrueQ[Dot[1, 2] == 1.2]
a = 1; b = 2;
SameQ[Dot[a, b], a.b]
TrueQ[Dot[a, b] == a.b]
Out[1]= False
Out[2]= False
Out[4]= True
Out[5]= True
I know this uses Dot command wrong. Anybody can give me a clear reson for the above different results?
thanks!
a.b is interpreted as Dot[a,b] and then variables a and b are substituted, meaning Dot[1,2] and thus equality holds. This is not the same as 1.2 where the dot stands for the decimal separator and not for the inline operator of Dot.
When you write 1.2, Mma understands a number (aka 6/5), but if you write {1, 1}.{2, 2} or a.b Mma understands a scalar product, as usual in any book using vectors.
HTH!
It can be informative to view an expression under Hold and FullForm:
a = 1; b = 2;
SameQ[Dot[a, b], a.b]] //Hold //FullForm
Hold[SameQ[Dot[a, b], Dot[a, b]]]
With this combination of commands, Mathematica parses but does not evaluate the expression (Hold), and then shows the long pseudo-internal form of the expression (FullForm).
In this case, you can see that the second term a.b is parsed as Dot[a, b] before any evaluation happens.
When . appears with numerals as in 1.2 it is interpreted specially as a decimal point. This is similar to other numeric entry formats such as: 1*^6 which is recognized directly as 1000000:
1*^6 //Hold //FullForm
Compare trying to enter:
a = 1;
a*^6
I wish to intercept assigning new values for the In variable.
I have tried to do this by defining UpValues for In but it does not help in this case:
Unprotect[In];
In /: Set[In[line_], expr_] /; ! TrueQ[$InsideSet] :=
Block[{$InsideSet = True},
Print[HoldForm#HoldForm[expr]; Set[In[line], expr]]]
In /: SetDelayed[In[line_], expr_] /; ! TrueQ[$InsideSet] :=
Block[{$InsideSet = True},
Print[HoldForm#HoldForm[expr]; SetDelayed[In[line], expr]]]
Is it possible to intercept it?
P.S. This question has arisen as a part of previous question on the stage when Mathematica creates new Symbols.
EDIT
I would wish to intercept explicitly the assignment new DownValue for the In variable. $Pre executes after this assignment and after creating all new Symbols in the current $Context:
In[1]:= $Pre := (Print[Names["`*"]];
Print[DownValues[In][[All, 1]]]; ##) &
In[2]:= a
During evaluation of In[2]:= {a}
During evaluation of In[2]:= {HoldPattern[In[1]],HoldPattern[In[2]]}
Out[2]= a
Have you looked at $Pre and $PreRead?
$Pre is a global variable whose value, if set, is applied to every input expression.
$PreRead is a global variable whose value, if set, is applied to the text or box form of every input expression before it is fed to Mathematica.
UPDATE (now with better example)
In[1]:= $Pre =
Function[{x}, Print["In[",$Line,"] is: ", Unevaluated[x]]; x, HoldFirst];
In[2]:= 2 + 2
During evaluation of In[2]:= In[2] is: 2+2
Out[2]= 4
In[3]:= InString[2]
During evaluation of In[3]:= In[3] is: InString[2]
Out[3]= "\\(2 + 2\\)"
UPDATE 2
Replace $Pre with $PreRead in my code above and you get close to what you want, I believe:
In[1]:= $PreRead = Function[{x}, Print[Names["`*"]]; x, HoldFirst]
Out[1]= Function[{x}, Print[Names["`*"]]; x, HoldFirst]
In[2]:= a = 1
During evaluation of In[2]:= {x}
Out[2]= 1
In[3]:= b = 2
During evaluation of In[3]:= {a,x}
Out[3]= 2
It's not possible to intercept In at the *Value level because the Kernel is simply not interacting with In via value manipulation in "top-level" Mathematica code.
How to get all definitions for a symbol associated with other symbols by TagSet, TagSetDelayed, UpSet or UpSetDelayed?
For example, if one has defined
area[square] ^= s^2
area[cube] ^= 6*s^2
how to obtain these definitions, not knowing the names square, cube but knowing only the name area?
I just have found that UpValues does not return definitions for MakeBoxes and N since they are stored in FormatValues and NValues correspondingly:
In[1]:= rotate /: MakeBoxes[expr_rotate, "StandardForm"] := x
UpValues[rotate]
FormatValues[rotate]
Out[2]= {}
Out[3]= {HoldPattern[MakeBoxes[expr_rotate, "StandardForm"]] :> x}
In[4]:= pi /: N[pi] = 3.14
UpValues[pi]
NValues[pi]
Out[4]= 3.14
Out[5]= {}
Out[6]= {HoldPattern[N[pi, {MachinePrecision, MachinePrecision}]] :>
3.14}
In this way instead of UpValues we should use a combination of UpValues, FormatValues and NValues.
When trying to output a list of FormatValues one can face problems with MakeBoxes since FormatValues gives definitions for MakeBoxes those are further processed by MakeBoxes on creating the output for the FrontEnd. This problem can be solved by switching FormatType temporarily to OutputForm or by converting these definitions to strings.
In[1]:= SetOptions[$Output,FormatType->OutputForm];
FormatValues[DialogNotebook]
Out[2]= {HoldPattern[MakeBoxes[BoxForm`apat$:HoldPattern[DialogNotebook[___]], BoxForm`fpat$_]] :>
BoxForm`BoxFormAutoLoad[MakeBoxes, BoxForm`apat$, BoxForm`fpat$, Typeset`CellNotebook`,
{{CellGroup, _}, {DocumentNotebook, _}, {PaletteNotebook, _}, {DialogNotebook, _}, {ExpressionCell, _}, {Text, _},
{TextCell, _}, {Cell, HoldPattern[MakeExpression[_Cell, _]]}, {Notebook, HoldPattern[MakeExpression[_Notebook, _]]}}]}
In[1]:= ToString#FormatValues[DialogNotebook]
Out[1]= {HoldPattern[MakeBoxes[BoxForm`apat$:HoldPattern[DialogNotebook[___]], BoxForm`fpat$_]] :> BoxForm`BoxFormAutoLoad[MakeBoxes, BoxForm`apat$, BoxForm`fpat$, Typeset`CellNotebook`, {{CellGroup, _}, {DocumentNotebook, _}, {PaletteNotebook, _}, {DialogNotebook, _}, {ExpressionCell, _}, {Text, _}, {TextCell, _}, {Cell, HoldPattern[MakeExpression[_Cell, _]]}, {Notebook, HoldPattern[MakeExpression[_Notebook, _]]}}]}
Attempting to address Alexey's concerns with Howard's answer, I came up with this:
Cases[
UpValues ### MakeExpression /# Names["Global`*"],
HoldPattern[_#_area :> _],
{2}
]
In response to your updated requirements, here is the advanced version:
SetAttributes[otherValues, HoldFirst]
otherValues[sym_] :=
With[{names = MakeExpression /# Names["Global`*"]},
Join[
Cases[UpValues ### names, HoldPattern[_#_sym :> _], {2}],
Cases[NValues ### names, HoldPattern[_#N[sym, ___] :> _], {2}],
Select[Join ## FormatValues ### names, ! FreeQ[#, HoldPattern#sym] &]
]
]
You can try an exhaustive search via
Select[UpValues /# Cases[ToExpression[Names["*"]], _Symbol], ! FreeQ[#, area] &]
which in your example will yield
{{HoldPattern[area[cube]] :> 6 s^2}, {HoldPattern[area[square]] :> s^2}}
The following version
Cases[
Flatten#Map[
ToExpression[#, InputForm, Function[sym, UpValues[sym], HoldAllComplete]] &,
Names["Global`*"]],
Verbatim[RuleDelayed][Verbatim[HoldPattern][_area], _]
]
will not evaluate symbols as well. It is similar in spirit to #Mr. Wizard's answer, but I prefer ToExpression to MakeExpression since the latter is tied to the FrontEnd and boxes ( at least conceptually) , while the former is a general-purpose command (although it is mentioned in the documentation that it will use rules for MakeExpression).
If you have an access to the full Mathematica session from the start, another solution would be to overload TagSet, TagSetDelayed, UpSet and UpSetDelayed so that they will record the symbol dependencies in some kind of hash. Here is an example for UpSet:
Unprotect[UpSet];
Module[{tried, upsetHash},
upsetHash[_] = {};
getUpsetHash[] := upsetHash;
UpSet[f_[args___], rhs_] :=
Block[{tried = True},
AppendTo[upsetHash[f],
Select[HoldComplete[args],
Function[Null, Head[Unevaluated[#]] === Symbol, HoldAll]]];
UpSet[f[args], rhs]] /; ! TrueQ[tried]
];
Protect[UpSet];
All assignments made with UpSet after this redefinition will be recorded. For example, after executing your example above, you can call
In[6]:= getUpsetHash[][area]
Out[6]= {HoldComplete[square], HoldComplete[cube]}
This way you get your information much faster, especially if you want to make such inquiries frequently, and/or you have lots of packages loaded. You can also automate the process further, to switch to the standard definitions for assignments once you load the functionality of interest.