3
$\begingroup$

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.

$\endgroup$
  • $\begingroup$ If you evaluate the two expressions using FullForm you'll see something like this: Times[Power[n1,-1]...]. The difference between the two expressions is that the later one has a FullForm of Times[Power[n1,-1]..., n5]. Pattern matching will work differently depending on which rule you place first after /.the way you define your patterns. $\endgroup$ – user42582 Sep 11 '17 at 12:21
3
$\begingroup$

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

$\endgroup$
  • $\begingroup$ Thanks for your efforts! I wonder though why it returned 2*a2, do we not expect, a2+e? $\endgroup$ – CAF Jun 9 '18 at 21:20
  • $\begingroup$ You're right, I've something missed that. The new version should not produce wrong results anymore. $\endgroup$ – Lukas Lang Jun 9 '18 at 21:34
  • $\begingroup$ Works indeed like a charm! I've checked it works for around 100 of such terms I have been dealing with. Will try to understand your 'How it works' section tomorrow, thanks! $\endgroup$ – CAF Jun 9 '18 at 21:48
  • $\begingroup$ Glqd it finally works! Feel free to ask questions if something about the working principle is unclear $\endgroup$ – Lukas Lang Jun 9 '18 at 21:50
4
$\begingroup$

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 *)
$\endgroup$
3
$\begingroup$

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.

$\endgroup$
  • $\begingroup$ That's because the replacement is too strict now... I'll see whether this approach can be adapted $\endgroup$ – Lukas Lang Sep 11 '17 at 13:04
  • $\begingroup$ Thanks!I tried it with replaceStrict[expr_, rules_] := Block[{Times}, expr /. rules] replaceStrict[-(1/ n3 ) + n1 /( n2 n3 ) + 1/ n4 - n1 /( n2 n4 ), {1/n3 -> a, n1/(n2*n3) -> b, 1/n4 -> c, n1/(n2*n4) -> d}] also and this does not make the proper replacement $\endgroup$ – CAF Sep 11 '17 at 13:11
2
$\begingroup$

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) *)
$\endgroup$
  • $\begingroup$ Very late reply but is there a way to generalise this answer to allow products in the numerators? E.g n2/n3/n4/n5 + n1*n2/n3/n4/n5 /. PatternSort@{ n2/n3/n4/n5 -> a2, n1*n2/n3/n4/n5 -> e} will work but n2/n3/n4/n5 + n1*n2/n3/n4/n5 /. PatternSort@{n1*n2/n3/n4/n5 -> e,n2/n3/n4/n5 -> a2} will not $\endgroup$ – CAF Jun 8 '18 at 10:31
1
$\begingroup$

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 }

$\endgroup$
  • $\begingroup$ Thanks for this but as I am a beginner I have no idea what that means. I have around 50 of these terms so I will try to work with what you have in your answer to generalise but I think it's probably better to just try and order by myself. I am surprised there is not a simple solution with a clever use of brackets or something in the replacement rules. $\endgroup$ – CAF Sep 11 '17 at 12:34
  • 2
    $\begingroup$ This replacement is equivalent to simply /. {__*_Symbol :> a, __Times :> b}. Further I don't see how this is a solution to the question presented. $\endgroup$ – Mr.Wizard Sep 11 '17 at 12:48
  • $\begingroup$ It matches the patterns presented as a use case. $\endgroup$ – user42582 Sep 11 '17 at 12:53
0
$\begingroup$

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

$\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.