Я предложу решение, основанное на предварительной обработке выражений и мягких переопределениях операций с использованием правил, а не самих правил. Вот код:
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;
]
Несколько подробностей об идеях реализации и о том, как это работает. Идея состоит в том, чтобы ограничить шаблон, который должен соответствовать, мы можем обернуть этот шаблон в какую-то голову (скажем, h), а также обернуть все элементы, соответствующие исходному шаблону, но также находящиеся (или не являющиеся) в некотором другом элемент (соответствующий «родительскому» шаблону) в той же голове h. Это можно сделать для общего «дочернего» шаблона. Технически, одна вещь, которая делает это возможным, это навязчивая природа применения правил (и передача параметров функции, которые имеют одинаковую семантику в этом отношении). Это позволяет взять правило типа x_List:>f[x], соответствующее универсальному шаблону lhs_:>rhs_, и изменить его на h[x_List]:>f[x], в общем случае, используя h[lhs]:>rhs. Это нетривиально, потому что RuleDelayed - это ограниченная конструкция, и только навязчивость другого RuleDelayed (или передача параметров функции) позволяет нам выполнять необходимую операцию области. В некотором смысле, это пример конструктивного использования того же эффекта, который приводит к негерметичной функциональной абстракции в Mathematica. Другой технической деталью здесь является использование UpValues для перегрузки функций, которые используют правила (Cases, ReplaceAll и т. Д.) «Мягким» способом, без добавления каких-либо правил к ним. В то же время UpValues здесь позволяет коду быть универсальным - один код выполняет множество функций, использующих шаблоны и правила. Наконец, я использую переменные Module в качестве механизма инкапсуляции, чтобы скрыть вспомогательную головку h и функцию preprocess. Как правило, это очень удобный способ добиться инкапсуляции как функций, так и данных в масштабе, меньшем, чем пакет, но больше, чем одна функция.
Вот несколько примеров:
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]}
Ожидается, что он будет работать с большинством функций, имеющих формат fun[expr_,rule_,otherArgs___]. В частности, это включает Cases,DeleteCases, Replace, ReplaceAll,ReplaceRepeated. Я не обобщал списки правил, но это должно быть легко сделать. Это может не работать должным образом в некоторых тонких случаях, например с нетривиальными головками и сопоставлением с рисунком на головах.