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