1################################################## 2InstallGlobalFunction(LieTensorSquare, 3function(L) 4local 5 BasisL, lenBL, SCTL, lisabelian, K, SCTC, u1, u2, u3, u4, l1, l2, 6 index1, index2, C, t1, t2, t3, t4, t5, t6, i, j, k, m, p, 7 vectorsI, vectorsII,w1,w2, 8 zr1, mr1, zr2, mr2, derayeh1, 9 lenv1, lenv2, lenv3, lenv4, lenv5, lenv6, 10 e, q, w, v1, v2, lzr1, lzr2, lmr1, lmr2, 11 q1, q2, tt1, tt2, ww, h, LTL, LVL, t, v7, I, II, 12 bL, bLTL, g, MLTL, v, vv1, BI, I1, I2, I3, 13 LenBI, BLTL, BBLTL, liltl, llzr1,g1,Pair; 14 15lisabelian:=0; 16if IsLieAbelian(L) then lisabelian:=1; fi; 17K:=L!.LeftActingDomain; 18BasisL:=Basis(L); 19lenBL:=Length(BasisL); 20SCTL:=StructureConstantsTable(BasisL); 21SCTC:=EmptySCTable(lenBL^2,0*One(K),"antisymmetric"); 22 23for u1 in [1..lenBL] do 24 for u2 in [1..lenBL] do 25 for u3 in [1..lenBL] do 26 for u4 in [1..lenBL] do 27 l1:=Length(SCTL[u1][u2][1]); 28 l2:=Length(SCTL[u3][u4][1]); 29 if l1<>0 then if l2<>0 then 30 index1:=(u1-1)*lenBL+u2; 31 index2:=(u3-1)*lenBL+u4; 32 derayeh1:=[]; 33 34 for t1 in [1..l1] do 35 for t2 in [1..l2] do 36 i:=SCTL[u1][u2][1][t1]; 37 j:=SCTL[u3][u4][1][t2]; 38 m:=(i-1)*lenBL+j; 39 p:=SCTL[u1][u2][2][t1]*SCTL[u3][u4][2][t2]; 40 Add(derayeh1,p*One(K)); 41 Add(derayeh1,m); 42 od; 43 od; 44 45 SetEntrySCTable(SCTC,index1,index2,derayeh1); 46 fi; fi; 47 od; 48 od; 49 od; 50od; 51 52C:=AlgebraByStructureConstants(K,SCTC); 53 54vectorsI:=[]; 55 56for u1 in [1..lenBL] do 57 for u2 in [1..lenBL] do 58 for u3 in [1..lenBL] do 59 zr1:=[]; 60 mr1:=[]; 61 zr2:=[]; 62 mr2:=[]; 63 lenv1:=Length(SCTL[u1][u2][1]); 64 if lenv1<>0 then 65 for t1 in [1..lenv1] do 66 i:=SCTL[u1][u2][1][t1]; 67 j:=u3; 68 m:=(i-1)*lenBL+j; 69 p:=SCTL[u1][u2][2][t1]*1; 70 Add(zr1,p*One(K)); 71 Add(mr1,m); 72 od; 73 fi; 74 lenv2:=Length(SCTL[u2][u3][1]); 75 if lenv2<>0 then 76 for t2 in [1..lenv2] do 77 i:=u1; 78 j:=SCTL[u2][u3][1][t2]; 79 m:=(i-1)*lenBL+j; 80 p:=1*SCTL[u2][u3][2][t2]; 81 e:=0; 82 if Length(zr1)<>0 then 83 for q in [1..Length(zr1)] do 84 if mr1[q]=m then zr1[q]:=zr1[q]-p*One(K); e:=1; fi; 85 od; 86 if e=0 then Add(zr1,-1*p*One(K)); Add(mr1,m); fi; 87 fi; 88 if Length(zr1)=0 then Add(zr1,-1*p*One(K)); Add(mr1,m); fi; 89 od; 90 fi; 91 lenv3:=Length(SCTL[u1][u3][1]); 92 if lenv3<>0 then 93 for t3 in [1..lenv3] do 94 i:=u2; 95 j:=SCTL[u1][u3][1][t3]; 96 m:=(i-1)*lenBL+j; 97 p:=1*SCTL[u1][u3][2][t3]; 98 e:=0; 99 if Length(zr1)<>0 then 100 for q in [1..Length(zr1)] do 101 if mr1[q]=m then zr1[q]:=zr1[q]+p*One(K); e:=1; fi; 102 od; 103 if e=0 then Add(zr1,p*One(K)); Add(mr1,m); fi; 104 fi; 105 if Length(zr1)=0 then Add(zr1,p*One(K)); Add(mr1,m); fi; 106 od; 107 fi; 108 lenv4:=Length(SCTL[u2][u3][1]); 109 if lenv4<>0 then 110 for t4 in [1..lenv2] do 111 i:=u1; 112 j:=SCTL[u2][u3][1][t4]; 113 m:=(i-1)*lenBL+j; 114 p:=1*SCTL[u2][u3][2][t4]; 115 Add(zr2,p*One(K)); 116 Add(mr2,m); 117 od; 118 fi; 119 lenv5:=Length(SCTL[u3][u1][1]); 120 if lenv5<>0 then 121 for t5 in [1..lenv5] do 122 i:=SCTL[u3][u1][1][t5]; 123 j:=u2; 124 m:=(i-1)*lenBL+j; 125 p:=SCTL[u3][u1][2][t5]*1; 126 e:=0; 127 if Length(zr2)<>0 then 128 for q in [1..Length(zr2)] do 129 if mr2[q]=m then zr2[q]:=zr2[q]-p*One(K); e:=1; fi; 130 od; 131 if e=0 then Add(zr2,-1*p*One(K)); Add(mr2,m); fi; 132 fi; 133 if Length(zr2)=0 then Add(zr2,-1*p*One(K)); Add(mr2,m); fi; 134 od; 135 fi; 136 lenv6:=Length(SCTL[u2][u1][1]); 137 if lenv6<>0 then 138 for t6 in [1..lenv6] do 139 i:=SCTL[u2][u1][1][t6]; 140 j:=u3; 141 m:=(i-1)*lenBL+j; 142 p:=SCTL[u2][u1][2][t6]*1; 143 e:=0; 144 if Length(zr2)<>0 then 145 for q in [1..Length(zr2)] do 146 if mr2[q]=m then zr2[q]:=zr2[q]+p*One(K); e:=1; fi; 147 od; 148 if e=0 then Add(zr2,p*One(K)); Add(mr2,m); fi; 149 fi; 150 if Length(zr2)=0 then Add(zr2,p*One(K)); Add(mr2,m); fi; 151 od; 152 fi; 153 154 lzr1:=Length(zr1); 155 lmr1:=Length(mr1); 156 v1:=0; 157 if lzr1<>0 then 158 v1:=zr1[1]*(Elements(Basis(C))[lenBL^2-mr1[1]+1]); 159 for q1 in [2..lzr1] do 160 if zr1[q1]<>0 then 161 v1:=v1+zr1[q1]*(Elements(Basis(C))[lenBL^2-mr1[q1]+1]); 162 fi; 163 od; 164 fi; 165 tt1:=0; 166 for ww in [1..Length(Basis(C))] do 167 if v1=0*Elements(Basis(C))[ww] then tt1:=1; fi; 168 od; 169 w:=0; 170 for h in [1..Length(vectorsI)] do 171 if v1=vectorsI[h] then w:=1; fi; 172 if -1*v1=vectorsI[h] then w:=1; fi; 173 od; 174 if v1<>0 then if w=0 then if tt1=0 then Add(vectorsI,v1); fi; fi; fi; 175 lzr2:=Length(zr2); 176 lmr2:=Length(mr2); 177 v2:=0; 178 if lzr2<>0 then 179 v2:=zr2[1]*(Elements(Basis(C))[lenBL^2-mr2[1]+1]); 180 for q2 in [2..lzr2] do 181 if zr2[q2]<>0 then 182 v2:=v2+zr2[q2]*(Elements(Basis(C))[lenBL^2-mr2[q2]+1]); 183 fi; 184 od; 185 fi; 186 tt2:=0; 187 for ww in [1..Length(Basis(C))] do 188 if v2=0*Elements(Basis(C))[ww] then tt2:=1; fi; 189 od; 190 w:=0; 191 for h in [1..Length(vectorsI)] do 192 if v2=vectorsI[h] then w:=1; fi; 193 if -1*v2=vectorsI[h] then w:=1; fi; 194 od; 195 if v2<>0 then if w=0 then if tt2=0 then Add(vectorsI,v2); fi; fi; fi; 196 197 od; 198 od; 199od; 200 201I:=Ideal(C,vectorsI); 202#LTL:=C/I; 203g1:=NaturalHomomorphismByIdeal(C,I); 204LTL:=Image(g1); 205vectorsII:=[]; 206 207for t in [1..Length(vectorsI)] do 208 Add(vectorsII,vectorsI[t]); 209od; 210 211for i in [1..lenBL] do 212 w:=(i-1)*lenBL+i; 213 v7:=Elements(Basis(C))[lenBL^2-w+1]; 214 Add(vectorsII,v7); 215od; 216 217for i in [1..lenBL] do 218 for j in [1..lenBL] do 219 w1:=(i-1)*lenBL+j; 220 w2:=(j-1)*lenBL+i; 221 v7:=Elements(Basis(C))[lenBL^2-w1+1]+Elements(Basis(C))[lenBL^2-w2+1]; 222 Add(vectorsII,v7); 223 od; 224od; 225 226II:=Ideal(C,vectorsII); 227LVL:=C/II; 228MLTL:=[]; 229 230for i in [1..Length(Basis(C))] do 231 v:=Elements(Basis(C))[lenBL^2-i+1]; 232 if not (v in I) then Add(MLTL,v); fi; 233od; 234 235BI:=Basis(I); 236LenBI:=Length(BI); 237BLTL:=[]; 238BBLTL:=[]; 239 240for j in [1..LenBI] do 241 Add(BBLTL,Elements(BI)[j]); 242od; 243 244for i in [1..Length(MLTL)] do 245 Add(BLTL,MLTL[i]); 246 Add(BBLTL,MLTL[i]); 247 I1:=VectorSpace(K,BBLTL); 248 if Dimension(I1)=LenBI+1 then LenBI:=LenBI+1; 249 else 250 Remove(BLTL); 251 Remove(BBLTL); 252 fi; 253 if Length(BLTL)=Dimension(C) then break; fi; 254od; 255 256I2:=VectorSpace(K,BLTL); 257I3:=VectorSpace(K,Basis(LTL)); 258liltl:=[]; 259 260for i in [1..Length(BLTL)] do 261 for j in [1..Length(Basis(C))] do 262 if BLTL[i]=Elements(Basis(C))[lenBL^2-j+1] then 263 Add(liltl,j); 264 break; 265 fi; 266 od; 267od; 268 269bL:=[]; 270 271for k in [1..Length(liltl)] do 272 u1:=Int(liltl[k]/lenBL)+1; 273 u2:= liltl[k] mod lenBL; 274 if u2=0 then u2:=lenBL; u1:=u1-1; fi; 275 u3:=SCTL[u1][u2]; 276 llzr1:=Length(SCTL[u1][u2][1]); 277 vv1:=0*Elements(BasisL)[1]; 278 if llzr1<>0 then 279 vv1:=SCTL[u1][u2][2][1]*Elements(BasisL)[lenBL-SCTL[u1][u2][1][1]+1]; 280 for i in [2..llzr1] do 281 vv1:=vv1+SCTL[u1][u2][2][i]*Elements(BasisL)[lenBL-SCTL[u1][u2][1][i]+1]; 282 od; 283 fi; 284 Add(bL,vv1); 285od; 286 287bLTL:=Basis(LTL); 288g:= AlgebraHomomorphismByImages( LTL, L, bLTL , bL );; 289#g1:= NaturalHomomorphismByIdeal( C, I ); 290 291################################ 292Pair:=function(x,y) 293 local 294 z1,z2,z3,z4,l,v1,v,k,i,j; 295 296z1:=Coefficients( Basis(L), x ); 297z2:=Coefficients( Basis(L), y ); 298l:=Length(z1); 299v:=0*Random(Images(g1,Basis(C)[1])); 300for i in [1..l] do 301 for j in [1..l] do 302 z3:=z1[i]*z2[j]; 303 if z3<>0 then 304 k:=(i-1)*lenBL+j; 305 v1:=Random(Images(g1,Basis(C)[k])); 306 v:=v+z3*v1; 307 fi; 308 od; 309od; 310return v; 311end; 312 313################################ 314return rec(homomorphism:=g, pairing:=Pair ); 315end); 316############################################################################### 317