How to write this tensor?

Question

How can I write this tensor in Mathematica?

$$\mathcal{P}_{ijkl}(N) = \Big( \delta_{ik} - N_iN_k \Big) \Big( \delta_{jl} - N_jN_l \Big) - \dfrac{1}{2} \Big( \delta_{ij} - N_iN_j \Big)\Big( \delta_{kl} - N_kN_l \Big)$$

I have tried with TensorProduct, but I realized that it is not so simple because of the position of the indices.

EDIT To clarify: $\delta_{ij}$ is the Kroeneker delta and $$N=\{\cos\phi \sin\theta, \sin\phi\sin\theta,\cos\theta\}$$

Answer 1

The simplest way would be to use Table, e.g. something like

tensorTable[n_] := With[{dim = Length[n]},
  Table[
   (KroneckerDelta[i, k] - n[[i]] n[[k]]) (KroneckerDelta[j, l] - 
       n[[j]] n[[l]]) -
    1/2 (KroneckerDelta[i, j] - n[[i]] n[[j]]) (KroneckerDelta[k, l] -
        n[[k]] n[[l]]),
   {i, dim}, {j, dim}, {k, dim}, {l, dim}]]

For the vector given by OP:

exampleTensor = Simplify[tensorTable[{Cos[ϕ] Sin[θ],Sin[ϕ] Sin[θ], Cos[θ]}]];

I suppose you could also write this in more convenient(?) mathematical notation using SparseArray, by noticing the two terms are identical up to a permutation of $j\leftrightarrow k$

commonTerm[n_] := With[{dim = Length[n]},
  Plus @@ Map[SparseArray[#, {dim, dim, dim, dim}] &,
    {
     {i_, j_, k_, l_} :> n[[i]] n[[j]] n[[k]] n[[l]],
     {i_, j_, i_, l_} :> -n[[j]] n[[l]],
     {i_, j_, k_, j_} :> -n[[i]] n[[k]],
     {i_, j_, i_, j_} :> 1
     }
    ]
  ]

This will also store the tensor as a SparseArray which may be beneficial for further analysis.

exampleTensor2 = 
  Simplify[commonTerm[{Cos[ϕ] Sin[θ],Sin[ϕ] Sin[θ], Cos[θ]}] - 
    1/2 Transpose[commonTerm[{Cos[ϕ] Sin[θ], Sin[ϕ] Sin[θ], Cos[θ]}], 
      Cycles[{{2, 3}}]]];

exampleTensor == exampleTensor2
(*True*)