35
$\begingroup$

I have a big polynomial that evaluates to: $$A^2 e^2 \phi ^- \phi ^++A e \phi ^- \phi ^+ c_{2 w} g_Z+\frac{1}{2} A e g h W^- \phi ^+ +\ll13\gg,$$ which is supposed to represent some terms in the standard model Lagrangian. I need to do the following:

  1. Reorganize the factors in each term so that $e$ comes before $A$ and $\phi^+$ before $\phi^-$. So that the first term, for example, would instead read $e^2A^2\phi ^+\phi ^- $.

  2. Reorganize the whole polynomial so that terms containing $h$ comes first and those containing $\phi^\pm$ come last so that the above expression would start with the third term displayed above.

I believe this would be done most efficiently by customizing the canonical ordering of each symbol in Mathematica. I'm pretty sure this can't be done — so what can I do to achieve my task?

$\endgroup$
7
  • $\begingroup$ is << 13 >> supposed to be Skeleton? $\endgroup$
    – rm -rf
    Aug 18, 2012 at 1:16
  • 2
    $\begingroup$ @R.M no, it's just << bad luck >> in its broadest sense $\endgroup$ Aug 18, 2012 at 1:32
  • $\begingroup$ @Verde Well, it's Friday too... $\endgroup$
    – rm -rf
    Aug 18, 2012 at 1:33
  • $\begingroup$ Yes, Skeleton $\endgroup$
    – QuantumDot
    Aug 18, 2012 at 1:45
  • $\begingroup$ I think the solution depends on what you want: just format a formula, or use it in follow-up calculation. I'll suggest using Row to simulate an ordered product/sum for the former case, but some carefully defined uncommutative operators for the latter case. $\endgroup$
    – Silvia
    Aug 18, 2012 at 16:23

5 Answers 5

19
$\begingroup$

As you said in your comment that you just want a well displayed formula, I suggest using Row to force specific orders. A rough example will look like following, you might want to adjust the priority level according to your needs:

expr = A^2 e^2 SuperMinus[\[Phi]] SuperPlus[\[Phi]] + 
  A e SuperMinus[\[Phi]] SuperPlus[\[Phi]] Subscript[c, 2 w] Subscript[g, Z] +
  1/2 A e g h SuperMinus[W] SuperPlus[\[Phi]]

enter image description here

Clear[prodSort]
prodSort[mono_] :=
If[Head[mono] =!= Times,
 Row[{mono}],
 Module[{termLst, priorityTable},
  termLst = List @@ mono;
  priorityTable = Piecewise[{{0, NumericQ[#]},
       {10, Not@FreeQ[#, e]},
       {11, Not@FreeQ[#, A]},
       {100, Not@FreeQ[#, SuperPlus[\[Phi]]]},
       {101, Not@FreeQ[#, SuperMinus[\[Phi]]]}
       }, 50] & /@ termLst;
  Row@SortBy[{termLst, priorityTable}\[Transpose], Last][[All, 1]]
  ]
 ]

Clear[sumSort]
sumSort[polynom_] :=
 Module[{termLst, priorityTable},
  termLst = List @@ polynom;
  priorityTable = 
   Piecewise[{{0, Not@FreeQ[#, h]},
              {100, Not@FreeQ[#, SuperPlus[\[Phi]]]},
              {100, Not@FreeQ[#, SuperMinus[\[Phi]]]}
             }, 10] & /@ termLst;
  SortBy[{termLst, priorityTable}\[Transpose], Last][[All, 1]] // 
    Riffle[#, "+"] & // Row
  ]

sumSort[prodSort /@ expr] // TraditionalForm

enter image description here

It can be copied as LaTeX code from Copy As menu:

$$\frac{1}{2}eAghW^-\phi ^++e^2A^2\phi ^+\phi ^-+eAc_{2 w}g_Z\phi ^+\phi ^-$$

Edit:

  1. For dealing with negative terms, a special abbreviation rule can be introduced:

    negTermQ[mono_] := mono[[1, 1]] == -1 ||
      AtomQ[mono[[1, 1]]] &&
       ! StringFreeQ[ToString[mono[[1, 1]]], "-"]
    
    negTermAbbr[mono_] := If[mono[[1, 1]] == -1,
      ReplacePart[mono, {1, 1} -> "-"],
      mono]
    
    negAbbr[expr_] := expr //.
      Row[{pre__, "+", mono_?negTermQ, post___}] :>
       Row[{pre, negTermAbbr[mono], post}]
    
    (*pardon me for an example that may be physical meaningless*)
    expr = A^2 e^2 SuperMinus[\[Phi]] SuperPlus[\[Phi]] -
      \[Pi] A e SuperMinus[\[Phi]] SuperPlus[\[Phi]] Subscript[c, 2 w] Subscript[g, Z] + 
      1/2 A e g h SuperMinus[W] SuperPlus[\[Phi]] - Sqrt[2] - 2 A
    
    sumSort[prodSort /@ expr] // negAbbr // TraditionalForm
    

    enter image description here

  2. Some explanation about the code.

    In prodSort a monomial which is a product is transformed from a1 * a2 * ... * an to a List structure {a1, a2, ..., an}, then the list is sorted according to the key term ($e$, $A$, $\phi^+$, $\phi^-$) they contain, then the sorted list is wrapped by Row. sumSort is built on a similar concept.

$\endgroup$
4
  • $\begingroup$ Wow I don't even understand half the syntax on here but it certainly does the job (almost perfectly). I barely understood it enough to adapt it to my needs. This is amazing! Only problem is if a term is negative then I will get a +- in front of it instead of a -. $\endgroup$
    – QuantumDot
    Aug 19, 2012 at 0:53
  • $\begingroup$ @QuantumDot Sorry for lack of explanation. See my edit please. And please note I improved the prodSort function. $\endgroup$
    – Silvia
    Aug 19, 2012 at 3:02
  • $\begingroup$ Thanks for the explanation! And thanks for the modification! $\endgroup$
    – QuantumDot
    Aug 19, 2012 at 3:48
  • $\begingroup$ @QuantumDot You're welcome:) $\endgroup$
    – Silvia
    Aug 19, 2012 at 7:55
25
$\begingroup$

Something like this might be helpful. It replaces the unsorted list of symbols with a sorted list, lets Mathematica rearrange the expression in the normal way, and then applies a HoldForm before replacing the symbols back again.

reorderSymbols[expr_, symbols_List] := With[{s = symbols}, 
  HoldForm[Evaluate[expr /. Thread[s -> Sort@s]]] /. Thread[Sort@s -> s]]

For example:

test = Expand[(a + b + c)^3]

$a^3 + 3 a^2 b + 3 a b^2 + b^3 + 3 a^2 c + 6 a b c + 3 b^2 c + 3 a c^2 + 3 b c^2 + c^3 $

reorderSymbols[test, {b, c, a}]

$b^3 + 3 b^2 c + 3 b c^2 + c^3 + 3 b^2 a + 6 b c a + 3 c^2 a + 3 b a^2 + 3 c a^2 + a^3 $

$\endgroup$
4
  • $\begingroup$ Looks like the right way to me. +1 $\endgroup$
    – Mr.Wizard
    Aug 19, 2012 at 12:48
  • $\begingroup$ @Simon - On the original SO site I asked a question similar to this and never received an answer that was robust enough to work for more complicated cases. What I wanted to have happen is that Dt[f[K,L]] would return the total diff with the same variable order (to make it easier for others to follow). You're function almost works as I'd want it to, but I have to enter large chunks of ugly code like Dt[K]f^(0,1)[K,L] for the symbols. Do you know how to migrate a question to this site (so u can answer it)? :) stackoverflow.com/q/8624341/667867 $\endgroup$ Sep 3, 2012 at 6:21
  • $\begingroup$ @telefunkenvf14, I don't know about migrating questions. I think you need to speak to a moderator, perhaps asking in chat would be a start. I can't see a straightforward way to extend my solution to your specific problem - the best best might be to automate the entering of your "large chunks of ugly code". $\endgroup$ Sep 3, 2012 at 12:59
  • $\begingroup$ @Simon Thanks for the info and for sharing such a lightweight and easy to understand solution. $\endgroup$ Sep 4, 2012 at 3:18
14
$\begingroup$

Here a similar symbol replacement method to the one Simon used, in my own style.

reorder[expr_, pats_List] :=
  Module[{h, rls},
    rls = MapIndexed[x : # :> h[#2, x] &, pats];
    HoldForm @@ {expr /. rls} /. h[_, x_] :> x
  ]

This definition allows you, within the standard limits of pattern matching expressions (e.g. FullForm) of course, to order arbitrary parts of an expression by pattern rather than merely symbols or fixed expressions. Using Silvia's example, suppose you want the term containing $\pi$ to be ordered early and the radical to be ordered late?

expr = A^2 e^2 SuperMinus[ϕ] SuperPlus[ϕ] - π A e \
SuperMinus[ϕ] SuperPlus[ϕ] Subscript[c, 2 w] Subscript[g, 
     Z] + 1/2 A e g h SuperMinus[W] SuperPlus[ϕ] - Sqrt[2] - 2 A

Mathematica graphics

reorder[expr, {π * _, e, A, SuperPlus[ϕ], SuperMinus[ϕ], Sqrt[_]}]

Mathematica graphics


Silvia implicitly pointed out that the ordering was not correct within the $\pi$ term in the second example and asked how this might be corrected. I believe that this second definition should work in most cases.

reorder2[expr_, pats_List] :=
  Module[{h, rls},
    rls = MapIndexed[x : # :> h[#2, Replace[x, rls, -1]] &, pats];
    HoldForm @@ {expr /. rls} //. h[_, x_] :> x
  ]

reorder2[expr, {π * _, e, A, SuperPlus[ϕ], SuperMinus[ϕ], Sqrt[_]}]

Mathematica graphics

$\endgroup$
2
  • $\begingroup$ +1, also up-voted Simon's answer. Much more elegant than mine. But how do you sort term containing $\pi$ ahead while keeping $e$ before $A$ in it? $\endgroup$
    – Silvia
    Aug 19, 2012 at 15:34
  • $\begingroup$ @Silvia and I voted for yours. :-) That's a good question and I'll try to address it soon. $\endgroup$
    – Mr.Wizard
    Aug 19, 2012 at 17:44
8
$\begingroup$
nice[exp_, varli_List] := Module[{dum}, 
     MakeBoxes[dum[_, y_], fmt_] := ToBoxes[y, fmt]; 
     exp /. Thread[varli -> Reverse /@ MapIndexed[dum, varli]]
]; 

expr = A^2*e^2*SuperMinus[\[Phi]]*SuperPlus[\[Phi]] + 
       A*e*SuperMinus[\[Phi]]*SuperPlus[\[Phi]]*Subscript[c, 2*w]*
       Subscript[g, Z] + (1*A*e*g*h*SuperMinus[W]*SuperPlus[\[Phi]])/2;  

nice[expr, {e, g, h, A, Subscript[c, 2*w], Subscript[g, Z], 
   SuperMinus[W], SuperPlus[\[Phi]], SuperMinus[\[Phi]]}]

reordered polynomial

$\endgroup$
1
$\begingroup$

This is the type of problem that Mathscape was designed to solve.

Unfortunately it's author (Michael Barnett) recently passed away before updating this ambitious project to work with more recent versions of Mathematica.

Mathscape appears to be relatively unknown among Mathematica users. Perhaps a Windows installer that is compatible with a modern LaTeX IDE (e.g. TeXWorks) would have helped his work reach a wider audience.

$\endgroup$
4
  • 1
    $\begingroup$ Could you elaborate on how Mathscape might be used here with Mathematica? Your answer implies that it is easy to use it, but does not show how. As you say, "Mathscape appears to be relatively unknown among Mathematica users.", so some examples would help. $\endgroup$
    – rm -rf
    Dec 1, 2012 at 3:54
  • $\begingroup$ I did not intend to suggest here that Mathscape would be easy to use (or even install for that matter under a more recent version of Mma). Mscape is a meta-language situated between the kernel and LaTeX. Directives allow the user to control the formatting of output in the manner requested by the OP. Several examples are provided in the papers under the heading Mathscape in the link provided above. The issue of controlling the ordering of variables is mentioned as one use case for this package although Mscape aims to be more general than this. $\endgroup$ Dec 2, 2012 at 6:19
  • 4
    $\begingroup$ Hi StackExchanger, the Mathscape link is invalid in your answer, would you update it please? I am interested in it. Thanks. $\endgroup$
    – Silvia
    Apr 10, 2014 at 8:36
  • $\begingroup$ @StackExchanger, Are you aware of any attempts to make Mathscape available once more, even in its outdated form? $\endgroup$
    – jjc385
    Dec 18, 2015 at 0:14

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.