// IMPORTANT: The input fields must be locally free (I don't check this). /* Here is an example: Attach("Iso.m"); // Test if two rings of integers are ZG-isomorphic K1 := Cougnard_Nd_adjoin(1, 5 : opt); // "opt" means that he will use a better defining polynomial K2 := Cougnard_Nd_adjoin(1, 221 : opt); G1, _, mK1 := AutomorphismGroup(K1); G2, _, mK2 := AutomorphismGroup(K2); QG := GroupAlgebra(Rationals(), G1); _, f := IsIsomorphic(G1, G2); WedderburnInit(QG); I1 := IntegersToIdeal(QG, K1, mK1); I2 := IntegersToIdeal(QG, K2, f * mK2); b := IsIsomorphic(QG, I1, I2); // Now test if O_K1 is free ZG-module isfree := IsIsomorphic(QG, I1, IdentityMatrix(Rationals(), 16)); // Now test if an ideal is free ZG-module A := ideal< MaximalOrder(K1) | 17>; I3 := IdealToIdeal(QG, K1, A, mK1); isfree := IsIsomorphic(QG, I3, IdentityMatrix(Rationals(), 16)); // Now compute the generator of a normal integral basis b, alpha := HasNormalIntegralBasis(K1); // It also works with C2 and Q8 extensions. */ /* We consider only lattices and orders in A = QG. We represent lattices and * orders by the basis matrix with respect to the basis of A. */ /* Assume that a lattice I is given with basis matrix M, and X is a matrix * representing the action of an element \alpha, this function returns * the basis matrix of I * \alpha. */ intrinsic TransformModule(M, X) -> Any {} N := M*X; //N := VerticalJoin(M, N); d := Denominator(N); L := ChangeRing(d*N, Integers()); L := HermiteForm(L); L := ChangeRing(L, Rationals())/d; return L; end intrinsic; /* A lattice has many basis matrices. The following function returns a canonical * one by bringing the basis matrix in upper triangular form. */ intrinsic Canonicalize(M) -> Any {} N := M; K := BaseRing(M); try d := Denominator(M); M := ChangeRing(d*M, Integers(K)); M := HermiteForm(M); M := ChangeRing(M, K)/d; catch e M := EchelonForm(N); end try; return M; end intrinsic /* If M and N are the basis matrices of lattices X and Y, this function returns * the basis matrix of the lattice X + Y. */ intrinsic AddModules(M, N) -> Any {} n := Nrows(M); L := VerticalJoin(M, N); d := Denominator(L); L := ChangeRing(d*L, Integers()); L := Submatrix(HermiteForm(L), 1, 1, n, n); L := ChangeRing(L, Rationals())/d; return L; end intrinsic; /* Let A = QG and O a maximal order of ZG. Assume that M is the basis matrix * of an ZG-lattice I in A. Return the the basis matrix of the O-lattice spanned * by I. */ intrinsic ApplyMaximalOrder(O::AlgAssVOrd, M::AlgMatElt) -> Any {} BO := Basis(O); // BO is the basis of the maximal order O B := Basis(Algebra(O)); // test if M is invariant under the action H := Canonicalize(M); N := M; for g in Group(Algebra(O)) do N := AddModules(N, M*_rep_mat(Algebra(O)!g)); end for; assert N eq H; // M is invariant under the action of G N := M; _mats := []; for b in BO do m := _rep_mat(Algebra(O)!b); Append(~_mats, m); N := AddModules(N, TransformModule(N, m)); end for; // _mats are the matrices describing the action of the basis of O return N, _mats; end intrinsic; /* Same as ApplyMaximalOrder, but this time with arbitrary orders. */ intrinsic ApplyOrder(O::AlgAssVOrd, M) -> Any {} m := ZeroMatrix(Rationals(), 0, Dimension(Algebra(O))); for i in [1..Nrows(M)] do v := &+[ M[i, j]*Basis(Algebra(O))[j] : j in [1..Ncols(M)]]; m := VerticalJoin(m, VerticalJoin([_elt_in_basis(v*g) : g in Basis(O) ])); end for; return Submatrix(Canonicalize(m), 1, 1, Dimension(Algebra(O)), Dimension(Algebra(O))); end intrinsic; /* Same as above but using *. */ intrinsic '*'(M::AlgMatElt, O::AlgAssVOrd) -> Any {} x, _ := ApplyOrder(O, M); return x; end intrinsic; /* Assume that g is an element of A and M is a lattice in A (for whatever order), * this function returns the lattice g * M. */ intrinsic ApplyElementLeft(g, M) -> Any {} m := ZeroMatrix(Rationals(), 0, Dimension(Parent(g))); for i in [1..Nrows(M)] do v := &+[ M[i, j]*Basis(Parent(g))[j] : j in [1..Ncols(M)]]; m := VerticalJoin(m, _elt_in_basis(g*v)); end for; return Submatrix(Canonicalize(m), 1, 1, Dimension(Parent(g)), Dimension(Parent(g))); end intrinsic; /* Assume that A = QG, K is a normal number field, m : G -> Aut(K/Q) an * isomorphism and I an (ambiguous) ideal. This function returns the basis * matrix of the ideal I, considered as an ideal of A (using m). */ intrinsic IdealToIdeal(A, K, I, m) -> Any {} d := Degree(K); G := Group(A); O := MaximalOrder(K); bmatinv := ChangeRing(BasisMatrix(I), Rationals())^-1; B := Basis(I); assert G eq Domain(m); S := []; BA := Basis(A); for g in GeneratorsSequence(G) do M := ZeroMatrix(Rationals(), d, d); for j in [1..d] do v := Vector(Eltseq(O!(m(g)(B[j]))))*bmatinv; // or g^-1? for k in [1..d] do M[j, k] := v[k]; // this should be the correct one for right action end for; end for; assert Denominator(M) eq 1; Append(~S, M); end for; SS := []; for g in GeneratorsSequence(G) do M := VerticalJoin([ _elt_in_basis(BA[j]*A!g) : j in [1..d]]); Append(~SS, M); end for; b, T := IsIsomorphic(GModule(G, S : Check), GModule(G, SS : Check)); assert b; return Canonicalize(T); end intrinsic; /* Assume that A = QG, K is a normal number field, m : G -> Aut(K/Q) an * isomorphism. This function returns the basis matrix of O_K, considered as an * ideal of A (using m). */ intrinsic IntegersToIdeal(A, K, m) -> Any {} O := LLL(MaximalOrder(K)); return IntegersToIdeal(A, K, O, m); end intrinsic; intrinsic IntegersToIdeal(A, K, O, m) -> Any {} d := Degree(K); G := Group(A); B := Basis(O); assert G eq Domain(m); S := []; BA := Basis(A); for g in GeneratorsSequence(G) do M := ZeroMatrix(Rationals(), d, d); for j in [1..d] do v := O!(m(g)(B[j])); for k in [1..d] do M[j, k] := v[k]; end for; end for; Append(~S, M); end for; SS := []; for g in GeneratorsSequence(G) do M := VerticalJoin([ _elt_in_basis(BA[j]*A!g) : j in [1..d]]); Append(~SS, M); end for; b, T := IsIsomorphic(GModule(G, S : Check), GModule(G, SS : Check)); assert b; return Canonicalize(T), T; end intrinsic; /* Get the coordinates of the element M as a matrix with one row. */ intrinsic _elt_in_basis(M) -> Any {} v := Eltseq(M); return Matrix(1, #v, v); end intrinsic; intrinsic _rep_mat(M) -> Any {} return VerticalJoin([ _elt_in_basis(b*M) : b in Basis(Parent(M)) ]); end intrinsic; intrinsic elt_in_basis(M) -> Any {} I := Parent(M); return elt_in_basis(M, Basis(I)); end intrinsic; intrinsic IsConsistentWithCache(A, b, U, B) -> ModMatRngElt {} y := ZeroMatrix(Rationals(), 1, Nrows(B)); for i in [1..Minimum(Ncols(B), Nrows(B))] do if IsZero(B[i, i]) then break; end if; y[1, i] := b[1, i]/B[i, i]; end for; //y := Matrix(1, Nrows(B), [ IsZero(B[i, i]) select 0 else b[1, i]/B[i,i] : i in [1..Nrows(B)]]); //assert b; //assert y*U*A eq b; return y*U; end intrinsic; intrinsic IsConsistentWithCache2(A, b, U, B) -> ModMatRngElt {} y := ZeroMatrix(BaseRing(U), 1, Nrows(B)); for i in [1..Minimum(Ncols(B), Nrows(B))] do if IsZero(B[i, i]) then break; end if; y[1, i] := b[1, i]/B[i, i]; end for; //y := Matrix(1, Nrows(B), [ IsZero(B[i, i]) select 0 else b[1, i]/B[i,i] : i in [1..Nrows(B)]]); //assert b; //assert y*U*A eq b; y*U; return ChangeRing(y*U, Rationals()); end intrinsic; intrinsic elt_in_basis(M, B) -> Any {} I := Parent(B[1]); K := BaseRing(M); A := Matrix(K, #B, Dimension(Generic(I)), [ 0 : i in [1..#B*Dimension(Generic(I))]]); for i in [1..#B] do v := Eltseq(B[i]); for j in [1..#v] do A[i, j] := v[j]; end for; end for; b := Matrix(K, 1, Dimension(Generic(I)), Eltseq(M)); solvable, x := IsConsistent(A, b); assert solvable; //assert M eq &+[ x[1,i]*B[i] : i in [1..#B]]; return x; end intrinsic; intrinsic basis_mat(S) -> Any {} n := #S; M := Matrix(Rationals(), n, n, [ 0 : i in [1..n^2]]); for i in [1..n] do v := elt_in_basis(S[i]); for j in [1..n] do M[i, j] := v[1, j]; end for; end for; return M; end intrinsic; intrinsic rep_mat(a) -> Any {} I := Parent(a); d := Dimension(I); B := Basis(I); M := Matrix(Rationals(), d, d, [ 0 : i in [1..d^2]]); for i in [1..d] do b := B[i]; v := elt_in_basis(a*b); for j in [1..d] do M[i, j] := v[1, j]; end for; end for; return M; end intrinsic; intrinsic _rep_matrix_with_respect_to_other_basis(M, N, z) -> Any {} // Assume that M and N are sequences of matrices and z is a matrix leftside := VerticalJoin( [ Matrix(Rationals(), 1, Nrows(M[1])^2, Eltseq(n) ) : n in N]); m := ZeroMatrix(Rationals(), 0, #M); for i in [1..#M] do t := M[i]*z; b, x := IsConsistent(leftside, Matrix(Rationals(), 1, Nrows(M[1])^2, Eltseq(t))); assert b; m := VerticalJoin(m, x); end for; return m; end intrinsic; intrinsic adjusted_rep_matrices(M, N, I) -> Any {} B := Basis(I); SM := basis_mat(M); SNinv := (basis_mat(N))^-1; S := []; for b in B do Append(~S, SM*rep_mat(b)*SNinv); end for; return S; end intrinsic; intrinsic saturate(S) -> Any {} n := Nrows(S[1]); Sad := Denominator(S[1])*S[1]; M := Matrix(Integers(), 1, n^2, Eltseq(Sad)); Res := []; for i in [2..#S] do Sad := Denominator(S[i])*S[i]; M := VerticalJoin(M, Matrix(Integers(), 1, n^2, Eltseq(Sad))); end for; smithform, P, Q := SmithForm(M); SS := P*M; for i in [1..#S] do Append(~Res, Matrix(Integers(), n, n, Eltseq(SS[i])) div smithform[i, i]); end for; return Res; end intrinsic; // IsoOnSimpleAlgebra := recformat< A:AlgGrp, e, rho, Ai, Mi, phii, psii>; AddAttribute(AlgGrp, "WedderburnDecomposition"); AddAttribute(AlgGrp, "MaximalOrder"); AddAttribute(AlgGrp, "NatRep"); AddAttribute(AlgMat, "UnitGrpStuff"); AddAttribute(AlgMat, "StuffForBasis"); AddAttribute(AlgGrp, "StuffForBasis"); intrinsic WedderburnInit(A::AlgGrp) -> Any {} K := BaseRing(A); G := Group(A); irr := IrreducibleModules(Group(A), K); ci := CentralIdempotents(A); M := MaximalOrder(A); AMaximalOrder := M; ANatRep := func< a | _rep_mat(a) >; AWedderburnDecomposition := []; for i in [1..#irr] do r := rec; V := irr[i]; rho := Representation(V); rA := A; rAi := Codomain(rho); rrho := rho; rphii := func< a | rAi!_apply_representation_to_group_algebra_element(a, rho, V)>; for j in [1..#ci] do if not IsZero(_apply_representation_to_group_algebra_element(ci[j], rho, V)) then e := ci[j]; assert IsOne(_apply_representation_to_group_algebra_element(e, rho, V)); re := e; break; end if; end for; t := VerticalJoin( [ Matrix(1, Dimension(Generic(rAi)), Eltseq(rho(g))) : g in G]); B, U := EchelonForm(t); rpsii := function(a) v := IsConsistentWithCache(t, Matrix(1, Nrows(a)^2, Eltseq(a)), U, B); return re*&+[ v[1, i]*Basis(A)[i] : i in [1..Dimension(A)]]; end function; tt := VerticalJoin([ Matrix(1, Nrows(a)^2, Eltseq(a)) : a in Basis(rAi) ]); BB, UU := EchelonForm(tt); rAiStuffForBasis := ; rMi := [ rphii(e*b) : b in Basis(M) | not IsZero(e*b)]; rAiUnitGrpStuff := SimpleAlgebraGetUnitsMod(rAi, rMi, Order(G)); Append(~AWedderburnDecomposition, r); end for; assert A!1 eq &+[ (rAi!1)@rpsii : r in AWedderburnDecomposition]; return true; end intrinsic; /* If A has a Wedderburn decomposition A1 x ... x Ar and corresponding * idempotents 1 = e_1 + ... + e_r, and M is the basis matrix of a lattice I, * this function basis matrices for M * e_1,..., M * e_r. */ intrinsic Decompose(A::AlgGrp, M::AlgMatElt) -> Any {} B := Basis(A); z := [* *]; for k in [1..#AWedderburnDecomposition] do Ai := AWedderburnDecomposition[k]Ai; m := [* *]; for i in [1..Nrows(M)] do v := 0; for j in [1..Ncols(M)] do v := v + M[i, j] * B[j]; end for; zzz := (AWedderburnDecomposition[k]phii)(v); assert Parent(zzz) eq AWedderburnDecomposition[k]Ai; Append(~m, zzz); end for; _T := Submatrix(Canonicalize(VerticalJoin([ elt_in_basis(zz) : zz in m])),1,1,Dimension(Ai), Dimension(Ai)); Append(~z, _T); end for; m := ZeroMatrix(BaseRing(A), 0, Dimension(A)); MO_dec := z; r := #AWedderburnDecomposition; for i in [1..r] do BMOi := [ &+[ (MO_dec[i])[k, j] * Basis(AWedderburnDecomposition[i]Ai)[j] : j in [1..Ncols(MO_dec[i])]] : k in [1..Nrows(MO_dec[i])]]; m := VerticalJoin(m, VerticalJoin([ _elt_in_basis(x@AWedderburnDecomposition[i]psii) : x in BMOi])); end for; //assert Canonicalize(m) eq M; return z; end intrinsic; /* Assume that A is a simple Q-algebra, O a maximal order of A and M, N two O-lattices. * This function checks whether M and N are O isomorphic. If so, it returns a scalar * \alpha \in A such that M \alpha = N. * * At the moment only A = M_n(Q) and dim_Q(A) = 4 are supported. */ intrinsic IsIsomorphicSimple(A, O, M, N) -> Any {} if A eq Generic(A) then // A is full matrix algebra over Q d := Dimension(A); if d eq 1 then lambda := N*M^-1; return true, lambda; else _, n := IsPower(d, 2); // A = Mat_n(Q) S := Submatrix(Canonicalize(Matrix([Rows(b)[1] : b in O])), 1, 1, n, n); MM := [ &+[ M[i, j]*(Basis(A)[j]) : j in [1..d]] : i in [1..d]]; NN := [ &+[ N[i, j]*(Basis(A)[j]) : j in [1..d]] : i in [1..d]]; MS := [ m*S^-1 : m in MM]; NS := [ n*S^-1 : n in NN]; MSe11 := Submatrix(Canonicalize(Matrix([ Rows(Transpose(m))[1] : m in MS])), 1, 1, n, n); NSe11 := Submatrix(Canonicalize(Matrix([ Rows(Transpose(m))[1] : m in NS])), 1, 1, n, n); basisforMSe11 := []; for j in [1..Nrows(MSe11)] do b := ZeroMatrix(BaseRing(S), n, n); for i in [1..n] do b[i, 1] := MSe11[j, i]; end for; Append(~basisforMSe11, b); end for; basisforNSe11 := []; for j in [1..Nrows(NSe11)] do b := ZeroMatrix(BaseRing(S), n, n); for i in [1..n] do b[i, 1] := NSe11[j, i]; end for; Append(~basisforNSe11, b); end for; [ basisforMSe11[i] : i in [1..n]]; eij(n, 1, 1); thetaM := &+[ basisforMSe11[i]*eij(n, 1, i) : i in [1..n]]; thetaN := &+[ basisforNSe11[i]*eij(n, 1, i) : i in [1..n]]; standardbasis := &cat[ [ eij(n, i, j) : i in [1..n]] : j in [1..n]]; scalar_for_isomorphism := thetaN*thetaM^-1; XX := Canonicalize(Matrix(d, d, &cat[ Eltseq(scalar_for_isomorphism*m) : m in MM])) *Canonicalize(Matrix(d, d, &cat[ Eltseq(m) : m in NN]))^-1; assert IsDiagonal(XX) and forall{IsUnit(XX[i, i]) : i in [1..Nrows(XX)]}; return true, scalar_for_isomorphism; end if; elif Dimension(A) eq 4 then b, H, phi := IsQuaternionAlgebra(A); assert b; HO := Order(Integers(), [ phi(O[j]) : j in [1..4]]); assert IsMaximal(HO); HM := RightIdeal(HO, [ &+[ M[i, j]*phi(Basis(A)[j]) : j in [1..4]] : i in [1..4]]); HN := RightIdeal(HO, [ &+[ N[i, j]*phi(Basis(A)[j]) : j in [1..4]] : i in [1..4]]); b, _, _scalar_for_isomorphism := IsRightIsomorphic(HM, HN); assert RightIdeal(HO, [ _scalar_for_isomorphism *x : x in Basis(HM) ]) eq HN; if not b then return false, Zero(A); else return true, _scalar_for_isomorphism@@phi; end if; end if; error "not yet implemented"; end intrinsic; /* Assume that A = QG and M, N are two ZG-lattices. This function checks * whether M and N are O isomorphic. If so, it returns a scalar * \alpha \in A such that M \alpha = N. */ intrinsic IsIsomorphic(A, M, N) -> Any {} // Assume that WedderburnInit(A) was already run O := AMaximalOrder; G := Group(A); r := #AWedderburnDecomposition; basA := Basis(A); ZG := Order(Integers(), Basis(A)); // Enlarging to maximal order MO := M*O; // Enlarging to maximal order NO := N*O; MO_dec := Decompose(A, MO); NO_dec := Decompose(A, NO); isos := [* *]; units := [* *]; real_units := [* *]; for i in [1..r] do // Checking if isomorphic over the maximal order M_i of A_i Ai := AWedderburnDecomposition[i]Ai; Mi := AWedderburnDecomposition[i]Mi; b, left_scalar := IsIsomorphicSimple(Ai, Mi, MO_dec[i], NO_dec[i]); "i", i; "Ai", Ai; "Mi", Mi; "NO_dec[i]", NO_dec[i]; if not b then // Not isomorphic return false, 0; end if; // To check if the original modules are isomorphic, we need to // compute some information about the unit group of the // maximal orders. i; Append(~real_units, UnitGroupStuff(Ai, Mi, NO_dec[i], Order(G))); Append(~isos, left_scalar); end for; // We now know that M * O and N * O are isomorphic. iso := &+[ isos[i]@(AWedderburnDecomposition[i]psii) : i in [1..r]]; // Check that iso is correct v := ZeroMatrix(Rationals(), 0, Dimension(A)); for i in [1..Nrows(M)] do b := &+[ MO[i, j]*basA[j] : j in [1..Ncols(M)]]; v := VerticalJoin(v, Matrix(Rationals(), 1, Dimension(A), Eltseq(A!(iso*b)))); end for; assert Canonicalize(v) eq Canonicalize(NO); Canonicalize(v) eq Canonicalize(NO); k := Dimension(A); rep_mat := ZeroMatrix(Rationals(), Dimension(A), Dimension(A)); morps := [* *]; N_bas_mat_trans := Transpose(N); M_bas_mat_trans := Transpose(M); N_bas_mat_trans_inv := (N_bas_mat_trans)^-1; M_bas_mat_trans_inv := (M_bas_mat_trans)^-1; [ #real_units[i] : i in [1..r]]; //[* : i in [1..r] *]; S := CartesianProduct(<[ x@AWedderburnDecomposition[i]psii : x in real_units[i] ] : i in [1..r]>); "There are ", #S, " many morphisms to check"; isos_in_QG := [ isos[i]@AWedderburnDecomposition[i]`psii : i in [1..r]]; //"Starting to loop ... "; nn := 0; for c in S do nn := nn + 1; //if nn eq 3 then // return false; //end if; morp := &+[ (c[i]*isos_in_QG[i]) : i in [1..r]]; for l in [1..k] do v := Eltseq(A!(morp*Basis(A)[l])); for j in [1..k] do rep_mat[j, l] := v[j]; end for; end for; z := N_bas_mat_trans_inv * rep_mat * M_bas_mat_trans; if Abs(Denominator(z)) eq 1 then return true, z, rep_mat; end if; end for; return false, 0; end intrinsic; /* Step (i) of Algorithm 4.1 */ intrinsic UnitGroupStuff(A, O, M, c) -> Any // c is the conductor {} if A eq Generic(A) then if Dimension(A) eq 1 then // A = Q R := ResidueClassRing(c); U, u := GenericGroup([-1]: Mult := '*', Eq := 'eq', Id := 1); return [ A!x : x in Codomain(u)]; else // A = M_n(K), with K a number field // We use Bley--Johnston, 2008, Section 6 d := Dimension(A); _, n := IsPower(d, 2); // Can only do K = Q, because we do not deal with pseudo matrices S := Submatrix(Canonicalize(Matrix([Rows(b)[1] : b in O])), 1, 1, n, n); assert BaseRing(S) eq Rationals(); assert Canonicalize(Matrix([ Eltseq(S*b*S^-1) : b in O])) eq IdentityMatrix(BaseRing(S), d); // This meanse that we have a = O_K K := BaseRing(S); O:= MaximalOrder(K); if n eq 2 then A1 := [ Matrix(O, 2, 2, [ 1, a, 0, 1] ) : a in IntegralBasis(K)]; A2 := [ Matrix(O, 2, 2, [ 1, 0, a, 1] ) : a in IntegralBasis(K)]; U, m := UnitGroup(K); V := A1 cat A2 cat [ Matrix(O, 2, 2, [1, 0, 0, 1])] cat [ Matrix(O, 2, 2, [-1, 0, 0, 1])] cat [Matrix(O, 2, 2, [1, 0, 0, -1])]; V := V cat [ Matrix(O, 2, 2, [ m(e), 0, 0, 1]) : e in Generators(U)]; function eqmodc(A, B) for i in [1..Nrows(A)] do for j in [1..Ncols(A)] do if (A[i,j] mod c) ne (B[i,j] mod c) then return false; end if; end for; end for; return true; end function; G, g := GenericGroup(V: Mult := '*', Eq := eqmodc, Id := IdentityMatrix(O, 2)); return [ A!(S*x*S^-1) : x in Codomain(g) ]; else V := []; for i in [1..n] do for j in [1..n] do if j eq i then continue; end if; for a in IntegralBasis(K) do b := IdentityMatrix(O, n); b[i, j] := a; Append(~V, b); end for; end for; end for; V; U, m := UnitGroup(K); for e in Generators(U) do b := IdentityMatrix(O, n); b[1, 1] := m(e); Append(~V, b); end for; function eqmodc(A, B) for i in [1..Nrows(A)] do for j in [1..Ncols(A)] do if (A[i,j] mod c) ne (B[i,j] mod c) then return false; end if; end for; end for; return true; end function; G, g := GenericGroup(V: Mult := '*', Eq := eqmodc, Id := IdentityMatrix(O, n)); return [ A!(S*x*S^-1) : x in Codomain(g) ]; end if; end if; elif Dimension(A) eq 4 then "Here"; Generators(A); b, H, phi := IsQuaternionAlgebra(A); assert b; HO := Order(Integers(), [ phi(O[j]) : j in [1..4]]); assert IsMaximal(HO); HM := RightIdeal(HO, [ &+[ M[i, j]*phi(Basis(A)[j]) : j in [1..4]] : i in [1..4]]); HH := LeftOrder(HM); I := RightIdeal(HH, [HH!c]); UU, uu := UnitGroup(HH); U, u := GenericGroup([ x@uu : x in GeneratorsSequence(UU)]: Mult := '*', Eq := func, Id := HH!1); //[ x@@phi : x in Codomain(u)]; return [ x@@phi : x in Codomain(u)]; end if; error("Not yet implemented"); end intrinsic; intrinsic SimpleAlgebraGetUnitsMod(A, O, c) -> Any {} if A eq Generic(A) then if Dimension(A) eq 1 then assert BaseRing(A) eq Rationals(); R := ResidueClassRing(c); U, u := GenericGroup([-1]: Mult := '*', Eq := 'eq', Id := 1); return [ A!x : x in Codomain(u)]; //return >; else if BaseRing(A) eq Rationals() then if Dimension(A) eq 4 then m := Matrix(Integers(), VerticalJoin([ Matrix(Integers(), 1, #O, Eltseq(x)) : x in O])); assert HermiteForm(m) eq IdentityMatrix(Integers(), #O); assert Dimension(A) eq 4; A1 := [ Matrix(Integers(), 2, 2, [ 1, a, 0, 1] ) : a in [1..1]]; A2 := [ Matrix(Integers(), 2, 2, [ 1, 0, a, 1] ) : a in [1..1]]; V := A1 cat A2 cat [ Matrix(Integers(), 2, 2, [1, 0, 0, 1])] cat [ Matrix(Integers(), 2, 2, [-1, 0, 0, 1])] cat [Matrix(Integers(), 2, 2, [1, 0, 0, -1])]; function eqmodc(A, B) for i in [1..Nrows(A)] do for j in [1..Ncols(A)] do if (A[i,j] mod c) ne (B[i,j] mod c) then return false; end if; end for; end for; return true; end function; G, g := GenericGroup(V: Mult := '*', Eq := eqmodc, Id := IdentityMatrix(Integers(), 2)); return [ A!x : x in Codomain(g) ]; else m := Matrix(Integers(), VerticalJoin([ Matrix(Integers(), 1, #O, Eltseq(x)) : x in O])); assert HermiteForm(m) eq IdentityMatrix(Integers(), #O); _, n := IsPower(Dimension(A), 2); K := Rationals(); V := []; for i in [1..n] do for j in [1..n] do if j eq i then continue; end if; for a in IntegralBasis(K) do b := IdentityMatrix(Integers(), n); b[i, j] := a; Append(~V, b); end for; end for; end for; V; U, m := UnitGroup(K); //V := A1 cat A2 cat [ Matrix(O, 2, 2, [1, 0, 0, 1])] cat [ Matrix(O, 2, 2, [-1, 0, 0, 1])] cat [Matrix(O, 2, 2, [1, 0, 0, -1])]; for e in Generators(U) do b := IdentityMatrix(Integers(), n); b[1, 1] := m(e); Append(~V, b); end for; V; function eqmodc(A, B) for i in [1..Nrows(A)] do for j in [1..Ncols(A)] do if (A[i,j] mod c) ne (B[i,j] mod c) then return false; end if; end for; end for; return true; end function; G, g := GenericGroup(V: Mult := '*', Eq := eqmodc, Id := IdentityMatrix(Integers(), n)); return [ A!x : x in Codomain(g) ]; end if; else error("Not implemented yet"); if not IsIsomorphic(BaseRing(A), QuadraticField(2)) then error("Not implemented yet"); end if; KK := BaseRing(A); OO := MaximalOrder(BaseRing(A)); om := Matrix(KK, VerticalJoin([ Matrix(KK, 1, Degree(A)^2, Eltseq(x)) : x in O])); s := Denominator(om); oms := Submatrix(ChangeRing(HermiteForm(ChangeRing(s*om, OO)), KK)/s, 1, 1, 4, 4); if not IsDiagonal(oms) then error("Not diagonal"); end if; if not &and[ IsIntegral(oms[i,i]) and Abs(Norm(oms[i, i])) eq 1 : i in [1..4]] then error("Not integral"); end if; // OK so we are in the nice case that Lambda = Mat_2(O_K), K = Q(sqrt 2) I := ideal /Different(OO); Q, mQ := quo< OO | I>; U, mU := UnitGroup(OO); A1 := [ Matrix(OO, 2, 2, [ 1, OO!a, 0, 1] ) : a in Basis(OO)]; A2 := [ Matrix(OO, 2, 2, [ 1, 0, OO!a, 1] ) : a in Basis(OO)]; A3 := [ Matrix(OO, 2, 2, [ mU(g), 0, 0, 1] ) : g in Generators(U)]; V := A1 cat A2 cat A3; function eqmodc(A, B) for i in [1..Nrows(A)] do for j in [1..Ncols(A)] do if not (A[i,j] - B[i,j] in I) then return false; end if; end for; end for; return true; end function; function mul(A, B) C := A*B; for i in [1..Nrows(C)] do for j in [1..Ncols(C)] do C[i, j] := C[i, j] mod I; end for; end for; return C; end function; //SetVerbose("GrpGen", 1); G, g := GenericGroup(V: Mult := mul, Eq := eqmodc, Id := IdentityMatrix(OO, 2)); return [ A!x : x in Codomain(g) ]; end if; end if; elif Dimension(A) eq 4 then b, H, phi := IsQuaternionAlgebra(A); assert b; HO := Order(Integers(), [ phi(O[j]) : j in [1..#O]]); assert IsMaximal(HO); UU, uu := UnitGroup(HO); I := rideal; U, u := GenericGroup([ x@uu : x in GeneratorsSequence(UU)]: Mult := '*', Eq := func, Id := HO!1); return [ x@@phi : x in Codomain(u)]; end if; if Center(A) eq A then while true do alpha := myrandom(A); a := MinimalPolynomial(alpha); if Degree(a) eq Dimension(A) then break; end if; end while; L := NumberField(a); M := Matrix([Eltseq(alpha^i) : i in [0..Dimension(A) - 1]]); function ff(z) v,vv := IsConsistent(M, Matrix([Eltseq(z)])); assert v; return &+[ vv[1, i] * w^(i-1) : i in [1..Dimension(A)]]; end function; function ffinv(v) vv := Eltseq(v); return &+[ vv[i]*alpha^(i-1) : i in [1..Dimension(A)]]; end function; OO := Order([ ff(O[i]) : i in [1..#O]]); assert IsMaximal(OO); UU, uu := UnitGroup(OO); I := ideal; U, u := GenericGroup([ x@uu : x in Generators(UU)]: Mult := '*', Eq := func, Id := OO!1); return [ ffinv(L!x) : x in Codomain(u)]; end if; error("Not yet implemented"); end intrinsic; // Compute generators for normal integral basis intrinsic HasNormalIntegralBasis(K) -> Any {} d := Degree(K); G, _, mK := AutomorphismGroup(K); QG := GroupAlgebra(Rationals(), G); _ := WedderburnInit(QG); OK := LLL(MaximalOrder(K)); B := Basis(OK); I, II := IntegersToIdeal(QG, K, OK, mK); b, M := IsIsomorphic(QG, IdentityMatrix(Rationals(), d), I); if not b then return b, K!0; end if; v := Vector([Transpose(M)[1, i] : i in [1..d]]); alpha := &+[ (v * I * II^-1)[i] * B[i] : i in [1..d]]; orbit := [ mK(g)(alpha) : g in G]; m := Matrix([Eltseq(OK!o) : o in orbit]); assert Abs(Determinant(m)) eq 1; return true, K!alpha; end intrinsic; // More Helper intrinsic _apply_representation_to_group_algebra_element(a, rho, V) -> Any {} B := Basis(Parent(a)); G := Group(V); assert G eq Group(Parent(a)); z := 0; w := Eltseq(a); for i in [1..#B] do z := z + w[i]*rho(B[i]); end for; return z; end intrinsic; intrinsic eij(n, i, j) -> Any {} M := ZeroMatrix(Rationals(), n, n); M[i, j] := 1; return M; end intrinsic; intrinsic myrandom(A) -> Any {} return &+[ Random(-10, 10)*Basis(A)[i] : i in [1..Dimension(A)]]; end intrinsic; // Construct the examples of Cougnard Qx := PolynomialRing(Rationals()); N_1 := NumberField( x^8 - x^7 + 62126*x^6 - 565081*x^5 + 1060385071*x^4 - 16366741325*x^3 + 465279400700*x^2 + 7092550941085*x + 160472449673155); H8 := TransitiveGroup(8, 5); intrinsic Cougnard_Nd(d:opt:=false) -> Any {} if d eq 1 then return N_1; end if; _temp := AbsoluteField(ext); subs := Subfields(_temp); subs := [ x : x in subs | IsIsomorphic(GaloisGroup(x[1]), H8)]; subs := [ x : x in subs | not IsIsomorphic(x[1], N_1) ]; assert #subs eq 1; L := subs[1][1]; if opt then L, _ := OptimizedRepresentation(L); end if; return L; end intrinsic; intrinsic Cougnard_Nd_adjoin(d, n:opt:=false) -> Any {} Nd := Cougnard_Nd(d:opt:=opt); L := AbsoluteField(ext< Nd | x^2 - n>); if opt then L, _ := OptimizedRepresentation(L); end if; return L; end intrinsic;