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?
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.
Distribute? $\endgroup$