各位好，最近我需要计算一串fermion的收缩，手算着实麻烦且机械，故拜访贵吧想来请教如何用mathematica来实现自动化的计算。大佬们如果有空可以把它当作是一道趣味思考题，在下先谢过各位。
抛开具体的物理内容，Wick收缩对应的实际操作是：
任意给一串字符串 a1,a2,a3,a4,...an
对它的”Wick收缩“操作即是：
输出全部可能的，所有字符两两带权相并后的乘积。而权重的定义为：
“当ai和aj相并的时候，设ai和aj中间隔了k个字符，那么并起来之后需要乘上数“(-1)^k”,”
下面是一个简单的例子。
-------------------------------------------------------------------
考虑字符串 {a1,a2,a3,a4} 的wick收缩，
因为所有字符两两相并一共只有3种可能（分别是12并x34并，13并x24并，14并x23并）
但是如同定义所说的那样，这里的相并还需要带上权重。那么对于{a1,a2,a3,a4} 的wick收缩，实际结果就是：
“<a1a2>x<a3a4> - <a1a3>x<a2a4> + <a1a4>x<a2a3>”（这里"<>"用来标记相并）
这里<a1a3>*<a2a4>前面的负号就来自于a1和a3相并的时候跨越了1个a2，所以出来了一个-1。
PS：（a1a3并完之后剩下{a2,a4}，则按照定义a2,a4相并就无负号了）
-------------------------------------------------------------------
我想向各位请教，请问我该如何使用MMA的代码来实现这样的操作呢？

先写了个简单的示意，由于不知道相并的意思，所以抽象成函数f，不知道奇数个元素怎么处理，所以只测试了两个偶数个元素的例子
代码：
wick[{}]=1;
wick[list_]:=Total[((-1)^
#*f[list[[1]],list[[#
]]]*wick@Join[list[[2;;
#-1]],list[[#
+1;;-1]]])&/@Range[2,Length@list]]

回复 @hjq447285628 ，您好
1) “相并”如其字面意思即是两个字符组合在一起，相并后我们把这个整体看成是一个复数，（有点像线性空间里面定义内积的感觉）即字符a1与字符a2相并，变成<a1a2>，<a1a2>是一个复数。所以x就是普通乘法，即 <a1a2>x<a3a4>就是两个复数相乘，满足乘法交换律。（PS：抱歉还有一点我没说，<a1a2> = - <a2a1>，但是感觉这条性质可能用不上）
-----------------------------------------------------------------------------------------
2) 抱歉是我没说清楚，由于wick收缩是考虑字符串中元素的两两相并，所以字符串中元素的个数只考虑偶数个。
我希望最后能够用MMA定义出一个收缩函数wick[]，使得
我们在输入2个字符的时候：
wick[a1,a2] = <a1,a2>,
4个字符的时候：
wick[a1,a2,a3,a4] = <a1a2>·<a3a4> + (-1)· <a1a3>·<a2a4> + <a1a4>·<a2a3>,
6个字符的时候：
wick[a1, a2, a3, a4, a5, a6]
= <a1a2>·（<a3a4>·<a5a6> + (-1)· <a3a5>·<a4a6> + <a3a6>·<a4a5>）
+ (-1)·<a1a3>·（<a2a4>·<a5a6> + (-1)· <a2a5>·<a4a6> + <a2a6>·<a4a5>）
+ <a1a4>·（<a2a3>·<a5a6> + (-1)· <a2a5>·<a3a6> + <a2a6>·<a3a5>）
+ (-1)·<a1a5>·（<a2a3>·<a4a6> + (-1)· <a2a4>·<a3a6> + <a2a6>·<a3a4>）
+ <a1a6>·（<a2a3>·<a4a5> + (-1)· <a2a4>·<a3a5> + <a2a5>·<a3a4>）
PS（6个字符一共结果15项，写的答案思路是相并掉两个之后就是4个字符，于是可以套用4个字符的结果）
-------------------------------------------------------------------------------------
如果再用通俗的话来翻译这个过程就是：我们要把有2n个字符的字符串用wick函数映射成一系列复数的和，而具体过程就是通过元素间的两两的收缩（即相并，后面我就用"收缩"代替"相并"，业内称作“收缩”），每一次收缩，字符串中就会减少两个字符，产生出一个复数<aiaj>，收缩n次后，就把字符串变成了n个复数，然后我们把复数全部乘起来得到一个子结果。但是收缩有规则，将两个元素收缩掉时必须确保它们处在相邻位置，，比如如果当
前排
列是{a1，a2，a3，a4},我要收缩两次来产生<a1a3>·<a2a4>的一个子结果，就必须把a3挪到与a1相邻，而这会使得a3与a2交换一次位置，交换位置会让收缩结果最终差一个正负号(即加权的意思)，而其规则为：假设设将aiaj收缩成<aiaj>需要让aj与其他元素交换k次，那么最终实际产生的复数为 <aiaj>·(-1)^k. 最后我们再把所有可能的子结果累加，即得到了最终答案。
按照这个规则，可以看出wick[] 4个、6个字符为啥是那样的结果。

@hjq447285628

@贴吧用户_0Q3a2KZ，再次感谢您的劳动、耐心以及您的分享，6个fermion的收缩结果是对的，代码应该是没问题

主要用Permutations、Partition和Signature应该就行了

一个写法：
Times@@h@@@
#*Signature@Catenate@#
&/@(Sort/@Partition[#,2]& /@ Permutations@Array[a,6]) //Total@*DeleteDuplicates
我注意到：那个正负符号并不是严格的Signature@list而是Signature@Catenate[Sort/@Partition[list,2]]，也就是说的orderless属性优先于置换奇偶性的判定，正负符号上{a1,a2,a3,a4}和{a2,a1,a3,a4}也不会有差别。按这种理解应该还能有基于Orderless属性的更简洁的写法

再给你写一条让输出好看一点的指令
h /: MakeBoxes[h[a[m_],a[n_]], form_] := ToBoxes[StringTemplate["\[LeftAngleBracket]``,``\[RightAngleBracket]"][m,n], form]
关于这种做法，这里有一篇详细些的文章：
https://gitee.com/asdasd1dsadsa/ZhiHu-asdasd1dsadsa/blob/master/Answer/Mathematica%E5%81%9A%E7%90%86%E8%AE%BA%E6%8E%A8%E5%AF%BC%E6%9C%89%E5%93%AA%E4%BA%9B%E5%A5%BD%E7%94%A8%E7%9A%84%E6%8A%80%E5%B7%A7%EF%BC%9F.md