# How do I reassign canonical ordering of symbols?

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?

-
is << 13 >> supposed to be Skeleton? – rm -rf Aug 18 '12 at 1:16
@R.M no, it's just << bad luck >> in its broadest sense – belisarius Aug 18 '12 at 1:32
@Verde Well, it's Friday too... – rm -rf Aug 18 '12 at 1:33
Yes, Skeleton – QuantumDot Aug 18 '12 at 1:45
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. – Silvia Aug 18 '12 at 16:23
show 2 more comments

## 5 Answers

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]]

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

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

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.

-
 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 -. – QuantumDot Aug 19 '12 at 0:53 @QuantumDot Sorry for lack of explanation. See my edit please. And please note I improved the prodSort function. – Silvia Aug 19 '12 at 3:02 Thanks for the explanation! And thanks for the modification! – QuantumDot Aug 19 '12 at 3:48 @QuantumDot You're welcome:) – Silvia Aug 19 '12 at 7:55

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$

-
 Looks like the right way to me. +1 – Mr.Wizard♦ Aug 19 '12 at 12:48 @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 – telefunkenvf14 Sep 3 '12 at 6:21 @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". – Simon Woods Sep 3 '12 at 12:59 @Simon Thanks for the info and for sharing such a lightweight and easy to understand solution. – telefunkenvf14 Sep 4 '12 at 3:18

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

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

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[_]}]

-
 +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? – Silvia Aug 19 '12 at 15:34 +1, great idea to allow patterns. – Simon Woods Aug 19 '12 at 15:59 @Silvia and I voted for yours. :-) That's a good question and I'll try to address it soon. – Mr.Wizard♦ Aug 19 '12 at 17:44
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]]}]

-

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.

-
 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. – rm -rf♦ Dec 1 '12 at 3:54 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. – StackExchanger Dec 2 '12 at 6:19