Mathematica: subscript simplification under noncommutative multiplication

Using Subscript[variable, integer] in Mathematica 7.0+, I have expressions of the following form:

a_-4 ** b_1 ** a_-4 ** b_-4 ** a_1 ** c_-4 ** c_1 ** c_5

I would like to simplify this expression.

Rules:

* Variables with the same subscript to don't commute,

* variables with different subscripts do commute.

I need a way to simplify the expression and combine like terms (if possi开发者_StackOverflow中文版ble); the output should be something like:

(a_-4)^2 ** b_-4 ** c_-4 ** b_1 ** a_1 ** c_1 ** c_5

The most important thing I need is to order the terms in the expression by subscripts while preserving the rules about what commutes and what does not. The second thing (I would like) to do is to combine like terms once the order is correct. I need to at least order expressions like above in the following way:

a_-4 ** a_-4 ** b_-4 ** c_-4 ** b_1 ** a_1 ** c_1 ** c_5,

that is, commute variables with different subscripts while preserving the non-communicative nature of variables with the same subscripts.

All ideas are welcome, thanks.

I cited a library notebook the other day for a related question.

http://library.wolfram.com/infocenter/Conferences/325/

How to expand the arithematics of differential operators in mathematica

I'll crib some relevant code. I first mention (again) that I'm going to define and work with my own noncommutative operator, to avoid pattern matching headaches from built-in NonCommutativeMultiply. Also I will use a[...] instead of Subscript[a,...] for ease of ascii notation and cut-paste of Mathematica input/output.

We will classify certain "basic" entities as scalars or variables, the latter being the things that have commutation restrictions. I am not taking this nearly as far as one might go, and am only defining scalars to be fairly obvious "non-variables".

variableQ[x_] := MemberQ[{a, b, c, d}, Head[x]]
scalarQ[x_?NumericQ] := True
scalarQ[x_[a_]^n_. /; !variableQ[x[a]]] := True
scalarQ[_] := False

ncTimes[] := 1
ncTimes[a_] := a
ncTimes[a___, ncTimes[b___, c___], d___] := ncTimes[a, b, c, d]
ncTimes[a___, x_ + y_, b___] := ncTimes[a, x, b] + ncTimes[a, y, b]
ncTimes[a___, n_?scalarQ*c_, b___] := n*ncTimes[a, c, b]
ncTimes[a___, n_?scalarQ, b___] := n*ncTimes[a, b]
ncTimes[a___, x_[i_Integer]^m_., x_[i_]^n_., b___] /; 
  variableQ[x[i]] := ncTimes[a, x[i]^(m + n), b]
ncTimes[a___, x_[i_Integer]^m_., y_[j_Integer]^n_., b___] /; 
  variableQ[x[i]] && ! OrderedQ[{x, y}] := (* !!! *)
    ncTimes[a, y[j]^n, x[i]^m, b]

I'll use your input form only slightly modified, so we'll convert ** expressions to use ncTimes instead.

Unprotect[NonCommutativeMultiply];
NonCommutativeMultiply[a___] := ncTimes[a]

Here is your example.

In[124]:= 
    a[-4] ** b[1] ** a[-4] ** b[-4] ** a[1] ** c[-4] ** c[1] ** c[5]

Out[124]= ncTimes[a[-4]^2, a[1], b[1], b[-4], c[-4], c[1], c[5]]

An advantage to this seemingly laborious method is you can readily define commutators. For example, we already have (implicitly) applied this one in formulating the rules above.

commutator[x_[a_], y_[b_]] /; x =!= y || !VariableQ[x[a] := 0

In general if you have commutator rules such as

ncTimes[a[j],a[i]] == ncTimes[a[i],a[i]]+(j-i)*a[i]

whenever j > i, then you could canonicalize, say by putting a[i] before a[j] in all expressions. For this you would need to modify the rule marked (!!!) to account for such commutators.

I should add that I have not in any sense fully tested the above code.

Daniel Lichtblau Wolfram Research

Is this the type of thing you are looking for

These types of rules can be generalised (e.g. add commutation rules for noncommuting objects, make it handle nonnumeric indices, etc...) and packaged up into a NCMSort routine. You can also optimize it by doing the sorting in a single pass by defining a unique NCMOrder function, e.g.

NCMSort[expr_] := expr /. a_NonCommutativeMultiply :> a[[NCMOrder[a]]]

An aside: I used such a process in generating the results of arXiv:1009.3298 -- the notebook will be distributed with the (soon to be released) longer paper.

You can do what you want using NCAlgebra. In the case of your example:

<< NC`
<< NCAlgebra`
expr = Subscript[a, -4] ** Subscript[b, 1] ** Subscript[a, -4] ** Subscript[b, -4] ** Subscript[a, 1] ** Subscript[c, -4] ** Subscript[c, 1] ** Subscript[c, 5]
rule = {(Subscript[x_, i_] ** Subscript[y_, j_] /; i > j) -> Subscript[y, j] ** Subscript[x, i]}NCReplaceRepeated[expr, rule]
NCReplaceRepeated[expr, rule]

produces

Subscript[a, -4] ** Subscript[a, -4] ** Subscript[b, -4] ** Subscript[c, -4] ** Subscript[b, 1] ** Subscript[a, 1] ** Subscript[c, 1] ** Subscript[c, 5]

It does not look so nice here but Subscripts will render nicely on a Notebook.