1############################################################################# 2## 3## This file is part of GAP, a system for computational discrete algebra. 4## This file's authors include Thomas Breuer, Götz Pfeiffer. 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 the methods for those functions that are needed to 12## compute and test possible permutation characters. 13## 14 15 16############################################################################# 17## 18#F TestPerm1( <tbl>, <char> ) . . . . . . . . . . . . . . . . test permchar 19## 20InstallGlobalFunction( TestPerm1, function(tbl, char) 21 22 local i, pm; 23 24 # TEST 1: 25 for i in char do 26 if i < 0 then 27 return 1; 28 fi; 29 od; 30 31 # TEST 2: 32 for pm in ComputedPowerMaps( tbl ) do 33 for i in [2..Length(char)] do 34 if char[i] > char[pm[i]] then return 2; fi; 35 od; 36 od; 37 38 return 0; 39end ); 40 41 42############################################################################# 43## 44#F TestPerm2( <tbl>, <char> ) . . . . . . . . . . . . . . . . test permchar 45## 46InstallGlobalFunction( TestPerm2, function(tbl, char) 47 48 local i, j, nccl, subord, tbl_orders, subclass, tbl_classes, subfak, 49 prime, sum; 50 51 char:= ValuesOfClassFunction( char ); 52 subord:= Size( tbl ) / char[1]; 53 if not IsInt(subord) then 54 Info( InfoCharacterTable, 2, "-" ); 55 return 1; 56 fi; 57 nccl:= Length(char); 58 59 # TEST 3: 60 tbl_orders:= OrdersClassRepresentatives( tbl ); 61 for i in [2..nccl] do 62 if char[i] <> 0 and subord mod tbl_orders[i] <> 0 then 63 Info( InfoCharacterTable, 2, "=" ); 64 return 3; 65 fi; 66 od; 67 68 # TEST 4: 69 subclass:= [1]; 70 tbl_classes:= SizesConjugacyClasses( tbl ); 71 for i in [2..nccl] do 72 subclass[i]:= (char[i] * tbl_classes[i]) / char[1]; 73 if not IsInt(subclass[i]) then 74 Info( InfoCharacterTable, 2, "#" ); 75 return 4; 76 fi; 77 od; 78 79 # TEST 5: 80 subfak:= PrimeDivisors(subord); 81 for prime in subfak do 82 if subord mod prime^2 <> 0 then 83 84 # Compute the number of elements of order $p$ in the 85 # (hypothetical) subgroup $H$. 86 sum:= 0; 87 for j in [2..nccl] do 88 if tbl_orders[j] = prime then 89 sum:= sum + subclass[j]; 90 fi; 91 od; 92 93 # Check that the number of Sylow $s$ subgroups is an integer 94 # that is congruent to $1$ modulo $p$. 95 if (sum - prime + 1) mod (prime * (prime - 1)) <> 0 then 96 Info( InfoCharacterTable, 2, ":" ); 97 return 5; 98 fi; 99 100 # Check that the number of Sylow $p$ subgroups in $H$ divides $|H|$. 101 if subord mod (sum / (prime - 1)) <> 0 then 102 Info( InfoCharacterTable, 2, ";" ); 103 return 5; 104 fi; 105 fi; 106 od; 107 108 return 0; 109end ); 110 111 112############################################################################# 113## 114#F TestPerm3( <tbl>, <permch> ) . . . . . . . . . . . . . . . test permchar 115## 116InstallGlobalFunction( TestPerm3, function( tbl, permch ) 117 118 local i, j, nccl, fb, corbs, lc, phii, pi, orders, classes, good; 119 120 fb := []; 121 lc := []; 122 phii := []; 123 orders := OrdersClassRepresentatives( tbl ); 124 classes := SizesConjugacyClasses( tbl ); 125 nccl := Length( orders ); 126 127 # Compute the values $`phii[i]' = [ N_G(g_i) : C_G(g_i) ]$, 128 # store them only for one representative of each Galois family. 129 for i in [ 1 .. nccl ] do 130 if not IsBound( lc[i] ) then 131 corbs:= ClassOrbit( tbl, i ); 132 lc[i]:= Length( corbs ); 133 for j in corbs do 134 lc[j]:= lc[i]; 135 od; 136 phii[i]:= Phi( orders[i] ) / lc[i]; 137 fi; 138 od; 139 140 # Check condition (h) for all characters $\pi$ in `permch', 141 # i.e., $\pi(1) |N_G(g)|$ divides $\pi(g) |G|$ for all $g \in G$. 142 for pi in permch do 143 good:= true; 144 for j in [ 2 .. nccl ] do 145 if 2 < orders[j] and IsBound( phii[j] ) 146 and ( pi[j] * classes[j] ) mod ( pi[1] * phii[j] ) <> 0 then 147 good:= false; 148 break; 149 fi; 150 od; 151 if good then 152 AddSet( fb, pi ); 153 fi; 154 od; 155 156 # Return the list of characters that satisfy condition (h). 157 return fb; 158end ); 159 160 161############################################################################## 162## 163## TestPerm4( <tbl>, <chars> ) 164## 165## Check whether the projections of <chars> to $p$-blocks of <tbl> satisfy 166## $|\pi_B(g)| \leq \pi_B(g^n) \leq \pi(g^n)$, for all $g\in G$ and positive 167## integers $n$ such that $g^n$ is a $p$-element of $G$. 168## 169## In the case of defect $1$, it is also tried to identify the projective 170## cover $1_G + \lambda_p$ of the trivial character; 171## in this case it is checked whether $\lambda_p$ is a constituent of the 172## candidate $\pi$. 173## We use that $\lambda_p$ is a sum of irreducibles in the principal block 174## that coincide on $p$-regular classes, 175## and that $\lambda$ has the properties $\lambda_p(1) \equiv -1 \pmod{p}$ 176## and $\lambda_p(g) = -1$ for each $p$-singular element $g \in G$. 177## (If $\lambda_p$ is not uniquely determined by these conditions then it is 178## checked whether at least one character with these properties is a 179## constituent of $\pi$. 180## 181InstallGlobalFunction( TestPerm4, function( tbl, chars ) 182 183 local nccl, 184 irr, 185 len, 186 good, 187 size, 188 orders, 189 p, 190 bl, 191 B, 192 except, 193 lambda, 194 i, 195 exp, 196 n, 197 j, k, 198 proj, 199 image; 200 201 nccl:= NrConjugacyClasses( tbl ); 202 irr:= Irr( tbl ); 203 len:= Length( chars ); 204 good:= BlistList( [ 1 .. len ], [ 1 .. len ] ); 205 size:= Size( tbl ); 206 orders:= OrdersClassRepresentatives( tbl ); 207 208 for p in PrimeDivisors( Size( tbl ) ) do 209 210 # Compute the distribution of characters to blocks. 211 bl:= PrimeBlocks( tbl, p ); 212 213 # Apply (T8). 214 if size mod p^2 <> 0 then 215 216 # Get the rational irreducible characters in the principal block. 217 B:= bl.block[ Position( irr, TrivialCharacter( tbl ) ) ]; 218 B:= irr{ Filtered( [ 1 .. nccl ], j -> bl.block[j] = B ) }; 219 220 # Try to identify the character $\lambda_p$ 221 # with the property that $1_G + \lambda_p$ is projective. 222 # First form the orbit sums from which lambda is to be chosen. 223 # (There is at most one nontrivial orbit of exceptional characters.) 224 except:= Filtered( B, chi -> Conductor( chi ) mod p = 0 ); 225 if not IsEmpty( except ) then 226 B:= Difference( B, except ); 227 Add( B, Sum( except ) ); 228 fi; 229 lambda:= Filtered( B, chi -> ( chi[1] + 1 ) mod p = 0 ); 230 if 1 < Length( lambda ) then 231 lambda:= Filtered( lambda, chi -> 232 ForAll( [ 1 .. nccl ], 233 i -> orders[i] mod p <> 0 or chi[i] = -1 ) ); 234 fi; 235 236 # Check whether $\lambda_p$ is a constituent. 237 for i in [ 1 .. Length( chars ) ] do 238 if good[i] 239 and chars[i][1] mod p = 0 240 and ForAll( lambda, 241 chi -> ScalarProduct( tbl, chi, chars[i] ) = 0 ) then 242 243 Info( InfoCharacterTable, 1, 244 "TestPerm4: degree ", chars[i][1], 245 " fails to have lambda_",p," as a constituent" ); 246 good[i]:= false; 247 248 fi; 249 od; 250 251 fi; 252 253 # Now apply (T9). 254 255 # `exp[i]' is either `false' (for `p'-regular elements) 256 # or the smallest number s.t. the `exp[i]'-th power of an element 257 # in class `i' is a `p'-element. 258 exp:= []; 259 for i in [ 1 .. nccl ] do 260 n:= orders[i]; 261 if n mod p <> 0 then 262 exp[i]:= false; 263 else 264 while n mod p = 0 do 265 n:= n/p; 266 od; 267 exp[i]:= n; 268 fi; 269 od; 270 271 for k in [ 1 .. Length( bl.defect ) ] do 272 273 # Compute the projections $\pi_B$. 274 B:= irr{ Filtered( [ 1 .. nccl ], j -> bl.block[j] = k ) }; 275 proj:= MatScalarProducts( tbl, B, chars ) * B; 276 277 for i in [ 1 .. Length( chars ) ] do 278 279 if good[i] then 280 281 for j in [ 1 .. nccl ] do 282 if exp[j] <> false and good[i] then 283 if exp[j] = 1 then 284 image:= j; 285 else 286 image:= PowerMap( tbl, exp[j], j ); 287 fi; 288 while image <> 1 and good[i] do 289 290 if ( not IsInt( proj[i][ image ] ) ) 291 or proj[i][ image ] < 0 then 292 293 # $\pi_B(g^n)$ must be a nonnegative integer. 294 Info( InfoCharacterTable, 1, 295 "TestPerm4: degree ", chars[i][1], 296 " violates integrality for p = ", p, 297 ", class ", j ); 298 good[i]:= false; 299 300 elif proj[i][ image ] > chars[i][ image ] then 301 302 # $\pi_B(g^n) \leq \pi(g^n)$ must hold. 303 Info( InfoCharacterTable, 1, 304 "TestPerm4: degree ", chars[i][1], 305 " violates 2nd ineq. for p = ", p, 306 ", class ", j ); 307 good[i]:= false; 308 309 elif IsInt( proj[i][j] ) 310 and AbsInt( proj[i][j] ) > proj[i][ image ] then 311 312 # $|\pi_B(g)| \leq \pi_B(g^n)$ must hold. 313 Info( InfoCharacterTable, 1, 314 "TestPerm4: degree ", chars[i][1], 315 " violates 1st ineq. for p = ", p, 316 ", class ", j ); 317 good[i]:= false; 318 319 fi; 320 321 image:= PowerMap( tbl, p, image ); 322 od; 323 fi; 324 od; 325 326 fi; 327 328 od; 329 330 od; 331 332 od; 333 334 # Return the characters that satisfy the condition. 335 return ListBlist( chars, good ); 336end ); 337 338 339############################################################################## 340## 341## TestPerm5( <tbl>, <chars>, <modtbl> ) 342## 343## Check whether characters of degree divisible by the $p$-part of 344## the order of <tbl> are linear combinations of the projective 345## indecomposables. 346## 347InstallGlobalFunction( TestPerm5, function( tbl, chars, modtbl ) 348 349 local size, 350 p, 351 nccl, 352 cand, 353 irr, 354 bl, 355 pims, 356 k, 357 B, 358 sol; 359 360 size:= Size( tbl ); 361 p:= UnderlyingCharacteristic( modtbl ); 362 363 cand:= Filtered( chars, pi -> ( size / pi[1] ) mod p <> 0 ); 364 if IsEmpty( cand ) then 365 return chars; 366 fi; 367 368 nccl:= NrConjugacyClasses( tbl ); 369 irr:= Irr( tbl ); 370 371 bl:= PrimeBlocks( tbl, p ); 372 pims:= []; 373 for k in [ 1 .. Length( bl.defect ) ] do 374 B:= irr{ Filtered( [ 1 .. nccl ], j -> bl.block[j] = k ) }; 375 Append( pims, TransposedMat( DecompositionMatrix( modtbl, k ) ) * B ); 376 od; 377 378 # Decompose the candidates. 379 sol:= Decomposition( pims, cand, "nonnegative" ); 380 381 sol:= Filtered( [ 1 .. Length( sol ) ], i -> sol[i] = fail ); 382 if not IsEmpty( sol ) then 383 Info( InfoCharacterTable, 1, 384 "TestPerm5: ", 385 Length( sol ), " character(s) not decomposable into PIMs (p = ", 386 p, ")" ); 387 sol:= cand{ sol }; 388 chars:= Filtered( chars, pi -> not pi in sol ); 389 fi; 390 391 return chars; 392end ); 393 394 395############################################################################# 396## 397#M Inequalities( <tbl>, <chars>[, <option>] ) . . . 398#M projected system of inequalities 399## 400## Supported for <option>: `"small"' 401## 402InstallMethod( Inequalities, 403 [ IsOrdinaryTable, IsList ], 404 function( tbl, chars ) 405 return Inequalities( tbl, chars, "" ); 406 end ); 407 408InstallMethod( Inequalities, 409 [ IsOrdinaryTable, IsList, IsObject ], 410 function( tbl, chars, option ) 411 local i, j, h, o, dim, nccl, ncha, c, X, dir, root, ineq, tuete, 412 Conditor, Kombinat, other, mini, con, conO, conU, pos, 413 proform, project; 414 415 # local functions 416 proform:= function(tuete, s, dir) 417 local i, lo, lu, conO, conU, komO, komU, res; 418 419 conO:= []; conU:= []; 420 res:= 0; 421 for i in [1..Length(tuete)] do 422 if tuete[i][dir] < 0 then 423 Add(conO, Kombinat[i]); 424 elif tuete[i][dir] > 0 then 425 Add(conU, Kombinat[i]); 426 else 427 res:= res + 1; 428 fi; 429 od; 430 431 lo:= Length(conO); lu:= Length(conU); 432 433 if s = dim+1 then 434 return res + lo * lu; 435 fi; 436 437 for komO in conO do 438 if Length(komO) = 1 then 439 res:= res + lu; 440 else 441 for komU in conU do 442 if Length(Union(komO, komU)) <= dim+3 - s then 443 res:= res + 1; 444 fi; 445 od; 446 fi; 447 od; 448 449 return res; 450 end; 451 452 project:= function(tuete, dir) 453 local i, j, k, l, C, sum, com, lo, lu, conO, conU, 454 lineO, lineU, lc, kombi, res; 455 456 Info( InfoCharacterTable, 2, "project(", dir, ")" ); 457 458 conO:= []; conU:= []; 459 res:= []; kombi:= []; 460 for i in [1..Length(tuete)] do 461 if tuete[i][dir] < 0 then 462 Add(conO, rec(con:= tuete[i], kom:= Kombinat[i])); 463 Add(Conditor[dir], tuete[i]); 464 elif tuete[i][dir] > 0 then 465 Add(conU, rec(con:= tuete[i], kom:= Kombinat[i])); 466 Add(Conditor[dir], tuete[i]); 467 else 468 Add(res, tuete[i]); Add(kombi, Kombinat[i]); 469 fi; 470 od; 471 472 lo:= Length(conO); lu:= Length(conU); 473 474 Info( InfoCharacterTable, 2, lo, " ", lu ); 475 476 for lineO in conO do 477 for lineU in conU do 478 com:= Union(lineO.kom, lineU.kom); 479 lc:= Length(com); 480 if lc <= dim+3 - dir then 481 sum:= lineU.con[dir] * lineO.con - lineO.con[dir] * lineU.con; 482 sum:= Gcd(sum)^-1 * sum; 483 if lc - Length(lineO.kom) = 1 or lc - Length(lineU.kom) = 1 then 484 Add(res, sum); Add(kombi, com); 485 else 486 C:= List( ineq{ com }, x -> x{ [ dir .. dim+1 ] } ); 487 if RankMat(C) = lc-1 then 488 Add(res, sum); Add(kombi, com); 489 fi; 490 fi; 491 fi; 492 od; 493 od; 494 Kombinat:= kombi; 495 return res; 496 end; 497 498 nccl:= NrConjugacyClasses( tbl ); 499 X:= RationalizedMat( List( chars, ValuesOfClassFunction ) ); 500 501 c:= TransposedMat(X); 502 503 # determine power conditions 504 # ie: for each class find a root and replace column by difference. 505 506 root:= ClassRoots(tbl); 507 ineq:= []; other:= []; pos:= []; 508 for i in [2..nccl] do 509 if not c[i] in ineq then 510 AddSet(ineq, c[i]); Add(pos, i); 511 fi; 512 od; 513 ineq:= []; 514 for i in pos do 515 if root[i] = [] then 516 AddSet(ineq, c[i]); 517 AddSet(other, c[i]); 518 else 519 AddSet(ineq, c[i] - c[root[i][1]]); 520 for j in root[i] do 521 AddSet(other, c[i] - c[j]); 522 od; 523 fi; 524 od; 525 ineq:= List(ineq, x->Gcd(x)^-1*x); 526 other:= List(other, x->Gcd(x)^-1*x); 527 528 ncha:= Length(X); 529 530 dim:= Length(ineq); 531 if dim <> Length(ineq[1])-1 then 532 Error("nonregular problem"); 533 fi; 534 535 Conditor:= List([1..dim+1], x->[]); 536 Kombinat:= List([1..dim+1], x->[x]); 537 tuete:= ineq; 538 539 for i in Reversed([2..dim+1]) do 540 dir:= 0; 541 542 if option = "small" then 543 544 # find optimal direction 545 for j in [2..i] do 546 o:= proform(tuete, i, j); 547 if dir = 0 or o <= mini then 548 mini:= o; dir:= j; 549 fi; 550 od; 551 552 # make it the current one 553 if dir <> i then 554 for j in [i..ncha] do 555 for con in Conditor[j] do 556 h:= con[dir]; con[dir]:= con[i]; con[i]:= h; 557 od; 558 od; 559 for con in tuete do 560 h:= con[dir]; con[dir]:= con[i]; con[i]:= h; 561 od; 562 for con in other do 563 h:= con[dir]; con[dir]:= con[i]; con[i]:= h; 564 od; 565 566 h:= X[dir]; X[dir]:= X[i]; X[i]:= h; 567 fi; 568 fi; 569 570 # perform projection 571 tuete:= project(tuete, i); 572 573 # if regular, reinstall reference 574 if Length(tuete) = i-2 then 575 ineq:= tuete; 576 dim:= i-2; 577 Kombinat:= List([1..i-1], x->[x]); 578 Info( InfoCharacterTable, 2, "REGULAR !!!" ); 579 fi; 580 581 od; 582 583 # don't use too many inequalities 584 for i in [2..ncha] do 585 if Length(Conditor[i]) > 1 then 586 conO:= Filtered(Conditor[i], x->x[i] < 0); 587 conU:= Filtered(Conditor[i], x->x[i] > 0); 588 if Length(conO) > i then 589 conO:= conO{ [1..i] }; 590 fi; 591 if Length(conU) > i then 592 conU:= conU{ [1..i] }; 593 fi; 594 Conditor[i]:= Union(conO, conU); 595 fi; 596 od; 597 598 # but don't forget original conditions 599 for con in other do 600 i:= ncha; 601 while con[i] = 0 do i:= i-1; od; 602 AddSet(Conditor[i], con); 603 od; 604 605 return rec(obj:= X, Conditor:= Conditor); 606 end ); 607 608 609############################################################################# 610## 611#F Permut( <tbl>, <arec> ) 612## 613## The properties (g), (h), and (j) are checked explicitly for each 614## candidate that is produced, 615## the properties (a)--(e) are forced by the construction of the 616## candidates, 617## and the properties (f) and (i) are consequences of (b) and (e). 618## 619InstallGlobalFunction( Permut, function( tbl, arec ) 620 local tbl_size, permel, sortedchars, 621 a, amin, amax, c, ncha, len, i, j, k, l, permch, 622 Conditor, comb, cond, X, divs, pm, minR, maxR, 623 d, sub, del, s, nccl, root, other, 624 time1, time2, total, free, const, lowerBound, upperBound, 625 einfug, solveKnot, nextLevel, insertValue, suche; 626 627 # Check the arguments. 628 if not IsOrdinaryTable( tbl ) then 629 Error( "<tbl> must be complete character table" ); 630 fi; 631 632 tbl_size:= Size( tbl ); 633 634 if IsBound(arec.ineq) then 635 permel:= arec.ineq; 636 else 637 sortedchars:= SortedCharacters( tbl, Irr( tbl ), "degree" ); 638 permel:= Inequalities( tbl, sortedchars ); 639 fi; 640 641 # local functions 642 lowerBound:= function(cond, const, free, s) 643 local j, unten; 644 645 unten:= -const; 646 for j in [2..s-1] do 647 if free[j] then 648 if cond[j] < 0 then 649 unten:= unten - amin[j]*cond[j]; 650 elif cond[j] > 0 then 651 unten:= unten - amax[j]*cond[j]; 652 fi; 653 fi; 654 od; 655 if unten <= 0 then return 0; 656 else return QuoInt(unten-1, cond[s])+1; 657 fi; 658 end; 659 660 upperBound:= function(cond, const, free, s) 661 local j, oben; 662 oben:= const; 663 for j in [2..s-1] do if free[j] then 664 if cond[j] < 0 then 665 oben:= oben + amin[j]*cond[j]; 666 elif cond[j] > 0 then 667 oben:= oben + amax[j]*cond[j]; 668 fi; 669 fi;od; 670 if oben < 0 then return -1; 671 else return QuoInt(oben, -cond[s]); 672 fi; 673 end; 674 675 nextLevel:= function(const, free) 676 local h, i, j, p, c, con, cond, unten, oben, maxu, mino, 677 unique, first, mindeg, maxdeg; 678 679 unique:= []; 680 for h in [2..ncha] do 681 cond:= Conditor[h]; 682 c:= const[h]; 683 if free[h] then 684 # compute amin, amax 685 if not IsBound(first) then 686 first:= h; 687 fi; 688 maxu:= 0; 689 mino:= tbl_size; 690 for i in [1..Length(cond)] do 691 if cond[i][h] > 0 then 692 maxu:= Maximum(maxu, lowerBound(cond[i], const[h][i], free, h)); 693 else 694 mino:= Minimum(mino, upperBound(cond[i], const[h][i], free, h)); 695 fi; 696 od; 697 698 amin[h]:= maxu; 699 amax[h]:= mino; 700 if mino < maxu then 701 return h; 702 fi; 703 704 if mino = maxu then AddSet(unique, h); fi; 705 else 706 707 if IsBound(first) then 708 # interpret inequalities for lower steps ! 709 for i in [1..Length(cond)] do 710 con:= cond[i]; 711 s:= h-1; 712 while s > 1 and (not free[s] or con[s] = 0) do 713 s:= s-1; 714 od; 715 if s > 1 then 716 if con[s] > 0 then 717 unten:= lowerBound(con, c[i], free, s); 718 amin[s]:= Maximum(amin[s], unten); 719 else 720 oben:= upperBound(con, c[i], free, s); 721 amax[s]:= Minimum(amax[s], oben); 722 fi; 723 if amin[s] > amax[s] then return s; 724 elif amin[s] = amax[s] then AddSet(unique, s); 725 fi; 726 fi; 727 od; 728 729 fi; 730 fi; 731 od; 732 733 maxdeg:= 1; 734 mindeg:= 1; 735 for i in [2..ncha] do 736 maxdeg:= maxdeg + amax[i] * X[i][1]; 737 mindeg:= mindeg + amin[i] * X[i][1]; 738 od; 739 if minR > maxdeg or maxR < mindeg then 740 return 0; 741 fi; 742 743 if unique <> [] then return unique; 744 else return first; fi; 745 746 end; 747 748 insertValue:= function(const, s) 749 local i, j, c; 750 751 const:= List( const, ShallowCopy ); 752 753 for i in [s..ncha] do 754 c:= const[i]; 755 for j in [1..Length(c)] do 756 c[j]:= c[j] + a[s]*Conditor[i][j][s]; 757 od; 758 od; 759 760 return const; 761 end; 762 763 solveKnot:= function(const, free) 764 local i, p, s, char; 765 766 free:= ShallowCopy(free); 767 if Set(free) = [false] then 768 total:= total+1; 769 char:= X[1]; 770 for j in [2..ncha] do 771 char:= char + a[j] * X[j]; 772 od; 773 if TestPerm2(tbl, char) = 0 then 774 Add(permch, char); 775 Info( InfoCharacterTable, 2, Length(permch), a, "\n", char ); 776 fi; 777 else 778 s:= nextLevel(const, free); 779 if IsList(s) then 780 for i in s do 781 free[i]:= false; 782 a[i]:= amin[i]; 783 const:= insertValue(const, i); 784 od; 785 solveKnot(const, free); 786 elif s > 0 then 787 for i in [amin[s]..amax[s]] do 788 a[s]:= i; 789 amin[s]:= i; 790 amax[s]:= i; 791 free[s]:= false; 792 solveKnot(insertValue(const, s), free); 793 od; 794 fi; 795 fi; 796 end; 797 798 nccl:= NrConjugacyClasses( tbl ); 799 total:= 0; 800 X:= permel.obj; 801 permch:= []; 802 803 ncha:= Length(X); 804 805 a:= [1]; 806 807 if IsBound(arec.degree) then 808 809 minR:= Minimum(arec.degree); maxR:= Maximum(arec.degree); 810 amax:= [1]; amin:= [1]; 811 Conditor:= permel.Conditor; 812 free:= List(Conditor, x->true); 813 free[1]:= false; 814 const:= List(Conditor, x-> List(x, y->y[1])); 815 solveKnot(const, free); 816 817 # The result list may contain also some characters of degree 818 # different from the desired ones. 819 # We remove these characters. 820 permch:= Filtered( permch, x -> x[1] in arec.degree ); 821 822 else 823 824 suche:= function(s) 825 local unten, oben, i, j, char, 826 maxu, mino, c; 827 828 unten:= []; 829 oben:= []; 830 831 maxu:= 0; 832 833 for i in [1..Length(Conditor[s].u)] do 834 unten:= 0; 835 for j in [1..s-1] do 836 unten:= unten - a[j]*Conditor[s].u[i][j]; 837 od; 838 if unten <= 0 then 839 unten:= 0; 840 else 841 unten:= QuoInt(unten-1, Conditor[s].u[i][s]) + 1; 842 fi; 843 844 maxu:= Maximum(maxu, unten); 845 od; 846 for i in [1..Length(Conditor[s].o)] do 847 oben:= 0; 848 for j in [1..s-1] do 849 oben:= oben + a[j]*Conditor[s].o[i][j]; 850 od; 851 if oben < 0 then 852 oben:= -1; 853 else 854 oben:= QuoInt(oben, -Conditor[s].o[i][s]); 855 fi; 856 if not IsBound(mino) then 857 mino:= oben; 858 else 859 mino:= Minimum(mino, oben); 860 fi; 861 od; 862 863 for i in [maxu..mino] do 864 a[s]:= i; 865 if s < ncha then 866 suche(s+1); 867 else 868 total:= total+1; 869 char:= a * X; 870 if TestPerm2(tbl, char) = 0 then 871 Add(permch, char); 872 Info( InfoCharacterTable, 2, Length(permch), a, "\n", char ); 873 fi; 874 fi; 875 od; 876 a[s]:= 0; 877 end; 878 879 Conditor:= []; 880 for i in [1..ncha] do 881 Conditor[i]:= rec(o:= Filtered(permel.Conditor[i], x->x[i] < 0), 882 u:= Filtered(permel.Conditor[i], x->x[i] > 0)); 883 od; 884 885 suche(2); 886 887 fi; 888 889 # Check condition (h). 890 permch:= TestPerm3( tbl, permch ); 891 892 Info( InfoCharacterTable, 2,"Total number of tested Characters:", total ); 893 Info( InfoCharacterTable, 2,"Surviving: ", Length(permch) ); 894 895 return List( permch, vals -> Character( tbl, vals ) );; 896end ); 897 898 899############################################################################# 900## 901#F PermBounds( <tbl>, <degree>[, <ratirr>] ) . boundary points for simplex 902## 903InstallGlobalFunction( PermBounds, function( arg ) 904 local tbl, degree, X, irreds, i, j, h, o, dim, nccl, ncha, c, dir, root, 905 ineq, other, rho, pos, vec, deglist, point; 906 907 tbl:= arg[1]; 908 degree:= arg[2]; 909 if IsBound( arg[3] ) then 910 X:= arg[3]; 911 else 912 # The trivial character is expected to be the first one. 913 # So sort the irreducibles, if necessary. 914 irreds:= List( Irr( tbl ), ValuesOfClassFunction ); 915 if not ForAll( irreds[1], x -> x = 1 ) then 916 irreds:= SortedCharacters( tbl, irreds, "degree" ); 917 fi; 918 X:= RationalizedMat( irreds ); 919 fi; 920 921 nccl:= NrConjugacyClasses( tbl ); 922 c:= TransposedMat(X); 923 924 # determine power conditions 925 # i.e.: for each class find a root and replace column by difference. 926 927 root:= ClassRoots(tbl); 928 ineq:= []; other:= []; pos:= []; 929 for i in [2..nccl] do 930 if not c[i] in ineq then 931 AddSet(ineq, c[i]); Add(pos, i); 932 fi; 933 od; 934 ineq:= []; 935 for i in pos do 936 if root[i] = [] then 937 AddSet(ineq, c[i]); 938 AddSet(other, c[i]); 939 else 940 AddSet(ineq, c[i] - c[root[i][1]]); 941 for j in root[i] do 942 AddSet(other, c[i] - c[j]); 943 od; 944 fi; 945 od; 946 ineq:= List(ineq, x->Gcd(x)^-1*x); 947 other:= List(other, x->Gcd(x)^-1*x); 948 949 ncha:= Length(X); 950 951 dim:= Length(ineq); 952 if dim <> Length(ineq[1])-1 then 953 Error("nonregular problem"); 954 fi; 955 956 # now correct inequalities ? 957 vec:= List(ineq, x->-x[1]); 958 ineq:= List(ineq, x-> x{ [2..dim+1] } ); 959 960 # determine boundary points 961 deglist:= List( X{ [2..ncha] }, x->x[1]); 962 Add(ineq, deglist); 963 Add(vec, degree-1); 964 965 point:= MutableTransposedMat(ineq); 966 Add(point, -vec); 967 968 point:= point^-1; 969 970 dim:= Length(point[1]); 971 972 rho:= point[dim][dim]^-1 * point[dim]{ [1..dim-1] }; 973 point:= List( point, x-> x[dim]^-1 * x{ [1..dim-1] } ){ [1..dim-1] }; 974#T ? 975 976 return rec(obj:= X, point:= point, rho:= rho, other:= other); 977 978end ); 979 980 981############################################################################# 982## 983#F PermComb( <tbl>, <arec> ) . . . . . . . . . . . . permutation characters 984## 985## The properties (b), (d), (g), (h), and (j) are checked explicitly for 986## each candidate that is produced, 987## the properties (a), (c), and (e) are forced by the construction of the 988## candidates, 989## and the properties (f) and (i) are consequences of (b) and (e). 990## 991InstallGlobalFunction( PermComb, function( tbl, arec ) 992 993 local irreds, # irreducible characters of `tbl' 994 newirreds, # shallow copy of `irreds' 995 perm, # permutation of constituents 996 mindeg, # list of minimal multiplicities of constituents 997 maxdeg, # list of maximal multiplicities of constituents 998 lincom, # local function, backtrack 999 prep, 1000 X, # possible constituents 1001 xdegrees, # degrees of the characters in `X' 1002 point, 1003 rho, 1004 permch, 1005 Constituent, 1006 maxList, 1007 minList; 1008 1009 # The trivial character is expected to be the first one. 1010 # So sort the irreducibles, if necessary. 1011 irreds:= List( Irr( tbl ), ValuesOfClassFunction ); 1012 if not ForAll( irreds[1], x -> x = 1 ) then 1013 1014 newirreds:= SortedCharacters( tbl, irreds, "degree" ); 1015 perm:= Sortex( ShallowCopy( irreds ) ) 1016 / Sortex( ShallowCopy( newirreds ) ); 1017 irreds:= newirreds; 1018 if IsBound( arec.bounds ) and IsList( arec.bounds ) then 1019 arec:= ShallowCopy( arec ); 1020 arec.bounds:= Permuted( arec.bounds, perm ); 1021 fi; 1022 1023 fi; 1024 1025 maxList:= function(list) 1026 local i, col, max; 1027 max:= []; 1028 for i in [1..Length(list[1])] do 1029 col:= Maximum(List(list, x->x[i])); 1030 Add(max, Int(col)); 1031 od; 1032 return max; 1033 end; 1034 1035 minList:= function(list) 1036 local i, col, min; 1037 min:= []; 1038 for i in [1..Length(list[1])] do 1039 col:= Minimum(List(list, x->x[i])); 1040 if col <= 0 then 1041 Add(min, 0); 1042 elif IsInt(col) then 1043 Add(min, col); 1044 else 1045 Add(min, Int(col)+1); 1046 fi; 1047 od; 1048 return min; 1049 end; 1050 1051 lincom:= function() 1052 local i, j, k, a, d, ncha, comb, mdeg, maxb, searching, char; 1053 1054 ncha:= Length(xdegrees); 1055 mdeg:= List([1..ncha], x->0); 1056 comb:= List([1..ncha], x->0); 1057 maxb:= []; 1058 for i in [1..ncha-1] do 1059 maxb[i]:= 0; 1060 for j in [2..i] do 1061 maxb[i]:= maxb[i] + xdegrees[j] * maxdeg[j]; 1062 od; 1063#T improve! (maxb[i]:= maxb[i-1] + xdegrees[j] * maxdeg[j];) 1064 od; 1065 d:= arec.degree - Constituent[1]; 1066 k:= ncha - 1; 1067 searching:= true; 1068 1069 while searching do 1070 for j in Reversed([1..k]) do 1071 a:= d - mdeg[j+1] - maxb[j]; 1072 if a <= 0 then 1073 comb[j+1]:= 0; 1074 else 1075 comb[j+1]:= Minimum(QuoInt(a-1, xdegrees[j+1])+1, maxdeg[j+1]); 1076 fi; 1077 mdeg[j]:= mdeg[j+1] + comb[j+1] * xdegrees[j+1]; 1078 od; 1079 1080 if mdeg[1] = d then 1081 char:= Constituent + comb * X; 1082 if TestPerm1( tbl, char ) = 0 and TestPerm2( tbl, char ) = 0 then 1083 Add( permch, char ); 1084 Info( InfoCharacterTable, 2, Length(permch), comb, "\n", char ); 1085#T ?? 1086 else 1087 Info( InfoCharacterTable, 2, "-" ); 1088#T ?? 1089 fi; 1090 fi; 1091 1092 i:= 3; 1093 while i <= ncha and 1094 (comb[i] >= maxdeg[i] or mdeg[i-1]+ xdegrees[i] > d) do 1095 i:= i+1; 1096 od; 1097 if i <= ncha then 1098 mdeg[i-1]:= mdeg[i-1] + xdegrees[i]; 1099 comb[i]:= comb[i] + 1; 1100 k:= i-2; 1101 else 1102 searching:= false; 1103#T just return, leave out `searching'! 1104 fi; 1105 od; 1106 end; 1107 1108 if IsBound(arec.bounds) then 1109 prep:= arec.bounds; 1110 if prep = false then 1111 X:= RationalizedMat( irreds ); 1112 else 1113 X:= prep.obj; 1114 rho:= Size( tbl ) ^-1 * (List(prep.point, x->prep.rho) - prep.point); 1115 fi; 1116 else 1117 X:= RationalizedMat( irreds ); 1118 prep:= PermBounds( tbl, 0, X ); 1119 rho:= Size( tbl ) ^-1 * (List(prep.point, x->prep.rho) - prep.point); 1120 fi; 1121 1122 xdegrees:= List(X, x->x[1]); 1123 permch:= []; 1124 1125 # Compute bounds for the multiplicities of the constituents. 1126 # (The trivial character *must* have multiplicity $1$.) 1127 if IsRecord( prep ) then 1128 1129 # Compute minimal and maximal multiplicities from the info in `prep'. 1130 point:= prep.point + arec.degree * rho; 1131 maxdeg:= [1]; 1132 Append(maxdeg, maxList(point)); 1133 mindeg:= [1]; 1134 Append(mindeg, minList(point)); 1135 1136 else 1137 1138 # The maximal multiplicity of $\psi$ in $\pi$ is bounded 1139 # by $\psi(1)/[\psi,\psi]$ and by $(\pi(1)-1)/\psi(1)$. 1140 maxdeg:= List( [ 1 .. Length( xdegrees ) ], 1141 i -> Minimum( xdegrees[i], 1142 QuoInt( arec.degree - 1, xdegrees[i] ) ) ); 1143 maxdeg[1]:= 1; 1144 mindeg:= List( X, x -> 0 ); 1145 mindeg[1]:= 1; 1146 1147 fi; 1148 1149 # Explicit upper bounds for the maximal multiplicities are prescribed. 1150 if IsBound( arec.maxmult ) then 1151 if Length( maxdeg ) <> Length( arec.maxmult ) then 1152 Error( "<arec>.maxmult corresponds to the rat. irred. characters" ); 1153 fi; 1154 maxdeg:= List( [ 1 .. Length( maxdeg ) ], 1155 i -> Minimum( maxdeg[i], arec.maxmult[i] ) ); 1156 fi; 1157 1158 # `mindeg' prescribes a constituent. 1159 Constituent:= mindeg * X; 1160 maxdeg:= maxdeg - mindeg; 1161 1162 lincom(); 1163 1164 # Check condition (h). 1165 permch:= TestPerm3( tbl, permch ); 1166 1167 Sort( permch ); 1168 return List( permch, values -> Character( tbl, values ) ); 1169end ); 1170 1171 1172############################################################################# 1173## 1174#F PermCandidates( <tbl>, <characters>, <torso>, <all> ) 1175## 1176## The properties (a) and (j) are checked explicitly for each candidate that 1177## is produced, 1178## the properties (b), (c), (e), (g), (h), and (i) are forced by the 1179## construction of the candidates, 1180## the property (f) --as well as (i)-- is a consequence of (b) and (e), 1181#T and property (d) could and should in principle be forced by construction, 1182#T but is checked afterwards. 1183## 1184InstallGlobalFunction( PermCandidates, 1185 function( tbl, characters, torso, all ) 1186 1187 local tbl_classes, # attribute of `tbl' 1188 tbl_size, # attribute of `tbl' 1189 ratchars, # list of all rational irreducible characters 1190 consider_candidate, # function to check each candidate 1191 orders, # list of representative orders of `tbl' 1192 tbl_centralizers, # attribute of `tbl' 1193 i, chi, matrix, fusion, moduls, divs, normindex, candidate, 1194 classes, nonzerocol, 1195 possibilities, # list of candidates already found 1196 rest, images, uniques, 1197 nccl, min_anzahl, min_class, erase_uniques, impossible, 1198 evaluate, first, localstep, 1199 remain, ncha, pos, fusionperm, newimages, oldrows, newmatrix, 1200 step, erster, descendclass, j, row; 1201 1202 tbl_classes:= SizesConjugacyClasses( tbl ); 1203 tbl_size:= Size( tbl ); 1204 1205 if all = true then 1206 ratchars:= List( characters, ValuesOfClassFunction ); 1207 else 1208 ratchars:= RationalizedMat( List( Irr( tbl ), ValuesOfClassFunction ) ); 1209 fi; 1210 1211 # We know that `genchar' is a generalized character, 1212 # since it is in the span of `characters', modulo the generalized 1213 # characters that are nonzero on exactly one Galois family of classes. 1214 consider_candidate:= function( genchar ) 1215 1216 local i, chi, cand; 1217 1218 # Check condition (a), 1219 # i.e., the scalar products with `ratchars' are nonnegative. 1220 cand:= []; 1221 for i in [ 1 .. Length( genchar ) ] do 1222 cand[i]:= genchar[i] * tbl_classes[i]; 1223 od; 1224#T better: once multiply all in `ratchars' with the class lengths! 1225 for chi in ratchars do 1226 if cand * chi < 0 then 1227 return false; 1228 fi; 1229 od; 1230 1231 # Check the properties (d) and (j) of possible permutation characters, 1232 # which are not guaranteed by the construction. 1233#T some others are guaranteed but are tested here again ... 1234 if TestPerm1( tbl, genchar ) = 0 and TestPerm2( tbl, genchar ) = 0 then 1235 Add( possibilities, genchar ); 1236 fi; 1237 1238 end; 1239 1240 # step 1: check and improve input 1241 if not IsInt( torso[1] ) or torso[1] <= 0 then # degree 1242 Error( "degree must be positive integer" ); 1243 elif tbl_size mod torso[1] <> 0 then 1244 return []; 1245 fi; 1246 1247 # Force property (g) of possible permutation characters. 1248 # ($\pi(g) = 0$ if the order of $g$ does not divide $|G|/\pi(1)$.) 1249 orders:= OrdersClassRepresentatives( tbl ); 1250 for i in [ 1 .. Length( characters[1] ) ] do 1251 if ( tbl_size / torso[1] ) mod orders[i] <> 0 then 1252 if IsBound( torso[i] ) and IsInt( torso[i] ) and torso[i] <> 0 then 1253 Error( "value must be zero at class ", i ); 1254 fi; 1255 torso[i]:= 0; 1256 fi; 1257 od; 1258 1259 # In all cases except one, 1260 # only constituents of degree less than the desired degree are allowed. 1261 matrix:= []; 1262 for chi in characters do 1263 if chi[1] < torso[1] then 1264 AddSet( matrix, chi ); 1265 fi; 1266 od; 1267 1268 # (Of course the trivial character itself is the exception.) 1269 if IsEmpty( matrix ) then 1270 if ForAll( torso, x -> x = 1 ) then 1271 return [ TrivialCharacter( tbl ) ]; 1272 else 1273 return []; 1274 fi; 1275 fi; 1276 1277 # The computations in each column are done modulo the centralizer 1278 # order of this column. 1279 # More precisely, we may choose the largest centralizer order for 1280 # all those columns of the character table that correspond to the 1281 # given column of `matrix'. 1282 tbl_centralizers:= SizesCentralizers( tbl ); 1283 matrix:= CollapsedMat( matrix, [ ] ); 1284 fusion:= matrix.fusion; 1285 matrix:= matrix.mat; 1286 moduls:= []; 1287 for i in [ 1 .. Length( fusion ) ] do 1288 if IsBound( moduls[ fusion[i] ] ) then 1289 moduls[ fusion[i] ]:= Maximum( moduls[ fusion[i] ], 1290 tbl_centralizers[i] ); 1291#T Would Lcm be allowed? 1292 else 1293 moduls[ fusion[i] ]:= tbl_centralizers[i]; 1294 fi; 1295 od; 1296 1297 # Force property (h) of possible permutation characters, 1298 # i.e., $\pi(1) |N_G(g)|$ divides $\pi(g) |G|$ for all $g \in G$. 1299 # (This is equivalent to the condition that 1300 # $\pi(1) / \gcd( \pi(1), [ G : N_G(g) ] )$ divides $\pi(g)$.) 1301 divs:= [ torso[1] ]; 1302 for i in [ 2 .. Length( fusion ) ] do 1303 normindex:= ( tbl_classes[i] * Length( ClassOrbit( tbl, i ) ) ) 1304 / Phi( orders[i] ); 1305 if IsBound( divs[ fusion[i] ] ) then 1306 divs[ fusion[i] ]:= Lcm( divs[ fusion[i] ], 1307 torso[1] / GcdInt( torso[1], normindex ) ); 1308 else 1309 divs[ fusion[i] ]:= torso[1] / GcdInt( torso[1], normindex ); 1310 fi; 1311 od; 1312 1313 candidate:= []; 1314 nonzerocol:= []; 1315 classes:= []; 1316 for i in [ 1 .. Length( moduls ) ] do 1317 candidate[i]:= 0; 1318 nonzerocol[i]:= true; 1319 classes[i]:= 0; 1320 od; 1321 1322 for i in [ 1 .. Length( fusion ) ] do 1323 classes[ fusion[i] ]:= classes[ fusion[i] ] + tbl_classes[i]; 1324 od; 1325 1326 # Initialize the global list of all possible permutation characters. 1327 possibilities:= []; 1328 1329 # The scalar product of the trivial character with a transitive 1330 # permutation character is $1$, 1331 # this yields an upper bound on the values that are not yet known. 1332 # We subtract the known values from `Size( tbl )'. 1333 # (If there is a contradiction, we return an empty list.) 1334 rest:= tbl_size; 1335 images:= []; 1336 uniques:= []; 1337 for i in [ 1 .. Length( fusion ) ] do 1338 if IsBound( torso[i] ) and IsInt( torso[i] ) then 1339 if IsBound( images[ fusion[i] ] ) then 1340 if torso[i] <> images[ fusion[i] ] then 1341 1342 # Different values are prescribed for identified columns. 1343 return []; 1344 1345 fi; 1346 else 1347 images[ fusion[i] ]:= torso[i]; 1348 AddSet( uniques, fusion[i] ); 1349 rest:= rest - classes[ fusion[i] ] * torso[i]; 1350 if rest < 0 then 1351 return []; 1352 fi; 1353 fi; 1354 fi; 1355 od; 1356 nccl:= Length( moduls ); 1357 1358 Info( InfoCharacterTable, 2, "PermCandidates: input checked" ); 1359 1360 # step 2: first elimination before backtrack: 1361 1362 erase_uniques:= function( uniques, nonzerocol, candidate, rest ) 1363 1364 # eliminate all unique columns, adapt nonzerocol; 1365 # then look if other columns become unique or if a contradiction occurs; 1366 # also look at which column the least number of values is left 1367 1368 local i, j, extracted, col, row, quot, val, ggt, a, b, k, u, anzahl, 1369 firstallowed, step, gencharacter, shrink; 1370 1371 extracted:= []; 1372 while uniques <> [] do 1373 for col in uniques do 1374 if col < 0 then # nonzero entries in `col' already eliminated 1375 col:= -col; 1376 candidate[ col ]:= ( candidate[ col ] + images[ col ] ) 1377 mod moduls[ col ]; 1378 row:= fail; 1379 else # eliminate nonzero entries in `col' 1380 candidate[ col ]:= ( candidate[ col ] + images[ col ] ) 1381 mod moduls[ col ]; 1382 row:= StepModGauss( matrix, moduls, nonzerocol, col ); 1383 1384 # delete zero rows: 1385 shrink:= []; 1386 for i in matrix do 1387 if PositionNonZero( i ) <= Length( i ) then 1388#T better call IsZero? 1389 Add( shrink, i ); 1390 fi; 1391 od; 1392 matrix:= shrink; 1393 fi; 1394 if row <> fail then 1395 Add( extracted, row ); 1396 quot:= candidate[ col ] / row[ col ]; 1397 if not IsInt( quot ) then 1398 impossible:= true; 1399 return extracted; 1400 fi; 1401 for j in [ 1 .. nccl ] do 1402 if nonzerocol[j] then 1403 candidate[j]:= ( candidate[j] - quot * row[j] ) mod moduls[j]; 1404 fi; 1405 od; 1406 elif candidate[col] <> 0 then 1407 impossible:= true; 1408 return extracted; 1409 fi; 1410 nonzerocol[col]:= false; 1411 od; 1412 min_anzahl:= infinity; 1413 uniques:= []; 1414 1415 # compute the number of possible values `x' for each class `i'. 1416 # `x' must be smaller or equal `Minimum( rest / classes[i], torso[1] )', 1417 # divisible by `divs[i]' and 1418 # congruent `-candidate[i]' modulo the Gcd of column `i'. 1419 for i in [ 1 .. nccl ] do 1420 if nonzerocol[i] then 1421 val:= moduls[i]; 1422 for j in matrix do val:= GcdInt( val, j[i]); od; # the Gcd of `i' 1423 # zerocol iff val = moduls[i] 1424 first:= ( - candidate[i] ) mod val; # the first possible value 1425 # in the case `divs[i] = 1' 1426 if divs[i] = 1 then 1427 localstep:= val; # all values are 1428 # `first, first + val, first + 2*val ..' 1429 else 1430 ggt:= Gcdex( divs[i], val ); 1431 a:= ggt.coeff1; 1432 ggt:= ggt.gcd; 1433 if first mod ggt <> 0 then # ggt divides `divs[i]' and hence `x'; 1434 # since ggt divides `val', which must 1435 # divide `( x + candidate[i] )', 1436 # we must have ggt dividing `first' 1437 impossible:= true; 1438 return extracted; 1439 fi; 1440 localstep:= Lcm( divs[i], val ); 1441 first:= ( first * a * divs[i] / ggt ) mod localstep; 1442 # satisfies the required congruences 1443 # (and that is enough here) 1444 fi; 1445 anzahl:= Int( ( Minimum( Int( rest[1] / classes[i] ), torso[1] ) 1446 - first + localstep ) / localstep ); 1447 if anzahl <= 0 then # contradiction 1448 impossible:= true; 1449 return extracted; 1450 elif anzahl = 1 then # unique 1451 images[i]:= first; 1452 if val = moduls[i] then # no elimination necessary 1453 # (the column consists of zeroes) 1454 Add( uniques, -i ); 1455 else 1456 Add( uniques, i ); 1457 fi; 1458 rest[1]:= rest[1] - classes[i] * images[i]; 1459 elif anzahl < min_anzahl then 1460 min_anzahl:= anzahl; 1461 step:= localstep; 1462 firstallowed:= first; 1463 min_class:= i; 1464 fi; 1465 fi; 1466 od; 1467 od; 1468 if min_anzahl = infinity then 1469 if rest[1] = 0 then 1470 consider_candidate( images{ fusion } ); 1471 fi; 1472 impossible:= true; 1473 else 1474 images[ min_class ]:= rec( firstallowed:= firstallowed, # first value 1475 step:= step, # step 1476 anzahl:= min_anzahl ); # no. of values 1477 impossible:= false; 1478 fi; 1479 return extracted; 1480 # impossible = true: calling function will return from backtrack 1481 # impossible = false: then min_class < infinity, and images[ min_class ] 1482 # contains the information for descending at min_class 1483 end; 1484 1485 rest:= [ rest ]; 1486 erase_uniques( uniques, nonzerocol, candidate, rest ); 1487 1488 # Here we may forget the extracted rows, 1489 # later in the backtrack they must be appended after each return. 1490 1491 rest:= rest[1]; 1492 if impossible then 1493 return List( possibilities, vals -> Character( tbl, vals ) ); 1494 fi; 1495 1496 Info( InfoCharacterTable, 2, 1497 "PermCandidates: unique columns erased, there are ", 1498 Number( nonzerocol, x -> x ), " columns left,\n", 1499 "#I the number of constituents is ", Length( matrix ), "." ); 1500 1501 # step 3: collapse 1502 1503 remain:= Filtered( [ 1 .. nccl ], x -> nonzerocol[x] ); 1504 for i in [ 1 .. Length( matrix ) ] do 1505 matrix[i]:= matrix[i]{ remain }; 1506 od; 1507 candidate:= candidate{ remain }; 1508 divs:= divs{ remain }; 1509 nonzerocol:= nonzerocol{ remain }; 1510 moduls:= moduls{ remain }; 1511 classes:= classes{ remain }; 1512 matrix:= ModGauss( matrix, moduls ); 1513 ncha:= Length( matrix ); 1514 pos:= 1; 1515 fusionperm:= []; 1516 newimages:= []; 1517 for i in remain do 1518 fusionperm[i]:= pos; 1519 if IsBound( images[i] ) then 1520 newimages[ pos ]:= images[i]; 1521 fi; 1522 pos:= pos + 1; 1523 od; 1524 min_class:= fusionperm[ min_class ]; 1525 for i in Difference( [ 1 .. nccl ], remain ) do 1526 fusionperm[i]:= pos; 1527 newimages[ pos ]:= images[i]; 1528 pos:= pos + 1; 1529 od; 1530 images:= newimages; 1531 fusion:= CompositionMaps( fusionperm, fusion ); 1532 nccl:= Length( nonzerocol ); 1533 1534 Info( InfoCharacterTable, 2, 1535 "PermCandidates: known columns physically deleted,\n", 1536 "#I a backtrack search will be needed" ); 1537 1538 # step 4: backtrack 1539 1540 evaluate:= function( candidate, rest, nonzerocol, uniques ) 1541 local i, j, col, val, row, quot, extracted, step, erster, descendclass; 1542 rest:= [ rest ]; 1543 extracted:= erase_uniques( [ uniques ], nonzerocol, candidate, rest ); 1544 rest:= rest[1]; 1545 if impossible then 1546 return extracted; 1547 fi; 1548 descendclass:= min_class; 1549 step:= images[ descendclass ].step; # spalten-ggt 1550 erster:= images[ descendclass ].firstallowed; 1551 rest:= rest + ( step - erster ) * classes[ descendclass ]; 1552 for i in [ 1 .. min_anzahl ] do 1553 images[ descendclass ]:= erster + (i-1) * step; 1554 rest:= rest - step * classes[ descendclass ]; 1555 oldrows:= evaluate( ShallowCopy( candidate ), rest, 1556 ShallowCopy( nonzerocol ), descendclass ); 1557 Append( matrix, oldrows ); 1558 if Length( matrix ) > ( 3 * ncha ) / 2 then 1559 newmatrix:= []; # matrix:= ModGauss( matrix, moduls ); 1560 for j in [ 1 .. Length( matrix[1] ) ] do 1561 if nonzerocol[j] then 1562 row:= StepModGauss( matrix, moduls, nonzerocol, j ); 1563 if row <> fail then Add( newmatrix, row ); fi; 1564 fi; 1565 od; 1566 matrix:= newmatrix; 1567 fi; 1568 od; 1569 return extracted; 1570 end; 1571 1572 # 1573 1574 step:= images[min_class].step; # spalten-ggt 1575 erster:= images[min_class].firstallowed; 1576 descendclass:= min_class; 1577 rest:= rest + ( step - erster ) * classes[ descendclass ]; 1578 for i in [ 1 .. min_anzahl ] do 1579 images[ descendclass ]:= erster + (i-1) * step; 1580 rest:= rest - step * classes[ descendclass ]; 1581 oldrows:= evaluate( ShallowCopy( candidate ), rest, 1582 ShallowCopy( nonzerocol ), descendclass ); 1583 Append( matrix, oldrows ); 1584 if Length( matrix ) > ( 3 * ncha ) / 2 then 1585 newmatrix:= []; # matrix:= ModGauss( matrix, moduls ); 1586 for j in [ 1 .. Length( matrix[1] ) ] do 1587 if nonzerocol[j] then 1588 row:= StepModGauss( matrix, moduls, nonzerocol, j ); 1589 if row <> fail then Add( newmatrix, row ); fi; 1590 fi; 1591 od; 1592 matrix:= newmatrix; 1593 fi; 1594 od; 1595 1596 return List( possibilities, values -> Character( tbl, values ) ); 1597end ); 1598 1599 1600############################################################################# 1601## 1602#F PermCandidatesFaithful( <tbl>, <chars>, <norm\_subgrp>, <nonfaithful>, 1603#F <lower>, <upper>, <torso>[, <all>] ) 1604## 1605# `PermCandidatesFaithful'\\ 1606# ` ( tbl, chars, norm\_subgrp, nonfaithful, lower, upper, torso )' 1607# 1608# reference of variables\: 1609# \begin{itemize} 1610# \item `tbl'\: a character table which must contain field `order' 1611# \item `chars'\: *rational* characters of `tbl' 1612# \item `nonfaithful'\: $(1_{UN})^G$ 1613# \item `lower'\: lower bounds for $(1_U)^G$ 1614# (may be unspecified, i.e. 0) 1615# \item `upper'\: upper bounds for $(1_U)^G$ 1616# (may be unspecified, i.e. 0) 1617# \item `torso'\: $(1_U)^G$ (at known positions) 1618# \item `faithful'\: `torso' - `nonfaithful' 1619# \item `divs'\: `divs[i]' divides $(1_U)^G[i]$ 1620# \end{itemize} 1621# 1622# The algorithm proceeds in 5 steps\: 1623# 1624# *step 1*\: Try to improve the input data 1625# \begin{enumerate} 1626# \item Check if `torso[1]' divides $\|G\|$, `nonfaithful[1]' divides 1627# `torso[1]'. 1628# \item If `orders[i]' does not divide $U$ 1629# or if $'nonfaithful[i]' = 0$, `torso[i]' must be 0. 1630# \item Transfer `upper' and `lower' to upper bounds and lower bounds for 1631# the values of `faithful' and try to improve them\: 1632# \begin{enumerate} 1633# \item \['lower[i]'\:= \max\{'lower[i]',0\} - `nonfaithful[i]';\] 1634# If $UN$ has only one galois family of classes for a prime 1635# representative order $p$, and $p$ divides $\|G\|/'torso[1]'$, 1636# or if $g_i$ is a $p$-element and $p$ does not divide $[UN\:U]$, 1637# then necessarily these elements lie in $U$, and we have 1638# \['lower[i]'\:= \max\{'lower[i]',1\} - `nonfaithful[i]';\] 1639# \item \begin{eqnarray*} 1640# `upper[i]' & \:= & \min\{'upper[i]','torso[1]', 1641# `tbl_centralizers[i]'-1,\\ 1642# & & `torso[1]' \cdot `nonfaithful[i]'/'nonfaithful[1]'\} 1643# -'nonfaithful[i]'. 1644# \end{eqnarray*} 1645# \end{enumerate} 1646# \item Compute divisors of the values of $(1_U)^G$\: 1647# \['divs[i]'\:= `torso[1]'/\gcd\{'torso[1]',\|G\|/\|N_G[i]\|\} 1648# \mbox{\rm \ divides} (1_U)^G[i].\] 1649# ($\|N_G[i]\|$ denotes the normalizer order of $\langle g_i \rangle$.) 1650# 1651# If $g_i$ generates a Sylow $p$ subgroup of $UN$ and $p$ does not 1652# divide $[UN\:U]$ then $(1_{UN})^G(g_i)$ divides $(1_U)^G(g_i)$, 1653# and we have \['divs[i]'\:= `Lcm( divs[i], nonfaithful[i] )'.\] 1654# \item Compute `roots' and `powers' for later improvements of local bounds\: 1655# $j$ is in `roots[i]' iff there exists a prime $p$ with powermap 1656# stored on `tbl' and $g_j^p = g_i$, 1657# $j$ is in `powers[i]' iff there exists a prime $p$ with powermap 1658# stored on `tbl' and $g_i^p = g_j$. 1659# \item Compute the list `matrix' of possible constituents of `faithful'\: 1660# (If `torso[1]' = 1, we have none.) 1661# Every constituent $\chi$ must have degree $\chi(1)$ lower than 1662# $'torso[1]' - `nonfaithful[1]'$, and $N \not\subseteq \ker(\chi)$; 1663# also, for all i, we must have 1664# $\chi[i] \geq \chi[1] - `faithful[1]' - `nonfaithful[i]'$. 1665# \end{enumerate} 1666# 1667# *step 2*\: Collapse classes which are equal for all possible constituents 1668# 1669# (*Note*\: We only needed the fusion of classes, but we also have to make 1670# a copy.) 1671# 1672# After that, `fusion' induces an equivalence relation of conjugacy classes, 1673# `matrix' is the new list of constituents. Let $C \:= \{i_1,\ldots,i_n\}$ 1674# be an equivalence class; for further computation, we have to adjust the 1675# other information\: 1676# 1677# \begin{enumerate} 1678# \item Collapse `faithful'; the values that are not yet known later will be 1679# filled in using the decomposability test (see "ContainedCharacters"); 1680# the equality 1681# \['torso' = `nonfaithful' + `Indirection'('faithful','fusion')\] 1682# holds, so later we have 1683# \[(1_U)^G = (1_{UN})^G + `Indirection( faithful , fusion )'.\] 1684# \item Adjust the old structures\: 1685# \begin{enumerate} 1686# \item Define as new roots \[ `roots[C]'\:= 1687# \bigcup_{1 \leq j \leq n} `set(Indirection(fusion,roots[i_j]))', \] 1688# \item as new powers \[ `powers[C]'\:= 1689# \bigcup_{1 \leq j \leq n} `set(Indirection(fusion,powers[i_j]))',\] 1690# \item as new upper bound \['upper[C]'\:= 1691# \min_{1 \leq j \leq n}('upper[i_j]'), \] 1692# try to improve the bound using the fact that for each j in 1693# `roots[C]' we have 1694# \['nonfaithful[j]'+'faithful[j]' \leq 1695# `nonfaithful[C]'+'faithful[C]',\] 1696# \item as new lower bound \['lower[C]'\:= 1697# \max_{1 \leq j \leq n}('lower[i_j]'),\] 1698# try to improve the bound using the fact that for each j in 1699# `powers[C]' we have 1700# \['nonfaithful[j]'+'faithful[j]' \geq 1701# `nonfaithful[C]'+'faithful[C]',\] 1702# \item as new divisors \['divs[C]'\:= 1703# `Lcm'( `divs'[i_1],\ldots, `divs'[i_n] ).\] 1704# \end{enumerate} 1705# \item Define some new structures\: 1706# \begin{enumerate} 1707# \item the moduls for the basechange \['moduls[C]'\:= 1708# \max_{1 \leq j \leq n}('tbl_centralizers[i_j]'),\] 1709# \item new classes \['classes[C]'\:= 1710# \sum_{1 \leq j \leq n} `tbl_classes[i_j]',\] 1711# \item \['nonfaithsum[C]'\:= \sum_{1 \leq j \leq n} `tbl_classes[i_j]' 1712# \cdot `nonfaithful[i_j]',\] 1713# \item a variable `rest', preset with $\|G\|$\: We know that 1714# $\sum_{g \in G} (1_U)^G(g) = \|G\|$. 1715# Let the values of $(1_U)^G$ be known for a subset 1716# $\tilde{G} \subseteq G$, and define 1717# $'rest'\:= \sum_{g \in \tilde{G}} (1_U)^G(g)$; 1718# then for $g \in G \setminus \tilde{G}$, we 1719# have $(1_U)^G(g) \leq `rest'/\|Cl_G(g)\|$. 1720# In our situation, this means 1721# \[\sum_{1 \leq j \leq n} \|Cl_G(g_j)\| \cdot (1_U)^G(g_j) 1722# \leq `rest',\] 1723# or equivalently 1724# $'nonfaithsum[C]' + `faithful[C]' \cdot `classes[C]' \leq `rest'$. 1725# (*Note* that `faithful' necessarily is constant on `C'.). 1726# So `rest' is used to update local upper bounds. 1727# \end{enumerate} 1728# \item (possible acceleration\: If we allow to collapse classes on which 1729# `nonfaithful' takes different values, the situation is a little 1730# more difficult. The new upper and lower bounds will be others, 1731# and the new divisors will become moduls in a congruence relation 1732# that has nothing to do with the values of torso or faithful.) 1733# \end{enumerate} 1734# 1735# *step 3*\: Eliminate classes for which the values of `faithful' are known 1736# 1737# The subroutine `erase' successively eliminates the columns of `matrix' 1738# listed up in `uniques'; at most one row remains with a nonzero entry `val' 1739# in that column `col', this is the gcd of the former column values. 1740# If we can eliminate `difference[ col ]', we proceed with the next column, 1741# else there is a contradiction (i.e. no generalized character exists that 1742# satisfies our conditions), and we set `impossible' true and then return 1743# all extracted rows which must be used at lower levels of a backtrack 1744# which may have called `erase'. 1745# Having erased all uniques without finding a contradiction, `erase' looks 1746# if other columns have become unique, i.e. the bounds and divisors allow 1747# just one value; those columns are erased, too. 1748# `erase' also updates the (local) upper and lower bounds using `roots', 1749# `powers' and `rest'. 1750# If no further elimination is possible, there can be two reasons\: 1751# If all columns are erased, `faithful' is complete, and if it is really a 1752# character, it will be appended to `possibilities'; then `impossible' is 1753# set true to indicate that this branch of the backtrack search tree has 1754# ended here. 1755# Otherwise `erase' looks for that column where the number of possible 1756# values is minimal, and puts a record with information about first 1757# possible value, step (of the arithmetic progression) and number of 1758# values into that column of `faithful'; 1759# the number of the column is written to `min\_class', 1760# `impossible' is set false, and the extracted rows are returned. 1761# 1762# And this way `erase' computes the lists of possible values\: 1763# 1764# Let $d\:= `divs[ i ]', z\:= `val', c\:= `difference[ i ]', 1765# n\:= `nonfaithful[ i ]', low\:= `local\_lower[ i ]', 1766# upp\:= `local\_upper[ i ]', g\:= \gcd\{d,z\} = ad + bz$. 1767# 1768# Then the set of allowed values is 1769# \[ M\:= \{x; low \leq x \leq upp; x \equiv -c \pmod{z}; 1770# x \equiv -n \pmod{d} \}.\] 1771# If $g$ does not divide $c-n$, we have a contradiction, else 1772# $y\:= -n -ad \frac{c-n}{g}$ defines the correct arithmetic progression\: 1773# \[ M = \{x;low \leq x \leq upp; x \equiv y \pmod{'Lcm'(d,z)} \} \] 1774# The minimum of $M$ is then given by 1775# \[ L\:= low + (( y - low ) \bmod `Lcm'(d,z)).\] 1776# 1777# (*Note* that for the usual case $d=1$ we have $a=1, b=0, y=-c$.) 1778# 1779# Therefore the number of values is 1780# $'Int( `( upp - L ) ` / Lcm'(d,z) ` )' +1$. 1781# 1782# In step 3, `erase' is called with the list of known values of `faithful' 1783# as `uniques'. 1784# Afterwards, if `InfoCharTable2 = Print' and a backtrack search is necessary, 1785# a message about the found improvements and the expected expense 1786# for the backtrack search is printed. 1787# (*Note* that we are allowed to forget the rows which we have extracted in 1788# this first elimination.) 1789# 1790# *step 4*\: Delete eliminated columns physically before the backtrack search 1791# 1792# The eliminated columns (those with `nonzerocol[i] = false') of `matrix' 1793# are deleted, and the other objects are adjusted\: 1794# \begin{enumerate} 1795# \item In `differences', `divs', `nonzerocol', `moduls', `classes', 1796# `nonfaithsum', `upper', `lower', the columns are simply deleted. 1797# \item For adjusting `fusion', first a permutation `fusionperm' is 1798# constructed that maps the eliminated columns behind the remaining 1799# columns; after `faithful\:= Indirection( faithful, fusionperm )' and 1800# `fusion\:= Indirection( fusionperm, fusion )', we have again 1801# \[ (1_U)^G = (1_{UN})^G + `Indirection( faithful, fusion )'. \] 1802# \item adjust `roots' and `powers'. 1803# \end{enumerate} 1804# 1805# *step 5*\: The backtrack search 1806# 1807# The subroutine `evaluate' is called with a column `unique'; this (and other 1808# uniques, if possible) is eliminated. If there was an inconsistence, the 1809# extracted rows are returned; otherwise the column `min\_class' subsequently 1810# will be set to all possible values and `evaluate' is called with 1811# `unique = min\_class'. 1812# After each return from `evaluate', the returned rows are appended to matrix 1813# again; if matrix becomes too long, a call of `ModGauss' will shrink it. 1814# Note that `erase' must be able to update the value of `rest', but any call 1815# of `evaluate' must not change `rest'; so `rest' is a parameter of 1816# `evaluate', but for `erase' it is global (realized as `[ rest ]'). 1817## 1818InstallGlobalFunction( PermCandidatesFaithful, 1819 function( tbl, chars, norm_subgrp, nonfaithful, upper, lower, torso, 1820 arg... ) 1821 local ratirr, 1822 tbl_classes, # attribute of `tbl' 1823 tbl_size, # attribute of `tbl' 1824 tbl_orders, # attribute of `tbl' 1825 tbl_centralizers, # attribute of `tbl' 1826 tbl_powermap, # attribute of `tbl' 1827 i, x, N, nccl, faithful, families, j, primes, orbits, factors, 1828 pparts, cyclics, divs, roots, powers, matrix, fusion, inverse, 1829 union, moduls, classes, nonfaithsum, rest, uniques, collfaithful, 1830 orig_nonfaithful, difference, nonzerocol, possibilities, 1831 ischaracter, erase, min_number, impossible, remain, 1832 ncha, pos, fusionperm, shrink, ppart, myset, newfaithful, 1833 min_class, evaluate, step, first, descendclass, oldrows, newmatrix, 1834 row; 1835 1836 chars:= List( chars, ValuesOfClassFunction ); 1837 if Length( arg ) = 1 and arg[1] = true then 1838 # The given list contains all rational irreducible characters. 1839 ratirr:= chars; 1840 else 1841 # The given list is not known to be complete. 1842 ratirr:= RationalizedMat( List( Irr( tbl ), ValuesOfClassFunction ) ); 1843 fi; 1844 1845 # 1846 # step 1: Try to improve the input data 1847 # 1848 lower:= ShallowCopy( lower ); 1849 upper:= ShallowCopy( upper ); 1850 torso:= ShallowCopy( torso ); 1851 1852 # order of normal subgroup 1853 tbl_classes:= SizesConjugacyClasses( tbl ); 1854 N := Sum( tbl_classes{ norm_subgrp } ); 1855 nccl:= Length( nonfaithful ); 1856 1857 tbl_size:= Size( tbl ); 1858 if not IsBound( torso[1] ) or not IsPosInt( torso[1] ) then 1859 Error( "degree must be positive integer" ); 1860 elif tbl_size mod torso[1] <> 0 or torso[1] mod nonfaithful[1] <> 0 1861 or torso[1] = 1 then 1862 return []; 1863 fi; 1864 tbl_orders:= OrdersClassRepresentatives( tbl ); 1865 for i in [ 1 .. nccl ] do 1866 if ( tbl_size / torso[1] ) mod tbl_orders[i] <> 0 1867 or nonfaithful[i] = 0 then 1868 if IsBound( torso[i] ) and IsInt( torso[i] ) and torso[i] <> 0 then 1869 return []; 1870 fi; 1871 torso[i]:= 0; 1872 fi; 1873 od; 1874 faithful:= []; 1875 for i in [ 1 .. Length( torso ) ] do 1876 if IsBound( torso[i] ) and IsInt( torso[i] ) then 1877 faithful[i]:= torso[i] - nonfaithful[i]; 1878 fi; 1879 od; 1880 # compute a list of Galois families for `tbl': 1881 families:= []; 1882 for i in [ 1 .. nccl ] do 1883 if not IsBound( families[i] ) then 1884 families[i]:= ClassOrbit( tbl, i ); 1885 for j in families[i] do 1886 families[j]:= families[i]; 1887 od; 1888 fi; 1889 od; 1890 # `primes': prime divisors of $|U|$ for which there is only one $G$-family 1891 # of that element order in $UN$: 1892 factors:= Factors(Integers, tbl_size / torso[1] ); 1893 primes:= Set( factors ); 1894 orbits:= List( primes, p -> [] ); 1895 for i in [ 1 .. nccl ] do 1896 if tbl_orders[i] in primes and nonfaithful[i] <> 0 then 1897 AddSet( orbits[ Position( primes, tbl_orders[i] ) ], families[i] ); 1898 fi; 1899 od; 1900 for i in [ 1 .. Length( primes ) ] do 1901 if Length( orbits[i] ) <> 1 then 1902 Unbind( primes[i] ); 1903 fi; 1904 od; 1905 primes:= Compacted( primes ); 1906 1907 # which Sylow subgroups of $UN$ are contained in $U$: 1908 1909 pparts:= []; 1910 for i in Set( factors ) do 1911 if ( torso[1] / nonfaithful[1] ) mod i <> 0 then 1912 # i is a prime divisor of $\|U\|$ not dividing 1913 # $|UN|/|U| = `torso[1] / nonfaithful[1]'$: 1914 ppart:= 1; 1915 for j in factors do 1916 if j = i then ppart:= ppart * i; fi; 1917 od; 1918 Add( pparts, ppart ); 1919 fi; 1920 od; 1921 cyclics:= []; # cyclic Sylow subgroups 1922 for i in [ 1 .. nccl ] do 1923 if tbl_orders[i] in pparts and nonfaithful[i] <> 0 then 1924 Add( cyclics, i ); 1925 fi; 1926 od; 1927 # transfer bounds: 1928 if lower = 0 then 1929 lower:= ListWithIdenticalEntries( nccl, 0 ); 1930 lower[1]:= torso[1]; 1931 fi; 1932 if upper = 0 then 1933 upper:= ListWithIdenticalEntries( nccl, torso[1] ); 1934 fi; 1935 upper[1]:= upper[1] - nonfaithful[1]; 1936 lower[1]:= lower[1] - nonfaithful[1]; 1937 tbl_centralizers:= SizesCentralizers( tbl ); 1938 for i in [ 2 .. nccl ] do 1939 if nonfaithful[i] <> 0 and 1940 ( tbl_orders[i] in primes 1941 or 0 in List( pparts, x -> x mod tbl_orders[i] ) ) then 1942 lower[i]:= Maximum( lower[i], 1 ) - nonfaithful[i]; 1943 else 1944 lower[i]:= Maximum( lower[i], 0 ) - nonfaithful[i]; 1945 fi; 1946 if i in norm_subgrp then 1947 upper[i]:= Minimum( upper[i], torso[1], tbl_centralizers[i] - 1, 1948 Int( ( N * nonfaithful[1] - torso[1] ) / tbl_classes[i] ), 1949 Int( torso[1] * nonfaithful[i] / nonfaithful[1] ) ) 1950 - nonfaithful[i]; 1951 else 1952 upper[i]:= Minimum( upper[i], torso[1], tbl_centralizers[i] - 1, 1953 Int( torso[1] * nonfaithful[i] / nonfaithful[1] ) ) 1954 - nonfaithful[i]; 1955 fi; 1956 od; 1957 for i in [ 1 .. nccl ] do 1958 if IsBound( faithful[i] ) then 1959 if faithful[i] >= lower[i] then 1960 lower[i]:= faithful[i]; 1961 else 1962 return []; 1963 fi; 1964 if faithful[i] <= upper[i] then 1965 upper[i]:= faithful[i]; 1966 else 1967 return []; 1968 fi; 1969 elif lower[i] = upper[i] then 1970 faithful[i]:= lower[i]; 1971 fi; 1972 od; 1973 # compute divs: 1974 divs:= [ torso[1] ]; 1975 for i in [ 2 .. nccl ] do 1976 divs[i]:= torso[1] / GcdInt( torso[1], 1977 tbl_classes[i] * Length( families[i] ) 1978 / Phi( tbl_orders[i] ) ); 1979 if i in cyclics then 1980 divs[i]:= Lcm( divs[i], nonfaithful[i] ); 1981 fi; 1982 od; 1983 # compute roots and powers: 1984 roots:= []; 1985 powers:= []; 1986 for i in [ 1 .. Length( nonfaithful ) ] do 1987 roots[i]:= []; 1988 powers[i]:= []; 1989 od; 1990 tbl_powermap:= ComputedPowerMaps( tbl ); 1991 for i in [ 2 .. Length( tbl_powermap ) ] do 1992 if IsBound( tbl_powermap[i] ) then 1993 for j in [ 1 .. Length( nonfaithful ) ] do 1994 if IsInt( tbl_powermap[i][j] ) then 1995 AddSet( powers[j], tbl_powermap[i][j] ); 1996 AddSet( roots[ tbl_powermap[i][j] ], j ); 1997 fi; 1998 od; 1999 fi; 2000 od; 2001 # matrix of constituents: 2002 matrix:= []; # delete impossibles 2003 for i in chars do 2004 if i[1] <= faithful[1] 2005 and Difference( norm_subgrp, ClassPositionsOfKernel( i ) ) <> [] then 2006 j:= 1; 2007 while j <= Length( i ) 2008 and i[j] >= i[1] - faithful[1] - nonfaithful[j] do 2009 j:= j + 1; 2010 od; 2011 if j > Length( i ) then Add( matrix, i ); fi; 2012 fi; 2013 od; 2014 if IsEmpty( matrix ) then 2015 return []; 2016 fi; 2017 2018 Info( InfoCharacterTable, 2, 2019 "PermCandidatesFaithful: There are ", 2020 Length( matrix ), " possible constituents,\n", 2021 "#I the number of unknown values is ", 2022 Number( [ 1 .. nccl ], 2023 x -> not IsBound( faithful[x] ) ), 2024 ";\n", 2025 "#I now trying to collapse the matrix" ); 2026 2027 # 2028 # step 2: Collapse classes which are equal for all possible constituents 2029 # 2030 matrix:= CollapsedMat( matrix, [ nonfaithful ] ); 2031 fusion:= matrix.fusion; 2032 matrix:= matrix.mat; 2033 inverse:= []; 2034 for i in [ 1 .. Length( fusion ) ] do 2035 if IsBound( inverse[ fusion[i] ] ) then 2036 Add( inverse[ fusion[i] ], i ); 2037 else 2038 inverse[ fusion[i] ]:= [ i ]; 2039 fi; 2040 od; 2041 # 2042 myset:= function( obj ) 2043 if IsInt( obj ) then return [ obj ]; else return obj; fi; end; 2044 # 2045 lower:= List( inverse, x -> Maximum( lower{ x } ) ); 2046 upper:= List( inverse, x -> Minimum( upper{ x } ) ); 2047 divs:= List( inverse, x -> Lcm( divs{ x } ) ); 2048 moduls:= List( inverse, x -> Maximum( tbl_centralizers{ x } ) ); 2049 roots:= List( CompositionMaps( CompositionMaps( fusion, roots ), 2050 inverse ), myset ); 2051 powers:= List( CompositionMaps( CompositionMaps( fusion, powers ), 2052 inverse ), myset ); 2053 classes:= ListWithIdenticalEntries( Length( moduls ), 0 ); 2054 for i in [ 1 .. Length( inverse ) ] do 2055 for j in inverse[i] do 2056 classes[i]:= classes[i] + tbl_classes[j]; 2057 od; 2058 od; 2059 nonfaithsum:= ListWithIdenticalEntries( Length( moduls ), 0 ); 2060 for i in [ 1 .. Length( inverse ) ] do 2061 for j in inverse[i] do 2062 nonfaithsum[i]:= nonfaithsum[i] + tbl_classes[j] * nonfaithful[j]; 2063 od; 2064 od; 2065 rest:= tbl_size; 2066 nccl:= Length( moduls ); 2067 uniques:= []; 2068 collfaithful:= []; 2069 for i in [ 1 .. Length( fusion ) ] do 2070 if IsBound( faithful[i] ) then 2071 if IsBound( collfaithful[ fusion[i] ] ) then 2072 if collfaithful[ fusion[i] ] <> faithful[i] then return []; fi; 2073 else 2074 collfaithful[ fusion[i] ]:= faithful[i]; 2075 Add( uniques, fusion[i] ); 2076 rest:= rest - classes[fusion[i]] * ( faithful[i] + nonfaithful[i] ); 2077 if rest < 0 then return []; fi; 2078 fi; 2079 fi; 2080 od; 2081 faithful:= collfaithful; 2082 orig_nonfaithful:= ShallowCopy( nonfaithful ); 2083 nonfaithful:= CompositionMaps( nonfaithful, inverse ); 2084 # improvement of bounds by use of roots and powers 2085 for i in [ 1 .. nccl ] do 2086 if IsBound( faithful[i] ) then 2087 for j in roots[i] do 2088 upper[j]:= Minimum( upper[j], 2089 nonfaithful[i] + faithful[i] - nonfaithful[j] ); 2090 od; 2091 for j in powers[i] do 2092 lower[j]:= Maximum( lower[j], 2093 nonfaithful[i] + faithful[i] - nonfaithful[j] ); 2094 od; 2095 fi; 2096 od; 2097 2098 Info( InfoCharacterTable, 2, 2099 "PermCandidatesFaithful: There are ", nccl, 2100 " families of classes left,\n", 2101 "#I the number of unknown values is ", 2102 nccl - Length( uniques ), ",\n", 2103 "#I the numbers of possible values for each class are", 2104 " approximately\n", 2105 "#I ", 2106 List( [ 1 .. nccl ], 2107 x -> Int( ( upper[x] - lower[x] ) / divs[x] )+1), 2108 ";\n#I now eliminating known classes" ); 2109 2110 # 2111 # step 3: Eliminate classes for which the values of `faithful' are known 2112 # 2113 difference:= ListWithIdenticalEntries( Length( moduls ), 0 ); 2114 nonzerocol:= ListWithIdenticalEntries( Length( moduls ), true ); 2115 possibilities:= []; # global list of permutation character candidates 2116 # 2117 # a little function: 2118 # 2119 ischaracter:= function( gencharacter ) 2120 local cand; 2121 cand:= List( [ 1 .. Length( gencharacter ) ], 2122 i -> gencharacter[i] * tbl_classes[i] ); 2123 return ForAll( ratirr, chi -> 0 <= cand * chi ); 2124 end; 2125 # 2126 # and a bigger function: 2127 # 2128 erase:= function( uniques, nonzerocol, difference, rest, locupp, loclow ) 2129 # eliminate all unique columns, adapt nonzerocol; 2130 # then look if other columns become unique or if a contradiction occurs; 2131 # also look at which column the least number of values is left 2132 local i, j, extracted, col, row, quot, val, ggt, a, b, k, u, anzahl, elm, 2133 firstallowed, step, gencharacter, remain, update, newupdate, 2134 c, upp, low, g, st, y, L, number; 2135 extracted:= []; 2136 while uniques <> [] do 2137 for col in uniques do 2138 if col < 0 then # col is zerocol, known from val = moduls[i] 2139 col:= -col; 2140 difference[ col ]:= ( difference[ col ] + faithful[ col ] ) 2141 mod moduls[ col ]; 2142 if difference[ col ] <> 0 then 2143 impossible:= true; 2144 return extracted; 2145 fi; 2146 else 2147 difference[ col ]:= 2148 ( difference[ col ] + faithful[ col ] ) 2149 mod moduls[ col ]; 2150 row:= StepModGauss( matrix, moduls, nonzerocol, col ); 2151 if row = fail then 2152 if difference[ col ] <> 0 then 2153 impossible:= true; 2154 return extracted; 2155 fi; 2156 else 2157 # delete zero rows: 2158 shrink:= []; 2159 for i in matrix do 2160 if PositionNonZero( i ) <= Length( i ) then 2161#T better call IsZero? 2162 Add( shrink, i ); 2163 fi; 2164 od; 2165 matrix:= shrink; 2166 # 2167 Add( extracted, row ); 2168 if difference[col] mod row[col] <> 0 then 2169 impossible:= true; 2170 return extracted; 2171 fi; 2172 quot:= difference[col] / row[col]; 2173 for j in [ 1 .. nccl ] do 2174 if nonzerocol[j] then 2175 difference[j]:= ( difference[j] - quot * row[j] ) 2176 mod moduls[j]; 2177 fi; 2178 od; 2179 fi; 2180 fi; 2181 nonzerocol[col]:= false; 2182 locupp[ col ]:= faithful[ col ]; 2183 loclow[ col ]:= faithful[ col ]; 2184 # update:= [ col ]; 2185 # while update <> [] do 2186 # newupdate:= []; 2187 # for k in update do 2188 # for elm in roots[k] do 2189 # if nonzerocol[ elm ] then 2190 # if locupp[ elm ] > 2191 # locupp[k] + nonfaithful[k] - nonfaithful[ elm ] then 2192 # AddSet( newupdate, elm ); 2193 # locupp[ elm ]:= locupp[k] + nonfaithful[k] 2194 # - nonfaithful[ elm ]; 2195 # fi; 2196 # fi; 2197 # od; 2198 # od; 2199 # update:= newupdate; 2200 # od; 2201 # update:= [ col ]; 2202 # while update <> [] do 2203 # newupdate:= []; 2204 # for k in update do 2205 # for elm in powers[k] do 2206 # if nonzerocol[ elm ] then 2207 # if loclow[ elm ] < loclow[k] 2208 # + nonfaithful[k] - nonfaithful[ elm ] then 2209 # AddSet( newupdate, elm ); 2210 # loclow[ elm ]:= loclow[k] + nonfaithful[k] 2211 # - nonfaithful[ elm ]; 2212 # fi; 2213 # fi; 2214 # od; 2215 # od; 2216 # update:= newupdate; 2217 # od; 2218 od; 2219 # now all yet known uniques have been erased, try to find new ones 2220 min_number:= infinity; 2221 uniques:= []; 2222 for i in [ 1 .. nccl ] do 2223 if nonzerocol[i] then 2224 val:= moduls[i]; 2225 for j in matrix do val:= GcdInt( val, j[i] ); od; 2226 # zerocol iff val = moduls[i] 2227 c:= difference[i] mod val; # now >= 0 2228 upp:= Minimum( locupp[i], ( rest[1] - nonfaithsum[i] )/classes[i] ); 2229 low:= loclow[i]; 2230 g:= Gcdex( divs[i], val ); 2231 a:= g.coeff1; 2232 b:= g.coeff2; 2233 g:= g.gcd; 2234 if ( c - nonfaithful[i] ) mod g <> 0 then 2235 impossible:= true; 2236 return extracted; 2237 fi; 2238 st:= divs[i] * val / g; 2239 y:= - nonfaithful[i] - ( a * divs[i] * ( c - nonfaithful[i] ) ) / g; 2240 L:= low + ( ( y - low ) mod st); 2241 if upp < L then 2242 impossible:= true; 2243 return extracted; 2244 else 2245 number:= Int( ( upp - L ) / st ) + 1; 2246 if number = 1 then # unique 2247 faithful[i]:= L; 2248 if val = moduls[i] then 2249 Add( uniques, -i ); # no StepModGauss necessary 2250 else 2251 Add( uniques, i ); 2252 fi; 2253 rest[1]:= rest[1] - classes[i] * faithful[i] - nonfaithsum[i]; 2254 elif number < min_number then 2255 min_number:= number; 2256 step:= st; 2257 firstallowed:= L; 2258 min_class:= i; 2259 fi; 2260 fi; 2261 fi; 2262 od; 2263 od; 2264 if min_number = infinity then 2265 if rest[1] = 0 then 2266 gencharacter:= faithful{ fusion } + orig_nonfaithful; 2267 if ischaracter( gencharacter ) and TestPerm1( tbl, gencharacter ) = 0 2268 and TestPerm2( tbl, gencharacter ) = 0 then 2269 Add( possibilities, gencharacter ); 2270 fi; 2271 fi; 2272 impossible:= true; 2273 else 2274 faithful[ min_class ]:= rec( firstallowed:= firstallowed, # first value 2275 step:= step, # step 2276 number:= min_number ); 2277 impossible:= false; 2278 fi; 2279 return extracted; 2280 # impossible = true: calling function will return from backtrack 2281 # impossible = false: then min_class < infinity, and faithful[ min_class ] 2282 # contains the information for descending at min_class 2283 end; 2284 2285 # 2286 rest:= [ rest ]; 2287 erase( uniques, nonzerocol, difference, rest, upper, lower ); 2288 rest:= rest[1]; 2289 if impossible then 2290 return List( possibilities, vals -> Character( tbl, vals ) ); 2291 fi; 2292 2293 Info( InfoCharacterTable, 2, 2294 "PermCandidatesFaithful: A backtrack search", 2295 " will be needed;\n", 2296 "#I now physically deleting known classes" ); 2297 2298 # 2299 # step 4: Delete eliminated columns physically before the backtrack search 2300 # 2301 remain:= Filtered( [ 1 .. nccl ], x -> nonzerocol[x] ); 2302 for i in [ 1 .. Length( matrix ) ] do 2303 matrix[i]:= matrix[i]{ remain }; 2304 od; 2305 difference:= difference{ remain }; 2306 divs:= divs{ remain }; 2307 nonzerocol:= nonzerocol{ remain }; 2308 moduls:= moduls{ remain }; 2309 classes:= classes{ remain }; 2310 nonfaithsum:= nonfaithsum{ remain }; 2311 nonfaithful:= nonfaithful{ remain }; 2312 upper:= upper{ remain }; 2313 lower:= lower{ remain }; 2314 matrix:= ModGauss( matrix, moduls ); 2315 ncha:= Length( matrix ); 2316 pos:= 1; 2317 fusionperm:= []; 2318 for i in [ 1 .. nccl ] do 2319 if i in remain then 2320 fusionperm[i]:= pos; 2321 pos:= pos + 1; 2322 fi; 2323 od; 2324 for i in Difference( [ 1 .. nccl ], remain ) do 2325 fusionperm[i]:= pos; 2326 pos:= pos + 1; 2327 od; 2328 min_class:= fusionperm[ min_class ]; 2329 newfaithful:= []; 2330 for i in [ 1 .. Length( faithful ) ] do 2331 if IsBound( faithful[i] ) then 2332 newfaithful[ fusionperm[i] ]:= faithful[i]; 2333 fi; 2334 od; 2335 faithful:= newfaithful; 2336 fusion:= CompositionMaps( fusionperm, fusion ); 2337 for i in remain do 2338 roots[ fusionperm[i] ]:= CompositionMaps( fusionperm, 2339 Intersection( roots[i], remain ) ); 2340 powers[ fusionperm[i] ]:= CompositionMaps( fusionperm, 2341 Intersection( powers[i], remain ) ); 2342 od; 2343 nccl:= Length( nonzerocol ); 2344 2345 Info( InfoCharacterTable, 2, 2346 "PermCandidatesFaithful:", 2347 " The number of unknown values is ", nccl, ";\n", 2348 "#I the numbers of possible values for each class are", 2349 " approximately\n#I ", 2350 List( [ 1 .. nccl ], 2351 x -> Int( ( upper[x] - lower[x] ) / divs[x]+1)), 2352 "\n#I now beginning the backtrack search" ); 2353 2354 # 2355 # step 5: The backtrack search 2356 # 2357 evaluate:= 2358 function(difference,rest,nonzerocol,unique,local_upper,local_lower) 2359 local i, j, col, val, row, quot, extracted, step, first, descendclass; 2360 rest:= [ rest ]; 2361 extracted:= erase( [ unique ], nonzerocol, difference, rest, local_upper, 2362 local_lower ); 2363 rest:= rest[1]; 2364 if impossible then 2365 return extracted; 2366 fi; 2367 descendclass:= min_class; 2368 step:= faithful[ descendclass ].step; 2369 first:= faithful[ descendclass ].firstallowed; 2370 rest:= rest + ( step - first ) * classes[ descendclass ] 2371 - nonfaithsum[ descendclass ]; 2372 for i in [ 1 .. min_number ] do 2373 faithful[ descendclass ]:= first + (i-1) * step; 2374 rest:= rest - step * classes[ descendclass ]; 2375 oldrows:= evaluate( ShallowCopy(difference), rest, 2376 ShallowCopy( nonzerocol ), 2377 descendclass, 2378 ShallowCopy( local_upper ), 2379 ShallowCopy( local_lower ) ); 2380 Append( matrix, oldrows ); 2381 if Length( matrix ) > ( 3 * ncha ) / 2 then 2382 newmatrix:= []; 2383 for j in [ 1 .. Length( matrix[1] ) ] do 2384 if nonzerocol[j] then 2385 row:= StepModGauss( matrix, moduls, nonzerocol, j ); 2386 if row <> fail then Add( newmatrix, row ); fi; 2387 fi; 2388 od; 2389 matrix:= newmatrix; 2390 fi; 2391 od; 2392 return extracted; 2393 end; 2394 2395 # 2396 2397 step:= faithful[min_class].step; 2398 first:= faithful[min_class].firstallowed; 2399 descendclass:= min_class; 2400 rest:= rest + ( step - first ) * classes[ descendclass ] 2401 - nonfaithsum[ descendclass ]; 2402 for i in [ 1 .. min_number ] do 2403 faithful[ descendclass ]:= first + (i-1) * step; 2404 rest:= rest - step * classes[ descendclass ]; 2405 oldrows:= evaluate( ShallowCopy(difference), rest, 2406 ShallowCopy( nonzerocol ), 2407 descendclass, 2408 ShallowCopy( upper ), 2409 ShallowCopy( lower ) ); 2410 Append( matrix, oldrows ); 2411 if Length( matrix ) > ( 3 * ncha ) / 2 then 2412 newmatrix:= []; 2413 for j in [ 1 .. Length( matrix[1] ) ] do 2414 if nonzerocol[j] then 2415 row:= StepModGauss( matrix, moduls, nonzerocol, j ); 2416 if row <> fail then 2417 Add( newmatrix, row ); 2418 fi; 2419 fi; 2420 od; 2421 matrix:= newmatrix; 2422 fi; 2423 od; 2424 2425 # Create class function objects from the candidates, 2426 # nad return the result list. 2427 return List( possibilities, vals -> Character( tbl, vals ) ); 2428end ); 2429 2430 2431############################################################################# 2432## 2433#F PermChars( <tbl> ) 2434#F PermChars( <tbl>, <degree> ) 2435#F PermChars( <tbl>, <arec> ) 2436## 2437InstallGlobalFunction( PermChars, function( arg ) 2438 2439 local tbl, arec, names, chars, upper, lower; 2440 2441 if Length(arg) = 1 then 2442 tbl:= arg[1]; 2443 arec:= rec(); 2444 elif Length(arg) = 2 then 2445 tbl:= arg[1]; 2446 if IsRecord( arg[2] ) then 2447 arec:= arg[2]; 2448 else 2449 arec:= rec(degree:= arg[2]); 2450 fi; 2451 else 2452 2453 Error( "usage: PermChars(<tbl>), PermChars(<tbl>, <degree>) or\n", 2454 " PermChars(<tbl>, <arec>)" ); 2455 2456 fi; 2457 2458 names:= RecNames( arec ); 2459 2460 if "degree" in names and IsInt( arec.degree ) then 2461 2462 # Use the improved combinatorial approach. 2463 return PermComb( tbl, arec ); 2464 2465 elif IsSubset( names, [ "normalsubgroup", "nonfaithful", "torso" ] ) then 2466 2467 # Search for faithful candidates only, using Gaussian elimination. 2468 if "chars" in names then 2469 chars:= arec.chars; 2470 else 2471 chars:= RationalizedMat( List( Irr( tbl ), ValuesOfClassFunction ) ); 2472 fi; 2473 if IsBound( arec.upper ) then 2474 upper:= arec.upper; 2475 else 2476 upper:= 0; 2477 fi; 2478 if IsBound( arec.lower ) then 2479 lower:= arec.lower; 2480 else 2481 lower:= 0; 2482 fi; 2483 return PermCandidatesFaithful( tbl, chars, arec.normalsubgroup, 2484 arec.nonfaithful, upper, lower, arec.torso, 2485 not "chars" in names ); 2486 2487 elif "torso" in names then 2488 2489 # Use Gaussian elimination. 2490 if "chars" in names then 2491 chars:= arec.chars; 2492 else 2493 chars:= RationalizedMat( List( Irr( tbl ), ValuesOfClassFunction ) ); 2494 fi; 2495 return PermCandidates( tbl, chars, arec.torso, false ); 2496 2497 else 2498 2499 # Solve the system of inequalities. 2500 return Permut( tbl, arec ); 2501 2502 fi; 2503end ); 2504 2505 2506############################################################################# 2507## 2508#F PermCharInfo( <tbl>, <permchars>[, \"LaTeX\" ] ) 2509#F PermCharInfo( <tbl>, <permchars>[, \"HTML\" ] ) 2510## 2511InstallGlobalFunction( PermCharInfo, function( arg ) 2512 local tbl, # character table, first argument 2513 permchars, # list of characters, second argument 2514 supopen, # opening tag for exponentiation 2515 supclose, # closing tag for exponentiation 2516 tbl_centralizers, # attribute of `tbl' 2517 tbl_size, # attribute of `tbl' 2518 tbl_irreducibles, # attribute of `tbl' 2519 tbl_classes, # attribute of `tbl' 2520 i, j, k, order, cont, bound, alp, degreeset, irreds, chi, 2521 ATLAS, ATL, error, scprs, cont1, bound1, char, chars; 2522 2523 if 1 < Length( arg ) and Length( arg ) < 4 2524 and IsNearlyCharacterTable( arg[1] ) 2525 and IsList( arg[2] ) then 2526 tbl:= arg[1]; 2527 permchars:= arg[2]; 2528 if IsBound( arg[3] ) and arg[3] = "HTML" then 2529 supopen := "<sup>"; 2530 supclose := "</sup>"; 2531 else 2532 supopen := "^{"; 2533 supclose := "}"; 2534 fi; 2535 else 2536 Error( "usage: PermCharInfo( <tbl>, <permchars>[, \"HTML\"] )" ); 2537 fi; 2538 2539 cont := []; 2540 bound := []; 2541 ATL := []; 2542 chars := []; 2543 2544 tbl_centralizers:= SizesCentralizers( tbl ); 2545 tbl_size:= Size( tbl ); 2546 2547 if not IsEmpty( permchars ) and not IsList( permchars[1] ) then 2548 permchars:= [ permchars ]; 2549 fi; 2550 permchars:= List( permchars, ValuesOfClassFunction ); 2551 2552 for char in permchars do 2553 cont1 := []; 2554 bound1 := []; 2555 order := tbl_size / char[1]; 2556 for i in [ 1 .. Length( char ) ] do 2557 cont1[i] := char[i] * order / tbl_centralizers[i]; 2558 bound1[i] := order / GcdInt( order, tbl_centralizers[i] ); 2559 od; 2560 Add( cont, cont1 ); 2561 Add( bound, bound1 ); 2562 Append( chars, [ char, cont1, bound1 ] ); 2563 od; 2564 2565 if HasIrr( tbl ) then 2566 2567 tbl_irreducibles:= Irr( tbl ); 2568 2569 # compute the `ATLAS' component 2570 alp:= [ "a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", 2571 "l", "m", "n", "o", "p", "q", "r", "s", "t", "u", "v", 2572 "w", "x", "y", "z" ]; 2573 degreeset:= Set( List( tbl_irreducibles, DegreeOfCharacter ) ); 2574 2575 # `irreds[i]' contains all irreducibles of the `i'--th degree 2576 irreds:= List( degreeset, x -> [] ); 2577 for chi in tbl_irreducibles do 2578 Add( irreds[ Position( degreeset, chi[1] ) ], 2579 ValuesOfClassFunction( chi ) ); 2580 od; 2581 2582 # extend the alphabet if necessary 2583 while Length( alp ) < Maximum( List( irreds, Length ) ) do 2584 alp:= Concatenation( alp, 2585 List( alp, x -> Concatenation( "(", x, "')" ) ) ); 2586 od; 2587 2588 ATLAS:= []; 2589 for char in permchars do 2590 2591 ATL:= ""; 2592 error:= false; 2593 for i in irreds do 2594 scprs:= List( i, x -> ScalarProduct( tbl, char, x ) ); 2595 if ForAny( scprs, x -> x < 0 ) then 2596 scprs:= Filtered( [ 1 .. Length( scprs ) ], x -> scprs[x] < 0 ); 2597 scprs:= List( scprs, x -> Position( tbl_irreducibles, i[x] ) ); 2598 Print( "#E PermCharInfo: negative scalar product(s) with X", 2599 scprs, "\n" ); 2600 error:= true; 2601 elif ForAny( scprs, x -> x > 0 ) then 2602 if ATL <> "" then 2603 ATL:= Concatenation( ATL, "+" ); 2604 fi; 2605 ATL:= Concatenation( ATL, String( i[1][1] ) ); 2606 for j in [ 1 .. Length( scprs ) ] do 2607 if scprs[j] = 1 then 2608 ATL:= Concatenation( ATL, alp[j] ); 2609 elif scprs[j] = 2 then 2610 ATL:= Concatenation( ATL, alp[j], alp[j] ); 2611 elif scprs[j] = 3 then 2612 ATL:= Concatenation( ATL, alp[j], alp[j], alp[j] ); 2613 elif scprs[j] > 3 then 2614 ATL:= Concatenation( ATL, alp[j], supopen, 2615 String( scprs[j] ), supclose ); 2616 fi; 2617 od; 2618 fi; 2619 od; 2620 if error then ATL:= "Error"; fi; 2621 ConvertToStringRep( ATL ); 2622 Add( ATLAS, ATL ); 2623 od; 2624 else 2625 ATLAS:= "error, no irreducibles bound"; 2626 fi; 2627 2628 tbl_classes:= SizesConjugacyClasses( tbl ); 2629 2630 return rec( contained:= cont, bound:= bound, 2631 display:= rec( classes:= Filtered([1..Length(tbl_classes)], 2632 x -> ForAny( permchars, y -> y[x]<>0 ) ), 2633 chars:= chars, 2634 letter:= "I" ), 2635 ATLAS:= ATLAS ); 2636end ); 2637 2638 2639############################################################################# 2640## 2641#F PermCharInfoRelative( <tbl>, <tbl2>, <permchars> ) 2642## 2643InstallGlobalFunction( PermCharInfoRelative, function( tbl, tbl2, permchars ) 2644 local tblfustbl2, # fusion of `tbl' in `tbl2' 2645 size2, # order of `tbl2' 2646 cont, 2647 bound, 2648 ATL, 2649 chars, 2650 centralizers2, # centralizer orders of `tbl2' 2651 char, # loop over `permchars' 2652 cont1, 2653 bound1, 2654 order, # order of the subgroup $U$ 2655 i, # loop variable 2656 irr, 2657 irr2, 2658 nccl2, 2659 alp, 2660 degreeset, 2661 irreds, 2662 chi, 2663 irreds2, 2664 irrnam2, 2665 rest, 2666 j, 2667 chi2, 2668 k, 2669 pos, 2670 ATLAS, 2671 error, 2672 scprs, 2673 ATL1, 2674 nam, 2675 mult; 2676 2677 tblfustbl2:= GetFusionMap( tbl, tbl2 ); 2678 size2:= Size( tbl2 ); 2679 if tblfustbl2 = fail or size2 <> 2 * Size( tbl ) then 2680 Error( "<tbl> must be of index 2 in <tbl2>, with stored fusion" ); 2681 fi; 2682 2683 cont := []; 2684 bound := []; 2685 ATL := []; 2686 chars := []; 2687 2688 centralizers2:= SizesCentralizers( tbl2 ); 2689 2690 if not IsEmpty( permchars ) and not IsList( permchars[1] ) then 2691 permchars:= [ permchars ]; 2692 fi; 2693 permchars:= List( permchars, ValuesOfClassFunction ); 2694 2695 # Compute the info about the number of elements in the subgroup etc. 2696 for char in permchars do 2697 cont1 := []; 2698 bound1 := []; 2699 order := size2 / char[1]; 2700 for i in [ 1 .. Length( char ) ] do 2701 cont1[i] := char[i] * order / centralizers2[i]; 2702 bound1[i] := order / GcdInt( order, centralizers2[i] ); 2703 od; 2704 Add( cont, cont1 ); 2705 Add( bound, bound1 ); 2706 Append( chars, [ char, cont1, bound1 ] ); 2707 od; 2708 2709 # The remaining code deals with the `ATLAS' component. 2710 if HasIrr( tbl ) and HasIrr( tbl2 ) then 2711 2712 irr := Irr( tbl ); 2713 irr2 := Irr( tbl2 ); 2714 nccl2:= Length( irr2 ); 2715 2716 alp:= [ "a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", 2717 "l", "m", "n", "o", "p", "q", "r", "s", "t", "u", "v", 2718 "w", "x", "y", "z" ]; 2719 2720 # `irreds[i]' contains all irreducibles of `tbl' of the `i'--th degree. 2721 degreeset:= Set( List( irr, x -> x[1] ) ); 2722 irreds:= List( degreeset, x -> [] ); 2723 for chi in irr do 2724 Add( irreds[ Position( degreeset, chi[1] ) ], 2725 ValuesOfClassFunction( chi ) ); 2726 od; 2727 2728 # Extend the alphabet if necessary. 2729 while Length( alp ) < Maximum( List( irreds, Length ) ) do 2730 Append( alp, 2731 List( alp, x -> Concatenation( "(", x, "')" ) ) ); 2732 od; 2733 2734 # Construct relative names for the irreducibles of `tbl2'. 2735 irreds2:= []; 2736 irrnam2:= []; 2737 rest:= List( irr2, x -> x{ tblfustbl2 } ); 2738 for i in [ 1 .. Length( irreds ) ] do 2739 2740 irreds2[i]:= []; 2741 irrnam2[i]:= []; 2742 2743 for j in [ 1 .. Length( irreds[i] ) ] do 2744 2745 chi2:= []; 2746 for k in [ 1 .. nccl2 ] do 2747 if rest[k] = irreds[i][j] then 2748 Add( chi2, irr2[k] ); 2749 fi; 2750 od; 2751 if Length( chi2 ) = 2 then 2752 2753 # The `j'-th character of the `i'-th degree of `tbl' extends. 2754 Append( irreds2[i], chi2 ); 2755 Add( irrnam2[i], Concatenation( alp[j], "^+" ) ); 2756 Add( irrnam2[i], Concatenation( alp[j], "^-" ) ); 2757 2758 else 2759 2760 # The `j'-th character of the `i'-th degree of `tbl' fuses 2761 # with another character of `tbl', of the same degree. 2762 for k in [ 1 .. nccl2 ] do 2763 if rest[k][1] = 2 * irreds[i][j][1] 2764 and ScalarProduct( tbl, rest[k], irreds[i][j] ) <> 0 then 2765 pos:= Position( irreds2[i], irr2[k] ); 2766 if pos = fail then 2767 Add( irreds2[i], irr2[k] ); 2768 Add( irrnam2[i], ShallowCopy( alp[j] ) ); 2769 else 2770 Append( irrnam2[i][ pos ], alp[j] ); 2771 fi; 2772 fi; 2773 od; 2774 2775 fi; 2776 2777 od; 2778 2779 od; 2780 2781 ATLAS:= []; 2782 for char in permchars do 2783 2784 ATL:= ""; 2785 error:= false; 2786 for i in [ 1 .. Length( degreeset ) ] do 2787 2788 scprs:= List( irreds2[i], x -> ScalarProduct( tbl2, char, x ) ); 2789 2790 if ForAny( scprs, x -> x < 0 ) then 2791 2792 # The decomposition into irreducibles has negative coefficients. 2793 Info( InfoCharacterTable, 1, 2794 "PermCharInfoRelative: negative scalar product(s) with X", 2795 List( Filtered( [ 1 .. Length( scprs ) ], 2796 x -> scprs[x] < 0 ), 2797 y -> Position( irr2, irreds2[i][y] ) ) ); 2798 error:= true; 2799 2800 elif ForAny( scprs, x -> x > 0 ) then 2801 2802 # There are constituents of the `i'-th degree. 2803 if ATL <> "" then 2804 Add( ATL, '+' ); 2805 fi; 2806 Append( ATL, String( degreeset[i] ) ); 2807 ATL1:= []; 2808 for j in [ 1 .. Length( scprs ) ] do 2809 nam:= false; 2810 if scprs[j] <> 0 then 2811 2812 # The `j'-th character of the `i'-th degree occurs. 2813 # If this is a `+' character then check whether also the 2814 # corresponding `-' character occurs, and if yes then 2815 # form constituents of the form `\pm'. 2816 if irrnam2[i][j][ Length( irrnam2[i][j] ) ] = '+' then 2817 pos:= ShallowCopy( irrnam2[i][j] ); 2818 pos[ Length( pos ) ]:= '-'; 2819 pos:= Position( irrnam2[i], pos ); 2820 if scprs[ pos ] <= scprs[j] and 0 < scprs[ pos ] then 2821 mult:= scprs[ pos ]; 2822 scprs[j]:= scprs[j] - mult; 2823 scprs[ pos ]:= 0; 2824 nam:= Concatenation( irrnam2[i][ pos ]{ [ 2825 1 .. Length( irrnam2[i][ pos ] ) -1 ]}, "{\\pm}" ); 2826 elif scprs[j] < scprs[ pos ] then 2827 mult:= scprs[j]; 2828 scprs[ pos ]:= scprs[ pos ] - mult; 2829 scprs[j]:= 0; 2830 nam:= Concatenation( irrnam2[i][j]{ [ 2831 1 .. Length( irrnam2[i][j] ) -1 ]}, "{\\pm}" ); 2832 fi; 2833 2834 fi; 2835 2836 fi; 2837 2838 # Deal with the `\pm' constituents. 2839 if nam <> false then 2840 Add( ATL1, [ nam, mult ] ); 2841 fi; 2842 2843 # Deal with the ordinary constituents. 2844 if scprs[j] <> 0 then 2845 if Length( irrnam2[i][j] ) = 2 then 2846 Add( ATL1, [ [ irrnam2[i][j][1] ], scprs[j] ] ); 2847 Add( ATL1, [ [ irrnam2[i][j][2] ], scprs[j] ] ); 2848 else 2849 Add( ATL1, [ irrnam2[i][j], scprs[j] ] ); 2850 fi; 2851 fi; 2852 2853 od; 2854 2855 # It may happen that constituents "ad" and "bc" occur. 2856 # Here we want to write "abcd" not "adbc", that's why we sort. 2857 Sort( ATL1 ); 2858 for j in ATL1 do 2859 if j[2] = 1 then 2860 Append( ATL, j[1] ); 2861 else 2862 Add( ATL, '(' ); 2863 Append( ATL, j[1] ); 2864 Append( ATL, ")^{" ); 2865 Append( ATL, String( j[2] ) ); 2866 Add( ATL, '}' ); 2867 fi; 2868 od; 2869 2870 fi; 2871 2872 od; 2873 2874 if error then 2875 ATL:= "Error"; 2876 fi; 2877 Add( ATLAS, ATL ); 2878 2879 od; 2880 2881 else 2882 ATLAS:= "error, no irreducibles bound"; 2883 fi; 2884 2885 # Return the result. 2886 return rec( contained := cont, 2887 bound := bound, 2888 display := rec( classes:= Filtered( [ 1 .. nccl2 ], 2889 x -> ForAny( permchars, y -> y[x]<>0 ) ), 2890 chars:= chars, 2891 letter:= "I" ), 2892 ATLAS := ATLAS ); 2893 end ); 2894