16
$\begingroup$

In papers in physics and mathematics one often encounters longer mathematical expressions which have to be, for intuition and typesetting, expressed using symbols standing for recurring patterns in the expressions.

Consider for instance a set of equations where "$r^2 + a^2 \cos^2\! \vartheta$" and "$r^2 - 2M r + a^2$" appear at multiple points so we decide to define the symbols $\Sigma \equiv r^2 + a^2 \cos^2 \! \vartheta$ and $\Delta \equiv r^2 - 2M r + a^2$ as placeholders which shorten my expressions. (This example comes from the metric of a spinning black hole.)

Now, when I make computations, I obtain expressions of the sort $$(\Delta + 2Mr - a^2 \sin^2\! \vartheta)(\Sigma -2Mr + a^2 \sin^2\! \vartheta)$$ In Mathematica I write

Sig = r^2 + a^2 Cos[th]^2; Delt = r^2 - 2 M r + a^2; expression = (Delt + 2 M r - a^2 Sin[th]^2) (Sig - 2 M r + a^2 Sin[th]^2)

and obtain (r^2 + a^2 Cos[th]^2)(r^2 - 2 M r + a^2) which is obviously just $\Delta \Sigma$. I would like Mathematica to return $\Delta \Sigma$ automatically, i.e. maximize the amount of the expression which can be "unsubstituted" by the original set of symbols.

A simple replacement rule of the sort expression/.{r^2 - 2 M r + a^2->Delt, r^2 + a^2 Cos[th]^2->Sig} is not what I am looking for because it does not crack things such as (r(r-2M)+a^2) or (r^2 + a^2 - a^2 Sin[th]^2). One could build a set of replacement rules which somehow list these variations but I do not think it would be able to take care of e.g.

(r^2 - 2 M r + a^2)(r^2 + a^2) - a^2 Sin[th]^2 (r^2 + 2 M r + a^2)

(An example of real output from FullSimplify) to reduce to $\Delta \Sigma - 4 M r a^2 \sin^2 \! \vartheta$.

I think this should be somehow possible through the modification of the ComplexityFunction and TransformationFunctions for FullSimplify but it is not clear to me how.

Improve this question
$\endgroup$
4
  • $\begingroup$ You really should correct your input code so that the desired result can be made to work. $\endgroup$
    – Daniel Lichtblau
    Commented Feb 27, 2017 at 23:25
  • $\begingroup$ @DanielLichtblau There was one sign error which I have already corrected. I do not understand what error you mean, all pieces of the code I cite evaluate without errors. Can you point out specifically what you think is wrong or what does not evaluate for you? $\endgroup$
    – Void
    Commented Feb 28, 2017 at 19:40
  • 1
    $\begingroup$ The presence or absence of a^2 factors determines whether expression is or is not equivalent to Δ Σ. As coded above, it is not. $\endgroup$
    – Daniel Lichtblau
    Commented Feb 28, 2017 at 22:36
  • $\begingroup$ @DanielLichtblau Thank you for pointing that out. $\endgroup$
    – Void
    Commented Mar 1, 2017 at 12:35

2 Answers 2

Reset to default
15
+50
$\begingroup$

This comes up often. Here are links to related MSE threads.

Rename terms of polynomials

Collecting factors of polynomials

Can I simplify an expression into form which uses my own definitions?

Replace expressions with symbols

Here is an omnibus link provided by @Mr.Wizard.

https://mathematica.stackexchange.com/questions/linked/3822?lq=1

For the particular example at hand one might proceed as follows.

Set up expression:

Sig = r^2 + a^2*Cos[th]^2;
Delt = r^2 - 2*M*r + a^2;
expression = (Delt + 2*M*r - a^2*Sin[th]^2) (Sig - 2 *M*r + a^2*Sin[th]^2);

Create replacement expression and then "canonicalize" with GroebnerBasis, making sure to use the variables in the original expression so they are ordered larger than anything else (in particular, larger than the replacement symbols).

repExprs = {sig - Sig, delt - Delt, Cos[th]^2 + Sin[th]^2 - 1};
repBasis = GroebnerBasis[repExprs, Variables[expression]];

Now use this to find the canonicalized form of the expression.

PolynomialReduce[expression, repBasis, Variables[expression]][[2]]

(* Out[769]= delt sig *)

--- edit ---

We really should be more complete in how we handle trigonometric functions. One way is to create new variables and make sure that every time we have a "sine variable" we also make use of the corresponding cosine, and vice versa. Here is suitably modified code for this.

Sig = r^2 + a^2*Cos[th]^2;
Delt = r^2 - 2*M*r + a^2;
trigRep = {Sin[a_] :> s[a], Cos[a_] :> c[a]};
trigSwap = {s[a_] :> c[a], c[a_] :> s[a]};
expression = (r^2 - 2 M r + a^2) (r^2 + a^2) - 
    a^2 Sin[th]^2 (r^2 + 2 M r + a^2) /. trigRep;
vars = Union[Variables[expression], Variables[expression] /. trigSwap];
repExprs = {sig - Sig, delt - Delt, Cos[th]^2 + Sin[th]^2 - 1} /. 
   trigRep;
repBasis = GroebnerBasis[repExprs, vars];

Now we get a reasonable outcome for a different example, posted in a comment.

PolynomialReduce[expression, repBasis, vars][[2]]

(* Out[311]= -8 M^2 r^2 + delt sig + M r (-4 delt + 4 sig) *)

One could add a reversed form of trigRep in order to replace surrogate variables, if any, with their actual trig forms.

--- end edit ---

Improve this answer
$\endgroup$
1
  • $\begingroup$ I didnt have access to Mathematica before the bounty started running out, so I just gave the bounty to you because I assumed that I can either find an answer in the links or your code. However, when I use expression = (r^2 - 2 M r + a^2) (r^2 + a^2) - a^2 Sin[th]^2 (r^2 + 2 M r + a^2); in your code, I get something much more complicated than delt sig - 4 M r a^2 Sin[th]^2 (as was a requirement in the description of the bounty). Can your code perhaps be tweaked to return delt sig - 4 M r a^2 Sin[th]^2 or something similar in that case? $\endgroup$
    – Void
    Commented Mar 8, 2017 at 13:39
14
$\begingroup$

You could use Simplify or FullSimplify with your transformation rules as assumptions, expressed as equations:

FullSimplify[
   (r^2 + a^2 Cos[th]^2) (r^2 - 2 M r + a^2), 
   {Sig == r^2 + a^2 Cos[th]^2, Delt == r^2 - 2 M r + a^2}
]

(* Out: Delt Sig *)

and 

FullSimplify[
   (r^2 - 2 M r + a^2) (r^2 + a^2) - a^2 Sin[th]^2 (r^2 + 2 M r + a^2), 
   {Sig == r^2 + a^2 Cos[th]^2, Delt == r^2 - 2 M r + a^2}
]

(* Out: Delt (Delt + 2 M r) - a^2 (Delt + 4 M r) Sin[th]^2 *)
Improve this answer
$\endgroup$
7
  • $\begingroup$ Would it be possible to tweak this to get Delt Sig + 4 M r a^2 Sin[th]^2 as the second output? $\endgroup$
    – Void
    Commented Feb 22, 2017 at 15:53
  • $\begingroup$ @Void Are you sure that the two expressions are actually equivalent? Consider that the following: FullSimplify[With[{Sig = r^2 + a^2 Cos[th]^2, Delt = r^2 - 2 M r + a^2}, (r^2 - 2 M r + a^2) (r^2 + a^2) - a^2 Sin[th]^2 (r^2 + 2 M r + a^2) == Delt Sig + 4 M r a^2 Sin[th]^2]] returns a M r Sin[th] == 0, i.e. the two expressions are NOT equivalent in the general case. $\endgroup$
    – MarcoB
    Commented Feb 22, 2017 at 16:08
  • $\begingroup$ Sorry, sign error, it is supposed to be Delt Sig - 4 M r a^2 Sin[th]^2. FullSimplify[ With[{Sig = r^2 + a^2 Cos[th]^2, Delt = r^2 - 2 M r + a^2}, (r^2 - 2 M r + a^2) (r^2 + a^2) - a^2 Sin[th]^2 (r^2 + 2 M r + a^2) == Delt Sig - 4 M r a^2 Sin[th]^2]] returns True. I guess this is the reason I need Mathematica to check my computations... $\endgroup$
    – Void
    Commented Feb 22, 2017 at 17:04
  • $\begingroup$ @MarcoB Why this FullSimplify[ x1 + x2 , {Sig == x1 + x2}] doesn't work ? $\endgroup$
    – Orders
    Commented Mar 3, 2017 at 1:35
  • 1
    $\begingroup$ @Orders Unfortunately, sometimes the simplifications depend on the lexicographic order of the variables. Compare for instance your result with FullSimplify[a1 + a2, Sig == a1 + a2] which in fact does return Sig as you would expect. This has come up on the site before, and it is quite unfortunate, but somewhat difficult to avoid in the general case. If you are aware of it, though, you can at least try to work around it... $\endgroup$
    – MarcoB
    Commented Mar 3, 2017 at 5:40

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.