5
$\begingroup$

Source: Position of a pattern-matched part of an expression

Can someone please explain the following code by Leonid Shifrin.

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];

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]
];

Can someone please explain how this code is working?

Called using:

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

If I put Echo in the inner most Cases like follows: Cases[ Position[p, Echo[name]], pos_ /; MatchQ[ReplacePart[p, pos -> tag], tagged] ] I get name as v? How is that possible, isn't name an input parameter to the function getPositions so should be wally all the way? What is changing the value of name dynamically?

$\endgroup$
  • 2
    $\begingroup$ Before we go into detail and explain a piece of code that was called "ugly and inefficient" by its very author, would you mind to tell us what your actual problem is? I suspect an XY-problem here because what Leonid tries to achieve there might be pretty well a rare border case... $\endgroup$ – Henrik Schumacher Feb 24 at 17:27
  • $\begingroup$ I am looking for an extension of Position. Position[expr, pattern] gives the position of any pattern matched in the expr while Position[pattern, Verbatim[subPattern]] gives the position of any subPattern matched in the pattern. I want a SubPosition[expr, pattern, subPattern] which gives the position of any subPattern matched while matching pattern in expr. Once I understand this code I will try to make it work for any subPattern. $\endgroup$ – user13892 Feb 24 at 21:35
  • $\begingroup$ This code appears to be pretty general already and once understood probably can be modified into SubPosition function that i want. $\endgroup$ – user13892 Feb 24 at 21:39
6
$\begingroup$

A possible implementation of SubPosition

This is an interesting problem, but I think your formulation is actually simpler than the original problem you refer to. To understand why the code worked as it did there, read the next section. Here I will provide a simpler implementation of SubPosition, based on ideas similar to those used in the original code.

Here is the implementation:

ClearAll[subPosition];
subPosition[expr_, pattern_, subPattern_]:=
  Module[{positions, parts, subparts, named, sowTag, syms, positionsInMatched},
    positions = Position[expr,  pattern];  (* Positions matching pattern *)
    parts = Extract[expr, positions]; (* Corresponding parts *)
    {named, syms} = Reap[ 
        (* 
        ** Replace each pattern subPattern with sym:subPattern (where sym is an
        ** inert newly generated symbol), to be able later to build a rule that 
        ** would extract subparts matching the subpattern. Also, record the 
        ** generated symbols using Reap - Sow
        *)
        ReplaceAll[
            pattern, 
            s:Verbatim[subPattern] :> RuleCondition @ Pattern[
                Evaluate @ Sow[Unique[], sowTag], s
            ]
        ],
        sowTag,
        #2&
    ];
    If[syms === {}, (* This would mean that subpattern is not found in a pattern.*)
        Return[{}],
        (* else *)
        syms = First @ syms
    ]; 
    With[{syms =  syms},
        (* 
        ** Extract subparts. For example, if the pattern is f[___,_h,___, _h, ___],
        ** named pattern will become smth. like f[___, $1:_h, ___, $2:_h, ___], then 
        ** the rule will become f[___, $1:_h, ___, $2:_h, ___] :> {$1, $2}, and this 
        ** will effectively extract the subparts for _h for a given part. Replace on  
        ** level {1} will do that for every part, then.
        *)
        subparts = Replace[parts, named :> syms, {1}]; 
        Remove @@ syms; (* Generated symbols no longer needed, remove them *)
    ];
    positionsInMatched = MapThread[ (* Extract positions of subparts for every part *)
        Position, 
        (* 
        ** Verbatim is needed since subparts themselves could be patterns,
        ** while what we need here are verbatim matches.
        *)
        {parts, Alternatives @@@ Map[Verbatim, subparts, {2}]}
    ];
    Flatten[
        (* 
        ** Expand lists like {part-pos, {subpart_1-pos, ..., subpart_n-pos}} into
        ** full positions of subparts 
        **      {Join[part-pos, subpart_1-pos], ... , Join[part-pos, subpart_n-pos]}
        *)
        Outer[Join, {#1}, #2, 1, 1] & @@@ Transpose[{positions, positionsInMatched}], 
        2
    ]
]

The comments should explain how the code works. Here is one example:

expr = {
  h[g[f[x, 9, h[vv], v, h[v], 3[5], v, y]], f[x, h[zz] , 9, v, h[v], 3[5], v, y]], 
  f[x, 9, v, h[q], h[v], 3[5], v, y]
}

pattern = HoldPattern@f[x, __, _h, ___, _h, ___, 3[5], __, y]

Then we get

spos = subPosition[expr, pattern, _h]
Extract[expr, spos]

(*

  {{1, 1, 1, 3}, {1, 1, 1, 5}, {2, 4}, {2, 5}}

  {h[vv], h[v], h[q], h[v]}
*)

There are a few caveats to be aware of, regarding the above implementation

  • I did not heavily test the function
  • I did not take any care to prevent evaluation of extracted parts and subparts. That can be done if needed, and isn't hard to add, but would've made the code somewhat more complex and harder to understand, which is why I considered a simpler problem here for didactic purposes.
  • The code works in such a way that the subPattern is effectively matched twice for every matching subpart: first when the main pattern is matched in Position, and second when subparts are extracted from parts in Replace[parts, named :> syms, {1}]] call. This normally should not be a big issue (except some performance penalty that I do not expect to be significant on the average), particularly for a version which would not evaluate parts and subparts when extracting them.

    However, there is one class of cases where this may matter. That is when subPattern contains Condition and / or PatternTest (which call the main evaluator) with code that has side effects. Such code will be executed twice in this implementation, while only once for the standard built-in pattern-matching process happening when one calls Position, Replace(All), etc. This may lead to unexpected results / effects, unless one is aware of this detail. It is usually not a good style to put side effects in conditions or functions used with PatternTest, but it is occasionally used, and one should be aware of this subtlety for such cases.

Answer to the specific question about code internal mechanics

It took me some time to understand how that code works and why this is happening. The key point is that passed name parameter is itself a symbol, and is being used to construct a pattern / rule, where it plays a role of rule's local variable.

To see that, wrap Echo around p:lp... like this:

Echo[p : lp :> Cases[
   Position[p, name], 
   pos_ /; MatchQ[ReplacePart[p, pos -> tag], tagged]]
]

Then execute the input from that post:

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

What you should get Echo-ed is something like this:

p$:(h:HoldPattern[f[x,__,3[5],wally_,y]]):>
  Cases[
    Position[p$,wally],
    pos$_ /; MatchQ[
      ReplacePart[p$,pos$->tag$28611],
      Alternatives[$154:HoldPattern[f[x,__,3[5],tag$28611,y]]]
    ]
  ]

where you see that wally now becomes a pattern variable, localized by this rule.

What you did echo was the r.h.s. of that rule, where name was first rightfully replaced with wally (as seen from the Echo- ed rule above), but then wally has been now localized by the internal local rule above, and by the time your Echo fired, that rule has been applied and wally has been therefore replaced by the match from the pattern on the l.h.s. (which was v).

For all this to work, it is important that one passes as name an inert symbol without any global value, that can be used as a local variable. Any other thing passed as name would've caused an error exactly because it could not have been used as a rule local variable.

$\endgroup$
  • $\begingroup$ @user13892 There is a defect in my current implementation of subPosition, which I don't have the time to fix now, but will try to fix soon: the line positionsInMatched = MapThread[...] may extract some false positives: the parts identical to some of those that were matching the subpattern, but existing in some other parts of expression matching the main pattern. Just wanted to let you know about this in the mean time. $\endgroup$ – Leonid Shifrin Feb 25 at 14:50

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.