1############################################################################# 2## 3## This file is part of GAP, a system for computational discrete algebra. 4## This file's authors include Thomas Breuer, and Willem de Graaf. 5## 6## Copyright of GAP belongs to its developers, whose names are too numerous 7## to list here. Please refer to the COPYRIGHT file for details. 8## 9## SPDX-License-Identifier: GPL-2.0-or-later 10## 11## This file contains methods for Lie algebras. 12## 13 14 15############################################################################# 16## 17#M LieUpperCentralSeries( <L> ) . . . . . . . . . . for a Lie algebra 18## 19InstallMethod( LieUpperCentralSeries, 20 "for a Lie algebra", 21 true, 22 [ IsAlgebra and IsLieAlgebra ], 0, 23 function( L ) 24 25 local S, # upper central series of <L>, result 26 C, # Lie centre 27 hom; # homomorphisms of <L> to `<L>/<C>' 28 29 S := [ TrivialSubalgebra( L ) ]; 30 C := LieCentre( L ); 31 while C <> S[ Length(S) ] do 32 33 # Replace `L' by `L / C', compute its centre, and get the preimage 34 # under the natural homomorphism. 35 Add( S, C ); 36 hom:= NaturalHomomorphismByIdeal( L, C ); 37 C:= PreImages( hom, LieCentre( Range( hom ) ) ); 38#T we would like to get ideals! 39#T is it possible to teach the hom. that the preimage of an ideal is an ideal? 40 41 od; 42 43 # Return the series when it becomes stable. 44 return Reversed( S ); 45 end ); 46 47 48############################################################################# 49## 50#M LieLowerCentralSeries( <L> ) . . . . . . . . . . for a Lie algebra 51## 52InstallMethod( LieLowerCentralSeries, 53 "for a Lie algebra", 54 true, 55 [ IsAlgebra and IsLieAlgebra ], 0, 56 function( L ) 57 58 local S, # lower central series of <L>, result 59 C; # commutator subalgebras 60 61 # Compute the series by repeated calling of `ProductSpace'. 62 S := [ L ]; 63 C := LieDerivedSubalgebra( L ); 64 while C <> S[ Length(S) ] do 65 Add( S, C ); 66 C:= ProductSpace( L, C ); 67 od; 68 69 # Return the series when it becomes stable. 70 return S; 71 end ); 72 73 74 75############################################################################# 76## 77#M LieDerivedSubalgebra( <L> ) 78## 79## is the (Lie) derived subalgebra of the Lie algebra <L>. 80## This is the ideal/algebra/subspace (equivalent in this case) 81## generated/spanned by all products $uv$ 82## where $u$ and $v$ range over a basis of <L>. 83## 84InstallMethod( LieDerivedSubalgebra, 85 "for a Lie algebra", 86 true, 87 [ IsAlgebra and IsLieAlgebra ], 0, 88 L -> ProductSpace( L, L ) ); 89 90 91############################################################################# 92## 93#M LieDerivedSeries( <L> ) 94## 95InstallMethod( LieDerivedSeries, 96 "for a Lie algebra", 97 true, 98 [ IsAlgebra and IsLieAlgebra ], 0, 99 function ( L ) 100 101 local S, # (Lie) derived series of <L>, result 102 D; # (Lie) derived subalgebras 103 104 # Compute the series by repeated calling of `LieDerivedSubalgebra'. 105 S := [ L ]; 106 D := LieDerivedSubalgebra( L ); 107 while D <> S[ Length(S) ] do 108 Add( S, D ); 109 D:= LieDerivedSubalgebra( D ); 110 od; 111 112 # Return the series when it becomes stable. 113 return S; 114 end ); 115 116 117############################################################################# 118## 119#M IsLieSolvable( <L> ) . . . . . . . . . . . . . . . for a Lie algebra 120## 121InstallMethod( IsLieSolvable, 122 "for a Lie algebra", 123 true, 124 [ IsAlgebra and IsLieAlgebra ], 0, 125 function( L ) 126 127 local D; 128 129 D:= LieDerivedSeries( L ); 130 return Dimension( D[ Length( D ) ] ) = 0; 131 end ); 132 133InstallTrueMethod( IsLieSolvable, IsLieNilpotent ); 134 135 136############################################################################# 137## 138#M IsLieNilpotent( <L> ) . . . . . . . . . . . . . . . for a Lie algebra 139## 140InstallMethod( IsLieNilpotent, 141 "for a Lie algebra", 142 true, 143 [ IsAlgebra and IsLieAlgebra ], 0, 144 function( L ) 145 146 local D; 147 148 D:= LieLowerCentralSeries( L ); 149 return Dimension( D[ Length( D ) ] ) = 0; 150 end ); 151 152 153InstallTrueMethod( IsLieNilpotent, IsLieAbelian ); 154 155 156############################################################################# 157## 158#M IsLieAbelian( <L> ) . . . . . . . . . . . . . . for a Lie algebra 159## 160## It is of course sufficient to check products of algebra generators, 161## no basis and structure constants of <L> are needed. 162## But if we have already a structure constants table we use it. 163## 164InstallMethod( IsLieAbelian, 165 "for a Lie algebra with known basis", 166 true, 167 [ IsAlgebra and IsLieAlgebra and HasBasis ], 0, 168 function( L ) 169 170 local B, # basis of `L' 171 T, # structure constants table w.r.t. `B' 172 i, # loop variable 173 j; # loop variable 174 175 B:= Basis( L ); 176 if not HasStructureConstantsTable( B ) then 177 TryNextMethod(); 178 fi; 179 180 T:= StructureConstantsTable( B ); 181 for i in T{ [ 1 .. Length( T ) - 2 ] } do 182 for j in i do 183 if not IsEmpty( j[1] ) then 184 return false; 185 fi; 186 od; 187 od; 188 return true; 189 end ); 190 191InstallMethod( IsLieAbelian, 192 "for a Lie algebra", 193 true, 194 [ IsAlgebra and IsLieAlgebra ], 0, 195 function( L ) 196 197 local i, # loop variable 198 j, # loop variable 199 zero, # zero of `L' 200 gens; # algebra generators of `L' 201 202 zero:= Zero( L ); 203 gens:= GeneratorsOfAlgebra( L ); 204 for i in [ 1 .. Length( gens ) ] do 205 for j in [ 1 .. i-1 ] do 206 if gens[i] * gens[j] <> zero then 207 return false; 208 fi; 209 od; 210 od; 211 212 # The algebra multiplication is trivial, and the algebra does 213 # not know about a basis. 214 # Here we know at least that the algebra generators are space 215 # generators. 216 if not HasGeneratorsOfLeftModule( L ) then 217 SetGeneratorsOfLeftModule( L, gens ); 218 fi; 219 220 # Return the result. 221 return true; 222 end ); 223 224InstallTrueMethod( IsLieAbelian, IsAlgebra and IsZeroMultiplicationRing ); 225 226 227############################################################################## 228## 229#M LieCentre( <L> ) . . . . . . . . . . . . . . . . . . . for a Lie algebra 230## 231## We solve the system 232## $\sum_{i=1}^n a_i c_{ijk} = 0$ for $1 \leq j, k \leq n$ 233## (instead of $\sum_{i=1}^n a_i ( c_{ijk} - c_{jik} ) = 0$). 234## 235## Additionally we know that the centre of a Lie algebra is an ideal. 236## 237InstallMethod( LieCentre, 238 "for a Lie algebra", 239 true, 240 [ IsAlgebra and IsLieAlgebra ], 0, 241 function( A ) 242 243 local R, # left acting domain of `A' 244 C, # Lie centre of `A', result 245 B, # a basis of `A' 246 T, # structure constants table w.r. to `B' 247 n, # dimension of `A' 248 M, # matrix of the equation system 249 zerovector, # 250 i, j, # loop over ... 251 row; # one row of `M' 252 253 R:= LeftActingDomain( A ); 254 255 if Characteristic( R ) <> 2 and HasCentre( A ) then 256 257 C:= Centre( A ); 258#T change it to an ideal! 259 260 else 261 262 # Catch the trivial case. 263 n:= Dimension( A ); 264 if n = 0 then 265 return A; 266 fi; 267 268 # Construct the equation system. 269 B:= Basis( A ); 270 T:= StructureConstantsTable( B ); 271 M:= []; 272 zerovector:= [ 1 .. n*n ] * Zero( R ); 273 for i in [ 1 .. n ] do 274 row:= ShallowCopy( zerovector ); 275 for j in [ 1 .. n ] do 276 if IsBound( T[i][j] ) then 277 row{ (j-1)*n + T[i][j][1] }:= T[i][j][2]; 278 fi; 279 od; 280 M[i]:= row; 281 od; 282 283 # Solve the equation system. 284 M:= NullspaceMat( M ); 285 286 # Get the generators from the coefficient vectors. 287 M:= List( M, x -> LinearCombination( B, x ) ); 288 289 # Construct the Lie centre. 290 C:= IdealNC( A, M, "basis" ); 291 292 fi; 293 294 # Return the Lie centre. 295 return C; 296 end ); 297 298 299############################################################################## 300## 301#M LieCentralizer( <A>, <S> ) . . . . . for a Lie algebra and a vector space 302## 303## Let $(b_1, \ldots, b_n)$ be a basis of <A>, and $(s_1, \ldots, s_m)$ 304## be a basis of <S>, with $s_j = \sum_{l=1}^m v_{jl} b_l$. 305## The structure constants of <A> are $c_{ijk}$ with 306## $b_i b_j = \sum_{k=1}^n c_{ijk} b_k$. 307## Then we compute a basis of the solution space of the system 308## $\sum_{i=1}^n a_i \sum_{l=1}^m v_{jl} c_{ilk} = 0$ for 309## $1 \leq j \leq m$ and $1 \leq k \leq n$. 310## 311## (left null space of an $n \times (nm)$ matrix) 312## 313InstallMethod( LieCentralizer, 314 "for an abelian Lie algebra and a vector space", 315 IsIdenticalObj, 316 [ IsAlgebra and IsLieAlgebra and IsLieAbelian, 317 IsVectorSpace ], 0, 318 function( A, S ) 319 320 if IsSubset( A, S ) then 321 return A; 322 else 323 TryNextMethod(); 324 fi; 325 end ); 326 327InstallMethod( LieCentralizer, 328 "for a Lie algebra and a vector space", 329 IsIdenticalObj, 330 [ IsAlgebra and IsLieAlgebra, IsVectorSpace ], 0, 331 function( A, S ) 332 333 local R, # left acting domain of `A' 334 B, # basis of `A' 335 T, # structure constants table w. r. to `B' 336 n, # dimension of `A' 337 m, # dimension of `S' 338 M, # matrix of the equation system 339 v, # coefficients of basis vectors of `S' w.r. to `B' 340 zerovector, # initialize one row of `M' 341 row, # one row of `M' 342 i, j, k, l, # loop variables 343 cil, # 344 offset, 345 vjl, 346 pos; 347 348 # catch trivial case 349 if Dimension(S) = 0 then 350 return A; 351 fi; 352 353 R:= LeftActingDomain( A ); 354 B:= Basis( A ); 355 T:= StructureConstantsTable( B ); 356 n:= Dimension( A ); 357 m:= Dimension( S ); 358 M:= []; 359 v:= List( BasisVectors( Basis( S ) ), 360 x -> Coefficients( B, x ) ); 361 362 zerovector:= [ 1 .. n*m ] * Zero( R ); 363 364 # Column $(j-1)*n + k$ contains in row $i$ the value 365 # $\sum_{l=1}^m v_{jl} c_{ilk}$ 366 367 for i in [ 1 .. n ] do 368 row:= ShallowCopy( zerovector ); 369 for l in [ 1 .. n ] do 370 cil:= T[i][l]; 371 for j in [ 1 .. m ] do 372 offset := (j-1)*n; 373 vjl := v[j][l]; 374 for k in [ 1 .. Length( cil[1] ) ] do 375 pos:= cil[1][k] + offset; 376 row[ pos ]:= row[ pos ] + vjl * cil[2][k]; 377 od; 378 od; 379 od; 380 Add( M, row ); 381 od; 382 383 # Solve the equation system. 384 M:= NullspaceMat( M ); 385 386 # Construct the generators from the coefficient vectors. 387 M:= List( M, x -> LinearCombination( B, x ) ); 388 389 # Return the subalgebra. 390 391 return SubalgebraNC( A, M, "basis" ); 392 393 end ); 394 395 396############################################################################## 397## 398#M LieNormalizer( <L>, <U> ) . . . . . . for a Lie algebra and a vector space 399## 400## If $(x_1, \ldots, x_n)$ is a basis of $L$ and $(u_1, \ldots, u_s)$ is 401## a basis of $U$, then $x = \sum_{i=1}^n a_i x_i$ is an element of $N_L(U)$ 402## iff $[x,u_j] = \sum_{k=1}^s b_{j,k} u_k$ for $j = 1, \ldots, s$. 403## This leads to a set of $n s$ equations for the $n + s^2$ unknowns $a_i$ 404## and $b_{jk}$. 405## If $u_k= \sum_{l=1}^n v_{kl} x_l$, then these equations can be written as 406## $\sum_{i=1}^n (\sum_{j=1}^n v_{lj} c_{ijk} a_i - 407## \sum_{i=1}^s v_{ik} b_{li} = 0$, 408## for $1 \leq k \leq n$ and $1 \leq j \leq s$, 409## where the $c_{ilp}$ are the structure constants of $L$. 410## From the solution we only need the "normalizer part" (i.e., 411## the $a_i$ part). 412## 413InstallMethod( LieNormalizer, 414 "for a Lie algebra and a vector space", 415 IsIdenticalObj, 416 [ IsAlgebra and IsLieAlgebra, IsVectorSpace ], 0, 417 function( L, U ) 418 419 local R, # left acting domain of `L' 420 B, # a basis of `L' 421 T, # the structure constants table of `L' w.r.t. `B' 422 n, # the dimension of `L' 423 s, # the dimension of `U' 424 A, # the matrix of the equation system 425 i, j, k, l, # loop variables 426 v, # the coefficients of the basis of `U' wrt `B' 427 cij, 428 bas, 429 b, 430 pos; 431 432 # catch trivial case 433 if Dimension(U) = 0 then 434 return L; 435 fi; 436 437 # We need not work if `U' knows to be an ideal in its parent `L'. 438 if HasParent( U ) and IsIdenticalObj( L, Parent( U ) ) 439 and HasIsLeftIdealInParent( U ) and IsLeftIdealInParent( U ) then 440 return L; 441 fi; 442 443 R:= LeftActingDomain( L ); 444 B:= Basis( L ); 445 T:= StructureConstantsTable( B ); 446 n:= Dimension( L ); 447 s:= Dimension( U ); 448 449 if s = 0 or n = 0 then 450 return L; 451 fi; 452 453 v:= List( BasisVectors( Basis( U ) ), 454 x -> Coefficients( B, x ) ); 455 456 # The equations. 457 # First the normalizer part, \ldots 458 459 A:= NullMat( n + s*s, n*s, R ); 460 for i in [ 1..n ] do 461 for j in [ 1..n ] do 462 cij:= T[i][j]; 463 for l in [ 1..s ] do 464 for k in [ 1..Length( cij[1] ) ] do 465 pos:= (l-1)*n+cij[1][k]; 466 A[i][pos]:= A[i][pos]+v[l][j]*cij[2][k]; 467 od; 468 od; 469 od; 470 od; 471 472 # \ldots and then the "superfluous" part. 473 474 for k in [1..n] do 475 for l in [1..s] do 476 for i in [1..s] do 477 A[ n+(l-1)*s+i ][ (l-1)*n+k ]:= -v[i][k]; 478 od; 479 od; 480 od; 481 482 # Solve the equation system. 483 b:= NullspaceMat(A); 484 485 # Extract the `normalizer part' of the solution. 486 l:= Length(b); 487 bas:= NullMat( l, n, R ); 488 for i in [ 1..l ] do 489 for j in [ 1..n ] do 490 bas[i][j]:= b[i][j]; 491 od; 492 od; 493 494 # Construct the generators from the coefficients list. 495 bas:= List( bas, x -> LinearCombination( B, x ) ); 496 497 # Return the subalgebra. 498 return SubalgebraNC( L, bas, "basis" ); 499 end ); 500 501 502############################################################################## 503## 504#M KappaPerp( <L>, <U> ) . . . . . . . . for a Lie algebra and a vector space 505## 506#T Should this better be `OrthogonalSpace( <F>, <U> )' where <F> is a 507#T bilinear form? 508#T How to represent forms in GAP? 509#T (Clearly the form must know about the space <L>.) 510## 511## If $(x_1,\ldots, x_n)$ is a basis of $L$ and $(u_1,\ldots, u_s)$ is a 512## basis of $U$ such that $u_k = \sum_{j=1}^n v_{kj} x_j$ then an element 513## $x = \sum_{i=1}^n a_i x_i$ is an element of $U^{\perp}$ iff the $a_i$ 514## satisfy the equations 515## $\sum_{i=1}^n ( \sum_{j=1}^n v_{kj} \kappa(x_i,x_j) ) a_i = 0$ for 516## $k = 1, \ldots, s$. 517## 518InstallMethod( KappaPerp, 519 "for a Lie algebra and a vector space", 520 IsIdenticalObj, 521 [ IsAlgebra and IsLieAlgebra, IsVectorSpace ], 0, 522 function( L, U ) 523 524 local R, # left acting domain of `L' 525 B, # a basis of L 526 kap, # the matrix of the Killing form w.r.t. `B' 527 A, # the matrix of the equation system 528 n, # the dimension of L 529 s, # the dimension of U 530 v, # coefficient list of the basis of U w.r.t. the basis of L 531 i,j,k, # loop variables 532 bas; # the basis of the solution space 533 534 R:= LeftActingDomain( L ); 535 B:= Basis( L ); 536 n:= Dimension( L ); 537 s:= Dimension( U ); 538 539 if s = 0 or n = 0 then 540 return L; 541 fi; 542 543 v:= List( BasisVectors( Basis( U ) ), 544 x -> Coefficients( B, x ) ); 545 A:= NullMat( n, s, R ); 546 kap:= KillingMatrix( B ); 547 548 # Compute the equations that define the subspace. 549 for k in [ 1..s ] do 550 for i in [ 1..n ] do 551 for j in [ 1..n ] do 552 A[i][k]:= A[i][k] + v[k][j] * kap[i][j]; 553 od; 554 od; 555 od; 556 557 # Solve the equation system. 558 bas:= NullspaceMat( A ); 559 560 # Extract the generators. 561 bas:= List( bas, x -> LinearCombination( B, x ) ); 562 563 return SubspaceNC( L, bas, "basis" ); 564 565 end ); 566 567 568############################################################################# 569## 570#M AdjointMatrix( <B>, <x> ) 571## 572## If the basis vectors are $(b-1, b_2, \ldots, b_n)$, and 573## $x = \sum_{i=1}^n x_i b_i$ then $b_j$ is mapped to 574## $[ x, b_j ] = \sum_{i=1}^n x_i [ b_i b_j ] 575## = \sum_{k=1}^n ( \sum_{i=1}^n x_i c_{ijk} ) b_k$, 576## so the entry in the $k$-th row and the $j$-th column of the adjoint 577## matrix is $\sum_{i=1}^n x_i c_{ijk}$. 578## 579## Note that $ad_x$ is a left multiplication, so also the action of the 580## adjoint matrix is from the left (i.e., on column vectors). 581## 582InstallMethod( AdjointMatrix, 583 "for a basis of a Lie algebra, and an element", 584 IsCollsElms, 585 [ IsBasis, IsRingElement ], 0, 586 function( B, x ) 587 588 local n, # dimension of the algebra 589 T, # structure constants table w.r. to `B' 590 zerovector, # zero of the field 591 M, # adjoint matrix, result 592 j, i, l, # loop variables 593 cij, # structure constants vector 594 k, # one position in structure constants vector 595 row; # one row of `M' 596 597 x:= Coefficients( B, x ); 598 n:= Length( BasisVectors( B ) ); 599 T:= StructureConstantsTable( B ); 600 zerovector:= [ 1 .. n ] * T[ Length( T ) ]; 601 M:= []; 602 for j in [ 1 .. n ] do 603 row:= ShallowCopy( zerovector ); 604 for i in [ 1 .. n ] do 605 cij:= T[i][j]; 606 for l in [ 1 .. Length( cij[1] ) ] do 607 k:= cij[1][l]; 608 row[k]:= row[k] + x[i] * cij[2][l]; 609 od; 610 od; 611 M[j]:= row; 612 od; 613 614 return TransposedMat( M ); 615 end ); 616 617#T general function for arbitrary algebras? (right/left multiplication) 618#T RegularRepresentation: right multiplication satisfies M_{xy} = M_x M_y 619#T is just the negative of the adjoint ... 620 621 622############################################################################# 623## 624#M RightDerivations( <B> ) 625## 626## Let $n$ be the dimension of $A$. 627## We start with $n^2$ indeterminates $D = [ d_{i,j} ]_{i,j}$ which 628## means that $D$ maps $b_i$ to $\sum_{j=1}^n d_{ij} b_j$. 629## 630## (Note that this is row convention.) 631## 632## This leads to the following linear equation system in the $d_{ij}$. 633## $\sum_{k=1}^n ( c_{ijk} d_{km} - c_{kjm} d_{ik} - c_{ikm} d_{jk} ) = 0$ 634## for all $1 \leq i, j, m \leq n$. 635## The solution of this system gives us a vector space basis of the 636## algebra of derivations. 637## 638InstallMethod( RightDerivations, 639 "method for a basis of an algebra", 640 true, 641 [ IsBasis ], 0, 642 function( B ) 643 644 local T, # structure constants table w.r. to 'B' 645 L, # underlying Lie algebra 646 R, # left acting domain of 'L' 647 n, # dimension of 'L' 648 eqno,offset, 649 A, 650 i, j, k, m, 651 M; # the Lie algebra of derivations 652 653 if not IsAlgebra( UnderlyingLeftModule( B ) ) then 654 Error( "<B> must be a basis of an algebra" ); 655 fi; 656 657 if IsLieAlgebra( UnderlyingLeftModule( B ) ) then 658 offset:= 1; 659 else 660 offset:= 0; 661 fi; 662 663 T:= StructureConstantsTable( B ); 664 L:= UnderlyingLeftModule( B ); 665 R:= LeftActingDomain( L ); 666 n:= Dimension( L ); 667 668 if n = 0 then 669 return NullAlgebra( R ); 670 fi; 671 672 # The rows in the matrix of the equation system are indexed 673 # by the $d_{ij}$; the $((i-1) n + j)$-th row belongs to $d_{ij}$. 674 675 # Construct the equation system. 676 if offset = 1 then 677 A:= NullMat( n^2, (n-1)*n*n/2, R ); 678 else 679 A:= NullMat( n^2, n^3, R ); 680 fi; 681 eqno:= 0; 682 for i in [ 1 .. n ] do 683 for j in [ offset*i+1 .. n ] do 684 for m in [ 1 .. n ] do 685 eqno:= eqno+1; 686 for k in [ 1 .. n ] do 687 A[ (k-1)*n+m ][eqno]:= A[ (k-1)*n+m ][eqno] + 688 SCTableEntry( T,i,j,k ); 689 A[ (i-1)*n+k ][eqno]:= A[ (i-1)*n+k ][eqno] - 690 SCTableEntry( T,k,j,m ); 691 A[ (j-1)*n+k ][eqno]:= A[ (j-1)*n+k ][eqno] - 692 SCTableEntry( T,i,k,m ); 693 od; 694 od; 695 od; 696 od; 697 698 # Solve the equation system. 699 # Note that if `L' is a Lie algebra and $n = 1$ the matrix is empty. 700 701 if n = 1 and offset = 1 then 702 A:= [ [ One( R ) ] ]; 703 else 704 A:= NullspaceMatDestructive( A ); 705 fi; 706 707 # Construct the generating matrices from the vectors. 708 A:= List( A, v -> List( [ 1 .. n ], 709 i -> v{ [ (i-1)*n + 1 .. i*n ] } ) ); 710 711 # Construct the Lie algebra. 712 if IsEmpty( A ) then 713 M:= AlgebraByGenerators( R, [], 714 LieObject( Immutable( NullMat( n, n, R ) ) ) ); 715 else 716 A:= List( A, LieObject ); 717 M:= AlgebraByGenerators( R, A ); 718 UseBasis( M, A ); 719 fi; 720 721 # Return the derivations. 722 return M; 723end ); 724 725 726############################################################################# 727## 728#M LeftDerivations( <B> ) 729## 730## Let $n$ be the dimension of $A$. 731## We start with $n^2$ indeterminates $D = [ d_{i,j} ]_{i,j}$ which 732## means that $D$ maps $b_i$ to $\sum_{j=1}^n d_{ji} b_j$. 733## 734## (Note that this is column convention.) 735## 736InstallMethod( LeftDerivations, 737 "method for a basis of an algebra", 738 true, 739 [ IsBasis ], 0, 740 function( B ) 741 742 local T, # structure constants table w.r. to 'B' 743 L, # underlying Lie algebra 744 R, # left acting domain of 'L' 745 n, # dimension of 'L' 746 eqno,offset, 747 A, 748 i, j, k, m, 749 M; # the Lie algebra of derivations 750 751 if not IsAlgebra( UnderlyingLeftModule( B ) ) then 752 Error( "<B> must be a basis of an algebra" ); 753 fi; 754 755 if IsLieAlgebra( UnderlyingLeftModule( B ) ) then 756 offset:= 1; 757 else 758 offset:= 0; 759 fi; 760 761 T:= StructureConstantsTable( B ); 762 L:= UnderlyingLeftModule( B ); 763 R:= LeftActingDomain( L ); 764 n:= Dimension( L ); 765 766 if n = 0 then 767 return NullAlgebra( R ); 768 fi; 769 770 # The rows in the matrix of the equation system are indexed 771 # by the $d_{ij}$; the $((i-1) n + j)$-th row belongs to $d_{ij}$. 772 773 # Construct the equation system. 774 if offset = 1 then 775 A:= NullMat( n^2, (n-1)*n*n/2, R ); 776 else 777 A:= NullMat( n^2, n^3, R ); 778 fi; 779 eqno:= 0; 780 for i in [ 1 .. n ] do 781 for j in [ offset*i+1 .. n ] do 782 for m in [ 1 .. n ] do 783 eqno:= eqno+1; 784 for k in [ 1 .. n ] do 785 A[ (m-1)*n+k ][eqno]:= A[ (m-1)*n+k ][eqno] + 786 SCTableEntry( T,i,j,k ); 787 A[ (k-1)*n+i ][eqno]:= A[ (k-1)*n+i ][eqno] - 788 SCTableEntry( T,k,j,m ); 789 A[ (k-1)*n+j ][eqno]:= A[ (k-1)*n+j ][eqno] - 790 SCTableEntry( T,i,k,m ); 791 od; 792 od; 793 od; 794 od; 795 796 # Solve the equation system. 797 # Note that if `L' is a Lie algebra and $n = 1$ the matrix is empty. 798 799 if n = 1 and offset = 1 then 800 A:= [ [ One( R ) ] ]; 801 else 802 A:= NullspaceMatDestructive( A ); 803 fi; 804 805 # Construct the generating matrices from the vectors. 806 A:= List( A, v -> List( [ 1 .. n ], 807 i -> v{ [ (i-1)*n + 1 .. i*n ] } ) ); 808 809 # Construct the Lie algebra. 810 if IsEmpty( A ) then 811 M:= AlgebraByGenerators( R, [], 812 LieObject( Immutable( NullMat( n, n, R ) ) ) ); 813 else 814 A:= List( A, LieObject ); 815 M:= AlgebraByGenerators( R, A ); 816 UseBasis( M, A ); 817 fi; 818 819 # Return the derivations. 820 return M; 821end ); 822 823 824 825############################################################################# 826## 827#M KillingMatrix( <B> ) 828## 829## We have $\kappa_{i,j} = \sum_{k,l=1}^n c_{jkl} c_{ilk}$ if $c_{ijk}$ 830## are the structure constants w.r. to <B>. 831## 832## (The matrix is symmetric, no matter whether the multiplication is 833## (anti-)symmetric.) 834## 835InstallMethod( KillingMatrix, 836 "for a basis of a Lie algebra", 837 true, 838 [ IsBasis ], 0, 839 function( B ) 840 841 local T, # s.c. table w.r. to `B' 842 L, # the underlying algebra 843 R, # left acting domain of `L' 844 kappa, # the matrix of the killing form, result 845 n, # dimension of `L' 846 zero, # the zero of `R' 847 i, j, k, t, # loop variables 848 row, # one row of `kappa' 849 val, # one entry of `kappa' 850 cjk; # `T[j][k]' 851 852 T:= StructureConstantsTable( B ); 853 L:= UnderlyingLeftModule( B ); 854 R:= LeftActingDomain( L ); 855 n:= Dimension( L ); 856 kappa:= []; 857 zero:= Zero( R ); 858 859 for i in [ 1 .. n ] do 860 row:= []; 861 for j in [ 1 .. i ] do 862 863 val:= zero; 864 for k in [ 1 .. n ] do 865 cjk:= T[j][k]; 866 for t in [ 1 .. Length( cjk[1] ) ] do 867 val:= val + cjk[2][t] * SCTableEntry( T, i, cjk[1][t], k ); 868 od; 869 od; 870 row[j]:= val; 871 if i <> j then 872 kappa[j][i]:= val; 873 fi; 874 875 od; 876 kappa[i]:= row; 877 878 od; 879 880 # Return the result. 881 return kappa; 882 end ); 883 884 885############################################################################## 886## 887#M AdjointBasis( <B> ) 888## 889## The input is a basis of a (Lie) algebra $L$. 890## This function returns a particular basis $C$ of the matrix space generated 891## by $ad L$, namely a basis consisting of elements of the form $ad x_i$ 892## where $x_i$ is a basis element of <B>. 893## An extra component `indices' is added to this space. 894## This is a list of integers such that `ad <B>.basisVectors[ indices[i] ]' 895## is the `i'-th basis vector of <C>, for i in [1..Length(indices)]. 896## (This list is added in order to be able to identify the basis element of 897## <B> with the property that its adjoint matrix is equal to a given basis 898## vector of <C>.) 899## 900InstallMethod( AdjointBasis, 901 "for a basis of a Lie algebra", 902 true, 903 [ IsBasis ], 0, 904 function( B ) 905 906 local bb, # the basis vectors of `B' 907 n, # the dimension of `B' 908 F, # the field over which the algebra is defined 909 adL, # a list of matrices that form a basis of adLsp 910 adLsp, # the matrix space spanned by ad L 911 inds, # the list of indices 912 i, # loop variable 913 adi, # the adjoint matrix of the i-th basis vector of `B' 914 adLbas; # the basis of `adLsp' compatible with `adL' 915 916 bb:= BasisVectors( B ); 917 n:= Length( bb ); 918 F:= LeftActingDomain( UnderlyingLeftModule( B ) ); 919 adL:= []; 920 adLsp:= MutableBasis( F, [ NullMat(n,n,F) ] ); 921#T better declare the zero ? 922 inds:= []; 923 for i in [1..n] do 924 adi:= AdjointMatrix( B, bb[i] ); 925 if not IsContainedInSpan( adLsp, adi ) then 926 Add( adL, adi ); 927 Add( inds, i ); 928 CloseMutableBasis( adLsp, adi ); 929 fi; 930 od; 931 932 if adL = [ ] then 933 adLbas:= Basis( VectorSpace( F, [ ], NullMat( n, n, F ) ) ); 934 else 935 adLbas:= Basis( VectorSpace( F, adL ), adL ); 936 fi; 937 938 SetIndicesOfAdjointBasis( adLbas, inds ); 939 940 return adLbas; 941 end ); 942 943 944############################################################################## 945## 946#M IsRestrictedLieAlgebra( <L> ) . . . . . . . . . . . . . for a Lie algebra 947## 948## A Lie algebra <L> is defined to be {\em restricted} when it is defined 949## over a field of characteristic $p \neq 0$, and for every basis element 950## $x$ of <L> there exists $y\in <L>$ such that $(ad x)^p = ad y$ 951## (see Jacobson, p. 190). 952## 953InstallMethod( IsRestrictedLieAlgebra, 954 "for a Lie algebra", 955 true, 956 [ IsAlgebra and IsLieAlgebra ], 0, 957 function( L ) 958 959 local F, # the field over which L is defined 960 B, # the basis of L 961 p, # the characteristic of F 962 adL, # basis for the (matrix) vector space generated by ad L 963 v; # loop over basis vectors of adL 964 965 F:= LeftActingDomain( L ); 966 p:= Characteristic( F ); 967 if p = 0 then 968 return false; 969 fi; 970 971 B:= Basis( L ); 972 973 adL:= AdjointBasis( B ); 974 975 # Check if ad(L) is closed under the p-th power operation. 976 for v in BasisVectors( adL ) do 977 if not v^p in UnderlyingLeftModule( adL ) then 978 return false; 979 fi; 980 od; 981 982 return true; 983 end ); 984 985 986############################################################################# 987## 988#F PowerSi( <F>, <i> ) 989## 990InstallGlobalFunction( PowerSi, function( F, i ) 991 992 local si, # a function of two arguments: seqs, a list of sequences, 993 # and l, a list containing the two arguments of the 994 # function s_i. The list seqs contains 995 # all possible sequences of i-1 1's and p-2-i+1 2's 996 # This function returns the value of s_i(l[1],l[2]) 997 j,k, # loop variables 998 p, # the characteristic of F 999 combs, # the list of all i-1 element subsets of {1,2,\ldots, p-2} 1000 # it serves to make the list seqs 1001 v, # a vector of 1's and 2's 1002 seqs; # the list of all sequences of 1's and 2's of length p-2, 1003 # with i-1 1's and p-2 2's serving as input for si 1004 # for example, the sequence [1,1,2] means the element 1005 # [[[[x,y],x],x],y] (the first element [x,y] is present 1006 # 1 1 2 in all terms of the sum s_i(x,y)). 1007 1008 si:= function( seqs, l ) 1009 1010 local x, 1011 j,k, 1012 sum; 1013 1014 for j in [1..Length(seqs)] do 1015 x:= l[1]*l[2]; 1016 for k in seqs[j] do 1017 x:= x*l[k]; 1018 od; 1019 if j=1 then 1020 sum:= x; 1021 else 1022 sum:= sum+x; 1023 fi; 1024 od; 1025 return ( i * One( F ) )^(-1)*sum; 1026 end; 1027 1028 p:= Characteristic( F ); 1029 combs:= Combinations( [1..p-2], i-1 ); 1030 1031 # Now all sequences of 1's and 2's of length p and containing i-1 1's 1032 # are constructed the 1's in the jth sequence are put at the positions 1033 # contained in combs[j]. 1034 seqs:=[]; 1035 for j in [1..Length( combs )] do 1036 v:= List( [1..p-2], x -> 2); 1037 for k in combs[j] do 1038 v[k]:= 1; 1039 od; 1040 Add( seqs, v ); 1041 od; 1042 return arg -> si( seqs, arg ); 1043end ); 1044 1045 1046############################################################################# 1047## 1048#F PowerS( <L> ) 1049## 1050InstallMethod( PowerS, 1051 "for a Lie algebra", 1052 true, 1053 [ IsLieAlgebra ], 0, 1054 function( L ) 1055 1056 local F, # the coefficients domain 1057 p; # the characteristic of `F' 1058 1059 F:= LeftActingDomain( L ); 1060 p:= Characteristic( F ); 1061 return List( [ 1 .. p-1 ], i -> PowerSi( F , i ) ); 1062 end ); 1063 1064 1065############################################################################## 1066## 1067#F PthPowerImage( <B>, <x> ) 1068## 1069BindGlobal("PTHPOWERIMAGE_PPI_VEC", function(L,zero,p,bv,pmap,cf,x) 1070 local 1071 n, # the dimension of L 1072 s, # the list of s_i functions 1073 im, # the image of x under the p-th power map 1074 i,j; # loop variables 1075 1076 n:= Dimension( L ); 1077 s:= PowerS( L ); 1078 im:= Zero( L ); 1079 1080 # First the sum of all $\alpha_i^p x_i^{[p]}$ is calculated. 1081 for i in [1..n] do 1082 im:= im + cf[i]^p * pmap[i]; 1083 od; 1084 1085 # To this the double sum of all 1086 # $s_i(\alpha_j x_j, \sum_{k=j+1}^n \alpha_k x_k)$ 1087 # is added. 1088 for j in [1..n-1] do 1089 if cf[j] <> zero then 1090 x:= x - cf[j] * bv[j]; 1091 for i in [1..p-1] do 1092 im:= im + s[i]( [cf[j]*bv[j],x] ); 1093 od; 1094 fi; 1095 od; 1096 1097 return im; 1098end); 1099 1100InstallMethod( PthPowerImage, 1101 "for a basis of an algebra, and a ring element", 1102 IsCollsElms, 1103 [ IsBasis, IsRingElement ], 0, 1104 function( B, x ) 1105 1106 local L, # the Lie algebra of which B is a basis 1107 F, # the coefficients domain of `L' 1108 n, # the dimension of L 1109 p, # the characteristic of the ground field 1110 s, # the list of s_i functions 1111 pmap, # the list containing x_i^{[p]} 1112 cf, # the coefficients of x wrt the basis of L 1113 im, # the image of x under the p-th power map 1114 i,j, # loop variables 1115 zero, # zero of `F' 1116 bv, # basis vectors of `B' 1117 adx, # adjoint matrix of x 1118 adL; # a basis of the matrix space ad L 1119 1120 L:= UnderlyingLeftModule( B ); 1121 if not IsLieAlgebra( L ) then 1122 TryNextMethod(); 1123 fi; 1124 1125 F:= LeftActingDomain( L ); 1126 p:= Characteristic( F ); 1127 1128 if Dimension( LieCentre( L ) ) = 0 then 1129 1130 # We calculate the inverse image $ad^{-1} ((ad x)^p)$. 1131 adx:= AdjointMatrix( B, x ); 1132 adL:= AdjointBasis( B ); 1133 adx:= adx^p; 1134 cf:= Coefficients( adL, adx ); 1135 return LinearCombination( B, cf ); 1136 1137 else 1138 return PTHPOWERIMAGE_PPI_VEC(L,Zero(F),p,BasisVectors(B),PthPowerImages(B),Coefficients(B,x),x); 1139 fi; 1140 end ); 1141 1142InstallMethod( PthPowerImage, "for an element of a restricted Lie algebra", 1143 [ IsJacobianElement ], # weaker filter, we maybe only discovered later 1144 # that the algebra is restricted 1145 function(x) 1146 local fam; 1147 fam := FamilyObj(x); 1148 if not IsBound(fam!.pMapping) then TryNextMethod(); fi; 1149 return PTHPOWERIMAGE_PPI_VEC(fam!.fullSCAlgebra,fam!.zerocoeff,Characteristic(fam),fam!.basisVectors,fam!.pMapping,ExtRepOfObj(x),x); 1150end); 1151 1152InstallMethod( PthPowerImage, "for an element of a restricted Lie algebra and an integer", 1153 [ IsJacobianElement, IsInt ], 1154 function(x,n) 1155 local fam; 1156 fam := FamilyObj(x); 1157 if not IsBound(fam!.pMapping) then TryNextMethod(); fi; 1158 while n>0 do 1159 x := PTHPOWERIMAGE_PPI_VEC(fam!.fullSCAlgebra,fam!.zerocoeff,Characteristic(fam),fam!.basisVectors,fam!.pMapping,ExtRepOfObj(x),x); 1160 n := n-1; 1161 od; 1162 return x; 1163end); 1164 1165InstallMethod( PClosureSubalgebra, "for a subalgebra of restricted jacobian elements", 1166 [ IsLieAlgebra and IsJacobianElementCollection ], 1167 function(A) 1168 local i, p, oldA; 1169 1170 repeat 1171 oldA := A; 1172 for i in Basis(oldA) do 1173 A := ClosureLeftModule(A,PthPowerImage(i)); 1174 od; 1175 until A=oldA; 1176 return A; 1177end); 1178 1179############################################################################# 1180## 1181#M PthPowerImages( <B> ) . . . . . . . . . . . for a basis of a Lie algebra 1182## 1183InstallMethod( PthPowerImages, 1184 "for a basis of a Lie algebra", 1185 true, 1186 [ IsBasis ], 0, 1187 function( B ) 1188 1189 local L, # the underlying algebra 1190 p, # the characteristic of `L' 1191 adL, # a basis of the matrix space spanned by ad L 1192 basL; # the list of basis vectors `b' of `B' such that 1193 # `ad b' is a basis vector of `adL' 1194 1195 L:= UnderlyingLeftModule( B ); 1196 if not IsRestrictedLieAlgebra( L ) then 1197 Error( "<L> must be a restricted Lie algebra" ); 1198 fi; 1199 1200 p:= Characteristic( LeftActingDomain( L ) ); 1201 1202 adL:= AdjointBasis( B ); 1203 1204 if Dimension( UnderlyingLeftModule( adL ) ) = 0 then 1205 1206 # The algebra is abelian. 1207 return List( BasisVectors( B ), x -> Zero( L ) ); 1208 1209 fi; 1210 1211 # Now `IndicesOfAdjointBasis( adL )' is a list of indices with `i'-th 1212 # entry the position of the basis vector of `B' 1213 # whose adjoint matrix is the `i'-th basis vector of `adL'. 1214 basL:= BasisVectors( B ){ IndicesOfAdjointBasis( adL ) }; 1215 1216 # We calculate the coefficients of $x_i^{[p]}$ wrt the basis basL. 1217 return List( BasisVectors( B ), 1218 x -> Coefficients( adL, AdjointMatrix( B, x ) ^ p ) * basL ); 1219#T And why do you compute the adjoint matrices again? 1220#T Aren't they stored as basis vectors in adL ? 1221 end ); 1222 1223 1224############################################################################ 1225## 1226#M CartanSubalgebra( <L> ) 1227## 1228## A Cartan subalgebra of the Lie algebra <L> is by definition a nilpotent 1229## subalgebra equal to its own normalizer in <L>. 1230## 1231## By defintion, an Engel subalgebra of <L> is the generalized eigenspace 1232## of a non nilpotent element, corresponding to the eigenvalue 0. 1233## In a restricted Lie algebra of characteristic p we have that every Cartan 1234## subalgebra of an Engel subalgebra of <L> is a Cartan subalgebra of <L>. 1235## Hence in this case we construct a decreasing series of Engel subalgebras. 1236## When it becomes stable we have found a Cartan subalgebra. 1237## On the other hand, when <L> is not restricted and is defined over a field 1238## $F$ of cardinality greater than the dimension of <L> we can proceed as 1239## follows. 1240## Let $a$ be a non nilpotent element of <L> and $K$ the corresponding 1241## Engel subalgebra. Furthermore, let $b$ be a non nilpotent element of $K$. 1242## Then there is an element $c \in F$ such that $a + c ( b - a )$ has an 1243## Engel subalgebra strictly contained in $K$ 1244## (see Humphreys, proof of Lemma A, p 79). 1245## 1246InstallMethod( CartanSubalgebra, 1247 "for a Lie algebra", 1248 true, 1249 [ IsLieAlgebra ], 0, 1250 function( L ) 1251 1252 local n, # the dimension of L 1253 F, # coefficients domain of `L' 1254 root, # prim. root of `F' if `F' is finite 1255 K, # a subalgebra of L (on termination a Cartan subalg.) 1256 a,b, # (non nilpotent) elements of L 1257 A, # matrix of the equation system (ad a)^n(x)=0 1258 bas, # basis of the solution space of Ax=0 1259 sp, # the subspace of L generated by bas 1260 found,ready, # boolean variables 1261 c, # an element of `F' 1262 newelt, # an element of L of the form a+c*(b-a) 1263 i; # loop variable 1264 1265 n:= Dimension(L); 1266 F:= LeftActingDomain( L ); 1267 1268 if IsRestrictedLieAlgebra( L ) then 1269 1270 K:= L; 1271 while true do 1272 1273 a:= NonNilpotentElement( K ); 1274 1275 if a = fail then 1276 # `K' is a nilpotent Engel subalgebra, hence a Cartan subalgebra. 1277 return K; 1278 fi; 1279 1280 # `a' is a non nilpotent element of `K'. 1281 # We construct the generalized eigenspace of this element w.r.t. 1282 # the eigenvalue 0. This is a subalgebra of `K' and of `L'. 1283 A:= TransposedMat( AdjointMatrix( Basis( K ), a)); 1284 A:= A ^ Dimension( K ); 1285 bas:= NullspaceMat( A ); 1286 bas:= List( bas, x -> LinearCombination( Basis( K ), x ) ); 1287 K:= SubalgebraNC( L, bas, "basis"); 1288 1289 od; 1290 1291 elif n < Size( F ) then 1292 1293 # We start with an Engel subalgebra. If it is nilpotent 1294 # then it is a Cartan subalgebra and we are done. 1295 # Otherwise we make it smaller. 1296 1297 a:= NonNilpotentElement( L ); 1298 1299 if a = fail then 1300 # `L' is nilpotent. 1301 return L; 1302 fi; 1303 1304 # `K' will be the Engel subalgebra corresponding to `a'. 1305 1306 A:= TransposedMat( AdjointMatrix( Basis( L ), a ) ); 1307 A:= A^n; 1308 bas:= NullspaceMat( A ); 1309 bas:= List( bas, x -> LinearCombination( Basis( L ), x ) ); 1310 K:= SubalgebraNC( L, bas, "basis"); 1311 1312 # We locate a nonnilpotent element in this Engel subalgebra. 1313 1314 b:= NonNilpotentElement( K ); 1315 1316 # If `b = fail' then `K' is nilpotent and we are done. 1317 ready:= ( b = fail ); 1318 1319 while not ready do 1320 1321 # We locate an element $a + c*(b-a)$ such that the Engel subalgebra 1322 # belonging to this element is smaller than the Engel subalgebra 1323 # belonging to `a'. 1324 # We do this by checking a few values of `c' 1325 # (At most `n' values of `c' will not yield a smaller subalgebra.) 1326 1327 sp:= VectorSpace( F, BasisVectors( Basis(K) ), "basis"); 1328 found:= false; 1329 if Characteristic( F ) = 0 then 1330 c:= 0; 1331 else 1332 root:= PrimitiveRoot( F ); 1333 c:= root; 1334 fi; 1335 while not found do 1336 1337 if Characteristic( F ) = 0 then 1338 c:= c+1; 1339 else 1340 c:= c*root; 1341 fi; 1342 newelt:= a+c*(b-a); 1343 1344 # Calculate the Engel subalgebra belonging to `newelt'. 1345 A:= TransposedMat( AdjointMatrix( Basis( K ), newelt ) ); 1346 A:= A^Dimension( K ); 1347 bas:= NullspaceMat( A ); 1348 bas:= List( bas, x -> LinearCombination( Basis( K ), x ) ); 1349 1350 # We have found a smaller subalgebra if the dimension is smaller 1351 # and new basis elements are contained in the old space. 1352 1353 found:= Length( bas ) < Dimension( K ); 1354 i:= 1; 1355 while i <= Length( bas ) and found do 1356 if not bas[i] in sp then 1357 found:= false; 1358 fi; 1359 i:= i+1; 1360 od; 1361 od; 1362 1363 a:= newelt; 1364 K:= SubalgebraNC( L, bas, "basis"); 1365 b:= NonNilpotentElement( K ); 1366 1367 # If `b = fail' then `K' is nilpotent and we are done. 1368 ready:= b = fail; 1369 1370 od; 1371 1372 return K; 1373 1374 else 1375 1376 # the field over which <L> is defined is too small 1377 TryNextMethod(); 1378 1379 fi; 1380 end ); 1381 1382 1383############################################################################## 1384## 1385#M AdjointAssociativeAlgebra( <L>, <K> ) 1386## 1387## This function calculates a basis of the associative matrix algebra 1388## generated by ad_L K, where <K> is a subalgebra of <L>. 1389## If {x_1,\ldots ,x_n} is a basis of K, then this algebra is spanned 1390## by all words 1391## ad x_{i_1}\cdots ad x_{i_t} 1392## where t>0. 1393## The degree of such a word is t. 1394## The algorithm first calculates a maximal linearly independent set 1395## of words of degree 1, then of degree 2 and so on. 1396## Since ad x ad y -ady ad x = ad [x,y], we have that we only have 1397## to consider words where i_1\leq i_2\leq \cdots \leq i_t. 1398## 1399InstallMethod( AdjointAssociativeAlgebra, 1400 "for a Lie algebra and a subalgebra", 1401 true, 1402 [ IsAlgebra and IsLieAlgebra, IsAlgebra and IsLieAlgebra ], 0, 1403 function( L, K ) 1404 1405 local n, # the dimension of L 1406 F, # the field of L 1407 asbas, # a list containing the basis elts. of the assoc. alg. 1408 highdeg, # a list of the elements of the highest degree computed 1409 # so far 1410 degree1, # a list of elements of degree 1 (i.e. ad x_i) 1411 lowinds, # a list of indices such that lowinds[i] is the smallest 1412 # index in the word highdeg[i] 1413 hdeg, # the new highdeg constructed each step 1414 linds, # the new lowinds constructed each step 1415 i,j,k, # loop variables 1416 ind, # an index 1417 m, # a matrix 1418 posits, # a list of positions in matrices: 1419 # posits[i] is a list of the form [p,q] such that 1420 # the matrix asbas[i] has a nonzero entry at position 1421 # [p][q] and furthermore the matrices asbas[j] with j>i 1422 # will have a zero at that position (so the basis 1423 # constructed will be in `upper triangular form') 1424 l1,l2, # loop variables 1425 found; # a boolean 1426 1427 F:= LeftActingDomain( L ); 1428 1429 if Dimension( K ) = 0 then 1430 return Algebra( F, [ [ [ Zero(F) ] ] ] ); 1431 elif IsLieAbelian( L ) then 1432 return Algebra( F, [ AdjointMatrix( Basis( L ), 1433 GeneratorsOfAlgebra( K )[1] ) ] ); 1434 fi; 1435 1436 n:= Dimension( L ); 1437 1438 # Initialisations that ensure that the first step of the loop will select 1439 # a maximal linearly independent set of matrices of degree 1. 1440 1441 degree1:= List( BasisVectors( Basis(K) ), 1442 x -> AdjointMatrix( Basis(L), x ) ); 1443 posits := [ [ 1, 1 ] ]; 1444 highdeg := [ IdentityMat( n, F ) ]; 1445 asbas := [ Immutable( highdeg[1] ) ]; 1446 lowinds := [ Dimension( K ) ]; 1447 1448 # If after some steps all words of degree t (say) can be reduced modulo 1449 # lower degree, then all words of degree >t can be reduced to linear 1450 # combinations of words of lower degree. 1451 # Hence in that case we are done. 1452 1453 while not IsEmpty( highdeg ) do 1454 1455 hdeg:= []; 1456 linds:= []; 1457 1458 for i in [1..Length(highdeg)] do 1459 1460 # Now we multiply all elements `highdeg[i]' with all possible 1461 # elements of degree 1 (i.e. elements having an index <= the lowest 1462 # index of the word `highdeg[i]') 1463 1464 ind:= lowinds[i]; 1465 for j in [1..ind] do 1466 1467 m:= degree1[j]*highdeg[i]; 1468 1469 # Now we first reduce `m' on the basis computed so far 1470 # and then add it to the basis. 1471 1472 for k in [1..Length(posits)] do 1473 l1:= posits[k][1]; 1474 l2:= posits[k][2]; 1475 m:= m-(m[l1][l2]/asbas[k][l1][l2])*asbas[k]; 1476 od; 1477 1478 if not IsZero( m ) then 1479 1480 #'m' is not an element of the span of `asbas' 1481 1482 Add( hdeg, m ); 1483 Add( linds, j ); 1484 Add( asbas, m); 1485 1486 # Now we look for a nonzero entry in `m' 1487 # and add the position of that entry to `posits'. 1488 1489 found:= false; 1490 l1:= 1; l2:= 1; 1491 while not found do 1492 if m[l1][l2] <> Zero( F ) then 1493 Add( posits, [l1,l2] ); 1494 found:= true; 1495 else 1496 if l2 = n then 1497 l1:= l1+1; 1498 l2:= 1; 1499 else 1500 l2:= l2+1; 1501 fi; 1502 fi; 1503 od; 1504 1505 fi; 1506 1507 od; 1508 1509 od; 1510 1511 if lowinds = [Dimension(K)] then 1512 1513 # We are in the first step and hence `degree1' must be made 1514 # equal to the linearly independent set that we have just calculated. 1515 1516 degree1:= ShallowCopy( hdeg ); 1517 linds:= [1..Length(degree1)]; 1518 1519 fi; 1520 1521 highdeg:= ShallowCopy( hdeg ); 1522 lowinds:= ShallowCopy( linds ); 1523 1524 od; 1525 1526 return Algebra( F, asbas, "basis" ); 1527 end ); 1528 1529 1530############################################################################## 1531## 1532#M LieNilRadical( <L> ) 1533## 1534## Let $p$ be the characteristic of the coefficients field of <L>. 1535## If $p=0$ the we use the following characterisation of the LieNilRadical: 1536## Let $S$ be the solvable radical of <L>. And let $H$ be a Cartan subalgebra 1537## of $S$. Decompose $S$ as $S = H \oplus S_1(H)$, where $S_1(H)$ is the 1538## Fitting 1-component of the adjoint action of $H$ on $S$. Let $H*$ be the 1539## associative algebra generated by $ad H$, then $S_1(H)$ is the intersection 1540## of the spaces $H*^i( S )$ for $i>0$. Let $R$ be the radical of the 1541## algebra $H*$. Then the LieNilRadical of <L> consists of $S_1(H)$ together 1542## with all elements $x$ in $H$ such that $ad x\in R$. This last space 1543## is also characterised as the space of all elements $x$ such that 1544## $ad x$ lies in the vector space spanned by all nilpotent parts of all 1545## $ad h$ for $h\in H$. 1546## 1547## In the case where $p>0$ we calculate the radical of the associative 1548## matrix algebra $A$ generated by $ad `L'$. 1549## The nil radical is then equal to $\{ x\in L \mid ad x \in A \}$. 1550## 1551InstallMethod( LieNilRadical, 1552 "for a Lie algebra", 1553 true, 1554 [ IsAlgebra and IsLieAlgebra ], 0, 1555 function( L ) 1556 1557 local F, # the coefficients domain of `L' 1558 p, # the characteristic of `F' 1559 bv, # basis vectors of a basis of `L' 1560 S, # the solvable radical of `L' 1561 H, # Cartan subalgebra of `S' 1562 HS, # Fitting 1-component of `S' wrt `H' 1563 adH, # list of ad x for x in a basis of `H' 1564 n, # dimension of `L' 1565 t, # the dimension of an ideal 1566 eqs, # equation set 1567 I, # basis vectors of an ideal of `L' 1568 i,j,k, # loop variables 1569 sol, # solution set 1570 adL, # list of matrices ad x where x runs through a basis of 1571 # `L' 1572 A, # an associative algebra 1573 R, # the radical of this algebra 1574 B; # list of basis vectors of R 1575 1576 F:= LeftActingDomain( L ); 1577 p:= Characteristic( F ); 1578 1579 if p = 0 then 1580 1581 # The LieNilRadical of <L> is equal to 1582 # the LieNilRadical of its solvable radical. 1583 1584 S:= LieSolvableRadical( L ); 1585 n:= Dimension( S ); 1586 1587 if n in [ 0, 1 ] then return S; fi; 1588 1589 H:= CartanSubalgebra(S); 1590 1591 if Dimension(H) = n then return S; fi; 1592 1593# We calculate the Fitting 1-component $S_1(H)$. 1594 1595 HS:= ProductSpace( H, S ); 1596 while Dimension( HS ) + Dimension( H ) <> n do 1597 HS:= ProductSpace( H, HS ); 1598 od; 1599 1600 if Dimension( H ) = 1 then 1601 return IdealNC( L, BasisVectors(Basis(HS)), "basis" ); 1602 fi; 1603 1604# Now we compute the intersection of `R' and `<ad H>'. 1605 1606 adH:= List( BasisVectors(Basis(H)), x -> AdjointMatrix(Basis(S),x)); 1607 R:= RadicalOfAlgebra( AdjointAssociativeAlgebra( S, H ) ); 1608 B:= BasisVectors( Basis( R ) ); 1609 1610 eqs:= NullMat(Dimension(H)+Dimension(R),n^2,F); 1611 for i in [1..n] do 1612 for j in [1..n] do 1613 for k in [1..Dimension(H)] do 1614 eqs[k][j+(i-1)*n]:= adH[k][i][j]; 1615 od; 1616 for k in [1..Dimension(R)] do 1617 eqs[Dimension(H)+k][j+(i-1)*n]:= B[k][i][j]; 1618 od; 1619 od; 1620 od; 1621 sol:= NullspaceMat( eqs ); 1622 I:= List( sol, x-> LinearCombination( Basis(H), x{[1..Dimension(H)]} ) ); 1623 1624 Append( I, BasisVectors( Basis( HS ) ) ); 1625 1626 return IdealNC( L, I, "basis" ); 1627 1628 else 1629 1630 n:= Dimension( L ); 1631 bv:= BasisVectors( Basis(L) ); 1632 adL:= List( bv, x -> AdjointMatrix(Basis(L),x) ); 1633 A:= AdjointAssociativeAlgebra( L, L ); 1634 R:= RadicalOfAlgebra( A ); 1635 1636 if Dimension( R ) = 0 then 1637 1638 # In this case the intersection of `ad L' and `R' is the centre of L. 1639 return LieCentre( L ); 1640 1641 fi; 1642 1643 B:= BasisVectors( Basis( R ) ); 1644 t:= Dimension( R ); 1645 1646 # Now we compute the intersection of `R' and `<ad L>'. 1647 1648 eqs:= NullMat(n+t,n*n,F); 1649 for i in [1..n] do 1650 for j in [1..n] do 1651 for k in [1..n] do 1652 eqs[k][j+(i-1)*n]:= adL[k][i][j]; 1653 od; 1654 for k in [1..t] do 1655 eqs[n+k][j+(i-1)*n]:= -B[k][i][j]; 1656 od; 1657 od; 1658 od; 1659 sol:= NullspaceMat( eqs ); 1660 I:= List( sol, x-> LinearCombination( bv, x{[1..n]} ) ); 1661 return SubalgebraNC( L, I, "basis" ); 1662 1663 fi; 1664 1665 end ); 1666 1667 1668############################################################################## 1669## 1670#M LieSolvableRadical( <L> ) 1671## 1672## In characteristic zero, the solvable radical of the Lie algebra <L> is 1673## just the orthogonal complement of $[ <L> <L> ]$ w.r.t. the Killing form. 1674## 1675## In characteristic $p > 0$, the following fact is used: 1676## $R( <L> / NR( <L> ) ) = R( <L> ) / NR( <L> )$ where 1677## $R( <L> )$ denotes the solvable radical of $L$ and $NR( <L> )$ its 1678## nil radical). 1679## 1680InstallMethod( LieSolvableRadical, 1681 "for a Lie algebra", 1682 true, 1683 [ IsLieAlgebra ], 0, 1684 function( L ) 1685 1686 local LL, # the derived algebra of L 1687 n, # the nil radical of L 1688 B, # a basis of the solvable radical of L 1689 quo, # the quotient L/n 1690 r1, # the solvable radical of L/n 1691 hom; # the canonical map L -> L/n 1692 1693 if Characteristic( LeftActingDomain( L ) ) = 0 then 1694 1695 LL:= LieDerivedSubalgebra( L ); 1696 B:= BasisVectors( Basis( KappaPerp( L, LL ) ) ); 1697 1698 else 1699 1700 n:= LieNilRadical( L ); 1701 1702 if Dimension( n ) = 0 or Dimension( n ) = Dimension( L ) then 1703 return n; 1704 fi; 1705 1706 hom:= NaturalHomomorphismByIdeal( L, n ); 1707 quo:= ImagesSource( hom ); 1708 r1:= LieSolvableRadical( quo ); 1709 B:= BasisVectors( Basis( r1 ) ); 1710 B:= List( B, x -> PreImagesRepresentative( hom, x ) ); 1711 Append( B, BasisVectors( Basis( n ) ) ); 1712 1713 fi; 1714 1715 SetIsLieSolvable( L, Length( B ) = Dimension( L ) ); 1716 1717 return IdealNC( L, B, "basis"); 1718 1719 end ); 1720 1721 1722############################################################################## 1723## 1724#M DirectSumDecomposition( <L> ) 1725## 1726## This function calculates a list of ideals of `L' such that `L' is equal 1727## to the direct sum of them. 1728## The existence of a decomposition of `L' is equivalent to the existence 1729## of a nontrivial idempotent in the centralizer of `ad L' in the full 1730## matrix algebra `M_n(F)'. In the general case we try to find such 1731## idempotents. 1732## In the case where the Killing form of `L' is nondegenerate we can use 1733## a more elegant method. In this case the action of the Cartan subalgebra 1734## will `identify' the direct summands. 1735## 1736InstallMethod( DirectSumDecomposition, 1737 "for a Lie algebra", 1738 true, 1739 [ IsAlgebra and IsLieAlgebra ], 0, 1740 function( L ) 1741 1742 local F, # The field of `L'. 1743 BL, # basis of `L' 1744 bvl, # basis vectors of `BL' 1745 n, # The dimension of `L'. 1746 m, # An integer. 1747 set, # A list of integers. 1748 C, # The centre of `L'. 1749 bvc, # basis vectors of a basis of `C' 1750 D, # The derived subalgebra of `L'. 1751 CD, # The intersection of `C' and `D'. 1752 H, # A Cartan subalgebra of `L'. 1753 BH, # basis of `H' 1754 B, # A list of bases of subspaces of `L'. 1755 cf, # Coefficient list. 1756 comlist, # List of commutators. 1757 ideals, # List of ideals. 1758 bb, # List of basis vectors. 1759 B1,B2, # Bases of the ideals. 1760 sp, # A vector space. 1761 x, # An element of `sp'. 1762 b, # A list of basis vectors. 1763 bas,res, # Bases of associative algebras. 1764 i,j,k,l, # Loop variables. 1765 centralizer, # The centralizer of `adL' in the matrix algebra. 1766 Rad, # The radical of `centralizer'. 1767 M,mat, # Matrices. 1768 facs, # A list of factors of a polynomial. 1769 f, # Polynomial. 1770 contained, # Boolean variable. 1771 adL, # A basis of the matrix space `ad L'. 1772 Q, # The factor algebra `centralizer/Rad' 1773 q, # Number of elements of the field of `L'. 1774 ei,ni,E, # Elements from `centralizer' 1775 hom, # A homomorphism. 1776 id, # A list of idempotents. 1777 vv; # A list of vectors. 1778 1779 1780 F:= LeftActingDomain( L ); 1781 n:= Dimension( L ); 1782 if n=0 then 1783 return [ L ]; 1784 fi; 1785 1786 if RankMat( KillingMatrix( Basis( L ) ) ) = n then 1787 1788 # The algorithm works as follows. 1789 # Let `H' be a Cartan subalgebra of `L'. 1790 # First we decompose `L' into a direct sum of subspaces `B[i]' 1791 # such that the minimum polynomial of the adjoint action of an element 1792 # of `H' restricted to `B[i]' is irreducible. 1793 # If `L' is a direct sum of ideals, then each of these subspaces 1794 # will be contained in precisely one ideal. 1795 # If the field `F' is big enough then we can look for a splitting 1796 # element in `H'. 1797 # This is an element `h' such that the minimum polynomial of `ad h' 1798 # has degree `dim L - dim H + 1'. 1799 # If the size of the field is bigger than `2*m' then there is a 1800 # powerful randomised algorithm (Las Vegas type) for finding such an 1801 # element. We just take a random element from `H' and with probability 1802 # > 1/2 this will be a splitting element. 1803 # If the field is small, then we use decomposable elements instead. 1804 1805 H:= CartanSubalgebra( L ); 1806 BH:= Basis( H ); 1807 BL:= Basis( L ); 1808 1809 m:= (( n - Dimension(H) ) * ( n - Dimension(H) + 2 )) / 8; 1810 1811 if 2*m < Size(F) and ( not Characteristic( F ) in [2,3] ) then 1812 1813 set:= [ -m .. m ]; 1814 1815 repeat 1816 cf:= List([ 1 .. Dimension( H ) ], x -> Random( set ) ); 1817 x:= LinearCombination( BH, cf ); 1818 M:= AdjointMatrix( BL, x ); 1819 f:= CharacteristicPolynomial( F, F, M ); 1820 f:= f/Gcd( f, Derivative( f ) ); 1821 until DegreeOfLaurentPolynomial( f ) 1822 = Dimension( L ) - Dimension( H ) + 1; 1823 1824 # We decompose the action of the splitting element: 1825 1826 facs:= Factors( PolynomialRing( F ), f ); 1827 B:= []; 1828 for i in facs do 1829 Add( B, List( NullspaceMat( TransposedMat( Value( i, M ) ) ), 1830 x -> LinearCombination( BL, x ) ) ); 1831 od; 1832 1833 B:= Filtered( B, x -> not ( x[1] in H ) ); 1834 1835 else 1836 1837 # Here `L' is a semisimple Lie algebra over a small field or a field 1838 # of characteristic 2 or 3. This means that 1839 # the existence of splitting elements is not assured. So we work 1840 # with decomposable elements rather than with splitting ones. 1841 # A decomposable element is an element from the associative 1842 # algebra `T' generated by `ad H' that has a reducible minimum 1843 # polynomial. Let `V' be a stable subspace (under the action of `H') 1844 # computed in the process. Then we proceed as follows. 1845 # We choose a random element from `T' and restrict it to `V'. If this 1846 # element has an irreducible minimum polynomial of degree equal to 1847 # the dimension of the associative algebra `T' restricted to `V', 1848 # then `V' is irreducible. On the other hand, 1849 # if this polynomial is reducible, then we decompose `V'. 1850 1851 # `bas' will be a basis of the associative algebra generated by 1852 # `ad H'. The computation of this basis is facilitated by the fact 1853 # that we know the dimension of this algebra. 1854 1855 bas:= List( BH, x -> AdjointMatrix( Basis( L ), x ) ); 1856 sp:= MutableBasis( F, bas ); 1857 1858 k:=1; l:=1; 1859 while k<=Length(bas) do 1860 if Length(bas)=Dimension(L)-Dimension(H) then break; fi; 1861 M:= bas[ k ]*bas[ l ]; 1862 if not IsContainedInSpan( sp, M ) then 1863 CloseMutableBasis( sp, M ); 1864 Add( bas, M ); 1865 fi; 1866 if l < Length(bas) then l:=l+1; 1867 else k:=k+1; l:=1; 1868 fi; 1869 od; 1870 Add( bas, Immutable( IdentityMat( Dimension( L ), F ) ) ); 1871 1872 # Now `B' will be a list of subspaces of `L' stable under `H'. 1873 # We stop once every element from `B' is irreducible. 1874 1875 cf:= AsList( F ); 1876 B:= [ ProductSpace( H, L ) ]; 1877 k:= 1; 1878 1879 while k <= Length( B ) do 1880 if Dimension( B[k] ) = 1 then 1881 k:=k+1; 1882 else 1883 b:= BasisVectors( Basis( B[k] ) ); 1884 M:= LinearCombination( bas, List( bas, x -> Random( cf ) ) ); 1885 1886 # Now we restrict `M' to the space `B[k]'. 1887 1888 mat:= [ ]; 1889 for i in [1..Length(b)] do 1890 x:= LinearCombination( BL, M*Coefficients( BL, b[i] ) ); 1891 Add( mat, Coefficients( Basis( B[k], b ), x ) ); 1892 od; 1893 M:= TransposedMat( mat ); 1894 1895 f:= MinimalPolynomial( F, M ); 1896 facs:= Factors( PolynomialRing( F ), f ); 1897 1898 if Length(facs)=1 then 1899 1900 # We restrict the basis `bas' to the space `B[k]'. If the length 1901 # of the result is equal to the degree of `f' then `B[k]' is 1902 # irreducible. 1903 1904 sp:= MutableBasis( F, 1905 [ Immutable( IdentityMat( Dimension(B[k]), F ) ) ] ); 1906 for j in [1..Length(bas)] do 1907 mat:= [ ]; 1908 for i in [1..Length(b)] do 1909 x:= LinearCombination( BL, bas[j]*Coefficients( BL, b[i] ) ); 1910 Add( mat, Coefficients( Basis( B[k], b ), x ) ); 1911 od; 1912 mat:= TransposedMat( mat ); 1913 1914 if not IsContainedInSpan( sp, mat ) then 1915 CloseMutableBasis( sp, mat ); 1916 fi; 1917 1918 od; 1919 res:= BasisVectors( sp ); 1920 1921 if Length( res ) = DegreeOfLaurentPolynomial( f ) then 1922 1923 # The space is irreducible. 1924 1925 k:=k+1; 1926 1927 fi; 1928 else 1929 1930 # We decompose. 1931 1932 for i in facs do 1933 vv:= List( NullspaceMat( TransposedMat( Value( i, M ) ) ), 1934 x -> LinearCombination( b, x ) ); 1935 sp:= VectorSpace( F, vv ); 1936 if not sp in B then Add( B, sp ); fi; 1937 od; 1938 1939 # We remove the old space from the list; 1940 1941 B:= Filtered( B, x -> (x <> B[k]) ); 1942 1943 fi; 1944 fi; 1945 1946 od; 1947 1948 B:= List( B, x -> BasisVectors( Basis( x ) ) ); 1949 fi; 1950 1951 # Now the pieces in `B' are grouped together. 1952 1953 ideals:=[]; 1954 1955 while B <> [ ] do 1956 1957 # Check whether `B[1]' is contained in any of 1958 # the ideals obtained so far. 1959 1960 contained := false; 1961 i:=1; 1962 while not contained and i <= Length(ideals) do 1963 if B[1][1] in ideals[i] then 1964 contained:= true; 1965 fi; 1966 i:=i+1; 1967 od; 1968 1969 if contained then # we do not need B[1] any more 1970 1971 B:= Filtered( B, x -> x<> B[1] ); 1972 1973 else 1974 1975 # `B[1]' generates a new ideal. 1976 # We form this ideal by taking `B[1]' together with 1977 # all pieces from `B' that do not commute with `B[1]'. 1978 # At the end of this process, `bb' will be a list of elements 1979 # commuting with all elements of `B'. 1980 # From this it follows that `bb' will generate 1981 # a subalgebra that is a simple ideal. (No remaining piece of `B' 1982 # can be in this ideal because in that case this piece would 1983 # generate a smaller ideal inside this one.) 1984 1985 bb:= ShallowCopy( B[1] ); 1986 B:= Filtered( B, x -> x<> B[1] ); 1987 i:=1; 1988 while i<= Length( B ) do 1989 1990 comlist:= [ ]; 1991 for j in [1..Length(bb)] do 1992 Append( comlist, List( B[i], y -> bb[j]*y ) ); 1993 od; 1994 1995 if not ForAll( comlist, x -> x = Zero(L) ) then 1996 Append( bb, B[i] ); 1997 B:= Filtered( B, x -> x <> B[i] ); 1998 i:= 1; 1999 else 2000 i:=i+1; 2001 fi; 2002 2003 od; 2004 2005 Add( ideals, SubalgebraNC( L, bb ) ); 2006 2007 fi; 2008 2009 od; 2010 2011 return List( ideals, 2012 I -> IdealNC( L, BasisVectors( Basis( I ) ), "basis" )); 2013 2014 else 2015 2016 # First we try to find a central component, i.e., a decomposition 2017 # `L=I_1 \oplus I_2' such that `I_1' is contained in the center of `L'. 2018 # Such a decomposition exists if and only if the center of `L' is not 2019 # contained in the derived subalgebra of `L'. 2020 2021 C:= LieCentre( L ); 2022 bvc:= BasisVectors( Basis( C ) ); 2023 2024 if Dimension( C ) = Dimension( L ) then 2025 2026 #Now `L' is abelian; hence `L' is the direct sum of `dim L' ideals. 2027 2028 return List( bvc, v -> IdealNC( L, [ v ], "basis" ) ); 2029 2030 fi; 2031 2032 BL:= Basis( L ); 2033 bvl:= BasisVectors( BL ); 2034 2035 if 0 < Dimension( C ) then 2036 2037 D:= LieDerivedSubalgebra( L ); 2038 CD:= Intersection2( C, D ); 2039 2040 if Dimension( CD ) < Dimension( C ) then 2041 2042 # The central component is the complement of `C \cap D' in `C'. 2043 2044 B1:=[]; 2045 k:=1; 2046 sp:= MutableBasis( F, 2047 BasisVectors( Basis( CD ) ), Zero( CD ) ); 2048 while Length( B1 ) + Dimension( CD ) <> Dimension( C ) do 2049 x:= bvc[k]; 2050 if not IsContainedInSpan( sp, x ) then 2051 Add( B1, x ); 2052 CloseMutableBasis( sp, x ); 2053 fi; 2054 k:=k+1; 2055 od; 2056 2057 # The second ideal is a complement of the central component 2058 # in `L' containing `D'. 2059#W next statement modified: 2060 B2:= ShallowCopy( BasisVectors( Basis( D ) ) ); 2061 k:= 1; 2062 b:= ShallowCopy( B1 ); 2063 Append( b, B2 ); 2064 sp:= MutableBasis( F, b ); 2065 while Length( B2 )+Length( B1 ) <> n do 2066 x:= bvl[k]; 2067 if not IsContainedInSpan( sp, x ) then 2068 Add( B2, x ); 2069 CloseMutableBasis( sp, x ); 2070 fi; 2071 k:= k+1; 2072 od; 2073 2074 ideals:= Flat([ 2075 DirectSumDecomposition(IdealNC( L, B1, "basis" )), 2076 DirectSumDecomposition(IdealNC( L, B2, "basis" )) 2077 ]); 2078 return ideals; 2079 2080 fi; 2081 2082 fi; 2083 2084 # Now we assume that `L' does not have a central component 2085 # and compute the centralizer of `ad L' in `M_n(F)'. 2086 2087 adL:= List( bvl, x -> AdjointMatrix( BL, x ) ); 2088 centralizer:= FullMatrixAlgebraCentralizer( F, adL ); 2089 Rad:= RadicalOfAlgebra( centralizer ); 2090 if Dimension( centralizer ) - Dimension( Rad ) = 1 then 2091 return [ L ]; 2092 fi; 2093 2094 # We calculate a complete set of orthogonal primitive idempotents 2095 # in the Abelian algebra `centralizer/Rad'. 2096 2097 hom:= NaturalHomomorphismByIdeal( centralizer, Rad ); 2098 Q:= ImagesSource( hom ); 2099 SetCentre( Q, Q ); 2100 SetRadicalOfAlgebra( Q, Subalgebra( Q, [ Zero( Q ) ] ) ); 2101 2102 id:= List( CentralIdempotentsOfAlgebra( Q ), 2103 x->PreImagesRepresentative(hom,x)); 2104 2105 # Now we lift the idempotents to the big algebra `A'. The 2106 # first idempotent is lifted as follows: 2107 # We have that `id[1]^2-id[1]' is an element of `Rad'. 2108 # We construct the sequences e_{i+1} = e_i + n_i - 2e_in_i, 2109 # and n_{i+1}=e_{i+1}^2-e_{i+1}, starting with e_0=id[1]. 2110 # It can be proved by induction that e_q is an idempotent in `A' 2111 # because n_0^{2^q}=0. 2112 # Now `E' will be the sum of all idempotents lifted so far. 2113 # Then the next lifted idempotent is obtained by setting 2114 # `ei:=id[i]-E*id[i]-id[i]*E+E*id[i]*E;' 2115 # and lifting as above. It can be proved that in this manner we 2116 # get an orthogonal system of primitive idempotents. 2117 2118 E:= Zero( F )*id[1]; 2119 2120 for i in [1..Length(id)] do 2121 ei:= id[i]-E*id[i]-id[i]*E+E*id[i]*E; 2122 q:= 0; 2123 while 2^q <= Dimension( Rad ) do 2124 q:= q+1; 2125 od; 2126 ni:= ei*ei-ei; 2127 for j in [1..q] do 2128 ei:= ei+ni-2*ei*ni; 2129 ni:= ei*ei-ei; 2130 od; 2131 id[i]:= ei; 2132 E:= E+ei; 2133 od; 2134 2135 # For every idempotent of `centralizer' we calculate 2136 # a direct summand of `L'. 2137 2138 ideals:= List( id, e -> List( TransposedMat( e ), v -> 2139 LinearCombination( BL, v ) ) ); 2140 ideals:= List( ideals, ii -> BasisVectors( 2141 Basis( VectorSpace( F, ii ) ) ) ); 2142 2143 return List( ideals, ii -> 2144 IdealNC( L, ii, "basis" ) ); 2145 2146 fi; 2147 2148 end ); 2149 2150 2151 2152############################################################################## 2153## 2154#M IsSimpleAlgebra( <L> ) . . . . . . . . . . . . . . . . for a Lie algebra 2155## 2156## A test whether <L> is simple. 2157## It works only over fields of characteristic 0. 2158## 2159InstallMethod( IsSimpleAlgebra, 2160 "for a Lie algebra in characteristic zero", 2161 true, 2162 [ IsAlgebra and IsLieAlgebra ], 0, 2163 function( L ) 2164 if Characteristic( LeftActingDomain( L ) ) <> 0 then 2165 TryNextMethod(); 2166 elif DeterminantMat( KillingMatrix( Basis( L ) ) ) = 0 then 2167 return false; 2168 else 2169 return Length( DirectSumDecomposition( L ) ) = 1; 2170 fi; 2171 end ); 2172 2173 2174############################################################################## 2175## 2176#F FindSl2( <L>, <x> ) 2177## 2178InstallGlobalFunction( FindSl2, function( L, x ) 2179 2180 local n, # the dimension of `L' 2181 F, # the field of `L' 2182 B, # basis of `L' 2183 T, # the table of structure constants of `L' 2184 xc, # coefficient vector 2185 eqs, # a system of equations 2186 i,j,k,l, # loop variables 2187 cij, # the element `T[i][j]' 2188 b, # the right hand side of the equation system 2189 v, # solution of the equations 2190 z, # element of `L' 2191 h, # element of `L' 2192 R, # centralizer of `x' in `L' 2193 BR, # basis of `R' 2194 Rvecs, # basis vectors of `R' 2195 H, # the matrix of `ad H' restricted to `R' 2196 e0, # coefficient vector 2197 e1, # coefficient vector 2198 y; # element of `L' 2199 2200 if not IsNilpotentElement( L, x ) then 2201 Error( "<x> must be a nilpotent element of the Lie algebra <L>" ); 2202 fi; 2203 2204 n:= Dimension( L ); 2205 F:= LeftActingDomain( L ); 2206 B:= Basis( L ); 2207 T:= StructureConstantsTable( B ); 2208 2209 xc:= Coefficients( B, x ); 2210 eqs:= NullMat( 2*n, 2*n, F ); 2211 2212 # First we try to find elements `z' and `h' such that `[x,z]=h' 2213 # and `[h,x]=2x' (i.e., such that two of the three defining equations 2214 # of sl_2 are satisfied). 2215 # This results in a system of `2n' equations for `2n' variables. 2216 2217 for i in [1..n] do 2218 for j in [1..n] do 2219 cij:= T[i][j]; 2220 for k in [1..Length(cij[1])] do 2221 l:= cij[1][k]; 2222 eqs[i][l] := eqs[i][l] + xc[j]*cij[2][k]; 2223 eqs[n+i][n+l]:= eqs[n+i][n+l] + xc[j]*cij[2][k]; 2224 od; 2225 od; 2226 eqs[n+i][i]:= One( F ); 2227 od; 2228 2229 b:= []; 2230 for i in [1..n] do 2231 b[i]:= Zero( F ); 2232 b[n+i]:= 2*One( F )*xc[i]; 2233 od; 2234 2235 v:= SolutionMat( eqs, b ); 2236 2237 if v = fail then 2238 # There is no sl_2 containing <x>. 2239 return fail; 2240 fi; 2241 2242 z:= LinearCombination( B, v{ [ 1 .. n ] } ); 2243 h:= LinearCombination( B, v{ [ n+1 .. 2*n ] } ); 2244 2245 R:= LieCentralizer( L, SubalgebraNC( L, [ x ] ) ); 2246 BR:= Basis( R ); 2247 Rvecs:= BasisVectors( BR ); 2248 2249 # `ad h' maps `R' into `R'. `H' will be the matrix of that map. 2250 2251 H:= List( Rvecs, v -> Coefficients( BR, h * v ) ); 2252 2253 # By the proof of the lemma of Jacobson-Morozov (see Jacobson, 2254 # Lie Algebras, p. 98) there is an element `e1' in `R' such that 2255 # `(H+2)e1=e0' where `e0=[h,z]+2z'. 2256 # If we set `y=z-e1' then `x,h,y' will span a subalgebra of `L' 2257 # isomorphic to sl_2. 2258 2259 H:= H+2*IdentityMat( Dimension( R ), F ); 2260#T cheaper! 2261 2262 e0:= Coefficients( BR, h * z + 2*z ); 2263 e1:= SolutionMat( H, e0 ); 2264 2265 if e1 = fail then 2266 # There is no sl_2 containing <x>. 2267 return fail; 2268 fi; 2269 2270 y:= z-LinearCombination(Rvecs,e1); 2271 2272 return SubalgebraNC( L, [x,h,y], "basis" ); 2273end ); 2274 2275 2276############################################################################# 2277## 2278#M SemiSimpleType( <L> ) 2279## 2280## This function works for Lie algebras over a field of characteristic not 2281## 2 or 3, having a nondegenerate Killing form. Such Lie algebras are 2282## semisimple. They are characterized as direct sums of simple Lie algebras, 2283## and these have been classified: a simple Lie algebra is either an element 2284## of the "great" classes of simple Lie algebas (A_n, B_n, C_n, D_n), or 2285## an exceptional algebra (E_6, E_7, E_8, F_4, G_2). This function finds 2286## the type of the semisimple Lie algebra `L'. Since for the calculations 2287## eigenvalues and eigenvectors of the action of a Cartan subalgebra are 2288## needed, we reduce the Lie algebra mod p (if it is of characteristic 0). 2289## The p may not divide the determinant of the matrix of the Killing form, 2290## nor may it divide the last nonzero coefficient of a minimum polynomial 2291## of an element of the basis of the Cartan subalgebra. 2292## 2293InstallMethod( SemiSimpleType, 2294 "for a Lie algebra", 2295 true, 2296 [ IsAlgebra and IsLieAlgebra ], 0, 2297 function( L ) 2298 2299 local CartanInteger, # Function that computes the Cartan integer. 2300 bvl, # basis vectors of a basis of `L' 2301 a, # Element of `L'. 2302 T,S,S1, # Structure constants tables. 2303 den, # Denominator of a structure constant. 2304 denoms, # List of denominators. 2305 i,j,k, # Loop variables. 2306 scal, # A scalar. 2307 K, # A Lie algebra. 2308 BK, # basis of `K' 2309 d, # The determinant of the Killing form of `K'. 2310 p, # A prime. 2311 H, # Cartan subalgebra. 2312 s, # An integer. 2313 mp, # List of minimum polynomials. 2314 F, # Field. 2315 bas, # List of basis vectors. 2316 simples, # List of simple subalgebras. 2317 types, # List of the types of the elements of simples. 2318 I, # An element of simples. 2319 BI, # basis of `I' 2320 bvi, # basis vectors of `BI' 2321 HI, # Cartan subalgebra of `I'. 2322 rk, # The rank of `I'. 2323 adH, # List of adjoint matrices. 2324 R, # Root system. 2325 basR, # Basis of `R'. 2326 posR, # List of the positive roots. 2327 fundR, # A fundamental system. 2328 r,r1,r2,rt, # Roots. 2329 Rvecs, # List of root vectors. 2330 basH, # List of basis vectors of a Cartan subalg. of `I' 2331 sp, # Vector space. 2332 h, # Element of a Cartan subalgebra of `I'. 2333 cf, # Coefficient. 2334 issum, # Boolean. 2335 CM, # Cartan Matrix. 2336 endpts; # The endpoints of the Dynkin diagram of `I'. 2337 2338 if Characteristic( LeftActingDomain( L ) ) in [ 2, 3 ] then 2339 Info( InfoAlgebra, 1, 2340 "The field of <L> must not have characteristic 2 or 3." ); 2341 return fail; 2342 fi; 2343 2344 # The following function computes the Cartan integer of two roots 2345 # `r1' and `r2'. 2346 # If `s' and `t' are the largest integers such that `r1 - s*r2' and 2347 # `r1 + t*r2' are elements of the root system `R', 2348 # then the Cartan integer of `r1' and `r2' is `s-t'. 2349 2350 CartanInteger := function( R, r1, r2 ) 2351 2352 local R1,s,t,rt; 2353 2354 R1:= ShallowCopy( R ); 2355 Add( R1, R[1]-R[1] ); 2356 s:= 0; 2357 t:= 0; 2358 rt:= r1-r2; 2359 while rt in R1 do 2360 rt:= rt-r2; 2361 s:= s+1; 2362 od; 2363 2364 rt:= r1+r2; 2365 while rt in R1 do 2366 rt:= rt+r2; 2367 t:= t+1; 2368 od; 2369 return s-t; 2370 end; 2371 2372 # We test whether the Killing form of `L' is nondegenerate. 2373 2374 d:= DeterminantMat( KillingMatrix( Basis( L ) ) ); 2375 if IsZero( d ) then 2376 Info( InfoAlgebra, 1, 2377 "The Killing form of <L> is degenerate." ); 2378 return fail; 2379 fi; 2380 2381 # First we produce a basis of `L' such that the first basis elements 2382 # form a basis of a Cartan subalgebra of `L'. Then if `L' is defined 2383 # over a field of characteristic 0 we do the following. We 2384 # multiply by an integer in order to ensure that the structure 2385 # constants are integers. 2386 # Finally we reduce modulo an appropriate prime `p'. 2387 2388 H:= CartanSubalgebra( L ); 2389 rk:= Dimension( H ); 2390 bas:= ShallowCopy( BasisVectors( Basis( H ) ) ); 2391 sp:= MutableBasis( LeftActingDomain( L ), bas ); 2392 k:= 1; 2393 bvl:= BasisVectors( Basis( L ) ); 2394 while Length( bas ) < Dimension( L ) do 2395 a:= bvl[k]; 2396 if not IsContainedInSpan( sp, a ) then 2397 Add( bas, a ); 2398 CloseMutableBasis( sp, a ); 2399 fi; 2400 k:= k+1; 2401 od; 2402 T:= StructureConstantsTable( BasisNC( L, bas ) ); 2403 2404 p:= Characteristic( LeftActingDomain( L ) ); 2405 2406 if p = 0 then 2407 2408 denoms:=[]; 2409 for i in [1..Dimension(L)] do 2410 for j in [1..Dimension(L)] do 2411 for k in [1..Length(T[i][j][2])] do 2412 den:= DenominatorRat( T[i][j][2][k] ); 2413 if (den <> 1) and (not den in denoms) then 2414 Add( denoms, den ); 2415 fi; 2416 od; 2417 od; 2418 od; 2419 2420 if denoms <> [] then 2421 S:= EmptySCTable( Dimension( L ), 0, "antisymmetric" ); 2422 scal:= Lcm( denoms ); 2423 for i in [1..Dimension(L)] do 2424 for j in [1..Dimension(L)] do 2425 S[i][j]:= [T[i][j][1],scal*T[i][j][2]]; 2426 od; 2427 od; 2428 else 2429 S:=T; 2430 fi; 2431 2432 K:= LieAlgebraByStructureConstants( LeftActingDomain( L ), S ); 2433 2434 BK:= Basis( K ); 2435 d:= DeterminantMat( KillingMatrix( BK ) ); 2436 F:= LeftActingDomain( L ); 2437 2438# `mp' will be a list of minimum polynomials of basis elements of the 2439# Cartan subalgebra. 2440 2441 mp:= List( BasisVectors( BK ){[1..rk]}, 2442 x -> CharacteristicPolynomial( F, F, AdjointMatrix( BK, x ) ) ); 2443 mp:= List( mp, x -> x/Gcd( Derivative( x ), x ) ); 2444 d:= d * Product( List( mp, p -> 2445 CoefficientsOfLaurentPolynomial(p)[1][1] ) ); 2446 p:= 5; 2447 s:=7; 2448 2449 # We determine a prime `p>5' not dividing `d' and an integer `s' 2450 # such that the minimum polynomials of the basis elements 2451 # of the Cartan subalgebra will split into linear factors 2452 # over the field of `p^s' elements, 2453 # and such that `p^s<=2^16' 2454 # (the maximum size of a finite field in GAP). 2455 2456 while p^s > 65536 do 2457 2458 while d mod p = 0 do 2459 p:= NextPrimeInt( p ); 2460 od; 2461 2462 F:= GF( p ); 2463 2464 S1:= EmptySCTable( Dimension( K ), Zero( F ), "antisymmetric" ); 2465 for i in [1..Dimension(K)] do 2466 for j in [1..Dimension(K)] do 2467 S1[i][j]:= [S[i][j][1], One( F )*List( S[i][j][2], x -> x mod p)]; 2468 od; 2469 od; 2470 2471 K:= LieAlgebraByStructureConstants( F, S1 ); 2472 BK:= Basis( K ); 2473 mp:= List( BasisVectors( BK ){[1..rk]}, 2474 x -> CharacteristicPolynomial( F, F, AdjointMatrix( BK, x ) ) ); 2475 s:= Lcm( Flat( List( mp, p -> List( Factors( p ), 2476 DegreeOfLaurentPolynomial ) ))); 2477 2478 if p=65521 then p:= 1; fi; 2479 2480 od; 2481 2482 if p = 1 then 2483 Info( InfoAlgebra, 1, 2484 "We cannot find a small modular splitting field for <L>" ); 2485 2486 return fail; 2487 fi; 2488 2489 else 2490 2491 # Here `L' is defined over a field of characteristic p>0. We determine 2492 # an integer `s' such that the Cartan subalgebra splits over 2493 # `GF( p^s )'. 2494 2495 F:= LeftActingDomain( L ); 2496 K:= LieAlgebraByStructureConstants( F, T ); 2497 BK:= Basis( K ); 2498 mp:= List( BasisVectors( BK ){[1..rk]}, 2499 x -> CharacteristicPolynomial( F, F, AdjointMatrix( BK, x ) ) ); 2500 s:= Lcm( Flat( List( mp, p -> List( Factors( p ), 2501 DegreeOfLaurentPolynomial ) ))); 2502 s:= s*Dimension( LeftActingDomain( L ) ); 2503 if p^s > 2^16 then 2504 Info( InfoAlgebra, 1, 2505 "We cannot find a small modular splitting field for <L>" ); 2506 2507 return fail; 2508 fi; 2509 S1:= T; 2510 fi; 2511 2512 F:= GF( p^s ); 2513 K:= LieAlgebraByStructureConstants( F, S1 ); 2514 2515 # We already know a Cartan subalgebra of `K'. 2516 2517 BK:= Basis( K ); 2518 H:= SubalgebraNC( K, BasisVectors( BK ){ [ 1 .. rk ] }, "basis" ); 2519 SetCartanSubalgebra( K, H ); 2520 2521 simples:= DirectSumDecomposition( K ); 2522 2523 types:= ""; 2524 2525 # Now for every simple Lie algebra in simples we have to determine 2526 # its type. 2527 # For Lie algebras not equal to B_l, C_l or E_6, 2528 # this is determined by the dimension and the rank. 2529 # In the other cases we have to examine the root system. 2530 2531 for I in simples do 2532 2533 if not IsEmpty( types ) then 2534 Append( types, " " ); 2535 fi; 2536 2537 HI:= Intersection2( H, I ); 2538 rk:= Dimension( HI ); 2539 2540 if Dimension( I ) = 133 and rk = 7 then 2541 Append( types, "E7" ); 2542 elif Dimension( I ) = 248 and rk = 8 then 2543 Append( types, "E8" ); 2544 elif Dimension( I ) = 52 and rk = 4 then 2545 Append( types, "F4" ); 2546 elif Dimension( I ) = 14 and rk = 2 then 2547 Append( types, "G2" ); 2548 else 2549 if Dimension( I ) = rk^2 + 2*rk then 2550 Append( types, "A" ); Append( types, String( rk ) ); 2551 elif Dimension( I ) = 2*rk^2-rk then 2552 Append( types, "D" ); Append( types, String( rk ) ); 2553 elif Dimension( I ) = 10 then 2554 Append( types, "B2" ); 2555 else 2556 2557 # We now determine the list of roots and the corresponding 2558 # root vectors. 2559 # Since the minimum polynomials of the elements of the 2560 # Cartan subalgebra split completely, 2561 # after the call of DirectSumDecomposition, 2562 # the root vectors are contained in the basis of `I'. 2563 2564 BI:= Basis( I ); 2565 bvi:= BasisVectors( BI ); 2566 adH:= List( BasisVectors(Basis(HI)), x->AdjointMatrix(BI,x)); 2567#T better! 2568 R:=[]; 2569 Rvecs:=[]; 2570 for i in [ 1 .. Dimension( I ) ] do 2571 rt:= List( adH, x -> x[i][i] ); 2572 if not IsZero( rt ) then 2573 Add( R, rt ); 2574 Add( Rvecs, bvi[i] ); 2575 fi; 2576 od; 2577 2578 # A set of roots `basR' is determined such that the set 2579 # { [x_r,x_{-r}] | r\in basR } is a basis of `HI'. 2580 2581 basH:= [ ]; 2582 basR:= [ ]; 2583 sp:= MutableBasis( F, [], Zero(I) ); 2584 i:= 1; 2585 while Length( basH ) < Dimension( HI ) do 2586 r:= R[i]; 2587 k:= Position( R, -r ); 2588 h:= Rvecs[i] * Rvecs[k]; 2589 if not IsContainedInSpan( sp, h ) then 2590 Add( basH, h ); 2591 CloseMutableBasis( sp, h ); 2592 Add( basR, r ); 2593 fi; 2594 i:= i+1; 2595 od; 2596 2597 # `posR' will be the set of positive roots. 2598 # A root `r' is called positive if in the list 2599 # [ < r, basR[i] >, i=1...Length(basR) ] the first nonzero 2600 # coefficient is positive 2601 # (< r_1, r_2 > is the Cartan integer of r_1 and r_2). 2602 2603 posR:= [ ]; 2604 for r in R do 2605 if (not r in posR) and (not -r in posR) then 2606 cf:= 0; 2607 i:= 0; 2608 while cf = 0 do 2609 i:= i+1; 2610 cf:= CartanInteger( R, r, basR[i] ); 2611 od; 2612 if 0 < cf then 2613 Add( posR, r ); 2614 else 2615 Add( posR, -r ); 2616 fi; 2617 fi; 2618 od; 2619 2620 # A positive root is a fundamental root if it is not 2621 # the sum of two other positive roots. 2622 2623 fundR:= [ ]; 2624 for r in posR do 2625 issum:= false; 2626 for r1 in posR do 2627 for r2 in posR do 2628 if r = r1+r2 then 2629 issum:= true; 2630 break; 2631 fi; 2632 od; 2633 if issum then break; fi; 2634 od; 2635 if not issum then 2636 Add( fundR, r ); 2637 fi; 2638 od; 2639 2640 # `CM' will be the matrix of Cartan integers 2641 # of the fundamental roots. 2642 2643 CM:= List( fundR, 2644 ri -> List( fundR, rj -> CartanInteger( R, ri, rj ) ) ); 2645 2646 # Finally the properties of the endpoints determine 2647 # the type of the root system. 2648 2649 endpts:= [ ]; 2650 for i in [ 1 .. Length(CM) ] do 2651 if Number( CM[i], x -> x <> 0 ) = 2 then 2652 Add( endpts, i ); 2653 fi; 2654 od; 2655 2656 if Length( endpts ) = 3 then 2657 Append( types, "E6" ); 2658 elif Sum( CM[ endpts[1] ] ) = 0 or Sum( CM[ endpts[2] ] ) = 0 then 2659 Append( types, "C" ); Append( types, String( rk ) ); 2660 else 2661 Append( types, "B" ); Append( types, String( rk ) ); 2662 fi; 2663 2664 fi; 2665 fi; 2666 od; 2667 2668 return types; 2669 end ); 2670 2671 2672############################################################################## 2673## 2674#M NonNilpotentElement( <L> ) 2675## 2676InstallMethod( NonNilpotentElement, 2677 "for a Lie algebra", 2678 true, 2679 [ IsAlgebra and IsLieAlgebra ], 0, 2680 function( L ) 2681 2682 local n, # the dimension of `L' 2683 F, # the field over which `L' is defined 2684 bvecs, # a list of the basisvectors of `L' 2685 D, # a list of elements of `L', forming a basis of a nilpotent 2686 # subspace 2687 sp, # the space spanned by `D' 2688 r, # the dimension of `sp' 2689 found, # a Boolean variable 2690 i, j, # loop variables 2691 b, c, # elements of `L' 2692 elm; # 2693 2694 # First rule out some trivial cases. 2695 n:= Dimension( L ); 2696 if n = 1 or n = 0 then 2697 return fail; 2698 fi; 2699 2700 F:= LeftActingDomain( L ); 2701 bvecs:= BasisVectors( Basis( L ) ); 2702 2703 if Characteristic( F ) <> 0 then 2704 2705 # `D' will be a basis of a nilpotent subalgebra of L. 2706 if IsNilpotentElement( L, bvecs[1] ) then 2707 D:= [ bvecs[1] ]; 2708 else 2709 return bvecs[1]; 2710 fi; 2711 2712 # `r' will be the dimension of the span of `D'. 2713 # If `r = n' then `L' is nilpotent and hence does not contain 2714 # non nilpotent elements. 2715 r:= 1; 2716 2717 while r < n do 2718 2719 sp:= VectorSpace( F, D, "basis" ); 2720 2721 # We first find an element `b' of `L' that does not lie in `sp'. 2722 found:= false; 2723 i:= 2; 2724 while not found do 2725 b:= bvecs[i]; 2726 if b in sp then 2727 i:= i+1; 2728 else 2729 found:= true; 2730 fi; 2731 od; 2732 2733 # We now replace `b' by `b * D[i]' if 2734 # `b * D[i]' lies outside `sp' in order to ensure that 2735 # `[b,sp] \subset sp'. 2736 # Because `sp' is a nilpotent subalgebra we only need 2737 # a finite number of replacement steps. 2738 2739 i:= 1; 2740 while i <= r do 2741 c:= b*D[i]; 2742 if c in sp then 2743 i:= i+1; 2744 else 2745 b:= c; 2746 i:= 1; 2747 fi; 2748 od; 2749 2750 if IsNilpotentElement( L, b ) then 2751 Add( D, b ); 2752 r:= r+1; 2753 else 2754 return b; 2755 fi; 2756 2757 od; 2758 2759 else 2760 2761 # Now `char F =0'. 2762 # In this case either `L' is nilpotent or one of the 2763 # elements $L.1, \ldots , L.n, L.i + L.j; 1 \leq i < j$ 2764 # is non nilpotent. 2765 2766 for i in [ 1 .. n ] do 2767 if not IsNilpotentElement( L, bvecs[i] ) then 2768 return bvecs[i]; 2769 fi; 2770 od; 2771 2772 for i in [ 1 .. n ] do 2773 for j in [ i+1 .. n ] do 2774 elm:= bvecs[i] + bvecs[j]; 2775 if not IsNilpotentElement( L, elm ) then 2776 return elm; 2777 fi; 2778 od; 2779 od; 2780 2781 fi; 2782 2783 # A non nilpotent element has not been found, 2784 # hence `L' is nilpotent. 2785 return fail; 2786 2787 end ); 2788 2789############################################################################ 2790## 2791#M PrintObj( <R> ) . . . . . . . . . . . . . . . . . . for a root system 2792## 2793InstallMethod( PrintObj, 2794 "for a root system", 2795 true, [ IsRootSystem ], 0, 2796 function( R ) 2797 2798 if HasCartanMatrix( R ) then 2799 Print("<root system of rank ",Length(SimpleSystem(R)),">"); 2800 else 2801 Print("<root system>"); 2802 fi; 2803 2804end ); 2805 2806 2807############################################################################ 2808## 2809#M \.( <R>, <name> ) . . . . . . . record component access for a root system 2810## 2811InstallMethod( \., 2812 "for a root system and a record component", 2813 true, [ IsRootSystem, IsObject ], 0, 2814 function( R, name ) 2815 2816 name:= NameRNam( name ); 2817 if name = "roots" then 2818 return Concatenation( PositiveRoots(R), NegativeRoots(R) ); 2819 elif name = "rootvecs" then 2820 return Concatenation( PositiveRootVectors(R), 2821 NegativeRootVectors(R) ); 2822 elif name = "fundroots" then 2823 return SimpleSystem( R ); 2824 elif name = "cartanmat" then 2825 return CartanMatrix(R); 2826 else 2827 TryNextMethod(); 2828 fi; 2829end ); 2830 2831 2832############################################################################## 2833## 2834#M RootSystem( <L> ) . . . . . . . . . . . . . . . . . . . for a Lie algebra 2835## 2836InstallMethod( RootSystem, 2837 "for a (semisimple) Lie algebra", 2838 true, 2839 [ IsAlgebra and IsLieAlgebra ], 0, 2840 function( L ) 2841 2842 local F, # coefficients domain of `L' 2843 BL, # basis of `L' 2844 H, # A Cartan subalgebra of `L' 2845 basH, # A basis of `H' 2846 sp, # A vector space 2847 B, # A list of bases of subspaces of `L' whose direct sum 2848 # is equal to `L' 2849 newB, # A new version of `B' being constructed 2850 i,j,l, # Loop variables 2851 facs, # List of the factors of `p' 2852 V, # A basis of a subspace of `L' 2853 M, # A matrix 2854 cf, # A scalar 2855 a, # A root vector 2856 ind, # An index 2857 basR, # A basis of the root system 2858 h, # An element of `H' 2859 posR, # A list of the positive roots 2860 fundR, # A list of the fundamental roots 2861 issum, # A boolean 2862 CartInt, # The function that calculates the Cartan integer of 2863 # two roots 2864 C, # The Cartan matrix 2865 S, # A list of the root vectors 2866 zero, # zero of `F' 2867 hts, # A list of the heights of the root vectors 2868 sorh, # The set `Set( hts )' 2869 sorR, # The soreted set of roots 2870 R, # The root system. 2871 Rvecs, # The root vectors. 2872 x,y, # Canonical generators. 2873 noPosR; # Number of positive roots. 2874 2875 # Let `a' and `b' be two roots of the rootsystem `R'. 2876 # Let `s' and `t' be the largest integers such that `a-s*b' and `a+t*b' 2877 # are roots. 2878 # Then the Cartan integer of `a' and `b' is `s-t'. 2879 CartInt := function( R, a, b ) 2880 local s,t,rt; 2881 s:=0; t:=0; 2882 rt:=a-b; 2883 while (rt in R) or (rt=0*R[1]) do 2884 rt:=rt-b; 2885 s:=s+1; 2886 od; 2887 rt:=a+b; 2888 while (rt in R) or (rt=0*R[1]) do 2889 rt:=rt+b; 2890 t:=t+1; 2891 od; 2892 return s-t; 2893 end; 2894 2895 F:= LeftActingDomain( L ); 2896 2897 if DeterminantMat( KillingMatrix( Basis( L ) ) ) = Zero( F ) then 2898 Info( InfoAlgebra, 1, "the Killing form of <L> is degenerate" ); 2899 return fail; 2900 fi; 2901 2902 2903 # First we compute the common eigenvectors of the adjoint action of a 2904 # Cartan subalgebra `H'. Here `B' will be a list of bases of subspaces 2905 # of `L' such that `H' maps each element of `B' into itself. 2906 # Furthermore, `B' has maximal length w.r.t. this property. 2907 2908 H:= CartanSubalgebra( L ); 2909 BL:= Basis( L ); 2910 B:= [ ShallowCopy( BasisVectors( BL ) ) ]; 2911 basH:= BasisVectors( Basis( H ) ); 2912 2913 for i in basH do 2914 2915 newB:= [ ]; 2916 for j in B do 2917 2918 V:= Basis( VectorSpace( F, j, "basis" ), j ); 2919 M:= List( j, x -> Coefficients( V, i*x ) ); 2920 facs:= Factors( MinimalPolynomial( F, M ) ); 2921 2922 for l in facs do 2923 V:= NullspaceMat( Value( l, M ) ); 2924 Add( newB, List( V, x -> LinearCombination( j, x ) ) ); 2925 od; 2926 2927 od; 2928 B:= newB; 2929 2930 od; 2931 2932 # Now we throw away the subspace `H'. 2933 2934 B:= Filtered( B, x -> ( not x[1] in H ) ); 2935 2936 # If an element of `B' is not one dimensional then `H' does not split 2937 # completely, and hence we cannot compute the root system. 2938 2939 for i in [ 1 .. Length(B) ] do 2940 if Length( B[i] ) <> 1 then 2941 Info( InfoAlgebra, 1, "the Cartan subalgebra of <L> in not split" ); 2942 return fail; 2943 fi; 2944 od; 2945 2946 # Now we compute the set of roots `S'. 2947 # A root is just the list of eigenvalues of the basis elements of `H' 2948 # on an element of `B'. 2949 2950 S:= []; 2951 zero:= Zero( F ); 2952 for i in [ 1 .. Length(B) ] do 2953 a:= [ ]; 2954 ind:= 0; 2955 cf:= zero; 2956 while cf = zero do 2957 ind:= ind+1; 2958 cf:= Coefficients( BL, B[i][1] )[ ind ]; 2959 od; 2960 for j in [1..Length(basH)] do 2961 Add( a, Coefficients( BL, basH[j]*B[i][1] )[ind] / cf ); 2962 od; 2963 Add( S, a ); 2964 od; 2965 2966 Rvecs:= List( B, x -> x[1] ); 2967 2968 # A set of roots `basR' is calculated such that the set 2969 # { [ x_r, x_{-r} ] | r\in R } is a basis of `H'. 2970 2971 basH:= [ ]; 2972 basR:= [ ]; 2973 sp:= MutableBasis( F, [], Zero(L) ); 2974 i:=1; 2975 while Length( basH ) < Dimension( H ) do 2976 a:= S[i]; 2977 j:= Position( S, -a ); 2978 h:= B[i][1]*B[j][1]; 2979 if not IsContainedInSpan( sp, h ) then 2980 CloseMutableBasis( sp, h ); 2981 Add( basR, a ); 2982 Add( basH, h ); 2983 fi; 2984 i:=i+1; 2985 od; 2986 2987 # A root `a' is said to be positive if the first nonzero element of 2988 # `[ CartInt( S, a, basR[j] ) ]' is positive. 2989 # We calculate the set of positive roots. 2990 2991 posR:= [ ]; 2992 i:=1; 2993 while Length( posR ) < Length( S )/2 do 2994 a:= S[i]; 2995 if (not a in posR) and (not -a in posR) then 2996 cf:= zero; 2997 j:= 0; 2998 while cf = zero do 2999 j:= j+1; 3000 cf:= CartInt( S, a, basR[j] ); 3001 od; 3002 if 0 < cf then 3003 Add( posR, a ); 3004 else 3005 Add( posR, -a ); 3006 fi; 3007 fi; 3008 i:=i+1; 3009 od; 3010 3011 # A positive root is called simple if it is not the sum of two other 3012 # positive roots. 3013 # We calculate the set of simple roots `fundR'. 3014 3015 fundR:= [ ]; 3016 for a in posR do 3017 issum:= false; 3018 for i in [1..Length(posR)] do 3019 for j in [i+1..Length(posR)] do 3020 if a = posR[i]+posR[j] then 3021 issum:=true; 3022 fi; 3023 od; 3024 od; 3025 if not issum then 3026 Add( fundR, a ); 3027 fi; 3028 od; 3029 3030 # Now we calculate the Cartan matrix `C' of the root system. 3031 3032 C:= List( fundR, i -> List( fundR, j -> CartInt( S, i, j ) ) ); 3033 3034 # Every root can be written as a sum of the simple roots. 3035 # The height of a root is the sum of the coefficients appearing 3036 # in that expression. 3037 # We order the roots according to increasing height. 3038 3039 V:= BasisNC( VectorSpace( F, fundR ), fundR ); 3040 hts:= List( posR, r -> Sum( Coefficients( V, r ) ) ); 3041 sorh:= Set( hts ); 3042 3043 sorR:= [ ]; 3044 for i in [1..Length(sorh)] do 3045 Append( sorR, Filtered( posR, r -> hts[Position(posR,r)] = sorh[i] ) ); 3046 od; 3047 Append( sorR, -1*sorR ); 3048 Rvecs:= List( sorR, r -> Rvecs[ Position(S,r) ] ); 3049 3050 # We calculate a set of canonical generators of `L'. Those are elements 3051 # x_i, y_i, h_i such that h_i=x_i*y_i, h_i*x_j = c_{ij} x_j, 3052 # h_i*y_j = -c_{ij} y_j for i \in {1..rank} 3053 3054 x:= Rvecs{[1..Length(C)]}; 3055 noPosR:= Length( Rvecs )/2; 3056 y:= Rvecs{[1+noPosR..Length(C)+noPosR]}; 3057 for i in [1..Length(x)] do 3058 V:= VectorSpace( LeftActingDomain(L), [ x[i] ] ); 3059 B:= Basis( V, [x[i]] ); 3060 y[i]:= y[i]*2/Coefficients( B, (x[i]*y[i])*x[i] )[1]; 3061 od; 3062 3063 h:= List([1..Length(C)], j -> x[j]*y[j] ); 3064 3065 # Now we construct the root system, and install as many attributes 3066 # as possible. The roots are represented als lists [ \alpha(h_1),.... 3067 # ,\alpha(h_l)], where the h_i form the `Cartan' part of the canonical 3068 # generators. 3069 3070 R:= Objectify( NewType( NewFamily( "RootSystemFam", IsObject ), 3071 IsAttributeStoringRep and IsRootSystemFromLieAlgebra ), 3072 rec() ); 3073 SetCanonicalGenerators( R, [ x, y, h ] ); 3074 SetUnderlyingLieAlgebra( R, L ); 3075 SetPositiveRootVectors( R, Rvecs{[1..noPosR]}); 3076 SetNegativeRootVectors( R, Rvecs{[noPosR+1..2*noPosR]} ); 3077 SetCartanMatrix( R, C ); 3078 3079 posR:= [ ]; 3080 for i in [1..noPosR] do 3081 B:= Basis( VectorSpace( F, [ Rvecs[i] ] ), [ Rvecs[i] ] ); 3082 posR[i]:= List( h, hj -> Coefficients( B, hj*Rvecs[i] )[1] ); 3083 od; 3084 3085 SetPositiveRoots( R, posR ); 3086 SetNegativeRoots( R, -posR ); 3087 SetSimpleSystem( R, posR{[1..Length(C)]} ); 3088 3089 return R; 3090 3091 end ); 3092 3093 3094############################################################################## 3095## 3096#M CanonicalGenerators( <R> ) . . . . for a root system from a Lie algebra 3097## 3098InstallMethod( CanonicalGenerators, 3099 "for a root system from a (semisimple) Lie algebra", 3100 true, 3101 [ IsRootSystemFromLieAlgebra ], 0, 3102 function( R ) 3103 3104 local L, rank, x, y, i, V, b, c; 3105 3106 L:= UnderlyingLieAlgebra( R ); 3107 rank:= Length( CartanMatrix( R ) ); 3108 x:= PositiveRootVectors( R ){[1..rank]}; 3109 y:= NegativeRootVectors( R ){[1..rank]}; 3110 for i in [1..Length(x)] do 3111 V:= VectorSpace( LeftActingDomain(L), [ x[i] ] ); 3112 b:= Basis( V, [x[i]] ); 3113 c:= Coefficients( b, (x[i]*y[i])*x[i] )[1]; 3114 y[i]:= y[i]*2/c; 3115 od; 3116 3117 return [ x, y, List([1..rank], j -> x[j]*y[j] ) ]; 3118 3119end ); 3120 3121############################################################################# 3122## 3123#M ChevalleyBasis( <L> ) . . . . . . for a semisimple Lie algebra 3124## 3125InstallMethod( ChevalleyBasis, 3126 "for a semisimple Lie algebra with a split Cartan subalgebra", 3127 true, [ IsLieAlgebra ], 0, 3128 function( L ) 3129 3130 local R, n, cg, b1p, b1m, b2p, b2m, k, r, i, r1, pos, 3131 b1, b2, f, cfs, bHa, posRV, negRV, x, y, ha, cf, 3132 F, T, K, B, BK; 3133 3134 # We first calculate an automorphism `f' of `L' such that 3135 # F(L_{\alpha}) = L_{-\alpha}, and f(H)=H, and f acts as multiplication 3136 # by -1 on H. For this we take the canonical generators of `L', 3137 # map its `x'-part onto its `y' part (and vice versa), and map 3138 # the `h'-part on minus itself. The automorphism is determined by this. 3139 3140 R:= RootSystem( L ); 3141 n:= Length( PositiveRoots( R ) ); 3142 cg:= CanonicalGenerators( R ); 3143 3144 b1p:= ShallowCopy( cg[1] ); b1m:= ShallowCopy( cg[2] ); 3145 b2p:= ShallowCopy( cg[2] ); b2m:= ShallowCopy( cg[1] ); 3146 3147 k:= 1; 3148 while k <= n do 3149 r:= PositiveRoots( R )[k]; 3150 for i in [1..Length( CartanMatrix( R ) )] do 3151 r1:= r + SimpleSystem( R )[i]; 3152 pos:= Position( PositiveRoots( R ), r1 ); 3153 if pos<>fail and not IsBound( b1p[pos] ) then 3154 3155 b1p[pos]:= cg[1][i]*b1p[k]; 3156 b1m[pos]:= cg[2][i]*b1m[k]; 3157 b2p[pos]:= cg[2][i]*b2p[k]; 3158 b2m[pos]:= cg[1][i]*b2m[k]; 3159 fi; 3160 od; 3161 k:= k+1; 3162 od; 3163 3164 b1:= b1p; Append( b1, b1m ); Append( b1, cg[3] ); 3165 b2:= b2p; Append( b2, b2m ); Append( b2, -cg[3] ); 3166 f:= LeftModuleHomomorphismByImages( L, L, b1, b2 ); 3167 3168 # Now for every positive root vector `x' we set `y= -Image( f, x )'. 3169 # We compute a scalar `cf' such that `[x,y]=h', where `h' is the 3170 # canonical Cartan element corresponding to the root (unquely determined). 3171 # Then we have to multiply `x' and `y' by Sqrt( 2/cf ), in order to get 3172 # elements of a Chevalley basis. 3173 3174 cfs:= [ ]; 3175 bHa:= [ ]; 3176 posRV:= [ ]; 3177 negRV:= [ ]; 3178 for i in [1..n] do 3179 x:= PositiveRootVectors( R )[i]; 3180 y:= -Image( f, x ); 3181 ha:= x*y; 3182 cf:= Coefficients( Basis( VectorSpace( LeftActingDomain(L), 3183 [x] ), [x] ), ha*x )[1]; 3184 if i <= Length( CartanMatrix( R ) ) then Add( bHa, (2/cf)*ha ); fi; 3185 Add( cfs, Sqrt( 2/cf ) ); 3186 posRV[i]:= x; negRV[i]:= y; 3187 od; 3188 3189 # In general the `cfs' will lie in a field extension of the ground field. 3190 # We construct the Lie algebra over that field with the same structure 3191 # constants as `L'. Then we map the Chevalley basis elements into 3192 # this new Lie algebra. Then we take the structure constants table of 3193 # this new Lie algebra with respect to the Chevalley basis, and 3194 # form a new Lie algebra over the same field as `L' with this table. 3195 3196 F:= DefaultField( cfs ); 3197 T:= StructureConstantsTable( Basis( L ) ); 3198 K:= LieAlgebraByStructureConstants( F, T ); 3199 BK:= CanonicalBasis( K ); 3200 B:= [ ]; 3201 for i in [1..n] do 3202 B[i]:= LinearCombination( BK, cfs[i]*Coefficients( Basis(L), 3203 posRV[i] ) ); 3204 B[n+i]:= LinearCombination( BK, cfs[i]*Coefficients( Basis(L), 3205 negRV[i] ) ); 3206 od; 3207 for i in [1..Length(bHa)] do 3208 B[2*n+i]:= LinearCombination( BK, Coefficients( Basis(L), 3209 bHa[i] ) ); 3210 od; 3211 3212 T:= StructureConstantsTable( Basis( K, B ) ); 3213 K:= LieAlgebraByStructureConstants( LeftActingDomain(L), T ); 3214 B:= BasisVectors( CanonicalBasis( K ) ); 3215 3216 # Now the basis elements of `K' form a Chevalley basis. Furthermore, 3217 # `K' is isomorphic to `L'. We construct the isomorphism, and map 3218 # the basis elements of `K' into `L', thus getting a Chevalley basis 3219 # in `L'. 3220 3221 b1p:= B{[1..Length(CartanMatrix(R))]}; 3222 b1m:= B{[n+1..n+Length(CartanMatrix(R))]}; 3223 b2p:= ShallowCopy( cg[1] ); b2m:= ShallowCopy( cg[2] ); 3224 3225 k:= 1; 3226 while k <= n do 3227 r:= PositiveRoots( R )[k]; 3228 for i in [1..Length( CartanMatrix( R ) )] do 3229 r1:= r + SimpleSystem( R )[i]; 3230 pos:= Position( PositiveRoots( R ), r1 ); 3231 if pos<>fail and not IsBound( b1p[pos] ) then 3232 3233 b1p[pos]:= b1p[i]*b1p[k]; 3234 b1m[pos]:= b1m[i]*b1m[k]; 3235 b2p[pos]:= b2p[i]*b2p[k]; 3236 b2m[pos]:= b2m[i]*b2m[k]; 3237 fi; 3238 od; 3239 k:= k+1; 3240 od; 3241 3242 b1:= b1p; Append( b1, b1m ); Append( b1, B{[2*n+1..Length(B)]} ); 3243 b2:= b2p; Append( b2, b2m ); Append( b2, cg[3] ); 3244 f:= LeftModuleHomomorphismByImages( K, L, b1, b2 ); 3245 3246 return [ List( B{[1..n]}, x -> Image( f, x ) ), 3247 List( B{[n+1..2*n]}, y -> Image( f, y ) ), 3248 cg[3] ]; 3249 3250 3251 end); 3252 3253 3254 3255############################################################################# 3256## 3257#F DescriptionOfNormalizedUEAElement( <T>, <listofpairs> ) 3258## 3259InstallGlobalFunction( DescriptionOfNormalizedUEAElement, 3260 function( T, listofpairs ) 3261 3262 local normalized, # ordered list of normalized coeff./monom. pairs 3263 indices, # list that stores at position $i$ up to what 3264 # position the $i$-th monomial is known to be 3265 # normalized 3266 s, i, j, k, l, # loop variables 3267 2i, # `2*i' 3268 scalar, # coefficient of the monomial under work 3269 mon, # monomial under work 3270 len, # length of the monomial under work 3271 head, # initial part of the monomial under work 3272 middle, # middle part of the monomial under work 3273 tail, # trailing part of the monomial under work 3274 index, # new value of `indices[i]' 3275 Tcoeffs, # one entry in `T' 3276 lennorm, # length of `normalized' at the moment 3277 zero; # zero coefficient 3278 3279 normalized := []; 3280 3281 while not IsEmpty( listofpairs ) do 3282 3283 listofpairs:= Compacted( listofpairs ); 3284 3285 # `indices' is a list of positive integers $[ j_1, j_2, \ldots, j_m ]$ 3286 # s.t. the initial part $x_{i_1}^{e_1} \cdots x_{i_{j_k}}^{e_{j_k}}$ 3287 # of the $k$-th monomial is known to be normalized, 3288 # i.e., $i_1 < i_2 < \cdots < i_{j_k}$. 3289 # (So $j_k = 1$ for all $k$ will always be correct.) 3290 indices:= ListWithIdenticalEntries( Length( listofpairs )/2, 1 ); 3291 3292 # Loop over the monomials that shall be normalized. 3293 for i in [ 1, 2 .. Length( indices ) ] do 3294 3295 # If the `i'-th monomial is already normalized, 3296 # put it into `normalized'. 3297 # Otherwise swap the first non-ordered generators. 3298 2i:= 2*i; 3299 scalar:= listofpairs[ 2i ]; 3300 mon:= listofpairs[ 2i-1 ]; 3301 len:= Length( mon ); 3302 j:= 2 * indices[i] - 1; 3303 while j < len - 2 do 3304 3305 if mon[j] < mon[ j+2 ] then 3306 3307 # `mon' is better normalized than `indices' tells. 3308 j:= j+2; 3309 indices[i]:= indices[i] + 1; 3310 3311 elif mon[j] = mon[ j+2 ] then 3312 3313 # absorption 3314 mon[ j+1 ]:= mon[ j+1 ] + mon[ j+3 ]; 3315 for k in [ j+2 .. len-2 ] do 3316 mon[k]:= mon[ k+2 ]; 3317 od; 3318 Unbind( mon[ len ] ); 3319 Unbind( mon[ len-1 ] ); 3320 len:= len - 2; 3321 3322 else 3323 3324 # We must swap two generators. 3325 # First construct head and tail of the arising monomials. 3326 head:= mon{ [ 1 .. j-1 ] }; 3327 3328 middle:= [ mon[ j+2 ], mon[j+3], mon[j], mon[j+1] ]; 3329 3330 tail:= mon{ [ j+4 .. len ] }; 3331 3332 # Adjust `indices[i]'. 3333 index:= indices[i] - 1; 3334 if index = 0 then 3335 index:= 1; 3336 fi; 3337 3338 indices[i]:= index; 3339 3340 # Replace the monomial by the swapped one. 3341 listofpairs[ 2i-1 ]:= Concatenation( head, middle, tail ); 3342 3343 # Add the coeffs/monomials that are given by the commutator. 3344 # The part between `head' and `tail' of these listofpairs is 3345 # $a_{ji}=\sum_{k=1}^d c_{ijk} x_d$. 3346 # Here we use the following formula (which is easily proved 3347 # by induction): 3348 # 3349 # x_j^m x_i^n = x_i^n x_j^m + \sum_{l=0}^{m-1} \sum_{k=0}^{n-1} 3350 # x_j^l x_i^k a_{ji} x_i^{n-1-k} x_j^{m-1-l} 3351 # 3352 # 3353 # where x_jx_i = x_ix_j + a_{ji} 3354 # 3355 Tcoeffs:= T[ mon[j] ][ mon[ j+2 ] ]; 3356 for s in [ 1 .. Length( Tcoeffs[1] ) ] do 3357 for l in [ 0 .. mon[j+1] - 1 ] do 3358 for k in [ 0 .. mon[j+3] - 1 ] do 3359 3360 middle:= [ ]; 3361 3362 if l > 0 then 3363 middle:= [ mon[j], l ]; 3364 fi; 3365 if k > 0 then 3366 Append( middle, [ mon[j+2], k ] ); 3367 fi; 3368 Append( middle, [ Tcoeffs[1][s], 1 ] ); 3369 if mon[j+3]-1-k > 0 then 3370 Append( middle, [ mon[j+2], mon[j+3]-1-k ] ); 3371 fi; 3372 if mon[j+1]-1-l > 0 then 3373 Append( middle, [ mon[j], mon[j+1]-1-l ] ); 3374 fi; 3375 3376 Append( listofpairs, 3377 [ Concatenation( head, middle, tail ), 3378 scalar * Tcoeffs[2][s] ] ); 3379 Add( indices, index ); 3380 od; 3381 od; 3382 od; 3383 3384 break; 3385 3386 fi; 3387 3388 od; 3389 3390 # If the monomial is normalized then move it to `normalized'. 3391 if len - 2 <= j then 3392 3393 # Find the correct position in `normalized', 3394 # and insert the monomial. 3395 lennorm:= Length( normalized ); 3396 k:= 2; 3397 while k <= lennorm do 3398 if listofpairs[ 2i-1 ] < normalized[ k-1 ] then 3399 for l in [ lennorm, lennorm-1 .. k-1 ] do 3400 normalized[l+2]:= normalized[l]; 3401 od; 3402 normalized[ k-1 ]:= listofpairs[ 2i-1 ]; 3403 normalized[ k ]:= scalar; 3404 break; 3405 elif listofpairs[ 2i-1 ] = normalized[ k-1 ] then 3406 normalized[k]:= normalized[k] + scalar; 3407 break; 3408 fi; 3409 k:= k+2; 3410 od; 3411 if lennorm < k then 3412 normalized[ lennorm+1 ]:= listofpairs[ 2i-1 ]; 3413 normalized[ lennorm+2 ]:= scalar; 3414 fi; 3415 3416 # Remove the monomial from `listofpairs'. 3417 Unbind( listofpairs[ 2i-1 ] ); 3418 Unbind( listofpairs[ 2i ] ); 3419 3420 fi; 3421 3422 od; 3423 3424 od; 3425 3426 # Remove monomials with multiplicity zero; 3427 if not IsEmpty( normalized ) then 3428 zero:= Zero( normalized[2] ); 3429 for i in [ 2, 4 .. Length( normalized ) ] do 3430 if normalized[i] = zero then 3431 Unbind( normalized[ i-1 ] ); 3432 Unbind( normalized[ i ] ); 3433 fi; 3434 od; 3435 normalized:= Compacted( normalized ); 3436 fi; 3437 3438 # Return the normal form. 3439 return normalized; 3440end ); 3441 3442 3443############################################################################# 3444## 3445#M UniversalEnvelopingAlgebra( <L> ) . . . . . . . . . . . for a Lie algebra 3446## 3447InstallOtherMethod( UniversalEnvelopingAlgebra, 3448 "for a finite dimensional Lie algebra and a basis of it", 3449 true, 3450 [ IsLieAlgebra, IsBasis ], 0, 3451 function( L, B ) 3452 3453 local F, # free associative algebra 3454 U, # universal enveloping algebra, result 3455 gen, # loop over algebra generators of `U' 3456 Fam, # elements family of `U' 3457 T, # s.c. table of a basis of `L' 3458 FamMon, # family of monomials 3459 FamFree; # elements family of `F' 3460 3461 # Check the argument. 3462 if not IsFiniteDimensional( L ) then 3463 Error( "<L> must be finite dimensional" ); 3464 fi; 3465 3466 # Construct the universal enveloping algebra. 3467 F:= FreeAssociativeAlgebraWithOne( LeftActingDomain( L ), 3468 Dimension( L ), "x" ); 3469 U:= FactorFreeAlgebraByRelators( F, [ Zero( F ) ] ); 3470#T do not cheat here! 3471 3472 # Enter knowledge about `U'. 3473 SetDimension( U, infinity ); 3474 for gen in GeneratorsOfLeftOperatorRingWithOne( U ) do 3475 SetIsNormalForm( gen, true ); 3476 od; 3477 SetIsNormalForm( Zero( U ), true ); 3478 3479 # Enter data to handle elements. 3480 Fam:= ElementsFamily( FamilyObj( U ) ); 3481 Fam!.normalizedType:= NewType( Fam, 3482 IsElementOfFpAlgebra 3483 and IsPackedElementDefaultRep 3484 and IsNormalForm ); 3485 3486 T:= StructureConstantsTable( B ); 3487 FamMon:= ElementsFamily( FamilyObj( UnderlyingMagma( F ) ) ); 3488 FamFree:= ElementsFamily( FamilyObj( F ) ); 3489 3490 SetNiceNormalFormByExtRepFunction( Fam, 3491 function( Fam, extrep ) 3492 local zero, i; 3493 zero:= extrep[1]; 3494 extrep:= DescriptionOfNormalizedUEAElement( T, extrep[2] ); 3495 for i in [ 1, 3 .. Length( extrep ) - 1 ] do 3496 extrep[i]:= ObjByExtRep( FamMon, extrep[i] ); 3497 od; 3498 return Objectify( Fam!.normalizedType, 3499 [ Objectify( FamFree!.defaultType, [ zero, extrep ] ) ] ); 3500 end ); 3501 3502 SetOne( U, ElementOfFpAlgebra( Fam, One( F ) ) ); 3503 3504 # Enter `L'; it is used to set up the embedding (as a vector space). 3505 Fam!.liealgebra:= L; 3506#T is not allowed ... 3507 3508 # Return the universal enveloping algebra. 3509 return U; 3510 end ); 3511 3512#T missing: embedding of the Lie algebra (as vector space) 3513#T missing: relators (only compute them if they are explicitly wanted) 3514#T (attribute `Relators'?) 3515 3516InstallMethod( UniversalEnvelopingAlgebra, 3517 "for a finite dimensional Lie algebra", 3518 true, 3519 [ IsLieAlgebra ], 0, 3520 function( L ) 3521 3522 return UniversalEnvelopingAlgebra( L, Basis(L) ); 3523end ); 3524 3525 3526############################################################################# 3527## 3528#F IsSpaceOfUEAElements( <V> ) 3529## 3530## If <V> is a space of elements of a universal enveloping algebra, 3531## then the `NiceFreeLeftModuleInfo' value of <V> is a record with the 3532## following components. 3533## \beginitems 3534## `family' & 3535## the elements family of <V>, 3536## 3537## `monomials' & 3538## a list of monomials occurring in the generators of <V>, 3539## 3540## 3541## `zerocoeff' & 3542## the zero coefficient of elements in <V>, 3543## 3544## `zerovector' & 3545## the zero row vector in the nice free left module, 3546## 3547## `characteristic' & 3548## the characteristic of the ground field. 3549## \enditems 3550## The `NiceVector' value of $v \in <V>$ is defined as the row vector of 3551## coefficients of $v$ w.r.t. the list `monomials'. 3552## 3553## 3554DeclareHandlingByNiceBasis( "IsSpaceOfUEAElements", 3555 "for free left modules of elements of a universal enveloping algebra" ); 3556 3557 3558############################################################################# 3559## 3560#M NiceFreeLeftModuleInfo( <V> ) 3561#M NiceVector( <V>, <v> ) 3562#M UglyVector( <V>, <r> ) 3563## 3564InstallHandlingByNiceBasis( "IsSpaceOfUEAElements", rec( 3565 detect := function( F, gens, V, zero ) 3566 return IsElementOfFpAlgebraCollection( V ); 3567 end, 3568 3569 NiceFreeLeftModuleInfo := function( V ) 3570 local gens, 3571 monomials, 3572 gen, 3573 list, 3574 zero, 3575 info; 3576 3577 gens:= GeneratorsOfLeftModule( V ); 3578 3579 monomials:= []; 3580 3581 for gen in gens do 3582 list:= ExtRepOfObj( gen )[2]; 3583 UniteSet( monomials, list{ [ 1, 3 .. Length( list ) - 1 ] } ); 3584 od; 3585 3586 zero:= Zero( LeftActingDomain( V ) ); 3587 info:= rec( monomials := monomials, 3588 zerocoeff := zero, 3589 characteristic:= Characteristic( LeftActingDomain( V ) ), 3590 family := ElementsFamily( FamilyObj( V ) ) ); 3591 3592 # For the zero row vector, catch the case of empty `monomials' list. 3593 if IsEmpty( monomials ) then 3594 info.zerovector := MakeImmutable([ zero ]); 3595 else 3596 info.zerovector := MakeImmutable(ListWithIdenticalEntries( Length( monomials ), 3597 zero ) ); 3598 fi; 3599 3600 return info; 3601 end, 3602 3603 NiceVector := function( V, v ) 3604 local info, c, monomials, i, pos; 3605 info:= NiceFreeLeftModuleInfo( V ); 3606 c:= ShallowCopy( info.zerovector ); 3607 v:= ExtRepOfObj( v )[2]; 3608 monomials:= info.monomials; 3609 for i in [ 2, 4 .. Length( v ) ] do 3610 pos:= Position( monomials, v[ i-1 ] ); 3611 if pos = fail then 3612 return fail; 3613 fi; 3614 c[ pos ]:= v[i]; 3615 od; 3616 return c; 3617 end, 3618 3619 UglyVector := function( V, r ) 3620 local info, list, i; 3621 info:= NiceFreeLeftModuleInfo( V ); 3622 if Length( r ) <> Length( info.zerovector ) then 3623 return fail; 3624 elif IsEmpty( info.monomials ) then 3625 if IsZero( r ) then 3626 return Zero( V ); 3627 else 3628 return fail; 3629 fi; 3630 fi; 3631 list:= []; 3632 for i in [ 1 .. Length( r ) ] do 3633 if r[i] <> info.zerocoeff then 3634 Add( list, info.monomials[i] ); 3635 Add( list, r[i] ); 3636 fi; 3637 od; 3638 return ObjByExtRep( info.family, [ info.characteristic, list ] ); 3639 end ) ); 3640 3641 3642 3643 3644 3645############################################################################# 3646## 3647#F FreeLieAlgebra( <R>, <rank> ) 3648#F FreeLieAlgebra( <R>, <rank>, <name> ) 3649#F FreeLieAlgebra( <R>, <name1>, <name2>, ... ) 3650## 3651InstallGlobalFunction( FreeLieAlgebra, function( arg ) 3652 3653 local R, # coefficients ring 3654 names, # names of the algebra generators 3655 M, # free magma 3656 F, # family of magma ring elements 3657 one, # identity of `R' 3658 zero, # zero of `R' 3659 L; # free Lie algebra, result 3660 3661 3662 # Check the argument list. 3663 if Length( arg ) = 0 or not IsRing( arg[1] ) then 3664 Error( "first argument must be a ring" ); 3665 fi; 3666 3667 R:= arg[1]; 3668 3669 # Construct names of generators. 3670 if Length( arg ) = 2 and IsInt( arg[2] ) then 3671 names:= List( [ 1 .. arg[2] ], 3672 i -> Concatenation( "x", String(i) ) ); 3673 MakeImmutable( names ); 3674 elif Length( arg ) = 2 3675 and IsList( arg[2] ) 3676 and ForAll( arg[2], IsString ) then 3677 names:= arg[2]; 3678 elif Length( arg ) = 3 and IsInt( arg[2] ) and IsString( arg[3] ) then 3679 names:= List( [ 1 .. arg[2] ], 3680 x -> Concatenation( arg[3], String(x) ) ); 3681 MakeImmutable( names ); 3682 elif ForAll( arg{ [ 2 .. Length( arg ) ] }, IsString ) then 3683 names:= arg{ [ 2 .. Length( arg ) ] }; 3684 else 3685 Error( "usage: FreeLieAlgebra( <R>, <rank> )\n", 3686 "or FreeLieAlgebra( <R>, <name1>, ... )" ); 3687 fi; 3688 3689 # Construct the algebra as magma algebra modulo relations 3690 # over a free magma. 3691 M:= FreeMagma( names ); 3692 3693 # Construct the family of elements of our ring. 3694 F:= NewFamily( "FreeLieAlgebraObjFamily", 3695 IsElementOfMagmaRingModuloRelations, 3696 IsJacobianElement and IsZeroSquaredElement ); 3697 SetFilterObj( F, IsFamilyElementOfFreeLieAlgebra ); 3698 3699 one:= One( R ); 3700 zero:= Zero( R ); 3701 3702 F!.defaultType := NewType( F, IsMagmaRingObjDefaultRep ); 3703 F!.familyRing := FamilyObj( R ); 3704 F!.familyMagma := FamilyObj( M ); 3705 F!.zeroRing := zero; 3706#T no !! 3707 F!.names := names; 3708 3709 # Set the characteristic. 3710 if HasCharacteristic( R ) or HasCharacteristic( FamilyObj( R ) ) then 3711 SetCharacteristic( F, Characteristic( R ) ); 3712 fi; 3713 3714 3715 # Make the magma ring object. 3716 L:= Objectify( NewType( CollectionsFamily( F ), 3717 IsMagmaRingModuloRelations 3718 and IsAttributeStoringRep ), 3719 rec() ); 3720 3721 # Set the necessary attributes. 3722 SetLeftActingDomain( L, R ); 3723 SetUnderlyingMagma( L, M ); 3724 3725 # Deduce useful information. 3726 SetIsFiniteDimensional( L, false ); 3727 if HasIsWholeFamily( R ) and HasIsWholeFamily( M ) then 3728 SetIsWholeFamily( L, IsWholeFamily( R ) and IsWholeFamily( M ) ); 3729 fi; 3730 3731 # Construct the generators. 3732 SetGeneratorsOfLeftOperatorRing( L, 3733 List( GeneratorsOfMagma( M ), 3734 x -> ElementOfMagmaRing( F, zero, [ one ], [ x ] ) ) ); 3735 3736 # Install grading 3737 SetGrading( L, rec( min_degree := 1, 3738 max_degree := infinity, 3739 source := Integers, 3740 hom_components := function(degree) 3741 local B, d, i, x, y, z; 3742 B := GeneratorsOfMagma(M); 3743 B := [List([1..Length(B)],i->[[i],fail,B[i]])]; 3744 for d in [2..degree] do 3745 Add(B,[]); 3746 for i in [1..d-1] do 3747 for x in B[i] do for y in B[d-i] do 3748 z := Concatenation(x[1],y[1]); 3749 if z<y[1] and x[1]<y[1] and (x[2]=fail or x[2]>=y[1]) then 3750 Add(B[d],[z,y[1],x[3]*y[3]]); 3751 fi; 3752 od; od; 3753 od; 3754 od; 3755 return VectorSpace( R, List( B[degree], 3756 p->ElementOfMagmaRing( F, zero, [ one ], [ p[3] ] ))); 3757 end) ); 3758 # Return the ring. 3759 return L; 3760end ); 3761 3762 3763############################################################################# 3764## 3765#M NormalizedElementOfMagmaRingModuloRelations( <Fam>, <descr> ) 3766## 3767## <descr> is a list of the form `[ <z>, <list> ]', <z> being the zero 3768## coefficient of the ring, and <list> being the list of monomials and 3769## their coefficients. 3770## This function returns the element described in <descr> expanded on 3771## the Lyndon basis of the free Lie algebra. In order to do this we do not 3772## need to know this basis; we only need a test whether something is a 3773## Lyndon element (this is done in the function `IsLyndonT'). 3774## For the algorithm we refer to C. Reutenauer, Free Lie Algebras, Clarendon 3775## Press, Oxford, 1993. 3776## 3777InstallMethod( NormalizedElementOfMagmaRingModuloRelations, 3778 "for family of free Lie algebra elements, and list", 3779 true, 3780 [ IsFamilyElementOfFreeLieAlgebra, IsList ], 0, 3781 function( Fam, descr ) 3782 3783 local todo, #The list of elements that are to be expanded 3784 k,i, #Loop variables 3785 z,s,u,v,x,y,w, #Bracketed expressions (or `trees') 3786 cf, #Coefficient 3787 found, #Boolean 3788 ll, #List 3789 zero, #The zero element of the field 3790 tlist, #List of elements of the free Lie algebra 3791 Dcopy,IsLyndonT; #Two functions 3792 3793 Dcopy:=function( l ) 3794 3795 if not IsList(l) then return ShallowCopy( l ); fi; 3796 return List( l, Dcopy ); 3797 end; 3798 3799 IsLyndonT:= function( t ) 3800 3801 # This function tests whether the bracketed expression `t' is 3802 # a Lyndon tree. 3803 3804 local w,w1,w2,b,y; 3805 3806 if not IsList( t ) then return true; fi; 3807 3808 w:= Flat( t ); 3809 if IsList( t[1] ) then 3810 w1:= Flat( t[1] ); 3811 b:= false; 3812 else 3813 w1:= [ t[1] ]; 3814 b:=true; 3815 fi; 3816 if IsList( t[2] ) then 3817 w2:= Flat( t[2] ); 3818 else 3819 w2:= [ t[2] ]; 3820 fi; 3821 3822 if w<w2 and w1<w2 then 3823 if not b then 3824 y:= Flat( [ t[1][2] ] ); 3825 if y < w2 then return false; fi; 3826 fi; 3827 else 3828 return false; 3829 fi; 3830 3831 if not IsLyndonT( t[1] ) then return false; fi; 3832 if not IsLyndonT( t[2] ) then return false; fi; 3833 return true; 3834 3835 end; 3836 3837 zero:= descr[1]; 3838 todo:= [ ]; 3839 i:= 1; 3840 3841# Every element in `todo' has the following format: [ bool, cf, br ], 3842# where bool is a boolean; it is true if the br is a Lyndon tree. 3843# cf is the coeffient (number) and br is a bracketed expression. 3844# The reason for `tagging' everything is that almost anywhere in the 3845# list cancellations may occur. This tagging provides an efficient way 3846# of remembering which trees were dealt with before. 3847 3848 while i+1 <= Length(descr[2]) do 3849 Add( todo, [ false, descr[2][i+1], ExtRepOfObj( descr[2][i] ) ] ); 3850 i:= i+2; 3851 od; 3852 3853 k:= 1; 3854 while k<=Length(todo) do 3855 3856 s:= todo[k][3]; 3857 cf:= todo[k][2]; 3858 if not IsList( s ) then 3859 # `s' is a Lyndon tree 3860 todo[k][1]:= true; 3861 k:= k+1; 3862 elif cf = zero or s[1]=s[2] then 3863 # `s' is zero 3864 ll:=Filtered([1..Length(todo)], x -> x<> k); 3865 todo:= todo{ll}; 3866 elif todo[k][1] then 3867 # we already dealt with `s' 3868 k:=k+1; 3869 elif IsLyndonT( s ) then 3870 # we do not need to expand `s' 3871 todo[k][1]:=true; 3872 k:=k+1; 3873 else 3874 #we expand `s' 3875 found:= false; u:=s; 3876 z:= Dcopy( s ); 3877 v:= z; 3878 3879 # we look for a subtree `u' such that is not a Lyndon tree 3880 # such that its left and right subtrees are Lyndon trees. 3881 3882 while not found do 3883 if IsLyndonT(u[1]) then 3884 if IsLyndonT(u[2]) then 3885 found:=true; 3886 else 3887 u:= u[2]; v:=v[2]; 3888 fi; 3889 else 3890 u:= u[1]; v:=v[1]; 3891 fi; 3892 od; 3893 3894 if u[1]=u[2] then 3895 # the whole expression `s' reduces to zero. 3896 ll:= Filtered([1..Length(todo)], x->x<>k); 3897 todo:= todo{ll}; 3898 else 3899 if Flat([u[1]]) > Flat([u[2]]) then 3900 # interchange u[1] and u[2]; this introduces a -. 3901 w:=u[1]; 3902 u[1]:=u[2]; 3903 u[2]:=w; 3904 i:= 1; 3905 found:= false; 3906 while i<= Length( todo ) and not found do 3907 if todo[i][3] = s and k<>i then 3908 todo[i][2]:= todo[i][2]-cf; 3909 if todo[i][2] = zero then 3910 ll:=Filtered([1..Length(todo)],x->(x<>k and x<>i )); 3911 else 3912 ll:=Filtered([1..Length(todo)],x->x<>k); 3913 fi; 3914 todo:= todo{ll}; 3915 found:= true; 3916 fi; 3917 i:=i+1; 3918 od; 3919 if not found then todo[k][2]:=-todo[k][2]; fi; 3920 else 3921 #use the Jacobi identity. 3922 x:=u[1][1]; 3923 y:=u[1][2]; 3924 w:= u[2]; 3925 u[1]:=[x,w]; 3926 u[2]:=y; 3927 3928 i:= 1; 3929 found:= false; 3930 while i<= Length( todo ) and not found do 3931 if todo[i][3] = s and k<>i then 3932 todo[i][2]:= todo[i][2]+cf; 3933 if todo[i][2] = zero then 3934 ll:=Filtered([1..Length(todo)],x->(x<>k and x<>i )); 3935 else 3936 ll:=Filtered([1..Length(todo)],x->x<>k); 3937 fi; 3938 todo:= todo{ll}; 3939 found:= true; 3940 fi; 3941 i:=i+1; 3942 od; 3943 3944 x:=v[1][1]; 3945 y:=v[1][2]; 3946 w:=v[2]; 3947 v[1]:=x; 3948 v[2]:=[y,w]; 3949 3950 i:= 1; 3951 found:= false; 3952 while i<= Length( todo ) and not found do 3953 if todo[i][3] = z then 3954 todo[i][2]:= todo[i][2]+cf; 3955 found:= true; 3956 fi; 3957 i:= i+1; 3958 od; 3959 if not found then 3960 Add( todo, [false,cf,z] ); 3961 fi; 3962 fi; 3963 k:=1; 3964 fi; 3965 fi; 3966 od; 3967 3968# wrap the list `todo' into an element of the free Lie algebra. 3969 3970 todo:= List( todo, x -> [x[3],x[2]] ); 3971 Sort( todo, function( x, y) return x < y; end ); 3972 tlist:= []; 3973 for i in [1..Length(todo)] do 3974 Append( tlist, todo[i] ); 3975 od; 3976 3977 return ObjByExtRep( Fam, [ zero, tlist ] ); 3978 3979 end ); 3980 3981 3982############################################################################## 3983## 3984#M ImageElm( <h>, <x> ) 3985#M ImagesRepresentative( <h>, <x> ) 3986## 3987## A special method for calculating the (unique) image of an element <x> 3988## under an FptoSCAMorphism <h>. The fact that <h> knows the images of the 3989## generators together with the fact that <h> is an algebra morphism is used 3990## (rather than the linearity of <h>). 3991## 3992BindGlobal( "FptoSCAMorphismImageElm", function( h, x ) 3993 local EvalProduct,gens,imgs,im,e,k; 3994 3995 EvalProduct:= function( prod, ims ) 3996 3997 if not IsList(prod) then 3998 return ims[prod]; 3999 else 4000 return EvalProduct( prod[1], ims )*EvalProduct( prod[2], ims ); 4001 fi; 4002 end; 4003 4004 e:=MappingGeneratorsImages(h); 4005 gens:= e[1]; 4006 imgs:= e[2]; 4007 e:= ExtRepOfObj(x)[2]; 4008 im:= 0*imgs[1]; 4009 k:= 1; 4010 while k <= Length(e) do 4011 im:= im + e[k+1]*EvalProduct( e[k], imgs ); 4012 k:= k+2; 4013 od; 4014 return im; 4015end ); 4016 4017InstallMethod( ImageElm, 4018 "for Fp to SCA mapping, and element", 4019 FamSourceEqFamElm, 4020 [ IsFptoSCAMorphism, IsElementOfFpAlgebra ], 0, 4021 FptoSCAMorphismImageElm ); 4022 4023InstallMethod( ImagesRepresentative, 4024 "for Fp to SCA mapping, and element", 4025 FamSourceEqFamElm, 4026 [ IsFptoSCAMorphism, IsElementOfFpAlgebra ], 0, 4027 FptoSCAMorphismImageElm ); 4028 4029########################################################################### 4030## 4031#M PreImagesRepresentative( f, x ) 4032## 4033InstallMethod( PreImagesRepresentative, 4034 "for Fp to SCA mapping, and element", 4035 FamRangeEqFamElm, 4036 [ IsFptoSCAMorphism, IsSCAlgebraObj ], 0, 4037 4038 function( f, x ) 4039 4040 local IsLyndonT, dim, e, gens, imgs, b1, b2, levs, 4041 brackets, sp, deg, newlev, newbracks, d, br1, br2, 4042 i, j, a, b, c, z, imz, cf; 4043 4044 IsLyndonT:= function( t ) 4045 4046 # This function tests whether the bracketed expression `t' is 4047 # a Lyndon tree. 4048 4049 local w,w1,w2,b,y; 4050 4051 if not IsList( t ) then return true; fi; 4052 4053 w:= Flat( t ); 4054 if IsList( t[1] ) then 4055 w1:= Flat( t[1] ); 4056 b:= false; 4057 else 4058 w1:= [ t[1] ]; 4059 b:=true; 4060 fi; 4061 if IsList( t[2] ) then 4062 w2:= Flat( t[2] ); 4063 else 4064 w2:= [ t[2] ]; 4065 fi; 4066 4067 if w<w2 and w1<w2 then 4068 if not b then 4069 y:= Flat( [ t[1][2] ] ); 4070 if y < w2 then return false; fi; 4071 fi; 4072 else 4073 return false; 4074 fi; 4075 4076 if not IsLyndonT( t[1] ) then return false; fi; 4077 if not IsLyndonT( t[2] ) then return false; fi; 4078 return true; 4079 4080 end; 4081 4082 if not IsBound( f!.bases ) then 4083 4084 # We find bases of the source and the range that are mapped to 4085 # each other. 4086 4087 dim:= Dimension( Range(f) ); 4088 e:=MappingGeneratorsImages(f); 4089 gens:= e[1]; 4090 imgs:= e[2]; 4091 b1:= ShallowCopy( gens ); 4092 b2:= ShallowCopy( imgs ); 4093 levs:= [ gens ]; 4094 brackets:= [ [1..Length(gens)] ]; 4095 sp:= MutableBasis( LeftActingDomain(Range(f)), b2 ); 4096 deg:= 1; 4097 while Length( b1 ) <> dim do 4098 deg:= deg+1; 4099 newlev:= [ ]; 4100 newbracks:= [ ]; 4101 # get all Lyndon elements of degree deg: 4102 for d in [1..Length(brackets)] do 4103 if Length( b1 ) = dim then break; fi; 4104 br1:= brackets[d]; 4105 br2:= brackets[deg-d]; 4106 for i in [1..Length(br1)] do 4107 if Length( b1 ) = dim then break; fi; 4108 for j in [1..Length(br2)] do 4109 if Length( b1 ) = dim then break; fi; 4110 a:= br1[i]; b:= br2[j]; 4111 if IsLyndonT( [a,b] ) then 4112 c:= [a,b]; 4113 z:= levs[d][i]*levs[deg-d][j]; 4114 elif IsLyndonT( [b,a] ) then 4115 c:= [b,a]; 4116 z:= levs[deg-d][j]*levs[d][i]; 4117 else 4118 c:= [ ]; 4119 fi; 4120 4121 if c <> [] then 4122 4123 imz:= Image( f, z ); 4124 if not IsContainedInSpan( sp, imz ) then 4125 CloseMutableBasis( sp, imz ); 4126 Add( b1, z ); 4127 Add( newlev, z ); 4128 Add( newbracks, c ); 4129 Add( b2, imz ); 4130 fi; 4131 fi; 4132 4133 od; 4134 od; 4135 od; 4136 Add( levs, newlev ); 4137 Add( brackets, newbracks ); 4138 od; 4139 4140 f!.bases:= [ b1, Basis( Range(f), b2 ) ]; 4141 fi; 4142 4143 cf:= Coefficients( f!.bases[2], x ); 4144 return cf*f!.bases[1]; 4145 4146end); 4147 4148############################################################################# 4149## 4150#M Dimension( <FpL> ) 4151## 4152## A method for the dimension of a finitely-presented Lie algebra. 4153## 4154InstallMethod( Dimension, 4155 "for a f.p. Lie algebra", 4156 true, 4157 [ IsLieAlgebra and IsSubalgebraFpAlgebra], 0, 4158 function( L ) 4159 local h; 4160 h:= NiceAlgebraMonomorphism( L ); 4161 if h <> fail then 4162 return Dimension( Range( h ) ); 4163 else 4164 TryNextMethod(); 4165 fi; 4166end); 4167 4168 4169############################################################################## 4170## 4171#M IsFiniteDimensional( <FpL> ) 4172## 4173## For finitely-presented Lie algebras. 4174## 4175InstallMethod( IsFiniteDimensional, 4176 "for a f.p. Lie algebra", 4177 true, 4178 [ IsLieAlgebra and IsSubalgebraFpAlgebra], 0, 4179 function( L ) 4180 local h; 4181 h:= NiceAlgebraMonomorphism( L ); 4182 if h <> fail then 4183 return Dimension( Range( h ) ) < infinity; 4184 else 4185 TryNextMethod(); 4186 fi; 4187end); 4188 4189############################################################################## 4190## 4191## FpLieAlgebraEnumeration( <arg> ) Juergen Wisliceny 4192## Willem de Graaf 4193## 4194## This function calculates a homomorphism of a finitely presented 4195## Lie algebra onto a structure constants algebra. 4196## The algorithm is guaranteed to terminate when the algebra is finite 4197## dimensional. In full length the list <arg> contains `FpL', a 4198## finitely presented Lie algebra, `MAX_WEIGHT', a bound on the length 4199## of the monomials (used for nilpotent quotients), `weights' (a list 4200## of weights of the variables) and finally a boolean indicating 4201## whether the relations are homogeneous (if so then the nilpotent 4202## quotient will be graded, the grading is set as an attribute of the 4203## range of the homomorphism). 4204## 4205## By a straightforward application of the Jacobi identity (see also the 4206## comments to the sub-function `LeftNormalization'), it can be seen that 4207## the space of all commutators of degree `n' is spanned by all left 4208## normed commutators (i.e., commutators of the form [[[[a,b],c],d]...]). 4209## By antisymmetry we have that a and b can be chosen such that a > b. 4210## This is the format for elements of the free Lie algebra used in the 4211## program. A left-normed commutator is represented by a list 4212## `[a,b,c,d,..]', meaning `[[[[a,b],c],d]...]'. A monomial is such a list 4213## together with a coefficient, e.g., `[ [a,b,c,d..], -2/3 ]'. Finally, a 4214## polynomial is a list of monomials. 4215 4216InstallGlobalFunction( FpLieAlgebraEnumeration, 4217 4218 function( arg ) 4219 4220local ReductionModuloTable, # 4221 LeftNormalization, # 4222 SubsVarInRels, # 4223 CollectPolynomial, # Sub-functions. 4224 UpdateTable, # 4225 RemoveComm, # 4226 RemoveEntry, # 4227 SubstituteVariable, # 4228 Dcopy, # 4229 gradorder, # 4230 grado, # 4231 4232 vg, # List of pairs (newly defined commutators) 4233 i,j,k,l,s, # Loop variables. 4234 end_reached, # 4235 table_init, # Booleans 4236 relation_found, # 4237 u,v,rr, # Lists of relations. 4238 r,u1,r1,r2,k1,k2,k11, # Polynomials, monomials etc. 4239 S,_T, # Structure constants tables. 4240 rowS, # A row of the multiplication table. 4241 sij,tij, # Entries of the multiplication table. 4242 inds, # Indices (list of integers). 4243 tab_pols, # List of polynomials of degree two. 4244 intrel, # Initial relations (after first conversion). 4245 pp, # Ext rep of a polynomial. 4246 cf, # Coefficient. 4247 t1,t2, # Indices. 4248 max, # Maximum. 4249 R, # Lists of commtators that have been defined. 4250 Rw1, # A new roe of `R'. 4251 one, # One of the field. 4252 zero, # Zero of the field. 4253 d, # maximum of the list of (pseudo-)generators 4254 e, # Flat(e) is the list of (pseudo-)generators 4255 w,ww, # Weights. 4256 temp, 4257 defs, # Definitions of generators in terms of other 4258 # generators. 4259 FL, # The free Lie algebra. 4260 rels, # Relators. 4261 bound, # Bound for `w'. 4262 gens, # Generators of `FpL'. 4263 imgs, # Images. 4264 map, # The map that is constructed. 4265 im, # An image. 4266 Fam, # Elements family of `FpL'. 4267 K, # Structure constants algebra. 4268 FpL,wts,wght,pos,fle,weight,MAX_WEIGHT,genweights,comp_grad,is_hom, 4269 bas,gradcomps,degs,bgc; 4270 4271 FpL:= arg[1]; 4272 if Length( arg ) >= 2 then 4273 MAX_WEIGHT:= arg[2]; 4274 else 4275 MAX_WEIGHT:= infinity; 4276 fi; 4277 4278 Fam:= ElementsFamily( FamilyObj( FpL ) ); 4279 FL:= Fam!.freeAlgebra; 4280 rels:= Fam!.relators; 4281 4282 if Length( arg ) >= 3 then 4283 genweights:= arg[3]; 4284 else 4285 genweights:= List( GeneratorsOfAlgebra( FL ), x -> 1 ); 4286 fi; 4287 4288 if Length( arg ) = 4 then 4289 is_hom:= arg[4]; 4290 else 4291 is_hom:= false; 4292 fi; 4293 4294 bound:= infinity; 4295 4296 _T:=[]; 4297 one:= One( LeftActingDomain( FL ) ); 4298 zero:= Zero( LeftActingDomain( FL ) ); 4299 4300# Some small functions..... 4301 4302 Dcopy:= function( l ) 4303 4304 # Deep copying, also copying the holes... 4305 4306 local m,i; 4307 4308 if not IsList(l) then return ShallowCopy(l); fi; 4309 m:=[]; 4310 for i in [1..Length(l)] do 4311 if IsBound(l[i]) then m[i]:= Dcopy(l[i]); fi; 4312 od; 4313 return m; 4314 end; 4315 4316 4317############################################################## 4318############################################################## 4319# v, w are associative monomials. is v>w? 4320## 4321## v > w if and only if 1) Length(v)>Length(w) or 4322## 2) Length(v)=Length(w) and Length(v) > 1 and 4323## v[2] > w[2] or 4324## 3) Length(v)=Length(w) and v[2]=w[2] and 4325## v>w alphabetically. 4326## 4327 4328 gradorder:=function(v,w) 4329 local k,l; 4330 4331 k:=Length(v[1]); l:=Length(w[1]); 4332 if k<>l then return k>l; 4333 elif k>1 and v[1][2]<>w[1][2] then return v[1][2]>w[1][2]; 4334 else return v>w; 4335 fi; 4336 4337 end; 4338 4339 grado:= function( v, w ) 4340 # tries to mimic gradorder for monomials of deg 2. 4341 4342 if v[2]<>w[2] then return v[2]>w[2]; 4343 else return v>w; 4344 fi; 4345 end; 4346 4347 4348 4349######################################################################## 4350 4351 CollectPolynomial:= function( r ) 4352 4353 # A function that collects equal things together, and gets rid of 4354 # things in the polynomial r that are zero. 4355 4356 local i,n,t; 4357 4358 if r <> [ ] then 4359 4360 # first regularize... 4361 for i in r do 4362 if Length(i[1])>1 and i[1][1]<i[1][2] then 4363 t:=i[1][2]; i[1][2]:=i[1][1]; i[1][1]:=t; 4364 i[2]:=-i[2]; 4365 fi; 4366 od; 4367 4368 Sort( r, gradorder ); 4369 n:= Length( r ); 4370 4371 for i in [1..n-1] do 4372 if r[i][2]=0*r[i][2] or 4373 (Length(r[i][1])>1 and r[i][1][1]=r[i][1][2]) then 4374 4375 #the thing is zero; get rid of it. 4376 4377 Unbind(r[i]); 4378 elif r[i][1] = r[i+1][1] then 4379 4380 #the monomials are equal; collect them together. 4381 4382 r[i+1][2]:=r[i][2]+r[i+1][2]; 4383 Unbind(r[i]); 4384 fi; 4385 od; 4386 if r[n][2]=0*r[n][2] or 4387 (Length(r[n][1])>1 and r[n][1][1]=r[n][1][2]) then 4388 4389 #the thing is zero; get rid of it. 4390 4391 Unbind(r[n]); 4392 fi; 4393 r:= Filtered( r, x -> IsBound(x) ); 4394 4395 fi; 4396 4397 return r; 4398 4399 end; 4400 4401 4402 ReductionModuloTable := function( k ) 4403 4404 # In this function a Lie polynomial `k' in standard form is 4405 # reduced by one step modulo the commutators already known by the 4406 # table. So if [x_i,x_j]= c*z is a relation in the table, and `k' 4407 # contains a monomial of the form [ [i,j,k,....], cf ] then this 4408 # monomial is replaced by [ [z,k,...], -c*cf ] 4409 4410 local i,j,k1,l,m,tst,t,s,cf,p,q,a; 4411 4412 a:= Dcopy( k ); 4413 for i in [1..Length(a)] do 4414 l:=Length(a[i][1]); 4415 if l>1 then 4416 s:= a[i][1][1]; t:=a[i][1][2]; 4417 if s < t then 4418 p:= t; q:= s; 4419 else 4420 p:=s; q:=t; 4421 fi; 4422 if IsBound( _T[p] ) and IsBound( _T[p][q] ) then 4423 k1:= [ ]; 4424 tst:= _T[p][q]; 4425 if s <> p then cf:= -1; 4426 else cf:= 1; 4427 fi; 4428 for j in [1..Length(tst[1])] do 4429 Add( k1, [[tst[1][j]], cf*a[i][2]*tst[2][j]] ); 4430 od; 4431 if l>2 then 4432 m:=a[i][1]{[3..l]}; 4433 for j in [1..Length(k1)] do 4434 Append(k1[j][1],m); 4435 od; 4436 fi; 4437 Unbind(a[i]); 4438 Append(a,k1); 4439 fi; 4440 fi; 4441 od; 4442 a:=Filtered(a,x -> IsBound(x)); 4443 a:= CollectPolynomial( a ); 4444 4445 if a = [ ] or a[1][2] = one then 4446 return a; 4447 4448 else 4449 cf:= 1/a[1][2]; 4450 return List( a, x -> [x[1],x[2]*cf] ); 4451 fi; 4452 end; 4453 4454 LeftNormalization:= function( rel ) 4455 4456 # a left-normed monomial is of the form 4457 # 4458 # [a,b,c,d,e,...], meaning [[[[[a,b],c],d],e],...] 4459 # 4460 # Using the Jacobi identity every commutator can be represented 4461 # as a linear combination of left-normed commutators. 4462 # 4463 # In this function a polynomial `rel' is left normed. 4464 # The Jacobi identity is applied successively to achieve this. 4465 # This means that an expression of the form 4466 # 4467 # [a,b,c,[d,e],f] (where a,b,c are generators (this part is already 4468 # `done') and [d,e] is any bracketed expression having d and e as 4469 # left and right subtrees, 4470 # 4471 # to a sum 4472 # 4473 # [a,b,c,d,e,f] - [a,b,c,e,d,f]. 4474 # 4475 # Justification: 4476 # 4477 # [a,b,c,[d,e]]=[[[a,b],c],[d,e]] = [X,[d,e]] (with X=[[a,b],c]) 4478 # =-[d,[e,X]]-[e,[X,d]] 4479 # =[[e,X],d]+[[X,d],e] 4480 # =-[[X,e],d]+[[X,d],e]. 4481 # 4482 4483 4484 local i,j,s,s1,s2,t,step_occurred; 4485 4486 step_occurred:= true; 4487 while step_occurred do 4488 4489 # if there no longer occur any Jacobi steps, then we stop. 4490 4491 i:=0; 4492 step_occurred:= false; 4493 while i < Length( rel ) do 4494 i:=i+1; j:=0; 4495 while j<Length(rel[i][1]) and not step_occurred do 4496 j:=j+1; 4497 if IsList(rel[i][1][j]) and Length(rel[i][1][j])=2 then 4498 step_occurred:= true; 4499 s:=rel[i][1]{[1..j-1]}; #i.e., the part already done (the X) 4500 s1:=Concatenation(s,rel[i][1][j]); 4501 s2:=Concatenation(s,[rel[i][1][j][2],rel[i][1][j][1]]); 4502 t:=rel[i][1]{[j+1..Length(rel[i][1])]}; 4503 Append(s1,t); Append(s2,t); 4504 rel[i][1]:=Dcopy(s1); 4505 4506 # If j=1 (so if the tree starts with [x,y], then we didn't do 4507 # much other than changing the notation ([[x,y],b] -> [x,y,b]). 4508 4509 if j>1 then Add(rel,[s2,-rel[i][2]]); fi; 4510 fi; 4511 od; 4512 od; 4513 od; 4514 return rel; 4515 end; 4516 4517 SubsVarInRels:= function( rels, rs ) 4518 4519 # Here `rs' is a relation of the form `var = othervars', and `rels' is 4520 # a list of Lie polynomials. This function substitutes `var' 4521 # everywhere in the polynomials `rels'. 4522 4523 local i,j,p,s,s1,s2,result,rel,cf; 4524 4525 result:= [ ]; 4526 4527 for rel in rels do 4528 4529 i:= 1; 4530 while i <= Length(rel) do 4531 4532 p:= Position( rel[i][1], rs[1][1][1] ); 4533 if p <> fail then 4534 4535 # s will be the polynomial that is gotten from r by substituting 4536 # `the rest of rs' for the variable rs[1][1][1] on the position p 4537 # in r. 4538 4539 s:= Dcopy( rs{[2..Length(rs)]} ); 4540 s1:= rel[i][1]{[1..p-1]}; 4541 s2:= rel[i][1]{[p+1..Length(rel[i][1])]}; 4542 for j in [1..Length(s)] do 4543 s[j][1]:=Concatenation(s1,s[j][1],s2); 4544 od; 4545 s:= List( s, x -> [ x[1], -rel[i][2]*x[2] ] ); 4546 Append( rel, s ); 4547 Unbind( rel[i] ); 4548 rel:= Filtered( rel, x -> IsBound( x ) ); 4549 4550 else 4551 i:= i+1; 4552 fi; 4553 4554 od; 4555 4556 #collect the result... 4557 4558 rel:= CollectPolynomial( rel ); 4559 if rel <> [ ] and rel[1][2] <> one then 4560 cf:= 1/rel[1][2]; 4561 rel:= List( rel, x -> [x[1],cf*x[2]] ); 4562 fi; 4563 if rel <> [ ] then AddSet( result, rel ); fi; 4564 4565 od; 4566 return result; 4567 end; 4568 4569 UpdateTable:= function( i, j, p ) 4570 4571 # Sets the commutator [xi,xj] in the table equal to the polynomial `p'. 4572 4573 local inds,cfs,k,s,t; 4574 4575 inds:=[]; 4576 cfs:=[]; 4577 for k in [1..Length(p)] do 4578 inds[k]:= p[k][1][1]; 4579 cfs[k]:= p[k][2]; 4580 od; 4581 if i < j then 4582 s:= j; t:= i; 4583 else 4584 s:=i; t:= j; 4585 fi; 4586 4587 if s = i then cfs:= -cfs; fi; 4588 if not IsBound(_T[s]) then _T[s]:=[]; fi; 4589 _T[s][t]:= [inds,cfs]; 4590 4591 end; 4592 4593 RemoveEntry:= function( k ) 4594 4595 # Removes all occurrences of the variable xk in the commutators 4596 # of the table. 4597 4598 local i; 4599 4600 Unbind(_T[k]); 4601 for i in [1..Length(_T)] do 4602 if IsBound( _T[i] ) then Unbind(_T[i][k]); fi; 4603 od; 4604 end; 4605 4606 RemoveComm:= function( k, l ) 4607 4608 # Removes the commutator [xk,xl] from the table. 4609 4610 local s,t; 4611 s:= Maximum( k, l ); t:= Minimum( k, l ); 4612 if IsBound(_T[s][t]) then Unbind(_T[s][t]); fi; 4613 end; 4614 4615 SubstituteVariable:= function( coms, rel ) 4616 4617 # Here `rel' is a polynomial of the form `var = othervars'; this 4618 # function substitutes `var' for `othervar' in the commutators of 4619 # the table prescribed by `coms'. 4620 4621 local var,inds,i,cfs,c,Tij,pos,cf,ii,cc,ind,s,t; 4622 4623 var := rel[1][1][1]; 4624 inds:= [ ]; cfs:= [ ]; 4625 for i in [2..Length(rel)] do 4626 Add( inds, rel[i][1][1] ); 4627 Add( cfs, -rel[i][2] ); 4628 od; 4629 cfs:= cfs/rel[1][2]; 4630 4631 for c in coms do 4632 4633 s:= Maximum( c ); t:= Minimum( c ); 4634 Tij:= _T[s][t]; 4635 pos:= Position( Tij[1], var ); 4636 if pos <> fail then 4637 Unbind( Tij[1][pos] ); 4638 cf:= Tij[2][pos]; 4639 if s <> c[1] then cf:= -cf; fi; 4640 Unbind( Tij[2][pos] ); 4641 Tij[1]:= Filtered( Tij[1], x -> IsBound(x) ); 4642 Tij[2]:= Filtered( Tij[2], x -> IsBound(x) ); 4643 Append( Tij[1], inds ); 4644 Append( Tij[2], cf*cfs ); 4645 ii:= [ ]; cc:= [ ]; 4646 if Tij[1] <> [ ] then 4647 SortParallel( Tij[1], Tij[2] ); 4648 ind:= Tij[1][1]; cf:= Tij[2][1]; 4649 ii:= [ ]; cc:= [ ]; 4650 for i in [2..Length(Tij[1])] do 4651 if Tij[1][i] = ind then 4652 cf:= Tij[2][i] + cf; 4653 else 4654 Add( ii, ind ); 4655 Add( cc, cf ); 4656 ind:= Tij[1][i]; 4657 cf:= Tij[2][i]; 4658 fi; 4659 od; 4660 Add( ii, ind ); Add( cc, cf ); 4661 fi; 4662 _T[s][t]:= [ ii, cc ]; 4663 fi; 4664 4665 od; 4666 4667 end; 4668 4669 wght:= function( e, wts, var ) 4670 4671 local p,q; 4672 4673 p:= PositionProperty( e, x -> var in x ); 4674 q:= Position( e[p], var ); 4675 4676 return wts[p][q]; 4677 end; 4678 4679############################################################################## 4680# 4681# The program starts. First the relations are transformed into internal format. 4682# That is: represented as lists of lists etc., and left-normalized. 4683# 4684 4685 # `intrel' will be the set of relations, but represented in 4686 # `internal form'; meaning [ [ [[1,2],3], 1 ], [[4],-1] ], instead 4687 # of (x1*x2)*x3-x4 etc. 4688 4689 intrel:= [ ]; 4690 for r in rels do 4691 pp:= Dcopy( ExtRepOfObj( r )[2] ); 4692 Add( intrel, List( [1,3..Length(pp)-1], x -> [ pp[x], pp[x+1] ] ) ); 4693 od; 4694 4695############################################################################# 4696 # now we left normalize the relations, using `LeftNormalization', i.e., 4697 # the relations are written as [ [ [1,2,5], -1], [.....], [......],.... ] 4698 # furthermore, all relations of degree at most two will go into `pr' 4699 # (those will be used to initialize the table). All the others go into 4700 # `u'. 4701 4702 tab_pols:= [ ]; u:= [ ]; 4703 4704 for r in intrel do 4705 max:= 0; 4706 for j in [1..Length(r)] do 4707 if not IsList(r[j][1]) then #transform [ i, cst ] into [ [i], cst ] 4708 r[j][1]:= [ r[j][1] ]; 4709 fi; 4710 if Length(Flat(r[j][1])) >= 2 and r[j][1][1]=r[j][1][2] then 4711 Unbind(r[j]); 4712 else 4713 max:= Maximum( max, Length( Flat(r[j][1]) ) ); 4714 fi; 4715 od; 4716 r:= Filtered( r, x -> IsBound(x) ); 4717 r:= LeftNormalization( r ); 4718 r:= CollectPolynomial( r ); 4719 if not max = 0 then 4720 if max <= 2 then 4721 cf:= 1/r[1][2]; 4722 r:= List( r, x -> [x[1],cf*x[2]] ); 4723 Add( tab_pols, r); # So if the relation only 4724 # involves monomials of deg 4725 # at most two, then this relation 4726 # goes into the 'tab_pols'. 4727 else 4728 Add( u, r ); 4729 fi; 4730 fi; 4731 od; 4732 4733 e:= [ List( [1..Length( GeneratorsOfAlgebra( FL ) )], x -> x ), [ ] ]; 4734 if MAX_WEIGHT < infinity then 4735 wts:= [ genweights, [] ]; 4736 comp_grad:= true; 4737 else 4738 wts:= [ ]; 4739 comp_grad:= false; 4740 fi; 4741 4742 if e[1] = [ ] then 4743 K:= LieAlgebraByStructureConstants( LeftActingDomain( FL ), 4744 EmptySCTable( 0, zero, "antisymmetric" ) ); 4745 gens:= GeneratorsOfAlgebra( FpL ); 4746 imgs:= List( gens, x -> Zero( K ) ); 4747 map:= Objectify( TypeOfDefaultGeneralMapping( FpL, K, 4748 IsSPGeneralMapping 4749 and IsAlgebraGeneralMapping 4750 and IsFptoSCAMorphism 4751 and IsAlgebraGeneralMappingByImagesDefaultRep ), 4752 rec( 4753 generators := gens, 4754 genimages := imgs 4755 ) ); 4756 SetMappingGeneratorsImages(map,[Immutable(gens),Immutable(imgs)]); 4757 return map; 4758 fi; 4759 4760 # `v' will be a history of relations, i.e., `v[w]' will be the relations 4761 # as they were when the program was dealing with weight `w'. This is 4762 # used to reset the relations if a collision among variables is found. 4763 4764 v:= [ Dcopy( u ) ]; 4765 d:= Maximum( e[1] ); 4766 R:= [ [], [] ]; 4767 end_reached:= false; 4768 w:= 0; 4769 defs:= [ ]; 4770 4771 while w < bound do 4772 4773 table_init:= false; 4774 4775 while not table_init do 4776 4777####################################################################### 4778# Initialize the table.... 4779# Meaning: fill in all possible commutators of generators using the 4780# relations, make definitions for the commutators that cannot be decided 4781# upon by using the relations. If this leads to a relation among the variables, 4782# then that relation is substituted first, and the process is started all 4783# over again. 4784 4785 relation_found:= false; 4786 4787 for r in tab_pols do 4788 4789 r1:= ReductionModuloTable( r ); 4790 if r1<>[] then 4791 4792 if Length(r1[1][1])=1 then 4793 relation_found:= true; 4794 break; 4795 else 4796 for k in [2..Length(r1)] do 4797 if Length(r1[k][1])=2 then 4798 d:=d+1; 4799 Add(e[2],d); 4800 if comp_grad then 4801 Add(wts[2],wght(e,wts,r1[k][1][1])+ 4802 wght(e,wts,r1[k][1][2]) ); 4803 fi; 4804 UpdateTable( r1[k][1][1], r1[k][1][2], [ [[d],-one] ] ); 4805 Add(R[2],r1[k][1]); 4806 r1[k][1]:=[d]; 4807 fi; 4808 od; 4809 UpdateTable( r1[1][1][1], r1[1][1][2], r1{[2..Length(r1)]} ); 4810 fi; 4811 Add(R[2],r1[1][1]); 4812 4813 fi; 4814 od; 4815 4816 if not relation_found then 4817 4818 # i.e., the previous loop has been executed without breaking 4819 # caused by finding a relation among the generators. 4820 4821 vg:=Difference( List( Combinations(e[1],2), x -> Reversed(x) ), 4822 R[2] ); 4823 Append( R[2], vg ); 4824 for i in [1..Length(vg)] do 4825 d:=d+1; 4826 Add(e[2],d); 4827 if comp_grad then 4828 Add(wts[2],wght(e,wts,vg[i][1])+wght(e,wts,vg[i][2])); 4829 fi; 4830 UpdateTable( vg[i][1], vg[i][2], [ [[d],-one] ] ); 4831 od; 4832 4833 rr:= [ ]; 4834 for i in [1..Length(u)] do 4835 r:= Dcopy( u[i] ); 4836 while true do 4837 r1:= ReductionModuloTable( r ); 4838 if r1 = r then break; 4839 else r:= r1; 4840 fi; 4841 od; 4842 if r <> [ ] then 4843 if Length(r[1][1]) = 1 and r[1][1][1] in e[1] then 4844 relation_found:= true; 4845 break; 4846 else 4847 Add( rr, r ); 4848 fi; 4849 fi; 4850 od; 4851 fi; 4852 4853 if relation_found then 4854 4855 # i.e., a relation among the variables has been found in the 4856 # previous piece of code. 4857 4858 w:= Position( List( e, x -> r1[1][1][1] in x ), true ); 4859 if w = 1 then 4860 if comp_grad then 4861 pos:= Position( e[1], r1[1][1][1] ); 4862 Remove( wts[1], pos ); 4863 Remove( e[1], pos); 4864 else 4865 RemoveSet( e[1], r1[1][1][1] ); 4866 fi; 4867 4868 Add( defs, r1 ); 4869 if e[1] = [ ] then 4870 K:= LieAlgebraByStructureConstants( LeftActingDomain( FL ), 4871 EmptySCTable( 0, zero, "antisymmetric" ) ); 4872 gens:= GeneratorsOfAlgebra( FpL ); 4873 imgs:= List( gens, x -> Zero( K ) ); 4874 map:= Objectify( TypeOfDefaultGeneralMapping( FpL, K, 4875 IsSPGeneralMapping 4876 and IsAlgebraGeneralMapping 4877 and IsFptoSCAMorphism 4878 and IsAlgebraGeneralMappingByImagesDefaultRep ), 4879 rec( 4880 generators := gens, 4881 genimages := imgs 4882 ) ); 4883 SetMappingGeneratorsImages(map,[Immutable(gens),Immutable(imgs)]); 4884 return map; 4885 fi; 4886 e[2]:= [ ]; 4887 if comp_grad then 4888 wts[2]:= [ ]; 4889 fi; 4890 tab_pols:= SubsVarInRels( tab_pols, r1 ); 4891 u:= SubsVarInRels( u, r1 ); 4892 _T:= [ ]; 4893 R:= [ [], [] ]; 4894 else 4895 if comp_grad then 4896 pos:= Position( e[w], r1[1][1][1] ); 4897 Remove( wts[w], pos ); 4898 Remove( e[w], pos); 4899 else 4900 RemoveSet( e[w], r1[1][1][1]); 4901 fi; 4902 4903 u:= SubsVarInRels( v[w-1], r1 ); 4904 SubstituteVariable( R[w], r1 ); 4905 fi; 4906 4907 else 4908 u:= rr; 4909 table_init:= true; 4910 fi; 4911 4912 od; 4913 4914 4915########################################################################## 4916# 4917# The table has been initialized, and the commutators of weight 2 4918# have been defined. Now the process of increasing the weight starts. 4919# 4920 4921 w:=1; 4922 while w < bound do 4923 4924 w:=w+1; 4925 Sort( R[w], grado ); 4926 4927 if comp_grad then 4928 fle:= Flat(e); 4929 for i in [1..Length(fle)] do 4930 for j in [i+1..Length(fle)] do 4931 if wght(e,wts,fle[i])+wght(e,wts,fle[j])>MAX_WEIGHT then 4932 UpdateTable( fle[i], fle[j], [] ); 4933 fi; 4934 od; 4935 od; 4936 fi; 4937 4938############################################################################# 4939# reduction modulo relations and Jacobi identity.... 4940# 4941# In this function also _T is changed; but if the function 4942# exits with a relation among the vars, then we change `_T' back to its 4943# old value (the copy `S'). 4944# 4945 4946 S:= Dcopy( _T ); 4947 rr:= Dcopy( u ); 4948 Rw1:= [ ]; 4949 e[w+1]:= [ ]; 4950 if comp_grad then 4951 wts[w+1]:= [ ]; 4952 fi; 4953 d:= Maximum( Flat( e ) ); 4954 relation_found:= false; 4955 4956 for r in R[w] do 4957 4958 t1:=r[1]; t2:=r[2]; 4959 if t1 > t2 then 4960 tij:= _T[t1][t2]; 4961 else 4962 tij:= ShallowCopy( _T[t2][t1] ); 4963 tij[2]:= -ShallowCopy( tij[2] ); 4964 fi; 4965 r1:= List( [1..Length(tij[1])], k -> [ [tij[1][k]], tij[2][k] ] ); 4966 4967 for j in e[1] do 4968 4969 # The Jacobi identity that will be inspected reads as 4970 # [ [ t1, t2 ], j ] - [ [ t1, j ], t2 ] + [ [ t2, j ], t1 ] = 0 4971 # This relation can be evaluated (using the partial table) to a 4972 # polynomial of degree <=2. This will lead to new definitions 4973 # (in the case of deg. = 2), or collisions (in the case of 4974 # deg. = 1). 4975 4976 if t2 > j then 4977 4978 if t1 > j then 4979 tij:= _T[t1][j]; 4980 else 4981 tij:= ShallowCopy( _T[j][t1] ); 4982 tij[2]:= -ShallowCopy( tij[2] ); 4983 fi; 4984 k1:= List( [1..Length(tij[1])], i->[ [tij[1][i],t2],-tij[2][i] ]); 4985 if t2 > j then 4986 tij:= _T[t2][j]; 4987 else 4988 tij:= ShallowCopy( _T[j][t2] ); 4989 tij[2]:= -ShallowCopy( tij[2] ); 4990 fi; 4991 k2:= List( [1..Length(tij[1])], i->[ [tij[1][i],t1],tij[2][i] ]); 4992 4993 r2:= Dcopy(r1); 4994 for i in r2 do Add( i[1], j ); od; 4995 4996 k:= Concatenation( k1, k2, r2 ); 4997 k:= CollectPolynomial( k ); 4998 k:= ReductionModuloTable( k ); 4999 5000 if k <> [ ] then 5001 5002 # Produce a relation of the form a = c1*var1+c2*var2... 5003 # by making new definitions. (Where a is either a commutator 5004 # or a variable). 5005 5006 i:= 2; 5007 while i <= Length( k ) do 5008 5009 if Length(k[i][1]) = 2 then 5010 if comp_grad then 5011 weight:= wght(e,wts,k[i][1][1])+ wght(e,wts,k[i][1][2]); 5012 else 5013 weight:= 0; 5014 fi; 5015 5016 if weight <= MAX_WEIGHT then 5017 if comp_grad then 5018 Add( wts[w+1], weight ); 5019 fi; 5020 d:= d+1; 5021 Add( e[w+1], d ); 5022 UpdateTable( k[i][1][1], k[i][1][2], [ [[d],-one] ] ); 5023 Add( Rw1, k[i][1] ); 5024 k[i][1]:= [ d ]; 5025 else 5026 Remove( k, i ); 5027 fi; 5028 fi; 5029 i:= i+1; 5030 od; 5031 k11:= k[1][1]; 5032 5033 if Length(k11) = 2 then 5034 5035 # The `a' in the comment above is a commutator; hence a new 5036 # entry for the table has been found. 5037 5038 UpdateTable( k11[1], k11[2], k{[2..Length(k)]} ); 5039 Add( Rw1, k11 ); 5040 elif Length(k11) = 1 then 5041 5042 ww:= 0; 5043 for i in [1..Length(e)] do 5044 if k11[1] in e[i] then ww:=i; break; fi; 5045 od; 5046 5047 if ww = w+1 then 5048 5049 # A collision (among the new basis elements) has been found. 5050 5051 if comp_grad then 5052 pos:= Position( e[w+1], k11[1] ); 5053 Remove( wts[w+1], pos ); 5054 fi; 5055 RemoveSet( e[w+1], k11[1] ); 5056 RemoveEntry( k11[1] ); 5057 SubstituteVariable( Rw1, k ); 5058 rr:= SubsVarInRels( rr, k ); 5059 elif ww > 0 then 5060 _T:=S; 5061 relation_found:= true; 5062 r1:= [ ww, k ]; 5063 break; 5064 fi; 5065 fi; 5066 5067 i:= 0; 5068 while i < Length(rr) do 5069 5070 i:= i+1; 5071 # Reduce the relations modulo the table and process them. 5072 5073 while true do 5074 u1:= ReductionModuloTable( rr[i] ); 5075 if u1 = rr[i] then break; 5076 else rr[i]:=u1; 5077 fi; 5078 od; 5079 5080 if rr[i]=[] then 5081 Unbind( rr[i] ); 5082 elif Length(rr[i][1][1])=1 then 5083 5084 ww:= 0; 5085 temp:= rr[i][1][1][1]; 5086 for l in [1..Length(e)] do 5087 if temp in e[l] then ww:=l; break; fi; 5088 od; 5089 5090 if ww = w+1 then 5091 if comp_grad then 5092 pos:= Position( e[w+1],rr[i][1][1][1] ); 5093 Remove( wts[w+1], pos ); 5094 fi; 5095 RemoveSet(e[w+1],rr[i][1][1][1]); 5096 RemoveEntry(rr[i][1][1][1]); 5097 SubstituteVariable( Rw1, rr[i] ); 5098 temp:= rr[i]; 5099 Remove( rr, i ); 5100 rr:= SubsVarInRels( rr, temp ); 5101 i:= i-1; # (last call removed holes...). 5102 elif ww > 0 then 5103 _T:=S; 5104 relation_found:= true; 5105 r1:= [ww,rr[i]]; 5106 break; 5107 fi; 5108 elif Length(rr[i][1][1])=2 then 5109 max := 0; 5110 for s in rr[i] do 5111 ww:= 0; 5112 for l in [1..Length(e)] do 5113 if s[1][1] in e[l] then ww:=l; break; fi; 5114 od; 5115 if Length(s[1]) = 1 then 5116 max:= Maximum(max,ww); 5117 else 5118 # We calculate the weight of `s[1][1]' + the weight 5119 # of `s[1][2]' i.e., the weight of `[s[1][1], s[1][2]]' 5120 5121 for l in [1..Length(e)] do 5122 if s[1][2] in e[l] then ww:=ww+l; break; fi; 5123 od; 5124 max:= Maximum(max,ww); 5125 fi; 5126 od; 5127 5128 if max = w+1 then 5129 s:= 2; 5130 while s <= Length( rr[i] ) do 5131 if Length(rr[i][s][1]) = 2 then 5132 if wts <> [ ] then 5133 weight:= wght(e,wts,rr[i][s][1][1])+ 5134 wght(e,wts,rr[i][s][1][2] ); 5135 else 5136 weight:= 0; 5137 fi; 5138 if weight <= MAX_WEIGHT then 5139 d:= d+1; 5140 Add( e[w+1], d ); 5141 if wts <> [ ] then 5142 Add( wts[w+1], weight ); 5143 fi; 5144 UpdateTable( rr[i][s][1][1], rr[i][s][1][2], 5145 [ [[d], -one] ] ); 5146 Add(Rw1,rr[i][s][1]); 5147 rr[i][s][1]:= [ d ]; 5148 else 5149 Remove( rr[i], s ); 5150 fi; 5151 fi; 5152 s:= s+1; 5153 od; 5154 Add(Rw1,rr[i][1][1]); 5155 UpdateTable( rr[i][1][1][1], rr[i][1][1][2], 5156 rr[i]{[2..Length(rr[i])]}); 5157 Unbind(rr[i]); 5158 fi; 5159 fi; 5160 5161 od; 5162 if relation_found then break; fi; 5163 rr:=Filtered(rr,x -> IsBound(x)); 5164 fi; 5165 5166 fi; 5167 od; 5168 if relation_found then break; fi; 5169 od; 5170 5171########################################################################## 5172 5173 if relation_found then 5174 5175 # Here `r1[2]' is a relation among basis elements. 5176 # `r1[1]' is the weight of the homogeneous component containing 5177 # the first variable (variable of highest weight). 5178 5179 w:= r1[1]; 5180 5181 if w = 1 then 5182 5183 # A relation among the variables of weight 1 has been found. 5184 # We reset everything and return to the point where the table 5185 # is initialized. 5186 5187 if comp_grad then 5188 pos:= Position( e[1], r1[2][1][1][1] ); 5189 Remove( wts[1], pos ); 5190 fi; 5191 RemoveSet( e[1], r1[2][1][1][1] ); 5192 Add( defs, r1[2] ); 5193 if e[1]=[] then 5194 K:= LieAlgebraByStructureConstants( LeftActingDomain( FL ), 5195 EmptySCTable( 0, zero, "antisymmetric" ) ); 5196 gens:= GeneratorsOfAlgebra( FpL ); 5197 imgs:= List( gens, x -> Zero( K ) ); 5198 map:= Objectify( TypeOfDefaultGeneralMapping( FpL, K, 5199 IsSPGeneralMapping 5200 and IsAlgebraGeneralMapping 5201 and IsFptoSCAMorphism 5202 and IsAlgebraGeneralMappingByImagesDefaultRep ), 5203 rec( 5204 generators := gens, 5205 genimages := imgs 5206 ) ); 5207 SetMappingGeneratorsImages(map,[Immutable(gens),Immutable(imgs)]); 5208 return map; 5209 fi; 5210 e:=[ e[1], [] ]; 5211 if comp_grad then 5212 wts:= [ wts[1], [] ]; 5213 fi; 5214 u:= SubsVarInRels( v[1], r1[2] ); 5215 tab_pols:= SubsVarInRels( tab_pols, r1[2] ); 5216 _T:=[]; 5217 R:=[ [ ], List( tab_pols, x -> x[1][1] ) ]; 5218 v[1]:= Dcopy( u ); 5219 5220 # We break to the principal loop. 5221 break; 5222 else 5223 5224# here `r1[2]' is of the form `var=something' where `var' is of weight 5225# `w', and `w>1'. This means that `var' was introduced somewhere; namely 5226# on level `w'. Hence the definition was [x_i,x_j]=var, where w(x_i)+ 5227# w(x_j)=w. Hence `var' only appears in tails (right hand sides) of commutators 5228# of weight `>= w'. Now `var' is substituted in all products of weight `w', 5229# and the program starts again on that level. 5230 5231 if comp_grad then 5232 pos:= Position( e[w], r1[2][1][1][1] ); 5233 Remove( wts[w], pos ); 5234 fi; 5235 RemoveSet(e[w], r1[2][1][1][1]); 5236 u:= SubsVarInRels( v[w-1], r1[2]); 5237 v[w-1]:=u; 5238 w:= w-1; 5239 SubstituteVariable( R[w+1], r1[2] ); 5240 for i in [w+2..Length(e)] do e[i]:=[]; od; 5241 for i in [w+2..Length(R)] do 5242 for j in [1..Length(R[i])] do 5243 RemoveComm( R[i][j][1], R[i][j][2] ); 5244 od; 5245 R[i]:= [ ]; 5246 od; 5247 5248 fi; 5249 5250 else 5251 5252 # Here Jacobi identities have been applied 5253 # without finding collisions between variables. 5254 5255 if e[w] = [ ] and not end_reached then 5256 bound:= 2*w; end_reached:= true; 5257 elif w = bound and not end_reached then 5258 return fail; 5259 fi; 5260 5261 R[w+1]:= Rw1; v[w]:= rr; u:= rr; 5262 5263 if Flat( e ) = [ ] then 5264 K:= LieAlgebraByStructureConstants( LeftActingDomain( FL ), 5265 EmptySCTable( 0, zero, "antisymmetric" ) ); 5266 gens:= GeneratorsOfAlgebra( FpL ); 5267 imgs:= List( gens, x -> Zero( K ) ); 5268 map:= Objectify( TypeOfDefaultGeneralMapping( FpL, K, 5269 IsSPGeneralMapping 5270 and IsAlgebraGeneralMapping 5271 and IsFptoSCAMorphism 5272 and IsAlgebraGeneralMappingByImagesDefaultRep ), 5273 rec( 5274 generators := gens, 5275 genimages := imgs 5276 ) ); 5277 SetMappingGeneratorsImages(map,[Immutable(gens),Immutable(imgs)]); 5278 return map; 5279 fi; 5280 5281 d:= Maximum( Flat( e ) ); 5282 vg:= [ ]; 5283 for i in e[w] do 5284 for j in e[1] do 5285 if i>j then AddSet( vg, [i,j] ); fi; 5286 od; 5287 od; 5288 vg:= Difference( vg, R[w+1] ); 5289 Append( R[w+1], vg ); 5290 5291 for i in [1..Length(vg)] do 5292 if comp_grad then 5293 weight:= wght(e,wts,vg[i][1])+wght(e,wts,vg[i][2]); 5294 else 5295 weight:= 0; 5296 fi; 5297 if weight <= MAX_WEIGHT then 5298 d:= d+1; 5299 Add( e[w+1], d ); 5300 if comp_grad then 5301 Add( wts[w+1], weight ); 5302 fi; 5303 Add( R[w+1], vg[i] ); 5304 UpdateTable( vg[i][1], vg[i][2], [ [[d],-1*one] ]); 5305 else 5306 UpdateTable( vg[i][1], vg[i][2], [ ] ); 5307 fi; 5308 od; 5309 5310 fi; 5311 5312 od; # end of the loop in which `w' is successively increased. 5313 od; # end of the main loop, 5314 5315 # Now we construct a table of structure constants from `_T'. 5316 5317 e:=Filtered(e,x->x<>[]); 5318 inds:=Flat(e); 5319 5320 S:=[]; 5321 for i in inds do 5322 rowS:= [ ]; 5323 for j in inds do 5324 if i=j then 5325 Add( rowS, [ [], [] ] ); 5326 else 5327 if i < j then 5328 tij:= ShallowCopy( _T[j][i] ); 5329 tij[2]:= -ShallowCopy( tij[2] ); 5330 else 5331 tij:= _T[i][j]; 5332 fi; 5333 sij:=[[],[]]; 5334 for k in [1..Length(tij[1])] do 5335 sij[1][k]:= Position( inds, tij[1][k] ); 5336 sij[2][k]:= tij[2][k]; 5337 od; 5338 Add( rowS, sij ); 5339 fi; 5340 od; 5341 Add( S, rowS ); 5342 od; 5343 Add( S, -1 ); Add( S, zero ); 5344 5345 K:= LieAlgebraByStructureConstants( LeftActingDomain( FL ), S ); 5346 if is_hom then 5347 wts:= Flat( wts ); 5348 bas:= [1..Dimension(K)]; 5349 SortParallel( wts, bas ); 5350 5351 gradcomps:= [ ]; 5352 degs:= [ ]; 5353 k:= 1; 5354 while k <= Length(wts) do 5355 bgc:= [ Basis( K )[bas[k]] ]; 5356 Add( degs, wts[k] ); 5357 while k < Length( wts ) and wts[k]=wts[k+1] do 5358 k:= k+1; 5359 Add( bgc, Basis(K)[bas[k]] ); 5360 od; 5361 Add( gradcomps, VectorSpace( LeftActingDomain( K ), bgc ) ); 5362 k:= k+1; 5363 od; 5364 5365 Add( gradcomps, Subspace( K, [ ] ) ); 5366 5367 SetGrading( K, rec( min_degree:= Minimum( wts ), 5368 max_degree:= Maximum( wts ), 5369 source:= Integers, 5370 hom_components:= function( d ) 5371 if d in degs then 5372 return gradcomps[Position(degs,d)]; 5373 else 5374 return gradcomps[Length(gradcomps)]; 5375 fi; 5376 end 5377 ) ); 5378 5379 fi; 5380 5381 5382 gens:= GeneratorsOfAlgebra( FpL ); 5383 5384 if Dimension( K ) = 0 then #trivial case 5385 imgs:= List( gens, x -> Zero(K) ); 5386 else 5387 # We process the definitions, (of generators as linear combinations 5388 # of other generators). 5389 i:= Length( defs ); 5390 while i > 1 do 5391 for j in [1..i-1] do 5392 for k in [1..Length(defs[j])] do 5393 if defs[j][k][1] = defs[i][1][1] then 5394 Append( defs[j], List( defs[i]{[2..Length(defs[i])]}, x -> 5395 [ x[1], -defs[j][k][2]*x[2] ] ) 5396 ); 5397 Unbind( defs[j][k] ); 5398 fi; 5399 od; 5400 defs[j]:= Filtered( defs[j], x -> IsBound( x ) ); 5401 od; 5402 i:= i-1; 5403 od; 5404 5405 imgs:= [ ]; 5406 5407 #For every generator of the Fp Lie algebra we calculate an image... 5408 5409 for i in [1..Length(gens)] do 5410 if i in e[1] then 5411 Add( imgs, Basis( K )[Position( inds, i )] ); 5412 else 5413 for j in [1..Length(defs)] do 5414 if defs[j][1][1][1] = i then break; fi; 5415 od; 5416 im:= Zero( K ); 5417 for k in [2..Length(defs[j])] do 5418 im:= im + -defs[j][k][2]*Basis( K )[defs[j][k][1][1]]; 5419 od; 5420 Add (imgs, im ); 5421 fi; 5422 od; 5423 fi; 5424 5425# Construct the map... 5426 5427 map:= Objectify( TypeOfDefaultGeneralMapping( FpL, K, 5428 IsSPGeneralMapping 5429 and IsAlgebraGeneralMapping 5430 and IsFptoSCAMorphism 5431 and IsAlgebraGeneralMappingByImagesDefaultRep ), 5432 rec( 5433 generators := gens, 5434 genimages := imgs 5435 ) ); 5436 SetMappingGeneratorsImages(map,[Immutable(gens),Immutable(imgs)]); 5437 5438 return map; 5439 5440end ); 5441 5442 5443InstallMethod( NiceAlgebraMonomorphism, 5444 "for a f.p. Lie algebra", 5445 true, 5446 [ IsLieAlgebra and IsSubalgebraFpAlgebra], 0, 5447 5448 function( FpL ) 5449 5450 return FpLieAlgebraEnumeration( FpL ); 5451 5452end ); 5453 5454 5455InstallGlobalFunction( NilpotentQuotientOfFpLieAlgebra, 5456 5457 function( arg ) 5458 5459 local FpL,L,weights,is_homogeneous,rels,weight,w,r,k,j,er,fol,maxw,N; 5460 5461 5462 # unwrapping the arguments... 5463 5464 if Length( arg ) = 2 then 5465 FpL:= arg[1]; maxw:= arg[2]; 5466 L:= ElementsFamily( FamilyObj( FpL ) )!.freeAlgebra; 5467 weights:= List( GeneratorsOfAlgebra( L ), x -> 1 ); 5468 elif Length( arg ) = 3 then 5469 FpL:= arg[1]; maxw:= arg[2]; weights:= arg[3]; 5470 else 5471 Error("Number of arguments must be two or three"); 5472 fi; 5473 5474 # checking whether the relations are homogeneous; if so then 5475 # the resulting structure constants Lie algebra will have a 5476 # natural grading. 5477 5478 is_homogeneous:= true; 5479 rels:= ElementsFamily( FamilyObj( FpL ) )!.relators; 5480 5481 for r in rels do 5482 5483 weight:= infinity; 5484 er:= ExtRepOfObj( r )[2]; 5485 for k in [1,3..Length(er)-1] do 5486 fol:= Flat( [ er[k] ] ); 5487 w:= 0; 5488 for j in fol do 5489 w:= w+weights[j]; 5490 od; 5491 if weight = infinity then 5492 weight:= w; 5493 elif weight <> w then 5494 is_homogeneous:= false; 5495 break; 5496 fi; 5497 od; 5498 if not is_homogeneous then break; fi; 5499 od; 5500 5501 N:= FpLieAlgebraEnumeration( FpL, maxw, weights, is_homogeneous ); 5502 SetIsLieNilpotent( Range(N), true ); 5503 return N; 5504 5505end ); 5506 5507 5508 5509############################################################################## 5510## 5511#F FpLieAlgebraByCartanMatrix( <C> ) 5512## 5513## 5514InstallGlobalFunction( FpLieAlgebraByCartanMatrix, function( C ) 5515 5516 local i,j,k, # Loop variables. 5517 l, # The rank. 5518 L, # The free Lie algebra. 5519 g, # Generators of `L'. 5520 x,h,y, # Lists of generators of `L'. 5521 rels, # List of relations. 5522 rx,ry; # Relations. 5523 5524 l:= Length( C ); 5525 L:= FreeLieAlgebra( Rationals, 3*l ); 5526 g:= GeneratorsOfAlgebra( L ); 5527 x:= g{[1..l]}; 5528 h:= g{[l+1..2*l]}; 5529 y:= g{[2*l+1..3*l]}; 5530 5531 rels:= [ ]; 5532 for i in [1..l] do 5533 for j in [i+1..l] do 5534 Add( rels, h[i]*h[j] ); 5535 od; 5536 od; 5537 5538 for i in [1..l] do 5539 for j in [1..l] do 5540 if i=j then 5541 Add( rels, x[i]*y[j]-h[i] ); 5542 else 5543 Add( rels, x[i]*y[j] ); 5544 fi; 5545 od; 5546 od; 5547 5548 for i in [1..l] do 5549 for j in [1..l] do 5550 Add( rels, h[i]*x[j]-C[j][i]*x[j] ); 5551 Add( rels, h[i]*y[j]+C[j][i]*y[j] ); 5552 od; 5553 od; 5554 5555 for i in [1..l] do 5556 for j in [1..l] do 5557 if i <> j then 5558 rx:= x[j]; ry:= y[j]; 5559 for k in [1..1-C[j][i]] do 5560 rx:= x[i]*rx; ry:= y[i]*ry; 5561 od; 5562 Add( rels, rx ); Add( rels, ry ); 5563 fi; 5564 od; 5565 od; 5566 5567 return L/rels; 5568 5569end ); 5570 5571############################################################################# 5572## 5573#M JenningsLieAlgebra( <G> ) 5574## 5575## The Jennings Lie algebra of the p-group G. 5576## 5577## 5578 5579InstallMethod( JenningsLieAlgebra, 5580 "for a p-group", 5581 true, 5582 [IsGroup], 0, 5583 5584 function ( G ) 5585 5586 local J, # Jennings series of G 5587 Homs, # Homomorphisms of J[i] onto the quotient J[i]/J[i+1] 5588 grades, # List of the full images of the maps in Homs 5589 gens, # List of the generators of the quotients J[i]/J[i+1], 5590 # i.e., a basis of the Lie algebra. 5591 pos, # list of positions: if pos[j] = p, then the element 5592 # gens[j] belongs to grades[p] 5593 i,j,k, # loop variables 5594 tempgens, 5595 t, # integer 5596 T, # multiplication table of the Lie algebra 5597 dim, # dimension of the Lie algebra 5598 a,b,c,f, # group elements 5599 e, # ext rep of a group element 5600 co, # entry of the multiplication table 5601 p, # the prime of G 5602 F, # ground field 5603 L, # the Lie algebra to be constructed 5604 pimgs, # pth-power images 5605 B, # Basis of L 5606 vv, x, # elements of L 5607 comp, # homogeneous component 5608 grading, # list of homogeneous components 5609 pcgps, # list of pc groups, isom to the elts of `grades'. 5610 hom_pcg, # list of isomomorphisms of `grades[i]' to `pcgps[i]'. 5611 enum_gens, # List of numbers of elts of `gens' in extrep. 5612 pp, # Position in a list. 5613 hm; 5614 5615 # We do not know the characteristic if `G' is trivial. 5616 if IsTrivial( G ) then 5617 Error( "<G> must be a nontrivial p-group" ); 5618 fi; 5619 5620 # Construct the homogeneous components of `L': 5621 5622 J:=JenningsSeries ( G ); 5623 Homs:= List ( [1..Length(J)-1] , x -> 5624 NaturalHomomorphismByNormalSubgroupNC( J[x], J[x+1] )); 5625 grades := List ( Homs , Range ); 5626 hom_pcg:= List( grades, IsomorphismSpecialPcGroup ); 5627 pcgps:= List( hom_pcg, Range ); 5628 gens := []; 5629 enum_gens:= [ ]; 5630 pos := []; 5631 for i in [1.. Length(grades)] do 5632 tempgens:= GeneratorsOfGroup( pcgps[i] ); 5633 Append ( gens , tempgens); 5634 5635 # Record the number that each generator has in extrep. 5636 Add( enum_gens, List( tempgens, x -> ExtRepOfObj( x )[1] ) ); 5637 Append ( pos , List ( tempgens , x-> i ) ); 5638 od; 5639 5640 # Construct the field and the multiplication table: 5641 5642 dim:= Length(gens); 5643 p:= PrimePGroup( G ); 5644 F:= GF( p ); 5645 T:= EmptySCTable( dim , Zero(F) , "antisymmetric" ); 5646 pimgs := []; 5647 for i in [1..dim] do 5648 a:= PreImagesRepresentative( Homs[pos[i]] , 5649 PreImagesRepresentative( hom_pcg[pos[i]], gens[i] ) ); 5650 5651 # calculate the p-th power image of `a': 5652 5653 if pos[i]*p <= Length(Homs) then 5654 Add( pimgs, Image( hom_pcg[pos[i]*p], 5655 Image( Homs[pos[i]*p], a^p) ) ); 5656 else 5657 Add( pimgs, "zero" ); 5658 fi; 5659 5660 for j in [i+1.. dim] do 5661 if pos[i]+pos[j] <= Length( Homs ) then 5662 5663 # Calculate the commutator [a,b], and map the result into 5664 # the correct homogeneous component. 5665 5666 b:= PreImagesRepresentative( Homs[pos[j]], 5667 PreImagesRepresentative( hom_pcg[pos[j]], gens[j] )); 5668 c:= Image( hom_pcg[pos[i] + pos[j]], 5669 Image(Homs[pos[i] + pos[j]], a^-1*b^-1*a*b) ); 5670 e:= ExtRepOfObj(c); 5671 co:=[]; 5672 for k in [1,3..Length(e)-1] do 5673 pp:= Position( enum_gens[pos[i]+pos[j]], e[k] ); 5674 t:= Sum( enum_gens{[1..pos[i]+pos[j]-1]}, Length )+pp; 5675 Add( co, One( F )*e[k+1] ); 5676 Add( co, t ); 5677 od; 5678 SetEntrySCTable( T, i, j, co ); 5679 fi; 5680 5681 od; 5682 od; 5683 5684 L:= LieAlgebraByStructureConstants( F, T ); 5685 5686 B:= Basis( L ); 5687 5688 # Now we compute the natural grading of `L'. 5689 grading:= [ ]; 5690 k:= 1; 5691 for i in [1..Length(enum_gens)] do 5692 comp:= [ ]; 5693 for j in [1..Length(enum_gens[i])] do 5694 Add( comp, B[k] ); 5695 k:= k+1; 5696 od; 5697 Add( grading, Subspace( L, comp ) ); 5698 od; 5699 5700 Add( grading, Subspace( L, [ ] ) ); 5701 5702 SetGrading( L, rec( min_degree:= 1, 5703 max_degree:= Length( grading ) - 1, 5704 source:= Integers, 5705 hom_components:= function( d ) 5706 if d in [1..Length(grading)] then 5707 return grading[d]; 5708 else 5709 return grading[Length(grading)]; 5710 fi; 5711 end 5712 ) 5713 ); 5714 5715 vv:= BasisVectors( B ); 5716 5717 # Set the pth-power images of the basis elements of `B': 5718 5719 for i in [1..Length(pimgs)] do 5720 if pimgs[i] = "zero" then 5721 pimgs[i]:= Zero( L ); 5722 else 5723 e:= ExtRepOfObj( pimgs[i] ); 5724 x:= Zero( L ); 5725 for k in [1,3..Length(e)-1] do 5726 pp:= Position( enum_gens[pos[i]*p], e[k] ); 5727 t:= Sum( enum_gens{[1..pos[i]*p-1]}, Length )+pp; 5728 x:= x+ One( F )*e[k+1]*vv[t]; 5729 od; 5730 pimgs[i]:= x; 5731 fi; 5732 od; 5733 SetPthPowerImages( B, pimgs ); 5734 SetIsRestrictedLieAlgebra( L, true ); 5735 FamilyObj(Representative(L))!.pMapping := pimgs; 5736 SetIsLieNilpotent( L, true ); 5737 5738 hm:= function( g, i ) 5739 5740 local h, e, x, k, pp, f, t; 5741 5742 if not g in J[i] then 5743 Error("<g> is not an element of the i-th term of the series used to define <L>"); 5744 fi; 5745 5746 h:= Image( hom_pcg[i], Image(Homs[i], g )); 5747 e:= ExtRepOfObj(h); 5748 x:= Zero(L); 5749 for k in [1,3..Length(e)-1] do 5750 pp:= Position( enum_gens[i], e[k] ); 5751 f:= GeneratorsOfGroup( pcgps[i] )[pp]; 5752 t:= Position( gens, f ); 5753 x:= x + e[k+1]*Basis(L)[t]; 5754 od; 5755 return x; 5756 end ; 5757 5758 SetNaturalHomomorphismOfLieAlgebraFromNilpotentGroup( L, hm ); 5759 5760 5761 return L; 5762 5763end ); 5764 5765 5766 5767############################################################################# 5768## 5769#M PCentralLieAlgebra( <G> ) 5770## 5771## The p-central Lie algebra of the p-group G. 5772## 5773## 5774InstallMethod( PCentralLieAlgebra, 5775 "for a p-group", 5776 true, 5777 [IsGroup], 0, 5778 5779 function ( G ) 5780 5781 local J, # p-central series of G 5782 Homs, # Homomorphisms of J[i] onto the quotient J[i]/J[i+1] 5783 grades, # List of the full images of the maps in Homs 5784 gens, # List of the generators of the quotients J[i]/J[i+1], 5785 # i.e., a basis of the Lie algebra. 5786 pos, # list of positions: if pos[j] = p, then the element 5787 # gens[j] belongs to grades[p] 5788 i,j,k, # loop variables 5789 tempgens, 5790 t, # integer 5791 T, # multiplication table of the Lie algebra 5792 dim, # dimension of the Lie algebra 5793 a,b,c,f, # group elements 5794 e, # ext rep of a group element 5795 co, # entry of the multiplication table 5796 p, # the prime of G 5797 F, # ground field 5798 L, # the Lie algebra to be constructed 5799 B, # Basis of L 5800 vv, x, # elements of L 5801 comp, # homogeneous component 5802 grading, # list of homogeneous components 5803 pcgps, # list of pc groups, isom to the elts of `grades'. 5804 hom_pcg, # list of isomomorphisms of `grades[i]' to `pcgps[i]'. 5805 enum_gens, # List of numbers of elts of `gens' in extrep. 5806 pp, # Position in a list. 5807 pimgs, # pth power images 5808 hm; 5809 5810 5811 # We do not know the characteristic if `G' is trivial. 5812 if IsTrivial( G ) then 5813 Error( "<G> must be a nontrivial p-group" ); 5814 fi; 5815 5816 # Construct the homogeneous components of `L': 5817 5818 p:= PrimePGroup( G ); 5819 J:= PCentralSeries( G, p ); 5820 Homs:= List ( [1..Length(J)-1] , x -> 5821 NaturalHomomorphismByNormalSubgroupNC( J[x], J[x+1] )); 5822 grades := List ( Homs , Range ); 5823 hom_pcg:= List( grades, IsomorphismSpecialPcGroup ); 5824 pcgps:= List( hom_pcg, Range ); 5825 gens := []; 5826 enum_gens:= [ ]; 5827 pos := []; 5828 for i in [1.. Length(grades)] do 5829 tempgens:= GeneratorsOfGroup( pcgps[i] ); 5830 Append ( gens , tempgens); 5831 5832 # Record the number that each generator has in extrep. 5833 Add( enum_gens, List( tempgens, x -> ExtRepOfObj( x )[1] ) ); 5834 Append ( pos , List ( tempgens , x-> i ) ); 5835 od; 5836 5837 # Construct the field and the multiplication table: 5838 5839 dim:= Length(gens); 5840 F:= GF( p ); 5841 T:= EmptySCTable( dim , Zero(F) , "antisymmetric" ); 5842 pimgs := []; 5843 for i in [1..dim] do 5844 a:= PreImagesRepresentative( Homs[pos[i]] , 5845 PreImagesRepresentative( hom_pcg[pos[i]], gens[i] ) ); 5846 5847 5848 # calculate the p-th power image of `a': 5849 5850 if pos[i]+1 <= Length(Homs) then 5851 Add( pimgs, Image( hom_pcg[pos[i]+1], 5852 Image( Homs[pos[i]+1], a^p) ) ); 5853 else 5854 Add( pimgs, "zero" ); 5855 fi; 5856 5857 for j in [i+1.. dim] do 5858 if pos[i]+pos[j] <= Length( Homs ) then 5859 5860 # Calculate the commutator [a,b], and map the result into 5861 # the correct homogeneous component. 5862 5863 b:= PreImagesRepresentative( Homs[pos[j]], 5864 PreImagesRepresentative( hom_pcg[pos[j]], gens[j] )); 5865 c:= Image( hom_pcg[pos[i] + pos[j]], 5866 Image(Homs[pos[i] + pos[j]], a^-1*b^-1*a*b) ); 5867 e:= ExtRepOfObj(c); 5868 co:=[]; 5869 for k in [1,3..Length(e)-1] do 5870 pp:= Position( enum_gens[pos[i]+pos[j]], e[k] ); 5871 t:= Sum( enum_gens{[1..pos[i]+pos[j]-1]}, Length )+pp; 5872 Add( co, One( F )*e[k+1] ); 5873 Add( co, t ); 5874 od; 5875 SetEntrySCTable( T, i, j, co ); 5876 fi; 5877 5878 od; 5879 od; 5880 5881 L:= LieAlgebraByStructureConstants( F, T ); 5882 5883 B:= Basis( L ); 5884 5885 # Now we compute the natural grading of `L'. 5886 5887 grading:= [ ]; 5888 k:= 1; 5889 5890 for i in [1..Length(enum_gens)] do 5891 comp:= [ ]; 5892 for j in [1..Length(enum_gens[i])] do 5893 Add( comp, B[k] ); 5894 k:= k+1; 5895 od; 5896 Add( grading, Subspace( L, comp ) ); 5897 od; 5898 5899 Add( grading, Subspace( L, [ ] ) ); 5900 5901 SetGrading( L, rec( min_degree:= 1, 5902 max_degree:= Length( grading ) - 1, 5903 source:= Integers, 5904 hom_components:= function( d ) 5905 if d in [1..Length(grading)] then 5906 return grading[d]; 5907 else 5908 return grading[Length(grading)]; 5909 fi; 5910 end 5911 ) 5912 ); 5913 5914 vv:= BasisVectors( B ); 5915 5916 # Set the pth-power images of the basis elements of `B': 5917 5918 for i in [1..Length(pimgs)] do 5919 if pimgs[i] = "zero" then 5920 pimgs[i]:= Zero( L ); 5921 else 5922 e:= ExtRepOfObj( pimgs[i] ); 5923 x:= Zero( L ); 5924 for k in [1,3..Length(e)-1] do 5925 pp:= Position( enum_gens[pos[i]+1], e[k] ); 5926 t:= Sum( enum_gens{[1..pos[i]]}, Length )+pp; 5927 x:= x+ One( F )*e[k+1]*vv[t]; 5928 od; 5929 pimgs[i]:= x; 5930 fi; 5931 od; 5932 SetPthPowerImages( B, pimgs ); 5933 SetIsRestrictedLieAlgebra( L, true ); 5934 SetIsLieNilpotent( L, true ); 5935 5936 hm:= function( g, i ) 5937 5938 local h, e, x, k, pp, f, t; 5939 5940 if not g in J[i] then 5941 Error("<g> is not an element of the i-th term of the series used to define <L>"); 5942 fi; 5943 5944 h:= Image( hom_pcg[i], Image(Homs[i], g )); 5945 e:= ExtRepOfObj(h); 5946 x:= Zero(L); 5947 for k in [1,3..Length(e)-1] do 5948 pp:= Position( enum_gens[i], e[k] ); 5949 f:= GeneratorsOfGroup( pcgps[i] )[pp]; 5950 t:= Position( gens, f ); 5951 x:= x + e[k+1]*Basis(L)[t]; 5952 od; 5953 return x; 5954 end ; 5955 5956 SetNaturalHomomorphismOfLieAlgebraFromNilpotentGroup( L, hm ); 5957 5958 return L; 5959 5960end ); 5961