In[]:=
deploy
Thu 17 Sep 2020 10:03:28

Background

https://mathematica.stackexchange.com/questions/230167/commutation-symmetrizer-and-duplication-matrices
https://math.stackexchange.com/questions/3830092/matrix-corresponding-to-transformation-ta-otimes-b-b-otimes-a

Common matrices

CircleTimes=KroneckerProduct;​​​​vec[W_]:=Join@@Transpose[W]​​​​vech[W_]:=With[{n=Length[W]},Flatten[MapThread[#1[[-#2;;]]&,{Transpose[W],Reverse@Range[n]}]]]​​​​getperm[perm_,n_]:=Permute[IdentityMatrix[n*n],perm]​​​​(*CommutationmatrixGn*)​​kcomm[n_]:=With[{mtx=ArrayReshape[Range[n*n],{n,n}]},getperm[FindPermutation[vec[Transpose[mtx]],vec[mtx]],Length[mtx]]]​​​​(*SymmetrizerNn=Pn*)​​nsymm[n_]:=(kcomm[n]+IdentityMatrix[n^2])/2​​​​(*DuplicationmatrixDn*)​​gdupe[n_]:=With[{mtx=Array[a[Min[#1,#2],Max[#1,#2]]&,{n,n}],gmatrix=Array[x,{n*n,n(n+1)/2}]},gmatrix/.First[SolveAlways[vec[mtx]gmatrix.vech[mtx],Variables[mtx]]]]​​​​(*Kroneckercommutationmatrix:Note:onlyworksfor2x2matrices*)​​kronComm[n_]:=With[{mtx1=ArrayReshape[Range[n*n],{n,n}],mtx2=ArrayReshape[n*n+1+Range[n*n],{n,n}]},getperm[FindPermutation[vec[mtx2⊗mtx1],vec[mtx1⊗mtx2]],Length[mtx1⊗mtx2]]];​​​​​​(*tests*)​​d=3;​​m=RandomReal[{-1,1},{d,d}];​​kcomm[d].vec[Transpose[m]]vec[m]​​(*True*)​​​​nsymm[d].vec[m]vec[(m+Transpose[m])/2]​​(*True*)​​​​vec[Normal[Symmetrize[m]]]gdupe[d].vech[Normal[Symmetrize[m]]]​​(*True*)​​​​​​d=2;​​m1=RandomReal[{-1,1},{d,d}];​​m2=RandomReal[{-1,1},{d,d}];​​vec[m2⊗m1]kronComm[d].vec[m1⊗m2]​​(*True*)​​​​​​
Out[]=
True
Out[]=
True
Out[]=
True
Out[]=
True