1################################################## 2InstallGlobalFunction(LieCoveringHomomorphism, 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, derayeh2, derayeh3, derayeh4, 9 derayeh5, derayeh6, derayeh7, derayeh8, derayeh9, derayeh10, derayeh11, derayeh12, 10 lenv1, lenv2, lenv3, lenv4, lenv5, lenv6, 11 e, q, w, v1, v2, lzr1, lzr2, lmr1, lmr2, 12 q1, q2, tt1, tt2, ww, h, LTL, LVL, t, v7, I, II, 13 bL, bLTL, g, MLTL, v, vv1, BI, I1, I2, I3, 14 LenBI, BLTL, BBLTL, liltl, llzr1, 15 MLVL,BLVL,BBLVL,II1,II2,II3,BII,LenBII,lilvl,bLV, 16 LL,f,L2,dlab,nn,Tens,pif,BL2,l,vpif,Bvpif,lenbvpif,sp,KK, 17 imagesp,bimagesp,MLAB,LenBL2,BLAB,BBLAB,IIII,LAB,BL,pi,imgpi, 18 BLAB1,LAB1,preimgpi,BJL,n,LS,SCTLStar1, 19 h1,h2,LVLJ,BLVLJ,k1,hh,k2,kt,zz1,zz2,zz3,zz4,vls1,vls2, 20 b1,b2,b3,b4,b5,o1,o2,ts,r,g1,bL1,kk1,ZStarL; 21 22 23 24lisabelian:=0; 25if IsLieAbelian(L) then lisabelian:=1; fi; 26K:=L!.LeftActingDomain; 27BasisL:=Basis(L); 28lenBL:=Length(BasisL); 29SCTL:=StructureConstantsTable(BasisL); 30SCTC:=EmptySCTable(lenBL^2,0*One(K),"antisymmetric"); 31 32for u1 in [1..lenBL] do 33 for u2 in [1..lenBL] do 34 for u3 in [1..lenBL] do 35 for u4 in [1..lenBL] do 36 l1:=Length(SCTL[u1][u2][1]); 37 l2:=Length(SCTL[u3][u4][1]); 38 if l1<>0 then if l2<>0 then 39 index1:=(u1-1)*lenBL+u2; 40 index2:=(u3-1)*lenBL+u4; 41 derayeh1:=[]; 42 43 for t1 in [1..l1] do 44 for t2 in [1..l2] do 45 i:=SCTL[u1][u2][1][t1]; 46 j:=SCTL[u3][u4][1][t2]; 47 m:=(i-1)*lenBL+j; 48 p:=SCTL[u1][u2][2][t1]*SCTL[u3][u4][2][t2]; 49 Add(derayeh1,p*One(K)); 50 Add(derayeh1,m); 51 od; 52 od; 53 54 SetEntrySCTable(SCTC,index1,index2,derayeh1); 55 fi; fi; 56 od; 57 od; 58 od; 59od; 60 61C:=AlgebraByStructureConstants(K,SCTC); 62 63vectorsI:=[]; 64 65for u1 in [1..lenBL] do 66 for u2 in [1..lenBL] do 67 for u3 in [1..lenBL] do 68 zr1:=[]; 69 mr1:=[]; 70 zr2:=[]; 71 mr2:=[]; 72 lenv1:=Length(SCTL[u1][u2][1]); 73 if lenv1<>0 then 74 for t1 in [1..lenv1] do 75 i:=SCTL[u1][u2][1][t1]; 76 j:=u3; 77 m:=(i-1)*lenBL+j; 78 p:=SCTL[u1][u2][2][t1]*1; 79 Add(zr1,p*One(K)); 80 Add(mr1,m); 81 od; 82 fi; 83 lenv2:=Length(SCTL[u2][u3][1]); 84 if lenv2<>0 then 85 for t2 in [1..lenv2] do 86 i:=u1; 87 j:=SCTL[u2][u3][1][t2]; 88 m:=(i-1)*lenBL+j; 89 p:=1*SCTL[u2][u3][2][t2]; 90 e:=0; 91 if Length(zr1)<>0 then 92 for q in [1..Length(zr1)] do 93 if mr1[q]=m then zr1[q]:=zr1[q]-p*One(K); e:=1; fi; 94 od; 95 if e=0 then Add(zr1,-1*p*One(K)); Add(mr1,m); fi; 96 fi; 97 if Length(zr1)=0 then Add(zr1,-1*p*One(K)); Add(mr1,m); fi; 98 od; 99 fi; 100 lenv3:=Length(SCTL[u1][u3][1]); 101 if lenv3<>0 then 102 for t3 in [1..lenv3] do 103 i:=u2; 104 j:=SCTL[u1][u3][1][t3]; 105 m:=(i-1)*lenBL+j; 106 p:=1*SCTL[u1][u3][2][t3]; 107 e:=0; 108 if Length(zr1)<>0 then 109 for q in [1..Length(zr1)] do 110 if mr1[q]=m then zr1[q]:=zr1[q]+p*One(K); e:=1; fi; 111 od; 112 if e=0 then Add(zr1,p*One(K)); Add(mr1,m); fi; 113 fi; 114 if Length(zr1)=0 then Add(zr1,p*One(K)); Add(mr1,m); fi; 115 od; 116 fi; 117 lenv4:=Length(SCTL[u2][u3][1]); 118 if lenv4<>0 then 119 for t4 in [1..lenv2] do 120 i:=u1; 121 j:=SCTL[u2][u3][1][t4]; 122 m:=(i-1)*lenBL+j; 123 p:=1*SCTL[u2][u3][2][t4]; 124 Add(zr2,p*One(K)); 125 Add(mr2,m); 126 od; 127 fi; 128 lenv5:=Length(SCTL[u3][u1][1]); 129 if lenv5<>0 then 130 for t5 in [1..lenv5] do 131 i:=SCTL[u3][u1][1][t5]; 132 j:=u2; 133 m:=(i-1)*lenBL+j; 134 p:=SCTL[u3][u1][2][t5]*1; 135 e:=0; 136 if Length(zr2)<>0 then 137 for q in [1..Length(zr2)] do 138 if mr2[q]=m then zr2[q]:=zr2[q]-p*One(K); e:=1; fi; 139 od; 140 if e=0 then Add(zr2,-1*p*One(K)); Add(mr2,m); fi; 141 fi; 142 if Length(zr2)=0 then Add(zr2,-1*p*One(K)); Add(mr2,m); fi; 143 od; 144 fi; 145 lenv6:=Length(SCTL[u2][u1][1]); 146 if lenv6<>0 then 147 for t6 in [1..lenv6] do 148 i:=SCTL[u2][u1][1][t6]; 149 j:=u3; 150 m:=(i-1)*lenBL+j; 151 p:=SCTL[u2][u1][2][t6]*1; 152 e:=0; 153 if Length(zr2)<>0 then 154 for q in [1..Length(zr2)] do 155 if mr2[q]=m then zr2[q]:=zr2[q]+p*One(K); e:=1; fi; 156 od; 157 if e=0 then Add(zr2,p*One(K)); Add(mr2,m); fi; 158 fi; 159 if Length(zr2)=0 then Add(zr2,p*One(K)); Add(mr2,m); fi; 160 od; 161 fi; 162 163 lzr1:=Length(zr1); 164 lmr1:=Length(mr1); 165 v1:=0; 166 if lzr1<>0 then 167 v1:=zr1[1]*(Elements(Basis(C))[lenBL^2-mr1[1]+1]); 168 for q1 in [2..lzr1] do 169 if zr1[q1]<>0 then 170 v1:=v1+zr1[q1]*(Elements(Basis(C))[lenBL^2-mr1[q1]+1]); 171 fi; 172 od; 173 fi; 174 tt1:=0; 175 for ww in [1..Length(Basis(C))] do 176 if v1=0*Elements(Basis(C))[ww] then tt1:=1; fi; 177 od; 178 w:=0; 179 for h in [1..Length(vectorsI)] do 180 if v1=vectorsI[h] then w:=1; fi; 181 if -1*v1=vectorsI[h] then w:=1; fi; 182 od; 183 if v1<>0 then if w=0 then if tt1=0 then Add(vectorsI,v1); fi; fi; fi; 184 lzr2:=Length(zr2); 185 lmr2:=Length(mr2); 186 v2:=0; 187 if lzr2<>0 then 188 v2:=zr2[1]*(Elements(Basis(C))[lenBL^2-mr2[1]+1]); 189 for q2 in [2..lzr2] do 190 if zr2[q2]<>0 then 191 v2:=v2+zr2[q2]*(Elements(Basis(C))[lenBL^2-mr2[q2]+1]); 192 fi; 193 od; 194 fi; 195 tt2:=0; 196 for ww in [1..Length(Basis(C))] do 197 if v2=0*Elements(Basis(C))[ww] then tt2:=1; fi; 198 od; 199 w:=0; 200 for h in [1..Length(vectorsI)] do 201 if v2=vectorsI[h] then w:=1; fi; 202 if -1*v2=vectorsI[h] then w:=1; fi; 203 od; 204 if v2<>0 then if w=0 then if tt2=0 then Add(vectorsI,v2); fi; fi; fi; 205 206 od; 207 od; 208od; 209 210I:=Ideal(C,vectorsI); 211LTL:=C/I; 212vectorsII:=[]; 213 214for t in [1..Length(vectorsI)] do 215 Add(vectorsII,vectorsI[t]); 216od; 217 218for i in [1..lenBL] do 219 w:=(i-1)*lenBL+i; 220 v7:=Elements(Basis(C))[lenBL^2-w+1]; 221 Add(vectorsII,v7); 222od; 223 224for i in [1..lenBL] do 225 for j in [1..lenBL] do 226 w1:=(i-1)*lenBL+j; 227 w2:=(j-1)*lenBL+i; 228 v7:=Elements(Basis(C))[lenBL^2-w1+1]+Elements(Basis(C))[lenBL^2-w2+1]; 229 Add(vectorsII,v7); 230 od; 231od; 232 233II:=Ideal(C,vectorsII); 234LVL:=C/II; 235MLTL:=[]; 236 237for i in [1..Length(Basis(C))] do 238 v:=Elements(Basis(C))[lenBL^2-i+1]; 239 if not (v in I) then Add(MLTL,v); fi; 240od; 241 242BI:=Basis(I); 243LenBI:=Length(BI); 244BLTL:=[]; 245BBLTL:=[]; 246 247for j in [1..LenBI] do 248 Add(BBLTL,Elements(BI)[j]); 249od; 250 251for i in [1..Length(MLTL)] do 252 Add(BLTL,MLTL[i]); 253 Add(BBLTL,MLTL[i]); 254 I1:=VectorSpace(K,BBLTL); 255 if Dimension(I1)=LenBI+1 then LenBI:=LenBI+1; 256 else 257 Remove(BLTL); 258 Remove(BBLTL); 259 fi; 260 if Length(BLTL)=Dimension(C) then break; fi; 261od; 262 263I2:=VectorSpace(K,BLTL); 264I3:=VectorSpace(K,Basis(LTL)); 265liltl:=[]; 266 267for i in [1..Length(BLTL)] do 268 for j in [1..Length(Basis(C))] do 269 if BLTL[i]=Elements(Basis(C))[lenBL^2-j+1] then 270 Add(liltl,j); 271 break; 272 fi; 273 od; 274od; 275 276bL:=[]; 277 278for k in [1..Length(liltl)] do 279 u1:=Int(liltl[k]/lenBL)+1; 280 u2:= liltl[k] mod lenBL; 281 if u2=0 then u2:=lenBL; u1:=u1-1; fi; 282 u3:=SCTL[u1][u2]; 283 llzr1:=Length(SCTL[u1][u2][1]); 284 vv1:=0*Elements(BasisL)[1]; 285 if llzr1<>0 then 286 vv1:=SCTL[u1][u2][2][1]*Elements(BasisL)[lenBL-SCTL[u1][u2][1][1]+1]; 287 for i in [2..llzr1] do 288 vv1:=vv1+SCTL[u1][u2][2][i]*Elements(BasisL)[lenBL-SCTL[u1][u2][1][i]+1]; 289 od; 290 fi; 291 Add(bL,vv1); 292od; 293 294bLTL:=Basis(LTL); 295 296g:= AlgebraHomomorphismByImages( LTL, L, bLTL , bL );; 297 298MLVL:=[]; 299 300for i in [1..Length(Basis(C))] do 301 v:=Elements(Basis(C))[lenBL^2-i+1]; 302 if not (v in II) then Add(MLVL,v); fi; 303od; 304 305BII:=Basis(II); 306LenBII:=Length(BII); 307BLVL:=[]; 308BBLVL:=[]; 309 310for j in [1..LenBII] do 311 Add(BBLVL,Elements(BII)[j]); 312od; 313 314for i in [1..Length(MLVL)] do 315 Add(BLVL,MLVL[i]); 316 Add(BBLVL,MLVL[i]); 317 II1:=VectorSpace(K,BBLVL); 318 if Dimension(II1)=LenBII+1 then LenBII:=LenBII+1; 319 else 320 Remove(BLVL); 321 Remove(BBLVL); 322 fi; 323 if Length(BLVL)=Dimension(C) then break; fi; 324od; 325 326II2:=VectorSpace(K,BLVL); 327II3:=VectorSpace(K,Basis(LVL)); 328lilvl:=[]; 329 330for i in [1..Length(BLVL)] do 331 for j in [1..Length(Basis(C))] do 332 if BLVL[i]=Elements(Basis(C))[lenBL^2-j+1] then 333 Add(lilvl,j); 334 break; 335 fi; 336 od; 337od; 338 339bLV:=[]; 340 341for k in [1..Length(lilvl)] do 342 u1:=Int(lilvl[k]/lenBL)+1; 343 u2:= lilvl[k] mod lenBL; 344 if u2=0 then u2:=lenBL; u1:=u1-1; fi; 345 u3:=SCTL[u1][u2]; 346 llzr1:=Length(SCTL[u1][u2][1]); 347 vv1:=0*Elements(BasisL)[1]; 348 if llzr1<>0 then 349 vv1:=SCTL[u1][u2][2][1]*Elements(BasisL)[lenBL-SCTL[u1][u2][1][1]+1]; 350 for i in [2..llzr1] do 351 vv1:=vv1+SCTL[u1][u2][2][i]*Elements(BasisL)[lenBL-SCTL[u1][u2][1][i]+1]; 352 od; 353 fi; 354 Add(bLV,vv1); 355od; 356 357BLVL:=Basis(LVL); 358LL:=LieDerivedSubalgebra(L); 359 360f:= AlgebraHomomorphismByImages( LVL, LL, BLVL , bLV ); 361 362L2:=Image(f); 363LL:=LieDerivedSubalgebra(L); 364dlab:=0; 365nn:=Dimension(L)-Dimension(LL); 366if nn=0 then dlab:=1; fi; 367Tens:=Source(f); 368pif:=[]; 369BL2:=Basis(L2); 370l:=Length(BL2); 371if l<>0 then 372 for i in [1..l] do 373 v:=Random(PreImagesElm(f,Basis(LL)[i])); 374 Add(pif,v); 375 od; 376 vpif:=VectorSpace(K,pif); 377 Bvpif:=Basis(vpif); 378 lenbvpif:=Length(Bvpif); 379 KK:=Elements(Bvpif); 380 381 sp:=LeftModuleHomomorphismByImages(LL,LVL,Basis(LL),pif); 382 383 imagesp:=Image(sp); 384 bimagesp:=Basis(imagesp); 385fi; 386 387pi:= NaturalHomomorphismByIdeal( L, LL ); 388 389imgpi:=Image(pi); 390BLAB1:=Basis(imgpi); 391LAB1:=VectorSpace(K,BLAB1); 392preimgpi:=[]; 393BJL:=[]; 394l:=Length(BLAB1); 395if l<>0 then 396 for i in [1..l] do 397 v:=Random(PreImagesElm(pi,BLAB1[i])); 398 Add(preimgpi,v); 399 od; 400fi; 401MLAB:=[]; 402 403for i in [1..Length(Basis(L))] do 404 v:=Elements(Basis(L))[i]; 405 if not (v in L2) then Add(MLAB,v); fi; 406od; 407 408LenBL2:=Length(BL2); 409BLAB:=[]; 410BBLAB:=[]; 411 412for j in [1..LenBL2] do 413 Add(BBLAB,Elements(BL2)[j]); 414od; 415 416for i in [1..Length(MLAB)] do 417 Add(BLAB,MLAB[i]); 418 Add(BBLAB,MLAB[i]); 419 IIII:=VectorSpace(K,BBLAB); 420 if Dimension(IIII)=LenBL2+1 then LenBL2:=LenBL2+1; 421 else 422 Remove(BLAB); 423 Remove(BBLAB); 424 fi; 425 if Length(BBLAB)=Dimension(L) then break; fi; 426od; 427 428LAB:=VectorSpace(K,BLAB); 429l:=Length(BLAB); 430if l<>0 then 431 for i in [1..l] do 432 Add(BJL,BLAB[i]); 433 od; 434fi; 435v1:=[]; 436v2:=[]; 437l:=Length(BL2); 438if l<>0 then 439 for i in [1..Length(BLVL)] do 440 v:=Image(f,BLVL[i]); 441 h1:=1; 442 if p<>0 then 443 for r in [1..l] do 444 if v=0*BL2[r] then h1:=0; fi; 445 od; 446 if h1=1 then 447 Add(BJL,v); 448 Add(v1,v); 449 Add(v2,i); 450 fi; 451 fi; 452 od; 453fi; 454if Length(BLAB1)>0 then 455 t:=LeftModuleHomomorphismByImages(LAB1,L,BLAB1,preimgpi); 456fi; 457m:=Dimension(LVL); 458n:=Length(BLAB1); 459p:=Length(BL2); 460 461SCTLStar1:=EmptySCTable(m+n,0*One(K),"antisymmetric"); 462 463h:=NaturalHomomorphismByIdeal(C,II);; 464 465LVLJ:=Image(h); 466BLVLJ:=Basis(LVLJ); 467 468for i in [1..n+m] do 469 for j in [i..n+m] do 470 if i<=m then 471 k1:=Image(f,BLVL[i]); 472 h1:=1; 473 if p<>0 then 474 for r in [1..p] do 475 if k1=0*Basis(L2)[r] then h1:=0; fi; 476 od; 477 if h1=1 then 478 for hh in [1..Length(v1)] do 479 if v1[hh]=k1 then k1:=BJL[n+hh]; fi; 480 od; 481 fi; 482 483 else 484 h1:=0; 485 fi; 486 487 else 488 k1:=BJL[i-m]; 489 h1:=1; 490 fi; 491 492 if j<=m then 493 k2:=Image(f,BLVL[j]); 494 h2:=1; 495 if p<>0 then 496 for r in [1..p] do 497 if k2=0*Basis(L2)[r] then h2:=0; fi; 498 od; 499 if h2=1 then 500 for hh in [1..Length(v1)] do 501 if v1[hh]=k2 then k2:=BJL[n+hh]; fi; 502 od; 503 fi; 504 505 else 506 h2:=0; 507 fi; 508 509 else 510 k2:=BJL[j-m]; 511 h2:=1; 512 fi; 513 514 if h1=1 and h2=1 then 515 zz1:=Coefficients(BasisL, k1 ); 516 zz2:=Coefficients(BasisL, k2 ); 517 vls1:=[]; 518 for b4 in [1..m] do 519 Add(vls1,0); 520 od; 521 522 for b1 in [1..Length(zz1)] do 523 for b2 in [1..Length(zz2)] do 524 o1:=(b1-1)*lenBL+b2; 525 o2:=zz1[b1]*zz2[b2]; 526 if o2<>0 then 527 kt:=Image(h,Basis(C)[o1]); 528 zz3:=Coefficients(BLVLJ,kt); 529 for b3 in [1..m] do 530 vls1[b3]:=vls1[b3]+o2*zz3[b3]; 531 od; 532 fi; 533 od; 534 od; 535 536 vls2:=[]; 537 for b5 in [1..m] do 538 if vls1[b5]<>0 then 539 Add(vls2,vls1[b5]); 540 Add(vls2,b5); 541 fi; 542 od; 543 if Length(vls2)>0 then SetEntrySCTable( SCTLStar1, i, j, vls2 ); fi; 544 fi; 545 546 od; 547od; 548LS:=LieAlgebraByStructureConstants(K,SCTLStar1); 549 550bL1:=[]; 551 552for i in [1..Length(bLV)] do 553 Add(bL1,bLV[i]); 554od; 555 556for i in [1..n] do 557 Add(bL1,BJL[i]); 558od; 559 560#for i in [1..Length(BasisL)] do 561# Add(bL1,BasisL[i]); 562#od; 563#for i in [1..(m-p)] do 564# Add(bL1,0*BasisL[1]); 565#od; 566 567g1:= AlgebraHomomorphismByImages( LS, L, Basis(LS) , bL1 ); 568 569return g1; 570end); 571################################################################## 572 573################################################################## 574InstallGlobalFunction(LieEpiCentre, 575function(L) 576local phi; 577 578phi:=LieCoveringHomomorphism(L); 579return Image(phi,LieCentre(Source(phi))); 580end); 581################################################################## 582