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

Question

在一些非常友善的 stackoverflow 贡献者这篇文章的帮助下，我有了以下新内容Mathematica 中 NonCommutativeMultiply (**) 的定义：

取消保护[非交换乘法]；
ClearAll[非交换乘法]
非对易乘法[] := 1
非对易乘法[___, 0, ___] := 0
NonCommutativeMultiply[a___, 1, b___] := a ** b
NonCommutativeMultiply[a___, i_Integer, b___] := i*a ** b
非交换乘法[a_] := a
c___ ** 下标[a_, i_] ** 下标[b_, j_] ** d___ /;我> j :=
c ** 下标[b, j] ** 下标[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 将 ab 表示为 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 显式查询假设，您可以通过分配给 $Asminations 进行全局设置，也可以使用 Assuming< 进行本地设置/code>：

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

返回-qc**c。

华泰

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) 以处理更通用的可交换对象。