How to make a postordered ReplaceAll that operates just once per subtree?

Question

The answers to this question provide code for a function I'll call postOrderReplaceAll to replace from the inside-out:

postOrderReplaceAll[expr_, rules_] :=
    Fold[Replace[#1, rules, {#2}] &, expr, Reverse@Range[0, Depth@expr]];

It operates on the innermost expression first, and works outward (depth-first postorder), in contrast to the behavior of ReplaceAll, which starts with the biggest expression and then if necessary looks at its parts (depth-first preorder). (See this question and this wiki page for some background.)

This function keeps applying the pattern whenever it can match it, in contrast to ReplaceAll which, once it has found an expression to change, doesn't probe any more:

ReplaceAll[f[f[f[1]]], f[x_] :> g[x] ]
  (*Result: g[f[f[1]]]*)

postOrderReplaceAll[f[f[f[1]]], f[x_] :> g[x] ]
  (*Result: g[g[g[1]]]*)

I would like to make a function postOrderReplaceInnermost that, like ReplaceAll, makes one replacement per subtree, if there is any to be made. How to do it? (And, any suggestions for a better name?)

Examples of desired behavior:

postOrderReplaceInnermost[f[f[f[1]]], f[x_] :> g[x] ]
  (*Result: f[f[g[1]]]*)

postOrderReplaceInnermost[f[f[f[1]]] + f[f[1]], f[x_] :> g[x] ]
  (*Result: f[f[g[1]]] + f[g[1]]*)

I think this might be difficult to achieve with the given code, since it iterates over level (and in example 2, the two terms have different depth).

Here is my attempt, which gets partway there. It uses Throw and Catch to stop the Fold once a replacement has been made:

postOrderReplaceDeepestLevel[expr_, rules_] := 
  Catch@Fold[
    If[! SameQ[Replace[#1, rules, {#2}], #1], 
      Throw[Replace[#1, rules, {#2}]], #] &, expr, 
    Reverse@Range[0, Depth@expr]];

But because the command iterates by level, it stops as soon as it has made a single replacement anywhere, instead of continuing to make one replacement in the first term f[f[1]]:

postOrderReplaceDeepestLevel[f[f[f[1]]] + f[f[1]], f[x_] :> g[x]]
  (* Result: f[f[1]] + f[f[g[1]]]*)
postOrderReplaceDeepestLevel[%, f[x_] :> g[x]]
  (* Result: f[g[1]] + f[g[g[1]]]*)

Answer 1

Based on my understanding of the question, you want to apply the rule to any expression, provided it wouldn't match any of its subexpressions.

You can implement this traversal yourself quite easily with a recursive function, using FreeQ to check whether to go deeper or apply the rule:

postOrderReplaceInnermost[expr_, rule_] := 
  If[FreeQ[expr, rule[[1]], {1, -1}],
    Replace[expr, rule, {0}],
    postOrderReplaceInnermost[#, rule] & /@ expr
  ]

postOrderReplaceInnermost[f[f[f[1]]], f[x_] :> g[x]]
postOrderReplaceInnermost[f[f[f[1]]] + f[f[1]], f[x_] :> g[x]]
postOrderReplaceInnermost[f[f[h[1]]] + f[f[1]], f[x_] :> g[x]]
postOrderReplaceInnermost[f[f[f[1], f[2]], f[f[3], f[f[4], f[5]]]], f[x__] :> g[x]]

(* f[f[g[1]]]
   f[f[g[1]]] + f[g[1]]
   f[g[1]] + f[g[h[1]]] 
   f[f[g[1], g[2]], f[g[3], f[g[4], g[5]]]] *)

Looking at the last example, note that this also works as expected when the rule's pattern has more than one child.

For a short explanation of the code:

• With FreeQ[expr, rule[[1]], {1, -1}] we check that the pattern of the rule (its first element) matches nowhere inside the current expression. The entire expression itself is skipped by specifying that we only start looking from level 1 onwards.
• If this is the case, Replace[expr, rule, {0}] applies the rule to the expression. If the expression matches it gets replaced, otherwise nothing happens. We use Replace and give it a level spec of {0} (instead of a simple expr /. rule), so that the code doesn't have to traverse the entire tree again.
• Otherwise, we know that the pattern matches somewhere inside the tree. Therefore, we recursively apply our function to each immediate subexpression with a map, postOrderReplaceInnermost[#, rule] & /@ expr. Luckily, Map (or /@) works with arbitrary heads and preserves them, so this does exactly what we want.

If you want to support a list of rules like the built-in Replace... functions do, it's not clear what semantics your looking for. Do you want to use a rule unless any of the rules matches further down, or do you want to use a rule unless that same rule matches further down? In either case, the above solution can be adapted quite easily.

Also note that this isn't quite as efficient as it can get, yet, because we're repeating the FreeQ call for every level on the way to a match of the pattern, even if there are many levels in between that don't match. If you're working with massive expression trees where that's an issue, a more elaborate solution based on Position, which skips non-matching levels entirely might be a better idea.

Here is such an implementation but I haven't actually profiled it yet to see how much it actually saves (if anything):

postOrderReplaceInnermost[expr_, rule_] := 
  Module[{matches = Position[expr, rule[[1]]], deepest},
    deepest = Complement[
      matches, 
      Flatten[Most@FoldList[Append, {}, #] & /@ matches, 1]
    ];
    MapAt[Replace[#, rule, {0}] &, expr, deepest]
  ]

The idea is to find all matches in the tree once with Position. Then we discard all positions that are prefixes of other positions (I'm sure there is a better solution for that then FoldList and Complement), because those contain further matches of the pattern. Finally, we map Replace with a levelspec of {0} over only those positions in the tree.