QuantumGroupsPath = "~/projects/QuantumGroups/trunk/package/";
AppendTo[$Path, QuantumGroupsPath];
<<QuantumGroups`

DecomposeRepresentation[F4][((Irrep[F4][{0,0,0,1}])^(⊗2))]

DebugSet[False]

InterpolationInverseThreshold=21

cap=DirectSumProjectionMap[F4,DirectSum[Irrep[(Subscript[F, 4])][{0,0,0,0}],Irrep[(Subscript[F, 4])][{0,0,0,1}],Irrep[(Subscript[F, 4])][{1,0,0,0}],Irrep[(Subscript[F, 4])][{0,0,1,0}],Irrep[(Subscript[F, 4])][{0,0,0,2}]],1,FundamentalBasis].InverseDecompositionMap[F4,((Irrep[F4][{0,0,0,1}])^(⊗2)),FundamentalBasis];

cup=DecompositionMap[F4,((Irrep[F4][{0,0,0,1}])^(⊗2)),FundamentalBasis].DirectSumInclusionMap[F4,DirectSum[Irrep[(Subscript[F, 4])][{0,0,0,0}],Irrep[(Subscript[F, 4])][{0,0,0,1}],Irrep[(Subscript[F, 4])][{1,0,0,0}],Irrep[(Subscript[F, 4])][{0,0,1,0}],Irrep[(Subscript[F, 4])][{0,0,0,2}]],1,FundamentalBasis];

SetDirectory["~/projects/fusionatlas/code/development/quantum-group-biprojections"]

Put[cup,"cup.m"]

Put[cap,"cap.m"]

Clear[p]

p[k_]:=p[k]=DecompositionMap[F4,((Irrep[F4][{0,0,0,1}])^(⊗2)),FundamentalBasis].DirectSumInclusionMap[F4,DirectSum[Irrep[(Subscript[F, 4])][{0,0,0,0}],Irrep[(Subscript[F, 4])][{0,0,0,1}],Irrep[(Subscript[F, 4])][{1,0,0,0}],Irrep[(Subscript[F, 4])][{0,0,1,0}],Irrep[(Subscript[F, 4])][{0,0,0,2}]],k,FundamentalBasis].DirectSumProjectionMap[F4,DirectSum[Irrep[(Subscript[F, 4])][{0,0,0,0}],Irrep[(Subscript[F, 4])][{0,0,0,1}],Irrep[(Subscript[F, 4])][{1,0,0,0}],Irrep[(Subscript[F, 4])][{0,0,1,0}],Irrep[(Subscript[F, 4])][{0,0,0,2}]],k,FundamentalBasis].InverseDecompositionMap[F4,((Irrep[F4][{0,0,0,1}])^(⊗2)),FundamentalBasis]

p[2]

With[{Γ=F4,λ={0,0,0,1}},
With[{V=Irrep[Γ][λ]},
Associator[Γ,V,V,V,FundamentalBasis]=Associator[Γ,V,V,V,FundamentalBasis];
InverseAssociator[Γ,V,V,V,FundamentalBasis]=InverseAssociator[Γ,V,V,V,FundamentalBasis];
InverseAssociator[Γ,V⊗V,V,V,FundamentalBasis]=InverseAssociator[Γ,V⊗V,V,V,FundamentalBasis];
]
]

V=Irrep[F4][{0,0,0,1}];

Put[Associator[F4,V,V,V,FundamentalBasis],"assoc.m"];
Put[InverseAssociator[F4,V,V,V,FundamentalBasis],"invassoc.m"];

invassoc4=List@@InverseAssociator[F4,V⊗V,V,V,FundamentalBasis];

ByteCount[invassoc4]

DumpSave["invassoc4.m",invassoc4];

id=IdentityMap[F4,Irrep[F4][{0,0,0,1}],FundamentalBasis];

Clear[rot,rotR]

rotR[k_]:=rotR[k]=((id⊗cap).(InverseAssociator[F4,V,V,V,FundamentalBasis].(p[k]⊗id)))/.{U_⊗Irrep[F4][{0,0,0,0}]:>U,Irrep[F4][{0,0,0,0}]⊗U_:>U}

rot[k_]:=rot[k]=((((id⊗rotR[k]).InverseAssociator[F4,V,V⊗V,V,FundamentalBasis]).(InverseAssociator[F4,V,V,V,FundamentalBasis]⊗id)).(cup⊗id⊗id))/.{U_⊗Irrep[F4][{0,0,0,0}]:>U,Irrep[F4][{0,0,0,0}]⊗U_:>U}

rotR[1];

rotR/@Range[5];

Put[rotR/@Range[5],"rotR.m"];

rot/@Range[5];

Put[rot/@Range[5],"rot.m"];