Changing the display ordering of orderless functions?

Question

If I write

x = -(1 - 2 G M/r) \[DoubleStruckD]t^2 + (1 - 
2 G M/r)^-1 \[DoubleStruckD]r^2 + r^2 \[DoubleStruckD]θ^2 +
r^2 Sin[θ]^2 \[DoubleStruckD]ϕ^2;

x

I see

When I write x (or perhaps x//SpecialDisplay), I want to see

that is, I want expressions containing dt to come first, and then expressions containing dr, and then expressions containing dθ, and then expressions containing dϕ. I know I can write this as

MyPlus[var_][v___] := 
  With[{has = Select[{v}, Not[FreeQ[#, var]] &], 
    nothas = Select[{v}, FreeQ[#, var] &]},
   If[Length[has] > 0 && Length[nothas] > 0,
    Row[{Plus @@ has, " + ", Plus @@ nothas}],
    Plus[v]
    ]
   ];
Pull[x_, var_] := x /. Plus -> MyPlus[var]
SpecialDisplay[x_] := 
 Fold[Pull[#1, #2] &, 
  x, {\[DoubleStruckD]t, \[DoubleStruckD]r, \[DoubleStruckD]θ, \
\[DoubleStruckD]ϕ}]

and I'm wondering if there's a simpler way to do it by, e.g., changing the canonical ordering of variables, or replacing variables with ones with the correct ordering and then freezing the order and then putting them back, or something.

Answer 1

You can add a wrapper that does what you need:

myForm /: MakeBoxes[myForm[e_], StandardForm] := With[{boxes = MakeBoxes[e]},
    ReplaceAll[
        boxes,
        RowBox[a:{_, "+"|"-", __}] /; !FreeQ[a, vars] :> RowBox[reorder[a]]
    ]
]

reorder[a_List] := Block[{old = a, new = a[[1 ;; -1 ;; 2]]},
    ord = Ordering @ Map[toOrder] @ new;
    old[[1 ;; -1 ;; 2]] = new[[ord]];
    old
]

toOrder[term_] := Cases[term, v:vars :> order[v], Infinity, 1]

vars = "\[DoubleStruckD]t"|"\[DoubleStruckD]r"|"\[DoubleStruckD]θ"|"\[DoubleStruckD]ϕ";

order["\[DoubleStruckD]t"] = 1;
order["\[DoubleStruckD]r"] = 2;
order["\[DoubleStruckD]θ"] = 3;
order["\[DoubleStruckD]ϕ"] = 4;

For your example:

x //myForm

You can either use $Post = myForm or you could add myForm to $OutputForms (as I did in the above image):

Unprotect[$OutputForms];
AppendTo[$OutputForms, myForm];
Protect[$OutputForms];

Another possibility is to use a wrapper for your variables. For example:

orderedV /: MakeBoxes[orderedV[_, v_], StandardForm] := MakeBoxes[v, StandardForm]

Using orderedV[1, \[DoubleStruckD]t] instead of \[DoubleStruckD]t will put \[DoubleStruckD]t first and similarly for the others:

x /. {\[DoubleStruckD]r->orderedV[2,\[DoubleStruckD]r],\[DoubleStruckD]t->orderedV[1,\[DoubleStruckD]t],\[DoubleStruckD]θ->orderedV[3,\[DoubleStruckD]θ],\[DoubleStruckD]ϕ->orderedV[4,\[DoubleStruckD]ϕ]}

Answer 2

A simple way to achieve this is by wrapping your expression as follows:

ClearAttributes[Plus, Orderless]
ClearAttributes[Times, Orderless]
x = -(1 - 2  G  M/r)  \[DoubleStruckD]t^2 + (1 - 
      2  G  M/r)^-1  \[DoubleStruckD]r^2 + 
  r^2  \[DoubleStruckD]\[Theta]^2 + 
  r^2  Sin[\[Theta]]^2  \[DoubleStruckD]\[Phi]^2
SetAttributes[Plus, Orderless]
SetAttributes[Times, Orderless]

The benefit of this approach is its intuitive ease: You can get MMA to order the terms however you want just by typing them that way. It does, however, come with a caution, which is easily addressed: It's critical to restore the Orderless Attributes to Plus and Times immediately afterwards, since leaving these out can alter basic functionality. For example, if I clear the Orderless Attribute from Plus, it no longer understands that addition is commutative, i.e., that a + b is mathematically identical to b + a.  Restoring the Attribute fixes this, even if a function was defined when the Attribute was absent.

For example:

ClearAttributes[Plus, Orderless]
a1=a+b;
a2=b+a;
a1==a2

a1==a2

SetAttributes[Plus, Orderless]
a1==a2

True