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

Question

在一些非常友好的stackoverflow贡献者in this post的帮助下，我在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和(-q)'s放在前面。我已经尝试使用ReplaceRepeated (\\.)来处理这里提到的两个问题，但到目前为止还没有成功。

欢迎所有的想法，谢谢……

Answer 1

这样做的关键是要认识到Mathematica将a-b表示为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只能识别明显为整数的内容。它甚至不会在像Assuming[{Element[q, Integers]}, a**q**b]这样的结构中发现q是一个整数。

为了实现这一点，您需要检查假设，这一过程可能太昂贵，无法放入全局转换表中。相反，我将编写一个可以手动应用的转换函数(并可能从全局表中删除当前规则)。像这样的东西可能会起作用：

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]] 

返回-q c**c。

HTH

Answer 2

这只是一个快速的回答，重复了上一个问题的一些评论。您可以删除一些定义，并使用作用于Times[i,c]的规则来解决此问题的所有部分，其中i是可交换的，而c具有缺省值Sequence[]

Unprotect[NonCommutativeMultiply];
ClearAll[NonCommutativeMultiply]
NonCommutativeMultiply[] := 1
NonCommutativeMultiply[a___, (i:(_Integer|q))(c_:Sequence[]), b___] := i a**Switch[c, 1, Unevaluated[Sequence[]], _, c]**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];

然后，这将按预期工作。

In[]:= a**b**q**(-c)**3**(2 a)**q
Out[]= -6 q^2 a**b**c**a

请注意，您可以泛化(_Integer|q)以处理更一般的可交换对象。