Symmetric product

Question

Let define the full symmetrization of a tensor $e_1 \otimes ... \otimes e_N$ by

$$ Sym : e_1 \otimes ... \otimes e_N \rightarrow \frac{1}{N!} \sum_{\pi \in S_N} e_{\pi^{-1} (1)} \otimes ... \otimes e_{\pi^{-1} (N)} $$

where $S_N$ is the symmetric group (set of permutations of N elements). Define the symmetric product of two tensors $e_1 \otimes ... \otimes e_N$, $f_1 \otimes ... \otimes f_n$ by

$$SymProd : (e_1 \otimes ... \otimes e_N,f_1 \otimes ... \otimes f_n) \rightarrow Sym(e_1 \otimes ... \otimes e_N \otimes e_{N+1} \otimes ... \otimes e_{N+n}) $$ where the f's were labeled as e's just to express that $\pi$ acts like a switch operation.

For example, $$Sym( e_1 \otimes e_2) = e_1 \otimes e_2 + e_2 \otimes e_1$$ and $$SymProd(e_1 \otimes e_2, f_1 \otimes f_2 \otimes f_3) \\= Sym(e_1 \otimes e_2 \otimes f_1 \otimes f_2 \otimes f_3) \\= \frac{1}{5!} \sum_{\pi \in S_5} e_{\pi^{-1} (1)} \otimes e_{\pi^{-1} (2)} \otimes e_{\pi^{-1} (3)} \otimes e_{\pi^{-1} (4)} \otimes e_{\pi^{-1} (5)}.$$

Does this function exist on mathematica ? If not, how would you implement it ?

Answer 1

I think you can construct SymProd with a combination of TensorProduct and Symmetrize. For example, take numeric arrays:

d = 3
a1 = RandomInteger[10, {d}]
a2 = RandomInteger[10, {d, d}]
a3 = RandomInteger[10, {d, d, d}]

Then you can take their tensor product and symmetrize:

Symmetrize[TensorProduct[a1, a2, a3]]

The result is given as a SymmetrizedArray object, that avoids storing repeated elements. To get a normal array use Normal:

% // Normal

Then you can check that the result is indeed symmetric with TensorSymmetry:

% // TensorSymmetry
(* Symmetric[{1, 2, 3, 4, 5, 6}] *)

If you want to use symbolic arrays instead of arrays of components then use the assumptions framework with something like this:

$Assumptions = Element[v, Vectors[d]] && Element[m, Matrices[{d, d}]]

and then compute things like

Symmetrize[TensorProduct[v, m]]

Answer 2

Perhaps

sym[array_]:=With[{n=ArrayDepth[array]},
  1/n!*Total[Map[Transpose[array,#]&,Permutations[Range[n]]]]];

For example

sym[Array[a,{2,2}]]//Expand

gives

{{a[1,1],1/2 a[1,2]+1/2 a[2,1]},{1/2 a[1,2]+1/2 a[2,1],a[2,2]}}

and

sym[Array[a,{2,2,2}]]//Expand

gives

{{{a[1,1,1],1/3 a[1,1,2]+1/3 a[1,2,1]+1/3 a[2,1,1]},
 {1/3 a[1,1,2]+1/3 a[1,2,1]+1/3 a[2,1,1],1/3 a[1,2,2]+1/3 a[2,1,2]+1/3 a[2,2,1]}},
 {{1/3 a[1,1,2]+1/3 a[1,2,1]+1/3 a[2,1,1],1/3 a[1,2,2]+1/3 a[2,1,2]+1/3 a[2,2,1]},
 {1/3 a[1,2,2]+1/3 a[2,1,2]+1/3 a[2,2,1],a[2,2,2]}}}