Optimizing a rank 3 tensor

Question

Assume we have the following elements \begin{equation} F_i{}^j \;and\; S_{ij}{}^k, \end{equation} which represent the components of tensorial objects of ranks 2 and 3 respectively, with Complex coefficients.

Let the components of $F$ be given by

$F_1{}^j$ = \begin{matrix} 0 \\ -x-iy \\ -i(-1+x^2+2ixy-y^2+z^2)/2z \\ (1-x^2-2ixy+y^2+z^2)/2z \end{matrix}

$F_2{}^j$ = \begin{matrix} x+iy \\ 0\\ (1-x^2-2ixy+y^2+z^2)/2z\\ i(-1+x^2+2ixy-y^2+z^2)/2z \end{matrix}

$F_3{}^j$ = \begin{matrix} i(-1+x^2+2ixy-y^2+z^2)/2z\\ -(1-x^2-2ixy+y^2+z^2)/2z \\ 0\\ -x-iy \end{matrix}

$F_4{}^j$ = \begin{matrix} -(1-x^2-2ixy+y^2+z^2)/2z\\ -i(-1+x^2+2ixy-y^2+z^2)/2z\\ x+iy\\ 0 \end{matrix}

($j=1,2,3,4$). We would like to solve for the components of $S$ if they satisfy the following equation

\begin{equation} S_{li}{}^jF_k{}^l-S_{lk}{}^jF_i{}^l=0, \end{equation}

where $l$ is summed over, all the indices run from 1 to 4, and $S$ is symmetric in the lower indices.

Would it be possible to write a code that find the components of $S$? The code provided in my previous question Solving antisymmetric tensorial equation would work well for simple examples of $F$, but not for the example we have here.

Answer 1

The equations (along with the symmetry constraints on $S$) are linear and homogeneous. All we have to do is write them down and find a basis for the solution space using NullSpace.

---

Strategy

Doing this efficiently for the analyst takes several steps: simplifying $F$ using common factors, then converting the $_{li}^{\ \ j}$ indexing into a single integer index starting at $1$. (Who cares about the program's efficiency? It won't need more than a second or two anyway.)

Simplifying $F$

ClearAll[x, y, u, v, z];
rules = {u -> x + I y, v -> (1 - x^2 - 2 I x y + y^2)/z};
f = {{0, -u, I (v - z)/2, (v + z)/2}, {u, 0, (v + z)/2, -I (v - z)/2}, 
     {-I (v - z)/2, -(v + z)/2, 0, -u}, {-(v + z)/2, I (v - z)/2, u, 0}} ;
f /. rules // Transpose // MatrixForm

This expresses $F$ more simply in terms of common factors, then displays it in a nice form for confirmation.

Dealing with tensor indices

Now some functions to convert indexes reliably and to display them for later output:

index[l_, i_, j_] := j + 4 (i - 1 + 4 (l - 1));
invIndex[n_] := PadLeft[IntegerDigits[n - 1, 4], 3] + 1 (* l, i, j *);
sIndexes = Flatten[Table[index[i, j, k], {k, 1, 4}, {i, 1, 4}, {j, i, 4}]];
sLabels = Flatten[Table[
    ToString[i] <> ToString[j] <> ToString[k], {k, 1, 4}, {i, 1, 4}, {j, i, 4}]];
i = Ordering[sIndexes];
sIndexes = sIndexes[[i]];
sLabels = sLabels[[i]];

Creating the matrix of equations

With these preliminaries out of the way, we can create the matrix of equations using pattern replacement, so that the computation closely follows the original tensor equations in form:

a = Module[{s, eqns, sym, x, t}, 
   (* The relationship between S and F *)
   eqns = Cases[Flatten[Table[
     List @@ (Collect[Sum[s[l, i, j] f[[k, l]] - s[l, k, j] f[[i, l]], {l, 1, 4}], s[a___]]
        /. Times[s[l0_, i0_, j0_], x_] :> ({index[i, j, k], index[l0, i0, j0]} -> x)),
     {k, 1, 4}, {j, 1, 4}, {i, 1, 4}]], _Rule];
   (* The symmetry of S *)
   t = index[4, 4, 4];
   sym = Flatten[Table[++t; {{t, index[i, j, k]} -> 1, {t, index[j, i, k]} -> -1}, 
       {k, 1, 4}, {i, 1, 4}, {j, i, 4}] ];
   SparseArray[eqns~Join~sym]
   ];

(This exploits the fact that no entries of $F$ are equal to $1$, so that everything in the sum will have a Times header. Cases strips out all equations that are identically zero. Although unnecessary in this application, Collect ensures that each set of subscripts appears only once in each equation.)

This array is $104$ by $64$ with symbolic coefficients. Here is a plot of its potentially nonzero entries:

The solution

zero = NullSpace[a];
sDimensions = Length[zero]

Verifying the solution

The output of 12 indicates there is a 12-dimensional space of solutions. As a check, let's systematically apply the original equations to each basis element in the null space. First, a function s extracts the coefficients of any solution for $S$ given as a linear combination with coefficients in a vector x:

ClearAll[s];
s[x_List] /; Length[x] == sDimensions := x.zero;
s[x_List, {l_, i_, j_}] := s[x][[index[l, i, j]]];

Now the check:

Module[{x},
 Select[Table[
     x = UnitVector[sDimensions, m]; 
     Sum[s[x, {l, i, j}] f[[k, l]] - s[x, {l, k, j}] f[[i, l]], {l, 1, 4}],
       {i, 1, 4}, {j, 1, 4}, {k, 1, 4}, {m, 1, sDimensions}
     ] // Flatten // Simplify, # != 0 &]
 ]

The output is empty ({}), confirming that all the rows of the putative solution really do solve the equation (and that our method of indexing via s is correct, too).

Displaying the solution

Finally, we can look at the solution. TableForm (instead of MatrixForm) enables us to head the columns with the $_{ij}^{\ \ l}$ indexes of $S$ rather than the integral indexes used in the array. At this time we may also apply the rules converting F back into expressions involving x, y, and z:

TableForm[zero[[All, sIndexes]]  /. rules, TableHeadings -> {{}, sLabels}]

To shorten the table, the symmetry of the lower indexes of $S$ is exploited to display only $S_{ij}^l$ for $i\le j$.