4
$\begingroup$

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!

$\endgroup$
  • $\begingroup$ Map[f[#[[1]],f[#[[2]],b]]&,Tuples[{x,y},2]] instantly gives you the list of results {f[x,f[x,b]], f[x,f[y,b]], f[y,f[x,b]], f[y,f[y,b]]} $\endgroup$ – Bill Aug 21 at 17:00
  • $\begingroup$ @Bill Thanks! How might I package this up into a function, e.g. replacePerTerm? $\endgroup$ – ryuku Aug 21 at 17:32
1
$\begingroup$

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.

$\endgroup$
  • $\begingroup$ Thank you for the in-depth explanation! Is it also possible to replace the head of expressions, such as f? $\endgroup$ – ryuku Aug 21 at 17:38
  • $\begingroup$ @ryuku That was more complicated than it should have been, but yes, it's possible. See the edited getreplacements for that functionality. The extended Cases is primarily to ensure that heads are treated as symbols rather than as expressions with arguments. $\endgroup$ – eyorble Aug 21 at 17:52
  • $\begingroup$ I just can't seem to make it work for me. Trying replaceUnique[f[a, f[a, b]], f, {{# -> x}, {# -> y}} &] leaves the f's as tmp$ variables. $\endgroup$ – ryuku Aug 21 at 17:56
  • $\begingroup$ Please try clearing getreplacements and using the newer edited version of it. $\endgroup$ – eyorble Aug 21 at 17:59
  • $\begingroup$ Thanks, and apologies for overlooking your edit. $\endgroup$ – ryuku Aug 21 at 18:04
1
$\begingroup$

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]]}  *)
$\endgroup$
  • $\begingroup$ Is it too much to ask that it can handle more complex rules, such as in Replace[f[f[a, b], b], head_[a, arg__] :> g[a, arg], All]? In this case, it only replaces the second f with g, because it is following by an a $\endgroup$ – ryuku Aug 21 at 18:07
  • $\begingroup$ @ryuku "In this case, it only replaces the second f with g"-- is what it does what you want? Or do you want something else? $\endgroup$ – Michael E2 Aug 21 at 18:15
  • $\begingroup$ It is what I want, I'm just unsure as to how one can extend replaceAllWays to include this functionality $\endgroup$ – ryuku Aug 21 at 18:17
  • $\begingroup$ @ryuku I see. It's the RuleDelayed instead of Rule. I extended the function definition to include both cases. Please see the updated function. $\endgroup$ – Michael E2 Aug 21 at 18:19
  • $\begingroup$ Trying replaceAllWays[f[f[a, b], b], {head_[a, arg__] :> g[a, arg]}] does not give the intended result. Should I write the RuleDelayed differently? $\endgroup$ – ryuku Aug 21 at 18:28
0
$\begingroup$
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]}

$\endgroup$

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.