# Implementing a Schouten identity

So I have an identity which looks like this:

$\langle ij \rangle\langle kl \rangle + \langle ik \rangle\langle lj \rangle = \langle il \rangle\langle kj \rangle$

In mathematica I implement the angle bracket like this: $\langle ij \rangle =$ ang[i,j].

Then I can implement the identity like this to reduce two terms to one:

ang[i_,j_] ang[k_,l_] + ang[i_,k_] ang[l_,j_] :>  ang[i,l]ang[k,j]


This works fine for some cases.

The bracket is anti-symmetric, ie. ang[i,j] = - ang[j,i]. Hence I also have an identity that

$-\langle ji \rangle\langle kl \rangle + \langle ik \rangle\langle lj \rangle = \langle il \rangle\langle kj \rangle$

and that

$\langle ji \rangle\langle lk \rangle + \langle ik \rangle\langle lj \rangle = \langle il \rangle\langle kj \rangle$

etc.

Does anyone know of a neat way to package up and catch all possibilities given the antisymmetry?

Thanks

If you're doing calculations using spinor-helicity formalism in Mathematica, you may find S@M package, and my extension Spinors Extras, useful.

Among other things S@M implements asymmetry of spinor products (angle ones are denoted by Spaa[i, j]) by automatically converting all products to canonical order.

Rule simplifying general expanded polynomial in two-element spinor chains can look like this:

Needs@"SpinorsExtras"

schoutenRule = HoldPattern[
(x : _. (sp1 : (sp : Spaa|Spbb)[i_, j_])^_. (sp2 : sp_[k_, l_])^_.) +
(y :
_. ((sp3 : sp_[i_, k_]) | (sp4 : sp_[k_, i_]))^_. ((sp5 : sp_[l_, j_]) | (sp6 : sp_[j_, l_]))^_. |
_. ((sp7 : sp_[i_, l_]) | (sp8 : sp_[l_, i_]))^_. ((sp9 : sp_[j_, k_]) | (sp10 : sp_[k_, j_]))^_.
)
] :>
With[{c = x / (sp1 sp2), ySp = (-1)^(Length@HoldComplete[sp4, sp6, sp8, sp10]) sp3 sp4 sp5 sp6 sp7 sp8 sp9 sp10},
-c sp[i, k] sp[l, j] sp[i, l] sp[j, k] / ySp /; y == c ySp
];


DeclareSpinor[i, j, k, l, m]
(* {i,j,k,l,m} added to the list of spinors *)


We can verify Schouten identity:

Spaa[i, j] Spaa[k, l] + Spaa[i, k] Spaa[l, j] + Spaa[i, l] Spaa[j, k]
% /. schoutenRule
(* <i|l> <j|k> - <i|k> <j|l> + <i|j> <k|l> *)
(* 0 *)


With canonical ordering all expressions from OP automatically evaluate to same expression, which can be simplified using our schoutenRule:

Spaa[i, j] Spaa[k, l] + Spaa[i, k] Spaa[l, j]
-Spaa[j, i] Spaa[k, l] + Spaa[i, k] Spaa[l, j]
Spaa[j, i] Spaa[l, k] + Spaa[i, k] Spaa[l, j]
% /. schoutenRule
(* -<i|k><j|l> + <i|j><k|l> *)
(* -<i|k><j|l> + <i|j><k|l> *)
(* -<i|k><j|l> + <i|j><k|l> *)
(* -<i|l><j|k> *)


Similarly for other combinations:

Spaa[i, j] Spaa[k, l] + Spaa[i, l] Spaa[j, k]
-Spaa[j, i] Spaa[k, l] + Spaa[i, l] Spaa[j, k]
Spaa[j, i] Spaa[l, k] + Spaa[i, l] Spaa[j, k]
% /. schoutenRule
(* <i|l><j|k> + <i|j><k|l> *)
(* <i|l><j|k> + <i|j><k|l> *)
(* <i|l><j|k> + <i|j><k|l> *)
(* <i|k><j|l> *)

Spaa[i, k] Spaa[l, j] + Spaa[i, l] Spaa[j, k]
-Spaa[k, i] Spaa[l, j] + Spaa[i, l] Spaa[j, k]
Spaa[k, i] Spaa[j, l] + Spaa[i, l] Spaa[j, k]
% /. schoutenRule
(* <i|l><j|k> - <i|k><j|l> *)
(* <i|l><j|k> - <i|k><j|l> *)
(* <i|l><j|k> - <i|k><j|l> *)
(* -<i|j><k|l> *)


More complicated expressions:

Spaa[i, m] Spaa[j, m] Spaa[k, l] + Spaa[i, m] Spaa[j, k] Spaa[l, m] + Spaa[i, j] Spaa[k, m] Spaa[l, m]
% //. schoutenRule
(* <i|m> <j|m> <k|l> + <i|m> <j|k> <l|m> + <i|j> <k|m> <l|m> *)
(* <i|l> <j|m> <k|m> *)

c Spaa[i, j]^2 Spaa[k, l]^5 Spaa[i, k] + c Spaa[i, j] Spaa[i, k]^2 Spaa[l, j] Spaa[k, l]^4
% /. schoutenRule
(* -c <i|j> <i|k>^2 <j|l> <k|l>^4 + c <i|j>^2 <i|k> <k|l>^5 *)
(* -c <i|j> <i|k> <i|l> <j|k> <k|l>^4 *)

• This is really nice, thank you – Joe Jul 30 '18 at 22:56
• OK, so firstly I have to tell it to antisymmetrise the brackets inside the /;x/y == (sp[i, j] sp[k, l])/(sp[i, k] sp[l, j]) part otherwise it doesn't work. And secondly, when I run -Spaa[2, 4] Spaa[3, 1] + Spaa[2, 3] Spaa[4, 1] /. schoutenRule it simplifies fine, but when I run -Spaa[2, 4] Spaa[1, 3] + Spaa[2, 3] Spaa[1, 4] /. schoutenRule it doesn't work. This is strange to me, as I read the code I understand that this second case should work – Joe Jul 31 '18 at 0:29
• @Joe I've added remaining pairings to schoutenRule, it should work now. – jkuczm Jul 31 '18 at 15:55

I would implement the antisymmetry by giving this definition to the function ang:

ang[x_,y_]/;!OrderedQ[{x, y}] := -ang[y, x];
ang[x_,x_]:=0;


you can even specify an ordering that you like and replace the function OrderedQ with another function defined by you.

I propose instead two ways for implementing the Schouten identities. The hard part of these identities is that it is not obvious to choose a minimal set of expressions that can be used to generate all others. If we choose a set that is too big, we risk of creating infinite loops when applying the rule repeatedly; if we do the opposite mistake we might end up with final expressions that are not fully simplified.

A possible criterion to decide whether a term stays or gets replaced is that its labels are ordered (according to the same ordering used for the function ang in order to make things simpler). Thus one can define the rule

SchoutenRule = ang[i_, j_] ang[k_, l_] /;OrderedQ[{i, j, k, l}] :>
-ang[i, k] ang[l, j] + ang[i, l] ang[k, j];


If powers appear in an expression we can deal with them as follows:

SchoutenRuleFinal = Join[{ang[i_, j_]^p_. ang[k_, l_]^q_. :>
ang[i, j]^(p - 1) ang[k, l]^(q - 1)
(ang[i, j] ang[k, l] /.SchoutenRule)}, SchoutenRule]


This rule obviously needs to be applied with replace repeated //. in order to work in all cases.

The method explained above performs well on generic expressions, where we expect all possible linear combinations of terms to appear. In less generic expression we can achieve a bigger simplification if we choose smarter sets of variables to solve for. The function Solve gives us precisely this freedom. Let's say you have an expression expr with a bunch of ang[x,y] products. you can then generate all identities as follows

CenterDot[x___, a_Integer ang[b__], y___] := a CenterDot[x, ang[b], y];
allLabels = Union[Cases[expr /. ang[x__] ang[y__] :> labels[x, y], labels[__],Infinity]];

allIdentities = Table[
(CenterDot[ang[#1, #2],ang[#3, #4]] +
CenterDot[ang[#1, #3],ang[#4, #2]] ==
CenterDot[ang[#1, #4],ang[#3, #2]]) & @@ subset,
{subset, allLabels}];


I defined CenterDot (any other Head would be fine) to make the monomials unsplittable. We will then use Solve as follows

SchoutenRule=First@Solve[allIdentities,
Cases[expr/.ang[x__]ang[y__]:>CenterDot[ang[x],ang[y]],
CenterDot[__], Infinity]
] /.CenterDot -> Times;


This is guaranteed to be a complete, loop-free, list of rules. We only need to deal with powers which may be done as before. The drawback is the fact that Solve might get slow if there are too many possbile labels. Again, this might simplify things only if, say,

$$\langle i j \rangle \langle k l \rangle + \langle i k \rangle \langle l j\rangle$$

appears with this precise relative coefficient in the whole expression. Then it's clearly convenient to have one of them in the left hand side of the rules rather than having $$\langle i l \rangle \langle k j \rangle$$. In all other cases the first option is to be preferred.

• This looks pretty interesting thanks, I'll come back to it next time I'm working with these type of expression. I generally don't use the antisymmetrisation as you've defined it, because in this case it's difficult to keep hold of how many times the ordering gets evaluated. So if I instead define an Antisymmetrise function that does what you describe for specified heads in a given expression, it's only evaluated when I ask it to be. – Joe Dec 13 '18 at 21:09
• - "So if I instead define an Antisymmetrise function that does what you describe for specified heads in a given expression, it's only evaluated when I ask it to be". Yes, I agree, that's smart. Alternatively you can even implement the antisymmetrization in the replacement rules. You use terms like ang[a:OrderlessPatternSequence[x_,y_]]  where x_ and y_ are reordered by Mathematica in an effort to match the pattern and a` knows what was the original ordering. – MannyC Dec 14 '18 at 0:09