Mathematica 表达式开头的非交换乘法和负系数

在一些非常友善的 stackoverflow 贡献者的帮助下在这篇文章中 https://stackoverflow.com/questions/5023863/redefine-noncommutative-multiplication-in-mathematica，我有以下新定义NonCommutativeMultiply (**)在数学中：

Unprotect[NonCommutativeMultiply];
ClearAll[NonCommutativeMultiply]
NonCommutativeMultiply[] := 1
NonCommutativeMultiply[___, 0, ___] := 0
NonCommutativeMultiply[a___, 1, b___] := a ** b
NonCommutativeMultiply[a___, i_Integer, b___] := i*a ** b
NonCommutativeMultiply[a_] := a
c___ ** Subscript[a_, i_] ** Subscript[b_, j_] ** d___ /; i > j :=
c ** Subscript[b, j] ** Subscript[a, i] ** d
SetAttributes[NonCommutativeMultiply, {OneIdentity, Flat}]
Protect[NonCommutativeMultiply];

这种乘法很棒，但是它不处理表达式开头的负值，即
a**b**c + (-q)**c**a
应该简化为
a**b**c - q**c**a
但它不会。

在我的乘法中，变量q（以及任何整数定标器）是可交换的；我还在尝试写一个SetCommutative功能，但没有成功。我并不急需SetCommutative，那就太好了。

如果我能够拉出所有的内容也会很有帮助q's到每个表达式的开头，即：
a**b**c + a**b**q**c**a
应简化为：
a**b**c + q**a**b**c**a
同样，结合这两个问题：
a**b**c + a**c**(-q)**b
应简化为：
a**b**c - q**a**c**b

目前，我想弄清楚如何在表达式开头处理这些负变量以及如何拉取q's and (-q)'s如上所述。我尝试使用以下方法来解决这里提到的两个问题ReplaceRepeated (\\.)，但到目前为止我还没有成功。

欢迎所有想法，谢谢...

做到这一点的关键是要认识到 Mathematica 代表a-b as a+((-1)*b)，正如你可以看到的

In[1]= FullForm[a-b]
Out[2]= Plus[a,Times[-1,b]]

对于问题的第一部分，您所要做的就是添加以下规则：

NonCommutativeMultiply[Times[-1, a_], b__] := - a ** b

或者你甚至可以从任何位置捕捉标志：

NonCommutativeMultiply[a___, Times[-1, b_], c___] := - a ** b ** c

更新——第 2 部分。将标量置于前面的一般问题是模式_Integer在你当前的规则中只会发现明显是整数的东西。它甚至不会发现这一点q是一个像这样的结构中的整数Assuming[{Element[q, Integers]}, a**q**b].
为了实现这一点，您需要检查假设，将这个过程放入全局转换表中可能会非常昂贵。相反，我会编写一个可以手动应用的转换函数（并且可能从全局表中删除当前规则）。像这样的事情可能会起作用：

NCMScalarReduce[e_] := e //.  {
    NonCommutativeMultiply[a___, i_ /; Simplify@Element[i, Reals],b___] 
    :> i a ** b
}

上面使用的规则使用Simplify显式查询假设，您可以通过分配给全局设置$Assumptions或在本地使用Assuming:

Assuming[{q \[Element] Reals},
  NCMScalarReduce[c ** (-q) ** c]] 

returns -q c**c.

HTH