Double contraction between 2nd and 4th rank tensor

Question

I would like to compute the double dot product between a 2nd and 4th rank tensor in mathematica $A_{kl}A_{ijkl}$

$if \, A_{kl}=\begin{pmatrix} 1& 0 & 0\\ 0 & 1 & 0\\ 0&0 & 1 \end{pmatrix} \, and \, \, A_{ijkl}=\begin{pmatrix} 1 &0 &0 &0 &1 &0& 0& 0& 1\\ 0 &0 &0 &0 &0 &0 &0 &0 &0\\ 0 &0 &0 &0 &0 &0 &0 &0& 0&\\ 0& 0& 0& 0& 0& 0& 0& 0& 0&\\ 1& 0& 0& 0& 1& 0& 0& 0& 1&\\ 0& 0& 0& 0& 0& 0& 0& 0& 0&\\ 0& 0& 0& 0& 0& 0& 0& 0& 0&\\ 0& 0& 0& 0& 0& 0& 0& 0& 0\\ 1& 0& 0& 0& 1& 0& 0& 0& 1 \end{pmatrix} then \, A_{kl}A_{ijkl} = \begin{pmatrix} 3&0 &0 \\ 0 &3 &0 \\ 0 &0 &3 \end{pmatrix}$

Can anyone give me a hand with this?

Best Regards

Answer 1

I assume your matrices are just an identity and its tensor product with itself reshaped into a matrix:

A = IdentityMatrix[3];
B = ArrayReshape[TensorProduct[A, A], {9, 9}];

If you treat them like this, then it's only one contraction:

TensorContract[TensorProduct[A, B], {{3, 4}}]

But I think this would be more faithful to your mathematical notation of contracting twice:

TensorContract[TensorProduct[A, A, A], {{1, 5}, {2, 6}}]

Answer 2

A = {{1, 0, 0},
     {0, 1, 0},
     {0, 0, 1}};
B = {{1, 0, 0, 0, 1, 0, 0, 0, 1},
     {0, 0, 0, 0, 0, 0, 0, 0, 0},
     {0, 0, 0, 0, 0, 0, 0, 0, 0},
     {0, 0, 0, 0, 0, 0, 0, 0, 0},
     {1, 0, 0, 0, 1, 0, 0, 0, 1},
     {0, 0, 0, 0, 0, 0, 0, 0, 0},
     {0, 0, 0, 0, 0, 0, 0, 0, 0},
     {0, 0, 0, 0, 0, 0, 0, 0, 0},
     {1, 0, 0, 0, 1, 0, 0, 0, 1}};

Partition[B.Flatten[A], 3]
(*    {{3, 0, 0},
       {0, 3, 0},
       {0, 0, 3}}    *)

Answer 3

For arbitrary rank tensors with any number of contractions between them, you can use Flatten and then Dot to get what you are after. If you are using numeric tensors (packed arrays), this might be quicker than the Tensor commands.

The general idea is that you can take a tensor $A_{kl}$ and then Flatten the $kl$ indices into a single multi-index $\alpha = (kl)$. You can then do the same with $B_{ijkl}$ (I'm calling it $B$ instead of $A$ here). You then have $$B_{ijkl} A_{kl} = B_{ij\alpha}A_{\alpha}$$ so that it is a standard dot product on the $\alpha$ index.

Let's start by defining a rank 2 and a rank 4 tensor (for example) of dimensions $3\times3$ and $3\times3\times3\times3$:

(* Subscript[A, kl] *)
A = RandomReal[10, {3, 3}];
(* Subscript[B, ijkl] *)
B = RandomReal[10, {3, 3, 3, 3}];

We then use Flatten on the $kl$ indices

A$flat = Flatten[A, {{1,2}}];
B$flat = Flatten[B, {{1}, {2}, {3, 4}}];

Note that the behaviour of Flatten is that {{1}, {2}, {3, 4}} says that the flattened object has indices given by {"1st index of original","2nd index of original","3rd and 4th index of original"}. These are now rank 1 and rank 3 tensors $A_\alpha$ and $B_{ij\alpha}$ of dimensions $9$ and $3\times3\times9$. We can then use the usual dot product

B$flat.A$flat

which gives a $3\times3$ dimensional rank two tensor. Or putting it all together

(* Subscript[A, kl] *)
A = RandomReal[10, {3, 3}];
(* Subscript[B, ijkl] *)
B = RandomReal[10, {3, 3, 3, 3}];
(* Flatten and take dot product *)
Flatten[B, {{1}, {2}, {3, 4}}].Flatten[A, {{1, 2}}]

Note that you could also swap the order of the dot product as

Flatten[A, {{1, 2}}].Flatten[B, {{3, 4}, {1}, {2}}]

where the Flatten on $B$ is used to transpose the $\alpha=(kl)$ indices to get $B_{\alpha i j}$ instead. I hope this illustrates what Flatten is doing.

You can also do this for more complicated contractions such as $$A_{k i m}B_{j k l m}$$ which gives a tensor with indices $(i j l)$ as the result. The code for this would be

(* Subscript[A, ikm] *)
A = RandomReal[10, {3, 3, 3}];
(* Subscript[B, ijklm] *)
B = RandomReal[10, {3, 3, 3, 3, 3}];
(* Flatten and take dot product *)
Flatten[A, {{2}, {1, 3}}].Flatten[B, {{2, 4}, {1}, {3}}]

Answer 4

Another ways. Start with theses arrays

A = {{1, 0, 0}, {0, 1, 0}, {0, 0, 1}};
B = {{1, 0, 0, 0, 1, 0, 0, 0, 1}, {0, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 
    0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 0, 0, 0}, {1, 0, 0, 0, 1,
     0, 0, 0, 1}, {0, 0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 0, 
    0, 0}, {0, 0, 0, 0, 0, 0, 0, 0, 0}, {1, 0, 0, 0, 1, 0, 0, 0, 1}};
AA = ArrayReshape[B, {3, 3, 3, 3}]

1.

ArrayReshape[AA, {3, 3, 9}].ArrayReshape[A, {9}]

2.

ArrayReshape[B, {3, 3, 9}].ArrayReshape[A, {9}]