Expanding non-commutative terms

How can I expand the following equation with non-commutative terms:

eq = Sum[k1 (f[i + 1, j] - f[i, j]) ** (f[i + 1,
j] - f[i, j]), {i, 0, nx - 2}, {j, 0, ny - 1}] +
Sum[k2 (f[i, j + 1] -f[i, j]) ** (f[i,
j + 1] - f[i, j]), {i, 0, nx - 1}, {j, 0, ny - 2}];


where "f" is an undefined function and where nx and ny are positive nonzero integers greater than 1?

• With Distribute? – Roman May 16 '19 at 15:54
• Sadly, it doesn't work because it doesn't conserve the non-commutativity of the elements – Alex May 16 '19 at 16:06

You can transform the expression with explicit rules:

nx = 2;
ny = 2;
eq = Sum[k1 (f[i+1,j] - f[i,j]) ** (f[i+1,j] - f[i,j]), {i, 0, nx-2}, {j, 0, ny-1}] +
Sum[k2 (f[i,j+1] - f[i,j]) ** (f[i,j+1] - f[i,j]), {i, 0, nx-1}, {j, 0, ny-2}]


k2 (-f[0, 0] + f[0, 1]) ** (-f[0, 0] + f[0, 1]) + k1 (-f[0, 0] + f[1, 0]) ** (-f[0, 0] + f[1, 0]) + k1 (-f[0, 1] + f[1, 1]) ** (-f[0, 1] + f[1, 1]) + k2 (-f[1, 0] + f[1, 1]) ** (-f[1, 0] + f[1, 1])

eq //. {a_ ** (b_ + c_) -> a ** b + a ** c,
(a_ + b_) ** c_ -> a ** c + b ** c,
a_ ** (u_?NumericQ*b_) -> u (a ** b),
(u_?NumericQ*a_) ** b_ -> u (a ** b)}


k2 (f[0, 0] ** f[0, 0] - f[0, 0] ** f[0, 1] - f[0, 1] ** f[0, 0] + f[0, 1] ** f[0, 1]) + k1 (f[0, 0] ** f[0, 0] - f[0, 0] ** f[1, 0] - f[1, 0] ** f[0, 0] + f[1, 0] ** f[1, 0]) + k1 (f[0, 1] ** f[0, 1] - f[0, 1] ** f[1, 1] - f[1, 1] ** f[0, 1] + f[1, 1] ** f[1, 1]) + k2 (f[1, 0] ** f[1, 0] - f[1, 0] ** f[1, 1] - f[1, 1] ** f[1, 0] + f[1, 1] ** f[1, 1])

The _?NumericQ patterns are a bit dubious, as they will not match any other symbols (for example, they won't match x*f[0,0]). If you can guarantee that f is the only non-commutative symbol, then it may be better to replace _?NumericQ with _?(FreeQ[f]):

eq //. {a_ ** (b_ + c_) -> a ** b + a ** c,
(a_ + b_) ** c_ -> a ** c + b ** c,
a_ ** (u_?(FreeQ[f])*b_) -> u (a ** b),
(u_?(FreeQ[f])*a_) ** b_ -> u (a ** b)}


(same result)

From here on you can use the usual transformations:

Expand[%]


k1 f[0, 0] ** f[0, 0] + k2 f[0, 0] ** f[0, 0] - k2 f[0, 0] ** f[0, 1] - k1 f[0, 0] ** f[1, 0] - k2 f[0, 1] ** f[0, 0] + k1 f[0, 1] ** f[0, 1] + k2 f[0, 1] ** f[0, 1] - k1 f[0, 1] ** f[1, 1] - k1 f[1, 0] ** f[0, 0] + k1 f[1, 0] ** f[1, 0] + k2 f[1, 0] ** f[1, 0] - k2 f[1, 0] ** f[1, 1] - k1 f[1, 1] ** f[0, 1] - k2 f[1, 1] ** f[1, 0] + k1 f[1, 1] ** f[1, 1] + k2 f[1, 1] ** f[1, 1]

Alternatively you could install FeynCalc

and simply do

Needs["FeynCalc"]
nx = 2;
ny = 2;
eq =
Sum[k1 (f[i + 1, j] - f[i, j]).(f[i + 1, j] - f[i, j]), {i, 0,
nx - 2}, {j, 0, ny - 1}] +
Sum[k2 (f[i, j + 1] - f[i, j]).(f[i, j + 1] - f[i, j]), {i, 0,
nx - 1}, {j, 0, ny - 2}];
DeclareNonCommutative[f];
MakeBoxes[f[a_, b_], _] := SubscriptBox["f", RowBox[{a, b}]];
Collect2[DotSimplify[eq, DotPower -> True], {k1, k2}]


which gives

Another possibility is to use TensorProduct instead of NonCommutativeMultiply:

nx = 2;
ny = 2;
eq = Sum[k1 (f[i+1,j]-f[i,j])\[TensorProduct](f[i+1,j]-f[i,j]),{i,0,nx-2},{j,0,ny-1}] +
Sum[k2 (f[i,j+1]-f[i,j])\[TensorProduct](f[i,j+1]-f[i,j]),{i,0,nx-1},{j,0,ny-2}];


Then:

TensorExpand @ eq /. TensorProduct -> CircleTimes //TeXForm


$$\text{k1} f(0,0)\otimes f(0,0)-\text{k1} f(0,0)\otimes f(1,0)+\text{k1} f(0,1)\otimes f(0,1)-\text{k1} f(0,1)\otimes f(1,1)-\text{k1} f(1,0)\otimes f(0,0)+\text{k1} f(1,0)\otimes f(1,0)-\text{k1} f(1,1)\otimes f(0,1)+\text{k1} f(1,1)\otimes f(1,1)+\text{k2} f(0,0)\otimes f(0,0)-\text{k2} f(0,0)\otimes f(0,1)-\text{k2} f(0,1)\otimes f(0,0)+\text{k2} f(0,1)\otimes f(0,1)+\text{k2} f(1,0)\otimes f(1,0)-\text{k2} f(1,0)\otimes f(1,1)-\text{k2} f(1,1)\otimes f(1,0)+\text{k2} f(1,1)\otimes f(1,1)$$

where I subsituted CircleTimes for TensorProduct` for readability.