home *** CD-ROM | disk | FTP | other *** search
/ Math Solutions 1995 October / Math_Solutions_CD-ROM_Walnut_Creek_October_1995.iso / pc / mac / discrete / lib / aginters.g < prev    next >
Encoding:
Text File  |  1993-05-05  |  16.5 KB  |  540 lines
  1. #############################################################################
  2. ##
  3. #A  aginters.g                  GAP library                      Frank Celler
  4. ##
  5. #A  @(#)$Id: aginters.g,v 3.16 1992/06/10 21:41:51 fceller Rel $
  6. ##
  7. #Y  Copyright 1990-1992,  Lehrstuhl D fuer Mathematik,  RWTH Aachen,  Germany
  8. ##
  9. ##  This files contains the intersection algorithm.
  10. ##
  11. #H  $Log: aginters.g,v $
  12. #H  Revision 3.16  1992/06/10  21:41:51  fceller
  13. #H  fixed a minor bug in 'NormalIntersection'
  14. #H
  15. #H  Revision 3.15  1992/04/03  13:10:09  fceller
  16. #H  changed 'Shifted...' into 'Sifted...'
  17. #H
  18. #H  Revision 3.14  1992/03/30  07:47:09  fceller
  19. #H  changed 'Exponents' slightly.
  20. #H
  21. #H  Revision 3.13  1992/02/07  18:11:40  fceller
  22. #H  Initial GAP 3.1 release.
  23. #H
  24. #H  Revision 3.1  1991/05/26  12:06:26  fceller
  25. #H  Initial revision
  26. ##
  27.  
  28.  
  29. #############################################################################
  30. ##
  31. #F  InfoAgGroup1( <arg> ) . . . . . . . . . . . . . . . . package information
  32. #F  InfoAgGroup2( <arg> ) . . . . . . . . . . . . . package debug information
  33. ##
  34. if not IsBound( InfoAgGroup1 )  then InfoAgGroup1 := Ignore;  fi;
  35. if not IsBound( InfoAgGroup2 )  then InfoAgGroup2 := Ignore;  fi;
  36.  
  37.  
  38. #############################################################################
  39. ##
  40. #V  GS_SIZE . . . . . . . . . . . . . . . .  size from which on we use glasby
  41. ##
  42. GS_SIZE := 20;
  43.  
  44.  
  45. #############################################################################
  46. ##
  47. #F  ExtendedIntersectionSumAgGroup( <N>, <U> )  . . . . . . . . .  zassenhaus
  48. ##
  49. ExtendedIntersectionSumAgGroup := function( N, U )
  50.     local   G, I, ls, rs, is, tmp, id, al, ar, z, g, i, M;
  51.  
  52.     # Get  the  number of supergroup generators and the generators of <U> and
  53.     # <N>.
  54.     G  := Parent( N, U );
  55.     id := G.identity;
  56.  
  57.     # What  follows  is a Zassenhausalgorithm. <ls> and <rs> are the left and
  58.     # rights  sides. They are initialized with [ n, n ] and [ u, 1 ]. <is> is
  59.     # the  intersection.  <I>  contains  the  words  [ u, 1 ]  which  must be
  60.     # Sifted through [ <ls>, <rs> ].
  61.     if IsBound( G.isFactorArg ) and G.isFactorArg  then
  62.         M  := G.factorDen;
  63.         ls := [];
  64.         rs := [];
  65.         is := [];
  66.         for i  in [ 1 .. Length( G.factorNum.cgs ) ] do
  67.             ls[ i ] := id;
  68.             rs[ i ] := id;
  69.             is[ i ] := id;
  70.         od;
  71.         for g  in N.generators  do
  72.             ls[ DepthAgWord( g ) ] := g;
  73.             rs[ DepthAgWord( g ) ] := g;
  74.         od;
  75.         I := [];
  76.         for g  in U.generators  do
  77.             if ls[ DepthAgWord( g ) ] = id  then
  78.                 ls[ DepthAgWord( g ) ] := g;
  79.             else
  80.                 Add( I, g );
  81.             fi;
  82.         od;
  83.  
  84.         # Enter the pairs [ u, 1 ] of <I> into [ <ls>, <rs> ].
  85.         for al  in I  do
  86.             ar := id;
  87.             al := SiftedAgWord( M, al );
  88.             z  := DepthAgWord( al );
  89.  
  90.             # Shift through and reduced from the left.
  91.             while al <> id and ls[ z ] <> id  do
  92.                 tmp := LeadingExponentAgWord( al )
  93.                          / LeadingExponentAgWord( ls[ z ] )
  94.                        mod RelativeOrderAgWord( al );
  95.                 al := SiftedAgWord( M, ls[ z ] ^ tmp mod al );
  96.                 ar := rs[ z ] ^ -tmp * ar;
  97.                 z  := DepthAgWord( al );
  98.             od;
  99.  
  100.             # Have we a new sum or intersection generator.
  101.             if al <> id  then
  102.                 ls[ z ] := al;
  103.                 rs[ z ] := ar;
  104.             else
  105.                 z  := DepthAgWord( ar );
  106.                 while ar <> id and is[ z ] <> id  do
  107.                     ar := SiftedAgWord( M, ReducedAgWord( ar, is[ z ] ) );
  108.                     z  := DepthAgWord( ar );
  109.                 od;
  110.                 if ar <> id  then
  111.                     is[ z ] := ar;
  112.                 fi;
  113.             fi;
  114.         od;
  115.  
  116.         # Construct  the sum and intersection aggroups. Return left and right
  117.         # sides, so one can decompose words of <N> * <U>.
  118.         return rec( leftSide     := ls,
  119.                     rightSide    := rs,
  120.                     sum          := Filtered( ls, x -> x <> id ),
  121.                     intersection := Filtered( is, x -> x <> id ) );
  122.     else
  123.         ls := [];
  124.         rs := [];
  125.         is := [];
  126.         for i  in [ 1 .. Length( G.cgs ) ] do
  127.             ls[ i ] := id;
  128.             rs[ i ] := id;
  129.             is[ i ] := id;
  130.         od;
  131.         for g  in Igs( N )  do
  132.             ls[ DepthAgWord( g ) ] := g;
  133.             rs[ DepthAgWord( g ) ] := g;
  134.         od;
  135.         I := [];
  136.         for g  in Igs( U )  do
  137.             if ls[ DepthAgWord( g ) ] = id  then
  138.                 ls[ DepthAgWord( g ) ] := g;
  139.             else
  140.                 Add( I, g );
  141.             fi;
  142.         od;
  143.  
  144.         # Enter the pairs [ u, 1 ] of <I> into [ <ls>, <rs> ].
  145.         for al  in I  do
  146.             ar := id;
  147.             z  := DepthAgWord( al );
  148.  
  149.             # Shift through and reduced from the left.
  150.             while al <> id and ls[ z ] <> id  do
  151.                 tmp := LeadingExponentAgWord( al )
  152.                          / LeadingExponentAgWord( ls[ z ] )
  153.                        mod RelativeOrderAgWord( al );
  154.                 al := ls[ z ] ^ tmp mod al;
  155.                 ar := rs[ z ] ^ tmp mod ar;
  156.                 z  := DepthAgWord( al );
  157.             od;
  158.  
  159.             # Have we a new sum or intersection generator.
  160.             if al <> id  then
  161.                 ls[ z ] := al;
  162.                 rs[ z ] := ar;
  163.             else
  164.                 z := DepthAgWord( ar );
  165.                 while ar <> id and is[ z ] <> id  do
  166.                     ar := ReducedAgWord( ar, is[ z ] );
  167.                     z  := DepthAgWord( ar );
  168.                 od;
  169.                 if ar <> id  then
  170.                     is[ z ] := ar;
  171.                 fi;
  172.             fi;
  173.         od;
  174.  
  175.         # Construct  the sum and intersection aggroups. Return left and right
  176.         # sides, so one can decompose words of <N> * <U>.
  177.         return rec(
  178.             leftSide     := ls,
  179.             rightSide    := rs,
  180.             sum          := AgSubgroup(G, Filtered(ls, x->x<>id),false),
  181.             intersection := AgSubgroup(G, Filtered(is, x->x<>id),false) );
  182.     fi;
  183. end;
  184.  
  185.  
  186. #############################################################################
  187. ##
  188. #F  SumFactorizationFunctionAgGroup( <U>, <N> ) . . . .  g = u*n in <U> * <N>
  189. ##
  190. SumFactorizationFunctionAgGroup := function( U, N )
  191.     local   G, f, id, S;
  192.  
  193.     G := Parent( N, U );
  194.     id := G.identity;
  195.  
  196.     # Never  change  <N>  and  <U>  in  the  function call. Otherwise we will
  197.     # decompose <N> * <U>.
  198.     S := ExtendedIntersectionSumAgGroup( U, N );
  199.  
  200.     # Decompose  a  word  of  <U> * <N>. See 'ExtendedIntersectionSumAgGroup'
  201.     # for details on 'rightSide' and 'leftSide'.
  202.     f := function( un )
  203.         local a, u, w, z;
  204.  
  205.         # Catch trivial case.
  206.         if un = id  then
  207.             return rec( u := id, n := id );
  208.         fi;
  209.  
  210.         # Shift  through  'leftSide'  and  do  the  inverse  operations  with
  211.         # 'rightSide'. This will give the <N> part.
  212.         u := id;
  213.         a := un;
  214.         w := DepthAgWord( a );
  215.         while a <> id and S.leftSide[ w ] <> id  do
  216.             z := LeadingExponentAgWord( a )
  217.                    / LeadingExponentAgWord( S.leftSide[ w ] )
  218.                  mod RelativeOrderAgWord( a );
  219.             a := S.leftSide[ w ] ^ z mod a;
  220.             u := u * S.rightSide[ w ] ^ z;
  221.             w := DepthAgWord( a );
  222.         od;
  223.         return rec( u := u, n := u^-1 * un );
  224.  
  225.     end;
  226.  
  227.     # Return the sum, intersection and the function.
  228.     return rec( sum           := S.sum,
  229.                 intersection  := S.intersection,
  230.                 factorization := f );
  231.  
  232. end;
  233.  
  234.  
  235. #############################################################################
  236. ##
  237. #F  GlasbyCover( <S>, <A>, <B>, <H>, <K> )  . . . . . . . . . . . . . . local
  238. ##
  239. ##  Glasby's  generalized  covering  algorithmus.  <S> := <H>/\<N> * <K>/\<N>
  240. ##  and <A> < <H>, <B> < <K>. <A> ( and also <B> ) generate the  intersection
  241. ##  modulo <S>.
  242. ##
  243. GlasbyCover := function( S, A, B, H, K )
  244.     local   Am, Bm, z, i;
  245.  
  246.     # Decompose the intersection <H> /\ <K> /\ <N>.
  247.     Am := S.intersection;
  248.     Bm := List( Am, x -> x / SiftedAgWord( K, x ) );
  249.  
  250.     # Now cover the other generators.
  251.     for i  in [ 1 .. Length( A ) ]  do
  252.         z := S.factorization( A[i] ^ -1 * B[i] );
  253.         A[ i ] := A[ i ] * z.u;
  254.         B[ i ] := B[ i ] * ( z.n / SiftedAgWord( K, z.n ) ) ^ -1;
  255.     od;
  256.  
  257.     # Concatenate them and return. The are not normalized.
  258.     Append( A, Am );
  259.     Append( B, Bm );
  260.  
  261. end;
  262.  
  263.  
  264. #############################################################################
  265. ##
  266. #F  GlasbyShift( <G>, <C>, <B> )  . . . . . . . . . . . . . . . . . . . local
  267. ##
  268. GlasbyShift := function( G, C, B )
  269.     local z;
  270.  
  271.     B := AgSubgroup( G, B, false );
  272.     return List( C, x -> x / SiftedAgWord( B, x ) );
  273.  
  274. end;
  275.  
  276.  
  277. #############################################################################
  278. ##
  279. #F  GlasbyStabilizer( <G>, <A>, <B>, <N>, <R> ) . . . . . . . . . . . . local
  280. ##
  281. GlasbyStabilizer := function( G, A, B, N, R )
  282.  
  283.     local   base,
  284.             field,
  285.             mA,
  286.             L,
  287.             V,
  288.             pt,
  289.             tau,
  290.             phi;
  291.  
  292.  
  293.     L       := FactorArg( AgSubgroup( G, N, false ), R );
  294.     base    := L.generators;
  295.     field   := GF( RelativeOrderAgWord( base[ 1 ] ) );
  296.     L.field := field;
  297.  
  298.     # Operate affine. Construct matrices of dimension one more.
  299.     A := AgSubgroup( G, A, false );
  300.     B := AgSubgroup( G, B, false );
  301.     tau := function( a )
  302.         return L.operations.Exponents( L, SiftedAgWord( B, a ), L.field );
  303.     end;
  304.     phi := function( x, a )
  305.         return L.operations.Exponents( L, x ^ a, L.field );
  306.     end;
  307.  
  308.     # Fake vectorspace, <base> is not empty.
  309.     V := rec( base := base, isDomain := true );
  310.     mA := AffineOperation( A, V, phi, tau ).images;
  311.  
  312.     # Stabilize point (0,...,0,1).
  313.     pt := List( base, x -> field.zero );
  314.     Add( pt, field.one );
  315.  
  316.     return AgOrbitStabilizer( A, mA, pt ).stabilizer.generators;
  317.  
  318. end;
  319.  
  320.  
  321. #############################################################################
  322. ##
  323. #F  GlasbyIntersection( <H>, <K> )  . . . . . . . . . . Glasby's intersection
  324. ##
  325. GlasbyIntersection := function( H, K )
  326.     local   G, A, B, C, D, HmN, KmN, N, R, E, sum, i, s, e;
  327.  
  328.     # The supergroup must have an elementary abelian agseries.
  329.     G := Parent( H, K );
  330.     Cgs( H );
  331.     Cgs( K );
  332.     if not IsElementaryAbelianAgSeries( G )  then
  333.         Error( "GlasbyIntersection: needs an elementary abelian agseries" );
  334.     fi;
  335.     E := ElementaryAbelianSeries( G );
  336.  
  337.     # Go down the elementary abelian series. <A> < <H>, <B> < <K>.
  338.     A := [];
  339.     B := [];
  340.     for i  in [ 1 .. Length( E ) - 1 ]  do
  341.  
  342.         Cgs( E[ i + 1 ] );
  343.         N := FactorArg( E[ i ], E[ i + 1 ] ).generators;
  344.  
  345.         ##  if CHECK  then
  346.         ##      Print( "#I  GlasbyIntersection: step number ", i, "\n" );
  347.         ##      Print( "#I  GlasbyIntersection: A = <", A, ">\n" );
  348.         ##      Print( "#I  GlasbyIntersection: B = <", B, ">\n" );
  349.         ##      Print( "#I  GlasbyIntersection: N = <", N, ">\n" );
  350.         ##  fi;
  351.  
  352.         s := DepthAgWord( N[ 1 ] );
  353.         e := DepthAgWord( N[ Length( N ) ] );
  354.         HmN := Filtered( H.cgs, x -> s <= DepthAgWord( x )
  355.                                       and DepthAgWord( x ) <= e );
  356.         KmN := Filtered( K.cgs, x -> s <= DepthAgWord( x )
  357.                                       and DepthAgWord( x ) <= e );
  358.         HmN := FactorArg( AgSubgroup( G, HmN, false ), E[ i + 1 ] );
  359.         KmN := FactorArg( AgSubgroup( G, KmN, false ), E[ i + 1 ] );
  360.  
  361.         sum := SumFactorizationFunctionAgGroup( HmN, KmN );
  362.  
  363.         ##  if CHECK  then
  364.         ##      Print( "#I  GlasbyIntersection: R = <", sum.sum, ">\n" );
  365.         ##  fi;
  366.  
  367.         # Maybe there is nothing left to stabilize.
  368.         if Length( sum.sum ) = Length( N ) then
  369.             C := A;
  370.             D := B;
  371.          else
  372.             R := AgSubgroup( G, Concatenation(sum.sum, E[i+1].cgs), false );
  373.             C := GlasbyStabilizer( G, A, B, N, R );
  374.             D := GlasbyShift( G, C, B );
  375.  
  376.             ##  if CHECK  then
  377.             ##      Print( "#I  GlasbyIntersection: C = <", C, ">\n" );
  378.             ##      Print( "#I  GlasbyIntersection: D = <", D, ">\n" );
  379.             ##  fi;
  380.  
  381.         fi;
  382.  
  383.         # Now we can cover <C> and <D>.
  384.         GlasbyCover( sum, C, D, H, K );
  385.         A := C;
  386.         B := D;
  387.     od;
  388.  
  389.     # <A> is the unnormalized intersection.
  390.     A := AgSubgroup( G, A, false );
  391.     Normalize( A );
  392.     return A;
  393.  
  394. end;
  395.  
  396.  
  397. #############################################################################
  398. ##
  399. #F  IntersectionSumAgGroup( <N>, <U> )  . . . . . . . . . . . . .  Zassenhaus
  400. ##
  401. IntersectionSumAgGroup := function( N, U )
  402.     local   G, g, tmp, sw, ins, sum;
  403.  
  404.     # Typecheck arguments. Catch trivial cases.
  405.     G := Parent( N, U );
  406.     if N.generators = []  then
  407.         return rec( intersection := N, sum := U );
  408.     elif U.generators = []  then
  409.         return rec( intersection := U, sum := N );
  410.     fi;
  411.  
  412.     # If  <N>  is  composition subgroup, no calculation is needed. We can use
  413.     # weights  instead.  Otherwise  'ExtendedIntersectionSumAgGroup'  will do
  414.     # the work.
  415.     if IsElementAgSeries( N )  then
  416.         sw  := DepthAgWord( Igs( N )[ 1 ] );
  417.         ins := [];
  418.         sum := [];
  419.         for g  in Igs( U )  do
  420.             if DepthAgWord( g ) < sw  then
  421.                 Add( sum, g );
  422.             else
  423.                 Add( ins, g );
  424.             fi;
  425.         od;
  426.         Append( sum, Igs( N ) );
  427.     else
  428.         tmp := ExtendedIntersectionSumAgGroup( N, U );
  429.         sum := tmp.sum.igs;
  430.         ins := tmp.intersection.igs;
  431.     fi;
  432.  
  433.     sum := AgSubgroup( G, sum, false );
  434.     ins := AgSubgroup( G, ins, false );
  435.     return rec( sum := sum, intersection := ins );
  436.  
  437. end;
  438.  
  439.  
  440. #############################################################################
  441. ##
  442. #F  NormalIntersection( <N>, <U> )  . . . . . . . . Zassenhaus (intersection)
  443. ##
  444. AgGroupOps.NormalIntersection := function( N, U )
  445.     local   G, g, sw, ins;
  446.  
  447.     # Typecheck arguments. Catch trivial cases.
  448.     G := Parent( N, U );
  449.     if N.generators = [] or U.generators = []  then
  450.         return AgSubgroup( G, [], true );
  451.     elif IsParent( N ) then
  452.         return U;
  453.     elif IsParent( U ) then
  454.         return N;
  455.     fi;
  456.  
  457.     # If  <N>  is  composition subgroup, no calculation is needed. We can use
  458.     # weights instead. Otherwise 'IntersectionSumAgGroup' will do the work.
  459.     if IsElementAgSeries( N )  then
  460.         sw  := DepthAgWord( Igs( N )[ 1 ] );
  461.         ins := [];
  462.         for g  in Igs(U)  do
  463.             if DepthAgWord( g ) >= sw  then
  464.                 Add( ins, g );
  465.             fi;
  466.         od;
  467.         ins := AgSubgroup( G, ins, false );
  468.         return ins;
  469.     else
  470.        return IntersectionSumAgGroup( N, U ).intersection;
  471.     fi;
  472.  
  473. end;
  474.  
  475.  
  476. #############################################################################
  477. ##
  478. #F  SumAgGroup( <N>, <U> )  . . . . . . . . . . . . . . . .  Zassenhaus (sum)
  479. ##
  480. SumAgGroup := function( N, U )
  481.     return IntersectionSumAgGroup( N, U ).sum;
  482. end;
  483.  
  484.  
  485. #############################################################################
  486. ##
  487. #F  Intersection( <U>, <V> )  . . . . . . . . . . . . . . . . . <U> meets <V>
  488. ##
  489. ##  Dispatcher  for  intersection.  'GlasbyIntersection'  should  be used for
  490. ##  big groups.
  491. ##
  492. AgGroupOps.Intersection := function( U, V )
  493.  
  494.     # Catch some trivial cases and check <GS_SIZE>.
  495.     if   not IsAgGroup( U ) or not IsAgGroup( V )  then
  496.         return GroupOps.Intersection( U, V );
  497.     elif Size( U ) < GS_SIZE or Size( V ) < GS_SIZE  then
  498.         return GroupOps.Intersection( U, V );
  499.     elif Parent( V ) <> Parent( U )  then
  500.         return [];
  501.     elif U.generators = [] or IsParent( V )  then
  502.         return U;
  503.     elif V.generators = [] or IsParent( U )  then
  504.         return V;
  505.     elif U = V  then
  506.         return U;
  507.     fi;
  508.  
  509.     # If  one group is normal use 'NormalIntersectionAgGroup', this needs one
  510.     # (commutative) gauss step.
  511.     if    ( IsBound( U.isNormal ) and U.isNormal )
  512.        or ( IsBound( V.isNormal ) and V.isNormal )
  513.     then
  514.         return NormalIntersection( U, V );
  515.     fi;
  516.  
  517.     #N The  elemntary abelian series must be refined by the agseries in order
  518.     #N to use Glasbys algorithm. This could be changed with some effort.
  519.     if not IsElementaryAbelianAgSeries( Parent( U ) )  then
  520.         Print( "#W  IntersectionAgGroup: no elementery abelian agseries, ",
  521.                "computing whole orbit\n" );
  522.         return GroupOps.Intersection( U, V );
  523.     else
  524.         return GlasbyIntersection( U, V );
  525.     fi;
  526.  
  527. end;
  528.  
  529.  
  530. #############################################################################
  531. ##
  532. #E  Emacs . . . . . . . . . . . . . . . . . . . . . . . local emacs variables
  533. ##
  534. ## Local Variables:
  535. ## mode:           outline
  536. ## outline-regexp: "#F\\|#V\\|#E"
  537. ## eval:           (hide-body)
  538. ## End:
  539. ##
  540.