All possible replacements of an expression, considering each term separately

Question

Say I have an expression:

f[a, f[a, b]]

I would like to replace each a with either x or y. By using Replace, I can do

Replace[f[a, f[a, b]], {{a -> x}, {a -> y}}, All]

Which gives

{
 f[x, f[x, b]],
 f[y, f[y, b]]
}

However, I'd like to get (in any order)

{
 f[x, f[x, b]],
 f[x, f[y, b]],
 f[y, f[x, b]],
 f[y, f[y, b]]
}

Essentially, each term is considered separately.

I've tried looking in the documentation for functions similar to Replace, but to no avail. How do I go about this? Thanks in advance!

---

Edit

I feel I should've been more precise in my original question. For some nested expression like f[x, f[x, x]], I need a list of expressions where some (or all or none) of the f's are replaced by g's. Only f's which take x as their first argument may be replaced; the rest are left unchanged.

For example, an input of

f[f[x, x], x]

Should give (in any order)

{
 f[f[x, x], x],
 f[g[x, x], x]
}

Notice how the first f has not been replaced, since it does not have x as its first argument.

I hope that this rephrasing is not distruptive. If I should instead ask this as a separate question, please tell me!

Answer 1

One possible (and fairly direct) approach is to convert all instances of the symbol to replace into unique versions of that symbol, and then replace each in turn. Automating this is a bit tricky though. I broke this problem up into 3 separate helper functions based around using tmp$n variables as a name space:

tmpvalQ[x_Symbol] := StringMatchQ[SymbolName[x], "tmp$" ~~ __];

This is a helper function which determines if its input is a symbol starting with tmp$.

getreplacements[expr_, replf_] := 
  Map[replf, 
   DeleteDuplicates[
    Cases[expr, (x_?tmpvalQ | (x_?tmpvalQ)[___]) -> x, Infinity, 
     Heads -> True]]];

This helper function generates a set of replacements based on the tmp$ variables found in the expression and a pure function defining what each of these variables should be replaced with. An example of such a function would be {{# -> x}, {# -> y}}, following the original question post.

replaceUnique[expr_, sym_, replf_] := 
 With[{e = expr /. {sym :> Unique[tmp]}}, 
  Fold[ReplaceAll, e, getreplacements[e, replf]]];

This is the core function of this solution. It performs the replacement of the chosen sym to a set of unique temporary symbols using Unique[tmp], generates the list of replacements with getreplacements, and then uses Fold to perform each set of replacements in order for each unique variable generated. As an example:

replaceUnique[f[a, f[a, b]], a, {{# -> x}, {# -> y}} &]

{{f[x, f[x, b]], f[y, f[x, b]]}, {f[x, f[y, b]], f[y, f[y, b]]}}

If you would like to precisely match the suggested output formatting, you may use Flatten as well.

Answer 2

Since the same pattern (a) is to be replaced in different ways in different positions, it seemed to me that the use of Position might be necessary:

replaceAllWays[expr_, rules : {(a_ -> _) ..}] :=
  With[{pos = Position[expr, a]},
   ReplacePart[expr, #] & /@ 
    Flatten[Outer[List, ##] & @@ Outer[Rule, pos, rules[[All, 2]], 1],
      Length[pos] - 1]
   ];

replaceAllWays[f[a, f[a, b]], {a -> x, a -> y}]
(*  {f[x, f[x, b]],
     f[x, f[y, b]],
     f[y, f[x, b]],
     f[y, f[y, b]]}  *)

Other examples (to replace k instances of a in n independent replacements can be done in n^k ways):

replaceAllWays[f[a, f[a, b]], {a -> x, a -> y, a -> z}] // Length
(*  9  *)

replaceAllWays[
  f[a, f[a, b] + f[a, a]], {a -> x, a -> y, a -> z}] // Length
(*  81  *)

Update: To work with other replacements, include RuleDelayed, as requested in a comment. Update 2: I think this problem is perhaps not well define on arbitrary replacement rules. When one rule might change the structure of an expression, it's hard to see how there will always be a consistent way to interpret a set of rules (the order that the rules are applied in the code matters in the second example below).

ClearAll[replaceAllWays];
replaceAllWays[expr_, rules : {(Rule | RuleDelayed)[a_, _] ..}] :=
  With[{pos = Position[{expr}, a]},
   First@Fold[ReplacePart, {expr}, Reverse@#] & /@ 
    Flatten[Outer[List, ##] & @@ 
      Outer[ReplacePart[
         Rule[##], {2} -> Replace[{expr}[[Sequence @@ #1]], #2]] &, 
       pos, rules, 1], Length[pos] - 1]
   ];

replaceAllWays[
 f[f[a, b], a], {head_[a, arg__] :> g[a, arg], 
  head_[a, arg__] :> h[a, arg]}]
(*  {f[g[a, b], a], f[h[a, b], a]}  *)

replaceAllWays[
 f[a, f[a, b]], {head_[a, arg__] :> g[a, arg], 
  head_[a, arg__] :> h[a, arg]}]
(*  {g[a, g[a, b]], h[a, g[a, b]], g[a, h[a, b]], h[a, h[a, b]]}  *)

Answer 3

f1 = Join @@ Outer[f[#, f[#2, b]] &, #, #] &
f1 @ {x, y}

{f[x, f[x, b]],
f[x, f[y, b]],
f[y, f[x, b]],
f[y, f[y, b]]}

f2 = Join @@ Outer[# /. f[x, y_] :> #2[x, y] &, {#}, #2] &;
f2[f[f[x, x], x], {f, g, h}]

{f[f[x, x], x], f[g[x, x], x], f[h[x, x], x]}