Position of a pattern-matched part of an expression

Question

What you have

1. A pattern, with certain part of it labeled

   As an example — Label: wally

   pattern = h : HoldPattern@f[x, __, 3[5], wally_, y]
   

2. An expression that matches a pattern such as:

   expr = f[x, 9, v, h[v], 3[5], v, y]
   

What I want

The position of the part of the expression expr that matched the label wally.

In the above example, that would be

gimmeWhattaWanna[expr, pattern, wally]
(* {{6}} *)

Note

If the labeled pattern is a sequence such as wally__, either finding the position of the first, or the first and last, are acceptable. If the labeled pattern is repeated such as in f[wally_, 2, wally_], then a list of the positions seems the most natural solution. However, a solution that limits itself to non-repeated labels, or even non-sequence ones is useful.

Answer 1

You really hit the weak spot of the pattern-matcher, it seems - there are no pointers in Mathematica and so expressions don't "know" their parent expressions. I will offer something pretty ugly and also inefficient, which seems to work however. Here is the implementation:

ClearAll[unique];
unique[tag_] := Sow[Unique[], tag];

ClearAll[constructPattern];
constructPattern[pattern_, name_, tag_, sowTag_] :=
   Alternatives @@
      Map[
        ReplacePart[pattern, # -> tag] &,
        Position[pattern, Verbatim[Pattern][name, _]]
      ] /. Verbatim[Pattern][name, _] -> name /.
       Verbatim[Pattern][s_Symbol, rest__] :>
          Pattern[Evaluate[unique[sowTag]], rest];

and the main function:

ClearAll[getPositions];
getPositions[expr_, pattern_, name_] :=
  Module[{tag, positions, parts, sowTag, positionsInMatched, syms, lp = pattern},
     positions = Position[expr, pattern];
     parts = Extract[expr, positions];
     {positionsInMatched, syms} = 
        Reap[
           With[{tagged = constructPattern[pattern, name, tag, sowTag]},
             Cases[parts, 
               p : lp :>
                  Cases[
                    Position[p, name],
                    pos_ /; MatchQ[ReplacePart[p, pos -> tag], tagged]
                  ]
             ]
           ], _, #2 &];
     If[syms =!= {}, Remove @@ First[syms]];
     Flatten[Outer[Join, {#1}, #2, 1, 1] & @@@
        Transpose[{positions, positionsInMatched}], 2]
];

Now, with

pattern = h : HoldPattern@f[x, __, 3[5], wally_, y]
expr = f[x, 9, v, h[v], 3[5], v, y]

one gets

getPositions[expr,pattern,wally]

(* {{6}}  *)

Answer 2

This handles repeated patterns but not sequences yet

SetAttributes[{getMatchedPosition, getCandidatePositions, 
   matchedPositionQ}, HoldFirst];

getMatchedPositions[label_, expr_, pattern_] /; MatchQ[expr, pattern] :=    
 Select[
  getCandidatePositions[label, Unevaluated@expr, Unevaluated@pattern], 
  matchedPositionQ[label, expr, pattern]]    
_getMatchedPositions := $Failed

getCandidatePositions[label_, expr_, pattern_] := 
 Unevaluated[expr] /. pattern :> Hold[label] /. 
  Hold[lab_] :> Position[Unevaluated@expr, Unevaluated@lab]


Off[RuleDelayed::rhs];
matchedPositionQ[label_, expr_, pattern_][pos_] := Module[{tag, hold},
   SetAttributes[hold, HoldAllComplete];
   ! FreeQ[
     Reap[
      MatchQ[
       ReplacePart[hold@expr, pos~Prepend~1 -> tag],
       hold@pattern /. {
           i_Verbatim :> i,
           HoldPattern@Verbatim[Pattern][label, _] :> tag} //.
         {(Condition | PatternTest)[tag, cond_] :> tag} /.
        tag :> (_?((Sow[HoldComplete[#], tag]; True) &))], tag],
     tag]];
On[RuleDelayed::rhs];

So

pattern = h : HoldPattern@f[x, __, h[wally_ /; wally === v], 3[5], wally_, y];
expr = f[x, 9, v, h[v], 3[5], v, y];

getMatchedPositions[wally, expr, pattern]   
(* {{4, 1}, {6}} *)

Answer 3

Can't say if my logic is completely sound here, but this might just work. The method is to search for the label and find the positions of its matches:

possibleMatchPositions[expr_, pattern_, locate_] :=
 Position[expr,
  First@Cases[expr, pattern :> locate, {0,Infinity}, Heads -> True]
 , {0,Infinity}, Heads -> True]

Then to find the correct one, a label is inserted at the matched position and the pattern is tested again to see if it returns the label:

validPositionQ[position_, expr_, pattern_, locate_] := 
 Module[{tagX}, 
  tagX === First@Cases[ReplacePart[expr, position -> tagX] 
      ,pattern :> locate, {0, Infinity}, Heads -> True]]

The entire process is then:

matchPosition[expr_, pattern_, locate_] := 
  Cases[
     possibleMatchPositions[expr, pattern, locate], 
     position_ /; validPositionQ[position, expr, pattern, locate]
  ]

The method definitely fails if the pattern you are searching for appears multiple places and in cases where it has some specifier (for instance wally_Integer or wally_?somethingQ etc.) that means it won't match the tag. You could avoid this by making a substitution on the desired pattern to be general in the verification step. Also it doesn't fail nicely when no matches are present, but I though it better to concisely show the method rather then include checks on lengths.