gap-libs 4r7p5-2 / usr / share / gap / lib / ctblfuns.gi

#############################################################################
##
#W  ctblfuns.gi                 GAP library                     Thomas Breuer
##
##
#Y  Copyright (C)  1997,  Lehrstuhl D für Mathematik,  RWTH Aachen,  Germany
#Y  (C) 1998 School Math and Comp. Sci., University of St Andrews, Scotland
#Y  Copyright (C) 2002 The GAP Group
##
##  This file contains generic methods for class functions.
##
##  2. Basic Operations for Class Functions
##  3. Comparison of Class Functions
##  4. Arithmetic Operations for Class Functions
##  5. Printing Class Functions
##  6. Creating Class Functions from Values Lists
##  7. Creating Class Functions using Groups
##  8. Operations for Class Functions
##  9. Restricted and Induced Class Functions
##  10. Reducing Virtual Characters
##  11. Symmetrizations of Class Functions
##  12. Operations for Brauer Characters
##  13. Domains Generated by Class Functions
##  14. Auxiliary operations
##


#############################################################################
##
#F  CharacterString( <char>, <str> )  . . . . .  character information string
##
InstallGlobalFunction( CharacterString, function( char, str )
    str:= Concatenation( str, " of degree ", String( char[1] ) );
    ConvertToStringRep( str );
    return str;
end );


#############################################################################
##
##  2. Basic Operations for Class Functions
##


#############################################################################
##
#M  ValuesOfClassFunction( <list> )
##
##  In order to treat lists as class functions where this makes sense,
##  we define that `ValuesOfClassFunction' returns the list <list> itself.
##
InstallOtherMethod( ValuesOfClassFunction,
    "for a dense list",
    [ IsDenseList ],
    function( list )
    if IsClassFunction( list ) and not HasValuesOfClassFunction( list ) then
      Error( "class function <list> must store its values list" );
    else
      return list;
    fi;
    end );


#############################################################################
##
#M  \[\]( <psi>, <i> )
#M  Length( <psi> )
#M  IsBound\[\]( <psi>, <i> )
#M  Position( <psi>, <obj>, 0 )
##
##  Class functions shall behave as immutable lists,
##  we install methods for `\[\]', `Length', `IsBound\[\]', `Position',
##  and `ShallowCopy'.
##
InstallMethod( \[\],
    "for class function and positive integer",
    [ IsClassFunction, IsPosInt ],
    function( chi, i )
    return ValuesOfClassFunction( chi )[i];
    end );

InstallMethod( Length,
    "for class function",
    [ IsClassFunction ],
    chi -> Length( ValuesOfClassFunction( chi ) ) );

InstallMethod( IsBound\[\],
    "for class function and positive integer",
    [ IsClassFunction, IsPosInt ],
    function( chi, i )
    return IsBound( ValuesOfClassFunction( chi )[i] );
    end );

InstallMethod( Position,
    "for class function, cyclotomic, and nonnegative integer",
    [ IsClassFunction, IsCyc, IsInt ],
    function( chi, obj, pos )
    return Position( ValuesOfClassFunction( chi ), obj, pos );
    end );

InstallMethod( ShallowCopy,
    "for class function",
    [ IsClassFunction ],
    chi -> ShallowCopy( ValuesOfClassFunction( chi ) ) );


#############################################################################
##
#M  UnderlyingGroup( <chi> )
##
InstallOtherMethod( UnderlyingGroup,
    "for a class function",
    [ IsClassFunction ],
    chi -> UnderlyingGroup( UnderlyingCharacterTable( chi ) ) );


#############################################################################
##
##  3. Comparison of Class Functions
##


#############################################################################
##
#M  \=( <chi>, <psi> )  . . . . . . . . . . . . . equality of class functions
##
InstallMethod( \=,
    "for two class functions",
    [ IsClassFunction, IsClassFunction ],
    function( chi, psi )
    return ValuesOfClassFunction( chi ) = ValuesOfClassFunction( psi );
    end );

InstallMethod( \=,
    "for a class function and a list",
    [ IsClassFunction, IsList ],
    function( chi, list )
    if IsClassFunction( list ) then
      return ValuesOfClassFunction( chi ) = ValuesOfClassFunction( list );
    else
      return ValuesOfClassFunction( chi ) = list;
    fi;
    end );

InstallMethod( \=,
    "for a list and a class function",
    [ IsList, IsClassFunction ],
    function( list, chi )
    if IsClassFunction( list ) then
      return ValuesOfClassFunction( list ) = ValuesOfClassFunction( chi );
    else
      return list = ValuesOfClassFunction( chi );
    fi;
    end );


#############################################################################
##
#M  \<( <chi>, <psi> )  . . . . . . . . . . . . comparison of class functions
##
InstallMethod( \<,
    "for two class functions",
    [ IsClassFunction, IsClassFunction ],
    function( chi, psi )
    return ValuesOfClassFunction( chi ) < ValuesOfClassFunction( psi );
    end );

InstallMethod( \<,
    "for a class function and a list",
    [ IsClassFunction, IsList ],
    function( chi, list )
    if IsClassFunction( list ) then
      return ValuesOfClassFunction( chi ) < ValuesOfClassFunction( list );
    else
      return ValuesOfClassFunction( chi ) < list;
    fi;
    end );

InstallMethod( \<,
    "for a list and a class function",
    [ IsClassFunction, IsList ],
    function( list, chi )
    if IsClassFunction( list ) then
      return ValuesOfClassFunction( list ) < ValuesOfClassFunction( chi );
    else
      return list < ValuesOfClassFunction( chi );
    fi;
    end );


#############################################################################
##
##  4. Arithmetic Operations for Class Functions
##


#############################################################################
##
#M  \+( <chi>, <obj> )  . . . . . . . . . .  sum of class function and object
#M  \+( <obj>, <chi> )  . . . . . . . . . .  sum of object and class function
#M  \+( <chi>, <psi> )  . . . . . . . . . . . . . . sum of virtual characters
#M  \+( <chi>, <psi> )  . . . . . . . . . . . . . . . . . . sum of characters
##
##  The sum of two class functions (virtual characters, characters) of the
##  same character table is again a class function (virtual character,
##  character) of this table.
##  In all other cases, the addition is delegated to the list of values of
##  the class function(s).
##
InstallOtherMethod( \+,
    "for class function, and object",
    [ IsClassFunction, IsObject ],
    function( chi, obj )
    local tbl, sum;
    tbl:= UnderlyingCharacterTable( chi );
    if IsClassFunction( obj ) and
       IsIdenticalObj( tbl, UnderlyingCharacterTable( obj ) ) then
      sum:= ClassFunction( tbl,
              ValuesOfClassFunction( chi ) + ValuesOfClassFunction( obj ) );
    else
      sum:= ValuesOfClassFunction( chi ) + obj;
    fi;
    return sum;
    end );

InstallOtherMethod( \+,
    "for object, and class function",
    [ IsObject, IsClassFunction ],
    function( obj, chi )
    local tbl, sum;
    tbl:= UnderlyingCharacterTable( chi );
    if IsClassFunction( obj ) and
       IsIdenticalObj( tbl, UnderlyingCharacterTable( obj ) ) then
      sum:= ClassFunction( tbl,
              ValuesOfClassFunction( obj ) + ValuesOfClassFunction( chi ) );
    else
      sum:= obj + ValuesOfClassFunction( chi );
    fi;
    return sum;
    end );

InstallMethod( \+,
    "for two virtual characters",
    IsIdenticalObj,
    [ IsClassFunction and IsVirtualCharacter,
      IsClassFunction and IsVirtualCharacter ],
    function( chi, psi )
    local tbl, sum;
    tbl:= UnderlyingCharacterTable( chi );
    sum:= ValuesOfClassFunction( chi ) + ValuesOfClassFunction( psi );
    if IsIdenticalObj( tbl, UnderlyingCharacterTable( psi ) ) then
      sum:= VirtualCharacter( tbl, sum );
    fi;
    return sum;
    end );

InstallMethod( \+,
    "for two characters",
    IsIdenticalObj,
    [ IsClassFunction and IsCharacter, IsClassFunction and IsCharacter ],
    function( chi, psi )
    local tbl, sum;
    tbl:= UnderlyingCharacterTable( chi );
    sum:= ValuesOfClassFunction( chi ) + ValuesOfClassFunction( psi );
    if IsIdenticalObj( tbl, UnderlyingCharacterTable( psi ) ) then
      sum:= Character( tbl, sum );
    fi;
    return sum;
    end );


#############################################################################
##
#M  AdditiveInverseOp( <psi> )  . . . . . . . . . . . .  for a class function
##
##  The additive inverse of a virtual character is again a virtual character,
##  but the additive inverse of a character is not a character,
##  so  we cannot use `ClassFunctionSameType'.
##
InstallMethod( AdditiveInverseOp,
    "for a class function",
    [ IsClassFunction ],
    psi -> ClassFunction( UnderlyingCharacterTable( psi ),
               AdditiveInverse( ValuesOfClassFunction( psi ) ) ) );


InstallMethod( AdditiveInverseOp,
    "for a virtual character",
    [ IsClassFunction and IsVirtualCharacter ],
    psi -> VirtualCharacter( UnderlyingCharacterTable( psi ),
               AdditiveInverse( ValuesOfClassFunction( psi ) ) ) );


#############################################################################
##
#M  ZeroOp( <psi> ) . . . . . . . . . . . . . . . . . .  for a class function
##
InstallMethod( ZeroOp,
    "for a class function",
    [ IsClassFunction ],
    psi -> VirtualCharacter( UnderlyingCharacterTable( psi ),
               Zero( ValuesOfClassFunction( psi ) ) ) );


#############################################################################
##
#M  \*( <cyc>, <psi> )  . . . . . . . . . scalar multiple of a class function
#M  \*( <psi>, <cyc> )  . . . . . . . . . scalar multiple of a class function
##
##  We define a multiplication only for two class functions (being the tensor
##  product), for scalar multiplication with cyclotomics,
##  and for default list times class function (where the class function acts
##  as a scalar).
##  Note that more is not needed, since class functions are not in
##  `IsMultiplicativeGeneralizedRowVector'.
##
InstallMethod( \*,
    "for cyclotomic, and class function",
    [ IsCyc, IsClassFunction ],
    function( cyc, chi )
    return ClassFunction( UnderlyingCharacterTable( chi ),
               cyc * ValuesOfClassFunction( chi ) );
    end );

InstallMethod( \*,
    "for integer, and virtual character",
    [ IsInt, IsVirtualCharacter ],
    function( cyc, chi )
    return VirtualCharacter( UnderlyingCharacterTable( chi ),
               cyc * ValuesOfClassFunction( chi ) );
    end );

InstallMethod( \*,
    "for positive integer, and character",
    [ IsPosInt, IsCharacter ],
    function( cyc, chi )
    return Character( UnderlyingCharacterTable( chi ),
               cyc * ValuesOfClassFunction( chi ) );
    end );

InstallMethod( \*,
    "for class function, and cyclotomic",
    [ IsClassFunction, IsCyc ],
    function( chi, cyc )
    return ClassFunction( UnderlyingCharacterTable( chi ),
               ValuesOfClassFunction( chi ) * cyc );
    end );

InstallMethod( \*,
    "for virtual character, and integer",
    [ IsVirtualCharacter, IsInt ],
    function( chi, cyc )
    return VirtualCharacter( UnderlyingCharacterTable( chi ),
               ValuesOfClassFunction( chi ) * cyc );
    end );

InstallMethod( \*,
    "for character, and positive integer",
    [ IsCharacter, IsPosInt ],
    function( chi, cyc )
    return Character( UnderlyingCharacterTable( chi ),
               ValuesOfClassFunction( chi ) * cyc );
    end );


#############################################################################
##
#M  OneOp( <psi> )  . . . . . . . . . . . . . . . . . .  for a class function
##
InstallMethod( OneOp,
    "for class function",
    [ IsClassFunction ],
    psi -> TrivialCharacter( UnderlyingCharacterTable( psi ) ) );


#############################################################################
##
#M  \*( <chi>, <psi> )  . . . . . . . . . . tensor product of class functions
##
InstallMethod( \*,
    "for two class functions",
    [ IsClassFunction, IsClassFunction ],
    function( chi, psi )
    local tbl, valschi, valspsi;
    tbl:= UnderlyingCharacterTable( chi );
    if not IsIdenticalObj( tbl, UnderlyingCharacterTable( psi ) ) then
      Error( "no product of class functions of different tables" );
    fi;
    valschi:= ValuesOfClassFunction( chi );
    valspsi:= ValuesOfClassFunction( psi );
    return ClassFunction( tbl,
               List( [ 1 .. Length( valschi ) ],
                     x -> valschi[x] * valspsi[x] ) );
    end );

InstallMethod( \*,
    "for two virtual characters",
    IsIdenticalObj,
    [ IsVirtualCharacter, IsVirtualCharacter ],
    function( chi, psi )
    local tbl, valschi, valspsi;
    tbl:= UnderlyingCharacterTable( chi );
    if not IsIdenticalObj( tbl, UnderlyingCharacterTable( psi ) ) then
      Error( "no product of class functions of different tables" );
    fi;
    valschi:= ValuesOfClassFunction( chi );
    valspsi:= ValuesOfClassFunction( psi );
    return VirtualCharacter( tbl,
               List( [ 1 .. Length( valschi ) ],
                     x -> valschi[x] * valspsi[x] ) );
    end );

InstallMethod( \*,
    "for two characters",
    IsIdenticalObj,
    [ IsCharacter, IsCharacter ],
    function( chi, psi )
    local tbl, valschi, valspsi;
    tbl:= UnderlyingCharacterTable( chi );
    if not IsIdenticalObj( tbl, UnderlyingCharacterTable( psi ) ) then
      Error( "no product of class functions of different tables" );
    fi;
    valschi:= ValuesOfClassFunction( chi );
    valspsi:= ValuesOfClassFunction( psi );
    return Character( tbl,
               List( [ 1 .. Length( valschi ) ],
                     x -> valschi[x] * valspsi[x] ) );
    end );


#############################################################################
##
#M  \*( <chi>, <list> ) . . . . . . . . . . class function times default list
#M  \*( <list>, <chi> ) . . . . . . . . . . default list times class function
##
InstallOtherMethod( \*,
    "for class function, and list in `IsListDefault'",
    [ IsClassFunction, IsListDefault ],
    function( chi, list )
    return List( list, entry -> chi * entry );
    end );

InstallOtherMethod( \*,
    "for list in `IsListDefault', and class function",
    [ IsListDefault, IsClassFunction ],
    function( list, chi )
    return List( list, entry -> entry * chi );
    end );


#############################################################################
##
#M  Order( <chi> )  . . . . . . . . . . . . . . . . order of a class function
##
##  Note that we are not allowed to regard the determinantal order of an
##  arbitrary (virtual) character as its order,
##  since nonlinear characters do not have an order as mult. elements.
##
InstallMethod( Order,
    "for a class function",
    [ IsClassFunction ],
    function( chi )
    local order, values;

    values:= ValuesOfClassFunction( chi );
    if   0 in values then
      Error( "<chi> is not invertible" );
    elif ForAny( values, cyc -> not IsIntegralCyclotomic( cyc )
                                or cyc * GaloisCyc( cyc, -1 ) <> 1 ) then
      return infinity;
    fi;
    order:= Conductor( values );
    if order mod 2 = 1 and ForAny( values, i -> i^order <> 1 ) then
      order:= 2*order;
    fi;
    return order;
    end );


#############################################################################
##
#M  InverseOp( <chi> )  . . . . . . . . . . . . . . . .  for a class function
##
InstallMethod( InverseOp,
    "for a class function",
    [ IsClassFunction ],
    function( chi )
    local values;

    values:= List( ValuesOfClassFunction( chi ), Inverse );
    if fail in values then
      return fail;
    elif HasIsCharacter( chi ) and IsCharacter( chi ) and values[1] = 1 then
      return Character( UnderlyingCharacterTable( chi ), values );
    else
      return ClassFunction( UnderlyingCharacterTable( chi ), values );
    fi;
    end );


#############################################################################
##
#M  \^( <chi>, <n> )  . . . . . . . . . . for class function and pos. integer
##
InstallOtherMethod( \^,
    "for class function and positive integer (pointwise powering)",
    [ IsClassFunction, IsPosInt ],
    function( chi, n )
    return ClassFunctionSameType( UnderlyingCharacterTable( chi ),
               chi,
               List( ValuesOfClassFunction( chi ), x -> x^n ) );
    end );


#############################################################################
##
#M  \^( <chi>, <g> )  . . . . .  conjugate class function under action of <g>
##
InstallMethod( \^,
    "for class function and group element",
    [ IsClassFunction, IsMultiplicativeElementWithInverse ],
    function( chi, g )
    local tbl, G;
    tbl:= UnderlyingCharacterTable( chi );
    if HasUnderlyingGroup( tbl ) then
      G:= UnderlyingGroup( tbl );
      if IsElmsColls( FamilyObj( g ), FamilyObj( G ) ) then
        return ClassFunctionSameType( tbl, chi,
               Permuted( ValuesOfClassFunction( chi ),
                         CorrespondingPermutations( tbl, chi, [ g ] )[1] ) );
      fi;
    fi;
    TryNextMethod();
    end );


#############################################################################
##
#M  \^( <chi>, <galaut> ) . . . Galois automorphism <galaut> applied to <chi>
##
InstallOtherMethod( \^,
    "for class function and Galois automorphism",
    [ IsClassFunction, IsGeneralMapping ],
    function( chi, galaut )
    if IsANFAutomorphismRep( galaut ) then
      galaut:= galaut!.galois;
      return ClassFunctionSameType( UnderlyingCharacterTable( chi ), chi,
                 List( ValuesOfClassFunction( chi ),
                       x -> GaloisCyc( x, galaut ) ) );
    elif IsOne( galaut ) then
      return chi;
    else
      TryNextMethod();
    fi;
    end );


#############################################################################
##
#M  \^( <chi>, <G> )  . . . . . . . . . . . . . . . .  induced class function
#M  \^( <chi>, <tbl> )  . . . . . . . . . . . . . . .  induced class function
##
InstallOtherMethod( \^,
    "for class function and group",
    [ IsClassFunction, IsGroup ],
    InducedClassFunction );

InstallOtherMethod( \^,
    "for class function and nearly character table",
    [ IsClassFunction, IsNearlyCharacterTable ],
    InducedClassFunction );


#############################################################################
##
#M  \^( <g>, <chi> )  . . . . . . . . . . value of <chi> on group element <g>
##
InstallOtherMethod( \^,
    [ IsMultiplicativeElementWithInverse, IsClassFunction ],
    function( g, chi )
    local tbl, ccl, i;
    tbl:= UnderlyingCharacterTable( chi );
    if not HasUnderlyingGroup( tbl ) then
      Error( "table <tbl> of <chi> does not store its group" );
    elif g in UnderlyingGroup( tbl ) then
      ccl:= ConjugacyClasses( tbl );
      for i in [ 1 .. Length( ccl ) ] do
        if g in ccl[i] then
          return ValuesOfClassFunction( chi )[i];
        fi;
      od;
    else
      Error( "<g> must lie in the underlying group of <chi>" );
    fi;
    end );


#############################################################################
##
#M  \^( <psi>, <chi> )  . . . . . . . . . .  conjugation of linear characters
##
InstallOtherMethod( \^,
    "for two class functions (conjugation, trivial action)",
    [ IsClassFunction, IsClassFunction ],
    function( chi, psi )
    return chi;
    end );


#############################################################################
##
#M  GlobalPartitionOfClasses( <tbl> )
##
InstallMethod( GlobalPartitionOfClasses,
    "for an ordinary character table",
    [ IsOrdinaryTable ],
    function( tbl )
    local part,     # partition that has to be respected
          list,     # list of all maps to be respected
          map,      # one map in 'list'
          inv,      # contains number of root classes
          newpart,  #
          values,   #
          j,        # loop over 'orb'
          pt;       # one point to map

    if HasAutomorphismsOfTable( tbl ) then

      # The orbits define the finest possible global partition.
      part:= OrbitsDomain( AutomorphismsOfTable( tbl ),
                     [ 1 .. Length( NrConjugacyClasses( tbl ) ) ] );

    else

      # Conjugate classes must have same representative order and
      # same centralizer order.
      list:= [ OrdersClassRepresentatives( tbl ),
               SizesCentralizers( tbl ) ];

      # The number of root classes is by definition invariant under
      # table automorphisms.
      for map in Compacted( ComputedPowerMaps( tbl ) ) do
        inv:= 0 * map;
        for j in map do
          inv[j]:= inv[j] + 1;
        od;
        Add( list, inv );
      od;

      # All elements in `list' must be respected.
      # Transform each of them into a partition,
      # and form the intersection of these partitions.
      part:= Partition( [ [ 1 .. Length( list[1] ) ] ] );
      for map in list do
        newpart := [];
        values  := [];
        for j in [ 1 .. Length( map ) ] do
          pt:= Position( values, map[j] );
          if pt = fail then
            Add( values, map[j] );
            Add( newpart, [ j ] );
          else
            Add( newpart[ pt ], j );
          fi;
        od;
        StratMeetPartition( part, Partition( newpart ) );
      od;
      part:= List( Cells( part ), Set );
#T unfortunately `Set' necessary ...

    fi;

    return part;
    end );


#############################################################################
##
#M  CorrespondingPermutations( <tbl>, <elms> )  . action on the conj. classes
##
InstallMethod( CorrespondingPermutations,
    "for character table and list of group elements",
    [ IsOrdinaryTable, IsHomogeneousList ],
    function( tbl, elms )
    local classes,  # list of conjugacy classes
          perms,    # list of permutations, result
          part,     # partition that has to be respected
          base,     # base of aut. group
          g,        # loop over `elms'
          images,   # list of images
          pt,       # one point to map
          im,       # actual image class
          orb,      # possible image points
          len,      # length of 'orb'
          found,    # image point found? (boolean value)
          j,        # loop over 'orb'
          list,     # one list in 'part'
          first,    # first point in orbit of 'g'
          min;      # minimal length of nontrivial orbit of 'g'

    classes:= ConjugacyClasses( tbl );

    perms:= [];

    # If the table automorphisms are known then we only must determine
    # the images of a base of this group.
    if HasAutomorphismsOfTable( tbl ) then

      part:= AutomorphismsOfTable( tbl );

      if IsTrivial( part ) then
        return ListWithIdenticalEntries( Length( elms ), () );
      fi;

      # Compute the images of the base points of this group.
      base:= BaseOfGroup( part );

      for g in elms do

        if IsOne( g ) then

          # If `g' is the identity then nothing is to do.
          Add( perms, () );

        else

          images:= [];
          for pt in base do

            im:= Representative( classes[ pt ] ) ^ g;
            found:= false;
            for j in Orbit( part, pt ) do
#T better CanonicalClassElement ??
              if im in classes[j] then
                Add( images, j );
                found:= true;
                break;
              fi;
            od;

          od;

          # Compute a group element.
          Add( perms,
               RepresentativeAction( part, base, images, OnTuples ) );

        fi;

      od;

    else

      # We can use only a partition into unions of orbits.

      part:= GlobalPartitionOfClasses( tbl );
      if Length( part ) = Length( classes ) then
        return ListWithIdenticalEntries( Length( elms ), () );
      fi;

      for g in elms do
#T It would be more natural to write
#T Permutation( g, ConjugacyClasses( tbl ), OnPoints ),
#T *BUT* the `Permutation' method in question first asks whether
#T the list of classes is sorted,
#T and there is no method to compare the classes!

        if IsOne( g ) then

          # If `g' is the identity then nothing is to do.
          Add( perms, () );

        else

          # Compute orbits of `g' on the lists in `part', store the images.
          # Note that if we have taken away a union of orbits such that the
          # number of remaining points is smaller than the smallest prime
          # divisor of the order of `g' then all these points must be fixed.
          min:= FactorsInt( Order( g ) )[1];
          images:= [];

          for list in part do

            if Length( list ) = 1 then
#T why not `min' ?

              # necessarily fixed point
              images[ list[1] ]:= list[1];

            else

              orb:= ShallowCopy( list );
              while min <= Length( orb ) do

                # There may be nontrivial orbits.
                pt:= orb[1];
                first:= pt;
                j:= 1;

                while j <= Length( orb ) do

                  im:= Representative( classes[ pt ] ) ^ g;
                  found:= false;
                  while j <= Length( orb ) and not found do
#T better CanonicalClassElement ??
                    if im in classes[ orb[j] ] then
                      images[pt]:= orb[j];
                      found:= true;
                    fi;
                    j:= j+1;
                  od;

                  RemoveSet( orb, pt );

                  if found and pt <> images[ pt ] then
                    pt:= images[ pt ];
                    j:= 1;
                  fi;

                od;

                # The image must be the first point of the orbit under `g'.
                images[pt]:= first;

              od;

              # The remaining points of the orbit must be fixed.
              for pt in orb do
                images[pt]:= pt;
              od;

            fi;

          od;

          # Compute a group element.
          Add( perms, PermList( images ) );

        fi;

      od;

    fi;

    return perms;
    end );


#############################################################################
##
#M  CorrespondingPermutations( <tbl>, <chi>, <elms> )
##
InstallOtherMethod( CorrespondingPermutations,
    "for a char. table, a hom. list, and a list of group elements",
    [ IsOrdinaryTable, IsHomogeneousList, IsHomogeneousList ],
    function( tbl, values, elms )
    local G,        # underlying group
          classes,  # list of conjugacy classes
          perms,    # list of permutations, result
          part,     # partition that has to be respected
          base,     # base of aut. group
          g,        # loop over `elms'
          images,   # list of images
          pt,       # one point to map
          im,       # actual image class
          orb,      # possible image points
          len,      # length of 'orb'
          found,    # image point found? (boolean value)
          j,        # loop over 'orb'
          list,     # one list in 'part'
          first,    # first point in orbit of 'g'
          min;      # minimal length of nontrivial orbit of 'g'

    classes:= ConjugacyClasses( tbl );
    perms:= [];

    # If the table automorphisms are known then we only must determine
    # the images of a base of this group.
    if HasAutomorphismsOfTable( tbl ) then

      part:= AutomorphismsOfTable( tbl );

      if IsTrivial( part ) then
        return ListWithIdenticalEntries( Length( elms ), () );
      fi;

      # Compute the images of the base points of this group.
      base:= BaseOfGroup( part );

      for g in elms do

        if IsOne( g ) then

          # If `g' is the identity then nothing is to do.
          Add( perms, () );

        else

          images:= [];
          for pt in base do

            im:= Representative( classes[ pt ] ) ^ g;
            found:= false;
            for j in Orbit( part, pt ) do
#T better CanonicalClassElement ??
              if im in classes[j] then
                Add( images, j );
                found:= true;
                break;
              fi;
              j:= j+1;
            od;

          od;

          # Compute a group element (if possible).
          Add( perms,
               RepresentativeAction( part, base, images, OnTuples ) );

        fi;

      od;

    else

      # We can use only a partition into unions of orbits.

      part:= GlobalPartitionOfClasses( tbl );
      if Length( part ) = Length( classes ) then
        return ListWithIdenticalEntries( Length( elms ), () );
      fi;

      for g in elms do

        if IsOne( g ) then

          # If `g' is the identity then nothing is to do.
          Add( perms, () );

        else

          # Compute orbits of `g' on the lists in `part', store the images.
          # Note that if we have taken away a union of orbits such that the
          # number of remaining points is smaller than the smallest prime
          # divisor of the order of `g' then all these points must be fixed.
          min:= FactorsInt( Order( g ) )[1];
          images:= [];

          for list in part do

            if Length( list ) = 1 then
#T why not `min' ?

              # necessarily fixed point
              images[ list[1] ]:= list[1];

            elif Length( Set( values{ list } ) ) = 1 then

              # We may take any permutation of the orbit.
              for j in list do
                images[j]:= j;
              od;

            else

              orb:= ShallowCopy( list );
              while Length( orb ) >= min do
#T fishy for S4 acting on V4 !!

                # There may be nontrivial orbits.
                pt:= orb[1];
                first:= pt;
                j:= 1;

                while j <= Length( orb ) do

                  im:= Representative( classes[ pt ] ) ^ g;
                  found:= false;
                  while j <= Length( orb ) and not found do
#T better CanonicalClassElement ??
                    if im in classes[ orb[j] ] then
                      images[pt]:= orb[j];
                      found:= true;
                    fi;
                    j:= j+1;
                  od;

                  RemoveSet( orb, pt );

                  if found then
                    j:= 1;
                    pt:= images[pt];
                  fi;

                od;

                # The image must be the first point of the orbit under `g'.
                images[pt]:= first;

              od;

              # The remaining points of the orbit must be fixed.
              for pt in orb do
                images[pt]:= pt;
              od;

            fi;

          od;

          # Compute a group element.
          Add( perms, PermList( images ) );

        fi;

      od;

    fi;

    return perms;
    end );


#############################################################################
##
#M  ComplexConjugate( <chi> )
##
##  We use `InstallOtherMethod' because class functions are both scalars and
##  lists, so the method matches two declarations of the operation.
##
InstallOtherMethod( ComplexConjugate,
    "for a class function",
    [ IsClassFunction and IsCyclotomicCollection ],
    chi -> GaloisCyc( chi, -1 ) );


#############################################################################
##
#M  GaloisCyc( <chi>, <k> )
##
InstallMethod( GaloisCyc,
    "for a class function, and an integer",
    [ IsClassFunction and IsCyclotomicCollection, IsInt ],
    function( chi, k )
    local tbl, char, n, g;

    tbl:= UnderlyingCharacterTable( chi );
    char:= UnderlyingCharacteristic( tbl );
    n:= Conductor( chi );
    g:= Gcd( k, n );

    if k = -1 or
       ( char = 0 and g = 1 ) then
      return ClassFunctionSameType( tbl, chi,
                 GaloisCyc( ValuesOfClassFunction( chi ), k ) );
#T also if k acts as some *(p^d) for char = p
#T (reduce k mod n, and then what?)
    else
      return ClassFunction( tbl,
                 GaloisCyc( ValuesOfClassFunction( chi ), k ) );
    fi;
    end );


#############################################################################
##
#M  Permuted( <chi>, <perm> )
##
InstallMethod( Permuted,
    "for a class function, and a permutation",
    [ IsClassFunction, IsPerm ],
    function( chi, perm )
    return ClassFunction( UnderlyingCharacterTable( chi ),
               Permuted( ValuesOfClassFunction( chi ), perm ) );
    end );


#############################################################################
##
##  5. Printing Class Functions
##

#############################################################################
##
#M  ViewObj( <psi> )  . . . . . . . . . . . . . . . . . view a class function
##
##  Note that class functions are finite lists, so the default `ViewObj'
##  method for finite lists should be avoided.
##
InstallMethod( ViewObj,
    "for a class function",
    [ IsClassFunction ],
    function( psi )
    Print( "ClassFunction( " );
    View( UnderlyingCharacterTable( psi ) );
    Print( ",\<\<\<\>\>\> " );
    View( ValuesOfClassFunction( psi ) );
    Print( " )" );
    end );

InstallMethod( ViewObj,
    "for a virtual character",
    [ IsClassFunction and IsVirtualCharacter ],
    function( psi )
    Print( "VirtualCharacter( " );
    View( UnderlyingCharacterTable( psi ) );
    Print( ",\<\<\<\>\>\> " );
    View( ValuesOfClassFunction( psi ) );
    Print( " )" );
    end );

InstallMethod( ViewObj,
    "for a character",
    [ IsClassFunction and IsCharacter ],
    function( psi )
    Print( "Character( " );
    View( UnderlyingCharacterTable( psi ) );
    Print( ",\<\<\<\>\>\> " );
    View( ValuesOfClassFunction( psi ) );
    Print( " )" );
    end );


#############################################################################
##
#M  PrintObj( <psi> ) . . . . . . . . . . . . . . . .  print a class function
##
InstallMethod( PrintObj,
    "for a class function",
    [ IsClassFunction ],
    function( psi )
    Print( "ClassFunction( ", UnderlyingCharacterTable( psi ),
           ", ", ValuesOfClassFunction( psi ), " )" );
    end );

InstallMethod( PrintObj,
    "for a virtual character",
    [ IsClassFunction and IsVirtualCharacter ],
    function( psi )
    Print( "VirtualCharacter( ", UnderlyingCharacterTable( psi ),
           ", ", ValuesOfClassFunction( psi ), " )" );
    end );

InstallMethod( PrintObj,
    "for a character",
    [ IsClassFunction and IsCharacter ],
    function( psi )
    Print( "Character( ", UnderlyingCharacterTable( psi ),
           ", ", ValuesOfClassFunction( psi ), " )" );
    end );


#############################################################################
##
#M  Display( <chi> )  . . . . . . . . . . . . . . .  display a class function
#M  Display( <chi>, <arec> )
##
InstallMethod( Display,
    "for a class function",
    [ IsClassFunction ],
    function( chi )
    Display( UnderlyingCharacterTable( chi ), rec( chars:= [ chi ] ) );
    end );

InstallOtherMethod( Display,
    "for a class function, and a record",
    [ IsClassFunction, IsRecord ],
    function( chi, arec )
    arec:= ShallowCopy( arec );
    arec.chars:= [ chi ];
    Display( UnderlyingCharacterTable( chi ), arec );
    end );


#############################################################################
##
##  6. Creating Class Functions from Values Lists
##


#############################################################################
##
#M  ClassFunction( <tbl>, <values> )
##
InstallMethod( ClassFunction,
    "for nearly character table, and dense list",
    [ IsNearlyCharacterTable, IsDenseList ],
    function( tbl, values )
    local chi;

    # Check the no. of classes.
    if NrConjugacyClasses( tbl ) <> Length( values ) then
      Error( "no. of classes in <tbl> and <values> must be equal" );
    fi;

    # Create the object.
    chi:= Objectify( NewType( FamilyObj( values ),
                                  IsClassFunction
                              and IsAttributeStoringRep ),
                     rec() );

    # Store the defining attribute values.
    SetValuesOfClassFunction( chi, ValuesOfClassFunction( values ) );
    SetUnderlyingCharacterTable( chi, tbl );

    # Store useful information.
    if IsSmallList( values ) then
      SetIsSmallList( chi, true );
    fi;

    return chi;
    end );


#############################################################################
##
#M  ClassFunction( <G>, <values> )
##
InstallMethod( ClassFunction,
    "for a group, and a dense list",
    [ IsGroup, IsDenseList ],
    function( G, values )
    return ClassFunction( OrdinaryCharacterTable( G ), values );
    end );


#############################################################################
##
#M  VirtualCharacter( <tbl>, <values> )
##
InstallMethod( VirtualCharacter,
    "for nearly character table, and dense list",
    [ IsNearlyCharacterTable, IsDenseList ],
    function( tbl, values )
    values:= ClassFunction( tbl, values );
    SetIsVirtualCharacter( values, true );
    return values;
    end );


#############################################################################
##
#M  VirtualCharacter( <G>, <values> )
##
InstallMethod( VirtualCharacter,
    "for a group, and a dense list",
    [ IsGroup, IsDenseList ],
    function( G, values )
    return VirtualCharacter( OrdinaryCharacterTable( G ), values );
    end );


#############################################################################
##
#M  Character( <tbl>, <values> )
##
InstallMethod( Character,
    "for nearly character table, and dense list",
    [ IsNearlyCharacterTable, IsDenseList ],
    function( tbl, values )
    values:= ClassFunction( tbl, values );
    SetIsCharacter( values, true );
    return values;
    end );


#############################################################################
##
#M  Character( <G>, <values> )
##
InstallMethod( Character,
    "for a group, and a dense list",
    [ IsGroup, IsDenseList ],
    function( G, values )
    return Character( OrdinaryCharacterTable( G ), values );
    end );


#############################################################################
##
#F  ClassFunctionSameType( <tbl>, <chi>, <values> )
##
InstallGlobalFunction( ClassFunctionSameType,
    function( tbl, chi, values )
    if not IsClassFunction( chi ) then
      return values;
    elif HasIsCharacter( chi ) and IsCharacter( chi ) then
      return Character( tbl, values );
    elif HasIsVirtualCharacter( chi ) and IsVirtualCharacter( chi ) then
      return VirtualCharacter( tbl, values );
    else
      return ClassFunction( tbl, values );
    fi;
end );


#############################################################################
##
##  7. Creating Class Functions using Groups
##


#############################################################################
##
#M  TrivialCharacter( <tbl> ) . . . . . . . . . . . . . for a character table
##
InstallMethod( TrivialCharacter,
    "for a character table",
    [ IsNearlyCharacterTable ],
    tbl -> Character( tbl,
               ListWithIdenticalEntries( NrConjugacyClasses( tbl ), 1 ) ) );


#############################################################################
##
#M  TrivialCharacter( <G> ) . . . . . . . . . . . . . . . . . . . for a group
##
InstallMethod( TrivialCharacter,
    "for a group (delegate to the table)",
    [ IsGroup ],
    G -> TrivialCharacter( OrdinaryCharacterTable( G ) ) );


#############################################################################
##
#M  NaturalCharacter( <G> ) . . . . . . . . . . . . . for a permutation group
##
InstallMethod( NaturalCharacter,
    "for a permutation group",
    [ IsGroup and IsPermCollection ],
    function( G )
    local deg, tbl;
    deg:= NrMovedPoints( G );
    tbl:= OrdinaryCharacterTable( G );
    return Character( tbl,
               List( ConjugacyClasses( tbl ),
               C -> deg - NrMovedPoints( Representative( C ) ) ) );
    end );


#############################################################################
##
#M  NaturalCharacter( <G> ) . . . . for a matrix group in characteristic zero
##
InstallMethod( NaturalCharacter,
    "for a matrix group in characteristic zero",
    [ IsGroup and IsRingElementCollCollColl ],
    function( G )
    local tbl;
    if Characteristic( G ) = 0 then
      tbl:= OrdinaryCharacterTable( G );
      return Character( tbl,
                 List( ConjugacyClasses( tbl ),
                       C -> TraceMat( Representative( C ) ) ) );
    else
      TryNextMethod();
    fi;
    end );


#############################################################################
##
#M  NaturalCharacter( <hom> ) . . . . . . . . . . .  for a group homomorphism
##
##  We use shortcuts for homomorphisms onto permutation groups and matrix
##  groups in characteristic zero,
##  since the meaning of `NaturalCharacter' is clear for these cases and
##  we can avoid explicit conjugacy tests in the image.
##  For other cases, we use a generic way.
##
InstallMethod( NaturalCharacter,
    "for a group general mapping",
    [ IsGeneralMapping ],
    function( hom )
    local G, R, deg, tbl, chi;
    G:= Source( hom );
    R:= Range( hom );
    tbl:= OrdinaryCharacterTable( G );
    if IsPermGroup( R ) then
      deg:= NrMovedPoints( R );
      return Character( tbl,
                 List( ConjugacyClasses( tbl ),
                 C -> deg - NrMovedPoints( ImagesRepresentative( hom,
                                Representative( C ) ) ) ) );
    elif IsMatrixGroup( R ) and Characteristic( R ) = 0 then
      return Character( tbl,
                 List( ConjugacyClasses( tbl ),
                 C -> TraceMat( ImagesRepresentative( hom,
                          Representative( C ) ) ) ) );
    else
      chi:= NaturalCharacter( Image( hom ) );
      return Character( tbl,
                 List( ConjugacyClasses( tbl ),
                 C -> ImagesRepresentative( hom,
                          Representative( C ) ) ^ chi ) );
    fi;
    end );


#############################################################################
##
#M  PermutationCharacter( <G>, <D>, <opr> ) . . . . . . . .  for group action
##
InstallMethod( PermutationCharacter,
    "group action on domain",
    [ IsGroup, IsCollection, IsFunction ],
    function( G, dom, opr )
    local tbl;
    tbl:= OrdinaryCharacterTable( G );
    return Character( tbl, List( ConjugacyClasses( tbl ),
	       i -> Number( dom, j -> j = opr( j, Representative(i) ) ) ) );
    end);


#############################################################################
##
#M  PermutationCharacter( <G>, <U> )  . . . . . . . . . . . .  for two groups
##
InstallMethod( PermutationCharacter,
    "for two groups (use double cosets)",
    IsIdenticalObj,
    [ IsGroup, IsGroup ],
    function( G, U )
    local tbl, C, c, s, i;

    tbl:= OrdinaryCharacterTable( G );
    C := ConjugacyClasses( tbl );
    c := [ Index( G, U ) ];
    s := Size( U );

    for i  in [ 2 .. Length(C) ]  do
      c[i]:= Number( DoubleCosets( G, U,
                         SubgroupNC( G, [ Representative( C[i] ) ] ) ),
                     x -> Size( x ) = s );
    od;

    # Return the character.
    return Character( tbl, c );
    end );


#T #############################################################################
#T ##
#T #M  PermutationCharacter( <G>, <U> )  . . . . . . . . .  for two small groups
#T ##
#T InstallMethod( PermutationCharacter,
#T     "for two small groups",
#T     IsIdenticalObj,
#T     [ IsGroup and IsSmallGroup, IsGroup and IsSmallGroup ],
#T     function( G, U )
#T     local E, I, tbl;
#T 
#T     E := AsList( U );
#T     I := Size( G ) / Length( E );
#T     tbl:= OrdinaryCharacterTable( G );
#T     return Character( tbl,
#T         List( ConjugacyClasses( tbl ),
#T         C -> I * Length( Intersection2( AsList( C ), E ) ) / Size( C ) ) );
#T     end );


#############################################################################
##
##  8. Operations for Class Functions
##


#############################################################################
##
#M  IsCharacter( <obj> )  . . . . . . . . . . . . . . for a virtual character
##
InstallMethod( IsCharacter,
    "for a virtual character",
    [ IsClassFunction and IsVirtualCharacter ],
    obj -> IsCharacter( UnderlyingCharacterTable( obj ),
                        ValuesOfClassFunction( obj ) ) );

InstallMethod( IsCharacter,
    "for a class function",
    [ IsClassFunction ],
    function( obj )
    if HasIsVirtualCharacter( obj ) and not IsVirtualCharacter( obj ) then
#T can disappear when inverse implications are supported!
      return false;
    fi;
    return IsCharacter( UnderlyingCharacterTable( obj ),
                        ValuesOfClassFunction( obj ) );
    end );

InstallMethod( IsCharacter,
    "for an ordinary character table, and a homogeneous list",
    [ IsOrdinaryTable, IsHomogeneousList ],
    function( tbl, list )
    local chi, scpr;

    # Proper characters have positive degree.
    if list[1] <= 0 then
      return false;
    fi;

    # Check the scalar products with all irreducibles.
    for chi in Irr( tbl ) do
      scpr:= ScalarProduct( tbl, chi, list );
      if not IsInt( scpr ) or scpr < 0 then
        return false;
      fi;
    od;
    return true;
    end );

InstallMethod( IsCharacter,
    "for a Brauer table, and a homogeneous list",
    [ IsBrauerTable, IsHomogeneousList ],
    function( tbl, list )
    local chi, scpr;

    # Proper characters have positive degree.
    if list[1] <= 0 then
      return false;
    fi;

    # Check the decomposition.
    return Decomposition( Irr( tbl ), [ list ], "nonnegative" )[1] <> fail;
    end );


#############################################################################
##
#M  IsVirtualCharacter( <chi> ) . . . . . . . . . . . .  for a class function
##
InstallMethod( IsVirtualCharacter,
    "for a class function",
    [ IsClassFunction ],
    chi -> IsVirtualCharacter( UnderlyingCharacterTable( chi ),
                               ValuesOfClassFunction( chi ) ) );

InstallMethod( IsVirtualCharacter,
    "for an ordinary character table, and a homogeneous list",
    [ IsOrdinaryTable, IsHomogeneousList ],
    function( tbl, list )
    local chi;

    # Check the scalar products with all irreducibles.
    for chi in Irr( tbl ) do
      if not IsInt( ScalarProduct( tbl, chi, list ) ) then
        return false;
      fi;
    od;
    return true;
    end );

# InstallMethod( IsVirtualCharacter,
#     "for a Brauer table, and a homogeneous list",
#     [ IsBrauerTable, IsHomogeneousList ],
#     function( tbl, list )
#     ???
#     end );


#############################################################################
##
#M  IsIrreducibleCharacter( <chi> )   . . . . . . . . .  for a class function
##
InstallMethod( IsIrreducibleCharacter,
    "for a class function",
    [ IsClassFunction ],
    chi -> IsIrreducibleCharacter( UnderlyingCharacterTable( chi ),
                                   ValuesOfClassFunction( chi ) ) );

InstallMethod( IsIrreducibleCharacter,
    "for an ordinary character table, and a homogeneous list",
    [ IsOrdinaryTable, IsHomogeneousList ],
    function( tbl, list )
    return     IsVirtualCharacter( tbl, list )
           and ScalarProduct( tbl, list, list) = 1
           and list[1] > 0;
    end );

InstallMethod( IsIrreducibleCharacter,
    "for a Brauer table, and a homogeneous list",
    [ IsBrauerTable, IsHomogeneousList ],
    function( tbl, list )
    local i, found;
    list:= Decomposition( Irr( tbl ), [ list ], "nonnegative" )[1];
    if list = fail then
      return false;
    fi;
    found:= false;
    for i in list do
      if i <> 0 then
        if found or i <> 1 then
          return false;
        else
          found:= true;
        fi;
      fi;
    od;
    return found;
    end );


#############################################################################
##
#M  ScalarProduct( <chi>, <psi> ) . . . . . . . . . . for two class functions
##
InstallMethod( ScalarProduct,
    "for two class functions",
    [ IsClassFunction, IsClassFunction ],
    function( chi, psi )
    local tbl, i, size, weights, scalarproduct;

    tbl:= UnderlyingCharacterTable( chi );
    if tbl <> UnderlyingCharacterTable( psi ) then
      Error( "<chi> and <psi> have different character tables" );
    fi;
    return ScalarProduct( tbl, ValuesOfClassFunction( chi ),
                               ValuesOfClassFunction( psi ) );
    end );


#############################################################################
##
#M  ScalarProduct( <tbl>, <chi>, <psi> ) .  scalar product of class functions
##
InstallMethod( ScalarProduct,
    "for character table and two homogeneous lists",
    [ IsCharacterTable, IsRowVector, IsRowVector ],
    function( tbl, x1, x2 )
    local i,       # loop variable
          scpr,    # scalar product, result
          weight;  # lengths of conjugacy classes

    weight:= SizesConjugacyClasses( tbl );
    x1:= ValuesOfClassFunction( x1 );
    x2:= ValuesOfClassFunction( x2 );
    scpr:= 0;
    for i in [ 1 .. Length( x1 ) ] do
      scpr:= scpr + x1[i] * GaloisCyc( x2[i], -1 ) * weight[i];
    od;
    return scpr / Size( tbl );
    end );


#############################################################################
##
#F  MatScalarProducts( [<tbl>, ]<list1>, <list2> )
#F  MatScalarProducts( [<tbl>, ]<list> )
##
InstallMethod( MatScalarProducts,
    "for two homogeneous lists",
    [ IsHomogeneousList, IsHomogeneousList ],
    function( list1, list2 )
    if IsEmpty( list1 ) then
      return [];
    elif not IsClassFunction( list1[1] ) then
      Error( "<list1> must consist of class functions" );
    else
      return MatScalarProducts( UnderlyingCharacterTable( list1[1] ),
                                list1, list2 );
    fi;
    end );

InstallMethod( MatScalarProducts,
    "for a homogeneous list",
    [ IsHomogeneousList ],
    function( list )
    if IsEmpty( list ) then
      return [];
    elif not IsClassFunction( list[1] ) then
      Error( "<list> must consist of class functions" );
    else
      return MatScalarProducts( UnderlyingCharacterTable( list[1] ), list );
    fi;
    end );

InstallMethod( MatScalarProducts,
    "for an ordinary table, and two homogeneous lists",
    [ IsOrdinaryTable, IsHomogeneousList, IsHomogeneousList ],
    function( tbl, list1, list2 )
    local i, j, chi, nccl, weight, scprmatrix, order, scpr;

    if IsEmpty( list1 ) then
      return [];
    fi;
    list1:= List( list1, ValuesOfClassFunction );

    nccl:= NrConjugacyClasses( tbl );
    weight:= SizesConjugacyClasses( tbl );
    order:= Size( tbl );

    scprmatrix:= [];
    for i in [ 1 .. Length( list2 ) ] do
      scprmatrix[i]:= [];
      chi:= List( ValuesOfClassFunction( list2[i] ), x -> GaloisCyc(x,-1) );
      for j in [ 1 .. nccl ] do
        chi[j]:= chi[j] * weight[j];
      od;
      for j in list1 do
        scpr:= ( chi * j ) / order;
        Add( scprmatrix[i], scpr );
        if not IsInt( scpr ) then
          if IsRat( scpr ) then
            Info( InfoCharacterTable, 2,
                  "MatScalarProducts: sum not divisible by group order" );
          elif IsCyc( scpr ) then
            Info( InfoCharacterTable, 2,
                  "MatScalarProducts: summation not integer valued");
          fi;
        fi;
      od;
    od;
    return scprmatrix;
    end );

InstallMethod( MatScalarProducts,
    "for an ordinary table, and a homogeneous list",
    [ IsOrdinaryTable, IsHomogeneousList ],
    function( tbl, list )
    local i, j, chi, nccl, weight, scprmatrix, order, scpr;

    if IsEmpty( list ) then
      return [];
    fi;
    list:= List( list, ValuesOfClassFunction );

    nccl:= NrConjugacyClasses( tbl );
    weight:= SizesConjugacyClasses( tbl );
    order:= Size( tbl );

    scprmatrix:= [];
    for i in [ 1 .. Length( list ) ] do
      scprmatrix[i]:= [];
      chi:= List( list[i], x -> GaloisCyc( x, -1 ) );
      for j in [ 1 .. nccl ] do
        chi[j]:= chi[j] * weight[j];
      od;
      for j in [ 1 .. i ] do
        scpr:= ( chi * list[j] ) / order;
        Add( scprmatrix[i], scpr );
        if not IsInt( scpr ) then
          if IsRat( scpr ) then
            Info( InfoCharacterTable, 2,
                  "MatScalarProducts: sum not divisible by group order" );
          elif IsCyc( scpr ) then
            Info( InfoCharacterTable, 2,
                  "MatScalarProducts: summation not integer valued");
          fi;
        fi;
      od;
    od;
    return scprmatrix;
    end );


#############################################################################
##
#M  Norm( [<tbl>, ]<chi> ) . . . . . . . . . . . . . . norm of class function
##
InstallOtherMethod( Norm,
    "for a class function",
    [ IsClassFunction ],
    chi -> ScalarProduct( chi, chi ) );

InstallOtherMethod( Norm,
    "for an ordinary character table and a homogeneous list",
    [ IsOrdinaryTable, IsHomogeneousList ],
    function( tbl, chi )
    return ScalarProduct( tbl, chi, chi );
    end );


#############################################################################
##
#M  CentreOfCharacter( [<tbl>, ]<chi> ) . . . . . . . . centre of a character
##
InstallMethod( CentreOfCharacter,
    "for a class function",
    [ IsClassFunction ],
    chi -> CentreOfCharacter( UnderlyingCharacterTable( chi ),
                              ValuesOfClassFunction( chi ) ) );

InstallMethod( CentreOfCharacter,
    "for an ordinary table, and a homogeneous list ",
    [ IsOrdinaryTable, IsHomogeneousList ],
    function( tbl, list )
    if not HasUnderlyingGroup( tbl ) then
      Error( "<tbl> does not store its group" );
    fi;
    return NormalSubgroupClasses( tbl, ClassPositionsOfCentre( list ) );
    end );


#############################################################################
##
#M  ClassPositionsOfCentre( <chi> )  . . classes in the centre of a character
##
##  We know that an algebraic integer $\alpha$ is a root of unity
##  if and only if all conjugates of $\alpha$ have absolute value at most 1.
##  Since $\alpha^{\ast} \overline{\alpha^{\ast}} = 1$ holds for a Galois
##  automorphism $\ast$ if and only if $\alpha \overline{\alpha} = 1$ holds,
##  a cyclotomic integer is a root of unity iff its absolute value is $1$.
##
##  Cf. the comment about the `Order' method for cyclotomics in the file
##  `lib/cyclotom.g'.
##
##  The `IsCyc' test is necessary to avoid errors in the case that <chi>
##  contains unknowns.
##
InstallMethod( ClassPositionsOfCentre,
    "for a homogeneous list",
    [ IsHomogeneousList ],
    function( chi )
    local deg, mdeg, degsquare;

    deg:= chi[1];
    mdeg:= - deg;
    degsquare:= deg^2;

    return PositionsProperty( chi,
               x -> x = deg or x = mdeg or
                    ( ( not IsInt( x ) ) and IsCyc( x ) and IsCycInt( x )
                      and x * GaloisCyc( x, -1 ) = degsquare ) );
    end );


#############################################################################
##
#M  ConstituentsOfCharacter( [<tbl>, ]<chi> ) .  irred. constituents of <chi>
##
InstallMethod( ConstituentsOfCharacter,
    [ IsClassFunction ],
    chi -> ConstituentsOfCharacter( UnderlyingCharacterTable( chi ), chi ) );

InstallMethod( ConstituentsOfCharacter,
    "for a character",
    [ IsClassFunction and IsCharacter ],
    function( chi )
    local tbl,    # underlying table of `chi'
          irr,    # irreducible characters of `tbl'
          values, # character values
          deg,    # degree of `chi'
          const,  # list of constituents, result
          i,      # loop over `irr'
          irrdeg, # degree of an irred. character
          scpr;   # one scalar product

    tbl:= UnderlyingCharacterTable( chi );
    irr:= Irr( tbl );
    values:= ValuesOfClassFunction( chi );
    deg:= values[1];
    const:= [];
    i:= 1;
    while 0 < deg and i <= Length( irr ) do
      irrdeg:= DegreeOfCharacter( irr[i] );
      if irrdeg <= deg then
        scpr:= ScalarProduct( tbl, chi, irr[i] );
        if scpr <> 0 then
          deg:= deg - scpr * irrdeg;
          Add( const, irr[i] );
        fi;
      fi;
      i:= i+1;
    od;

    return Set( const );
    end );

InstallMethod( ConstituentsOfCharacter,
    "for an ordinary table, and a homogeneous list",
    [ IsOrdinaryTable, IsHomogeneousList ],
    function( tbl, chi )
    local irr,    # irreducible characters of `tbl'
          const,  # list of constituents, result
          proper, # is `chi' a proper character
          i,      # loop over `irr'
          scpr;   # one scalar product

    const:= [];
    proper:= true;
    for i in Irr( tbl ) do
      scpr:= ScalarProduct( tbl, chi, i );
      if scpr <> 0 then
        Add( const, i );
        proper:= proper and IsInt( scpr ) and ( 0 < scpr );
      fi;
    od;

    # In the case `proper = true' we know that `chi' is a character.
    if proper then
      SetIsCharacter( chi, true );
    fi;

    return Set( const );
    end );

InstallMethod( ConstituentsOfCharacter,
    "for a Brauer table, and a homogeneous list",
    [ IsBrauerTable, IsHomogeneousList ],
    function( tbl, chi )
    local irr,    # irreducible characters of `tbl'
          dec;

    irr:= Irr( tbl );
    dec:= Decomposition( irr, [ chi ], "nonnegative" )[1];
    if dec = fail then
      TryNextMethod();
    fi;
    return irr{ Filtered( [ 1 .. Length( dec ) ], i -> dec[i] <> 0 ) };
    end );


#############################################################################
##
#M  DegreeOfCharacter( <chi> )  . . . . . . . . . . . .  for a class function
##
InstallMethod( DegreeOfCharacter,
    "for a class function",
    [ IsClassFunction ],
    chi -> ValuesOfClassFunction( chi )[1] );


#############################################################################
##
#M  InertiaSubgroup( [<tbl>, ]<G>, <chi> )  . inertia subgroup of a character
##
InstallMethod( InertiaSubgroup,
    "for a group, and a class function",
    [ IsGroup, IsClassFunction ],
    function( G, chi )
    return InertiaSubgroup( UnderlyingCharacterTable( chi ), G,
                            ValuesOfClassFunction( chi ) );
    end );

InstallMethod( InertiaSubgroup,
    "for an ordinary table, a group, and a homogeneous list",
    [ IsOrdinaryTable, IsGroup, IsHomogeneousList ],
    function( tbl, G, chi )
    local H,          # group of `chi'
          index,      # index of `H' in `G'
          induced,    # induced of `chi' from `H' to `G'
          global,     # global partition of classes
          part,       # refined partition
          p,          # one set in `global' and `part'
          val,        # one value in `p'
          values,     # list of character values on `p'
          new,        # list of refinements of `p'
          i,          # loop over stored partitions
          pos,        # position where to store new partition later
          perms,      # permutations corresp. to generators of `G'
          permgrp,    # group generated by `perms'
          stab;       # the inertia subgroup, result

    # `G' must normalize the group of `chi'.
    H:= UnderlyingGroup( tbl );
    if not ( IsSubset( G, H ) and IsNormal( G, H ) ) then
      Error( "<H> must be a normal subgroup in <G>" );
    fi;

    # For prime index, check the norm of the induced character.
    # (We get a decision if `chi' is irreducible.)
    index:= Index( G, H );
    if IsPrimeInt( index ) then
      induced:= InducedClassFunction( tbl, chi, G );
      if ScalarProduct( CharacterTable( G ), induced, induced ) = 1 then
        return H;
      elif ScalarProduct( tbl, chi, chi ) = 1 then
        return G;
      fi;
    fi;

    # Compute the partition that must be stabilized.
#T Why is `StabilizerPartition' no longer available?
#T In GAP 3.5, there was such a function.
    # (We need only those cells where `chi' really yields a refinement.)
    global:= GlobalPartitionOfClasses( tbl );

    part:= [];
    for p in global do
#T only if `p' has length > 1 !
      val:= chi[ p[1] ];
      if ForAny( p, x -> chi[x] <> val ) then

        # proper refinement will yield a condition.
        values:= [];
        new:= [];
        for i in p do
          pos:= Position( values, chi[i] );
          if pos = fail then
            Add( values, chi[i] );
            Add( new, [ i ] );
          else
            Add( new[ pos ], i );
          fi;
        od;
        Append( part, new );

      fi;
    od;

    # If no refinement occurs, the character is necessarily invariant in <G>.
    if IsEmpty( part ) then
      return G;
    fi;

    # Compute the permutations corresponding to the generators of `G'.
    perms:= CorrespondingPermutations( tbl, chi, GeneratorsOfGroup( G ) );
    permgrp:= GroupByGenerators( perms );

    # `G' acts on the set of conjugacy classes given by each cell of `part'.
    stab:= permgrp;
    for p in part do
      stab:= Stabilizer( stab, p, OnSets );
#T Better one step (partition stabilizer) ??
    od;

    # Construct and return the result.
    if stab = permgrp then
      return G;
    else
      return PreImagesSet( GroupHomomorphismByImages( G, permgrp,
                               GeneratorsOfGroup( G ), perms ),
                 stab );
    fi;
    end );


#############################################################################
##
#M  KernelOfCharacter( [<tbl>, ]<chi> ) . . . . . . . .  for a class function
##
InstallMethod( KernelOfCharacter,
    "for a class function",
    [ IsClassFunction ],
    chi -> KernelOfCharacter( UnderlyingCharacterTable( chi ),
                              ValuesOfClassFunction( chi ) ) );

InstallMethod( KernelOfCharacter,
    "for an ordinary table, and a homogeneous list",
    [ IsOrdinaryTable, IsHomogeneousList ],
    function( tbl, chi )
    return NormalSubgroupClasses( tbl, ClassPositionsOfKernel( chi ) );
    end );


#############################################################################
##
#M  ClassPositionsOfKernel( <char> ) .  the set of classes forming the kernel
##
InstallMethod( ClassPositionsOfKernel,
    "for a homogeneous list",
    [ IsHomogeneousList ],
    function( char )
    local degree;
    degree:= char[1];
    return Filtered( [ 1 .. Length( char ) ], x -> char[x] = degree );
    end );


#############################################################################
##
#M  CycleStructureClass( [<tbl>, ]<permchar>, <class> )
##
##  For a permutation character $\pi$ and an element $g$ of $G$, the number
##  of $n$-cycles in the underlying permutation representation is equal to
##  $\frac{1}{n} \sum_{r|n} \mu(\frac{n}{r}) \pi(g^r)$.
##
InstallMethod( CycleStructureClass,
    "for a class function, and a class position",
    [ IsClassFunction, IsPosInt ],
    function( permchar, class )
    return CycleStructureClass( UnderlyingCharacterTable( permchar ),
                                ValuesOfClassFunction( permchar ), class );
    end );

InstallMethod( CycleStructureClass,
    "for an ordinary table, a list, and a class position",
    [ IsOrdinaryTable, IsHomogeneousList, IsPosInt ],
    function( tbl, permchar, class )
    local n,           # element order of `class'
          divs,        # divisors of `n'
          i, d, j,     # loop over `divs'
          fixed,       # numbers of fixed points
          cycstruct;   # cycle structure, result

    # Compute the numbers of fixed points of powers.
    n:= OrdersClassRepresentatives( tbl )[ class ];
    divs:= DivisorsInt( n );
    fixed:= [];
    for i in [ 1 .. Length( divs ) ] do

      # Compute the number of cycles of the element of order `n / d'.
      d:= divs[i];
      fixed[d]:= permchar[ PowerMap( tbl, d, class ) ];
      for j in [ 1 .. i-1 ] do
        if d mod divs[j] = 0 then

          # Subtract the number of fixed points with stabilizer exactly
          # of order `n / divs[j]'.
          fixed[d]:= fixed[d] - fixed[ divs[j] ];

        fi;
      od;

    od;

    # Convert these numbers into numbers of cycles.
    cycstruct:= [];
    for i in divs do
      if fixed[i] <> 0 and 1 < i then
        cycstruct[ i-1 ]:= fixed[i] / i;
      fi;
    od;

    # Return the cycle structure.
    return cycstruct;
    end );


#############################################################################
##
#M  IsTransitive( [<tbl>, ]<permchar> )
##
InstallMethod( IsTransitive,
    "for a class function",
    [ IsClassFunction ],
    function( permchar )
    local tbl;
    tbl:= UnderlyingCharacterTable( permchar );
    return ValuesOfClassFunction( permchar ) * SizesConjugacyClasses( tbl )
           = Size( tbl );
    end );

InstallMethod( IsTransitive,
    "for an ordinary table and a homogeneous list",
    [ IsOrdinaryTable, IsHomogeneousList ],
    function( tbl, permchar )
    return permchar * SizesConjugacyClasses( tbl ) = Size( tbl );
    end );


#############################################################################
##
#M  Transitivity( [<tbl>, ]<permchar> )
##
##  The transitivity of a permutation character $\pi$ corresponding to the
##  action on the $G$-set $\Omega$ is computed as follows
##  (cf.~\cite{Hup98}, Theorem~11.8).
##  Let $\Omega_k = \{ (\omega_1, \omega_2, \ldots, \omega_k) \mid
##  \omega_i \in \Omega, \omega_i {\rm\ pairwise distinct} \}$.
##  Then $\Omega_k$ is a $G$-set w.r.t.~componentwise action,
##  and the permutation character $\pi_k$ is given by
##  $\pi_k(g) = \pi(g) (\pi(g)-1) (\pi(g)-2) \cdots (\pi(g)-k+1)$.
##  $\Omega$ is $k$-transitive if and only if $\Omega_k$ is transitive.
##
InstallMethod( Transitivity,
    "for a class function",
    [ IsClassFunction ],
    pi -> Transitivity( UnderlyingCharacterTable( pi ),
                        ValuesOfClassFunction( pi ) ) );

InstallMethod( Transitivity,
    "for an ordinary table, and a homogeneous list",
    [ IsOrdinaryTable, IsHomogeneousList ],
    function( tbl, values )
    local order,
          classes,
          n,
          k,
          pik;

    # Check the argument.
    if not ForAll( values, IsInt ) then
      Error( "<values> is not integral" );
    fi;

    order:= Size( tbl );
    classes:= SizesConjugacyClasses( tbl );
    n:= Length( classes );

    k:= 1;
    pik:= values;
    while pik * classes = order do
      k:= k + 1;
      pik:= List( [ 1 .. n ], x -> pik[x] * ( values[x] - k + 1 ) );
    od;

    return k - 1;
    end );


#############################################################################
##
#M  CentralCharacter( [<tbl>, ]<chi> )  . . . . . . . . . . . for a character
##
InstallMethod( CentralCharacter,
    "for a class function",
    [ IsClassFunction ],
    chi -> CentralCharacter( UnderlyingCharacterTable( chi ),
                             ValuesOfClassFunction( chi ) ) );

InstallMethod( CentralCharacter,
    "for an ordinary table, and a homogeneous list",
    [ IsOrdinaryTable, IsHomogeneousList ],
    function( tbl, char )
    local classes;
    classes:= SizesConjugacyClasses( tbl );
    if Length( classes ) <> Length( char ) then
      Error( "<classes> and <char> must have same length" );
    fi;
    return ClassFunction( tbl, List( [ 1 .. Length( char ) ],
                                     x -> classes[x] * char[x] / char[1] ) );
    end );


##############################################################################
##
#M  DeterminantOfCharacter( [<tbl>, ]<chi> )
##
##  The determinant is computed as follows.
##  Diagonalize the matrix; the determinant is the product of the diagonal
##  entries, which can be computed by `Eigenvalues'.
##
##  Note that the determinant of a virtual character $\chi - \psi$ is
##  well-defined as the quotient of the determinants of the characters $\chi$
##  and $\psi$, since the determinant of a sum of characters is the product
##  of the determinants of the summands.
##
InstallMethod( DeterminantOfCharacter,
    "for a class function",
    [ IsClassFunction ],
    function( chi )
    local det;

    if chi[1] = 1 then
      return chi;
    fi;
    det:= DeterminantOfCharacter( UnderlyingCharacterTable( chi ),
                                  ValuesOfClassFunction( chi ) );
    if HasIsVirtualCharacter( chi ) and IsVirtualCharacter( chi ) then
      SetIsCharacter( det, true );
    fi;
    return det;
    end );

InstallMethod( DeterminantOfCharacter,
    "for a nearly character table, and a class function",
    [ IsCharacterTable, IsHomogeneousList ],
    function( tbl, chi )
    local det,      # result list
          ev,       # eigenvalues
          ord,      # one element order
          i;        # loop over classes

    if chi[1] = 1 then
      return ClassFunction( tbl, chi );
    fi;

    det:= [];

    for i in [ 1 .. Length( chi ) ] do

      ev:= EigenvaluesChar( tbl, chi, i );
      ord:= Length( ev );

      # The determinant is 'E(ord)' to the 'exp'-th power,
      # where $'exp' = \sum_{j=1}^{ord} j 'ev'[j]$.
      # (Note that the $j$-th entry in 'ev' is the multiplicity of
      # 'E(ord)^j' as eigenvalue.)
      det[i]:= E(ord) ^ ( [ 1 .. ord ] * ev );

    od;

    return ClassFunction( tbl, det );
    end );


#############################################################################
##
#M  EigenvaluesChar( [<tbl>, ]<char>, <class> )
##
##  The eigenvalues can be computed from the values of the character
##  <char> together with the power maps up to the order of elements in the
##  <class>-th class of <tbl>, see page~231 in~\cite{NPP84};
##  note that the multiplicity of a given $n$-th root of unity $\zeta$
##  as an eigenvalue of $M$ is equal to the multiplicity of the irreducible
##  character of the cyclic group spanned by $g$ that maps $g$ to $\zeta$,
##  and this can be computed from the restriction of <char> to this cyclic
##  subgroup or, equivalently, by the power maps  of <tbl>.
##
#T > I would like to know if there is a quickier way to compute the
#T > characteristic polynomial f=f(G) of a representative G
#T > of a conjugacy class mentioned
#T > above, than using Eigenvalues().
#T > (The latter function involves using algebraic numbers,
#T > whereas  it might happen
#T > that f has rational or integer coefficients ,
#T > i.e. all the irrationalies cancel)
#T 
#T For example, if the character values in question are rational
#T one can use Galois sums of the irreducible characters of the cyclic
#T subgroup instead of the irreducible characters when computing
#T scalar products,
#T because the multiplicities of Galois conjugate eigenvalues are equal
#T in such a case.
#T This avoids computations with non-rational numbers.
##
InstallMethod( EigenvaluesChar,
    "for a class function and a positive integer",
    [ IsClassFunction, IsPosInt ],
    function( chi, class )
    return EigenvaluesChar( UnderlyingCharacterTable( chi ),
                            ValuesOfClassFunction( chi ), class );
    end );

InstallMethod( EigenvaluesChar,
    "for a character table and a hom. list, and a pos.",
    [ IsCharacterTable, IsHomogeneousList, IsPosInt ],
    function( tbl, char, class )
    local i, j, n, powers, eigen, e, val;

    n:= OrdersClassRepresentatives( tbl )[ class ];
    if n = 1 then return [ char[ class ] ]; fi;

    # Compute necessary power maps and the restricted character.
    powers:= [];
    powers[n]:= char[1];
    for i in [ 1 .. n-1 ] do
      if not IsBound( powers[i] ) then

        # necessarily 'i' divides 'n', since 'i/Gcd(n,i)' is invertible
        # mod 'n', and thus powering with 'i' is Galois conjugate to
        # powering with 'Gcd(n,i)'
        powers[i]:= char[ PowerMap( tbl, i, class ) ];
#T better approach:
#T only write down values for one representative of each
#T Galois family, and compute traces;
#T for rational characters, this avoids computation with
#T non-rational values at all.
#T (how much does this help?)
        for j in PrimeResidues( n/i ) do

          # Note that the position cannot be 0.
          powers[ ( i*j ) mod n ]:= GaloisCyc( powers[i], j );
        od;
      fi;
    od;

    # compute the scalar products of the characters given by 'E(n)->E(n)^i'
    # with the restriction of <char> to the cyclic group generated by
    # <class>
    eigen:= [];
    for i in [ 1 .. n ] do
      e:= E(n)^(-i);
      val:= 0;
      for j in [ 1 .. n ] do val:= val + e^j * powers[j]; od;
      eigen[i]:= val / n;
    od;

    return eigen;
    end );


#############################################################################
##
#M  Tensored( <chars1>, <chars2> )  . . . .  for two lists of class functions
##
InstallMethod( Tensored,
    "method for two homogeneous lists",
    [ IsHomogeneousList, IsHomogeneousList ],
    function( chars1, chars2 )
    local i, j, k, nccl, tensored, single;

    if IsEmpty( chars1 ) or IsEmpty( chars2 ) then
      return [];
    fi;

    nccl:= Length( chars1[1] );
    tensored:= [];

    for i in chars1 do
      for j in chars2 do

        single:= [];
        for k in [ 1 .. nccl ] do
          single[k]:= i[k] * j[k];
        od;

        if HasIsCharacter( i ) and IsCharacter( i ) and
           HasIsCharacter( j ) and IsCharacter( j ) and
           UnderlyingCharacterTable( i ) = UnderlyingCharacterTable( j ) then
          single:= Character( UnderlyingCharacterTable( i ), single );
        elif HasIsVirtualCharacter( i ) and IsVirtualCharacter( i ) and
           HasIsVirtualCharacter( j ) and IsVirtualCharacter( j ) and
           UnderlyingCharacterTable( i ) = UnderlyingCharacterTable( j ) then
          single:= VirtualCharacter( UnderlyingCharacterTable( i ), single );
        elif IsClassFunction( i ) and IsClassFunction( j ) and
           UnderlyingCharacterTable( i ) = UnderlyingCharacterTable( j ) then
          single:= ClassFunction( UnderlyingCharacterTable( i ), single );
        fi;

        Add( tensored, single );

      od;
    od;

    return tensored;
    end );


#############################################################################
##
##  9. Restricted and Induced Class Functions
##


#############################################################################
##
#M  RestrictedClassFunction( [<tbl>, ]<chi>, <H> )
#M  RestrictedClassFunction( [<tbl>, ]<chi>, <hom> )
#M  RestrictedClassFunction( [<tbl>, ]<chi>, <subtbl> )
##
InstallMethod( RestrictedClassFunction,
    "for a class function, and a group",
    [ IsClassFunction, IsGroup ],
    function( chi, H )
    local subtbl, tbl, fus;

    subtbl:= OrdinaryCharacterTable( H );
    tbl:= UnderlyingCharacterTable( chi );
    if UnderlyingCharacteristic( tbl ) <> 0 then
      subtbl:= subtbl mod UnderlyingCharacteristic( tbl );
    fi;
    fus:= FusionConjugacyClasses( subtbl, tbl );
    if fus = fail then
      Error( "no fusion from <subtbl> to <tbl>" );
    fi;
    return ClassFunctionSameType( subtbl, chi, chi{ fus } );
    end );

InstallMethod( RestrictedClassFunction,
    "for a character table, a homogeneous list, and a group",
    [ IsNearlyCharacterTable, IsHomogeneousList, IsGroup ],
    function( tbl, chi, H )
    local subtbl, fus;

    subtbl:= OrdinaryCharacterTable( H );
    if UnderlyingCharacteristic( tbl ) <> 0 then
      subtbl:= subtbl mod UnderlyingCharacteristic( tbl );
    fi;
    fus:= FusionConjugacyClasses( subtbl, tbl );
    if fus = fail then
      Error( "no fusion from <subtbl> to <tbl>" );
    fi;
    return ClassFunction( subtbl, chi{ fus } );
    end );

InstallMethod( RestrictedClassFunction,
    "for a class function and a group homomorphism",
    [ IsClassFunction, IsGeneralMapping ],
    function( chi, hom )
    local tbl, subtbl, fus;

    subtbl:= CharacterTable( PreImage( hom ) );
    tbl:= UnderlyingCharacterTable( chi );
    if UnderlyingCharacteristic( tbl ) <> 0 then
      subtbl:= subtbl mod UnderlyingCharacteristic( tbl );
    fi;
    fus:= FusionConjugacyClasses( hom, subtbl, tbl );
    if fus = fail then
      Error( "no fusion from <subtbl> to <tbl>" );
    fi;
    return ClassFunctionSameType( subtbl, chi,
               ValuesOfClassFunction( chi ){ fus } );
    end );

InstallMethod( RestrictedClassFunction,
    "for a character table, a homogeneous list, and a group homomorphism",
    [ IsNearlyCharacterTable, IsHomogeneousList, IsGeneralMapping ],
    function( tbl, chi, hom )
    local subtbl, fus;

    subtbl:= CharacterTable( PreImage( hom ) );
    if UnderlyingCharacteristic( tbl ) <> 0 then
      subtbl:= subtbl mod UnderlyingCharacteristic( tbl );
    fi;
    fus:= FusionConjugacyClasses( hom, subtbl, tbl );
    if fus = fail then
      Error( "no fusion from <subtbl> to <tbl>" );
    fi;
    return ClassFunction( subtbl, chi{ fus } );
    end );

InstallMethod( RestrictedClassFunction,
    "for class function and nearly character table",
    [ IsClassFunction, IsNearlyCharacterTable ],
    function( chi, subtbl )
    local fus;

    fus:= FusionConjugacyClasses( subtbl, UnderlyingCharacterTable( chi ) );
    if fus = fail then
      Error( "class fusion not available" );
    fi;
    return ClassFunctionSameType( subtbl, chi,
               ValuesOfClassFunction( chi ){ fus } );
    end );

InstallMethod( RestrictedClassFunction,
    "for a character table, a homogeneous list, and a character table",
    [ IsNearlyCharacterTable, IsHomogeneousList, IsNearlyCharacterTable ],
    function( tbl, chi, subtbl )
    local fus;

    fus:= FusionConjugacyClasses( subtbl, tbl );
    if fus = fail then
      Error( "class fusion not available" );
    fi;
    return ClassFunction( subtbl, chi{ fus } );
    end );


#############################################################################
##
#M  RestrictedClassFunctions( [<tbl>, ]<chars>, <H> )
#M  RestrictedClassFunctions( [<tbl>, ]<chars>, <hom> )
#M  RestrictedClassFunctions( [<tbl>, ]<chars>, <subtbl> )
##
InstallMethod( RestrictedClassFunctions,
    "for list and group",
    [ IsList, IsGroup ],
    function( chars, H )
    return List( chars, chi -> RestrictedClassFunction( chi, H ) );
    end );

InstallMethod( RestrictedClassFunctions,
    "for list and group homomorphism",
    [ IsList, IsGeneralMapping ],
    function( chars, hom )
    return List( chars, chi -> RestrictedClassFunction( chi, hom ) );
    end );

InstallMethod( RestrictedClassFunctions,
    "for list and character table",
    [ IsList, IsCharacterTable ],
    function( chars, subtbl )
    return List( chars, chi -> RestrictedClassFunction( chi, subtbl ) );
    end );

InstallMethod( RestrictedClassFunctions,
    "for a character table, a list, and a group",
    [ IsCharacterTable, IsList, IsGroup ],
    function( tbl, chars, H )
    local subtbl, fus;

    subtbl:= OrdinaryCharacterTable( H );
    if UnderlyingCharacteristic( tbl ) <> 0 then
      subtbl:= subtbl mod UnderlyingCharacteristic( tbl );
    fi;
    fus:= FusionConjugacyClasses( subtbl, tbl );
    if fus = fail then
      Error( "no fusion from <subtbl> to <tbl>" );
    fi;
    return List( chars, chi -> ClassFunctionSameType( subtbl, chi,
                                   ValuesOfClassFunction( chi ){ fus } ) );
    end );

InstallMethod( RestrictedClassFunctions,
    "for a character table, a list, and a group homomorphism",
    [ IsCharacterTable, IsList, IsGeneralMapping ],
    function( tbl, chars, hom )
    local subtbl, fus;

    subtbl:= CharacterTable( PreImage( hom ) );
    if UnderlyingCharacteristic( tbl ) <> 0 then
      subtbl:= subtbl mod UnderlyingCharacteristic( tbl );
    fi;
    fus:= FusionConjugacyClasses( hom, subtbl, tbl );
    if fus = fail then
      Error( "class fusion not available" );
    fi;
    return List( chars, chi -> ClassFunctionSameType( subtbl, chi,
                                   ValuesOfClassFunction( chi ){ fus } ) );
    end );

InstallMethod( RestrictedClassFunctions,
    "for a character table, a list, and a character table",
    [ IsCharacterTable, IsList, IsCharacterTable ],
    function( tbl, chars, subtbl )
    local fus;

    fus:= FusionConjugacyClasses( subtbl, tbl );
    if fus = fail then
      Error( "class fusion not available" );
    fi;
    return List( chars, chi -> ClassFunctionSameType( subtbl, chi,
                                   ValuesOfClassFunction( chi ){ fus } ) );
    end );


#############################################################################
##
#M  Restricted( <tbl>, <subtbl>, <chars> )
#M  Restricted( <tbl>, <subtbl>, <chars>, <specification> )
#M  Restricted( <chars>, <fusionmap> )
##
##  These methods are installed just for compatibility with {\GAP}~3.
##
InstallMethod( Restricted,
    [ IsNearlyCharacterTable, IsNearlyCharacterTable, IsHomogeneousList ],
    function( tbl, subtbl, chars )
    local fus;

    fus:= FusionConjugacyClasses( subtbl, tbl );
    if fus = fail then
      Error( "class fusion not available" );
    fi;
    return List( chars, row -> ClassFunction( subtbl, row{ fus } ) );
    end );

InstallMethod( Restricted,
    [ IsNearlyCharacterTable, IsNearlyCharacterTable, IsMatrix, IsObject ],
    function( tbl, subtbl, chars, specification )
    local fus;

    fus:= GetFusionMap( subtbl, tbl, specification );
    if fus = fail then
      Error( "class fusion not available" );
    fi;
    return List( chars, row -> ClassFunction( subtbl, row{ fus } ) );
    end );

InstallMethod( Restricted,
    [ IsList, IsList and IsCyclotomicCollection ],
    function( mat, fus )
    if ForAll( mat, IsList ) then
      return List( mat, row -> row{ fus } );
    fi;
    Error( "<mat> must be a matrix" );
    end );


#############################################################################
##
#M  Restricted( [<tbl>, ]<chi>, <H> )
#M  Restricted( [<tbl>, ]<chi>, <hom> )
#M  Restricted( [<tbl>, ]<chi>, <tbl> )
#M  Restricted( [<tbl>, ]<chars>, <H> )
#M  Restricted( [<tbl>, ]<chars>, <hom> )
#M  Restricted( [<tbl>, ]<chars>, <tbl> )
##
InstallMethod( Restricted,
    [ IsClassFunction, IsGroup ],
    RestrictedClassFunction );

InstallMethod( Restricted,
    [ IsCharacterTable, IsHomogeneousList, IsGroup ],
    function( tbl, list, H )
    if IsMatrix( list ) then
      return RestrictedClassFunctions( tbl, list, H );
    else
      return RestrictedClassFunction( tbl, list, H );
    fi;
    end );

InstallMethod( Restricted,
    [ IsClassFunction, IsGroupHomomorphism ],
    RestrictedClassFunction );

InstallMethod( Restricted,
    [ IsCharacterTable, IsClassFunction, IsGroupHomomorphism ],
    function( tbl, list, hom )
    if IsMatrix( list ) then
      return RestrictedClassFunctions( tbl, list, hom );
    else
      return RestrictedClassFunction( tbl, list, hom );
    fi;
    end );

InstallMethod( Restricted,
    [ IsClassFunction, IsNearlyCharacterTable ],
    RestrictedClassFunction );

InstallMethod( Restricted,
    [ IsCharacterTable, IsClassFunction, IsNearlyCharacterTable ],
    function( tbl, list, subtbl )
    if IsMatrix( list ) then
      return RestrictedClassFunctions( tbl, list, subtbl );
    else
      return RestrictedClassFunction( tbl, list, subtbl );
    fi;
    end );

InstallMethod( Restricted,
    [ IsHomogeneousList, IsGroup ],
    function( list, H )
    if ForAll( list, IsClassFunction ) then
      return RestrictedClassFunctions( list, H );
    else
      TryNextMethod();
    fi;
    end );

InstallMethod( Restricted,
    [ IsHomogeneousList, IsGroupHomomorphism ],
    function( list, hom )
    if ForAll( list, IsClassFunction ) then
      return RestrictedClassFunctions( list, hom );
    else
      TryNextMethod();
    fi;
    end );

InstallMethod( Restricted,
    [ IsHomogeneousList, IsNearlyCharacterTable ],
    function( list, subtbl )
    if ForAll( list, IsClassFunction ) then
      return RestrictedClassFunctions( list, subtbl );
    else
      TryNextMethod();
    fi;
    end );


#############################################################################
##
#F  InducedClassFunctionsByFusionMap( <subtbl>, <tbl>, <chars>, <fusionmap> )
##
InstallGlobalFunction( InducedClassFunctionsByFusionMap,
    function( subtbl, tbl, chars, fusion )
    local j, im,          # loop variables
          centralizers,   # centralizer orders in hte supergroup
          nccl,           # number of conjugacy classes of the group
          subnccl,        # number of conjugacy classes of the subgroup
          suborder,       # order of the subgroup
          subclasses,     # class lengths in the subgroup
          induced,        # list of induced characters, result
          singleinduced,  # one induced character
          char;           # one character to be induced

    if fusion = fail then
      return fail;
    fi;

    centralizers:= SizesCentralizers( tbl );
    nccl:= Length( centralizers );
    suborder:= Size( subtbl );
    subclasses:= SizesConjugacyClasses( subtbl );
    subnccl:= Length( subclasses );

    induced:= [];

    for char in chars do

      # Preset the character with zeros.
      singleinduced:= ListWithIdenticalEntries( nccl, 0 );

      # Add the contribution of each class of the subgroup.
      for j in [ 1 .. subnccl ] do
        if char[j] <> 0 then
          if IsInt( fusion[j] ) then
            singleinduced[ fusion[j] ]:= singleinduced[ fusion[j] ]
                                     + char[j] * subclasses[j];
          else
            for im in fusion[j] do singleinduced[ im ]:= Unknown(); od;
#T only for TableInProgress!
          fi;
        fi;
      od;

      # Adjust the values by multiplication.
      for j in [ 1 .. nccl ] do
        singleinduced[j]:= singleinduced[j] * centralizers[j] / suborder;
        if not IsCycInt( singleinduced[j] ) then
          singleinduced[j]:= Unknown();
          Info( InfoCharacterTable, 1,
                "Induced: subgroup order not dividing sum in character ",
                Length( induced ) + 1, " at class ", j );
        fi;
      od;

      # Create the class function object.
      if IsClassFunction( char ) then
        singleinduced:= ClassFunctionSameType( tbl, char, singleinduced );
      else
        singleinduced:= ClassFunction( tbl, singleinduced );
      fi;

      Add( induced, singleinduced );

    od;

    # Return the list of induced characters.
    return induced;
end );


#############################################################################
##
#M  InducedClassFunction( [<tbl>, ]<chi>, <H> )
#M  InducedClassFunction( [<tbl>, ]<chi>, <hom> )
#M  InducedClassFunction( [<tbl>, ]<chi>, <suptbl> )
##
InstallMethod( InducedClassFunction,
    "for a class function and a group",
    [ IsClassFunction, IsGroup ],
    function( chi, G )
    local tbl, suptbl, fus;
    tbl:= UnderlyingCharacterTable( chi );
    suptbl:= OrdinaryCharacterTable( G );
    if UnderlyingCharacteristic( tbl ) <> 0 then
      suptbl:= suptbl mod UnderlyingCharacteristic( tbl );
    fi;
    fus:= FusionConjugacyClasses( tbl, suptbl );
    return InducedClassFunctionsByFusionMap( tbl, suptbl, [ chi ], fus )[1];
    end );

InstallMethod( InducedClassFunction,
    "for a character table, a homogeneous list, and a group",
    [ IsCharacterTable, IsHomogeneousList, IsGroup ],
    function( tbl, chi, G )
    local suptbl, fus;
    suptbl:= OrdinaryCharacterTable( G );
    if UnderlyingCharacteristic( tbl ) <> 0 then
      suptbl:= suptbl mod UnderlyingCharacteristic( tbl );
    fi;
    fus:= FusionConjugacyClasses( tbl, suptbl );
    return InducedClassFunctionsByFusionMap( tbl, suptbl, [ chi ], fus )[1];
    end );

InstallMethod( InducedClassFunction,
    "for class function and nearly character table",
    [ IsClassFunction, IsNearlyCharacterTable ],
    function( chi, suptbl )
    local tbl, fus;
    tbl:= UnderlyingCharacterTable( chi );
    fus:= FusionConjugacyClasses( tbl, suptbl );
    return InducedClassFunctionsByFusionMap( tbl, suptbl, [ chi ], fus )[1];
    end );

InstallMethod( InducedClassFunction,
    "for character table, homogeneous list, and nearly character table",
    [ IsCharacterTable, IsHomogeneousList, IsNearlyCharacterTable ],
    function( tbl, chi, suptbl )
    local fus;
    fus:= FusionConjugacyClasses( tbl, suptbl );
    return InducedClassFunctionsByFusionMap( tbl, suptbl, [ chi ], fus )[1];
    end );

InstallMethod( InducedClassFunction,
    "for a class function and a group homomorphism",
    [ IsClassFunction, IsGeneralMapping ],
    function( chi, hom )
    local tbl, suptbl, fus;
    tbl:= UnderlyingCharacterTable( chi );
    suptbl:= OrdinaryCharacterTable(Image( hom ));
    if UnderlyingCharacteristic( tbl ) <> 0 then
      suptbl:= suptbl mod UnderlyingCharacteristic( tbl );
    fi;
    fus:= FusionConjugacyClasses( hom, tbl, suptbl );
    return InducedClassFunctionsByFusionMap( tbl, suptbl, [ chi ], fus )[1];
    end );

InstallMethod( InducedClassFunction,
    "for a character table, a homogeneous list, and a group homomorphism",
    [ IsCharacterTable, IsHomogeneousList, IsGeneralMapping ],
    function( tbl, chi, hom )
    local suptbl, fus;
    suptbl:= OrdinaryCharacterTable(Image( hom ));
    if UnderlyingCharacteristic( tbl ) <> 0 then
      suptbl:= suptbl mod UnderlyingCharacteristic( tbl );
    fi;
    fus:= FusionConjugacyClasses( hom, tbl, suptbl );
    return InducedClassFunctionsByFusionMap( tbl, suptbl, [ chi ], fus )[1];
    end );


#############################################################################
##
#M  InducedClassFunctions( [<tbl>, ]<chars>, <H> )
#M  InducedClassFunctions( [<tbl>, ]<chars>, <hom> )
#M  InducedClassFunctions( [<tbl>, ]<chars>, <suptbl> )
##
InstallMethod( InducedClassFunctions,
    "for list, and group",
    [ IsList, IsGroup ],
    function( chars, H )
    return List( chars, chi -> InducedClassFunction( chi, H ) );
    end );

InstallMethod( InducedClassFunctions,
    "for list, and group homomorphism",
    [ IsList, IsGeneralMapping ],
    function( chars, hom )
    return List( chars, chi -> InducedClassFunction( chi, hom ) );
    end );

InstallMethod( InducedClassFunctions,
    "for list, and group homomorphism",
    [ IsList, IsCharacterTable ],
    function( chars, suptbl )
    return List( chars, chi -> InducedClassFunction( chi, suptbl ) );
    end );

InstallMethod( InducedClassFunctions,
    "for a character table, a homogeneous list, and a group",
    [ IsCharacterTable, IsHomogeneousList, IsGroup ],
    function( tbl, chars, G )
    local suptbl, fus;
    suptbl:= OrdinaryCharacterTable( G );
    if UnderlyingCharacteristic( tbl ) <> 0 then
      suptbl:= suptbl mod UnderlyingCharacteristic( tbl );
    fi;
    fus:= FusionConjugacyClasses( tbl, suptbl );
    return InducedClassFunctionsByFusionMap( tbl, suptbl, chars, fus );
    end );

InstallMethod( InducedClassFunctions,
    "for character table, homogeneous list, and nearly character table",
    [ IsCharacterTable, IsHomogeneousList, IsNearlyCharacterTable ],
    function( tbl, chars, suptbl )
    local fus;
    fus:= FusionConjugacyClasses( tbl, suptbl );
    return InducedClassFunctionsByFusionMap( tbl, suptbl, chars, fus );
    end );

InstallMethod( InducedClassFunctions,
    "for a character table, a homogeneous list, and a group homomorphism",
    [ IsCharacterTable, IsHomogeneousList, IsGeneralMapping ],
    function( tbl, chars, hom )
    local suptbl, fus;
    suptbl:= Image( hom );
    if UnderlyingCharacteristic( tbl ) <> 0 then
      suptbl:= suptbl mod UnderlyingCharacteristic( tbl );
    fi;
    fus:= FusionConjugacyClasses( hom, tbl, suptbl );
    return InducedClassFunctionsByFusionMap( tbl, suptbl, chars, fus );
    end );


#############################################################################
##
#M  Induced( [<tbl>, ]<chi>, <H> )
#M  Induced( [<tbl>, ]<chi>, <hom> )
#M  Induced( [<tbl>, ]<chi>, <suptbl> )
#M  Induced( [<tbl>, ]<chars>, <H> )
#M  Induced( [<tbl>, ]<chars>, <hom> )
#M  Induced( [<tbl>, ]<chars>, <suptbl> )
##
InstallMethod( Induced,
    [ IsClassFunction, IsGroup ],
    InducedClassFunction );

InstallMethod( Induced,
    [ IsCharacterTable, IsHomogeneousList, IsGroup ],
    function( tbl, list, H )
    if IsMatrix( list ) then
      return InducedClassFunctions( tbl, list, H );
    else
      return InducedClassFunction( tbl, list, H );
    fi;
    end );

InstallMethod( Induced,
    [ IsClassFunction, IsGroupHomomorphism ],
    InducedClassFunction );

InstallMethod( Induced,
    [ IsCharacterTable, IsHomogeneousList, IsGroupHomomorphism ],
    function( tbl, list, hom )
    if IsMatrix( list ) then
      return InducedClassFunctions( tbl, list, hom );
    else
      return InducedClassFunction( tbl, list, hom );
    fi;
    end );

InstallMethod( Induced,
    [ IsClassFunction, IsNearlyCharacterTable ],
    InducedClassFunction );

InstallMethod( Induced,
    [ IsCharacterTable, IsHomogeneousList, IsNearlyCharacterTable ],
    function( tbl, list, suptbl )
    if IsMatrix( list ) then
      return InducedClassFunctions( tbl, list, suptbl );
    else
      return InducedClassFunction( tbl, list, suptbl );
    fi;
    end );

InstallMethod( Induced,
    [ IsHomogeneousList, IsGroup ],
    function( list, H )
    if ForAll( list, IsClassFunction ) then
      return InducedClassFunctions( list, H );
    else
      TryNextMethod();
    fi;
    end );

InstallMethod( Induced,
    [ IsHomogeneousList, IsGeneralMapping ],
    function( list, hom )
    if ForAll( list, IsClassFunction ) then
      return InducedClassFunctions( list, hom );
    else
      TryNextMethod();
    fi;
    end );

InstallMethod( Induced,
    [ IsHomogeneousList, IsCharacterTable ],
    function( list, suptbl )
    if ForAll( list, IsClassFunction ) then
      return InducedClassFunctions( list, suptbl );
    else
      TryNextMethod();
    fi;
    end );


#############################################################################
##
#M  Induced( <subtbl>, <tbl>, <chars> )
#M  Induced( <subtbl>, <tbl>, <chars>, <specification> )
#M  Induced( <subtbl>, <tbl>, <chars>, <fusionmap> )
##
##  These methods are installed just for compatibility with {\GAP}~3.
##
InstallMethod( Induced,
    "for two nearly character tables, and homog list",
    [ IsNearlyCharacterTable, IsNearlyCharacterTable, IsHomogeneousList ],
    function( subtbl, tbl, chars )
    return InducedClassFunctionsByFusionMap( subtbl, tbl, chars,
               FusionConjugacyClasses( subtbl, tbl ) );
    end );

InstallMethod( Induced,
    "for two nearly character tables, homog list, and string",
    [ IsNearlyCharacterTable, IsNearlyCharacterTable,
      IsHomogeneousList, IsString ],
    function( subtbl, tbl, chars, specification )
    return InducedClassFunctionsByFusionMap( subtbl, tbl, chars,
               FusionConjugacyClasses( subtbl, tbl, specification ) );
    end );

InstallMethod( Induced,
    "for two nearly character tables and two homog. lists",
    [ IsNearlyCharacterTable, IsNearlyCharacterTable,
      IsHomogeneousList, IsHomogeneousList and IsCyclotomicCollection ],
    InducedClassFunctionsByFusionMap );


#############################################################################
##
#M  InducedCyclic( <tbl> )
#M  InducedCyclic( <tbl>, \"all\" )
#M  InducedCyclic( <tbl>, <classes> )
#M  InducedCyclic( <tbl>, <classes>, \"all\" )
##
InstallMethod( InducedCyclic,
    "for a character table",
    [ IsOrdinaryTable ],
    tbl -> InducedCyclic( tbl, [ 1 .. NrConjugacyClasses( tbl ) ] ) );

InstallMethod( InducedCyclic,
    "for a character table and a string",
    [ IsOrdinaryTable, IsString ],
    # The `string' should overrule over the `homogeneous list' installed in
    # the next method
    1,
    function( tbl, all )
    return InducedCyclic( tbl, [ 1 .. NrConjugacyClasses( tbl ) ], all );
    end );

InstallMethod( InducedCyclic,
    "for a character table and a hom. list",
    [ IsOrdinaryTable, IsHomogeneousList ],
    function( tbl, classes )
    local centralizers,
          orders,
          independent,
          inducedcyclic,
          i,
          fusion,
          j,
          single;

    centralizers:= SizesCentralizers( tbl );
    orders:= OrdersClassRepresentatives( tbl );
    independent:= List( orders, x -> true );
    inducedcyclic:= [];
    for i in classes do                         # induce from i-th class
      if independent[i] then
        fusion:= [ i ];
        for j in [ 2 .. orders[i] ] do
          fusion[j]:= PowerMap( tbl, j, i );    # j-th powermap at class i
        od;
	single:= ListWithIdenticalEntries(Length(orders),0);
        for j in fusion do
          if orders[j] = orders[i] then
            # position is Galois conjugate to 'i'
            independent[j]:= false;
          fi;
          single[j]:= single[j] + 1;
        od;
        for j in [ 1 .. Length( orders ) ] do
          single[j]:= single[j] * centralizers[j] / orders[i];
          if not IsInt( single[j] ) then
            single[j]:= Unknown();
            Info( InfoCharacterTable, 1,
                  "InducedCyclic: subgroup order not dividing sum",
                  " (induce from class ", i, ")" );
          fi;
        od;
        AddSet( inducedcyclic, Character( tbl, single ) );
      fi;
    od;
    return inducedcyclic;
    end );

InstallMethod( InducedCyclic,
    "for a character table, a hom. list, and a string",
    [ IsOrdinaryTable, IsHomogeneousList, IsString ],
    function( tbl, classes, all )
    local centralizers,
          orders,
          independent,
          inducedcyclic,
          i,
          fusion,
          j,
          k,
          single;

    centralizers:= SizesCentralizers( tbl );
    orders:= OrdersClassRepresentatives( tbl );
    independent:= List( orders, x -> true );
    inducedcyclic:= [];
    for i in classes do                         # induce from i-th class
      if independent[i] then
        fusion:= [ i ];
        for j in [ 2 .. orders[i] ] do
          fusion[j]:= PowerMap( tbl, j, i );    # j-th powermap at class i
        od;

        for k in [ 0 .. orders[i] - 1 ] do      # induce k-th character
	  single:= ListWithIdenticalEntries(Length(orders),0);
          single[i]:= E( orders[i] ) ^ ( k );
          for j in [ 2 .. orders[i] ] do
            if orders[ fusion[j] ] = orders[i] then

              # position is Galois conjugate
              independent[ fusion[j] ]:= false;
            fi;
            single[ fusion[j] ]:=
                single[ fusion[j] ] + E( orders[i] )^( k*j mod orders[i] );
          od;
          for j in [ 1 .. Length( orders ) ] do
            single[j]:= single[j] * centralizers[j] / orders[i];
            if not IsCycInt( single[j] ) then
              single[j]:= Unknown();
              Info( InfoCharacterTable, 1,
                    "InducedCyclic: subgroup order not dividing sum",
                    " (induce from class ", i, ")" );
            fi;
          od;
          AddSet( inducedcyclic, Character( tbl, single ) );
        od;
      fi;
    od;
    return inducedcyclic;
    end );


#############################################################################
##
##  10. Reducing Virtual Characters
##


#############################################################################
##
#M  ReducedClassFunctions( [<ordtbl>, ]<constituents>, <reducibles> )
#M  ReducedClassFunctions( [<ordtbl>, ]<reducibles> )
##
InstallMethod( ReducedClassFunctions,
    "for two lists (of class functions)",
    [ IsHomogeneousList, IsHomogeneousList ],
    function( constituents, reducibles )
    if IsEmpty( constituents ) then
      return rec( irreducibles:= [],
                  remainders:= ShallowCopy( reducibles ) );
    elif IsClassFunction( constituents[1] ) then
      return ReducedClassFunctions(
                 UnderlyingCharacterTable( constituents[1] ),
                 constituents, reducibles );
    else
      TryNextMethod();
    fi;
    end );

InstallMethod( ReducedClassFunctions,
    "for a list (of class functions)",
    [ IsHomogeneousList ],
    function( reducibles )
    if IsEmpty( reducibles ) then
      return rec( irreducibles:= [],
                  remainders:= [] );
    elif IsClassFunction( reducibles[1] ) then
      return ReducedClassFunctions(
                 UnderlyingCharacterTable( reducibles[1] ),
                 reducibles );
    else
      TryNextMethod();
    fi;
    end );

InstallMethod( ReducedClassFunctions,
    "for ordinary character table, and two lists (of class functions)",
    [ IsOrdinaryTable, IsHomogeneousList , IsHomogeneousList ],
    function( ordtbl, constituents, reducibles )
    local i, j,
          normsquare,
          upper,
          found,          # list of found irreducible characters
          remainders,     # list of reducible remainders after reduction
          single,
          reduced,
          scpr;

    upper:= Length( constituents );
    upper:= List( reducibles, x -> upper );
    normsquare:= List( constituents, x -> ScalarProduct( ordtbl, x, x ) );
    found:= [];
    remainders:= [];

    for i in [ 1 .. Length( reducibles ) ] do
      single:= reducibles[i];
      for j in [ 1 .. upper[i] ] do
        scpr:= ScalarProduct( ordtbl, single, constituents[j] );
        if IsInt( scpr ) then
          scpr:= Int( scpr / normsquare[j] );
          if scpr <> 0 then
            single:= single - scpr * constituents[j];
          fi;
        else
          Info( InfoCharacterTable, 1,
                "ReducedClassFunctions: scalar product of X[", j,
                "] with Y[", i, "] not integral (ignore)" );
        fi;
      od;
      if ForAny( single, x -> x <> 0 ) then
        if single[1] < 0 then
          single:= - single;
        fi;
        if ScalarProduct( ordtbl, single, single ) = 1 then
          if not single in found and not single in constituents then
            Info( InfoCharacterTable, 2,
                  "ReducedClassFunctions: irreducible character of degree ",
                  single[1], " found" );
            if IsClassFunction( single ) then
              SetIsCharacter( single, true );
            fi;
            AddSet( found, single );
          fi;
        else
          AddSet( remainders, single );
        fi;
      fi;
    od;

    # If no irreducibles were found, return the remainders.
    if IsEmpty( found ) then
      return rec( remainders:= remainders, irreducibles:= [] );
    fi;

    # Try to find new irreducibles by recursively calling the reduction.
    reduced:= ReducedClassFunctions( ordtbl, found, remainders );

    # Return the result.
    return rec( remainders:= reduced.remainders,
                irreducibles:= Union( found, reduced.irreducibles ) );
    end );

InstallMethod( ReducedClassFunctions,
    "for ordinary character table, and list of class functions",
    [ IsOrdinaryTable, IsHomogeneousList ],
    function( ordtbl, reducibles )
    local upper,
          normsquare,
          found,        # list of found irreducible characters
          remainders,   # list of reducible remainders after reduction
          i, j,
          single,
          reduced,
          scpr;

    upper:= [ 0 .. Length( reducibles ) - 1 ];
    normsquare:= List( reducibles, x -> ScalarProduct( ordtbl, x, x ) );
    found:= [];
    remainders:= [];

    for i in [ 1 .. Length( reducibles ) ] do
      if normsquare[i] = 1 then
        if 0 < reducibles[i][1] then
          AddSet( found, reducibles[i] );
        else
          AddSet( found, - reducibles[i] );
        fi;
      fi;
    od;

    for i in [ 1 .. Length( reducibles ) ] do
      single:= reducibles[i];
      for j in [ 1 .. upper[i] ] do
        scpr:= ScalarProduct( ordtbl, single, reducibles[j] );
        if IsInt( scpr ) then
          scpr:= Int( scpr / normsquare[j] );
          if scpr <> 0 then
            single:= single - scpr * reducibles[j];
          fi;
        else
          Info( InfoCharacterTable, 1,
                "ReducedClassFunctions: scalar product of X[", j,
                "] with Y[", i, "] not integral (ignore)" );
        fi;
      od;
      if ForAny( single, x -> x <> 0 ) then
        if single[1] < 0 then
          single:= - single;
        fi;
        if ScalarProduct( ordtbl, single, single ) = 1 then
          if not single in found and not single in reducibles then
            Info( InfoCharacterTable, 2,
                  "ReducedClassFunctions: irreducible character of degree ",
                  single[1], " found" );
            if IsClassFunction( single ) then
              SetIsCharacter( single, true );
            fi;
            AddSet( found, single );
          fi;
        else
          AddSet( remainders, single );
        fi;
      fi;
    od;

    # If no irreducibles were found, return the remainders.
    if IsEmpty( found ) then
      return rec( remainders:= remainders, irreducibles:= [] );
    fi;

    # Try to find new irreducibles by recursively calling the reduction.
    reduced:= ReducedClassFunctions( ordtbl, found, remainders );

    # Return the result.
    return rec( remainders:= reduced.remainders,
                irreducibles:= Union( found, reduced.irreducibles ) );
    end );


#############################################################################
##
#M  ReducedCharacters( [<ordtbl>, ]<constituents>, <reducibles> )
##
InstallMethod( ReducedCharacters,
    "for two lists (of characters)",
    [ IsHomogeneousList , IsHomogeneousList ],
    function( constituents, reducibles )
    if IsEmpty( constituents ) then
      return rec( irreducibles:= [],
                  remainders:= ShallowCopy( reducibles ) );
    elif IsClassFunction( constituents[1] ) then
      return ReducedCharacters(
                 UnderlyingCharacterTable( constituents[1] ),
                 constituents, reducibles );
    else
      TryNextMethod();
    fi;
    end );

InstallMethod( ReducedCharacters,
    "for ordinary character table, and two lists of characters",
    [ IsOrdinaryTable, IsHomogeneousList , IsHomogeneousList ],
    function( ordtbl, constituents, reducibles )
    local normsquare,
          found,
          remainders,
          single,
          i, j,
          nchars,
          reduced,
          scpr;

    normsquare:= List( constituents, x -> ScalarProduct( ordtbl, x, x ) );
    found:= [];
    remainders:= [];
    nchars:= Length( constituents );
    for i in [ 1 .. Length( reducibles ) ] do

      single:= reducibles[i];
      for j in [ 1 .. nchars ] do
        if constituents[j][1] <= single[1] then
          scpr:= ScalarProduct( ordtbl, single, constituents[j] );
          if IsInt( scpr ) then
            scpr:= Int( scpr / normsquare[j] );
            if scpr <> 0 then
              single:= single - scpr * constituents[j];
            fi;
          else
            Info( InfoCharacterTable, 1,
                  "ReducedCharacters: scalar product of X[", j, "] with Y[",
                  i, "] not integral (ignore)" );
          fi;
        fi;
      od;

      if ForAny( single, x -> x <> 0 ) then
        if ScalarProduct( ordtbl, single, single ) = 1 then
          if single[1] < 0 then single:= - single; fi;
          if not single in found and not single in constituents then
            Info( InfoCharacterTable, 2,
                  "ReducedCharacters: irreducible character of",
                  " degree ", single[1], " found" );
            if IsClassFunction( single ) then
              SetIsCharacter( single, true );
            fi;
            AddSet( found, single );
          fi;
        else
          AddSet( remainders, single );
        fi;
      fi;

    od;

    # If no irreducibles were found, return the remainders.
    if IsEmpty( found ) then
      return rec( remainders:= remainders, irreducibles:= [] );
    fi;

    # Try to find new irreducibles by recursively calling the reduction.
    reduced:= ReducedCharacters( ordtbl, found, remainders );

    # Return the result.
    return rec( remainders:= reduced.remainders,
                irreducibles:= Union( found, reduced.irreducibles ) );
    end );


#############################################################################
##
#F  IrreducibleDifferences( <tbl>, <reducibles>, <reducibles2> )
#F  IrreducibleDifferences( <tbl>, <reducibles>, <reducibles2>, <scprmat> )
#F  IrreducibleDifferences( <tbl>, <reducibles>, \"triangle\" )
#F  IrreducibleDifferences( <tbl>, <reducibles>, \"triangle\", <scprmat> )
##
#T compute/consider scalar product of i-th and j-th character only if the
#T norms have different parity!
##
InstallGlobalFunction( IrreducibleDifferences, function( arg )
    local tbl,
          reducibles,
          irreducibledifferences,
          scprmatrix,
          i, j,
          diff,
          reducibles2,
          norms, norms2;

    if not ( Length( arg ) in [ 3, 4 ] and IsOrdinaryTable( arg[1] ) and
             IsList( arg[2] ) and ( IsList( arg[3] ) or IsString( arg[3] ) ) )
       or ( Length( arg ) = 4 and not IsList( arg[4] ) ) then
      Error( "usage: IrreducibleDifferences(tbl,reducibles,\"triangle\")\n",
      "resp.   IrreducibleDifferences(tbl,reducibles,\"triangle\",scprmat)",
      "\n resp.    IrreducibleDifferences(tbl,reducibles,reducibles2)\nresp.",
      "   IrreducibleDifferences(tbl,reducibles,reducibles2,scprmat)" );
    fi;

    tbl:= arg[1];
    reducibles:= arg[2];
    irreducibledifferences:= [];
    if IsString( arg[3] ) then           # "triangle"
      if Length( arg ) = 3 then
        scprmatrix:= MatScalarProducts( tbl, reducibles );
      else
        scprmatrix:= arg[4];
      fi;
      for i in [ 1 .. Length( scprmatrix ) ] do
        for j in [ 1 .. i-1 ] do
          if scprmatrix[i][i] + scprmatrix[j][j] - 2*scprmatrix[i][j] = 1 then
            if reducibles[i][1] > reducibles[j][1] then
              diff:= reducibles[i] - reducibles[j];
              Info( InfoCharacterTable, 2,
                    "IrreducibleDifferences: X[",i, "] - X[",j, "] found" );
            else
              diff:= reducibles[j] - reducibles[i];
              Info( InfoCharacterTable, 2,
                    "IrreducibleDifferences: X[",j, "] - X[",i, "] found" );
            fi;
            if IsClassFunction( diff ) then
              SetIsCharacter( diff, true );
            fi;
            AddSet( irreducibledifferences, diff );
          fi;
        od;
      od;
    else                     # not "triangle"
      reducibles2:= arg[3];
      if Length( arg ) = 3 then
        scprmatrix:= MatScalarProducts( tbl, reducibles, reducibles2 );
      else
        scprmatrix:= arg[4];
      fi;
      norms := List( reducibles , x -> ScalarProduct(tbl,x,x) );
      norms2:= List( reducibles2, x -> ScalarProduct(tbl,x,x) );
      for i in [ 1 .. Length( norms ) ] do
        for j in [ 1 .. Length( norms2 ) ] do
          if norms[i] + norms2[j] - 2 * scprmatrix[i][j] = 1 then
            if reducibles[j][1] > reducibles2[i][1] then
              diff:= reducibles[j] - reducibles2[i];
              Info( InfoCharacterTable, 2,
                    "IrreducibleDifferences: X[",j, "] - Y[",i, "] found" );
            else
              diff:= reducibles2[i] - reducibles[j];
              Info( InfoCharacterTable, 2,
                    "IrreducibleDifferences: Y[",i, "] - X[",j, "] found" );
            fi;
            if IsClassFunction( diff ) then
              SetIsCharacter( diff, true );
            fi;
            AddSet( irreducibledifferences, diff );
          fi;
        od;
      od;
    fi;
    return irreducibledifferences;
end );


#############################################################################
##
##  11. Symmetrizations of Class Functions
##


#############################################################################
##
#F  Symmetrizations( [<tbl>, ]<characters>, <n> )
#F  Symmetrizations( [<tbl>, ]<characters>, <Sn> )
#F  Symmetrizations( <tbl>, <characters>, <arec> )
##
InstallMethod( Symmetrizations,
    "for homogeneous list (of class functions) and positive integer",
    [ IsHomogeneousList, IsPosInt ],
    function( list, n )
    if IsEmpty( list ) then
      return [];
    elif IsClassFunction( list[1] ) then
      return Symmetrizations( UnderlyingCharacterTable( list[1] ), list, n );
    else
      TryNextMethod();
    fi;
    end );

InstallMethod( Symmetrizations,
    "for homogeneous list (of class functions) and character table",
    [ IsHomogeneousList, IsOrdinaryTable ],
    function( list, Sn )
    if IsEmpty( list ) then
      return [];
    elif IsClassFunction( list[1] ) then
      return Symmetrizations( UnderlyingCharacterTable( list[1] ),
                              list, Sn );
    else
      TryNextMethod();
    fi;
    end );

InstallMethod( Symmetrizations,
    "for char. table, homog. list (of class functions), and pos. integer",
    [ IsCharacterTable, IsHomogeneousList, IsPosInt ],
    function( tbl, characters, n )
    local gensymm, classparam, siz, classes;

    gensymm:= CharTableSymmetric;
    classparam:= gensymm.classparam[1]( n );
    siz:= gensymm.size( n );
    classes:= List( classparam, p -> siz / gensymm.centralizers[1]( n, p ) );

    return Symmetrizations( tbl, characters,
               rec( classparam  := List( classparam, x -> [ 1, x ] ),
                    symmirreds  := gensymm.matrix( n ),
                    symmclasses := classes,
                    symmorder   := siz ) );
    end );

InstallMethod( Symmetrizations,
    "for char. table, homog. list (of class functions), and table of Sn",
    [ IsCharacterTable, IsHomogeneousList, IsOrdinaryTable ],
    function( tbl, characters, Sn )

    if not HasClassParameters( Sn ) then
      Error( "partitions corresponding to classes must be stored",
             " as `ClassParameters( <Sn> )'" );
    fi;

    return Symmetrizations( tbl, characters,
               rec( classparam  := ClassParameters( Sn ),
                    symmirreds  := List( Irr( Sn ), ValuesOfClassFunction ),
                    symmclasses := SizesConjugacyClasses( Sn ),
                    symmorder   := Size( Sn ) ) );
    end );

InstallOtherMethod( Symmetrizations,
    "for char. table, homog. list (of class functions), and record",
    [ IsCharacterTable, IsHomogeneousList, IsRecord ],
    function( tbl, characters, arec )
    local i, j, l, n,
          tbl_powermap,     # computed power maps of 'tbl'
          cyclestruct,
          classparam,
          symmirreds,
          symmclasses,
          symmorder,
          cycl,
          symmetrizations,
          chi,
          psi,
          powermap,
          prodmatrix,
          single,
          value,
          val;

    classparam  := arec.classparam;
    symmirreds  := arec.symmirreds;
    symmclasses := arec.symmclasses;
    symmorder   := arec.symmorder;

    cyclestruct:= [];
    for i in [ 1 .. Length( classparam ) ] do
      if Length( classparam[i][2] ) = 1 then
        n:= classparam[i][2][1];
      fi;
      cyclestruct[i]:= [];
      for j in [ 1 .. Maximum( classparam[i][2] ) ] do
         cyclestruct[i][j]:= 0;
      od;
      for j in classparam[i][2] do
        cyclestruct[i][j]:= cyclestruct[i][j] + 1;
      od;
    od;

    tbl_powermap:= ShallowCopy( ComputedPowerMaps( tbl ) );
#T better do the computation of necessary power maps only once!

    # Compute necessary power maps.
    for i in [ 1 .. n ] do
      if not IsBound( tbl_powermap[i] ) then
        tbl_powermap[i]:= PowerMap( tbl, i );
      fi;
    od;

    powermap:= tbl_powermap;
    symmetrizations:= [];
    for chi in characters do

      # Symmetrize the character `chi' of `tbl' ...
      prodmatrix:= [];
      for i in [ 1 .. Length( characters[1] ) ] do
        prodmatrix[i]:= [];
        for j in [ 1 .. Length( symmclasses ) ] do
          value:= symmclasses[j];
          cycl:= cyclestruct[j];
          for l in [ 1 .. Length( cycl ) ] do
            if cycl[l] <> 0 then
              if IsInt( powermap[l][i] ) then
                value:= value * ( chi[ powermap[l][i] ] ^ cycl[l] );
              else
                val:= CompositionMaps( chi, powermap[l][i] );
                if IsInt( val ) then
                  value:= value * ( val ^ cycl[l] );
                else
                  value:= Unknown();
                fi;
              fi;
            fi;
          od;
          prodmatrix[i][j]:= value;
        od;
      od;

      # ... with the character `psi' ...
      for psi in symmirreds do
        single:= [];
        for i in [ 1 .. Length( chi ) ] do

          # ... at class `i'
          single[i]:= psi * prodmatrix[i] / symmorder;
          if not ( IsCycInt( single[i] ) or IsUnknown( single[i] ) ) then
            single[i]:= Unknown();
            Print( "#E Symmetrizations: value not dividing group order,",
                   " set to ", single[i], "\n" );
          fi;

        od;
        if IsClassFunction( chi ) and single[1] > 0 then
          single:= ClassFunctionSameType( tbl, chi, single );
        elif HasIsVirtualCharacter( chi ) and IsVirtualCharacter( chi ) then
          single:= VirtualCharacter( tbl, single );
        fi;
        Add( symmetrizations, single );
      od;

    od;

    # Return the symmetrizations.
    return symmetrizations;
    end );


#############################################################################
##
#F  SymmetricParts( <tbl>, <characters>, <n> )
##
InstallGlobalFunction( SymmetricParts, function( tbl, characters, n )
    local i,
          j,
          k,
          nccl,
          exponents,
          symcentralizers,   # list of symmetrizations, result
          symmetricparts,
          chi,               # loop over 'characters'
          sym,
          exp,
          factor,
          powermap;          # list of computed power maps of 'tbl'

    if IsEmpty( characters ) then
      return [];
    fi;

    nccl:= NrConjugacyClasses( tbl );
    exponents:= Partitions( n );
    symcentralizers:= CharTableSymmetric.centralizers[1];
    symcentralizers:= List( exponents, x -> symcentralizers( n, x ) );

    for i in [ 1 .. Length( exponents ) ] do

      # Transform partitions to exponent vectors.
      # At position $i$ we store the number of cycles of length $i$.
      exp:= [];
      for j in [ 1 .. Maximum( exponents[i] ) ] do exp[j]:= 0; od;
      for j in exponents[i] do exp[j]:= exp[j] + 1; od;
      exponents[i]:= exp;

    od;

    # Compute necessary power maps.
    powermap:= ComputedPowerMaps( tbl );
    for i in [ 1 .. n ] do
      if not IsBound( powermap[i] ) then
        powermap[i]:= PowerMap( tbl, i );
      fi;
    od;

    symmetricparts:= [];
    for chi in characters do

      Info( InfoCharacterTable, 2,
            "SymmetricParts: chi[.]" );
      sym:= List( chi, x -> 0 );

      # Loop over the conjugacy classes of the symmetric group.
      for j in [ 1 .. Length( symcentralizers ) ] do

        exp:= exponents[j];

        for k in [ 1 .. nccl ] do
          factor:= 1;
          for i in [ 1 .. Length( exp ) ] do
            if IsBound( exp[i] ) then
              factor:= factor * chi[ powermap[i][k] ]^exp[i];
            fi;
          od;
          sym[k]:= sym[k] + factor / symcentralizers[j];
        od;

      od;
      if IsClassFunction( chi ) then
        sym:= ClassFunctionSameType( tbl, chi, sym );
      fi;
      Add( symmetricparts, sym );

    od;

    # Return the symmetrizations.
    return symmetricparts;
end );


#############################################################################
##
#F  AntiSymmetricParts( <tbl>, <character>, <n> )
##
InstallGlobalFunction( AntiSymmetricParts, function( tbl, characters, n )
    local i,
          j,
          k,
          nccl,
          exponents,
          symcentralizers,
          antisymmetricparts,
          chi,
          sym,
          exp,
          factor,
          powermap;

    if IsEmpty( characters ) then
      return [];
    fi;

    nccl:= NrConjugacyClasses( tbl );
    exponents:= Partitions( n );
    symcentralizers:= CharTableSymmetric.centralizers[1];
    symcentralizers:= List( exponents, x -> symcentralizers( n, x ) );

    for i in [ 1 .. Length( exponents ) ] do

      # Transform partitions to exponent vectors.
      # At position $i$ we store the number of cycles of length $i$.

      exp:= [];
      for j in [ 1 .. Maximum( exponents[i] ) ] do exp[j]:= 0; od;
      for j in exponents[i] do exp[j]:= exp[j] + 1; od;
      exponents[i]:= exp;

    od;

    # Compute necessary power maps.
    powermap:= ComputedPowerMaps( tbl );
    for i in [ 1 .. n ] do
      if not IsBound( powermap[i] ) then
        powermap[i]:= PowerMap( tbl, i );
      fi;
    od;

    # Compute the symmetrizations.
    antisymmetricparts:= [];
    for chi in characters do

      Info( InfoCharacterTable, 2,
            "AntiSymmetricParts: chi[.]" );
      sym:= List( chi, x -> 0 );
      for j in [ 1 .. Length( exponents ) ] do

        exp:= exponents[j];

        for k in [ 1 .. nccl ] do
          factor:= 1;
          for i in [ 1 .. Length( exp ) ] do
            if IsBound( exp[i] ) then
              if i mod 2 = 0 and exp[i] mod 2 = 1 then
                factor:= -factor * chi[ powermap[i][k] ]^exp[i];
              else
                factor:=  factor * chi[ powermap[i][k] ]^exp[i];
              fi;
            fi;
          od;
          sym[k]:= sym[k] + factor / symcentralizers[j];
        od;

      od;
      if IsClassFunction( chi ) and sym[1] > 0 then
        sym:= ClassFunctionSameType( tbl, chi, sym );
      elif HasIsVirtualCharacter( chi ) and IsVirtualCharacter( chi ) then
        sym:= VirtualCharacter( tbl, sym );
      fi;
      Add( antisymmetricparts, sym );

    od;

    # Return the symmetrizations.
    return antisymmetricparts;
end );


#############################################################################
##
#F  RefinedSymmetrizations( <tbl>, <chars>, <m>, <func> )
##
##  (Note: It suffices to change `F2' and `F4' in order to get the
##  symplectic components from the orthogonal ones.)
##
##  We have (see J.S. Frame, Recursive computation of tensor power
##  components, Bayreuther Mathematische Schriften 10, 153--159)
##
##  \begintt
##  component   orthogonal                symplectic
##  M0        = L0                        L0  ( = 1 )
##  M1        = L1                        L1
##  M11       = L11                       L11-L0
##  M2        = L2-L0                     L2
##  M111      = L111                      L111-L1
##  M21       = L21-L1                    L21-L1
##  M3        = L3-L1                     L3
##  M1111     = L1111                     L1111-L11
##  M211      = L211-L11                  L211-L11-L2+L0
##  M22       = L22-L2                    L22-L11
##  M31       = L31-L2-L11+L0             L31-L2
##  M4        = L4-L2                     L4
##  M11111    = L11111                    L11111-L111
##  M2111     = L2111-L111                L2111-L111-L21+L1
##  M221      = L221-L21                  L221-L111-L21+L1
##  M311      = L311-L21-L111+L1          L311-L21-L3+L1
##  M32       = L32-L3-L21+L1             L32-L21
##  M41       = L41-L3-L21+L1             L41-L3
##  M5        = L5-L3                     L5
##  M111111   = L111111                   L111111-L1111
##  M21111    = L21111-L1111              L21111-L1111-L211+L11
##  M2211     = L2211-L211                L2211-L1111-L211-L22+L11+L2
##  M3111     = L3111-L211-L1111+L11      L3111-L211-L31+L11+L2-L0
##  M222      = L222-L22                  L222-L211+L11-L0
##  M321      = L321-L31-L22-L211+L2+L11  L321-L31-L22-L211+L2+L11
##  M33       = L33-L31+L2-L0             L33-L22
##  M411      = L411-L31-L211+L2+L11-L0   L411-L31-L4+L2
##  M42       = L42-L4-L31-L22+L2+L11     L42-L31
##  M51       = L51-L4-L31+L2             L51-L4
##  M6        = L6-L4                     L6
##  \endtt
##
InstallGlobalFunction( RefinedSymmetrizations,
    function( tbl, chars, m, func )
    local i, classes, components,
          F2, F3, F4, F5, F6,
          M1,
          M2, M11,
          M3, M21, M111,
          M4, M31, M22, M211, M1111,
          M5, M41, M32, M311, M221, M2111, M11111,
          M6, M51, M42, M411, M33, M321, M3111, M222, M2211, M21111, M111111;

    # Linear characters are not allowed since their symmetrizations need not
    # to be proper characters.
    chars:= Filtered( chars, x -> 1 < x[1] );
    components:= [];
    classes:= [ 1 .. NrConjugacyClasses( tbl ) ];

    for M1 in chars do

      F2 := MinusCharacter( M1, PowerMap( tbl, 2 ), 2 );

      # orthogonal case: 'M11 = F2'
      # symplectic case: 'M11 = F2 - 1'
      M11:= func( F2, 1 );
      M2 := List( classes, x -> M1[x]^2 - M11[x] - 1 );

      Add( components, M11 );
      Add( components, M2  );

      if m > 2 then

        F3:=    MinusCharacter( M1, PowerMap( tbl, 3 ), 3 );
        M21:=   F3 - M1;
        M111:=  List( classes, x -> M1[x] * M11[x] - F3[x] );
        M3:=    List( classes, x -> M1[x] * M2[x]  - F3[x] );

        Append( components, [ M21, M111, M3 ] );

        if m > 3 then

          F4:=    MinusCharacter( F2, PowerMap( tbl, 2 ), 2 );

          # orthogonal case: 'F4 := F4'
          # symplectic case: 'F4 := F4 - M2'
          F4:=    func( F4, M2 );
          M211:=  F4 - M11;
          M31:=   List( classes, x -> M11[x]*M2[x]-F4[x]-M2[x]);
          M22:=   List( classes, x -> M1[x]*M21[x]-F4[x]-M2[x]-M31[x] );
          M1111:= List( classes, x -> M1[x]*M111[x]-F4[x] );
          M4:=    List( classes, x -> M1[x]*M3[x]-M31[x]-M2[x] );

          Append( components, [ M211, M31, M22, M1111, M4 ] );

          if m > 4 then

            F5:= MinusCharacter( M1, PowerMap( tbl, 5 ), 5 );
            M2111:=  List( classes, x-> F5[x]-M2[x]*F3[x]-M1[x]*M11[x] );
            M311:=   List( classes, x-> M2[x]*M111[x]-M2111[x]-M21[x]
                                               -M111[x] );
            M221:=   List( classes, x-> M1[x]*M211[x]-M2[x]*M111[x] );
            M11111:= List( classes, x-> M1[x]*M1111[x]-M2111[x]-M111[x]);
            M32:=    List( classes, x-> M1[x]*M22[x]-M221[x]-M21[x] );
            M41:=    List( classes, x-> M11[x]*M3[x]-M311[x]-M21[x]
                                               -M3[x] );
            M5:=     List( classes, x-> M1[x]*M4[x]-M41[x]-M3[x] );

            Append( components, [ M2111, M311, M221, M11111, M32, M41, M5 ]);

            if m = 6 then

              F6:= MinusCharacter( F2, PowerMap( tbl, 3 ), 3 );
              M3111:=   List( classes, x-> M21[x]*M111[x]-F6[x]+F2[x] );
              M411:=    List( classes, x-> M3[x]*M111[x]-M3111[x]-M31[x]
                                              -M211[x] );
              M21111:=  List( classes, x-> M2[x]*M1111[x]-M3111[x]
                                              -M211[x]-M1111[x] );
              M111111:= List( classes, x-> M1[x]*M11111[x]-M21111[x]
                                              -M1111[x] );
              M2211:=   List( classes, x-> M1[x]*M2111[x]-M3111[x]
                                              -M21111[x]-M211[x]-M1111[x] );
              M321:=    List( classes, x-> M1[x]*M311[x]-M3111[x]
                                              -M411[x]-M31[x]-M211[x] );
              M33:=     List( classes, x-> F2[x]*M22[x]-M321[x]-M2211[x]
                                              -M31[x]-M22[x]-M211[x]-F2[x] );
              M51:=     List( classes, x-> F2[x]*M4[x]-M411[x]-M31[x]
                                              -M4[x] );
              M42:=     List( classes, x-> M1[x]*M41[x]-M411[x]-M51[x]
                                              -M31[x]-M4[x] );
              M222:=    List( classes, x-> M2[x]*M22[x]-M321[x]-M42[x]
                                              -M31[x]-M22[x]-M211[x]-M2[x] );
              M6:=      List( classes, x-> M1[x]*M5[x]-M51[x]-M4[x] );

              Append( components, [ M3111, M411, M21111, M111111, M2211,
                                    M321, M33, M51, M42, M222, M6 ] );

            fi;
          fi;
        fi;
      fi;
    od;

    return List( components, chi -> ClassFunction( tbl, chi ) );
end );


#############################################################################
##
#F  OrthogonalComponents( <tbl>, <chars>, <m> )
##
InstallGlobalFunction( OrthogonalComponents, function( tbl, chars, m )
    if     IsCharacterTable( tbl ) and IsList( chars )
       and IsInt( m ) and 1 < m and m < 7 then
      return RefinedSymmetrizations( tbl, chars, m,
                                     function( x, y ) return x; end );
    else
      Error( "usage: OrthogonalComponents( <tbl>, <chars>, <m> ) with ",
             "integer 2 <= m <= 6" );
    fi;
end );


#############################################################################
##
#F  SymplecticComponents( <tbl>, <chars>, <m> )
##
InstallGlobalFunction( SymplecticComponents, function( tbl, chars, m )
    if     IsCharacterTable( tbl ) and IsList( chars )
       and IsInt( m ) and 1 < m and m < 6 then
      return RefinedSymmetrizations( tbl, chars, m,
                                     function( x, y ) return x-y; end );
    else
      Error( "usage: SymplecticComponents( <tbl>, <chars>, <m> ) with ",
             "integer 2 <= m <= 5" );
    fi;
end );


#############################################################################
##
##  12. Operations for Brauer Characters
##


###############################################################################
##
#F  FrobeniusCharacterValue( <value>, <p> )
##
##  Let $n$ be the conductor of $v$.
##  Let $k$ be the order of $p$ modulo $n$, that is, $\F_{p^k}$ is the
##  smallest field of characteristic $p$ containing $n$-th roots of unity.
##  Let $m$ be minimal with $v^{\ast p^m} = v$, that is, $\F_{p^m}$ is a
##  (not necessarily minimal) field containing the Frobenius character value
##  $\overline{v}$.
##
##  Let $C_k$ and $C_m$ be the Conway polynomials of degrees $k$ and $m$,
##  and $z = X + (C_k)$ in $\F_{p^k} = \F_p[X] / (C_k)$.
##  Then $\hat{y} = z^{\frac{p^k-1}{p^m-1}}$ may be identified with
##  $y = X + (C_m)$ in $\F_{p^m} = \F_p[X] / (C_m)$.
##
##  For $v = \sum_{i=1}^n a_i E(n)^i$, a representation of $\overline{v}$ in
##  $\F_{p^k}$ is $\sum_{i=1}^n \overline{a_i} z^{\frac{p^k-1}{n} i}$ where
##  $\overline{a_i}$ is the reduction of $a_i$ modulo $p$, viewed as
##  element of $\F_p$.
##
##  A representation of $\overline{v}$ in $\F_{p^m}$ can be found by
##  solving the linear equation system
##  $\overline{v} = \sum_{i=0}^{m-1} c_i \hat{y}^i$ over $\F_p$, which
##  gives us $\overline{v} = \sum{i=0}^{m-1} c_i y^i$ in $\F_{p^m}$.
##
InstallGlobalFunction( FrobeniusCharacterValue, function( value, p )
    local n,            # conductor of `value'
          k,            # degree of smallest field containing `n'-th roots
          size,         # `p^k'
          power,        # `( size - 1 ) / n'
          ffe,          # primitive `n'-th root in `GF( size )'
          cf,           # canonical basis of `CF(n)'
          m,            # degree of some field containing the result
          image,        # image of `value' under Galois conjugation
          primefield,   # `GF(p)'
          zero,         # zero of `primefield'
          one,          # identity of `primefield'
          conwaypol,    # coeffs. of the `k'-th Conway pol. in char. `p'
          x,            # coeffs. of an indeterminate
          y,
          lastvalue,
          fieldbase,
          i;

    # If <value> belongs to a <p>-singular element then return `fail'.
    n:= Conductor( value );
    if   n mod p = 0 then
      return fail;
    elif n = 1 then
      if DenominatorRat( value ) mod p = 0 then
        return fail;
      else
        return value * One( GF(p) );
      fi;
    elif IsCycInt( value / p ) then
      return Zero( GF(p) );
    fi;

    # Compute the size $p^k$ of the smallest finite field of characteristic
    # `p' that contains 'n'-th roots of unity.
    k:= OrderMod( p, n );
    size:= p^k;

    # The root `E(n)' is identified with the smallest primitive `n'-th
    # root in the finite field, that is, the `(size-1) / n'-th power of
    # the primitive root of the field
    # (which is given by the Conway polynomial).
    power:= ( size - 1 ) / n;

    if size <= MAXSIZE_GF_INTERNAL then

      # Use GAP's internal finite fields.
      # (Express the Brauer character value in terms of the Zumbroich basis
      # of the underlying cyclotomic field.)
      ffe:= PrimitiveRoot( GF( size ) ) ^ power;
      cf:= CanonicalBasis( CF( n ) );
      value:= Coefficients( cf, value ) *
                  List( ZumbroichBase( n, 1 ), exp -> ffe ^ exp );

    elif not IsCheapConwayPolynomial( p, k ) then

      # Give up if the required Conway polynomial is hard to compute.
      Info( InfoWarning, 1,
            "the Conway polynomial of degree ", k, " for p = ", p,
            " is not known" );
      return fail;

    else

      # Compute a finite field that contains the Frobenius character value.
      # An upper bound is given by the field of order $p^m$
      # where $m$ is the smallest number such that <value> is fixed
      # by the Galois automorphism that raises roots of unity
      # to the $p^m$-th power.
      m:= 1;
      image:= GaloisCyc( value, p );
      while image <> value do
        m:= m+1;
        image:= GaloisCyc( image, p );
      od;

      # Compute the representation of the Frobenius character value
      # in the field $\F_{p^k}$.
      primefield:= GF(p);
      zero:= Zero( primefield );
      one:= One( primefield );

      conwaypol:= ConwayPol( p, k ) * one;
      x:= [ zero, one ];
      value:= COEFFS_CYC( value ) * one;

      ConvertToVectorRepNC( conwaypol, p );
      ConvertToVectorRepNC( x, p );
      ConvertToVectorRepNC( value, p );

      value:= PowerModEvalPol( conwaypol, 
                  value,
                  PowerModCoeffs( x, 2, power, conwaypol, k+1 ) );
      if IsEmpty( value ) then
        return zero;
      fi;
      PadCoeffs( value, k, zero );

      # Compute a $\F_p$-basis $(\hat{y}^i; 0\leq i\leq m-1)$ of
      # the subfield of $\F_{p^k}$ isomorphic with $\F_{p^m}$.
      y:= PowerModCoeffs( x, 2, (size - 1) / (p^m - 1), conwaypol, k+1 );

      lastvalue:= [ one ];
      fieldbase:= [ [ one ] ];
      PadCoeffs( fieldbase[1], k, zero );
      ConvertToVectorRepNC( fieldbase[1], p );

      for i in [ 2 .. m ] do
        lastvalue:= ProductCoeffs( y, lastvalue );
        ReduceCoeffs( lastvalue, conwaypol );
#T bad that ReduceCoeffs does not predict how it deals with trailing zeros
        PadCoeffs( lastvalue, k, zero );
        fieldbase[i]:= lastvalue;
        ConvertToVectorRepNC( fieldbase[i], p );
      od;

      value:= ValuePol( SolutionMatDestructive( fieldbase, value ),
                        Z( p, m ) );

    fi;

    # Return the Frobenius character value.
    return value;
end );


##############################################################################
##
#F  ReductionToFiniteField( <value>, <p> )
##
InstallGlobalFunction( ReductionToFiniteField, function( value, p )
    local n, primefield, one, zero, k, size, power, ffe, cf, frob, d,
          conwaypol, x, m, primes, sol, l, mc, y, leny, lastvalue, fieldbase,
          i, redsol;

    # If <value> belongs to a <p>-singular element then return `fail'.
    n:= Conductor( value );
    if n mod p = 0 then
      return fail;
    fi;

    primefield:= GF(p);

    # Catch the case where the reduction trivially lies in the prime field.
    if n = 1 then
      if DenominatorRat( value ) mod p = 0 then
        return fail;
      else
        return [ value * One( Indeterminate( primefield ) ), 1 ];
      fi;
    elif IsCycInt( value / p ) then
      return [ Zero( Indeterminate( primefield ) ), 1 ];
    fi;

    one:= One( primefield );
    zero:= Zero( primefield );

    # Compute the size $p^k$ of the smallest finite field of characteristic
    # `p' that contains `n'-th roots of unity.
    k:= OrderMod( p, n );
    size:= p^k;

    # The root `E(n)' is identified with the smallest primitive `n'-th
    # root in the finite field, that is, the `(size-1) / n'-th power of
    # the primitive root of the field
    # (which is given by the Conway polynomial).
    power:= ( size - 1 ) / n;

    if size <= MAXSIZE_GF_INTERNAL then
      # Use GAP's internal finite fields.
      # (Compute the Frobenius character value and the corresponding pol.)
      ffe:= PrimitiveRoot( GF( size ) ) ^ power;
      cf:= CanonicalBasis( CF( n ) );
      frob:= Coefficients( cf, value ) *
                 List( ZumbroichBase( n, 1 ), exp -> ffe ^ exp );
      if IsZero( frob ) then
        return [ Zero( Indeterminate( primefield ) ), 1 ];
      fi;

      d:= DegreeFFE( frob );
      if d = 1 then
        return [ frob * One( Indeterminate( primefield ) ), 1 ];
      fi;

      # Note that `LogFFE' returns a nonzero value.
      conwaypol:= ConwayPol( p, d ) * one;
      x:= [ zero, one ];
      ConvertToVectorRepNC( conwaypol, p );
      ConvertToVectorRepNC( x, p );
      frob:= PowerModCoeffs( x, 2, LogFFE( frob, Z( p, d ) ), conwaypol, d+1 );
      return [ UnivariatePolynomialByCoefficients( FamilyObj( one ),
                   frob, 1 ),
               d ];
    elif not IsCheapConwayPolynomial( p, k ) then
      # Give up if the required Conway polynomial is hard to compute.
      Info( InfoWarning, 1,
            "the Conway polynomial of degree ", k, " for p = ", p,
            " is not known" );
      return fail;
    fi;

    conwaypol:= ConwayPol( p, k ) * one;

    x:= [ zero, one ];
    value:= COEFFS_CYC( value ) * one;

    ConvertToVectorRepNC( conwaypol, p );
    ConvertToVectorRepNC( x, p );
    ConvertToVectorRepNC( value, p );

    value:= PowerModEvalPol( conwaypol, value,
                PowerModCoeffs( x, 2, power, conwaypol, k+1 ) );
    if IsEmpty( value ) then
      return [ Zero( Indeterminate( primefield ) ), 1 ];
    fi;
    PadCoeffs( value, k, zero );

    # Reduce the representation into the smallest finite field.
    # The currently known field has size `p^k'.
    m:= k;

    if k <> 1 then

      primes:= Set( Factors( m ) );
      sol:= fail;

      while not IsEmpty( primes ) do

        for l in ShallowCopy( primes ) do

          # `p^(m/l)' is the candidate for next smaller field.
          mc:= m / l;

          # Compute a $\F_p$-basis $(\hat{y}^i; 0 \leq i \leq m/l - 1)$ of
          # the subfield of $\F_{p^k}$ isomorphic with $\F_{p^{(m/l)}}$.
          y:= PowerModCoeffs( x, 2, (size - 1) / (p^mc - 1), conwaypol, k+1 );
          leny:= Length( y );

          lastvalue:= [ one ];
          PadCoeffs( lastvalue, k, zero );
          fieldbase:= [ [ one ] ];
          PadCoeffs( fieldbase[1], k, zero );
          ConvertToVectorRepNC( lastvalue, p );
          ConvertToVectorRepNC( fieldbase[1], p );

          for i in [ 2 .. mc ] do
            lastvalue:= ProductCoeffs( y, leny, lastvalue, k );
            ReduceCoeffs( lastvalue, conwaypol );
            PadCoeffs( lastvalue, k, zero );
            ConvertToVectorRepNC( lastvalue, p );
#T needed?
            fieldbase[i]:= lastvalue;
          od;

          # Check whether `value' is a linear combination of this basis.
          redsol:= SolutionMatDestructive( fieldbase, ShallowCopy( value ) );
          if redsol = fail then
            RemoveSet( primes, l );
          else
            sol:= redsol;
            m:= mc;
          fi;

        od;

        IntersectSet( primes, Factors( m ) );

      od;

      if sol <> fail then
        # We have found a smaller field.
        value:= sol;
      fi;

    fi;

    # Return the reduction into the minimal field.
    return [ UnivariatePolynomialByCoefficients( FamilyObj( one ), value, 1 ),
             m ];
end );

# # alternative implementation
# ReductionToFiniteField2:= function( value, p )
#     local frob, d, z, one, zero, conwaypol, x;
# 
#     frob:= FrobeniusCharacterValue( value, p );
#     if frob = fail then
#       return fail;
#     elif IsZero( frob ) then
#       return [ Zero( Indeterminate( GF(p) ) ), 1 ];
#     fi;
# 
#     d:= DegreeFFE( frob );
# 
#     if d = 1 then
#       return [ frob * One( Indeterminate( GF(p) ) ), 1 ];
#     elif p^d <= MAXSIZE_GF_INTERNAL then
#       z:= Z( p, d );
#       one:= One( z );
#       zero:= Zero( z );
#       conwaypol:= ConwayPol( p, d ) * one;
#       x:= [ zero, one ];
#       ConvertToVectorRepNC( conwaypol, p );
#       ConvertToVectorRepNC( x, p );
# 
#       # Note that `LogFFE' returns a nonzero value.
#       frob:= PowerModCoeffs( x, 2, LogFFE( frob, z ), conwaypol, d+1 );
#       frob:= UnivariatePolynomialByCoefficients( FamilyObj( one ),
#                  frob, 1 );
#     elif IsCoeffsModConwayPolRep( frob ) then
#       frob:= UnivariatePolynomialByCoefficients( FamilyObj( Z(p) ),
#                  frob![1], 1 );
#     else
#       # This should never happen, since `FrobeniusCharacterValue' worked.
#       Info( InfoWarning, 1,
#             "no coefficients w.r.t. the Conway polynomial available" );
#       return fail;
#     fi;
#     return [ frob, d ];
# end;


##############################################################################
##
#F  SizeOfFieldOfDefinition( <val>, <p> )
##
##  If the coefficients of the Zumbroich basis representation of the
##  difference $\alpha^{\ast p} - \alpha$ are divisible by $p$
##  then $\alpha$ is mapped to an element of the prime field under
##  the reduction modulo any maximal ideal.
##  (This covers the special cases that $\alpha$ is fixed under the
##  automorphism $\ast p$ or that all coefficients of $\alpha$
##  are divisible by $p$.)
##
##  Otherwise, I do not know a better way to compute the size than explicitly
##  computing the reductions.
##
InstallGlobalFunction( SizeOfFieldOfDefinition, function( val, p )
    local values, entry;

    # The first argument may be a cyclotomic or a list of cyclotomics.
    if   IsInt( val ) then
      return p;
    elif IsCyc( val ) then
      if DenominatorCyc( val ) mod p = 0 then
        return fail;
      fi;
      values:= [ val ];
    elif IsList( val ) and IsCyclotomicCollection( val ) then
      values:= [];
      for entry in val do
        if   not IsRat( entry ) then
          Add( values, entry );
        elif DenominatorCyc( entry ) mod p = 0 then
          return fail;
        fi;
      od;
    else
      Error( "<val> must be a cyclotomic or a list of cyclotomics" );
    fi;

    if ForAll( values, x -> IsCycInt( ( GaloisCyc( x, p ) - x ) / p ) ) then
      return p;
    fi;

    values:= List( values, x -> FrobeniusCharacterValue( x, p ) );
    if fail in values then
      return fail;
    fi;
    return p ^ DegreeFFE( values );
end );


#############################################################################
##
#M  BrauerCharacterValue( <mat> )
##
##  Let $M$ be a matrix of order $n$, with entries in the finite field $F$,
##  and suppose that $M$ is diagonalizable over the extension field $K$ with
##  $p^d$ elements.
##
##  It could in principle be computed by determining the diagonal form,
##  identifying the entries in the diagonal with $(p^d -1)$-th complex roots
##  of unity,
##  and then summing up these roots.
##
##  But one can do better.
##  (This is the approach used by the C-{\MeatAxe}.)
##  For each irreducible factor $f$ of $X^n - 1$ over $F$, the multiplicities
##  of its roots over $K$ as eigenvalues of $M$ are equal,
##  hence one needs to compute these multiplicities and the corresponding
##  sums of roots of unity.
##  The former means to solve an equation system over $F$,
##  and the latter depends only on $n$ and $F$, but not on $M$;
##  so one can use a database for speeding up the computations.
##  This database is implemented by the global variable `ZEV_DATA' and the
##  functions `ZevData' and `ZevDataValue'.
##
InstallMethod( BrauerCharacterValue,
    "for a matrix",
    [ IsMatrix ],
    function( mat )
    local n,        # order of `mat'
          p,        # characteristic of `mat'
          info,     # list of pairs returned by `ZevData'
          value,    # Brauer character value, result
          pair,     # loop over `info'
          f,        # polynomial part of `pair'
          nullity;  # dimension of a nullspace

    n:= Order( mat );

    # Handle the trivial cases first.
    if n = 1 then
      return Length( mat );
    fi;

    p:= Characteristic( mat );
    if n mod p = 0 then
      return fail;
    fi;

    # Get the complex values corresponding to the irreducible
    # factors of $X^n - 1$ over $F$.
    info:= ZevData( p^DegreeFFE( mat ), n );

    # Compute the coefficients of the complex summands,
    # as quotients of nullities and degrees.
    value:= 0;
    for pair in info do
      f:= pair[1];
      nullity:= Length( NullspaceMat( ValuePol( f, mat ) ) );
      if nullity <> 0 then
        nullity:= nullity / ( Length( f ) - 1 );
        Assert( 1, IsInt( nullity ), "degree of <f> must divide <nullity>" );
        value:= value + nullity * pair[2];
      fi;
    od;

    return value;
    end );


#############################################################################
##
#V  ZEV_DATA
##
InstallFlushableValue( ZEV_DATA, [ [], [] ] );


#############################################################################
##
#F  ZevDataValue( <q>, <n> )
##
InstallGlobalFunction( ZevDataValue, function( q, n )
    local F, dimext, extfieldsize, Ee, value, K, z, quot, R, f, y, fac,
          p, one, conw, conwlen, x, zpol, zpollen, zeta, zetalen, coeffs, l,
          power, powerlen, i, exp, res, reslen, j;

    # Compute the field $F$ of matrix entries and the smallest field $K
    # over which a matrix of order `n' is diagonalizable.
    F:= GF( q );
    dimext:= DegreeOverPrimeField( F ) * OrderMod( q, n );
    extfieldsize:= Characteristic( F ) ^ dimext;
    Ee:= E( n );
    value:= [];

    if extfieldsize <= MAXSIZE_GF_INTERNAL then

      # The splitting field is supported in {\GAP},
      # and the stored primitive root is given by the Conway polynomial.
      K:= GF( extfieldsize );
      z:= PrimitiveRoot( K );
      quot:= ( extfieldsize - 1 ) / n;

      R:= PolynomialRing( K );
      for f in Factors( PolynomialRing( F ), Indeterminate(F)^n - 1 ) do

        y:= 0;
        for fac in Factors( R, f ) do

          # The factors are all linear, i.e., of the form $X - \alpha$.
          # Sum up the lifts of the numbers $\alpha$.
          y:= y + Ee^ ( LogFFE(
                 -CoefficientsOfLaurentPolynomial( fac )[1][1], z ) / quot );

        od;
        Add( value, [ CoefficientsOfLaurentPolynomial( f )[1], y ] );

      od;

    else

      # The splitting field is not available in {\GAP},
      # use computations with polynomials.
      p:= Characteristic( F );
      z:= PrimitiveRoot( F );

      one:= One( F );
      conw:= ConwayPol( p, dimext ) * one;
      conwlen:= dimext + 1;
      x:= [ Zero( F ), one ];

      # polynomial corresponding to the primitive root of `F'
      zpol:= PowerModCoeffs( x, 2, ( extfieldsize-1 ) / ( Size(F)-1 ),
                             conw, conwlen );
      zpollen:= Length( zpol );

      # polynomial corresponding to a primitive `n'-th root $\zeta$
      zeta:= PowerModCoeffs( x, 2, ( extfieldsize-1 ) / n,
                                conw, conwlen );
      zetalen:= Length( zeta );

      for f in Factors( PolynomialRing( F ), Indeterminate(F)^n - 1 ) do

        y:= 0;
        coeffs:= CoefficientsOfUnivariatePolynomial( f );
        l:= Length( coeffs );
        power:= [ one ];
        powerlen:= 1;

        for i in [ 0 .. n-1 ] do

          # Compute $\sum_{j=0}^{l-1} c_j \zeta^{i j}$,
          # where `f' has the form $\sum_{j=0}^{l-1} c_j X^j$.
          exp:= LogFFE( coeffs[l], z );
          if exp = 0 then
            res:= [ one ];
          else
            res:= PowerModCoeffs( zpol, zpollen, exp, conw, conwlen );
          fi;
          reslen:= Length( res );
          for j in [ 1 .. l-1 ] do
            reslen:= MultCoeffs( res, res, reslen, power, powerlen );
            if not IsZero( coeffs[l-j] ) then
              exp:= LogFFE( coeffs[l-j], z );
              if exp = 0 then
                res:= res + [ one ];
              else
                res:= res + PowerModCoeffs( zpol, zpollen, exp,
                                            conw, conwlen );
              fi;
            fi;
            reslen:= ReduceCoeffs( res, Length( res ), conw, conwlen );
            ShrinkRowVector( res );  # needed?
            reslen:= Length( res );  # needed?
          od;

          # If $\zeta^i$ is a root of `f' then take the corresponding
          # complex root of unity.
          if reslen = 0 then
            y:= y + Ee^i;
          fi;

          powerlen:= MultCoeffs( power, power, powerlen, zeta, zetalen );
          powerlen:= ReduceCoeffs( power, powerlen, conw, conwlen );

        od;

        Add( value, [ coeffs, y ] );

      od;

    fi;

    return value;
    end );


#############################################################################
##
#F  ZevData( <q>, <n> )
#F  ZevData( <q>, <n>, <listofpairs> )
##
InstallGlobalFunction( ZevData, function( arg )
    local q,
          n,
          pos,
          pos2;

    q:= arg[1];
    n:= arg[2];

    pos:= Position( ZEV_DATA[1], q );
    if pos = fail then
      Add( ZEV_DATA[1], q );
      Add( ZEV_DATA[2], [ [], [] ] );
      pos:= Length( ZEV_DATA[1] );
    fi;

    pos2:= Position( ZEV_DATA[2][ pos ][1], n );
    if pos2 = fail then
      Add( ZEV_DATA[2][ pos ][1], n );
      pos2:= Length( ZEV_DATA[2][ pos ][1] );
    fi;

    if Length( arg ) = 3 then

      # Store the third argument at this position.
      if IsBound( ZEV_DATA[2][ pos ][2][ pos2 ] ) then
        if ZEV_DATA[2][ pos ][2][ pos2 ] = arg[3] then
          Info( InfoWarning, 1,
                "ZevData( ", q, ", ", n, " ) was already stored" );
        else
          Error( "incompatible ZevData( ", q, ", ", n, " )" );
        fi;
      fi;
      ZEV_DATA[2][ pos ][2][ pos2 ]:= Immutable( arg[3] );
      return arg[3];

    else

      # Get the entry.
      if not IsBound( ZEV_DATA[2][ pos ][2][ pos2 ] ) then
        ZEV_DATA[2][ pos ][2][ pos2 ]:= ZevDataValue( q, n );
      fi;
      return ZEV_DATA[2][ pos ][2][ pos2 ];

    fi;
end );


##############################################################################
##
#F  RealizableBrauerCharacters( <matrix>, <q> )
##
InstallGlobalFunction( RealizableBrauerCharacters, function( matrix, q )
    local result, factors, p, m, done, row, d, g, qq, image, newrow, i;

    result:= [];
    factors:= Factors( q );
    p:= factors[1];
    m:= Length( factors );
    done:= [];

    for row in matrix do
      if not row in done then
        d:= SizeOfFieldOfDefinition( row, p );
        if d = fail then
          return fail;
        fi;
        d:= Length( Factors( d ) );
        g:= Gcd( d, m );
        qq:= p^g;
        image:= row;
        newrow:= row;
        Add( done, row );

        for i in [ 1 .. d/g-1 ] do
          image:= GaloisCyc( image, qq );
          newrow:= newrow + image;
          Add( done, image );
        od;

        if not newrow in result then
          Add( result, newrow );
        fi;
      fi;
    od;

    return result;
end );


#############################################################################
##
##  13. Domains Generated by Class Functions
##


#############################################################################
##
#M  GroupWithGenerators( <classfuns>[, <id>] )
##
InstallOtherMethod( GroupWithGenerators,
    "for a homogeneous list (of class functions)",
    [ IsHomogeneousList ],
    function( gens )
    local filter, G;

    # Check that the list consists of invertible class functions.
    if IsEmpty( gens ) or not ForAll( gens, IsClassFunction ) then
      TryNextMethod();
    elif ForAny( gens, psi -> Inverse( psi ) = fail ) then
      Error( "class functions in <gens> must be invertible" );
#T move to `IsGeneratorsOfGroup'
    fi;

    filter:= IsGroup and IsAttributeStoringRep;
    if IsFinite( gens ) then
      filter:= filter and IsFinitelyGeneratedGroup;
    fi;

    # Construct the group.
    G:= Objectify( NewType( FamilyObj( gens ), filter ), rec() );
    SetGeneratorsOfMagmaWithInverses( G, AsList( gens ) );
    return G;
    end );

InstallOtherMethod( GroupWithGenerators,
    "for list (of class functions) and class function",
    IsCollsElms,
    [ IsHomogeneousList, IsClassFunction ],
    function( gens, id )
    local filter, G;

    # Check that the class functions are invertible.
    if not ForAll( gens, IsClassFunction ) then
      TryNextMethod();
    elif ForAny( gens, psi -> Inverse( psi ) = fail ) then
      Error( "class functions in <gens> must be invertible" );
#T move to `IsGeneratorsOfGroup'
    elif not IsOne( id ) then
      Error( "<id> must be an identity" );
    fi;

    filter:= IsGroup and IsAttributeStoringRep;
    if IsFinite( gens ) then
      filter:= filter and IsFinitelyGeneratedGroup;
    fi;

    # Construct the group.
    G:= Objectify( NewType( FamilyObj( gens ), filter), rec() );
    SetGeneratorsOfMagmaWithInverses( G, AsList( gens ) );
    SetOne( G, id );
    return G;
    end );

InstallOtherMethod( GroupWithGenerators,
    "for empty list and trivial character",
    [ IsList and IsEmpty, IsClassFunction ],
    function( empty, id )
    local G;

    if not IsOne( id ) then
      Error( "<id> must be an identity" );
    fi;

    # Construct the group.
    G:= Objectify( NewType( CollectionsFamily( FamilyObj( id ) ),
                            IsGroup and IsAttributeStoringRep and
			    IsFinitelyGeneratedGroup and IsTrivial ),

                   rec() );
    SetGeneratorsOfMagmaWithInverses( G, empty );
    SetOne( G, id );
    return G;
    end );


#############################################################################
##
##  5. vector spaces of class functions
##
##  Free left modules and algebras of class functions are handled by nice
##  bases,
##  for admitting the default procedure of closure under multiplication.
##  In order to apply `NiceVector' and `UglyVector', algebras of class
##  functions are in the filter `IsClassFunctionsSpace'.
##
InstallHandlingByNiceBasis( "IsClassFunctionsSpace", rec(
    detect:= function( R, gens, V, zero )
      local tbl;
      if not ForAll( gens, IsClassFunction ) then
        return false;
      elif zero = false then
        tbl:= UnderlyingCharacterTable( gens[1] );
      elif not IsClassFunction( zero ) then
        return false;
      else
        tbl:= UnderlyingCharacterTable( zero );
      fi;
      if ForAny( gens, chi -> UnderlyingCharacterTable( chi ) <> tbl ) then
        return false;
      fi;
      return true;
      end,

    NiceFreeLeftModuleInfo := function( V )
      return UnderlyingCharacterTable( Zero( V ) );
      end,

    NiceVector := function( V, v )
      if UnderlyingCharacterTable( v ) = NiceFreeLeftModuleInfo( V ) then
        return ValuesOfClassFunction( v );
      else
        return fail;
      fi;
      end,

    UglyVector := function( V, r )
      return ClassFunction( NiceFreeLeftModuleInfo( V ), r );
      end ) );


#############################################################################
##
#M  ScalarProduct( <V>, <chi>, <psi> ) . . . .  for module of class functions
##
##  Left modules of class functions carry the usual bilinear form.
##
InstallOtherMethod( ScalarProduct,
    "for left module of class functions, and two class functions",
    IsCollsElmsElms,
    [ IsFreeLeftModule, IsClassFunction, IsClassFunction ],
    function( V, x1, x2 )
    local tbl;
    tbl:= UnderlyingCharacterTable( x1 );
    if tbl = UnderlyingCharacterTable( x2 ) then
      return ScalarProduct( tbl, x1, x2 );
    else
      TryNextMethod();
    fi;
    end );


#############################################################################
##
#M  ScalarProduct( <V>, <chivals>, <psivals> )  . . for module of class funs.
##
##  Left modules of class functions carry the usual bilinear form.
##
InstallOtherMethod( ScalarProduct,
    "for module of class functions, and two values lists",
    [ IsFreeLeftModule and IsClassFunctionsSpace,
      IsHomogeneousList, IsHomogeneousList ],
    function( V, x1, x2 )
    return ScalarProduct( NiceFreeLeftModuleInfo( V ), x1, x2 );
    end );


#############################################################################
##
##  14. Auxiliary operations
##


##############################################################################
##
#F  OrbitChar( <chi>, <linear> )
##
InstallGlobalFunction( OrbitChar, function( chi, linear )
    local classes,   # range of positions in `chi'
          nofcyc,    # describes the conductor of values of `chi'
          gens,      # generators of Galois automorphism group
          orb,       # the orbit, result
          gen,       # loop over `gens'
          image;     # one image of `chi' under operation

    classes:= [ 1 .. Length( chi ) ];
    nofcyc:= Conductor( chi );

    # Apply Galois automorphisms if necessary.
    orb:= [ chi ];
    if 1 < nofcyc then
      gens:= Flat( GeneratorsPrimeResidues( nofcyc ).generators );
      for chi in orb do
        for gen in gens do
          image:= List( chi, x -> GaloisCyc( x, gen ) );
          if not image in orb then
            Add( orb, image );
          fi;
        od;
      od;
    fi;

    # Apply multiplication with linear characters.
    for chi in orb do
      for gen in linear do
        image:= List( classes, x -> gen[x] * chi[x] );
        if not image in orb then
          Add( orb, image );
        fi;
      od;
    od;

    # Return the orbit.
    return orb;
end );


##############################################################################
##
#F  OrbitsCharacters( <irr> )
##
InstallGlobalFunction( OrbitsCharacters, function( irr )
    local irrvals,     # list of value lists
          oldirrvals,  # store original succession
          tbl,         # underlying character table
          linear,      # linear characters of `tbl'
          orbits,      # list of orbits, result
          indices,     # from 1 to number of conjugacy classes of `tbl'
          orb,         # one orbit
          gens,        # generators of the acting group
          chi,         # one irreducible character
          gen,         # one generator of the acting group
          image,       # image of a character
          i,           # loop over one orbit
          pos;         # position of value list in `oldirrvals'

    orbits:= [];

    if not IsEmpty( irr ) then

      if IsClassFunction( irr[1] ) then

        # Replace group characters by their value lists.
        # Store the succession in the original list.
        irrvals:= List( irr, ValuesOfClassFunction );
        oldirrvals:= ShallowCopy( irrvals );
        irrvals:= Set( irrvals );

      else
        irrvals:= Set( irr );
      fi;

      indices:= [ 1 .. Length( irrvals[1] ) ];

      # Compute the orbit of linear characters if there are any.
      linear:= Filtered( irrvals, x -> x[1] = 1 );

      if 0 < Length( linear ) then

        # The linear characters form an orbit.
        # We remove them from the other characters,
        # and remove the trivial character from `linear'.
        orb:= ShallowCopy( linear );
        SubtractSet( irrvals, linear );
        RemoveSet( linear, List( linear[1], x -> 1 ) );

        # Make `linear' closed under Galois automorphisms.
        gens:= Flat( GeneratorsPrimeResidues(
                        Conductor( Flat( linear ) ) ).generators );

        for chi in orb do
          for gen in gens do
            image:= List( chi, x -> GaloisCyc( x, gen ) );
            if not image in orb then
              Add( orb, image );
            fi;
          od;
        od;

        # Make `linear' closed under multiplication with linear characters.
        for chi in orb do
          for gen in linear do
            image:= List( indices, x -> gen[x] * chi[x] );
            if not image in orb then
              Add( orb, image );
            fi;
          od;
        od;

        orbits[1]:= orb;

      fi;

      # Compute the other orbits.
      while Length( irrvals ) > 0 do

        orb:= OrbitChar( irrvals[1], linear );
        Add( orbits, orb );
        SubtractSet( irrvals, orb );

      od;

      # Replace the value lists by the group characters
      # if the input was a list of characters.
      # Be careful not to copy characters if not necessary.
      if IsCharacter( irr[1] ) then
        tbl:= UnderlyingCharacterTable( irr[1] );
        for orb in orbits do
          for i in [ 1 .. Length( orb ) ] do
            pos:= Position( oldirrvals, orb[i] );
            if pos = fail then
              orb[i]:= Character( tbl, orb[i] );
            else
              orb[i]:= irr[ pos ];
            fi;
          od;
        od;
      fi;

    fi;

    return orbits;
end );


##############################################################################
##
#F  OrbitRepresentativesCharacters( <irr> )
##
InstallGlobalFunction( OrbitRepresentativesCharacters, function( irr )
    local irrvals,     # list of value lists
          oldirrvals,  # store original succession
          chi,         # loop over `irrvals'
          linear,      # linear characters in `irr'
          nonlin,      # nonlinear characters in `irr'
          repres,      # list of representatives, result
          orb;         # one orbit

    repres:= [];

    if not IsEmpty( irr ) then

      if IsCharacter( irr[1] ) then

        # Replace group characters by their value lists.
        # Store the succession in the original list.
        irrvals:= List( irr, ValuesOfClassFunction );
        oldirrvals:= ShallowCopy( irrvals );
        irrvals:= Set( irrvals );

      else
        irrvals:= Set( irr );
      fi;

      # Get the linear characters.
      linear := [];
      nonlin := [];
      for chi in irrvals do
        if chi[1] = 1 then
          Add( linear, chi );
        else
          Add( nonlin, chi );
        fi;
      od;
      if Length( linear ) > 0 then
        repres[1]:= linear[1];
      fi;

      # Compute orbits and remove them until the set is empty.
      while Length( nonlin ) > 0 do
        Add( repres, nonlin[1] );
        orb:= OrbitChar( nonlin[1], linear );
        SubtractSet( nonlin, orb );
      od;

      # Replace the value lists by the group characters
      # if the input was a list of characters.
      # Do not copy characters!
      if IsCharacter( irr[1] ) then
        repres:= List( repres, x -> irr[ Position( oldirrvals, x ) ] );
      fi;

    fi;

    # Return the representatives.
    return repres;
end );


#############################################################################
##
#F  CharacterTableQuaternionic( <4n> )
##
InstallGlobalFunction( CharacterTableQuaternionic, function( 4n )
    local quaternionic;

    if 4n mod 4 <> 0 then
      Error( "argument must be a multiple of 4" );
    elif 4n = 4 then
      quaternionic:= CharacterTable( "Cyclic", 4 );
    else
      quaternionic:= CharacterTableIsoclinic(
                         CharacterTable( "Dihedral", 4n ),
                         [ 1 .. 4n / 4 + 1 ] );
    fi;
    ResetFilterObj( quaternionic, HasIdentifier );
    SetIdentifier( quaternionic, Concatenation( "Q", String( 4n ) ) );
    return quaternionic;
end );


#############################################################################
##
#F  CollapsedMat( <mat>, <maps> )
##
InstallGlobalFunction( CollapsedMat, function( mat, maps )
    local i, j, k, nontrivblock, nontrivblocks, row, newblocks, values,
            blocks, pos, minima, fusion;

    # Compute successivly the partition of column families defined by
    # the rows already processed.
    nontrivblocks:= [ [ 1 .. Length( mat[1] ) ] ];
    for row in Concatenation( maps, mat ) do
      newblocks:= [];
      for nontrivblock in nontrivblocks do
        values:= [];
        blocks:= [];
        for k in nontrivblock do
          pos:= 1;
          while pos <= Length( values ) and values[ pos ] <> row[k] do
            pos:= pos + 1;
          od;
          if Length( values ) < pos then
            values[ pos ]:= row[k];
            blocks[ pos ]:= [ k ];
          else
            AddSet( blocks[ pos ], k );
          fi;
        od;
        for k in blocks do
          if 1 < Length( k ) then Add( newblocks, k ); fi;
        od;
      od;
      nontrivblocks:= newblocks;
    od;

    minima:= List( nontrivblocks, Minimum );
    nontrivblocks:= Permuted( nontrivblocks, Sortex( minima ) );
    minima:= Concatenation( [ 0 ], minima );
    fusion:= [];
    pos:= 1;
    for i in [ 1 .. Length( minima ) - 1 ] do
      for j in [ minima[i] + 1 .. minima[i+1] - 1 ] do
        if not IsBound( fusion[j] ) then
          fusion[j]:= pos;
          pos:= pos + 1;
        fi;
      od;
      for j in nontrivblocks[i] do fusion[j]:= pos; od;
      pos:= pos + 1;
    od;
    for i in [ minima[ Length( minima ) ] + 1 .. Length( mat[1] ) ] do
      if not IsBound( fusion[i] ) then
        fusion[i]:= pos;
        pos:= pos + 1;
      fi;
    od;

    values:= ProjectionMap( fusion );
    return rec( mat:= List( mat, x -> x{ values } ),
#T do I really need the component 'mat'?
                fusion:= fusion );
end );


#############################################################################
##
#E