# Creating 28$\times$28 matrix whose entries are Levi Civita tensors

I would like to create a particular 28$\times$ 28 matrix whose entries are given by

$$X_{[ij][kl]} = \delta^{[ij][kl]}_{1234} + \delta^{[ij][kl]}_{5678}$$

where $\delta^{ijkl}_{abcd} = \begin{cases} +1 & \text{if$ijkl$is an even permutation of$abcd$}\\ -1 & \text{if$ijkl$is an odd permutation of$abcd$} \\0 & \text{otherwise}\end{cases}$

1. The entries of $X$ are labeled by antisymmetric pairs $[ij]$ where $i,j$ (individually) run from 1 to 8, but when they are combined in antisymmetric pairs, there are 28 combinations (here organised into 7 blocks, each 4$\times$ 4): (12, 34, 56, 78); (13, 24, 57, 68); (14, 23, 58, 67); (15, 26, 37, 48); (16, 25, 38, 47); (17, 28, 35, 46); (18, 27, 36, 45)
2. So basically, X is of block-diagonal form, with 7 blocks with entries labeled as above. So to calculate the entries, one uses 4-dimensional Levi-civita tensors for each entry. The only way I know to create this 28$\times$28 matrix would be to enter each entry individually using the Signature[{i,j,k,l}] function. This would repeat for the rest of the 6 remaining diagonal blocks (all entries corresponding to elements of different blocks vanish), and it is rather tedious.

So I'd be very grateful if someone could come up with a smart way to do this ?

Is this what you are looking for?

n = 8;
idx = Flatten[Table[{i, j}, {i, 1, n}, {j, i + 1, n}], 1];
list1 = Range[1, 4];
list2 = Range[5, 8];

A = Table[
With[
{c = Join[a, b]},
With[
{d = Sort[c]},
Signature[c] (Boole[d == list1] + Boole[d == list2])
]
],
{a, idx}, {b, idx}];

• Thank you for your code ! I am trying to understand it and check to see what modifications are needed if I have to generate the following 28$\times$28 matrices: $X^{[ij][kl]}_2 = \delta^{[ij][kl]}_{1256} + \delta^{[ij][kl]}_{3478}$, $X^{[ij][kl]}_3= \delta^{[ij][kl]}_{1458} + \delta^{[ij][kl]}_{2367}$ – user195583 Jun 6 '18 at 6:43
• For the first new case, you simply have to replace list1 and list2 by {1,2,5,6} and {3,4,7,8}, respectively. – Henrik Schumacher Jun 6 '18 at 6:50
• I re-ran the code on my home laptop, which only has Mathematica 8, I got the following error messages: With::argrx: With called with 3 arguments; 2 arguments are expected. >>General::stop: Further output of With::argrx will be suppressed during this calculation. >>. This code worked fine on my work laptop with Mathematica 11, so perhaps these are due to Mathematica 8? – user195583 Jun 6 '18 at 10:07
• The multi-argument version of With was only introduced recently and isn't documented. I shouldn't have used it. I removed it from the post. Please try again. – Henrik Schumacher Jun 6 '18 at 10:08
• It works on Mathematica 8 now ! Thanks so much ! I'd like to confirm that the label for the entries follow your defined idx, they're increasing from 12, 13, 14, ...., 67, 68, 78, right? There is no way to re-organize those into the block diagonal form of the 7 blocks listed in my question? I ask this because I have another nasty 28$\times$ 28 matrix that I have to generate, which is a sum of 7 terms: $Y = \delta_{1234} + \delta_{1256} + \delta_{1278} + \delta_{1375} + \delta_{1368} + \delta_{1458} + \delta_{1467}$, and this Y matrix will probably look neat in the block diagonal form. – user195583 Jun 6 '18 at 10:34

If you have M9+, you could use SymmetrizedArray to create an $8 \times 8 \times 8\times8$ dimensional array with the desired symmetry:

X = SymmetrizedArray[
{{1,2,3,4}->1, {5,6,7,8}->1},
{8,8,8,8},
Antisymmetric[{1,2,3,4}]
];


To convert this to a $28\times28$ matrix, you would group the first 2 and last 2 dimensions:

Y = Flatten[X, {{1,2}, {3,4}}];


and then extract the upper right indices:

upperRight = Pick[
Range[64],
Flatten @ LowerTriangularize[ConstantArray[1, {8,8}]],
0
]


{2, 3, 4, 5, 6, 7, 8, 11, 12, 13, 14, 15, 16, 20, 21, 22, 23, 24, 29, 30, 31, 32, 38, 39, 40, 47, 48, 56}

to arrive at:

Z = Y[[upperRight, upperRight]];


This is the same as @Henrik's answer:

A == Z


True

• Thank you for your answer. I copied and pasted your code into my Mathematica 8 on my home laptop, and I got the following outputs and error messages: Flatten::fldep: "Level 2 specified in {{1,2},{3,4}} exceeds the levels, 1, which can be flattened together in SymmetrizedArray[{{1,2,3,4}->1,{5,6,7,8}->1},{8,8,8,8},Antisymmetric[{1,2,3,4}]]." I suspect that it is a problem with Mathematica 8, because the same code from Henrik that worked on Mathematica 11 (on my work laptop) ceased to work on Mathematica 8 (on my home laptop) – user195583 Jun 6 '18 at 10:03
• Thanks. I should run this code again on my work laptop with M11. – user195583 Jun 7 '18 at 4:09