/*
 * characters.m
 * (c) 2008-2009 Ruben Debeerst
 *
 * Methods for characters. Includes two functions from the RelAlgKTheory
 * by Bley and Wilson.
 *
 * Depends On:
 *   artin.m (localNormResidueSymbol)
 *   RelAlgKTheory.m (BrauerInduction, Det; both included)
 *
 *
 * Methods provided:
 * 
 * brauerInductionDeg0
 *     Compute the Brauer Induction in degree 0, i.e. the Brauer induction
 *     of chi-chi(1)Id.
 *
 * conductor
 *     Compute the conductor of a character.
 *
 * det
 *     Compute the determinant of a character, which is itself a character.
 *     This can also be applied to algebraic elements by composing with
 *     the local Norm Residue Symbol.
 *
 * reduceCharacter
 *     Compute the linear character of a quotient group that lifts to the
 *     given character by the induction map on characters.
 *
 * restriction
 * induction
 * quotient
 *     Canonical maps on characters, see [Breuning PhD, Lemma 2.4].
 *
 * galoisActionOnCharacters
 *     Galois action by composing the character with the galois action
 *     on the character field.
 *
 * linearCharactersWithFields
 * abelianSituationForLinearCharacter
 * abelianSituationForLinearCharacters
 *     Functions for the precomputation of abelian extensions for
 *     linear characters.
 *
 */


// import external functions
//import "RelAlgKTheory.m": BrauerInduction, Det;
import "artin.m": localNormResidueSymbol;

forward restrict_aut_to_quotient, restricted_aut;


/* Given a character chi of G, compute the Brauer Induction of chi-chi(1)Id, i.e.
 * compute triples [H, phi, c], where H is a subgroup of G, phi is a linear character of H,
 * and c_{H,phi} is an integer. Then
 *          chi-chi(1)\Id(G) = \sum_{H,phi} c_{H,phi} \ind_H^G(phi- \Id(H))
 * If a sequence of characters is given, a sequence of solutions is returned.
 * If already computed, one can pass the characters of G and linear characters
 * as computed by linearCharactersWithFields.
 */
intrinsic brauerInductionDeg0(chi::AlgChtrElt) -> SeqEnum
{ Compute the Brauer induction in degree zero for chi. }
    
    return brauerInductionDeg0([chi])[1];
end intrinsic;

/* Given a character chi of G, compute the Brauer Induction of chi-chi(1)Id, i.e.
 * compute triples [H, phi, c], where H is a subgroup of G, phi is a linear character of H,
 * and c_{H,phi} is an integer. Then
 *          chi-chi(1)\Id(G) = \sum_{H,phi} c_{H,phi} \ind_H^G(phi- \Id(H))
 * If a sequence of characters is given, a sequence of solutions is returned.
 * If already computed, one can pass the characters of G and linear characters
 * as computed by linearCharactersWithFields.
 */
intrinsic brauerInductionDeg0(chars::SeqEnum) -> SeqEnum
{ Compute the Brauer induction in degree zero for all chi in chars. }
    
    local G, IrrG, Hs, phis, M, chi, B, C, coeffs;
    
    G := Group(Parent(chars[1]));
    IrrG := CharacterTable(G);
    
    // Lineare Charactere aller Untergruppen
    Hs := Subgroups(G);
    //phis := &cat ([ [*  phi-Identity(CharacterRing(H`subgroup))  : phi in LinearCharacters(H`subgroup)*] : H in Hs]);  
    
    phis := &cat ([ [*  [*H`subgroup, phi *]  : phi in LinearCharacters(H`subgroup)*] : H in Hs]);
    
    // schreibe a's in M
    M := Matrix(Integers(), #phis, #IrrG,  &cat([Decomposition(IrrG, Induction(phis[i,2] - Identity(CharacterRing(phis[i,1])), G)) : i in [1..#phis]]));
    
    coeffs := [];
    for chi in chars do
        B := Vector(Integers(), Decomposition(IrrG, chi- chi(1)*Identity(CharacterRing(G))) );
        C := Solution(M, B); // C*M=B
        C := [C[i] : i in [1..NumberOfColumns(C)]];
        Append(~coeffs, C);
    end for;
    
    // [H, phi, c]
    return [ [ [* phis[i,1], phis[i,2], coeffs[j,i]*]  : i in [1..#coeffs[j]]  |  coeffs[j,i] ne 0 ] : j in [1..#coeffs] ];
end intrinsic;


/*****************************************************************************************************
    pCubedBrauerInductionDeg0(chars::SeqEnum) -> SeqEnum
    Computes the data necessary to compute Galois Gauss sums. 

    For each chi in chars we do the following:
        If deg(chi) = 1, then we return [* [* G, chi, 1 *] *].
	In this case \tau(\chi) is computable because chi is abelian.
        We ignore trivial characters.

	If deg(chi) eq p the we return [* [* A, psi, 1 *] cat [* G, phi, 1 *] : phi in Induction(1_A, G) and phi ne id *] *]
	In this case chi = ind_A^G(psi) - ind_A^G(1_A) + ind_A^G(1_A) and hence
	    tau(chi) = tau(ind_A^G(psi - 1_A) * tau(ind_A^G(1_A)) = tau(L/L^A, psi) * tau(ind_A^G(1_A)).

        Note that we never need trivial characters because tau(triv char) = 1.
************************************************************************************************************/
intrinsic pCubedBrauerInductionDeg0(setting::Rec) -> SeqEnum
{ Compute the Brauer induction in degree zero for all chi in chars. }

    local G, IrrG, Hs, phis, M, chi, B, C, coeffs;

    chars := setting`IrrG;
    G := Group(Parent(chars[1]));
    IrrG := CharacterTable(G);
    p := PrimeDivisors(#G)[1];

    /* The choice of A is important. It must be chosen such that L^A is not the unramified extension of Qp.
       Otherwise the set of representatives for (O_{L^A} / P^2)^\times is too large for the computation of the Gauss sums.
    */
    Z := Centre(G);
    As := [s`subgroup : s in Subgroups(G) | s`order eq p^2 and Z subset s`subgroup];
    Ks := [FixedField(setting`L, A) : A in As]; 
    b := [IsRamified(p, MaximalOrder(K)) : K in Ks];
    j := 1; while not b[j] do j := j+1; end while;
    A := As[j];

    /* Compute characters psi of A such that the inductions to G of the psis 
      are exactly the degree p irreducible characters of G */
    IrrA := CharacterTable(A);
    IrrZ := CharacterTable(Z);
    psis := [];
    for lambda in IrrZ do
        if lambda ne Identity(CharacterRing(Z)) then
            chi := [psi : psi in IrrA | Restriction(psi, Z) eq lambda][1];
            Append(~psis, chi);
        end if;
    end for;

    brauerInd := [];
    for chi in chars do
        if chi eq Identity(CharacterRing(G)) then
            Append(~brauerInd, [  ]);
        end if;
        if Degree(chi) eq 1 and chi ne Identity(CharacterRing(G)) then
	    Append(~brauerInd, [ [* G, chi, 1 *] ]);
        end if;
	if Degree(chi) eq p then
	    B := [ ]; 
	    psi := [psi : psi in psis | Induction(psi, G) eq chi][1];
	    Append(~B, [* A, psi, 1 *]);
	    dec := Decomposition(IrrG, Induction(Identity(CharacterRing(A)), G));
	    for i:=2 to #IrrG do    /* We ignore the trivial character */
	        if dec[i] ne 0 then
		    Append(~B, [* G, IrrG[i], Integers() ! dec[i] *]);
		end if;
	    end for;
	    Append(~brauerInd, B);
	end if;
    end for;
    return brauerInd;
end intrinsic;


intrinsic G63BrauerInductionDeg0(setting::Rec) -> SeqEnum
{ Compute the Brauer induction in degree zero for all chi in chars. }

    local G, IrrG, Hs, phis, M, chi, B, C, coeffs;

    chars := setting`IrrG;
    G := Group(Parent(chars[1]));
    IrrG := CharacterTable(G);
    p := setting`p;

    /* There is exactly one abelian subgroup U of order 21. */
    U := [A`subgroup : A in AbelianSubgroups(G) | A`order eq 21][1]; 
    TU := CharacterTable(U);
    IndChars := [Induction(chi,G) : chi in TU];

    brauerInd := [];
    for i:=1 to #chars do
        chi := chars[i]; 
        if chi eq Identity(CharacterRing(G)) then
            Append(~brauerInd, [  ]);
        end if;
        if Degree(chi) eq 1 and chi ne Identity(CharacterRing(G)) then
            Append(~brauerInd, [ [* G, chi, 1 *] ]);
        end if;
        if Degree(chi) eq 3 then
            i0 := Index(IndChars, chi);
            B := [ ];
            Append(~B, [* U, TU[i0], 1 *]);
            dec := Decomposition(IrrG, Induction(Identity(CharacterRing(U)), G));
            for i:=2 to #IrrG do    /* We ignore the trivial character */
                if dec[i] ne 0 then
                    Append(~B, [* G, IrrG[i], Integers() ! dec[i] *]);
                end if;
            end for;
            Append(~brauerInd, B);
        end if;
    end for;
    return brauerInd;
end intrinsic;



/* Given a character chi of G, compute the Brauer Induction of chi-chi(1)Id, i.e.
 * compute triples [H, phi, c], where H is a subgroup of G, phi is a linear character of H,
 * and c_{H,phi} is an integer. Then
 *          chi-chi(1)\Id(G) = \sum_{H,phi} c_{H,phi} \ind_H^G(phi- \Id(H))
 * If a sequence of characters is given, a sequence of solutions is returned.
 * If already computed, one can pass the characters of G and linear characters
 * as computed by linearCharactersWithFields.
 */
intrinsic brauerInductionDeg0(chi::AlgChtrElt, IrrG::SeqEnum, linChrs::List) -> SeqEnum
{ Compute the Brauer induction in degree zero for chi, where IrrG are the
  characters of G and linChrs are the linear characters as computed by
  linearCharactersWithFields. }
    
    local G, phis, M,  B, C;
    
    G := Group(Parent(chi));
    
    // Untergruppen mit linearen Charakteren schon berechnet
    phis := [ [*x[1], x[2] *]  : x in linChrs];
    
    // schreibe a's in M
    M := Matrix(Integers(), #phis, #IrrG,  &cat([Decomposition(IrrG, Induction(phis[i,2] - Identity(CharacterRing(phis[i,1])), G)) : i in [1..#phis]]));
    
    B := Vector(Integers(), Decomposition(IrrG, chi- chi(1)*Identity(CharacterRing(G))) );
    C := Solution(M, B); // C*M=B
    C := [C[i] : i in [1..NumberOfColumns(C)]];
    
    // [H, phi, c]
    return [ [* phis[i,1], phis[i,2], C[i]*]  : i in [1..#C]  |  C[i] ne 0 ];
end intrinsic;


/*
 * For a character chi of G compute the conductor
 *     n(chi) = \sum_{i=0}^\infty #G_i/#G_0 \codim(V_chi^{G_i}),
 * where G_i denotes the i-th ramification group of P.
 * The prime P or a list of the non-trivial ramification groups
 * is needed. [Bley/Breuning]
 */
intrinsic conductor(chi::AlgChtrElt, P::RngOrdIdl) -> RngIntElt
{ Compute the conductor of chi for the prime P. }
    local G, n,  G0, i, Gi, codim, useiso, iota, chiGi, Hi;
    
    G := Group(Parent(chi));
    
    G0 := RamificationGroup(P,0);
    
    Gi := G0;
    i := 0;
    n := 0;
    while #Gi ne 1 do
        Gi := RamificationGroup(P,i);
        //dim := InnerProduct(Identity(CharacterRing(Hi)), Restriction(chi, Hi));
        //print "Schritt", i;
        //print "Res(chi)", Restriction(chi, Gi);
        codim := (Degree(chi) - InnerProduct(Identity(CharacterRing(Gi)), Restriction(chi, Gi)) );
        //print([i, #Gi/#G0, codim]);
        n := n + #Gi/#G0 * codim;
        i := i+1;
    end while;
    
    return Integers()!n;
end intrinsic;


/*
 * For a character chi of G compute the conductor
 *     n(chi) = \sum_{i=0}^\infty #G_i/#G_0 \codim(V_chi^{G_i}),
 * where G_i denotes the i-th ramification group of P.
 * The prime P or a list of the non-trivial ramification groups
 * is needed. [Bley/Breuning]
 */
intrinsic conductor(chi::AlgChtrElt, RamGroups::SeqEnum) -> RngIntElt
{ Compute the conductor of chi with ramification groups as given. }
    local G0, i, n, G;

    G0 := RamGroups[1];
    i := 0;
    n := 0;
    for G in RamGroups do
        codim := (Degree(chi) - InnerProduct(Identity(CharacterRing(G)), Restriction(chi, G)) );
        n := n + #G/#G0 * codim;
    end for;
    
    return Integers()!n;
end intrinsic;

intrinsic det(chi::AlgChtrElt, lambda::AlgGrpElt) -> AlgMatElt
{Given lambda in QG, compute det_chi(lambda) using Brauer induction and
 determinants of linear characters.}
    local B, b;
    
    B := BrauerInduction(chi);
    return &*([ Det(b[1],b[2],lambda)^b[3] : b in B]);
end intrinsic;

intrinsic det(chi::AlgChtrElt) -> AlgChtrElt
{Compute the character psi which is given by the linear representation psi(g)=det_chi(g).}
    local G, QG, vals, phi;
    
    G := Group(Parent(chi));
    QG := GroupAlgebra(Rationals(), G);
    vals := [det(chi, QG!g) : g in G];
    for phi in LinearCharacters(G) do
        if vals eq [phi(g) : g in G] then
            return phi;
        end if;
    end for;
    error "Couldn't find linear character that represents determinant!";
end intrinsic;

/* Given an extension L/Q, a character chi\in Irr(G) and x in Q,
 * compute det_chi(x) using Brauer induction.
 * If N/M is the abelian extension for chi, then det_chi(x)=det_chi((x, N/M)).
 * For the definition see [Breuning PhD, Prop 3.6 (4)]. 
 * Optionally, the abelian extensions are taken from the list
 * linChrFlds := linearCharactersWithFields(G, L)
 */
intrinsic det(chi::AlgChtrElt, psi::Map, p::RngIntElt, x::FldRatElt) -> FldCycElt
{Compute det_chi(x).}
    local L, B, Hphi, H, phi, c, d, M, N, N2, Na, PM, H2, res, phi2, PP, a;
    
    if chi eq One(Parent(chi)) then
        return Rationals()!1;
    end if;
    
    L := Domain(Codomain(psi));
    B := BrauerInduction(chi);
    d := 1;
    for Hphi in B do
        H := Hphi[1];
        phi := Hphi[2];
        c := Hphi[3];
        
        // zugehoerige abelsche Koerpersituation
        kerPhi := Kernel(phi);
        M  := FixedField(L, H);
        N  := FixedField(L, kerPhi);
        N2 := ext< M | Factorization(PolynomialRing(M)!DefiningPolynomial(N))[1,1] >;
        Na := AbelianExtension(N2);
        PM  := Factorization(p*RingOfIntegers(M))[1,1];
        H2, res := quo<H|kerPhi>;
        phi2 := reduceCharacter(phi, H2, res);
        psi2 := restrictToQuotient(psi, N, H2, res);
        
        // Artin Abbildung
        //PP := Factorization(Conductor(Na));
        //a := localNormResidueSymbolAsGlobalIdeal(M!x, PP, PM);
        //a := artinMap(a, N, H2, psi2);
        assert Domain(psi2) eq H2;
        a := localNormResidueSymbol(M!x, Na, PM, psi2);
        
        // Determinante
        d := d*Det(H2,phi2,GroupAlgebra(Rationals(), H2)!a)^c;
    end for;
    
    return d;
end intrinsic;

/* Given an extension L/Q, a character chi\in Irr(G) and x in Q,
 * compute det_chi(x) using Brauer induction.
 * If N/M is the abelian extension for chi, then det_chi(x)=det_chi((x, N/M)).
 * For the definition see [Breuning PhD, Prop 3.6 (4)]. 
 * Optionally, the abelian extensions are taken from the list
 * linChrFlds := linearCharactersWithFields(G, L)
 */
intrinsic det(linChrFlds::List, chi::AlgChtrElt, psi::Map, p::RngIntElt, x::FldRatElt) -> FldCycElt
{Compute det_chi(x).}
    local G, L, B, Hphi, H, phi, c, d, M, N, Na, PM, H2, res, phi2, PP, a, bool;
    
    G := Group(Parent(chi));
    if chi eq One(Parent(chi)) then
        return Rationals()!1;
    end if;
    
    L := Domain(Codomain(psi));
    B := BrauerInduction(chi);
    d := 1;
    for Hphi in B do
        H := Hphi[1];
        phi := Hphi[2];
        c := Hphi[3];
        
        kerPhi := Kernel(phi);
        bool, N, M, Na := abelianSituationForLinearCharacter(linChrFlds, H, phi);
        //try
        //    N, M, Na := abelianSituationForLinearCharacter(linChrFlds, H, phi);
        //catch e
        //    print "Creating extension!";
            // zugehoerige abelsche Koerpersituation
        if (not bool) then
            M  := FixedField(L, H);
            N  := FixedField(L, kerPhi);
            Na := AbelianExtension(ext< M | Factorization(PolynomialRing(M)!DefiningPolynomial(N))[1,1] >);
        end if;
        
        PM  := Factorization(p*RingOfIntegers(M))[1,1];
        H2, res := quo<H|kerPhi>;
        phi2 := reduceCharacter(phi, H2, res);
        psi2 := restrictToQuotient(psi, N, H2, res);
        
        // Artin Abbildung
        //PP := Factorization(Conductor(Na));
        //a := localNormResidueSymbolAsGlobalIdeal(M!x, PP, PM);
        //a := artinMap(a, N, H2, psi2);
        assert Domain(psi2) eq H2;
        a := localNormResidueSymbol(M!x, Na, PM, psi2);
        
        // Determinante
        d := d*Det(H,phi,GroupAlgebra(Rationals(), G)!G!(res^(-1))(a))^c;
    end for;
    
    return d;
end intrinsic;

intrinsic reduceCharacter(chi::AlgChtrElt, H::Grp, res::Map) -> AlgChtrElt
{ Given a linear character chi of G and a quotient H of G with natural homomorphism
  res, such that chi is actually a character of H. Compute the character phi of H
  that lifts to chi via res.}
    local LinC, phis, i;
    
    LinC := LinearCharacters(H);
    phis := LiftCharacters(LinC, res, Group(Parent(chi)));
    i := Index(phis,chi);
    if i eq 0 then
        error "Character could not be restricted.";
    end if;
    return LinC[i];
end intrinsic;

/* Restriction map on \prod_chi \CC^\times
 * [Breuning PhD, Lemma 2.4]
 */
intrinsic restriction(x::List, G::Grp, S::Grp) -> List
{ Restriction map on \prod_chi \CC^\times }
    local IrrG, IrrS, psi, i;
    
    IrrG := CharacterTable(G);
    IrrS := CharacterTable(S);
    
    return [* &*([  x[i]^Integers()!InnerProduct( IrrG[i], Induction(psi, G) ) 
                    : i in [1..#IrrG]]) :  psi in IrrS*];
end intrinsic;

intrinsic restriction(x::SeqEnum, IrrG::SeqEnum, IrrS::SeqEnum) -> List
{ Restriction map on \prod_chi \CC^\times }
    local G, S, psi, i;
    
    G := Group(Parent(IrrG[1]));
    S := Group(Parent(IrrS[1]));
    
    return [ &*([  x[i]^Integers()!InnerProduct( IrrG[i], Induction(psi, G) ) 
                    : i in [1..#IrrG]]) :  psi in IrrS];
end intrinsic;

/* Induction map on \prod_chi \CC^\times
 * [Breuning PhD, Lemma 2.4]
 */
intrinsic induction(x::List, G::Grp, S::Grp) -> List
{ Induction map on \prod_chi \CC^\times }
    local IrrG, IrrS, chi;
    
    IrrG := CharacterTable(G);
    IrrS := CharacterTable(S);
    
    return [* &*([  x[i]^Integers()!InnerProduct( IrrS[i], Restriction(chi, S) )
                    : i in [1..#IrrS]])  :  chi in IrrG*];
end intrinsic;

/* Quotient map on \prod_chi \CC^\times
 * [Breuning PhD, Lemma 2.4]
 */
intrinsic quotient(x::List, G::Grp, Q::Grp, q::Map) -> List
{ Quotient map on \prod_chi \CC^\times }
    local IrrG, IrrQ, psi;
    
    IrrG := CharacterTable(G);
    IrrQ := CharacterTable(Q);
    
    return [* x[Index(IrrG, LiftCharacter(psi, q, G))]  :  psi in IrrQ*];
end intrinsic;

intrinsic galoisActionOnCharacters(G::Grp, psiG::Map, Irr::SeqEnum) -> Map
{ Given a group G, psi:G->Aut(L) and the character table of G. Compute
  the Galois action G\times Irr(G) -> Irr(G). }
    local E, IrrSeq, x, GG, g, seq;
    
    E := Domain(psiG(Id(G)));
    IrrSeq := [ [E!x : x in ElementToSequence(chi)]  : chi in Irr];
    
    GG := [g : g in G];
    seq := [[ Index(IrrSeq, [(psiG(g))(E!x)  :  x in chiSeq]) : chiSeq in IrrSeq] : g in G];
    
    return map< car<G, Irr> -> Irr | x :-> Irr[seq[Index(GG, x[1]), Index(Irr, x[2])]] >; 
end intrinsic;

/*
 * Given a field extension L/Q with Galois group G and psi:G->Aut(L).
 * Computes all linear Characters phi for all subgroups H of G
 * and corresponding abelian extensions L^{ker(phi)}/L^H and
 * generates a list of elements [* H, phi, L^{ker(phi)}, L^H, Na *],
 * where Na is the abelian extension L^{ker(phi)}/L^H.
 */
intrinsic linearCharactersWithFields(G::Grp, L::FldNum, psi::Map) -> List
{ Compute all linear characters of all subgroups of G and the corresponding
  abelian field extensions in L. }
    local Hs, phis, list, H, phi, M, N, N2, Na, x, f;
    
    list := [**];
    // Iteration ueber Untergruppen und deren lineare Charactere
    for Hrec in Subgroups(G) do
        H := Hrec`subgroup;
        M  := FixedField(L, [psi(x) : x in H]);
        for phi in LinearCharacters(H) do
            if #H eq 1 then
                Append(~list, [* H, phi, L, L *]);
            elif H eq Kernel(phi) then
                Append(~list, [* H, phi, M, M *]);
            else
                N  := FixedField(L, [psi(x) : x in Kernel(phi)]);
                f := [f[1] : f in  Factorization(PolynomialRing(M)!DefiningPolynomial(N)) | #Roots(f[1], N) eq Degree(f[1])][1];
                //N2 := ext< M | Factorization(PolynomialRing(M)!DefiningPolynomial(N))[1,1] >;
                N2 := ext< M | f >;
                Na := AbelianExtension(N2);
                Append(~list, [* H, phi, N, M, Na *]);
            end if;
        end for;
    end for;
    
    return list;
end intrinsic;

/* Given a field extension L/Q and psi: G -> Aut(L/Q), G=Gal(L/Q), and a list of
 * linear Characters of G.
 * Compute the abelian subextensions N/M in L/Q for each of these characters.
 */
intrinsic abelianSituationForLinearCharacters(linChrs::List, L::FldNum, psi::Map : subfields := []) -> List
{ Given the automorphism map psi:G->Aut(L). Compute the abelian field extensions
  in L corresponding to the given linear characters. }
    local linChrFlds, Hphi, H, phi, bool;
    
    if #subfields eq 0 then
        subfields := Subfields(L);
    end if;
    
    cnt := 1;
    linChrFlds := [**];
    for Hphi in linChrs do
        // print "cnt = ", cnt;
        H := Hphi[1];
        phi := Hphi[2];
        //try
        //    N, M, Na := abelianSituationForLinearCharacter(linChrFlds, H, phi);
            bool, N, M, Na := abelianSituationForLinearCharacter(linChrFlds, H, phi);
        //catch e
        if (not bool) then
            // print "Compute M";
            if #H eq Degree(L) then
                M := Rationals();
            else
                //M  := FixedField(L, [psi(x) : x in H]);
                M := [ K[1] : K in subfields | 
                    Degree(K[1]) eq Degree(L)/#H and  
                    &and([  psi(sigma)(K[2](x)) eq K[2](x) : x in  Generators(K[1]), sigma in Generators(H) ])
                ][1];
                //assert #M eq 1;
                //M := M[1];
            end if;
            // print "Degree(M) = ", Degree(M);
            // print "Compute N";
            if #Kernel(phi) eq Degree(L) then
                N := Rationals();
            else
                //N  := FixedField(L, [psi(x) : x in Kernel(phi)]);
                N := [ K[1] : K in subfields | 
                    Degree(K[1]) eq Degree(L)/#Kernel(phi) and  
                    &and([  psi(sigma)(K[2](x)) eq K[2](x) : x in  Generators(K[1]), sigma in Generators(Kernel(phi)) ])
                ][1];
                //assert #N eq 1;
                //N := N[1];
            end if;
            // print "Degree(N) = ", Degree(N);
            
            //N2 := ext< M | Factorization(PolynomialRing(M)!DefiningPolynomial(N))[1,1] >;
            fac := Factorization(PolynomialRing(M)!DefiningPolynomial(N));
            i := 1; f := fac[i, 1];
            while not #Roots(f, N) eq Degree(f) do
                i := i+1;
                f := fac[i, 1];
            end while;   
            // f := [f[1] : f in  Factorization(PolynomialRing(M)!DefiningPolynomial(N)) | #Roots(f[1], N) eq Degree(f[1])][1];
            N2 := ext< M | f >;
            // print "Compute Na";
            Na := AbelianExtension(N2);
            Append(~linChrFlds, [* H, phi, N, M, Na *]);
        end if;
        //end try;
        cnt := cnt + 1;
    end for;
   
    return linChrFlds;
end intrinsic;

intrinsic G63abelianSituationForLinearCharacters(linChrs::List, L::FldNum, psi::Map : subfields := []) -> List
{ Given the automorphism map psi:G->Aut(L). Compute the abelian field extensions
  in L corresponding to the given linear characters. }
    local linChrFlds, Hphi, H, phi, bool;

    if #subfields eq 0 then
        subfields := Subfields(L);
    end if;
// 
    cnt := 1;
    linChrFlds := [**];
    for Hphi in linChrs do
        // print "cnt = ", cnt;
        H := Hphi[1];
        phi := Hphi[2];
        //try
        //    N, M, Na := abelianSituationForLinearCharacter(linChrFlds, H, phi);
            bool, N, M, Na := abelianSituationForLinearCharacter(linChrFlds, H, phi);
        //catch e
        if (not bool) then
            // print "Compute M";
            if #H eq Degree(L) then
                M := Rationals();
            else
                //M  := FixedField(L, [psi(x) : x in H]);
                M := [ K[1] : K in subfields |
                    Degree(K[1]) eq Degree(L)/#H and
                    &and([  psi(sigma)(K[2](x)) eq K[2](x) : x in  Generators(K[1]), sigma in Generators(H) ])
                ][1];
                //assert #M eq 1;
                //M := M[1];
            end if;
            // print "Degree(M) = ", Degree(M);
            // print "Compute N";
            if #Kernel(phi) eq Degree(L) then
                N := Rationals();
            else
                //N  := FixedField(L, [psi(x) : x in Kernel(phi)]);
                N := [ K[1] : K in subfields |
                    Degree(K[1]) eq Degree(L)/#Kernel(phi) and
                    &and([  psi(sigma)(K[2](x)) eq K[2](x) : x in  Generators(K[1]), sigma in Generators(Kernel(phi)) ])
                ][1];
                //assert #N eq 1;
                //N := N[1];
            end if;
            // print "Degree(N) = ", Degree(N);

            //N2 := ext< M | Factorization(PolynomialRing(M)!DefiningPolynomial(N))[1,1] >;
            fac := Factorization(PolynomialRing(M)!DefiningPolynomial(N));
            i := 1; f := fac[i, 1];
            while not #Roots(f, N) eq Degree(f) do
                i := i+1;
                f := fac[i, 1];
            end while;
            // f := [f[1] : f in  Factorization(PolynomialRing(M)!DefiningPolynomial(N)) | #Roots(f[1], N) eq Degree(f[1])][1];
            N2 := ext< M | f >;
            // print "We don't compute Na; the field remains empty; actually it is not used.";
            // Na := AbelianExtension(N2);
            empty := true;
            Na := empty; 
            Append(~linChrFlds, [* H, phi, N, M, Na *]);
        end if;
        //end try;
        cnt := cnt + 1;
    end for;

    return linChrFlds;
end intrinsic;


// : createMissingExtension := false
intrinsic abelianSituationForLinearCharacter(linChrFlds::List, H::Grp, phi::AlgChtrElt) -> BoolElt, FldNum, FldNum, FldAb
{ Given a list of field extensions for linear characters as computed by 
  abelianSituationForLinearCharacters, return the extension in the list corresponding
  to (H, phi). }
    local found, x, g, N, M, Na, kerPhi;
    
    // gespeicherte Koerpersituationen
    found := false;
    for x in linChrFlds do
        if x[1] eq H then
            if &and([x[2](g) eq phi(g) : g in H]) then
                found := true;
                N := x[3];
                M := x[4];
                Na := x[5];
                break;
            end if;
        end if;
    end for;
    
    if not found then
        /*if createMissingExtension then
            // zugehoerige abelsche Koerpersituation
            M  := FixedField(L, H);
            N  := FixedField(L, kerPhi);
            Na := AbelianExtension(ext< M | Factorization(PolynomialRing(M)!DefiningPolynomial(N))[1,1] >);
        else*/
            //error "No appropriate extension found!";
            return false, _,_,_;
        //end if;
    else
        return true, N, M, Na;
    end if;
end intrinsic;

intrinsic restrictToQuotient(psi::Map, K::FldNum, H::Grp, res::Map) -> .
{ Given the automorphism map psi:G->Aut(L), K\subset L and a factor H
  of U<G with canonical projection res:U-->H.
  Compute psi|_H:H->Aut(K). }
    return restrict_aut_to_quotient(psi, K, H, res);
end intrinsic;

intrinsic restrictToQuotient(psi::Map, K::FldRat, H::Grp, res::Map) -> .
{ Given the automorphism map psi:G->Aut(L), K\subset L and a factor H
  of U<G with canonical projection res:U-->H.
  Compute psi|_H:H->Aut(K). }
    return restrict_aut_to_quotient(psi, K, H, res);
end intrinsic;

/* restrict_aut_to_quotient(psi::Map, K::FldNum/FldRat, H::Grp, res::Map) -> .
 */
function restrict_aut_to_quotient(psi, K, H, res)
    local Hs, Auts;
    Hs := [h : h in H];
    if Type(K) eq FldRat then
        assert(#H eq 1);
        Auts := [ map< K -> K | x :-> x> ] ;
    else
        Auts := [ restricted_aut(psi((res^(-1))(h)),K) : h in Hs];
    end if;
    return map<H -> Auts | x:-> Auts[Index(Hs,x)] >;
end function;

/* Given an automorphism sigma of L and K\subset L.
 * Compute sigma|_K.
 */
function restricted_aut(sigma, K)
    //if not IsSubfield(K,Codomain(sigma)) then
    //    error "K must be a subfield of codomain of sigma";
    //end if;
    return hom<K-> K | x:-> sigma(x), y:-> (sigma^(-1))(y)>; 
end function;



/**
 * The following functions are copied from the RelAlgKTheory package,
 * to get an independent package.
 */


/* brauer_induction(chi :: AlgChtrElt) -> SeqEnum
 * Computes the Brauer induction of chi.
 * Copy from RelAlgKTheory (BrauerInduction).
 */
function brauer_induction(chi)
    local G, ES, CTs, Y, s, i, psi, TG, A, j, y, b, c;

    G := Group(Parent(chi));

    if Degree(chi) eq 1 then
        return [ [* G, chi, 1 *] ];
    end if;

    ES := ElementarySubgroups(G);
    CTs := [* CharacterTable(H) : H in ES *];

    Y := [* *];
    s := 0;
    for i in [1..#ES] do
        for psi in CTs[i] do
           if Degree(psi) eq 1 then
               Append(~Y, [* ES[i], psi *] );
               s := s+1;
           end if;
        end for;
    end for;
    
    TG := CharacterTable(G);
    A := ZeroMatrix(IntegerRing(), #TG, s);
    for i := 1 to #TG do
        j := 1;
        for y in Y do
           A[i, j] := InnerProduct(TG[i], Induction(y[2], G));
           j := j+1;
        end for;
    end for;
    b := Vector( [Integers() ! InnerProduct(chi, psi) : psi in TG] );
    c := Solution(Transpose(A), b);
    return [ [* Y[i][1], Y[i][2], c[i] *] : i in [1..Ncols(c)] | c[i] ne 0 ];
end function;


/* det_linear(U::GrpPerm, phi::AlgChtrElt, lambda::AlgGrpElt) -> AlgMatElt
 * Computes the determinant det_phi(lambda) for a linear character phi.
 * Copy from RelAlgKTheory (Det).
 */
function det_linear(U, phi, lambda)
    local G, E, Gl, Tphi, T, n, M, g;

    assert Degree(phi) eq 1;
    G := Group(Parent(lambda));
    E := Parent(phi(Id(U)));
    Gl := GL(1,E);

    Tphi := hom< U->Gl | [gen->Gl![phi(gen)] : gen in Generators(U)] >;
    T := Induction(Tphi, G);

    n := Index(G, U);

    M := ZeroMatrix(E,n,n);
    for g in G do
        M := M + ScalarMatrix(E, n, Coefficient(lambda, g)) * T(g);
    end for;

    return Determinant(M);
end function;



