1##################################################################################### 2# 3# fplie.gi Serena Cicalo' and Willem de Graaf 4# 5# 6# The package LieRing is free software; you can redistribute it and/or modify it under the 7# terms of the GNU General Public License as published by the Free Software Foundation; 8# either version 2 of the License, or (at your option) any later version. 9 10 11# Functions for working with free algebras. 12# first we install the record containing all 13# sorts of functions we want to write protect 14 15InstallValue( LRPrivateFunctions, rec() ); 16 17############################################################################ 18## 19#M ObjByExtRep( <fam>, <list> ) 20#M ExtRepOfObj( <obj> ) 21# 22InstallMethod( ObjByExtRep, 23 "for family of FAlg elements, and list", 24 true, [ IsFAlgElementFamily, IsList ], 0, 25 function( fam, list ) 26 27 return Objectify( fam!.defaultType, 28 [ Immutable(list) ] ); 29end ); 30 31InstallMethod( ExtRepOfObj, 32 "for an FAlg element", 33 true, [ IsFAlgElement ], 0, 34 function( obj ) 35 36 return obj![1]; 37 38end ); 39 40InstallMethod( PrintObj, 41 "for FAlg element", 42 [ IsFAlgElement ], 43 function( elm ) 44 45 local names, print, e, i, len; 46 47 names:= FamilyObj( elm )!.names; 48 print:= function( expr ) 49 50 if IsBound(expr.var) then 51 Print( names[ expr.var ] ); 52 else 53 Print( "(" ); 54 print( expr.left ); 55 Print( "," ); 56 print( expr.right ); 57 Print( ")" ); 58 fi; 59 end; 60 61 e:= elm![1]; 62 len:= Length( e ); 63 for i in [ 1, 3 .. len - 1 ] do 64 if not IsOne( e[i+1] ) then 65 Print( "(",e[i+1],")*"); 66 fi; 67 if i < len-1 then 68 print( e[i] ); Print("+"); 69 else 70 print( e[i] ); 71 fi; 72 od; 73 if len = 0 then 74 Print( "0" ); 75 fi; 76 end ); 77 78############################################################################# 79## 80#M ZeroOp( <m> ) . . . . . . . . . . . . . . . for a Falg element 81#M \<( <m1>, <m2> ) . . . . . . . . . . . . . . for two Falg elements 82#M \=( <m1>, <m2> ) . . . . . . . . . . . . . . for two Falg elements 83#M \+( <m1>, <m2> ) . . . . . . . . . . . . . . for two Falg elements 84#M \AINV( <m> ) . . . . . . . . . . . . . . for a Falg element 85#M \in( <U>, <u> ) . . . . . . . . . . . . . . for Free algebra, and element 86## 87InstallMethod( ZeroOp, 88 "for FAlg element", 89 true, [ IsFAlgElement ], 0, 90 function( x ) 91 92 return ObjByExtRep( FamilyObj( x ), [ ] ); 93 94end ); 95 96 97InstallMethod( \<, 98 "for two FAlg elements", 99 IsIdenticalObj, [ IsFAlgElement, IsFAlgElement ], 0, 100 function( x, y ) 101 return x![1]< y![1]; 102end ); 103 104InstallMethod( \=, 105 "for two FAlg elements", 106 IsIdenticalObj, [ IsFAlgElement, IsFAlgElement], 0, 107 function( x, y ) 108 109 local len, i; 110 return x![1] = y![1]; 111end ); 112 113 114LRPrivateFunctions.direct_sum:= function( F, x, y ) 115 116 local sum,z,mons,o,ord; 117 118 o:= F!.ordering; 119 120 ord:= function( a, b ) 121 return o[a.no] < o[b.no]; 122 end; 123 124 sum:= ZIPPED_SUM_LISTS( x, y, F!.zeroCoefficient, [ ord, \+ ] ); 125 return sum; 126 127end; 128 129InstallMethod( \+, 130 "for two FAlg elements", 131 true, [ IsFAlgElement, IsFAlgElement ], 0, 132 function( x, y ) 133 local F; 134 F:= FamilyObj(x); 135 return ObjByExtRep( F, LRPrivateFunctions.direct_sum( F, x![1], y![1] ) ); 136 137end ); 138 139LRPrivateFunctions.dir_monmult:= function( F, x, y ) 140 141 local T, mons, o, ord_1, a, b, c, i, j, t1, t2, s1, r, pos, num, p, s; 142 143 T:= F!.multTable; 144 mons:= F!.monomials; 145 o:= F!.ordering; 146 147 ord_1:= function( mon1, mon2 ) 148 149 150 if mon1.no = mon2.no then return false; fi; 151 if mon1.deg <> mon2.deg then return mon1.deg < mon2.deg; fi; 152 if mon1.left.no <> mon2.left.no then return o[mon1.left.no] < o[mon2.left.no]; fi; 153 return o[mon1.right.no] < o[mon2.right.no]; 154 155 end; 156 157 a:= x[1]; b:= y[1]; 158 c:= x[2]*y[2]; 159 i:= a.no; j:= b.no; 160 161 if F!.sign = -1 then 162 163 if i = j then return [ a, 0*c ]; fi; 164 if i > j then 165 t1:= j; t2:= i; 166 s1:= -1; 167 else 168 t1:= i; t2:= j; 169 s1:= 1; 170 fi; 171 if IsBound( T[t1] ) and IsBound( T[t1][t2] ) then 172 r:= T[t1][t2]; 173 pos:= o[ r[1] ]; 174 return [ mons[pos], s1*r[2]*c ]; 175 fi; 176 # If we arrive here then the product is not known yet. 177 num:= Length( mons ) + 1; # number of new monomial... 178 179 if o[i] < o[j] then 180 # i.e., a < b 181 p:= rec( no:= num, deg:= a.deg+b.deg, left:= a, right:= b ); 182 s:= 1; 183 else 184 p:= rec( no:= num, deg:= a.deg+b.deg, left:= b, right:= a ); 185 c:= -c; 186 s:= -1; 187 fi; 188 189 if not IsBound( T[t1] ) then T[t1]:= [ ]; fi; 190 T[t1][t2]:= [ num, s*s1 ]; 191 F!.multTable:= T; 192 193 # now we have to insert p in the sorted list of monomials... 194 195 pos:= POSITION_SORTED_LIST_COMP( mons, p, ord_1 ); 196 for i in [pos..Length(o)] do o[ mons[i].no ]:= o[ mons[i].no ]+1; od; 197 Add( o, pos ); 198 199 CopyListEntries(mons,pos,1,mons,pos+1,1,Length(mons)-pos+1); 200 mons[pos]:= p; 201 202 F!.monomials:= mons; 203 F!.ordering:= o; 204 205 return [ p, c ]; 206 207 else 208 # The extremely free multiplication... 209 210 if IsBound( T[i] ) and IsBound( T[i][j] ) then 211 r:= T[i][j]; 212 pos:= o[ r ]; 213 return [ mons[pos], c ]; 214 fi; 215 # If we arrive here then the product is not known yet. 216 num:= Length( mons ) + 1; # number of new monomial... 217 p:= rec( no:= num, deg:= a.deg+b.deg, left:= a, right:= b ); 218 219 if not IsBound( T[i] ) then T[i]:= [ ]; fi; 220 T[i][j]:= num; 221 F!.multTable:= T; 222 223 # now we have to insert p in the sorted list of monomials... 224 pos:= POSITION_SORTED_LIST_COMP( mons, p, ord_1 ); 225 226 for i in [pos..Length(o)] do o[ mons[i].no ]:= o[ mons[i].no ]+1; od; 227 Add( o, pos ); 228 229 CopyListEntries(mons,pos,1,mons,pos+1,1,Length(mons)-pos+1); 230 mons[pos]:= p; 231 232 F!.monomials:= mons; 233 F!.ordering:= o; 234 235 return [ p, c ]; 236 237 fi; 238 239end; 240 241LRPrivateFunctions.monmult:= function( x, y ) 242 243 local F; 244 245 F:= FamilyObj(x); 246 return ObjByExtRep( F, LRPrivateFunctions.dir_monmult( F, x![1], y![1] ) ); 247 248end; 249 250 251LRPrivateFunctions.dir_mult:= function( F, x, y ) 252 253 local o, ord, mns, cfs, i, j, l, res, len; 254 255 o:= F!.ordering; 256 257 ord:= function( a, b ) 258 return o[a.no] < o[b.no]; 259 end; 260 261# Keeping it sorted might make it faster!! 262 263 mns:= []; cfs:= []; 264 for i in [1,3..Length(x)-1] do 265 for j in [1,3..Length(y)-1] do 266 l:= LRPrivateFunctions.dir_monmult( F, [x[i],x[i+1]], [y[j],y[j+1]] ); 267 if not IsZero( l[2] ) then 268 Add( mns, l[1] ); Add(cfs, l[2] ); 269 fi; 270 od; 271 od; 272 273 SortParallel( mns, cfs, ord ); 274 275 res:= []; 276 len:= -1; 277 for i in [1..Length(mns)] do 278 if len > 0 and mns[i].no = res[len].no then 279 res[len+1]:= res[len+1]+cfs[i]; 280 else 281 Add( res, mns[i] ); Add( res, cfs[i] ); 282 len:= len+2; 283 fi; 284 od; 285 for i in [2,4..Length(res)] do 286 if IsZero(res[i]) then 287 Unbind( res[i-1] ); Unbind( res[i] ); 288 fi; 289 od; 290 res:= Filtered( res, x -> IsBound(x) ); 291 292 return res; 293 294end; 295 296InstallMethod( \*, 297 "for two FAlg elements", 298 true, [ IsFAlgElement, IsFAlgElement ], 0, 299 function( x, y ) 300 local F; 301 F:= FamilyObj(x); 302 return ObjByExtRep( F, LRPrivateFunctions.dir_mult( F, x![1], y![1] ) ); 303end); 304 305LRPrivateFunctions.special_mult:= function( F, x1, f1, x2, f2, x3, f3 ) 306 307 # compute x1f1 + x2f2 + x3f3, where the xi are monomials 308 309 local T, mons, o, ord_1, mon_prod, ord, mns, cfs, i, j, l, res, len,t, e1, e2; 310 311 T:= F!.multTable; 312 mons:= F!.monomials; 313 o:= F!.ordering; 314 315 ord_1:= function( mon1, mon2 ) 316 317 318 if mon1.no = mon2.no then return false; fi; 319 if mon1.deg <> mon2.deg then return mon1.deg < mon2.deg; fi; 320 if mon1.left.no <> mon2.left.no then return o[mon1.left.no] < o[mon2.left.no]; fi; 321 return o[mon1.right.no] < o[mon2.right.no]; 322 323 end; 324 325 if F!.sign = -1 then 326 327 mon_prod:= function( a, b, ca, cb ) 328 local c, p, i, j, r, pos, num, pi, pj, s, mmm, t1, t2, s1; 329 c:= ca*cb; 330 i:= a.no; j:= b.no; 331 if i = j then return [ a, 0*c ]; fi; 332 if i > j then 333 t1:= j; t2:= i; 334 s1:= -1; 335 else 336 t1:= i; t2:= j; 337 s1:= 1; 338 fi; 339 340 if IsBound( T[t1] ) and IsBound( T[t1][t2] ) then 341 r:= T[t1][t2]; 342 pos:= o[ r[1] ]; 343 return [ mons[pos], s1*r[2]*c ]; 344 fi; 345 # If we arrive here then the product is not known yet. 346 num:= Length( mons ) + 1; # number of new monomial... 347 348 if o[i] < o[j] then 349 # i.e., a < b 350 p:= rec( no:= num, deg:= a.deg+b.deg, left:= a, right:= b ); 351 s:= 1; 352 else 353 p:= rec( no:= num, deg:= a.deg+b.deg, left:= b, right:= a ); 354 c:= -c; 355 s:= -1; 356 fi; 357 358 if not IsBound( T[t1] ) then T[t1]:= [ ]; fi; 359 T[t1][t2]:= [ num, s*s1 ]; 360 F!.multTable:= T; 361 362 # now we have to insert p in the sorted list of monomials... 363 pos:= POSITION_SORTED_LIST_COMP( mons, p, ord_1 ); 364 365 for i in [pos..Length(o)] do o[ mons[i].no ]:= o[ mons[i].no ]+1; od; 366 Add( o, pos ); 367 368 CopyListEntries(mons,pos,1,mons,pos+1,1,Length(mons)-pos+1); 369 mons[pos]:= p; 370 371 F!.monomials:= mons; 372 F!.ordering:= o; 373 374 return [ p, c ]; 375 end; 376 377 fi; 378 379 ord:= function( a, b ) 380 return o[a.no] < o[b.no]; 381 end; 382 383 e1:= [ ]; 384 for i in [1,3..Length(f1)-1] do 385 l:= mon_prod( x1[1], f1[i], x1[2], f1[i+1] ); 386 if not IsZero( l[2] ) then 387 Append( e1, l ); 388 fi; 389 od; 390 e2:= [ ]; 391 for i in [1,3..Length(f2)-1] do 392 l:= mon_prod( x2[1], f2[i], x2[2], f2[i+1] ); 393 if not IsZero( l[2] ) then 394 Append( e2, l ); 395 fi; 396 od; 397 res:= ZIPPED_SUM_LISTS( e1, e2, F!.zeroCoefficient, [ ord, \+ ] ); 398 e2:= [ ]; 399 for i in [1,3..Length(f3)-1] do 400 l:= mon_prod( x3[1], f3[i], x3[2], f3[i+1] ); 401 if not IsZero( l[2] ) then 402 Append( e2, l ); 403 fi; 404 od; 405 406 return ZIPPED_SUM_LISTS( res, e2, F!.zeroCoefficient, [ ord, \+ ] ); 407 408 409end; 410 411 412InstallMethod( AINV, 413 "for FAlg element", 414 true, [ IsFAlgElement ], 0, 415 function( x ) 416 417 local ex, i; 418 419 ex:= ShallowCopy(x![1]); 420 for i in [2,4..Length(ex)] do 421 ex[i]:= -ex[i]; 422 od; 423 return ObjByExtRep( FamilyObj(x), ex ); 424end ); 425 426InstallMethod( AINV_MUT, 427 "for FAlg element", 428 true, [ IsFAlgElement ], 0, 429 function( x ) 430 431 local ex, i; 432 433 ex:= ShallowCopy(x![1]); 434 for i in [2,4..Length(ex)] do 435 ex[i]:= -ex[i]; 436 od; 437 return ObjByExtRep( FamilyObj(x), ex ); 438end ); 439 440############################################################################# 441## 442#M \*( <scal>, <m> ) . . . . . . . . .for a scalar and a FAlg element 443#M \*( <m>, <scal> ) . . . . . . . . .for a scalar and a FAlg element 444## 445InstallMethod( \*, 446 "for scalar and FAlg element", 447 true, [ IsScalar, IsFAlgElement ], 0, 448 function( scal, x ) 449 450 local ex, i; 451 452 if IsZero( scal ) then return Zero(x); fi; 453 ex:= ShallowCopy( x![1] ); 454 for i in [2,4..Length(ex)] do 455 ex[i]:= scal*ex[i]; 456 od; 457 return ObjByExtRep( FamilyObj(x), ex ); 458end); 459 460InstallMethod( \*, 461 "for FAlg element and scalar", 462 true, [ IsFAlgElement, IsScalar ], 0, 463 function( x, scal ) 464 465 local ex, i; 466 467 if IsZero( scal ) then return Zero(x); fi; 468 ex:= ShallowCopy( x![1] ); 469 for i in [2,4..Length(ex)] do 470 ex[i]:= scal*ex[i]; 471 od; 472 return ObjByExtRep( FamilyObj(x), ex ); 473end); 474 475InstallMethod( \in, 476 "for FAlg element and free algebra", 477 true, [ IsFAlgElement, IsFreeNAAlgebra ], 0, 478 function( u, U ) 479 return IsIdenticalObj( ElementsFamily( FamilyObj(U) ), FamilyObj(u) ); 480end ); 481 482 483InstallMethod( Degree, "FAlg elements", true, [ IsFAlgElement ], 0, 484 function(x) 485 x:= x![1]; 486 return x[ Length(x)-1 ].deg ; 487end ); 488 489 490 491LRPrivateFunctions.FreeNonassociativeAlgebra:= function( arg ) 492 493 local R, # coefficients ring 494 names, # names of the algebra generators 495 F, # family of elements 496 one, # identity of `R' 497 zero, # zero of `R' 498 A, sign, g, gr, ord; 499 500 501 R:= arg[1]; 502 503 # Construct names of generators. 504 if IsInt( arg[2] ) then 505 506 names:= List( [ 1 .. arg[2] ], 507 i -> Concatenation( "x", String(i) ) ); 508 elif IsList( arg[2] ) then 509 names:= arg[2]; 510 else 511 Error( "The second argument to FreeNonassociativeAlgebra has to be an integer, or a list" ); 512 fi; 513 514 if Length(arg) >= 3 then 515 if arg[3] in [1,-1] then 516 sign:= arg[3]; 517 else 518 Error("The third argument to FreeNonassociativeAlgebra must be 1, or -1 "); 519 fi; 520 else 521 sign:= 1; 522 fi; 523 524 if Length( arg ) = 4 then 525 gr:= arg[4]; 526 else 527 gr:= List( names, x -> 1 ); 528 fi; 529 530 F:= NewFamily( "FreeAlgebraEltFamily", IsFAlgElement ); 531 532 if IsField(R) then 533 F!.isfield_basering:= true; 534 elif R=Integers then 535 F!.isfield_basering:= false; 536 else 537 Error("The only allowed base rings are fields and the Integers"); 538 fi; 539 540 541 one:= One( R ); 542 zero:= Zero( R ); 543 544 F!.defaultType := NewType( F, IsFAlgElement ); 545 F!.zeroCoefficient := zero; 546 F!.names := names; 547 F!.sign:= sign; 548 549 A:= Objectify( NewType( CollectionsFamily( F ), 550 IsFreeNAAlgebra 551 and IsAttributeStoringRep ), 552 rec() ); 553 554 SetLeftActingDomain( A, R ); 555 g:= List( [1..Length(names)], 556 x -> ObjByExtRep( F, [ rec( no:= x, deg:=gr[x], var:= x ), one ] ) ); 557 F!.monomials:= List( g, u -> ExtRepOfObj( u )[1] ); 558 F!.multTable:= []; 559 ord:= List( [1..Length(names)], x -> x ); 560 SortParallel( gr, ord ); 561 F!.ordering:= ord; 562 SetGeneratorsOfLeftOperatorRing( A, g ); 563 564 return A; 565 566end; 567 568InstallAccessToGenerators( IsFreeNAAlgebra, 569 "free algebra", 570 GeneratorsOfLeftOperatorRing ); 571 572InstallMethod( FreeLieRing, 573 "for a ring and list", 574 true, 575 [ IsRing, IsList ], 0, 576 function( R, names ) 577 578 # Check the argument list. 579 if not IsRing( R ) then 580 Error( "first argument must be a ring" ); 581 fi; 582 583 if not ForAll( names, IsString ) then 584 Error("second argument must be a list of strings"); 585 fi; 586 587 return LRPrivateFunctions.FreeNonassociativeAlgebra( R, names, -1 ); 588 589end ); 590 591InstallOtherMethod( FreeLieRing, 592 "for a ring and list and list", 593 true, 594 [ IsRing, IsList, IsList ], 0, 595 function( R, names, grad ) 596 597 # Check the argument list. 598 if not IsRing( R ) then 599 Error( "first argument must be a ring" ); 600 fi; 601 602 if not ForAll( names, IsString ) then 603 Error("second argument must be a list of strings"); 604 fi; 605 606 return LRPrivateFunctions.FreeNonassociativeAlgebra( R, names, -1, grad ); 607 608end ); 609 610InstallOtherMethod( FreeLieRing, 611 "for a ring and an integer", 612 true, 613 [ IsRing, IsInt ], 0, 614 function( R, k ) 615 616 # Check the argument list. 617 if not IsRing( R ) then 618 Error( "first argument must be a ring" ); 619 fi; 620 621 return LRPrivateFunctions.FreeNonassociativeAlgebra( R, k, -1 ); 622 623end ); 624 625InstallOtherMethod( FreeLieRing, 626 "for a ring and an integer", 627 true, 628 [ IsRing, IsInt, IsList ], 0, 629 function( R, k, grad ) 630 631 # Check the argument list. 632 if not IsRing( R ) then 633 Error( "first argument must be a ring" ); 634 fi; 635 636 return LRPrivateFunctions.FreeNonassociativeAlgebra( R, k, -1, grad ); 637 638end ); 639 640 641InstallMethod( PrintObj, 642 "for a nonassociative algebra", 643 true, 644 [ IsFreeNAAlgebra ], 0, 645 function( A ) 646 647 local g, i; 648 649 Print("<Free algebra over ",LeftActingDomain(A)," generators: " ); 650 g:= GeneratorsOfAlgebra(A); 651 for i in [1..Length(g)-1] do 652 Print( g[i], ", " ); 653 od; 654 Print( g[ Length(g) ], " >" ); 655 656 657end ); 658 659 660InstallMethod( ViewObj, 661 "for a nonassociative algebra", 662 true, 663 [ IsFreeNAAlgebra ], 0, 664 function( A ) 665 666 local g, i; 667 668 Print("<Free algebra over ",LeftActingDomain(A)," generators: " ); 669 g:= GeneratorsOfAlgebra(A); 670 for i in [1..Length(g)-1] do 671 Print( g[i], ", " ); 672 od; 673 Print( g[ Length(g) ], " >" ); 674 675 676end ); 677 678InstallMethod( PrintObj, 679 "for a reduced set", 680 true, 681 [ IsReducedSetOfFAE ], 0, 682 function( G ) 683 684 Print("<Reduced set of free algebra elements>" ); 685 686end ); 687 688InstallMethod( ViewObj, 689 "for a reduced set", 690 true, 691 [ IsReducedSetOfFAE ], 0, 692 function( G ) 693 694 Print("<Reduced set of free algebra elements>" ); 695 696end ); 697 698 699InstallMethod( AsSSortedList, 700 "for a reduced set", 701 true, 702 [ IsReducedSetOfFAE ], 0, 703 function( G ) 704 705 return G!.elements; 706 707end ); 708 709LRPrivateFunctions.search_factor:= function( m, lms ) 710 711 # here m is a monomial in ext rep; lms is a sorted list of monomial 712 # numbers of leading monomials. We search a leading monomial that is 713 # a factor in m; if found then a list is returned with in the first 714 # position the value true, in the second position, the position of the 715 # factor in lms, and the third and fourth positions contain lists that 716 # describe the correponding appliance (first the list of monomials, than 717 # a list of 0,1; 0 means: mult on the left, 1 means mult on the right). 718 # if no factor is found the list [false] is returned. 719 720 local b, choices, points, pos, mns, lr, c, k; 721 722 723 b:= m; 724 choices:= [ ]; 725 points:= [ b ]; 726 727 while true do 728 729 pos:= PositionSorted( lms, b.no ); 730 if pos <= Length(lms) and lms[pos] = b.no then 731 mns:= [ ]; 732 lr:= [ ]; 733 c:= m; 734 for k in choices do 735 if k = 0 then 736 Add( lr, 1 ); Add( mns, c.right ); c:= c.left; 737 else 738 Add( lr, 0 ); Add( mns, c.left ); c:= c.right; 739 fi; 740 od; 741 return [ true, pos, Reversed(mns), Reversed(lr) ]; 742 fi; 743 if IsBound(b.var) then 744 # backtrack... 745 k:= Length( choices ); 746 while k>=1 and choices[k] = 1 do k:= k-1; od; 747 if k = 0 then return [ false ]; fi; 748 choices:= choices{[1..k-1]}; points:= points{[1..k]}; 749 750 b:= points[k].right; 751 Add( choices, 1 ); Add( points, b ); 752 753 else 754 b:= b.left; 755 Add( choices, 0 ); Add( points, b ); 756 fi; 757 od; 758 759end; 760 761 762LRPrivateFunctions.ReduceElmFreeAlg:= function( fam, f, G, lms, minus ) 763 764 local ef, len, r, a, g, lg, mns, side, i, m, cf, cg, rem, q; 765 766 # Here f is an elem of a free algeb in ext rep, 767 # fam is its family, G is a list of elements of 768 # the same free alg, but in wrapped rep, lms is a list 769 # of the numbers of the leading monomials of G, 770 # minus is a boolean, if true then the result is normalised 771 # i.e., multiplied by an appropriate unit. 772 773 if f=[] then return f; fi; 774 if G = [ ] then 775 if minus then 776 f:= ShallowCopy(f); 777 cf:= f[Length(f)]; 778 if fam!.isfield_basering then 779 if not IsOne(cf) then 780 for i in [2,4..Length(f)] do 781 f[i]:= f[i]/cf; 782 od; 783 fi; 784 else 785 if cf < 0 then 786 for i in [2,4..Length(f)] do 787 f[i]:= -f[i]; 788 od; 789 fi; 790 fi; 791 fi; 792 return f; 793 fi; 794 795 ef:= ShallowCopy( f ); 796 len:= Length(ef); 797 798 r:= [ ]; 799 800 if fam!.isfield_basering then 801 while len >0 do 802 m:= ef[ len-1 ]; cf:= ef[len]; 803 ef:= ef{[1..len-2]}; 804 len:= len-2; 805 806 # look for a factor... 807 a:= LRPrivateFunctions.search_factor( m, lms ); 808 809 if a[1] then 810 g:= ShallowCopy(G[a[2]]![1]); 811 mns:= a[3]; 812 side:= a[4]; 813 lg:= Length(g); 814 g:= g{[1..lg-2]}; 815 816 for i in [1..Length(mns)] do 817 if side[i] = 0 then 818 g:= LRPrivateFunctions.dir_mult( fam, [mns[i],1], g ); 819 else 820 g:= LRPrivateFunctions.dir_mult( fam, g, [mns[i],1] ); 821 fi; 822 od; 823 824 # compute -cf*g: 825 for i in [2,4..Length(g)] do 826 g[i]:= -cf*g[i]; 827 od; 828 829 ef:= LRPrivateFunctions.direct_sum( fam, ef, g ); 830 len:= Length( ef ); 831 else 832 833 r:= LRPrivateFunctions.direct_sum( fam, r, [m,cf] ); 834# Better: add everything, then sort! 835 fi; 836 od; 837 838 if r <> [ ] and minus then 839 cf:= r[Length(r)]; 840 if not IsOne(cf) then 841 for i in [2,4..Length(r)] do r[i]:= r[i]/cf; od; 842 fi; 843 fi; 844 845 else 846 # so the base ring is the integers... 847 while len >0 do 848 m:= ef[ len-1 ]; cf:= ef[len]; 849 ef:= ef{[1..len-2]}; 850 len:= len-2; 851 852 # look for a factor... 853 a:= LRPrivateFunctions.search_factor( m, lms ); 854 855 if a[1] then 856 g:= ShallowCopy(G[a[2]]![1]); 857 lg:= Length(g); 858 cg:= g[lg]; 859 rem:= cf mod cg; 860 q:= (cf-rem)/cg; 861 if q <> 0 then 862 mns:= a[3]; 863 side:= a[4]; 864 g:= g{[1..lg-2]}; 865 866 for i in [1..Length(mns)] do 867 if side[i] = 0 then 868 g:= LRPrivateFunctions.dir_mult( fam, [mns[i],1], g ); 869 else 870 g:= LRPrivateFunctions.dir_mult( fam, g, [mns[i],1] ); 871 fi; 872 od; 873 874 # compute -q*g: 875 for i in [2,4..Length(g)] do 876 g[i]:= -q*g[i]; 877 od; 878 879 ef:= LRPrivateFunctions.direct_sum( fam, ef, g ); 880 len:= Length( ef ); 881 fi; 882 883 if rem <> 0 then 884 r:= LRPrivateFunctions.direct_sum( fam, r, [m,rem] ); 885 886 fi; 887 else 888 889 r:= LRPrivateFunctions.direct_sum( fam, r, [m,cf] ); 890# Better: add everything, then sort! 891 fi; 892 od; 893 894 if r <> [ ] and minus then 895 cf:= r[Length(r)]; 896 if cf < 0 then 897 for i in [2,4..Length(r)] do r[i]:= -r[i]; od; 898 fi; 899 fi; 900 901 fi; 902 903 return r; 904 905end; 906 907LRPrivateFunctions.AddElmRedSet:= function( fam, f, G, lms ) 908 909 local newelms, len, h, n, Gh, i, g, pos; 910 911 newelms:= [ f ]; 912 len:= 1; 913 while len>0 do 914 h:= newelms[len]; 915 newelms:= newelms{[1..len-1]}; 916 len:= len-1; 917 h:= LRPrivateFunctions.ReduceElmFreeAlg( fam, h, G, lms, true ); 918 if h <> [] then 919 # we add it, but first we remove all elements of which the 920 # leading monomial reduces mod h from G: 921 n:= [ h[ Length(h)-1 ].no ]; 922 h:= ObjByExtRep( fam, h ); 923 Gh:= [ h ]; 924 for i in [1..Length(G)] do 925 g:= LRPrivateFunctions.ReduceElmFreeAlg( fam, G[i]![1], Gh, n, true ); 926 if g <> [] and g[Length(g)-1].no <> lms[i] then 927 Add( newelms, g ); len:= len+1; 928 Unbind( G[i] ); Unbind( lms[i] ); 929 elif g=[ ] then 930 Unbind( G[i] ); Unbind( lms[i] ); 931 else 932 G[i]:= ObjByExtRep( fam, g ); 933 fi; 934 od; 935 G:= Filtered( G, x -> IsBound(x) ); 936 lms:= Filtered( lms, x -> IsBound(x) ); 937 pos:= PositionSorted( lms, n[1] ); 938 CopyListEntries(G,pos,1,G,pos+1,1,Length(G)-pos+1); 939 G[pos]:= h; 940 CopyListEntries(lms,pos,1,lms,pos+1,1,Length(lms)-pos+1); 941 lms[pos]:= n[1]; 942 fi; 943 od; 944 945 return [ G, lms ]; 946 947end; 948 949InstallMethod( ReducedSet, 950 "for a set of free alg elms", 951 true, 952 [ IsList ], 0, 953 function( elms ) 954 955 local RS, G, lms, fam, g, a; 956 957 RS:= Objectify( NewType( NewFamily( "ReducedSetFam", IsReducedSetOfFAE ), IsReducedSetOfFAE ), 958 rec() ); 959 960 if elms = [ ] then 961 RS!.elements:= [ ]; 962 RS!.leading_mns:= [ ]; 963 return RS; 964 fi; 965 966 G:= [ ]; lms:= [ ]; 967 fam:= FamilyObj( elms[1] ); 968 for g in elms do 969 a:= LRPrivateFunctions.AddElmRedSet( fam, g![1], G, lms ); 970 G:= a[1]; lms:= a[2]; 971 od; 972 RS!.elements:= G; 973 RS!.leading_mns:= lms; 974 return RS; 975 976end ); 977 978 979 980InstallMethod( AddToReducedSet, 981 "for a reduced set of free alg elms, and a free alg elm", 982 true, 983 [ IsReducedSetOfFAE, IsFAlgElement ], 0, 984 function( G, f ) 985 986 local elms, lms, ef, a; 987 988 elms:= G!.elements; 989 lms:= G!.leading_mns; 990 ef:= f![1]; 991 if elms = [ ] and ef <> [ ] then 992 G!.elements:= [ f ]; 993 G!.leading_mns:= [ ef[ Length(ef)-1 ].no ]; 994 elif elms <> [ ] then 995 a:= LRPrivateFunctions.AddElmRedSet( FamilyObj( f ), ef, elms, lms ); 996 G!.elements:= a[1]; 997 G!.leading_mns:= a[2]; 998 fi; 999 1000end ); 1001 1002InstallMethod( NormalForm, 1003 "for a reduced set of free alg elms, and a free alg elm", 1004 true, 1005 [ IsReducedSetOfFAE, IsFAlgElement ], 0, 1006 function( G, f ) 1007 1008 local h; 1009 1010 h:= LRPrivateFunctions.ReduceElmFreeAlg( 1011 FamilyObj(f), f![1], G!.elements, G!.leading_mns, false ); 1012 return ObjByExtRep( FamilyObj(f), h ); 1013 1014end ); 1015 1016