Make Times non-commutative only for a specific set of expressions

I'm making a small hacky notebook and want to avoid using external libraries. In my notebook, I'd like multiplication to be non-commutative only for a particular family of expressions whilst still using Times (not NonCommutativeMultiply).

The expressions have the form Subscript[symb_Symbol, _Integer] where symb is a member of (e.g.) [A, B, C]. There are few symbols, so I'm happy to hardcode rules.

I'd like, for example

Times[Subscript[B, 2], Subscript[A, 1]]

to be unchanged, rather than have the order of the terms automatically commuted.

I've seen this solution where Times of a particular Head matrix is made non-commutative, and I've seen how NCAlgebra does it, but I can't manage to adapt either for my purposes.

I'd actually prefer to substitute Times for Dot when it contains one of these expressions. I know I can define a function with the HoldAll attribute and replace Times to Dot before Mathematica commutes the expression, but I'd like this behaviour everywhere, not just in the function argument.

In affect, this would give behaviour like (for special symbols A, B, C):

$B_2 A_2 + G F E$ would evaluate to $B_2 . A_2 + E F G$

Is this possible without immense complication?

• I'm thinking this is either not possible and not recommended. – QuantumDot Jul 4 '18 at 23:47
• As a workaround try this: ClearAttributes[Times, Orderless]; Times[x___, Subscript[a_, n_], y___] ^:= Dot[x, Subscript[a, n], y]. It will use Dot instead of Times every time a Subscript appears inside Times. It's necessary to clear Orderless attribute in order to preserve the order of arguments though. – roman465 Jul 5 '18 at 2:43
• @QuantumDot All the interesting things are :) – Anti Earth Jul 5 '18 at 10:01
• Why do you insist on using Times? Mathematica tends to be unpredictable sometimes. Based on past experience, I would not dare mess with such a fundamental built-in as Times. – Szabolcs Jul 5 '18 at 10:37
• Did any of the answers satisfied your need? There are things to do after your question is answered. It's a good idea to stay vigilant for some time, better approaches may come later improving over previous replies. Experienced users may point alternatives, caveats or limitations. New users should test answers before voting and wait 24 hours before accepting the best one. One weeks is enough wait. Participation is essential for the site, please do your part. – rhermans Jul 11 '18 at 18:25

You can perhaps get what you want by using $Pre:$Pre =
Function[{arg},
ReleaseHold[
Hold[arg] //.
Times[α___,
patt : (Longest[
Subscript[_Symbol, _Integer] ..]), ω___] :>
Times[α, Dot[patt], ω]], HoldAll];

x y + a c Subscript[B, 2] Subscript[A, 1] b

(* ==> x y + a b c Subscript[B, 2].Subscript[A, 1] *)

a b Subscript[A, 10] Subscript[B, 2] Subscript[A, 1] c

(* ==> a b c Subscript[A, 10].Subscript[B, 2].Subscript[A, 1] *)

The replacement rule also merges dot products that are interspersed with commutative multiplications:

a c Subscript[B, 2] Subscript[A, 1] b Subscript[B, 3] Subscript[A, 4]

(*
==> a b c Subscript[B, 2].Subscript[A, 1].Subscript[B, 3].Subscript[A, 4]
*)
• This is brilliant :) Can I expect any adverse side effects? – Anti Earth Jul 5 '18 at 10:03
• This is the least invasive way I could think of. And in principle you could make the pattern more restrictive if there are other subscripted objects that need to be treated differently. So I'd say any side effects should be manageable if your notebook has a well-defined scope. – Jens Jul 5 '18 at 14:23
ClearAll[times]
times[a___, Longest@PatternSequence[b_Subscript, c___, d_Subscript], e___] :=
Times[a, e, ## & @@ Cases[{b, c, d}, Except[_Subscript], 1] ,
Dot @@ Cases[{b, c, d}, _Subscript, 1]]
times[a___]:= Times[a]

Examples:

times[a, b, Subscript[B, 3], y, Subscript[C, 3], w, z, Subscript[A, 2], 2, t]

2 a b t w y z Subscript[B, 3].Subscript[C, 3].Subscript[A, 2]

Inactivate[Times[Subscript[B, 2], Subscript[A, 1], J] + F G H, Times] /.
Times -> times // Activate // TeXForm

$J B_2.A_1+F G H$

For version 9 and earlier versions

Hold[Times[Subscript[B, 2], Subscript[A, 1], J] + F G H] /. Times -> times //
ReleaseHold // TeXForm

$J B_2.A_1+F G H$

Stealing from Jens's great idea, wee can also use times to specify $Pre:$Pre = Function[{arg}, Activate[Inactivate[arg, Times] /. Times -> times], HoldAll];(*or*)
\$Pre = Function[{arg}, ReleaseHold[Hold[arg] /. Times -> times],  HoldAll];