Pattern matching a pattern with patterns

Question

Confusing title, I know. But the question is, if we have two patterns which have the same general structure but different names used in the patterns and different names:

 a = HoldPattern[f[x_, y_, g_, h_]] :> g[x] + h[y];
 b = HoldPattern[g[y_, z_, m_, l_]] :> m[y] + l[z];

And I would like to be able to define a pattern for these two pattens, letting {f,x,y,g,h} take arbitrary values. How would I go about this?

To clearify. If I had a=4;b=5. I could define a common pattern through: _Integer and get MatchQ[a,_Integer](*=>True*) and MatchQ[b,_Integer](*=>True*).

But for my above two patterns, I cannot simply base my pattenr on a and substitute out {f,x,y,g,h} with _ eg:

badpattern = HoldPattern[f_[Pattern[x_,_], Pattern[y_,_],
             Pattern[g_,_], Pattern[h_,_]]] :> h_[x_] + h_[y_];

I should not that what I want as a result is a working pattern not just a method that accomplishes this. Why? Well because the I would have to reimpliment MatchQ, Cases, Position and so forth for everything that expects a pattern as it's input to still work. The code below accomplishes this, however in an ad-hoc fasion.

This is wrong since the result does not distinguish between structural Blanks, and pattern blanks.

My initial code
Just to get a pattern to match to itself I need to get rid of HoldPattern which I do as:

MatchQ[a, a /. HoldPattern -> hp_ /; hp === HoldPattern]
(* True *)

Of cause I could just use Verbatim however then I won't be able to do the next part. Where I extend the same type of pattern of switching out pattern components such as HoldPattern.

To check b against a pattern based on a, I switch out a collection of heads inject new patterns and condition the pattern on the switched out heads:

myPatternPatternA=(a/.{HoldPattern->hp_,Pattern->p_,Blank->b_,RuleDelayed->rd_}
   /.{f->f_,x-> x_,y-> y_,g-> g_,h-> h_ }
 )/;And[hp===HoldPattern,p===Pattern,b===Blank,rd===RuleDelayed];    

MatchQ[b,myPatternPatternA]
 (* True *)

Note that I'm just using a as a template of the new pattern I construct, in the new pattern {f,x,y,g,h} can all take arbitrary values since I'm injecting a new pattern for them after removing {HoldPattern,Pattern,Blank,RuleDelayed}.

It seems however that I'll occasionally have problems with other symbols, which means I need to extend the list for instance to include Set and SetDelayed, however only when they actually appear in the expression, since otherwise the check fails. As such it feels like a rather cumbersome method. So I'm wondering if others have dealt with such cases and how they have carried this out.

Update

I should add that I'm relying on the matching to return values aswell, eg:

myPatternPattern = (a/.{HoldPattern->hp_,Pattern->p_,Blank->b_,RuleDelayed->rd_}
       /.{f->f_,x-> x_,y-> y_,g-> g_,h-> h_ }
     )/;And[hp===HoldPattern,p===Pattern,b===Blank,rd===RuleDelayed]:>f;

Cases[{a,b},myPatternPattern]
 (*{f,g}*)

Mr. Wizard inquired as to what exactly I mean by the two definitions having the same structure. So I'll clarify. If we have two different expressions: f[3,4] and g[2,5] and I wanted to describe their structure, then I could write name_[_Integer,_Integer] as one possible common structure. When I have two patterns this approach breaks down for obvious reasons, Consider; _[varA_] and _[varB_]. I would like to define a "pattern^2" that matches both of these patterns and assigns varA or varB to a name, so I just follow the same recipe as before and substitute varA in the first with name_ and get: `_[_name_]. This obviously fails. So what I have above is a way to define a pattern for patterns such that I can match elements inside them. Confusing, I know.

Answer 1

From a short discussion in Chat I think this question is going in a different direction. It may be a duplicate of How to match a pattern with a pattern? but perhaps more complicated than the examples there.

To illustrate how a pattern can be fully broken down:

a = HoldPattern[g[x_, y_, _, {1, 2}, q : {g_, h_}]] :> g[x] + h[y];

meta =
 Replace[
   HoldPattern @@ {a},
   {Pattern -> Verbatim[Pattern], Blank -> Verbatim[Blank], HoldPattern -> Verbatim[HoldPattern]},
   {2, -1},
   Heads -> True
 ];

MatchQ[a, meta]

True

HoldPattern @@ {a} and {2, -1} is used to keep an outer HoldPattern around the entire thing to prevent any unintentional evaluations.

Every part of meta can be tagged with patterns and used as normal.

---

Since it doesn't make sense to me to assert that f and g literals are similar I shall ignore that for now. Consider this:

fill[pat_] := Range@Length@# /. # -> Extract[pat, 2, Hold] & @ 
   Cases[pat[[1]], Quiet[Verbatim[Pattern][name_, _] :> name_], -1];

similar[a_, b_] := And[
  SameQ @@ ({a, b}[[All, 1]] //. Verbatim[Pattern][_, x_] :> x),
  SameQ @@ fill /@ {a, b}
 ]

Now:

a = HoldPattern[f[x_, y_, g_, h_]] :> g[x] + h[y];
b = HoldPattern[f[y_, z_, m_, l_]] :> m[y] + l[z];

similar[a, b]

True

Answer 2

Here is one possibility. Comparing patterns is a special case of comparing trees in general, so we need some specialized version of diff of Mathematica expressions. One way to build such a diff is to "serialize" expression into atomic elements and then compare the serialized forms.

I will use slightly more complex patterns as examples:

a = HoldPattern[g[x_, y_, _, {1, 2}, q : {g_, h_}]] :> g[x] + h[y];
b = HoldPattern[g[y_, z_, _, {1, 2}, p : {m_, l_}]] :> m[y] + l[z];

Note that the well-defined problem is when the difference is only in pattern names, so I consider the function's name to be the same. One can probably extend the solution below to also different function names, but one would need to impose more constraints on what is considered same, then.

Here is the serialization code:

patternSerialize[pt_] :=
   Quiet@Cases[
      MapIndexed[List, pt, {0, Infinity}], 
      s_ /; AtomQ[Unevaluated[s]] :> HoldComplete[s], 
      {0, Infinity}, 
      Heads -> True];

so that, for example:

patternSerialize[First[a]]//Short

(*    
  {HoldComplete[List],HoldComplete[RuleDelayed],HoldComplete[List],   
  <<170>>,HoldComplete[List],HoldComplete[2],HoldComplete[List]}
*)

Now, the next ingredient is to align the serialized sequences, and here we will leverage SequenceAlignment:

patternsAlign[pt1_, pt2_] :=
   SequenceAlignment @@ Map[patternSerialize, {pt1, pt2}];

so that, for example (note: this example refers to a previous version of the code, but the new corrected one will produce much longer output which is hard to understand, while the essence remains mostly the same):

patternsAlign[First@a,First@b]

(*
     {{HoldComplete[HoldPattern],HoldComplete[g],HoldComplete[Pattern]},
         {{HoldComplete[x]},{HoldComplete[y]}},
     {HoldComplete[Blank],HoldComplete[Pattern]},
         {{HoldComplete[y]},{HoldComplete[z]}},     
     {HoldComplete[Blank],HoldComplete[Blank],HoldComplete[List],
       HoldComplete[1], HoldComplete[2],HoldComplete[Pattern]},
         {{HoldComplete[q]},{HoldComplete[p]}},
     {HoldComplete[List],HoldComplete[Pattern]},
         {{HoldComplete[g]},{HoldComplete[m]}},
     {HoldComplete[Blank],HoldComplete[Pattern]},
         {{HoldComplete[h]},{HoldComplete[l]}},
     {HoldComplete[Blank]}}
*)

I intentionally gave here the full output, so that you can see the structure. Here is then the function which attempts to establish the fact of the pattern's equality and record the transformation rules for pattern names at the same time:

ClearAll[patternsSameQ];
patternsSameQ[{}] := True;
patternsSameQ[pt1_HoldPattern, pt2_HoldPattern] :=
   patternsSameQ[patternsAlign[pt1, pt2]];
patternsSameQ[{{Except[_List] .., HoldComplete[Pattern],HoldComplete[List]}, 
     {{HoldComplete[x_Symbol]}, {HoldComplete[y_Symbol]}},
     rest___}] :=
  (Sow[HoldPattern[x] :> y, $tag]; patternsSameQ[{rest}]);
patternsSameQ[{{Except[_List] ..}, rest___}] :=
   patternsSameQ[{rest}];
patternsSameQ[__] := False;

Here is what we get for our case:

Reap[patternsSameQ[First@a,First@b],$tag,#2&]

(* 
   {True,{{HoldPattern[x]:>y,HoldPattern[y]:>z,HoldPattern[q]:>p,
      HoldPattern[g]:>m,HoldPattern[h]:>l}}}
*)

Now, the final function: it will collect these rules and apply those to the r.h.s. of the first rule, and compare to the second one:

ClearAll[rulesEquivalentQ];
rulesEquivalentQ[lfst_ :> rfst_, lsec_ :> rsec_] :=
   Module[{psame = Reap[patternsSameQ[lfst, lsec], $tag, #2 &]},
     (rfst /. If[# === {}, {}, First[#]] &@Last[psame]) === rsec /;First[psame]
   ];
rulesEquivalentQ[__] := False

This gives:

rulesEquivalentQ[a,b]

(*  True  *)

Answer 3

After a chat with Mr. Wizard I finally had the breakthrough I was looking for, which is how to get this to work using Verbatim. I had already tried to do this but my attempts where somewhat misguided.

The solutoin; you can simply take a template pattern, then apply Verbatim to all sensitive Heads, and inject any wanten patterns in place of previous literals:

 shield = {HoldPattern, Blank, Pattern, RuleDelayed};
   substitutionRules = (# -> Verbatim@#) & /@ shield;
   structural[pattern_] := pattern /. substitutionRules

So now, given my two patterns:

a = HoldPattern[f[x_, y_, g_, h_]] :> g[x] + h[y];
b = HoldPattern[g[y_, z_, m_, l_]] :> m[y] + l[z];

I can define a pattern for patterns simply by applying structural to a template and injecting the patterns I would like into the resulting literal match to create a pattern-pattern:

myPatternPattern = structural[
HoldPattern[name[p1_, p2_, p3_, p4_]] :> p3[p1] + p4[p2]
] /. {name -> name_, p1 -> p1_, p2 -> p2_, p3 -> p3_, p4 -> p4_}

MatchQ[a, myPatternPattern]
MatchQ[b, myPatternPattern]
(*True*)
(*True*)

And this seamlessly works everywhere else (Cases,DeleteCases,Position etc.):

Cases[{a, b}, myPatternPattern :> name]
(* {f,g} *)

All credit goes to Mr.Wizard.