Quelle ctblmaps.gi Sprache: unbekannt

#############################################################################
##
##  This file is part of GAP, a system for computational discrete algebra.
##  This file's authors include Thomas Breuer.
##
##  Copyright of GAP belongs to its developers, whose names are too numerous
##  to list here. Please refer to the COPYRIGHT file for details.
##
##  SPDX-License-Identifier: GPL-2.0-or-later
##
##  This file contains those functions that are used to construct maps,
##  (mostly fusion maps and power maps).
##
##  1. Maps Concerning Character Tables
##  2. Power Maps
##  3. Class Fusions between Character Tables
##  4. Utilities for Parametrized Maps
##  5. Subroutines for the Construction of Power Maps
##  6. Subroutines for the Construction of Class Fusions
##

#T UpdateMap: assertions for returned `true' in the library occurrences

#############################################################################
##
##  2. Power Maps
##

#############################################################################
##
#M  PowerMap( <tbl>, <n> )  . . . . . . . . . for character table and integer
#M  PowerMap( <tbl>, <n>, <class> )
##
InstallMethod( PowerMap,
    "for a character table, and an integer",
    [ IsNearlyCharacterTable, IsInt ],
    function( tbl, n )
    local known, erg,i,e,ord,a,p;

    ord:=OrdersClassRepresentatives(tbl);

    if IsPosInt( n ) and IsSmallIntRep( n ) then
      known:= ComputedPowerMaps( tbl );

      # compute the <n>-th power map
      if not IsBound( known[n] ) then
        if ForAll(Filtered([1..n-1],IsPrimeInt),x->IsBound(known[x])) then
          # do not exceed element order, we can fill these out easier
          erg:= PowerMapOp( tbl, n:onlyuptoorder );
          for i in [1..Length(erg)] do
            if erg[i]=0 then
              e:=n mod ord[i];
              a:=i;
              while e>1 do
                p:=SmallestPrimeDivisor(e);
                e:=e/p;
                a:=known[p][a];
              od;
              erg[i]:=a;
            fi;

          od;
        else
          erg:= PowerMapOp( tbl, n );
        fi;
        known[n]:= MakeImmutable( erg );
      fi;

      # return the <p>-th power map
      return known[n];
    else
      return PowerMapOp( tbl, n );
    fi;
    end );

InstallMethod( PowerMap,
    "for a character table, and two integers",
    [ IsNearlyCharacterTable, IsInt, IsInt ],
    function( tbl, n, class )
    local known;

    if IsPosInt( n ) and IsSmallIntRep( n ) then
      known:= ComputedPowerMaps( tbl );
      if IsBound( known[n] ) then
        return known[n][ class ];
      fi;
    fi;
    return PowerMapOp( tbl, n, class );
    end );

#############################################################################
##
#M  PowerMapOp( <ordtbl>, <n> ) . . . . . .  for ord. table, and pos. integer
##
InstallMethod( PowerMapOp,
    "for ordinary table with group, and positive integer",
    [ IsOrdinaryTable and HasUnderlyingGroup, IsPosInt ],
    function( tbl, n )
    local G, map, p;

    if n = 1 then

      map:= [ 1 .. NrConjugacyClasses( tbl ) ];

    elif IsPrimeInt( n ) then

      G:= UnderlyingGroup( tbl );
      map:= PowerMapOfGroup( G, n, ConjugacyClasses( tbl ) );

    else

      map:= [ 1 .. NrConjugacyClasses( tbl ) ];
      for p in Factors( n ) do
        map:= map{ PowerMap( tbl, p ) };
      od;

    fi;
    return map;
    end );

#############################################################################
##
#M  PowerMapOp( <ordtbl>, <n> ) . . . . . .  for ord. table, and pos. integer
##
InstallMethod( PowerMapOp,
    "for ordinary table, and positive integer",
    [ IsOrdinaryTable, IsPosInt ],
    function( tbl, n )
    local i, powermap, nth_powermap, pmap;

    nth_powermap:= [ 1 .. NrConjugacyClasses( tbl ) ];
    if n = 1 then
      return nth_powermap;
    elif HasUnderlyingGroup( tbl ) then
      TryNextMethod();
    fi;

    powermap:= ComputedPowerMaps( tbl );

    for i in Factors( n ) do
      if IsSmallIntRep( i ) and IsBound( powermap[i] ) then
        nth_powermap:= nth_powermap{ powermap[i] };
      else

        # Compute the missing power map.
        pmap:= PossiblePowerMaps( tbl, i, rec( quick := true ) );
        if Length( pmap ) <> 1 then
          return fail;
        elif IsSmallIntRep( i ) then
          powermap[i]:= MakeImmutable( pmap[1] );
        fi;
        nth_powermap:= nth_powermap{ pmap[1] };
      fi;
    od;

    # Return the map;
    return nth_powermap;
    end );

#############################################################################
##
#M  PowerMapOp( <ordtbl>, <n>, <class> )
##
InstallOtherMethod( PowerMapOp,
    "for ordinary table, integer, positive integer",
    [ IsOrdinaryTable, IsInt, IsPosInt ],
    function( tbl, n, class )
    local i, powermap, image;

    powermap:= ComputedPowerMaps( tbl );
    if n = 1 then
      return class;
    elif 0 < n and IsSmallIntRep( n ) and IsBound( powermap[n] ) then
      return powermap[n][ class ];
    fi;

    n:= n mod OrdersClassRepresentatives( tbl )[ class ];
    if n = 0 then
      return 1;
    elif n = 1 then
      return class;
    elif IsSmallIntRep( n ) and IsBound( powermap[n] ) then
      return powermap[n][ class ];
    fi;

    image:= class;
    for i in Factors(Integers, n ) do
      # Here we use that `i' is a small integer.
      if not IsBound( powermap[i] ) then

        # Compute the missing power map.
        powermap[i]:= MakeImmutable( PowerMap( tbl, i ) );
#T if the group is available, better ask it directly?
#T (careful: No maps are stored by the three-argument call,
#T this may slow down the computation if many calls are done ...)

      fi;
      image:= powermap[i][ image ];
    od;
    return image;
    end );

#############################################################################
##
#M  PowerMapOp( <tbl>, <n> )
##
InstallMethod( PowerMapOp,
    "for character table and negative integer",
    [ IsCharacterTable, IsInt and IsNegRat ],
    function( tbl, n )
    return PowerMap( tbl, -n ){ InverseClasses( tbl ) };
    end );

#############################################################################
##
#M  PowerMapOp( <tbl>, <zero> )
##
InstallMethod( PowerMapOp,
    "for character table and zero",
    [ IsCharacterTable, IsZeroCyc ],
    function( tbl, zero )
    return ListWithIdenticalEntries( NrConjugacyClasses( tbl ), 1 );
    end );

#############################################################################
##
#M  PowerMapOp( <modtbl>, <n> )
##
InstallMethod( PowerMapOp,
    "for Brauer table and integer",
    [ IsBrauerTable, IsInt ],
    function( tbl, n )
    local fus, ordtbl;

    ordtbl:= OrdinaryCharacterTable( tbl );
    fus:= GetFusionMap( tbl, ordtbl );
    return InverseMap( fus ){ PowerMap( ordtbl, n ){ fus } };
    end );

#############################################################################
##
#M  PowerMapOp( <modtbl>, <n>, <class> )
##
InstallOtherMethod( PowerMapOp,
    "for Brauer table, integer, positive integer",
    [ IsBrauerTable, IsInt, IsPosInt ],
    function( tbl, n, class )
    local fus, ordtbl;

    if 0 < n and IsBound( ComputedPowerMaps( tbl )[n] ) then
      return ComputedPowerMaps( tbl )[n][ class ];
    fi;
    ordtbl:= OrdinaryCharacterTable( tbl );
    fus:= GetFusionMap( tbl, ordtbl );
    return Position( fus, PowerMap( ordtbl, n, fus[ class ] ) );
    end );

#############################################################################
##
#M  ComputedPowerMaps( <tbl> )  . . . . . . . .  for a nearly character table
##
InstallMethod( ComputedPowerMaps,
    "for a nearly character table",
    [ IsNearlyCharacterTable ],
    tbl -> [] );

#############################################################################
##
#M  PossiblePowerMaps( <ordtbl>, <prime> )
##
InstallMethod( PossiblePowerMaps,
    "for an ordinary character table and a prime (add empty options record)",
    [ IsOrdinaryTable, IsPosInt ],
    function( ordtbl, prime )
    return PossiblePowerMaps( ordtbl, prime, rec() );
    end );

#############################################################################
##
#M  PossiblePowerMaps( <ordtbl>, <prime>, <parameters> )
##
InstallMethod( PossiblePowerMaps,
    "for an ordinary character table, a prime, and a record",
    [ IsOrdinaryTable, IsPosInt, IsRecord ],
    function( ordtbl, prime, arec )
    local chars,          # list of characters to be used
          decompose,      # boolean: is decomposition of characters allowed?
          useorders,      # boolean: use element orders information?
          approxpowermap, # known approximation of the power map
          quick,          # boolean: immediately return if the map is unique?
          maxamb,         # entry in parameters record
          minamb,         # entry in parameters record
          maxlen,         # entry in parameters record
          powermap,       # parametrized map of possibilities
          ok,             # intermediate result of `MeetMaps'
          poss,           # list of possible maps
          rat,            # rationalized characters
          pow;            # loop over possibilities found up to now

    # Check the arguments.
    if not IsPrimeInt( prime ) then
      Error( "<prime> must be a prime" );
    fi;

    # Evaluate the parameters.
    if IsBound( arec.chars ) then
      chars:= arec.chars;
      decompose:= false;
    elif HasIrr( ordtbl ) then
      chars:= Irr( ordtbl );
      decompose:= true;
    else
      chars:= [];
      decompose:= false;
    fi;

    # Override `decompose' if it is explicitly set.
    if IsBound( arec.decompose ) then
      decompose:= arec.decompose;
    fi;

    if IsBound( arec.useorders ) then
      useorders:= arec.useorders;
    else
      useorders:= true;
    fi;

    if IsBound( arec.powermap ) then
      approxpowermap:= arec.powermap;
    else
      approxpowermap:= [];
    fi;

    quick:= IsBound( arec.quick ) and ( arec.quick = true );

    if IsBound( arec.parameters ) then
      maxamb:= arec.parameters.maxamb;
      minamb:= arec.parameters.minamb;
      maxlen:= arec.parameters.maxlen;
    else
      maxamb:= 100000;
      minamb:= 10000;
      maxlen:= 10;
    fi;

    # Initialize the parametrized map.
    powermap:= InitPowerMap( ordtbl, prime, useorders );
    if powermap = fail then
      Info( InfoCharacterTable, 2,
            "PossiblePowerMaps: no initialization possible" );
      return [];
    fi;

    # Use the known approximation `approxpowermap',
    # and check the other local conditions.
    ok:= MeetMaps( powermap, approxpowermap );
    if   ok <> true then
      Info( InfoCharacterTable, 2,
            "PossiblePowerMaps: incompatibility with ",
                      "<approxpowermap> at class ", ok );
      return [];
    elif not Congruences( ordtbl, chars, powermap, prime, quick ) then
      Info( InfoCharacterTable, 2,
            "PossiblePowerMaps: errors in Congruences" );
      return [];
    elif not ConsiderKernels( ordtbl, chars, powermap, prime, quick ) then
      Info( InfoCharacterTable, 2,
            "PossiblePowerMaps: errors in ConsiderKernels" );
      return [];
    elif not ConsiderSmallerPowerMaps( ordtbl, powermap, prime, quick ) then
      Info( InfoCharacterTable, 2,
            "PossiblePowerMaps: errors in ConsiderSmallerPowerMaps" );
      return [];
    fi;

    Info( InfoCharacterTable, 2,
          "PossiblePowerMaps: ", Ordinal( prime ),
          " power map initialized; congruences, kernels and\n",
          "#I    maps for smaller primes considered,\n",
          "#I    ", IndeterminatenessInfo( powermap ) );
    if quick then
      Info( InfoCharacterTable, 2,
            "  (\"quick\" option specified)" );
    fi;

    if quick and ForAll( powermap, IsInt ) then
      return [ powermap ];
    fi;

    # Now use restricted characters.
    # If decomposition of characters is allowed then
    # use decompositions of minus-characters of `chars' into `chars'.

    if decompose then

      if Indeterminateness( powermap ) < minamb then

        Info( InfoCharacterTable, 2,
              "PossiblePowerMaps: indeterminateness too small for test",
              " of decomposability" );
        poss:= [ powermap ];

      else

        Info( InfoCharacterTable, 2,
              "PossiblePowerMaps: now test decomposability of rational ",
              "minus-characters" );
        rat:= RationalizedMat( chars );

        poss:= PowerMapsAllowedBySymmetrizations( ordtbl, rat, rat, powermap,
                             prime, rec( maxlen    := maxlen,
                                         contained := ContainedCharacters,
                                         minamb    := minamb,
                                         maxamb    := infinity,
                                         quick     := quick ) );

        Info( InfoCharacterTable, 2,
              "PossiblePowerMaps: decomposability tested,\n",
              "#I    ", Length( poss ),
              " solution(s) with indeterminateness\n",
              List( poss, Indeterminateness ) );

        if quick and Length( poss ) = 1 and ForAll( poss[1], IsInt ) then
          return [ poss[1] ];
        fi;

      fi;

    else

      Info( InfoCharacterTable, 2,
            "PossiblePowerMaps: no test of decomposability allowed" );
      poss:= [ powermap ];

    fi;

    # Check the scalar products of minus-characters of `chars' with `chars'.
    Info( InfoCharacterTable, 2,
          "PossiblePowerMaps: test scalar products",
          " of minus-characters" );

    powermap:= [];
    for pow in poss do
      Append( powermap,
              PowerMapsAllowedBySymmetrizations( ordtbl, chars, chars, pow,
                       prime, rec( maxlen:= maxlen,
                                   contained:= ContainedPossibleCharacters,
                                   minamb:= 1,
                                   maxamb:= maxamb,
                                   quick:= quick ) ) );
    od;

    # Give a final message about the result.
    if 2 <= InfoLevel( InfoCharacterTable ) then
      if ForAny( powermap, x -> ForAny( x, IsList ) ) then
        Info( InfoCharacterTable, 2,
              "PossiblePowerMaps: ", Length(powermap),
              " parametrized solution(s),\n",
              "#I    no further improvement was possible with given",
              " characters\n",
              "#I    and maximal checked ambiguity of ", maxamb );
      else
        Info( InfoCharacterTable, 2,
              "PossiblePowerMaps: ", Length( powermap ), " solution(s)" );
      fi;
    fi;

    # Return the result.
    return powermap;
    end );

#############################################################################
##
#M  PossiblePowerMaps( <modtbl>, <prime> )
##
InstallOtherMethod( PossiblePowerMaps,
    "for a Brauer character table and a prime",
    [ IsBrauerTable, IsPosInt ],
    function( modtbl, prime )
    local ordtbl, poss, fus, inv;
    ordtbl:= OrdinaryCharacterTable( modtbl );
    if IsBound( ComputedPowerMaps( ordtbl )[ prime ] ) then
      poss:= [ ComputedPowerMaps( ordtbl )[ prime ] ];
    else
      poss:= PossiblePowerMaps( ordtbl, prime, rec() );
    fi;
    fus:= GetFusionMap( modtbl, ordtbl );
    inv:= InverseMap( fus );
    return Set( poss,
             x -> CompositionMaps( inv, CompositionMaps( x, fus ) ) );
    end );

#############################################################################
##
#M  PossiblePowerMaps( <modtbl>, <prime>, <parameters> )
##
InstallMethod( PossiblePowerMaps,
    "for a Brauer character table, a prime, and a record",
    [ IsBrauerTable, IsPosInt, IsRecord ],
    function( modtbl, prime, arec )
    local ordtbl, poss, fus, inv, quick, decompose;
    ordtbl:= OrdinaryCharacterTable( modtbl );
    if IsBound( ComputedPowerMaps( ordtbl )[ prime ] ) then
      poss:= [ ComputedPowerMaps( ordtbl )[ prime ] ];
    else
      quick:= IsBound( arec.quick ) and ( arec.quick = true );
      decompose:= IsBound( arec.decompose ) and ( arec.decompose = true );
      if IsBound( arec.parameters ) then
        poss:= PossiblePowerMaps( ordtbl, prime,
               rec( quick      := quick,
                    decompose  := decompose,
                    parameters := rec( maxamb:= arec.parameters.maxamb,
                                       minamb:= arec.parameters.minamb,
                                       maxlen:= arec.parameters.maxlen ) ) );
      else
        poss:= PossiblePowerMaps( ordtbl, prime,
               rec( quick      := quick,
                    decompose  := decompose ) );
      fi;
    fi;
    fus:= GetFusionMap( modtbl, ordtbl );
    inv:= InverseMap( fus );
    return Set( poss,
             x -> CompositionMaps( inv, CompositionMaps( x, fus ) ) );
    end );

#############################################################################
##
#F  ElementOrdersPowerMap( <powermap> )
##
InstallGlobalFunction( ElementOrdersPowerMap, function( powermap )
    local i, primes, elementorders, nccl, bound, newbound, map, pos;

    if IsEmpty( powermap ) then
      Error( "<powermap> must be nonempty" );
    fi;

    primes:= Filtered( [ 1 .. Length( powermap ) ],
                       x -> IsBound( powermap[x] ) );
    nccl:= Length( powermap[ primes[1] ] );

    if 2 <= InfoLevel( InfoCharacterTable ) then
      for i in primes do
        if ForAny( powermap[i], IsList ) then
          Print( "#I  ElementOrdersPowerMap: ", Ordinal( i ),
                 " power map not unique at classes\n",
                 "#I  ", Filtered( [ 1 .. nccl ],
                                  x -> IsList( powermap[i][x] ) ),
                 " (ignoring these entries)\n" );
        fi;
      od;
    fi;

    elementorders:= [ 1 ];
    bound:= [ 1 ];

    while bound <> [] do
      newbound:= [];
      for i in primes do
        map:= powermap[i];
        for pos in [ 1 .. nccl ] do
          if IsInt( map[ pos ] ) and map[ pos ] in bound
             and IsBound( elementorders[ map[ pos ] ] )
             and not IsBound( elementorders[ pos ] ) then
            elementorders[ pos ]:= i * elementorders[ map[ pos ] ];
            AddSet( newbound, pos );
          fi;
        od;
      od;
      bound:= newbound;
    od;
    for i in [ 1 .. nccl ] do
      if not IsBound( elementorders[i] ) then
        elementorders[i]:= Unknown();
      fi;
    od;
    if     2 <= InfoLevel( InfoCharacterTable )
       and ForAny( elementorders, IsUnknown ) then
      Print( "#I  ElementOrdersPowerMap: element orders not determined for",
             " classes in\n",
             "#I  ", Filtered( [ 1 .. nccl ],
                              x -> IsUnknown( elementorders[x] ) ), "\n" );
    fi;
    return elementorders;
end );

#############################################################################
##
#F  PowerMapByComposition( <tbl>, <n> ) . .  for char. table and pos. integer
##
InstallGlobalFunction( PowerMapByComposition, function( tbl, n )

    local powermap, nth_powermap, i;

    if not IsInt( n ) then
      Error( "<n> must be an integer" );
    fi;
    powermap:= ComputedPowerMaps( tbl );

    if IsPosInt( n ) then
      nth_powermap:= [ 1 .. NrConjugacyClasses( tbl ) ];
    else
      nth_powermap:= InverseClasses( tbl );
      n:= -n;
    fi;

    for i in Factors( n ) do
      if not IsBound( powermap[i] ) then
        return fail;
      fi;
      nth_powermap:= nth_powermap{ powermap[i] };
    od;

    # Return the map;
    return nth_powermap;
end );

#############################################################################
##
#F  OrbitPowerMaps( <powermap>, <matautomorphisms> )
##
InstallGlobalFunction( OrbitPowerMaps, function( powermap, matautomorphisms )

    local nccl, orb, gen, image;

    nccl:= Length( powermap );
    orb:= [ powermap ];
    for powermap in orb do
      for gen in GeneratorsOfGroup( matautomorphisms ) do
        image:= List( [ 1 .. nccl ], x -> powermap[ x^gen ] / gen );
        if not image in orb then Add( orb, image ); fi;
      od;
    od;
    return orb;
end );

#############################################################################
##
#F  RepresentativesPowerMaps( <listofpowermaps>, <matautomorphisms> )
##
##  returns a list of representatives of powermaps in the list
##  <listofpowermaps> under the action of the maximal admissible subgroup
##  of the matrix automorphisms <matautomorphisms> of the considered
##  character matrix.
##  The matrix automorphisms must be a permutation group.
##
InstallGlobalFunction( RepresentativesPowerMaps,
    function( listofpowermaps, matautomorphisms )

    local nccl, stable, gens, orbits, orbit;

    if IsEmpty( listofpowermaps ) then
      return [];
    fi;
    listofpowermaps:= Set( listofpowermaps );

    # Find the subgroup of the table automorphism group that acts on
    # <listofpowermaps>.

    nccl:= Length( listofpowermaps[1] );
    gens:= GeneratorsOfGroup( matautomorphisms );
    stable:= Filtered( gens,
              x -> ForAll( listofpowermaps,
              y -> List( [ 1..nccl ], z -> y[z^x]/x ) in listofpowermaps ) );
    if stable <> gens then
      Info( InfoCharacterTable, 2,
            "RepresentativesPowerMaps: Not all table automorphisms\n",
            "#I    do act; computing the admissible subgroup." );
      matautomorphisms:= SubgroupProperty( matautomorphisms,
          ( x -> ForAll( listofpowermaps,
              y -> List( [ 1..nccl ], z -> y[z^x]/x ) in listofpowermaps ) ),
              GroupByGenerators( stable, () ) );
    fi;

    # Distribute the maps to orbits.

    orbits:= [];
    while not IsEmpty( listofpowermaps ) do
      orbit:= OrbitPowerMaps( listofpowermaps[1], matautomorphisms );
      Add( orbits, orbit );
      SubtractSet( listofpowermaps, orbit );
    od;

    Info( InfoCharacterTable, 2,
          "RepresentativesPowerMaps: ", Length( orbits ),
          " orbit(s) of length(s) ", List( orbits, Length ) );

    # Choose representatives, and return them.
    return List( orbits, x -> x[1] );
end );

#############################################################################
##
##  3. Class Fusions between Character Tables
##

#############################################################################
##
#M  FusionConjugacyClasses( <tbl1>, <tbl2> )  . . . . .  for character tables
#M  FusionConjugacyClasses( <H>, <G> )  . . . . . . . . . . . . .  for groups
#M  FusionConjugacyClasses( <hom> ) . . . . . . . .  for a group homomorphism
#M  FusionConjugacyClasses( <hom>, <tbl1>, <tbl2> )  for a group homomorphism
##
##  We do not store class fusions in groups,
##  the groups delegate to their ordinary character tables.
##
InstallMethod( FusionConjugacyClasses,
    "for two groups",
    IsIdenticalObj,
    [ IsGroup, IsGroup ],
    function( H, G )
    local tbl1, tbl2, fus;

    tbl1:= OrdinaryCharacterTable( H );
    tbl2:= OrdinaryCharacterTable( G );
    fus:= FusionConjugacyClasses( tbl1, tbl2 );

    # Redirect the fusion.
    if fus <> fail then
      fus:= IdentificationOfConjugacyClasses( tbl2 ){
                fus{ InverseMap( IdentificationOfConjugacyClasses(
                    tbl1 ) ) } };
    fi;
    return fus;
    end );

InstallMethod( FusionConjugacyClasses,
    "for a group homomorphism",
    [ IsGeneralMapping ],
    FusionConjugacyClassesOp );

InstallMethod( FusionConjugacyClasses,
    "for a group homomorphism, and two nearly character tables",
    [ IsGeneralMapping, IsNearlyCharacterTable, IsNearlyCharacterTable ],
    FusionConjugacyClassesOp );

InstallMethod( FusionConjugacyClasses,
    "for two nearly character tables",
    [ IsNearlyCharacterTable, IsNearlyCharacterTable ],
    function( tbl1, tbl2 )
    local fus;

    # Check whether the fusion map is stored already.
    fus:= GetFusionMap( tbl1, tbl2 );

    # If not then call the operation.
    if fus = fail then
      fus:= FusionConjugacyClassesOp( tbl1, tbl2 );
      if fus <> fail then
        StoreFusion( tbl1, fus, tbl2 );
      fi;
    fi;

    # Return the fusion map.
    return fus;
    end );

#############################################################################
##
#M  FusionConjugacyClassesOp( <hom> )
##
InstallMethod( FusionConjugacyClassesOp,
    "for a group homomorphism",
    [ IsGeneralMapping ],
    function( hom )
    local Sclasses, Rclasses, nccl, fusion, i, image, j;

    Sclasses:= ConjugacyClasses( PreImagesRange( hom ) );
    Rclasses:= ConjugacyClasses( ImagesSource( hom ) );
    nccl:= Length( Rclasses );

    fusion:= [];
#T use more invariants/class identification!
    for i in [ 1 .. Length( Sclasses ) ] do
      image:= ImagesRepresentative( hom, Representative( Sclasses[i] ) );
      for j in [ 1 .. nccl ] do
        if image in Rclasses[j] then
          fusion[i]:= j;
          break;
        fi;
      od;
    od;

    if Number( fusion ) <> Length( Sclasses ) then
      Info( InfoCharacterTable, 1,
            "class fusion must be defined for all in `Sclasses'" );
      fusion:= fail;
    fi;

    return fusion;
    end );

#############################################################################
##
#M  FusionConjugacyClassesOp( <hom>, <tbl1>, <tbl2> )
##
InstallMethod( FusionConjugacyClassesOp,
    "for a group homomorphism, and two character tables",
    [ IsGeneralMapping, IsOrdinaryTable, IsOrdinaryTable ],
    function( hom, tbl1, tbl2 )
    local Sclasses, Rclasses, nccl, fusion, i, image, j;

    Sclasses:= ConjugacyClasses( tbl1 );
    Rclasses:= ConjugacyClasses( tbl2 );
    nccl:= Length( Rclasses );

    fusion:= [];
#T use more invariants/class identification!
    for i in [ 1 .. Length( Sclasses ) ] do
      image:= ImagesRepresentative( hom, Representative( Sclasses[i] ) );
      for j in [ 1 .. nccl ] do
        if image in Rclasses[j] then
          fusion[i]:= j;
          break;
        fi;
      od;
    od;

    if Number( fusion ) <> Length( Sclasses ) then
      Info( InfoCharacterTable, 1,
            "class fusion must be defined for all in `Sclasses'" );
      fusion:= fail;
    fi;

    return fusion;
    end );

#############################################################################
##
#M  FusionConjugacyClassesOp( <tbl1>, <tbl2> )
##
InstallMethod( FusionConjugacyClassesOp,
    "for two ordinary tables with groups",
    [ IsOrdinaryTable and HasUnderlyingGroup,
      IsOrdinaryTable and HasUnderlyingGroup ],
    function( tbl1, tbl2 )
    local i, k, t, p,  # loop and help variables
          Sclasses,    # conjugacy classes of S
          Rclasses,    # conjugacy classes of R
          fusion,      # the fusion map
          orders;      # list of orders of representatives

    Sclasses:= ConjugacyClasses( tbl1 );
    Rclasses:= ConjugacyClasses( tbl2 );

    # Check that no factor fusion is tried.
    if FamilyObj( Sclasses ) <> FamilyObj( Rclasses ) then
      Error( "group of <tbl1> must be a subgroup of that of <tbl2>" );
    fi;

    fusion:= [];
    orders:= OrdersClassRepresentatives( tbl2 );
#T use more invariants/class identification!
    for i in [ 1 .. Length( Sclasses ) ] do
      k:= Representative( Sclasses[i] );
      t:= Order( k );
      for p in [ 1 .. Length( orders ) ] do
        if t = orders[p] and k in Rclasses[p] then
          fusion[i]:= p;
          break;
        fi;
      od;
    od;

    if Number( fusion ) <> Length( Sclasses ) then
      Info( InfoCharacterTable, 1,
            "class fusion must be defined for all in `Sclasses'" );
      fusion:= fail;
    fi;

    return fusion;
    end );

InstallMethod( FusionConjugacyClassesOp,
    "for two ordinary tables",
    [ IsOrdinaryTable, IsOrdinaryTable ],
    function( tbl1, tbl2 )
    local fusion;

    if   Size( tbl2 ) < Size( tbl1 ) then

      Error( "cannot compute factor fusion from tables" );
#T (at least try, sometimes it is unique ...)

    elif Size( tbl2 ) = Size( tbl1 ) then

      # find a transforming permutation
      fusion:= TransformingPermutationsCharacterTables( tbl1, tbl2 );
      if   fusion = fail then
        return fail;
      elif 1 < Size( fusion.group ) then
        Info( InfoCharacterTable, 1,
              "fusion is not unique" );
        fusion:= fail;

      fi;
      if fusion.columns = () then
        fusion:= [];
      else
        fusion:= OnTuples( [ 1 .. LargestMovedPoint( fusion.columns ) ],
                           fusion.columns );
      fi;

      Append( fusion,
              [ Length( fusion ) + 1 .. NrConjugacyClasses( tbl1 ) ] );

    else

      # find a subgroup fusion
      fusion:= PossibleClassFusions( tbl1, tbl2 );
      if   IsEmpty( fusion ) then
        return fail;
      elif 1 < Length( fusion ) then

        # If both tables know a group then we may use them.
        if HasUnderlyingGroup( tbl1 ) and HasUnderlyingGroup( tbl2 ) then
          TryNextMethod();
        else
          Info( InfoCharacterTable, 1,
                "fusion is not stored and not uniquely determined" );
          return fail;
        fi;

      fi;
      fusion:= fusion[1];

    fi;

    Assert( 2, Number( fusion ) = NrConjugacyClasses( tbl1 ),
            "fusion must be defined for all positions in `Sclasses'" );

    return fusion;
    end );

InstallMethod( FusionConjugacyClassesOp,
    "for two Brauer tables",
    [ IsBrauerTable, IsBrauerTable ],
    function( tbl1, tbl2 )
    local fus, ord1, ord2;

    ord1:= OrdinaryCharacterTable( tbl1 );
    ord2:= OrdinaryCharacterTable( tbl2 );

    if HasUnderlyingGroup( ord1 ) and HasUnderlyingGroup( ord2 ) then

      # If the tables know their groups then compute the unique fusion.
      fus:= FusionConjugacyClasses( ord1, ord2 );
      if fus = fail then
        return fail;
      else
        return InverseMap( GetFusionMap( tbl2, ord2 ) ){
                   fus{ GetFusionMap( tbl1, ord1 ) } };
      fi;

    else

      # Try to find a unique restriction of the possible class fusions.
      fus:= PossibleClassFusions( ord1, ord2 );
      if IsEmpty( fus ) then
        return fail;
      else

        fus:= Set( fus, map -> InverseMap(
                                         GetFusionMap( tbl2, ord2 ) ){
                                     map{ GetFusionMap( tbl1, ord1 ) } } );
        if 1 < Length( fus ) then
          Info( InfoCharacterTable, 1,
                "fusion is not stored and not uniquely determined" );
          return fail;
        fi;
        return fus[1];

      fi;

    fi;
    end );

#############################################################################
##
#M  ComputedClassFusions( <tbl> )
##
##  We do *not* store class fusions in groups,
##  `FusionConjugacyClasses' must store the fusion if the character tables
##  of both groups are known already.
##
InstallMethod( ComputedClassFusions,
    "for a nearly character table",
    [ IsNearlyCharacterTable ],
    tbl -> [] );

#############################################################################
##
#F  GetFusionMap( <source>, <destin>[, <specification>] )
##
InstallGlobalFunction( GetFusionMap, function( arg )
    local source,
          destin,
          specification,
          name,
          fus,
          ordsource,
          orddestin;

    # Check the arguments.
    if not ( 2 <= Length( arg ) and IsNearlyCharacterTable( arg[1] )
                                and IsNearlyCharacterTable( arg[2] ) ) then
      Error( "first two arguments must be nearly character tables" );
    elif 3 < Length( arg ) then
      Error( "usage: GetFusionMap( <source>, <destin>[, <specification>" );
    fi;

    source := arg[1];
    destin := arg[2];

    if Length( arg ) = 3 then
      specification:= arg[3];
    fi;

    # First check whether `source' knows a fusion to `destin' .
    name:= Identifier( destin );
    for fus in ComputedClassFusions( source ) do
      if fus.name = name then
        if IsBound( specification ) then
          if     IsBound( fus.specification )
             and fus.specification = specification then
            if HasClassPermutation( destin ) then
              return OnTuples( fus.map, ClassPermutation( destin ) );
            else
              return ShallowCopy( fus.map );
            fi;
          fi;
        else
          if IsBound( fus.specification ) then
            Info( InfoCharacterTable, 1,
                  "GetFusionMap: Used fusion has specification ",
                  fus.specification );
          fi;
          if HasClassPermutation( destin ) then
            return OnTuples( fus.map, ClassPermutation( destin ) );
          else
            return ShallowCopy( fus.map );
          fi;
        fi;
      fi;
    od;

    # Now check whether the tables are Brauer tables
    # whose ordinary tables know more.
    # (If `destin' is the ordinary table of `source' then
    # the fusion has been found already.)
    # Note that `specification' makes no sense here.
    if IsBrauerTable( source ) and IsBrauerTable( destin ) then
      ordsource:= OrdinaryCharacterTable( source );
      orddestin:= OrdinaryCharacterTable( destin );
      fus:= GetFusionMap( ordsource, orddestin );
      if fus <> fail then
        fus:= InverseMap( GetFusionMap( destin, orddestin ) ){ fus{
                              GetFusionMap( source, ordsource ) } };
        StoreFusion( source, fus, destin );
        return fus;
      fi;
    fi;

    # No fusion map was found.
    return fail;
end );

#############################################################################
##
#F  StoreFusion( <source>, <fusion>, <destination> )
#F  StoreFusion( <source>, <fusionmap>, <destination> )
##
InstallGlobalFunction( StoreFusion, function( source, fusion, destination )
    local fus;

    # (compatibility with GAP 3)
    if IsList( destination ) or IsRecord( destination ) then
      StoreFusion( source, destination, fusion );
      return;
    fi;

    # Check the arguments.
    if IsList( fusion ) and ForAll( fusion, IsPosInt ) then
      fusion:= rec( name := Identifier( destination ),
                    map  := Immutable( fusion ) );
    elif IsRecord( fusion ) and IsBound( fusion.map )
                            and ForAll( fusion.map, IsPosInt ) then
      if     IsBound( fusion.name )
         and fusion.name <> Identifier( destination ) then
        Error( "identifier of <destination> must be equal to <fusion>.name" );
      fi;
      fusion      := ShallowCopy( fusion );
      fusion.map  := Immutable( fusion.map );
      fusion.name := Identifier( destination );
    else
      Error( "<fusion> must be a list of pos. integers",
             " or a record containing at least <fusion>.map" );
    fi;

    # Adjust the map to the stored permutation.
    if HasClassPermutation( destination ) then
      fusion.map:= MakeImmutable( OnTuples( fusion.map,
                       Inverse( ClassPermutation( destination ) ) ) );
    fi;

    # Check that different stored fusions into the same table
    # have different specifications.
    for fus in ComputedClassFusions( source ) do
      if fus.name = fusion.name then

        # Do nothing if a known fusion is to be stored.
        if fus.map = fusion.map then
          return;
        fi;

        # Signal an error if two different fusions to the same
        # destination are to be stored, without distinguishing them.
        if    not IsBound( fusion.specification )
           or (     IsBound( fus.specification )
                and fusion.specification = fus.specification ) then
          Error( "fusion to <destination> already stored on <source>;\n",
             " to store another one, assign a different specification",
             " to the new fusion record <fusion>" );
        fi;

      fi;
    od;

    # The fusion is new, add it.
    Add( ComputedClassFusions( source ), Immutable( fusion ) );
    source:= Identifier( source );
    if not source in NamesOfFusionSources( destination ) then
      Add( NamesOfFusionSources( destination ), source );
    fi;
end );

#############################################################################
##
#M  NamesOfFusionSources( <tbl> ) . . . . . . .  for a nearly character table
##
InstallMethod( NamesOfFusionSources,
    "for a nearly character table",
    [ IsNearlyCharacterTable ],
    tbl -> [] );

#############################################################################
##
#F  PossibleClassFusions( <subtbl>, <tbl> )
##
InstallMethod( PossibleClassFusions,
    "for two ordinary character tables",
    [ IsNearlyCharacterTable, IsNearlyCharacterTable ],
    function( subtbl, tbl )
    return PossibleClassFusions( subtbl, tbl,
               rec(
                    quick      := false,
                    parameters := rec(
                                       approxfus:= [],
                                       maxamb:= 200000,
                                       minamb:= 10000,
                                       maxlen:= 10
                                                        ) ) );
         end );

#############################################################################
##
#F  PossibleClassFusions( <subtbl>, <tbl>, <parameters> )
##
#T improvement:
#T use linear characters of subtbl for indirection, without decomposing
##
InstallMethod( PossibleClassFusions,
    "for two ordinary character tables, and a parameters record",
    [ IsNearlyCharacterTable, IsNearlyCharacterTable, IsRecord ],
    function( subtbl, tbl, parameters )
#T support option `no branch' ??
    local maycomputeattributessub,
#T document this parameter!
          subchars,            # known characters of the subgroup
          chars,               # known characters of the supergroup
          decompose,           # decomposition into `chars' allowed?
          quick,               # stop in case of a unique solution
          verify,              # check s.c. also in case of only one orbit
          maxamb,              # parameter, omit characters of higher indet.
          minamb,              # parameter, omit characters of lower indet.
          maxlen,              # parameter, branch only up to this number
          approxfus,           # known part of the fusion
          permchar,            # perm. char. of `subtbl' in `tbl'
          fus,                 # parametrized map repres. the fusions
          flag,                # result of `MeetMaps'
          subtbl_powermap,     # known power maps of `subtbl'
          tbl_powermap,        # known power maps of `tbl'
          p,                   # position in `subtbl_powermap'
          taut,                # table automorphisms of `tbl', or `false'
          grp,                 # admissible subgroup of automorphisms
          imp,                 # list of improvements
          poss,                # list of possible fusions
          subgroupfusions,
          subtaut;

    # May `subtbl' be asked for nonstored attribute values?
    # (Currently `Irr' and `AutomorphismsOfTable' are used.)
    if IsBound( parameters.maycomputeattributessub ) then
      maycomputeattributessub:= parameters.maycomputeattributessub;
    else
      maycomputeattributessub:= IsCharacterTable;
    fi;

    # available characters of `subtbl'
    if IsBound( parameters.subchars ) then
      subchars:= parameters.subchars;
      decompose:= false;
    elif HasIrr( subtbl ) or maycomputeattributessub( subtbl ) then
      subchars:= Irr( subtbl );
      decompose:= true;
#T possibility to have subchars and incomplete tables ???
    else
      subchars:= [];
      decompose:= false;
    fi;

    # available characters of `tbl'
    if IsBound( parameters.chars ) then
      chars:= parameters.chars;
    elif HasIrr( tbl ) or IsOrdinaryTable( tbl ) then
      chars:= Irr( tbl );
    else
      chars:= [];
    fi;

    # parameters `quick' and `verify'
    quick:= IsBound( parameters.quick ) and parameters.quick = true;
    verify:= IsBound( parameters.verify ) and parameters.verify = true;

    # Is `decompose' explicitly allowed or forbidden?
    if IsBound( parameters.decompose ) then
      decompose:= parameters.decompose = true;
    fi;

    if     IsBound( parameters.parameters )
       and IsRecord( parameters.parameters ) then
      maxamb:= parameters.parameters.maxamb;
      minamb:= parameters.parameters.minamb;
      maxlen:= parameters.parameters.maxlen;
    else
      maxamb:= 200000;
      minamb:= 10000;
      maxlen:= 10;
    fi;

    if IsBound( parameters.fusionmap ) then
      approxfus:= parameters.fusionmap;
    else
      approxfus:= [];
    fi;

    if IsBound( parameters.permchar ) then
      permchar:= parameters.permchar;
      if Length( permchar ) <> NrConjugacyClasses( tbl ) then
        Error( "length of <permchar> must be the no. of classes of <tbl>" );
      fi;
    else
      permchar:= [];
    fi;
    # (end of the inspection of the parameters)

    # Initialize the fusion.
    fus:= InitFusion( subtbl, tbl );
    if fus = fail then
      Info( InfoCharacterTable, 2,
            "PossibleClassFusions: no initialisation possible" );
      return [];
    fi;
    Info( InfoCharacterTable, 2,
          "PossibleClassFusions: fusion initialized" );

    # Use `approxfus'.
    flag:= MeetMaps( fus, approxfus );
    if flag <> true then
      Info( InfoCharacterTable, 2,
            "PossibleClassFusions: possible maps not compatible with ",
            "<approxfus> at class ", flag );
      return [];
    fi;

    # Use the permutation character for the first time.
    if not IsEmpty( permchar ) then
      if not CheckPermChar( subtbl, tbl, fus, permchar ) then
        Info( InfoCharacterTable, 2,
              "PossibleClassFusions: fusion inconsistent with perm.char." );
        return [];
      fi;
      Info( InfoCharacterTable, 2,
            "PossibleClassFusions: permutation character checked");
    fi;

    # Check consistency of fusion and power maps.
    # (If necessary then compute power maps of `subtbl' that are available
    # in `tbl'.)
    subtbl_powermap := ComputedPowerMaps( subtbl );
    tbl_powermap    := ComputedPowerMaps( tbl );
    if IsOrdinaryTable( subtbl ) and HasIrr( subtbl ) then
      for p in [ 1 .. Length( tbl_powermap ) ] do
        if IsBound( tbl_powermap[p] )
           and not IsBound( subtbl_powermap[p] ) then
          PowerMap( subtbl, p );
        fi;
      od;
    fi;
    if not TestConsistencyMaps( subtbl_powermap, fus, tbl_powermap ) then
      Info( InfoCharacterTable, 2,
            "PossibleClassFusions: inconsistency of fusion and power maps" );
      return [];
    fi;
    Info( InfoCharacterTable, 2,
          "PossibleClassFusions: consistency with power maps checked,\n",
          "#I    ", IndeterminatenessInfo( fus ) );

    # May we return?
    if quick and ForAll( fus, IsInt ) then return [ fus ]; fi;

    # Consider table automorphisms of the supergroup.
    if   HasAutomorphismsOfTable( tbl ) or IsCharacterTable( tbl ) then
      taut:= AutomorphismsOfTable( tbl );
    else
      taut:= false;
      Info( InfoCharacterTable, 2,
            "PossibleClassFusions: no table automorphisms stored" );
    fi;

    if taut <> false then
      imp:= ConsiderTableAutomorphisms( fus, taut );
      if IsEmpty( imp ) then
        Info( InfoCharacterTable, 2,
              "PossibleClassFusions: table automorphisms checked, ",
              "no improvements" );
      else
        Info( InfoCharacterTable, 2,
              "PossibleClassFusions: table automorphisms checked, ",
              "improvements at classes\n",
              "#I   ", imp );
        if not TestConsistencyMaps( ComputedPowerMaps( subtbl ),
                                    fus,
                                    ComputedPowerMaps( tbl ),
                                    imp ) then
          Info( InfoCharacterTable, 2,
                "PossibleClassFusions: inconsistency of fusion ",
                "and power maps" );
          return [];
        fi;
        Info( InfoCharacterTable, 2,
              "PossibleClassFusions: consistency with power maps ",
              "checked again,\n",
              "#I    ", IndeterminatenessInfo( fus ) );
      fi;
    fi;

    # Use the permutation character for the second time.
    if not IsEmpty( permchar ) then
      if not CheckPermChar( subtbl, tbl, fus, permchar ) then
        Info( InfoCharacterTable, 2,
              "PossibleClassFusions: inconsistency of fusion and permchar" );
        return [];
      fi;
      Info( InfoCharacterTable, 2,
            "PossibleClassFusions: permutation character checked again");
    fi;

    if quick and ForAll( fus, IsInt ) then return [ fus ]; fi;

    # Now use restricted characters.
    # If `decompose' is `true', use decompositions of
    # indirections of <chars> into <subchars>;
    # otherwise only check the scalar products with <subchars>.

    if decompose then

      if Indeterminateness( fus ) < minamb then
        Info( InfoCharacterTable, 2,
              "PossibleClassFusions: indeterminateness too small for test\n",
              "#I    of decomposability" );
        poss:= [ fus ];
      elif IsEmpty( chars ) then
        Info( InfoCharacterTable, 2,
              "PossibleClassFusions: no characters given for test ",
              "of decomposability" );
        poss:= [ fus ];
      else
        Info( InfoCharacterTable, 2,
              "PossibleClassFusions: now test decomposability of",
              " rational restrictions" );
        poss:= FusionsAllowedByRestrictions( subtbl, tbl,
                      RationalizedMat( subchars ),
                      RationalizedMat( chars ), fus,
                      rec( maxlen    := maxlen,
                           contained := ContainedCharacters,
                           minamb    := minamb,
                           maxamb    := infinity,
                           quick     := quick ) );

        poss:= Filtered( poss, x ->
                  TestConsistencyMaps( subtbl_powermap, x, tbl_powermap ) );
#T dangerous if power maps are not unique!

        # Use the permutation character for the third time.
        if not IsEmpty( permchar ) then
          poss:= Filtered( poss, x -> CheckPermChar(subtbl,tbl,x,permchar) );
        fi;

        Info( InfoCharacterTable, 2,
              "PossibleClassFusions: decomposability tested,\n",
              "#I    ", Length( poss ),
              " solution(s) with indeterminateness\n",
              "#I    ", List( poss, Indeterminateness ) );

      fi;

    else

      Info( InfoCharacterTable, 2,
            "PossibleClassFusions: no test of decomposability" );
      poss:= [ fus ];

    fi;

    Info( InfoCharacterTable, 2,
          "PossibleClassFusions: test scalar products of restrictions" );

    subgroupfusions:= [];
    for fus in poss do
      Append( subgroupfusions,
              FusionsAllowedByRestrictions( subtbl, tbl, subchars, chars,
                        fus, rec( maxlen:= maxlen,
                                  contained:= ContainedPossibleCharacters,
                                  minamb:= 1,
                                  maxamb:= maxamb,
                                  quick:= quick ) ) );
    od;

    # Check the consistency with power maps again.
    subgroupfusions:= Filtered( subgroupfusions, x ->
                  TestConsistencyMaps( subtbl_powermap, x, tbl_powermap ) );
#T dangerous if power maps are not unique!
    if Length( subgroupfusions ) = 0 then
      return subgroupfusions;
    elif quick and Length( subgroupfusions ) = 1
               and ForAll( subgroupfusions[1], IsInt ) then
      return subgroupfusions;
    fi;

    subtaut:= GroupByGenerators( [], () );
    if 1 < Length( subgroupfusions ) then
      if    HasAutomorphismsOfTable( subtbl )
         or maycomputeattributessub( subtbl ) then
        subtaut:= AutomorphismsOfTable( subtbl );
      fi;
      subgroupfusions:= RepresentativesFusions( subtaut, subgroupfusions,
                            Group( () ) );
    fi;

    if verify or 1 < Length( subgroupfusions ) then

      # Use the structure constants criterion.
      # (Since table automorphisms preserve structure constants,
      # it is sufficient to check representatives only.)
      Info( InfoCharacterTable, 2,
            "PossibleClassFusions: test structure constants" );
      subgroupfusions:=
          ConsiderStructureConstants( subtbl, tbl, subgroupfusions, quick );

    fi;

    # Make orbits under the admissible subgroup of `taut'
    # to get the whole set of all subgroup fusions,
    # where admissible means that if there was an approximation `fusionmap'
    # in the argument record, this map must be respected;
    # if the permutation character `permchar' was entered then it must be
    # respected, too.

    if taut <> false then
      if IsEmpty( permchar ) then
        grp:= taut;
      else

        # Use the permutation character for the fourth time.
        grp:= SubgroupProperty( taut,
                  x -> ForAll( [1 .. Length( permchar ) ],
                               y -> permchar[y] = permchar[y^x] ) );
      fi;
      subgroupfusions:= Set( Concatenation( List( subgroupfusions,
          x -> OrbitFusions( subtaut, x, grp ) ) ) );
    fi;

    if not IsEmpty( approxfus ) then
      subgroupfusions:= Filtered( subgroupfusions,
          x -> ForAll( [ 1 .. Length( approxfus ) ],
                 y -> not IsBound( approxfus[y] )
                       or ( IsInt(approxfus[y]) and x[y] = approxfus[y] )
                       or ( IsList(approxfus[y]) and IsInt( x[y] )
                            and x[y] in approxfus[y] )
                       or ( IsList(approxfus[y]) and IsList( x[y] )
                            and IsSubset( approxfus[y], x[y] ) )));
    fi;

    # Print some messages about the orbit distribution.
    if 2 <= InfoLevel( InfoCharacterTable ) then

      # If possible make orbits under the groups of table automorphisms.
      if     1 < Length( subgroupfusions )
         and ForAll( subgroupfusions, x -> ForAll( x, IsInt ) ) then

        if taut = false then
          taut:= GroupByGenerators( [], () );
        fi;
        RepresentativesFusions( subtaut, subgroupfusions, taut );

      fi;

      # Print the messages.
      if ForAny( subgroupfusions, x -> ForAny( x, IsList ) ) then
        Print( "#I  PossibleClassFusions: ", Length( subgroupfusions ),
               " parametrized solution" );
        if Length( subgroupfusions ) = 1 then
          Print( ",\n" );
        else
          Print( "s,\n" );
        fi;
        Print( "#I    no further improvement was possible with",
               " given characters\n",
               "#I    and maximal checked ambiguity of ", maxamb, "\n" );
      else
        Print( "#I  PossibleClassFusions: ", Length( subgroupfusions ),
               " solution" );
        if Length( subgroupfusions ) = 1 then
          Print( "\n" );
        else
          Print( "s\n" );
        fi;
      fi;

    fi;

    # Return the list of possibilities.
    return subgroupfusions;
    end );

#############################################################################
##
#F  PossibleClassFusions( <submodtbl>, <modtbl> )
##
InstallMethod( PossibleClassFusions,
    "for two Brauer tables",
    [ IsBrauerTable, IsBrauerTable ],
    function( submodtbl, modtbl )
    local ordsub, ordtbl, fus, invGfus, Hfus;

    ordsub:= OrdinaryCharacterTable( submodtbl );
    ordtbl:= OrdinaryCharacterTable( modtbl );
    fus:= PossibleClassFusions( ordsub, ordtbl );

    if not IsEmpty( fus ) then
      invGfus:= InverseMap( GetFusionMap( modtbl, ordtbl ) );
      Hfus:= GetFusionMap( submodtbl, ordsub );
      fus:= Set( List( fus ),
                 map -> CompositionMaps( invGfus,
                            CompositionMaps( map, Hfus ) ) );
    fi;

    return fus;
    end );

#############################################################################
##
#F  OrbitFusions( <subtblautomorphisms>, <fusionmap>, <tblautomorphisms> )
##
InstallGlobalFunction( OrbitFusions,
    function( subtblautomorphisms, fusionmap, tblautomorphisms )
    local i, orb, gen, image;

    orb:= [ fusionmap ];
    subtblautomorphisms:= GeneratorsOfGroup( subtblautomorphisms );
    tblautomorphisms:= GeneratorsOfGroup( tblautomorphisms );
    for fusionmap in orb do
      for gen in subtblautomorphisms do
        image:= Permuted( fusionmap, gen );
        if not image in orb then
          Add( orb, image );
        fi;
      od;
    od;
    for fusionmap in orb do
      for gen in tblautomorphisms do
        image:= [];
        for i in fusionmap do
          if IsInt( i ) then
            Add( image, i^gen );
          else
            Add( image, Set( OnTuples( i, gen ) ) );
          fi;
        od;
        if not image in orb then
          Add( orb, image );
        fi;
      od;
    od;
#T is slow if the orbit is long;
#T better use `Orbit', but with which group?
    return orb;
end );

#############################################################################
##
#F  RepresentativesFusions( <subtblautomorphisms>, <listoffusionmaps>,
#F                          <tblautomorphisms> )
#F  RepresentativesFusions( <subtbl>, <listoffusionmaps>, <tbl> )
##
InstallGlobalFunction( RepresentativesFusions,
    function( subtblautomorphisms, listoffusionmaps, tblautomorphisms )
    local stable, gens, orbits, orbit;

    if IsEmpty( listoffusionmaps ) then
      return [];
    fi;
    listoffusionmaps:= Set( listoffusionmaps );
    if IsNearlyCharacterTable( subtblautomorphisms ) then

      if    HasAutomorphismsOfTable( subtblautomorphisms )
         or IsCharacterTable( subtblautomorphisms ) then
        subtblautomorphisms:= AutomorphismsOfTable( subtblautomorphisms );
      else
        subtblautomorphisms:= GroupByGenerators( [], () );
        Info( InfoCharacterTable, 2,
              "RepresentativesFusions: no subtable automorphisms stored" );
      fi;

    fi;

    if IsNearlyCharacterTable( tblautomorphisms ) then

      if    HasAutomorphismsOfTable( tblautomorphisms )
         or IsCharacterTable( tblautomorphisms ) then
        tblautomorphisms:= AutomorphismsOfTable( tblautomorphisms );
      else
        tblautomorphisms:= GroupByGenerators( [], () );
        Info( InfoCharacterTable, 2,
              "RepresentativesFusions: no table automorphisms stored" );
      fi;

    fi;

    # Find the subgroups of all those table automorphisms that act on
    # <listoffusionmaps>.
    gens:= GeneratorsOfGroup( subtblautomorphisms );
    stable:= Filtered( gens,
                 x -> ForAll( listoffusionmaps,
                              y -> Permuted( y, x ) in listoffusionmaps ) );
    if stable <> gens then
      Info( InfoCharacterTable, 2,
            "RepresentativesFusions: Not all table automorphisms of the\n",
            "#I    subgroup table act; computing the admiss. subgroup." );
      subtblautomorphisms:= SubgroupProperty( subtblautomorphisms,
             ( x -> ForAll( listoffusionmaps,
                            y -> Permuted( y, x ) in listoffusionmaps ) ),
             GroupByGenerators( stable, () ) );
    fi;

    gens:= GeneratorsOfGroup( tblautomorphisms );
    stable:= Filtered( gens,
                 x -> ForAll( listoffusionmaps,
                              y -> List( y, z->z^x ) in listoffusionmaps ) );
    if stable <> gens then
      Info( InfoCharacterTable, 2,
            "RepresentativesFusions: Not all table automorphisms of the\n",
            "#I    supergroup table act; computing the admiss. subgroup." );
      tblautomorphisms:= SubgroupProperty( tblautomorphisms,
             ( x -> ForAll( listoffusionmaps,
                            y -> List( y, z -> z^x ) in listoffusionmaps ) ),
             GroupByGenerators( stable, () ) );
    fi;

    # Distribute the maps to orbits.
    orbits:= [];
    while not IsEmpty( listoffusionmaps ) do
      orbit:= OrbitFusions( subtblautomorphisms, listoffusionmaps[1],
                            tblautomorphisms );
      Add( orbits, orbit );
      SubtractSet( listoffusionmaps, orbit );
    od;

    Info( InfoCharacterTable, 2,
          "RepresentativesFusions: ", Length( orbits ),
          " orbit(s) of length(s) ", List( orbits, Length ) );

    # Choose representatives, and return them.
    return List( orbits, x -> x[1] );
end );

#############################################################################
##
##  4. Utilities for Parametrized Maps
##

#############################################################################
##
#F  CompositionMaps( <paramap2>, <paramap1>[, <class>] )
##
InstallGlobalFunction( CompositionMaps, function( arg )
    local i, j, map1, map2, class, result, newelement;

    if Length(arg) = 2 and IsList(arg[1]) and IsList(arg[2]) then

      map2:= arg[1];
      map1:= arg[2];
      result:= [];
      for i in [ 1 .. Length( map1 ) ] do
        if IsBound( map1[i] ) then
          result[i]:= CompositionMaps( map2, map1, i );
        fi;
      od;

    elif Length( arg ) = 3
         and IsList( arg[1] ) and IsList( arg[2] ) and IsInt( arg[3] ) then

      map2:= arg[1];
      map1:= arg[2];
      class:= arg[3];
      if IsInt( map1[ class ] ) then
        result:= map2[ map1[ class ] ];
        if IsList( result ) and Length( result ) = 1 then
          result:= result[1];
        fi;
      else
        result:= [];
        for j in map1[ class ] do
          newelement:= map2[j];
          if IsList( newelement ) and not IsString( newelement ) then
            UniteSet( result, newelement );
          else
            AddSet( result, newelement );
          fi;
        od;
        if Length( result ) = 1 then result:= result[1]; fi;
      fi;

    else
      Error(" usage: CompositionMaps( <map2>, <map1>[, <class>] )" );
    fi;

    return result;
end );

#############################################################################
##
#F  InverseMap( <paramap> )  . . . . . . . . .  Inverse of a parametrized map
##
InstallGlobalFunction( InverseMap, function( paramap )
    local i, inversemap, im;
    inversemap:= [];
    for i in [ 1 .. Length( paramap ) ] do
      if IsList( paramap[i] ) then
        for im in paramap[i] do
          if IsBound( inversemap[ im ] ) then
            AddSet( inversemap[ im ], i );
          else
            inversemap[ im ]:= [ i ];
          fi;
        od;
      else
        if IsBound( inversemap[ paramap[i] ] ) then
          AddSet( inversemap[ paramap[i] ], i );
        else
          inversemap[ paramap[i] ]:= [ i ];
        fi;
      fi;
    od;
    for i in [ 1 .. Length( inversemap ) ] do
      if IsBound( inversemap[i] ) and Length( inversemap[i] ) = 1 then
        inversemap[i]:= inversemap[i][1];
      fi;
    od;
    return inversemap;
end );

#############################################################################
##
#F  ProjectionMap( <fusionmap> ) . . projection corresponding to a fusion map
##
InstallGlobalFunction( ProjectionMap, function( fusionmap )
    local i, projection;
    projection:= [];
    for i in Reversed( [ 1 .. Length( fusionmap ) ] ) do
      projection[ fusionmap[i] ]:= i;
    od;
    return projection;
end );

#############################################################################
##
#F  Indirected( <character>, <paramap> )
##
InstallGlobalFunction( Indirected, function( character, paramap )
    local i, imagelist, indirected;
    indirected:= [];
    for i in [ 1 .. Length( paramap ) ] do
      if IsInt( paramap[i] ) then
        indirected[i]:= character[ paramap[i] ];
      else
        imagelist:= Set( character{ paramap[i] } );
        if Length( imagelist ) = 1 then
          indirected[i]:= imagelist[1];
        else
          indirected[i]:= Unknown();
        fi;
      fi;
    od;
    return indirected;
end );

#############################################################################
##
#F  Parametrized( <list> )
##
InstallGlobalFunction( Parametrized, function( list )
    local i, j, parametrized;
    if list = [] then return []; fi;
    parametrized:= [];
    for i in [ 1 .. Length( list[1] ) ] do
      if ( IsList( list[1][i] ) and not IsString( list[1][i] ) )
         or list[1][i] = [] then
        parametrized[i]:= list[1][i];
      else
        parametrized[i]:= [ list[1][i] ];
      fi;
    od;
    for i in [ 2 .. Length( list ) ] do
      for j in [ 1 .. Length( list[i] ) ] do
        if ( IsList( list[i][j] ) and not IsString( list[i][j] ) )
           or list[i][j] = [] then
          UniteSet( parametrized[j], list[i][j] );
        else
          AddSet( parametrized[j], list[i][j] );
        fi;
      od;
    od;
    for i in [ 1 .. Length( list[1] ) ] do
      if Length( parametrized[i] ) = 1 then
        parametrized[i]:= parametrized[i][1];
      fi;
    od;
    return parametrized;
end );

#############################################################################
##
#F  ContainedMaps( <paramap> )
##
InstallGlobalFunction( ContainedMaps, function( paramap )
    local i, j, containedmaps, copy;
    i:= 1;
    while i <= Length( paramap ) and
          ( not IsList( paramap[i] ) or IsString( paramap[i] ) ) do
      i:= i+1;
    od;
    if i > Length( paramap ) then
      return [ StructuralCopy( paramap ) ];
    else
      containedmaps:= [];
      copy:= ShallowCopy( paramap );
      for j in paramap[i] do
        copy[i]:= j;
        Append( containedmaps, ContainedMaps( copy ) );
      od;
      return containedmaps;
    fi;
end );

#############################################################################
##
#F  UpdateMap( <char>, <paramap>, <indirected> )
##
InstallGlobalFunction( UpdateMap, function( char, paramap, indirected )
    local i, j, value, fus;

    for i in [ 1 .. Length( paramap ) ] do
      if IsInt( paramap[i] ) then
        if indirected[i] <> char[ paramap[i] ] then
          Info( InfoCharacterTable, 2,
                "UpdateMap: inconsistency at class ", i );
          return false;
        fi;
      else
        value:= indirected[i];
        if not IsList( value ) then value:= [ value ]; fi;
        fus:= [];
        for j in paramap[i] do
          if char[j] in value then Add( fus, j ); fi;
        od;
        if fus = [] then
          Info( InfoCharacterTable, 2,
                "UpdateMap: inconsistency at class ", i );
          return false;
        else
          if Length( fus ) = 1 then fus:= fus[1]; fi;
          paramap[i]:= fus;
        fi;
      fi;
    od;
    return true;
end );

#############################################################################
##
#F  MeetMaps( <map1>, <map2> )
##
InstallGlobalFunction( MeetMaps, function( map1, map2 )
    local i;      # loop over the classes

    for i in [ 1 .. Maximum( Length( map1 ), Length( map2 ) ) ] do
      if IsBound( map1[i] ) then
        if IsBound( map2[i] ) then

          # This is the only case where we have to work.
          if IsInt( map1[i] ) then
            if IsInt( map2[i] ) then
              if map1[i] <> map2[i] then
                return i;
              fi;
            elif not map1[i] in map2[i] then
              return i;
            fi;
          elif IsInt( map2[i] ) then
            if map2[i] in map1[i] then
              map1[i]:= map2[i];
            else
              return i;
            fi;
          else
            map1[i]:= Intersection( map1[i], map2[i] );
            if map1[i] = [] then
              return i;
            elif Length( map1[i] ) = 1 then
              map1[i]:= map1[i][1];
            fi;
          fi;

        fi;
      elif IsBound( map2[i] ) then
        map1[i]:= map2[i];
      fi;
    od;
    return true;
end );

#############################################################################
##
#F  ImproveMaps( <map2>, <map1>, <composition>, <class> )
##
InstallGlobalFunction( ImproveMaps,
    function( map2, map1, composition, class )
    local j, map1_i, newvalue;

    map1_i:= map1[ class ];
    if IsInt( map1_i ) then

      # case 1: map2[ map1_i ] must be a set,
      #         try to improve map2 at that position
      if composition <> map2[ map1_i ] then
        if Length( composition ) = 1 then
          map2[ map1_i ]:= composition[1];
        else
          map2[ map1_i ]:= composition;
        fi;

        # map2[ map1_i ] was improved
        return map1_i;
      fi;
    else

      # case 2: try to improve map1[ class ]
      newvalue:= [];
      for j in map1_i do
        if ( IsInt( map2[j] ) and map2[j] in composition ) or
           (     IsList( map2[j] )
             and Intersection2( map2[j], composition ) <> [] ) then
          AddSet( newvalue, j );
        fi;
      od;
      if newvalue <> map1_i then
        if Length( newvalue ) = 1 then
          map1[ class ]:= newvalue[1];
        else
          map1[ class ]:= newvalue;
        fi;
        return -1;                  # map1 was improved
      fi;
    fi;
    return 0;                       # no improvement
end );

#############################################################################
##
#F  CommutativeDiagram( <paramap1>, <paramap2>, <paramap3>, <paramap4>[,
#F                      <improvements>] )
##
##    i ---------> map1[i]
##    |              |
##    |              v
##    |          map2[ map1[i] ]
##    v
##  map3[i] ---> map4[ map3[i] ]
##
InstallGlobalFunction( CommutativeDiagram, function( arg )
    local i, paramap1, paramap2, paramap3, paramap4, imp1, imp2, imp4,
--> --------------------

--> maximum size reached

--> --------------------

Quelle ctblmaps.gi Sprache: unbekannt

[ Dauer der Verarbeitung: 0.26 Sekunden (vorverarbeitet) ]