home *** CD-ROM | disk | FTP | other *** search
/ Math Solutions 1995 October / Math_Solutions_CD-ROM_Walnut_Creek_October_1995.iso / pc / mac / discrete / lib / agcoset.g < prev    next >
Encoding:
Text File  |  1993-05-05  |  15.6 KB  |  577 lines
  1. #############################################################################
  2. ##
  3. #A  agcoset.g                   GAP library                      Frank Celler
  4. ##
  5. #A  @(#)$Id: agcoset.g,v 3.7 1993/01/18 18:44:40 martin Rel $
  6. ##
  7. #Y  Copyright 1990-1992,  Lehrstuhl D fuer Mathematik,  RWTH Aachen,  Germany
  8. ##
  9. ##  This  file  contains  all  functions  for  creating cosets of ag groups.
  10. ##
  11. #H  $Log: agcoset.g,v $
  12. #H  Revision 3.7  1993/01/18  18:44:40  martin
  13. #H  added double coset functions
  14. #H
  15. #H  Revision 3.6  1993/01/04  11:17:47  fceller
  16. #H  changed 'DepthAgWord'
  17. #H
  18. #H  Revision 3.5  1992/12/16  19:47:27  martin
  19. #H  replaced quoted record names with escaped ones
  20. #H
  21. #H  Revision 3.4  1992/11/25  15:29:18  fceller
  22. #H  fixed a minor bug
  23. #H
  24. #H  Revision 3.3  1992/07/01  11:46:52  fceller
  25. #H  'LeftCoset' now uses 'CanonicalAgWord'
  26. #H
  27. #H  Revision 3.2  1992/04/03  13:10:09  fceller
  28. #H  changed 'Shifted...' into 'Sifted...'
  29. #H
  30. #H  Revision 3.1  1992/02/07  18:11:23  fceller
  31. #H  Initial GAP 3.1 release.
  32. ##
  33.  
  34.  
  35. #############################################################################
  36. ##
  37. #F  InfoAgGroup1( <arg> ) . . . . . . . . . . . . . . . . package information
  38. #F  InfoAgGroup2( <arg> ) . . . . . . . . . . . . . package debug information
  39. ##
  40. if not IsBound( InfoAgGroup1 )  then InfoAgGroup1 := Ignore;  fi;
  41. if not IsBound( InfoAgGroup2 )  then InfoAgGroup2 := Ignore;  fi;
  42.  
  43.  
  44. #############################################################################
  45. ##
  46.  
  47. #V  RightCosetAgGroupOps  . . . . . . . . . . . ops record of ag group cosets
  48. ##
  49. RightCosetAgGroupOps := Copy( RightCosetGroupOps );
  50.  
  51.  
  52. #############################################################################
  53. ##
  54. #F  RightCosetAgGroupOps.\<  . . . . . . . . . . . .  right coset comparison
  55. ##
  56. RightCosetAgGroupOps.\< := function( C, D )
  57.     local   L,  G,  x,  y,  g;
  58.  
  59.     if not IsRightCoset( C ) or not IsRightCoset( D )  then
  60.         return RightCosetGroupOps.\<( C, D );
  61.     elif C.group <> D.group  then
  62.         return RightCosetGroupOps.\<( C, D );
  63.     else
  64.         G := C.group;
  65.         L := Parent( G ).cgs;
  66.         x := SiftedAgWord( G, C.representative );
  67.         y := SiftedAgWord( G, D.representative );
  68.         while not x/y in G  do
  69.             if DepthAgWord(x) <> DepthAgWord(y)  then
  70.                 return x < y;
  71.             elif LeadingExponent(x) <> LeadingExponent(y)  then
  72.                 return x < y;
  73.             fi;
  74.             g := L[ DepthAgWord(x) ] ^ LeadingExponent(x);
  75.             G := G ^ g;
  76.             g := g ^ -1;
  77.             x := SiftedAgWord( G, g * x );
  78.             y := SiftedAgWord( G, g * y );
  79.         od;
  80.         return false;
  81.     fi;
  82.  
  83. end;
  84.  
  85.  
  86. #############################################################################
  87. ##
  88. #F  AgGroupOps.RightCoset( <G>, <u> ) . . . . . . . . . right coset <G> * <u>
  89. ##
  90. AgGroupOps.RightCoset := function( G, u )
  91.     local   C;
  92.  
  93.     C := rec();
  94.     C.isDomain       := true;
  95.     C.isRightCoset   := true;
  96.     C.group          := G;
  97.     C.representative := u;
  98.     C.isFinite       := true;
  99.     C.operations     := RightCosetAgGroupOps;
  100.     return C;
  101.  
  102. end;
  103.  
  104.  
  105. #############################################################################
  106. ##
  107. #F  AgGroupOps.RightCosets <S>, <U> ) . . . . . .  cosets <U>*s of <U> in <S>
  108. ##
  109. AgGroupOps.RightCosets := function( S, U )
  110.     local   C, d, cosets, id, g, u, i, old, new;
  111.  
  112.     if not IsSubgroup( S, U )  then
  113.        return GroupOps.RightCosets( S, U );
  114.     fi;
  115.  
  116.     # Get the generators of <U> with weight not in <V>.
  117.     U := Normalized( U );
  118.     d := List( Igs(U), DepthAgWord );
  119.     C := Filtered( Cgs( S ), x -> not DepthAgWord(x) in d );
  120.  
  121.     # Multiply all generators reversed canonically (we want Ug not gU).
  122.     old := [ U.identity ];
  123.     for g  in Reversed( C )  do
  124.         new := Copy( old );
  125.         for i  in [ 1 .. RelativeOrderAgWord( g ) - 1 ]  do
  126.             for u  in old  do
  127.                 Add( new, u * g ^ i );
  128.             od;
  129.         od;
  130.         old := new;
  131.     od;
  132.     cosets := old;
  133.  
  134.     # Return not only the agwords but also the operation.
  135.     id := RightCoset( U );
  136.     return List( cosets, x -> id * x );
  137.  
  138. end;
  139.  
  140. AgGroupOps.Cosets := AgGroupOps.RightCosets;
  141.  
  142.  
  143. #############################################################################
  144. ##
  145.  
  146. #V  LeftCosetAgGroupOps . . . . . . . . . . . . ops record of ag group cosets
  147. ##
  148. LeftCosetAgGroupOps := Copy( LeftCosetGroupOps );
  149.  
  150.  
  151. #############################################################################
  152. ##
  153. #F  LeftCosetAgGroupOps.\< . . . . . . . . . . . . . . left coset comparison
  154. ##
  155. LeftCosetAgGroupOps.\< := function( C, D )
  156.  
  157.     if not IsLeftCoset(C) or not IsLeftCoset(D)  then
  158.         return LeftCosetGroupOps.\<(C, D);
  159.     elif C.group <> D.group  then
  160.         return LeftCosetGroupOps.\<(C, D);
  161.     else
  162.         return C.representative < D.representative;
  163.     fi;
  164.  
  165. end;
  166.  
  167.  
  168. #############################################################################
  169. ##
  170. #F  LeftCosetAgGroupOps.\= . . . . . . . . . . . . . . left coset comparison
  171. ##
  172. LeftCosetAgGroupOps.\= := function( C, D )
  173.     local   isEql;
  174.  
  175.     # compare a left coset
  176.     if IsLeftCoset(C)  then
  177.  
  178.         # with another left coset
  179.         if IsLeftCoset(D)  then
  180.             isEql := C.group=D.group and C.representative=D.representative;
  181.  
  182.         # with a subgroup, which is a special left coset
  183.         elif IsGroup(D)  then
  184.             isEql := C.group=D and C.representative=C.group.identity;
  185.  
  186.         # with something else
  187.         else
  188.             isEql := DomainOps.\=(C, D);
  189.         fi;
  190.  
  191.     # compare a subgroup, which is a special left coset
  192.     elif IsGroup(C)  then
  193.  
  194.         # with a left coset
  195.         if IsLeftCoset(D)  then
  196.             isEql := C=D.group and D.representative=C.identity;
  197.  
  198.         # with something else
  199.         else
  200.             Error("panic, neither <C> nor <D> is a left coset");
  201.         fi;
  202.  
  203.     # compare something else
  204.     else
  205.  
  206.         # with a left coset
  207.         if IsLeftCoset(D)  then
  208.             isEql := DomainOps.\=(C, D);
  209.  
  210.         # with another something else
  211.         else
  212.             Error("panic, neither <C> nor <D> is a left coset");
  213.         fi;
  214.  
  215.     fi;
  216.  
  217.     # return the result
  218.     return isEql;
  219.  
  220. end;
  221.  
  222.  
  223. #############################################################################
  224. ##
  225. #F  LeftCosetAgGroupOps.\*  . . . . . . . . . . . . . .  multiply two cosets
  226. LeftCosetAgGroupOps.\* := function ( C, D )
  227.     local   E;
  228.  
  229.     if IsLeftCoset(D)  and C in Parent(D.group)  then
  230.         E := D.group.operations.LeftCoset(D.group, C*D.representative);
  231.     elif IsLeftCoset(D)  then
  232.         E := C * Elements(D);
  233.     elif IsLeftCoset(C)  then
  234.         E := Elements(C) * D;
  235.     else
  236.         Error("product of <C> and <D> is not defined");
  237.     fi;
  238.     return E;
  239.  
  240. end;
  241.  
  242.  
  243. #############################################################################
  244. ##
  245. #F  AgGroupOps.LeftCoset( <G>, <u> )  . . . . . . . . .  left coset <u> * <G>
  246. ##
  247. AgGroupOps.LeftCoset := function( G, u )
  248.     local   C;
  249.  
  250.     C := rec();
  251.     C.isDomain       := true;
  252.     C.isLeftCoset    := true;
  253.     C.group          := G;
  254.     C.representative := CanonicalAgWord(G, u);
  255.     C.isFinite       := true;
  256.     C.operations     := LeftCosetAgGroupOps;
  257.     return C;
  258.  
  259. end;
  260.  
  261.  
  262. #############################################################################
  263. ##
  264. #F  InfoCoset1  . . . . . . . . . . . . . . . information for coset functions
  265. ##
  266. if not IsBound(InfoCoset1)  then InfoCoset1:=Ignore; fi;
  267.  
  268.  
  269. #############################################################################
  270. ##
  271.  
  272. #F  AGDoubleCosets( <G>, <L>, <R> ) . . . . . . .  double cosets for aggroups
  273. ##
  274. ##  Double Coset calculation for AgGroups, inductive scheme, according to
  275. ##  Mike Slattery
  276. ##
  277. AGDoubleCosets := function(G,L,R)
  278.   local A,B,eas,fg,fgi,r,st,nr,nst,ind,N,H,K,sff,f,mat,m,i,j,ao,ng,v,isi,img,
  279.         b,wbase,neubas,wproj,wg,gen,W,x,xg,gi,U,mats,u,nu,sf,dr,U,flip,hom;
  280.  
  281.   # force elementary abelian Series
  282.   if not(IsElementaryAbelianAgSeries(G)) then
  283.     hom:=IsomorphismAgGroup(ElementaryAbelianSeries(G));
  284.     A:=Image(hom,L);
  285.     B:=Image(hom,R);
  286.     G:=hom.range;
  287.     img:=true;
  288.   else
  289.     img:=false;
  290.     A:=L;
  291.     B:=R;
  292.   fi;
  293.  
  294.   # if a is small and b large, compute cosets b\G/a and take inverses of the
  295.   # representatives: Since we compute stabilizers in B and a chain down to
  296.   # A, this is remarkable faster
  297.  
  298.   if 3*Size(A)<2*Size(B) then
  299.     m:=B;
  300.     B:=A;
  301.     A:=m;
  302.     flip:=true;
  303.     InfoCoset1("#I DoubleCosetFlip\n");
  304.   else
  305.     flip:=false;
  306.   fi;
  307.  
  308.   gi:=G.identity;
  309.   eas:=ElementaryAbelianSeries(G);
  310.   fg:=G/eas[1]; #eas[1]=G
  311.   r:=[fg.identity];
  312.   st:=[B];
  313.   for ind in [2..Length(eas)] do
  314.     # G/<1> \not= G for GAP, thus avoid G/<1>
  315.     if ind<Length(eas) then
  316.       fg:=G/eas[ind];
  317.     else
  318.       fg:=G;
  319.     fi;
  320.     fgi:=fg.identity;
  321.     N:=FactorAgSubgroup(fg,eas[ind-1]);
  322.     H:=FactorAgSubgroup(fg,A);
  323.     K:=FactorAgSubgroup(fg,B);
  324.     if IsSubgroup(H,N) then
  325.       if ind=Length(eas) then
  326.     # calculation of preImages is only necessary in the last step
  327.     for i in [1..Length(r)] do
  328.       r[i]:=FactorAgWord(r[i],fgi);
  329.     od;
  330.       fi;
  331.     #elif IsSubgroup(K,N) then
  332.       #Print("new Part\n"); contains errors!
  333.       # If N\subseteq K, then W\subset N=N^x\subset Stab^x=U (note, that N\cap K
  334.       # \subset Stab). Thus we get one Orbit. The Stabilizer is the
  335.       # Stabilizer of H in U, i.e. H-part of U, which is the conjugation of
  336.       # the A-part of the conjugated Stabilizer.
  337.       #for i in [1..Length(r)] do
  338.     #xg:=FactorAgWord(r[i],gi);
  339.     #r[i]:=FactorAgWord(r[i],fgi);
  340.     #st[i]:=Closure(eas[ind],Intersection(Subgroup(G,List(st[i].generators,i->i^(xg^(-1)))),A))^xg;
  341.     else
  342.       sff:=SumFactorizationFunctionAgGroup(H,N);
  343.       ng:=Cgs(N);
  344.       if not IsBound(N.field) then
  345.     N.field:=GF(RelativeOrderAgWord(N.generators[1]));
  346.       fi;
  347.       f:=N.field;
  348.       v:=RowSpace(Length(ng),f);
  349.       if Size(sff.intersection)=1 then
  350.     isi:=RowSpace([v.zero],f);
  351.       else
  352.     isi:=RowSpace(List(sff.intersection.generators,i->Exponents(N,i,f)),f);
  353.       fi;
  354.       # compute complement W
  355.       b:=BaseSteinitz(v,isi);
  356.       wbase:=b.factorspace;
  357.       dr:=[1..Length(wbase)]; # 3 for stripping the affine 1
  358.       neubas:=Concatenation(wbase,isi.base);
  359.       wproj:=List(neubas^(-1),i->Sublist(i,[1..Length(wbase)]));
  360.       wg:=[];
  361.       for i in wbase do
  362.     Add(wg,ElementVector(ng,i));
  363.       od;
  364.       W:=Subgroup(fg,wg);
  365.       InfoCoset1("#I Step:",Size(W),"\n");
  366.  
  367.       nr:=[];
  368.       nst:=[];
  369.       for i in [1..Length(r)] do
  370.     x:=FactorAgWord(r[i],fgi);
  371.     xg:=FactorAgWord(x,gi);
  372.         U:=st[i]^(xg^(-1));
  373.     mats:=[];
  374.         for u in List(U.generators,i->FactorAgWord(i,fgi)) do
  375.           m:=[]; 
  376.           for j in wg do
  377.         Add(m,Concatenation(Exponents(N,j^u,f)*wproj,[f.zero])); 
  378.       od;
  379.       Add(m,Concatenation(Exponents(N,sff.factorization(u).n,f)*wproj,
  380.         [f.one])); 
  381.       Add(mats,m);
  382.     od;
  383.     # modify later: if U trivial
  384.     if Length(mats)>0 then
  385.       ao:=AffineOrbitsAgGroup(U,mats,f);
  386.       Apply(ao.representatives,
  387.          i->ElementVector(ng,Sublist(i,dr)*wbase));
  388.     else
  389.       ao:=rec(
  390.                   representatives:=Elements(W),
  391.                   stabilizers:=List(Elements(W),i->U)
  392.           ); 
  393.     fi;
  394.     for j in [1..Length(ao.representatives)] do
  395.       Add(nr,ao.representatives[j]*x);
  396.       Add(nst,ao.stabilizers[j]^xg);
  397.     od;
  398.       od;
  399.       r:=nr;
  400.       st:=nst;
  401.     fi;
  402.   od;
  403.   sf:=Size(A)*Size(B);
  404.   for i in [1..Length(r)] do
  405.     if img then
  406.       r[i]:=PreImagesRepresentative(hom,r[i]);
  407.     fi;
  408.     if flip then
  409.       f:=G.operations.DoubleCoset(R,r[i]^(-1),L);
  410.     else
  411.       f:=G.operations.DoubleCoset(L,r[i],R);
  412.     fi;
  413.     f.size:=sf/Size(st[i]);
  414.     r[i]:=f;
  415.   od;
  416.   return r;
  417. end;
  418.  
  419. AgGroupOps.DoubleCosets := function(G,A,B)
  420.   if Size(G)<=500 then
  421.     return CalcDoubleCosets(G,A,B);
  422.   else
  423.     return AGDoubleCosets(G,A,B);
  424.   fi;
  425. end;
  426.  
  427.  
  428. #############################################################################
  429. ##
  430. #F  FactorAgSubgroup( <F>, <S> )  . . . . .  map <S> into factor group <F> by
  431. #F                                                    stripping the exponents
  432. ##
  433. FactorAgSubgroup := function(F,S)
  434.   return Subgroup(F,List(S.generators,i->FactorAgWord(i,F.identity)));
  435. end;
  436.  
  437.  
  438. #############################################################################
  439. ##
  440. #F  ElementVector( <cgs>, <e> ) . . . .  element of subgroup corresponding to
  441. #F                                                      a finite field vector
  442. ##
  443. ElementVector := function(cgs,e)
  444.   local el,i;
  445.   el:=cgs[1]^0;
  446.   for i in [1..Length(e)] do
  447.     el:=el*cgs[i]^IntFFE2(e[i]);
  448.   od;
  449.   return el;
  450. end;
  451.  
  452.  
  453. #############################################################################
  454. ##
  455. #F  AscendingChain(<G>,<U>) . . . . . . .  chain of subgroups G=G_1>...>G_n=U
  456. ##
  457. AgGroupOps.AscendingChain := function(G,s)
  458.   local c,cc,e,bound,k,i,j,neu,olg;
  459.   c:=[s];
  460.   e:=s;
  461.   k:=Reversed(CompositionSeries(G));
  462.   olg:=[];
  463.   for i in [1..Length(k)-1] do
  464.     if Size(e)>Size(k[i]) and IsSubset(k[i].generators,olg) then
  465.       e:=Closure(e,k[i]);
  466.     else
  467.       e:=Closure(k[i],s);
  468.     fi;
  469.     olg:=k[i].generators;
  470.     neu:=true;
  471.     j:=1;
  472.     while j<=Length(c) and neu do
  473.       if Size(c[j])=Size(e) then
  474.     neu:=false;
  475.       fi;
  476.       j:=j+1;
  477.     od;
  478.     if neu then
  479.       Add(c,e);
  480.     fi; 
  481.   od;
  482.   if Size(e)<Size(G) then
  483.     Add(c,G);
  484.   fi;
  485.   return RefinedChain(G,c);
  486. end;
  487.  
  488.  
  489. #############################################################################
  490. ##
  491. #F AgGroupOps.CanonicalCosetElement( <U>, <g> ) . . . . .  CCEs for ag groups
  492. ##
  493. ## Set up a CGS and relative orders of the generators for MainEntryCCEAgGroup
  494. ##
  495. AgGroupOps.CanonicalCosetElement := function(U,g)
  496.   local G;
  497.   G:=Parent(U);
  498.   # force computation of CGS for U and of genRelOrders of G
  499.   Cgs(U);
  500.   GenRelOrdersAgGroup(G);
  501.   return MainEntryCCEAgGroup( G, U, g );
  502. end;
  503.  
  504.  
  505. #############################################################################
  506. ##
  507. #F  AgGroupOps.OnCanonicalCosetElements(<G>,<U>)  . create operation function
  508. #F                                                      for CCEs for aggroups
  509. ##
  510. ##  this routine returns a *function*, that can be used like OnPoints.
  511. ##
  512. AgGroupOps.OnCanonicalCosetElements := function(G,U)
  513.   GenRelOrdersAgGroup(G);
  514.   Cgs(U);
  515.   return function(a,b)
  516.        return MainEntryCCEAgGroup(G,U,a*b);
  517.      end;
  518. end;
  519.  
  520.  
  521. #############################################################################
  522. ##
  523. #F  MainEntryCCEAgGroup( <G>, <U>, <g> )  . . . . . . . . .  cce for aggroups
  524. ##
  525. ##  Main part of the computation of a canonical coset representative in a
  526. ##  AgGroup. This is done by factoring with the canonical generators of the
  527. ##  subgroup to set the appropriate exponents to zero. Since the
  528. ##  representation as an AgWord is "from left to right", we can multiply with
  529. ##  subgroup elements from _right_, without changing exponents of the
  530. ##  generators with lower depth (that are supposedly in canonical form yet).
  531. ##  Since we want _right_ cosets, everything is done with the _inverse_
  532. ##  elements, which are representatives for the left cosets.  The routine
  533. ##  supposes, that an Cgs has been set up and the relative orders of the
  534. ##  generators have been computed by the calling routine.
  535. ##
  536. MainEntryCCEAgGroup := function(G,U,g)
  537.   local a,d1,d,u,e;
  538.   a:=g^(-1);
  539.   d1:=Depth(a);
  540.   for u in U.cgs do
  541.     d:=Depth(u);
  542.     if d>=d1 then
  543.       e:=ExponentsAgWord(a);
  544.       a:=a*u^(G.genRelOrders[d]-e[d]);
  545.       d1:=Depth(a);
  546.     fi;
  547.   od;
  548.   return a^(-1);
  549. end;
  550.  
  551. AgGroupOps.MainEntryCCE:=MainEntryCCEAgGroup;
  552.  
  553.  
  554. #############################################################################
  555. ##
  556. #F  GenRelOrdersAgGroup( <G> )  . . .  relative orders of the generators of G
  557. ##
  558. GenRelOrdersAgGroup := function(G)
  559.   if not IsBound(G.genRelOrders) then
  560.     G.genRelOrders:=List(G.generators,i->RelativeOrderAgWord(i));
  561.   fi;
  562.   return G.genRelOrders;
  563. end;
  564.  
  565.  
  566. #############################################################################
  567. ##
  568.  
  569. #E  Emacs . . . . . . . . . . . . . . . . . . . . . . . local emacs variables
  570. ##
  571. ## Local Variables:
  572. ## mode:           outline
  573. ## outline-regexp: "#F\\|#V\\|#E"
  574. ## eval:           (hide-body)
  575. ## End:
  576. ##
  577.