wolfram mathematica - Pattern to match only "children" of certain elements

Question

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?

Answer 1

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.