Making strict replacements in Mathematica

Question

My question is quite a simple one, but I have not been able to find a solution yet. Say I have terms of the form e.g

1/n1/n2/n3/n4

and

n5/n1/n2/n3/n4

where the ni are just symbols. I want to replace these two terms as follows.

  /.{1/n1/n2/n3/n4->a, n5/n1/n2/n3/n4->b}

I find that in some cases Mathematica will do it, but in some cases it will give me expressions like replacing the latter term as n5*a, etc. rather than just b as indicated. The replacement works how I like it to if I order the replacements in the right way within the brackets. Is there a way to make this automatic? I am dealing with many of these terms so to order appropriately would be tiresome.

Answer 1

_{Third times's the charm, isn't it? ;)}

Similar in spirit to my other answer using GeneralUtilities`PatternSort, but fully documented and more robust:

robustRuleSort[rules_] := Module[{ruleSorter},
  (ruleSorter[# dummyPat_] := {{#2}}) & @@@ rules;
  DownValues[ruleSorter][[All, All, 1, 1]] /. p_ Verbatim[dummyPat_] :> p
]

n2/n3/n4/n5 + n1*n2/n3/n4/n5 /. robustRuleSort@{n2/n3/n4/n5 -> a2, n1*n2/n3/n4/n5 -> e}
(* a2 + e *)

How it works

The basic idea is to (ab)use the rule ordering mechanism of downvalues to order the rules for us. This has the advantage that we use the best available specificity tester available, rather that something that tries to emulate it (like GeneralUtilities`PatternSort or Internal`ComparePatterns). This requires a few things:

• A dummy symbol to attach our rules to (ruleSorter). We will attach our rules as downvalues, which are then ordered by specificity (see here).
• We need to make sure the rules are not literal downvalues (ordering doesn't work for them). Hence the dummyPat factor we add. We later remove it using ReplaceAll (/.) (note the use of Verbatim)
• The right-hand-side of the downvalues is wrapped in {{…}} to make extraction easier: DownValues[sym] are always of the form {HoldPattern[sym[lhs]]:>rhs}. This means we need to strip off two layers on the lhs, so we add two on the rhs to even it out.

This results in a rule sorter that should be as good as possible

Answer 2

Replacements in Mathematica are structural, so you must understand how your expressions will appear structurally to use them. For the kind of mathematically-aware rewrite you appear to want, you can avoid this by putting your problem in equation form and using algebra:

Eliminate[{expr == (1 - n5)/(n1*n2*n3*n4), 1/n1/n2/n3/n4 == a,
n5/n1/n2/n3/n4 == b}, {n1, n2, n3, n4, n5}]
(* b + expr == a *)
expr /. Solve[%, expr][[1]]
(* a - b *)

Answer 3

One way is the following: Since the issue is caused by the Flatness of Times, we simply remove the attribute temporarily:

replaceStrict[expr_, rules_] := Block[{Times}, expr /. rules]

replaceStrict[1/n1/n2/n3/n4 + n5/n1/n2/n3/n4, {1/n1/n2/n3/n4 -> a, n5/n1/n2/n3/n4 -> b}]
(* a + b *)

What this does: The function replaceStrict temporarily replaces Times with a symbol that has no meaning, i.e. no special rules are applied to it. Then, the replacement is made.

Answer 4

Another approach is to try and sort the rules, so that more specific ones are applied first. This can be done using GeneralUtilities`PatternSort:

Needs["GeneralUtilities`"]

1/n1/n2/n3/n4 + n5/n1/n2/n3/n4 /. PatternSort@{1/n1/n2/n3/n4 -> a, n5/n1/n2/n3/n4 -> b}
(* a + b *)

-(r/(16 n3 (r + s)^3)) + (n1 r)/(16 n2 n3 (r + s)^3) + r/(16 n4 (r + s)^3) /. 
 PatternSort@{1/n3 -> a, n1/n2/n3 -> b, 1/n4 -> c}
(* -((a r)/(16 (r + s)^3)) + (b r)/(16 (r + s)^3) + (c r)/(16 (r + s)^3) *)

Answer 5

It might not be elegant, but I think it works on the example provided

{
 1/n1/n2/n3/n4,
 n5/n1/n2/n3/n4
} /. {
 Times[y__, x_?(Head[#] === Symbol &)] :> b, 
 Times[y__?(Head[#] === Times &)] :> a
}

The output of the evaluation of the replacement rules will yield {b,a}.

The same result can be gotten by using //. { Power :> h, Times[x_?(Head[#] === Symbol &), h[_, -1] ..] :> b, Times[h[_, -1], __] :> a }

Answer 6

Considering all of your test cases:

Unevaluated[1/n1/n2/n3/n4 + n5/n1/n2/n3/n4] /.
{HoldPattern[1/n1/n2/n3/n4] -> a, HoldPattern[n5/n1/n2/n3/n4] -> b}

a + b

Unevaluated[n2/n3/n4/n5 + n1*n2/n3/n4/n5] /. 
{HoldPattern[n1*n2/n3/n4/n5] -> a2, HoldPattern[n2/n3/n4/n5] -> e}

a2 + e

Unevaluated[-(1/n3) + n1/(n2 n3) + 1/n4 - n1/(n2 n4)] /. 
{HoldPattern[1/n3] -> a, HoldPattern[n1/(n2*n3)] -> b,
HoldPattern[1/n4] -> c, HoldPattern[n1/(n2*n4)] -> d}

-a + b + c - d

Mathe172's very nice robustRulesSort Module, in the accepted answer, requires much less typing, and would thus be the preferred approach if one had many replacements with functional forms similar to those above. However, the syntax I've given may be more canonical. For instance:

robustRuleSort[rules_] := 
Module[{ruleSorter}, (ruleSorter[# dummyPat_] := {{#2}}) & @@@ rules;
DownValues[ruleSorter][[All, All, 1, 1]]
/. p_ Verbatim[dummyPat_] :> p]

Exp[x]^2 + Exp[y]^2 /. robustRuleSort@{Exp[x] -> a, Exp[y] -> b}

E^(2 x) + E^(2 y)

Unevaluated[Exp[x]^2 + Exp[y]^2] /. 
{HoldPattern[Exp[x]] -> a, HoldPattern[Exp[y]] -> b}

a^2 + b^2