diff --git a/gap/matrix/wordsInNiceGens/BruhatDecomposition.gd b/gap/matrix/wordsInNiceGens/BruhatDecomposition.gd new file mode 100755 index 00000000..274d0183 --- /dev/null +++ b/gap/matrix/wordsInNiceGens/BruhatDecomposition.gd @@ -0,0 +1,48 @@ +############################################################################# +# BruhatDecomposition.gd +############################################################################# +############################################################################# +## +## BruhatDecomposition package +## +## Daniel Rademacher, RWTH Aachen University +## Alice Niemeyer, RWTH Aachen University +## +## Licensed under the GPL 3 or later. +## +############################################################################# +# +#! @Chapter Foreword +#! +#! Let G be one of the classical groups SL, Sp, SU or SO over a finite field of size q and dimension d. Let g be an element in G. +#! We want to write g = u_1 \cdot w \cdot u_2 with u_1 and u_2 lower unitriangular matrices and w a monomial matrix.

+#! This is already implemented for: +#! +#! +#! Special linear group (SL) (see Chapter ) +#! +#! +#! Symplectic group (Sp) (see Chapter ) +#! +#! +#! Special unitary group (SU) (see Chapter ) +#! +#! +#! Special orthogonal group (SO) (see Chapter ) +#! +#! + + + +#! @Section Main Function +#! @SectionLabel MainFunction + +##### +# BruhatDecomposition() +##### + +#! @Arguments g +#! @Returns pgr (A SLP to compute u_1,u_2,p_{sign} and diag and the matrices u_1, u_2, p_{sign} and diag itself.) +#! @Description +#! Checks whether g is an element of one of the classical groups in their natural representation. If yes, the corresponding Bruhat decomposition of the group and the element g is calculated. Otherwise the function prints a warning. +DeclareGlobalFunction( "BruhatDecomposition" ); diff --git a/gap/matrix/wordsInNiceGens/BruhatDecomposition.gi b/gap/matrix/wordsInNiceGens/BruhatDecomposition.gi new file mode 100755 index 00000000..1e3849ee --- /dev/null +++ b/gap/matrix/wordsInNiceGens/BruhatDecomposition.gi @@ -0,0 +1,36 @@ +###################################### +# BruhatDecomposition.gi +###################################### + +##### +# BruhatDecomposition() +##### + +InstallGlobalFunction( BruhatDecomposition, +function(g) + + local d, fld, q; + + d := Length( g ); + fld := FieldOfMatrixList( [g] ); + q := Size(fld); + + if g in Sp(d,q) then + return BruhatDecompositionSp(LGOStandardGensSp(d,q),g); + elif g in SU(d,q) then + return BruhatDecompositionSU(LGOStandardGensSU(d,q),g); + elif g in SO(1,d,q) then + return BruhatDecompositionSO(LGOStandardGensSO(1,d,q),g); + elif g in SO(0,d,q) then + return BruhatDecompositionSO(LGOStandardGensSO(0,d,q),g); + elif g in SO(-1,d,q) then + return BruhatDecompositionSO(LGOStandardGensSO(-1,d,q),g); + elif g in SL(d,q) then + return BruhatDecompositionSL(LGOStandardGensSL(d,q),g); + else + Print("The element g is not an element of one of the classical groups in their natural representation. \n"); + Print("Abort."); + fi; + +end +); diff --git a/gap/matrix/wordsInNiceGens/BruhatDecompositionO.gd b/gap/matrix/wordsInNiceGens/BruhatDecompositionO.gd new file mode 100755 index 00000000..1acc8cfb --- /dev/null +++ b/gap/matrix/wordsInNiceGens/BruhatDecompositionO.gd @@ -0,0 +1,398 @@ +############################################################################# +# BruhatDecompositionSO.gd +############################################################################# +############################################################################# +## +## BruhatDecomposition package +## +## Daniel Rademacher, RWTH Aachen University +## Alice Niemeyer, RWTH Aachen University +## +## Licensed under the GPL 3 or later. +## +############################################################################# + +#! @Chapter Special Orthogonal Group +#! @ChapterLabel SpecialOrthogonalGroup +#! +#! This chapter deals with the special orthogonal group + +#! @Section Introduction and Quick Start of functions for SO +#! @SectionLabel LabelIntroductionAndQuickStartSO +#! +#! TODO + + + + + + +#! @Section Functions for SO +#! @SectionLabel LabelFunctionsSO + +#################### +# PART I - a) +# Originally implemented subfunctions +#################### + +InfoBruhat := NewInfoClass("InfoBruhat");; +SetInfoLevel( InfoBruhat, 2 ); + +##### +# FindPrimePowerDecomposition +##### + +#! @Arguments n +#! @Returns [a,b] (a and b are natural numbers such that n-1= 2^a \cdot b) +#! @Description +#! n: Natural number +#! Computes two natural numbers a and b such that n-1= 2^a \cdot b. +DeclareGlobalFunction( "FindPrimePowerDecomposition" ); + + + +##### +# LGOStandardGensSO +##### + +#! @BeginGroup LGOStandardGensSOGroup +#! @Arguments d q e +#! @Returns stdgens (the LGO standard-generators of SO(e,d,q)) +#! @Description +#! d: the dimension of our matrices, \newline +#! q: A prime power q = p^f, where \mathbb{F}_q ist the field whereover the matrices are defined. q has to be odd \newline +#! e: 1 for plus type, 0 for zero type, -1 for minus type +#! This function computes the standard generators of SO +#! as given by C. R. Leedham-Green and E. A. O'Brien in +#! "Constructive Recognition of Classical Groups in odd characteristic" +#! Depending on e and p (notice q = p^f with p prime), the functions __LGOStandardGensSOPlus(d,q), __LGOStandardGensSOCircle(d,q) or __LGOStandardGensSOMinus(d,q) are called. +DeclareGlobalFunction( "LGOStandardGensSO" ); +DeclareGlobalFunction( "__LGOStandardGensSOPlus" ); +DeclareGlobalFunction( "__LGOStandardGensSOCircle" ); +DeclareGlobalFunction( "__LGOStandardGensSOMinus" ); +#! @EndGroup + + + +##### +# LGOStandardGensOmega +##### + +#! @BeginGroup LGOStandardGensOmegaGroup +#! @Arguments d q e +#! @Returns stdgens (the LGO standard-generators of \Omega(e,d,q)) +#! @Description +#! d: the dimension of our matrices, \newline +#! q: A prime power q = p^f, where \mathbb{F}_q ist the field whereover the matrices are defined. \newline +#! e: 1 for plus type, 0 for zero type, -1 for minus type +#! This function computes the standard generators of \Omega +#! as given by C. R. Leedham-Green and E. A. O'Brien in +#! "Constructive Recognition of Classical Groups in odd characteristic" and +#! "Constructive Recognition of Classical Groups in even characteristic" +#! Depending on e, the functions __LGOStandardGensOmegaPlus(d,q), __LGOStandardGensOmegaPlusEvenChar(d,q), __LGOStandardGensOmegaCircle(d,q), __LGOStandardGensOmegaCircleEvenChar(d,q) __LGOStandardGensOmegaMinus(d,q) or __LGOStandardGensOmegaMinusEvenChar(d,q) are called. +DeclareGlobalFunction( "LGOStandardGensOmega" ); +DeclareGlobalFunction( "__LGOStandardGensOmegaPlus" ); +DeclareGlobalFunction( "__LGOStandardGensOmegaPlusEvenChar" ); +DeclareGlobalFunction( "__LGOStandardGensOmegaCircle" ); +DeclareGlobalFunction( "__LGOStandardGensOmegaCircleEvenChar" ); +DeclareGlobalFunction( "__LGOStandardGensOmegaMinus" ); +DeclareGlobalFunction( "__LGOStandardGensOmegaMinusEvenChar" ); +#! @EndGroup + + + +##### +# MSO +##### + +#! @Arguments d q e +#! @Returns G (where G = SO(e,d,q)) +#! @Description +#! d: the dimension of our matrices, \newline +#! q: A prime power q = p^f, where \mathbb{F}_q ist the field whereover the matrices are defined. q has to be odd \newline +#! e: 1 for plus type, 0 for zero type, -1 for minus type \newline +#! This function returns the special orthogonal group of type e. The generators of the group are the LGO standard generators and the size of the group is already stored as an attribute. +DeclareGlobalFunction( "MSO" ); + + + +#################### +# PART II - a) +# UnipotentDecomposition and Transvections +#################### + +##### +# UnitriangularDecompositionSOPlus +##### + +#! @Arguments stdgens g +#! @Returns slp (A list of instructions yielding u_1,u_2 if evaluated as SLP), [u_1,g,u_2] (The matrices of the Bruhat-Decomposition) +#! @Description +#! stdgens: The LGO standard-generators of SO^+(d,q) \newline +#! g: A matrix in SO^+(d,q) \newline +#! Computes the Unitriangular decomposition of the matrix g. +DeclareGlobalFunction( "UnitriangularDecompositionSOPlus" ); + + + +##### +# UnitriangularDecompositionSOCircle +##### + +#! @Arguments stdgens g +#! @Returns slp (A list of instructions yielding u_1,u_2 if evaluated as SLP), [u_1,g,u_2] (The matrices of the Bruhat-Decomposition) +#! @Description +#! stdgens: The LGO standard-generators of SO^\circ(d,q) \newline +#! g: A matrix in SO^\circ(d,q) \newline +#! Computes the Unitriangular decomposition of the matrix g. +DeclareGlobalFunction( "UnitriangularDecompositionSOCircle" ); + + + +##### +# UnitriangularDecompositionSOMinus +##### + +#! @Arguments stdgens g +#! @Returns slp (A list of instructions yielding u_1,u_2 if evaluated as SLP), [u_1,g,u_2] (The matrices of the Bruhat-Decomposition) +#! @Description +#! stdgens: The LGO standard-generators of SO^-(d,q) \newline +#! g: A matrix in SO^-(d,q) \newline +#! Computes the Unitriangular decomposition of the matrix g. +DeclareGlobalFunction( "UnitriangularDecompositionSOMinus" ); + + + +##################### +# PART III +# Decomposition of Permutation and Diagonal-Matrix +#################### + +##### +# MonomialSLPSOPlus +##### + +#! @Arguments stdgens mat slp +#! @Returns slp (A list of instructions to evaluate tmpvalue. If slp is also given as input then this instructions are added to slp), [tmpvalue,diag] (tmpvalue is a monomial matix such that tmpvalue*mat = diag where diag is a diagonal matrix) +#! @Description +#! stdgens: The LGO standard-generators of SO^+(d,q) \newline +#! mat: A monomial matrix (ie w) in SO^+(d,q) \newline +#! slp: An already existing list of instructions *optional \newline +#! In this function we will transform a monomial matrix mat \in SO^+(d,q) into +#! a diagonal matrix diag. Using only the standard-generators s,u,v this +#! will lead to a monomial matrix tmpvalue +#! and tmpvalue^{-1} \cdot diag = mat (i.e. diag = tmpvalue*mat ). +#! Furthermore we will return list slp of instructions which will +#! (when evaluated at the LGO standard-generators) yields diag. +DeclareGlobalFunction( "MonomialSLPSOPlus" ); + + + +##### +# MonomialSLPSOCircle +##### + +#! @Arguments stdgens mat slp +#! @Returns slp (A list of instructions to evaluate tmpvalue. If slp is also given as input then this instructions are added to slp), [tmpvalue,diag] (tmpvalue is a monomial matix such that tmpvalue*mat = diag where diag is a diagonal matrix) +#! @Description +#! stdgens: The LGO standard-generators of SO^\circ(d,q) \newline +#! mat: A monomial matrix (ie w) in SO^\circ(d,q) \newline +#! slp: An already existing list of instructions *optional \newline +#! In this function we will transform a monomial matrix mat \in SO^\circ(d,q) into +#! a diagonal matrix diag. Using only the standard-generators s,u,v this +#! will lead to a monomial matrix tmpvalue +#! and tmpvalue^{-1} \cdot diag = mat (i.e. diag = tmpvalue*mat ). +#! Furthermore we will return list slp of instructions which will +#! (when evaluated at the LGO standard-generators) yields diag. +DeclareGlobalFunction( "MonomialSLPSOCircle" ); + + + +##### +# MonomialSLPSOMinus +##### + +#! @Arguments stdgens mat slp +#! @Returns slp (A list of instructions to evaluate tmpvalue. If slp is also given as input then this instructions are added to slp), [tmpvalue,diag] (tmpvalue is a monomial matix such that tmpvalue*mat = diag where diag is a diagonal matrix) +#! @Description +#! stdgens: The LGO standard-generators of SO^-(d,q) \newline +#! mat: A monomial matrix (ie w) in SO^-(d,q) \newline +#! slp: An already existing list of instructions *optional \newline +#! In this function we will transform a monomial matrix mat \in SO^-(d,q) into +#! a diagonal matrix diag. Using only the standard-generators s,u,v this +#! will lead to a monomial matrix tmpvalue +#! and tmpvalue^{-1} \cdot diag = mat (i.e. diag = tmpvalue*mat ). +#! Furthermore we will return list slp of instructions which will +#! (when evaluated at the LGO standard-generators) yields diag. +DeclareGlobalFunction( "MonomialSLPSOMinus" ); + + + +##### +# FindCorrectCycel +##### + +#! @Arguments perm j +#! @Returns A permutation +#! @Description +#! perm: A list of cycles \newline +#! j: A natural number \newline +#! This is a help function for MonomialSLPSOPlus. +#! Checks whether there is a cycle c in perm such that j^c \neq j. If there is such an cycle, the cycle is returned. Otherwise the identity permutation is returned. +DeclareGlobalFunction( "FindCorrectCycel" ); + + + + +##### +# TestPermutationProd +##### + +#! @Arguments op np l n +#! @Returns true or false +#! @Description +#! op: A list of cycle \newline +#! np: A list of cycle \newline +#! l: A list of natural numbers \newline +#! n: A natural number \newline +#! This is a help function for MonomialSLPSOPlus. This function checks whether the new permutation np destorys an already considered element of op. The already considered elements are stored in l. +DeclareGlobalFunction( "TestPermutationProd" ); + + + + +##### +# TestPermutationProd2 +##### + +#! @Arguments op np tn l n +#! @Returns true or false +#! @Description +#! op: A list of cycle \newline +#! np: A list of cycle \newline +#! tn: A natural number \newline +#! l: A list of natural numbers \newline +#! n: A natural number \newline +#! This is a help function for MonomialSLPSOPlus. This function checks whether the probability to continue with np is higher than with op depending on the element tn. +DeclareGlobalFunction( "TestPermutationProd2" ); + + + + +##### +# MonomialMatrixToEasyForm +##### + +#! @Arguments M +#! @Returns [list,perm] (list is a list of the non-zero elements of each column of M, perm is the permutation corresponding to M) +#! @Description +#! M: A monomial matrix \newline +#! This is a help function for MonomialSLPSOPlus and MonomialSLPSOCircle. This function calcultes a list of size 2. The first entry is a list of the non-zero elements of each column of M. The second entry is a permutation which corresponds to M as a permutation matrix. +DeclareGlobalFunction( "MonomialMatrixToEasyForm" ); + + + + +##### +# EasyFormToMonomialMatrix +##### + +#! @Arguments tupel n fld +#! @Returns M (A monomial matrix) +#! @Description +#! tupel: A 2-tupel as in MonomialMatrixToEasyForm \newline +#! n: A natural number \newline +#! fld: A finite field \newline +#! This is a help function for MonomialSLPSOPlus and MonomialSLPSOCircle. This function computes a monomial matrix M of size n over fld such that MonomialMatrixToEasyForm(M) = tupel . +DeclareGlobalFunction( "EasyFormToMonomialMatrix" ); + + + + +##### +# MultiplicationOfEasyForm +##### + +#! @Arguments tupel1 tupel2 +#! @Returns [list,perm] (list is a list of the non-zero elements of each column of M, perm is the permutation corresponding to M) +#! @Description +#! tupel1: A 2-tupel as in MonomialMatrixToEasyForm \newline +#! tupel2: A 2-tupel as in MonomialMatrixToEasyForm \newline +#! This is a help function for MonomialSLPSOPlus and MonomialSLPSOCircle. Let M_1 be a monomial matrix which corresponds to tupel1 and M_2 be a monomial matrix which corresponds to tupel2. This function computes a tupel [list,perm] such that for the corresponding monomial matrix M holds M = M_1 \cdot M_2. +DeclareGlobalFunction( "MultiplicationOfEasyForm" ); + + + +##### +# DiagSLPSOPlus +##### + +#! @Arguments stdgens diag slp +#! @Returns slp (A list of instructions to evaluate diag if slp was Input then this instructions are added to slp) +#! @Description +#! stdgens: The LGO standard-generators of SO^+(d,q) \newline +#! diag: A diagonal matrix (eg diag) in SO^+(d,q) \newline +#! slp: An already existing list of instructions *optional \newline +#! Writes a list of instructions which evaluated with LGO standard-generators +#! yield the diagonal matrix of the input. +DeclareGlobalFunction( "DiagSLPSOPlus" ); + + + + +##### +# DiagSLPSOCircle +##### + +#! @Arguments stdgens diag slp +#! @Returns slp (A list of instructions to evaluate diag if slp was Input then this instructions are added to slp) +#! @Description +#! stdgens: The LGO standard-generators of SO^\circ(d,q) \newline +#! diag: A diagonal matrix (eg diag) in SO^\circ(d,q) \newline +#! slp: An already existing list of instructions *optional \newline +#! Writes a list of instructions which evaluated with LGO standard-generators +#! yield the diagonal matrix of the input. +DeclareGlobalFunction( "DiagSLPSOCircle" ); + + + + +##### +# DiagSLPSOMinus +##### + +#! @Arguments stdgens diag slp +#! @Returns slp (A list of instructions to evaluate diag if slp was Input then this instructions are added to slp) +#! @Description +#! stdgens: The LGO standard-generators of SO^-(d,q) \newline +#! diag: A diagonal matrix (eg diag) in SO^-(d,q) \newline +#! slp: An already existing list of instructions *optional \newline +#! Writes a list of instructions which evaluated with LGO standard-generators +#! yield the diagonal matrix of the input. +DeclareGlobalFunction( "DiagSLPSOMinus" ); + + + +#################### +# PART IV +# Main Functions. Constructs slp for the StraightLineProgram +##################### + +##### +# BruhatDecompositionSO +##### + +#! @Arguments stdgens g +#! @Returns pgr (A SLP to compute u_1,u_2,p_{sign} and diag and the matrices u_1, u_2, p_{sign} and diag itself.) +#! @Description +#! stdgens: The LGO standard-generators \newline +#! g: A matrix in SO(e,d,q) \newline +#! Uses UnitriangularDecompositionSOPlus(), MonomialSLPSOPlus() and DiagSLPSOPlus() +#! for the plus type, UnitriangularDecompositionSOCircle(), MonomialSLPSOCircle() and DiagSLPSOCircle() +#! for the circle type or UnitriangularDecompositionSOMinus(), MonomialSLPSOMinus() and DiagSLPSOMinus() +#! for the minus type to write a matrix g \in SO(e,d,q) as g = u_1^{-1} \cdot p_{sign} \cdot diag \cdot u_2^{-1} +#! where u_1,u_2 are lower unitriangular matrices, p_{sign} is a monomial matrix and diag a diagonal matrix. +#! It furthermore yields an SLP that returns the above matrices if evaluated +#! with the LGO standard-generators. +DeclareGlobalFunction( "BruhatDecompositionSO" ); +DeclareGlobalFunction( "BruhatDecompositionSOMinus" ); diff --git a/gap/matrix/wordsInNiceGens/BruhatDecompositionO.gi b/gap/matrix/wordsInNiceGens/BruhatDecompositionO.gi new file mode 100755 index 00000000..9880a710 --- /dev/null +++ b/gap/matrix/wordsInNiceGens/BruhatDecompositionO.gi @@ -0,0 +1,4391 @@ +###################################### +# BruhatDecompositionO.gi +###################################### + +#################### +# PART I - a) +# Originally implemented subfunctions +#################### + +InfoBruhat := NewInfoClass("InfoBruhat");; +SetInfoLevel( InfoBruhat, 2 ); + +##### +# FindPrimePowerDecomposition() +##### + +InstallGlobalFunction( FindPrimePowerDecomposition, +function(n) + local res, a, b; + + res := n-1; + a := 0; + while res mod 2 = 0 do + a := a + 1; + res := Int(res*0.5); + od; + b := (n-1)/(2^a); + + return [a,b]; + +end +); + + + +##### +# LGOStandardGensSO() +##### + +InstallGlobalFunction( LGOStandardGensSO, +function(e, d, q) + + if e = 1 then + if d < 6 then + Error("LGOStandardGens: d has to be at least 6\n"); + return; + fi; + return __LGOStandardGensSOPlus(d,q); + fi; + + if e = -1 then + if d < 6 then + Error("LGOStandardGens: d has to be at least 8\n"); + return; + fi; + return __LGOStandardGensSOMinus(d,q); + fi; + + if e = 0 then + if d < 6 then + Error("LGOStandardGens: d has to be at least 7\n"); + return; + fi; + return __LGOStandardGensSOCircle(d,q); + fi; + + Error("e has to be 1, -1 or 0."); + +end +); + + + +##### +# __LGOStandardGensSOPlus() +##### + +InstallGlobalFunction( __LGOStandardGensSOPlus, +function(d,q) + local s, sBar, t, tBar, delta, deltaBar, u, v, sigma, fld, w, n, S1, S2, a, b, res; + + fld := GF(q); + w := PrimitiveElement(fld); + + s := IdentityMat( d, fld ); + s[1][1] := Zero(fld); + s[2][2] := Zero(fld); + s[d-1][d-1] := Zero(fld); + s[d][d] := Zero(fld); + s[1][d-1] := -1 * One(fld); + s[d][2] := -1 * One(fld); + s[2][d] := One(fld); + s[d-1][1] := One(fld); + + sBar := IdentityMat( d, fld ); + sBar[1][1] := Zero(fld); + sBar[2][2] := Zero(fld); + sBar[d-1][d-1] := Zero(fld); + sBar[d][d] := Zero(fld); + sBar[1][2] := One(fld); + sBar[d][d-1] := One(fld); + sBar[2][1] := -1 * One(fld); + sBar[d-1][d] := -1 * One(fld); + + t := IdentityMat( d, fld ); + t[1][d-1] := -1 * One(fld); + t[2][d] := One(fld); + + tBar := IdentityMat( d, fld ); + tBar[1][2] := One(fld); + tBar[d-1][d] := -1 * One(fld); + + delta := IdentityMat( d, fld ); + delta[1][1] := w; + delta[d][d] := w^(-1); + delta[2][2] := w; + delta[d-1][d-1] := w^(-1); + + deltaBar := IdentityMat( d, fld ); + deltaBar[1][1] := w; + deltaBar[d][d] := w^(-1); + deltaBar[2][2] := w^(-1); + deltaBar[d-1][d-1] := w; + + u := IdentityMat( d, fld ); + + n := Int(d* 0.5); + + v := 0 * IdentityMat( d, fld ); + v[d/2][1] := One(fld); + v{[1..(d/2)-1]}{[2..d/2]} := IdentityMat((d/2)-1, fld); + v[d/2+1][d] := One(fld); + v{[(d/2)+2..d]}{[(d/2)+1..d-1]} := IdentityMat((d/2)-1, fld); + if n mod 2 = 0 then + v[d/2][1] := -1 * One(fld); + v[d/2+1][d] := -1 * One(fld); + fi; + + res := q-1; + a := 0; + while res mod 2 = 0 do + a := a + 1; + res := Int(res*0.5); + od; + b := (q-1)/(2^a); + sigma := IdentityMat( d, fld ); + sigma[1][1] := w^b; + sigma[d][d] := w^(-b); + + return [s, sBar, t, tBar, delta, deltaBar, u, v, sigma]; + +end +); + + + +##### +# __LGOStandardGensSOCircle() +##### + +InstallGlobalFunction( __LGOStandardGensSOCircle, +function(d,q) + local s, t, delta, u, v, sigma, fld, w, n, S1, a, b, res; + + fld := GF(q); + w := PrimitiveElement(fld); + n := Int((d-1)*1/2); + + s := IdentityMat( d, fld ); + s[1][1] := Zero(fld); + s[d][d] := Zero(fld); + s[(d+1)/2][(d+1)/2] := -1 * One(fld); + s[1][d] := One(fld); + s[d][1] := One(fld); + + t := IdentityMat( d, fld ); + t[1][d] := One(fld); + t[1][(d+1)/2] := 2 * One(fld); + t[(d+1)/2][d] := One(fld); + + delta := IdentityMat( d, fld ); + delta[1][1] := w^2; + delta[d][d] := w^(-2); + delta[3][3] := One(fld); + + u := IdentityMat( d, fld ); + u{[1..2]}{[1..2]} := [[0,1],[-1,0]]; + u{[d-1,d]}{[d-1,d]} := [[0,-1],[1,0]]; + u := u * One(fld); + + v := 0 * IdentityMat( d, fld ); + v[(d+1)/2][(d+1)/2] := One(fld); + v[(d+1)/2 - 1][1] := One(fld); + v{[1..((d+1)/2)-2]}{[2..((d+1)/2)-1]} := IdentityMat(((d+1)/2)-2, fld); + v[(d+1)/2 + 1][d] := One(fld); + v{[((d+1)/2)+2..d]}{[((d+1)/2)+1..d-1]} := IdentityMat(((d+1)/2)-2, fld); + if n mod 2 = 0 then + v[(d+1)/2 - 1][1] := -1 * One(fld); + v[(d+1)/2 + 1][d] := -1 * One(fld); + fi; + + res := q-1; + a := 0; + while res mod 2 = 0 do + a := a + 1; + res := Int(res*0.5); + od; + b := (q-1)/(2^a); + sigma := IdentityMat( d, fld ); + sigma[1][1] := w^b; + sigma[d][d] := w^(-b); + sigma[3][3] := One(fld); + + return [s, t, delta, u, v, sigma]; + +end +); + + + +##### +# __LGOStandardGensSOMinus() +##### + +InstallGlobalFunction( __LGOStandardGensSOMinus, +function(d,q) + local s, t, delta, u, v, sigma, fld, w, n, S1, lambda, A, B, C, gamma, alpha,perm, inv, gamma2; + + fld := GF(q); + gamma := PrimitiveElement(GF(q^2)); + gamma2 := PrimitiveElement(GF(q)); + alpha := gamma^((q+1)/2); + w := alpha^2; + + s := IdentityMat( d, fld ); + s[1][1] := Zero(fld); + s[d][d] := Zero(fld); + s[1][d] := One(fld); + s[d][1] := One(fld); + s[d/2][d/2] := -1 * One(fld); + + t := IdentityMat( d, fld ); + t[1][d] := One(fld); + t[1][(d/2) + 1] := One(fld); + t[(d/2) + 1][d] := 2 * One(fld); + + A := 1/2 * ((gamma^(q-1))+(gamma^(-q+1))); + if A <> Zero(fld) then + A := gamma2^LogFFE(A,gamma2); + else + A := Zero(fld); + fi; + B := 1/2 * alpha * ((gamma^(q-1)) - (gamma^(-q+1))); + if B <> Zero(fld) then + B := gamma2^LogFFE(B,gamma2); + else + B := Zero(fld); + fi; + C := 1/2 * alpha^(-1) * ((gamma^(q-1)) - (gamma^(-q+1))); + if C <> Zero(fld) then + C := gamma2^LogFFE(C,gamma2); + else + C := Zero(fld); + fi; + w := gamma2^LogFFE(w,gamma2); + delta := IdentityMat( d, fld ); + delta[1][1] := w; + delta[d][d] := w^(-1); + delta[(d/2)][(d/2)] := A; + delta[(d/2)+1][(d/2)+1] := A; + delta[(d/2)][(d/2)+1] := B; + delta[(d/2)+1][(d/2)] := C; + + u := IdentityMat( d, fld ); + u{[1..2]}{[1..2]} := [[0,1],[-1,0]]; + u{[d-1,d]}{[d-1,d]} := [[0,-1],[1,0]]; + u := u * One(fld); + + n := Int(d * 0.5)-1; + v := 0 * IdentityMat( d, fld ); + v[(d/2)][(d/2)] := One(fld); + v[(d/2)+1][(d/2)+1] := One(fld); + v[(d/2) - 1][1] := One(fld); + v{[1..(d/2)-2]}{[2..((d/2)-1)]} := IdentityMat((d/2)-2, fld); + v[(d/2) + 2][d] := One(fld); + v{[(d/2)+3..d]}{[(d/2)+2..d-1]} := IdentityMat((d/2)-2, fld); + if n mod 2 = 0 then + v[(d/2) - 1][1] := -1 * One(fld); + v[(d/2) + 2][d] := -1 * One(fld); + fi; + + sigma := IdentityMat( d, fld ); + n := Int(d * 0.5); + lambda := (-1)^((q-1)/2); + sigma[1][1] := lambda * One(fld); + sigma[d][d] := lambda * One(fld); + sigma[d/2][d/2] := -lambda * One(fld); + sigma[(d/2)+1][(d/2)+1] := -lambda * One(fld); + + return [s, t, delta, u, v, sigma]; + +end +); + + + +##### +# LGOStandardGensOmega() +##### + +InstallGlobalFunction( LGOStandardGensOmega, +function(e, d, q) + + if (q mod 2 = 0) then + if e = 1 then + return __LGOStandardGensOmegaPlusEvenChar(d,q); + fi; + + if e = -1 then + return __LGOStandardGensOmegaMinusEvenChar(d,q); + fi; + + if e = 0 then + return __LGOStandardGensOmegaCircleEvenChar(d,q); + fi; + else + if e = 1 then + return __LGOStandardGensOmegaPlus(d,q); + fi; + + if e = -1 then + return __LGOStandardGensOmegaMinus(d,q); + fi; + + if e = 0 then + return __LGOStandardGensOmegaCircle(d,q); + fi; + fi; + + Error("e has to be 1, -1 or 0."); + +end +); + + + +##### +# __LGOStandardGensOmegaPlus() +##### + +InstallGlobalFunction( __LGOStandardGensOmegaPlus, +function(d,q) + local s, sBar, t, tBar, delta, deltaBar, u, v, sigma, fld, w, n, S1, S2, a, b, res; + + fld := GF(q); + w := PrimitiveElement(fld); + + s := IdentityMat( d, fld ); + s[1][1] := Zero(fld); + s[2][2] := Zero(fld); + s[d-1][d-1] := Zero(fld); + s[d][d] := Zero(fld); + s[1][d-1] := -1 * One(fld); + s[d][2] := -1 * One(fld); + s[2][d] := One(fld); + s[d-1][1] := One(fld); + + sBar := IdentityMat( d, fld ); + sBar[1][1] := Zero(fld); + sBar[2][2] := Zero(fld); + sBar[d-1][d-1] := Zero(fld); + sBar[d][d] := Zero(fld); + sBar[1][2] := One(fld); + sBar[d][d-1] := One(fld); + sBar[2][1] := -1 * One(fld); + sBar[d-1][d] := -1 * One(fld); + + t := IdentityMat( d, fld ); + t[1][d-1] := -1 * One(fld); + t[2][d] := One(fld); + + tBar := IdentityMat( d, fld ); + tBar[1][2] := One(fld); + tBar[d-1][d] := -1 * One(fld); + + delta := IdentityMat( d, fld ); + delta[1][1] := w; + delta[d][d] := w^(-1); + delta[2][2] := w; + delta[d-1][d-1] := w^(-1); + + deltaBar := IdentityMat( d, fld ); + deltaBar[1][1] := w; + deltaBar[d][d] := w^(-1); + deltaBar[2][2] := w^(-1); + deltaBar[d-1][d-1] := w; + + u := IdentityMat( d, fld ); + + n := Int(d* 0.5); + + v := 0 * IdentityMat( d, fld ); + v[d/2][1] := One(fld); + v{[1..(d/2)-1]}{[2..d/2]} := IdentityMat((d/2)-1, fld); + v[d/2+1][d] := One(fld); + v{[(d/2)+2..d]}{[(d/2)+1..d-1]} := IdentityMat((d/2)-1, fld); + if n mod 2 = 0 then + v[d/2][1] := -1 * One(fld); + v[d/2+1][d] := -1 * One(fld); + fi; + + return [s, sBar, t, tBar, delta, deltaBar, u, v]; + +end +); + + + +##### +# __LGOStandardGensOmegaCircle() +##### + +InstallGlobalFunction( __LGOStandardGensOmegaCircle, +function(d,q) + local s, t, delta, u, v, sigma, fld, w, n, S1, a, b, res; + + fld := GF(q); + w := PrimitiveElement(fld); + n := Int((d-1)*1/2); + + s := IdentityMat( d, fld ); + s[1][1] := Zero(fld); + s[d][d] := Zero(fld); + s[(d+1)/2][(d+1)/2] := -1 * One(fld); + s[1][d] := One(fld); + s[d][1] := One(fld); + + t := IdentityMat( d, fld ); + t[1][d] := One(fld); + t[1][(d+1)/2] := 2 * One(fld); + t[(d+1)/2][d] := One(fld); + + delta := IdentityMat( d, fld ); + delta[1][1] := w^2; + delta[d][d] := w^(-2); + delta[3][3] := One(fld); + + u := IdentityMat( d, fld ); + u{[1..2]}{[1..2]} := [[0,1],[-1,0]]; + u{[d-1,d]}{[d-1,d]} := [[0,-1],[1,0]]; + u := u * One(fld); + + v := 0 * IdentityMat( d, fld ); + v[(d+1)/2][(d+1)/2] := One(fld); + v[(d+1)/2 - 1][1] := One(fld); + v{[1..((d+1)/2)-2]}{[2..((d+1)/2)-1]} := IdentityMat(((d+1)/2)-2, fld); + v[(d+1)/2 + 1][d] := One(fld); + v{[((d+1)/2)+2..d]}{[((d+1)/2)+1..d-1]} := IdentityMat(((d+1)/2)-2, fld); + if n mod 2 = 0 then + v[(d+1)/2 - 1][1] := -1 * One(fld); + v[(d+1)/2 + 1][d] := -1 * One(fld); + fi; + + return [s, t, delta, u, v]; + +end +); + + + +##### +# __LGOStandardGensOmegaMinus() +##### + +InstallGlobalFunction( __LGOStandardGensOmegaMinus, +function(d,q) + local s, t, delta, u, v, sigma, fld, w, n, S1, lambda, A, B, C, gamma, alpha,perm, inv, gamma2; + + fld := GF(q); + gamma := PrimitiveElement(GF(q^2)); + gamma2 := PrimitiveElement(GF(q)); + alpha := gamma^((q+1)/2); + w := alpha^2; + + s := IdentityMat( d, fld ); + s[1][1] := Zero(fld); + s[d][d] := Zero(fld); + s[1][d] := One(fld); + s[d][1] := One(fld); + s[d/2][d/2] := -1 * One(fld); + + t := IdentityMat( d, fld ); + t[1][d] := One(fld); + t[1][(d/2) + 1] := One(fld); + t[(d/2) + 1][d] := 2 * One(fld); + + A := 1/2 * ((gamma^(q-1))+(gamma^(-q+1))); + if A <> Zero(fld) then + A := gamma2^LogFFE(A,gamma2); + else + A := Zero(fld); + fi; + B := 1/2 * alpha * ((gamma^(q-1)) - (gamma^(-q+1))); + if B <> Zero(fld) then + B := gamma2^LogFFE(B,gamma2); + else + B := Zero(fld); + fi; + C := 1/2 * alpha^(-1) * ((gamma^(q-1)) - (gamma^(-q+1))); + if C <> Zero(fld) then + C := gamma2^LogFFE(C,gamma2); + else + C := Zero(fld); + fi; + w := gamma2^LogFFE(w,gamma2); + delta := IdentityMat( d, fld ); + delta[1][1] := w; + delta[d][d] := w^(-1); + delta[(d/2)][(d/2)] := A; + delta[(d/2)+1][(d/2)+1] := A; + delta[(d/2)][(d/2)+1] := B; + delta[(d/2)+1][(d/2)] := C; + + u := IdentityMat( d, fld ); + u{[1..2]}{[1..2]} := [[0,1],[-1,0]]; + u{[d-1,d]}{[d-1,d]} := [[0,-1],[1,0]]; + u := u * One(fld); + + n := Int(d * 0.5)-1; + v := 0 * IdentityMat( d, fld ); + v[(d/2)][(d/2)] := One(fld); + v[(d/2)+1][(d/2)+1] := One(fld); + v[(d/2) - 1][1] := One(fld); + v{[1..(d/2)-2]}{[2..((d/2)-1)]} := IdentityMat((d/2)-2, fld); + v[(d/2) + 2][d] := One(fld); + v{[(d/2)+3..d]}{[(d/2)+2..d-1]} := IdentityMat((d/2)-2, fld); + if n mod 2 = 0 then + v[(d/2) - 1][1] := -1 * One(fld); + v[(d/2) + 2][d] := -1 * One(fld); + fi; + + return [s, t, delta, u, v]; + +end +); + + + +##### +# __LGOStandardGensOmegaPlusEvenChar() +##### + +InstallGlobalFunction( __LGOStandardGensOmegaPlusEvenChar, +function(d,q) + local s, t, tBar, delta, deltaBar, u, v, sigma, fld, w, n, S1, S2, a, b, res, J; + + fld := GF(q); + w := PrimitiveElement(fld); + + s := IdentityMat( d, fld ); + s[1][1] := Zero(fld); + s[2][2] := Zero(fld); + s[d-1][d-1] := Zero(fld); + s[d][d] := Zero(fld); + s[1][d-1] := One(fld); + s[d][2] := One(fld); + s[2][d] := One(fld); + s[d-1][1] := One(fld); + + t := IdentityMat( d, fld ); + t[1][d-1] := One(fld); + t[2][d] := One(fld); + + tBar := IdentityMat( d, fld ); + tBar[1][2] := One(fld); + tBar[d-1][d] := One(fld); + + delta := IdentityMat( d, fld ); + delta[1][1] := w; + delta[d][d] := w^(-1); + delta[2][2] := w; + delta[d-1][d-1] := w^(-1); + + deltaBar := IdentityMat( d, fld ); + deltaBar[1][1] := w; + deltaBar[d][d] := w^(-1); + deltaBar[2][2] := w^(-1); + deltaBar[d-1][d-1] := w; + + u := IdentityMat( d, fld ); + J := [[Zero(fld),One(fld)],[One(fld),Zero(fld)]]; + u{[1,2]}{[1,2]} := J; + u{[d-1,d]}{[d-1,d]} := J; + + n := Int(d* 0.5); + + v := 0 * IdentityMat( d, fld ); + v[d/2][1] := One(fld); + v{[1..(d/2)-1]}{[2..d/2]} := IdentityMat((d/2)-1, fld); + v[d/2+1][d] := One(fld); + v{[(d/2)+2..d]}{[(d/2)+1..d-1]} := IdentityMat((d/2)-1, fld); + + return [s, t, tBar, delta, deltaBar, u, v]; + +end +); + + + +##### +# __LGOStandardGensOmegaCircleEvenChar() +##### + +InstallGlobalFunction( __LGOStandardGensOmegaCircleEvenChar, +function(d,q) + + return LGOStandardGensSpEvenChar(d-1,q); + +end +); + + + +##### +# __LGOStandardGensOmegaMinusEvenChar() +##### + +InstallGlobalFunction( __LGOStandardGensOmegaMinusEvenChar, +function(d,q) + local s, t, delta, u, v, sigma, fld, w, n, S1, lambda, A, B, C, gamma,perm, inv, gamma2, nu; + + fld := GF(q); + gamma := PrimitiveElement(GF(q^2)); + gamma2 := PrimitiveElement(GF(q)); + w := gamma^(q+1); + + nu := gamma + gamma^q; + if nu <> Zero(fld) then + nu := gamma2^LogFFE(nu,gamma2); + else + nu := Zero(fld); + fi; + s := IdentityMat( d, fld ); + s[1][1] := Zero(fld); + s[d][d] := Zero(fld); + s[1][d] := One(fld); + s[d][1] := One(fld); + s[(d/2)+1][d/2] := nu * One(fld); + + t := IdentityMat( d, fld ); + t[1][d] := One(fld); + t[1][(d/2) ] := One(fld); + t[(d/2) + 1][d] := nu; + + A :=((gamma^(-1))+(gamma^(-q))); + if A <> Zero(fld) then + A := gamma2^LogFFE(A,gamma2); + else + A := Zero(fld); + fi; + B := ((gamma^(1)) + (gamma^(q))); + if B <> Zero(fld) then + B := gamma2^LogFFE(B,gamma2); + else + B := Zero(fld); + fi; + C := ((gamma^(-q+1)) + (gamma^(q-1))+1); + if C <> Zero(fld) then + C := gamma2^LogFFE(C,gamma2); + else + C := Zero(fld); + fi; + w := gamma2^LogFFE(w,gamma2); + delta := IdentityMat( d, fld ); + delta[1][1] := w; + delta[d][d] := w^(-1); + delta[(d/2)][(d/2)] := One(fld); + delta[(d/2)+1][(d/2)+1] := C; + delta[(d/2)][(d/2)+1] := A; + delta[(d/2)+1][(d/2)] := B; + + u := IdentityMat( d, fld ); + u{[1..2]}{[1..2]} := [[0,1],[1,0]]; + u{[d-1,d]}{[d-1,d]} := [[0,1],[1,0]]; + u := u * One(fld); + + n := Int(d * 0.5)-1; + v := 0 * IdentityMat( d, fld ); + v[(d/2)][(d/2)] := One(fld); + v[(d/2)+1][(d/2)+1] := One(fld); + v[(d/2) - 1][1] := One(fld); + v{[1..(d/2)-2]}{[2..((d/2)-1)]} := IdentityMat((d/2)-2, fld); + v[(d/2) + 2][d] := One(fld); + v{[(d/2)+3..d]}{[(d/2)+2..d-1]} := IdentityMat((d/2)-2, fld); + + return [s, t, delta, u, v]; + +end +); + + + +##### +# MSO() +##### + +InstallGlobalFunction( MSO, +function(e,d,q) + local gens, G, inv, i, s, q2, q2i, perm, k, m; + + #Test Input TODO + + if e = 1 then + gens := __LGOStandardGensSOPlus(d,q); + + m:= d / 2; + + s := 1; + q2 := q^2; + q2i:= 1; + for i in [ 1 .. m-1 ] do + q2i:= q2 * q2i; + s := s * (q2i-1); + od; + + perm := (); + k := 1; + while k < d do + perm := perm * (k,d-k+1); + k := k+2; + od; + inv := PermutationMat(perm,d) * One(GF(q)); + + G := GroupByGenerators(gens); + SetDimensionOfMatrixGroup( G, d ); + SetFieldOfMatrixGroup( G, GF(q) ); + SetSize( G, q^(m*(m-1)) * (q^m-1) * s ); + SetInvariantBilinearForm( G, rec( matrix:=inv) ); + + inv := Zero(GF(q)) * IdentityMat(d); + for k in [1..(d/2)] do + inv[k][d-k+1] := 1; + od; + + SetInvariantQuadraticForm( G, rec( matrix:=inv) ); + SetIsFullSubgroupGLorSLRespectingBilinearForm( G, true ); + + elif e = -1 then + #gens := __LGOStandardGensChangeSOMinus(d,q); + gens := __LGOStandardGensSOMinus(d,q); + + m:= d/2; + + s := 1; + q2 := q^2; + q2i:= 1; + for i in [ 1 .. m-1 ] do + q2i:= q2 * q2i; + s := s * (q2i-1); + od; + + perm := (); + k := 1; + while k < d do + perm := perm * (k,d-k+1); + k := k+2; + od; + inv := PermutationMat(perm,d) * One(GF(q)); + inv[m][m+1] := 0; + inv[m+1][m] := 0; + inv[m][m] := 2*PrimitiveElement(GF(q)); + inv[m+1][m+1] := -2; + inv := inv * One(GF(q)); + + G := GroupWithGenerators(gens); + SetDimensionOfMatrixGroup( G, d ); + SetFieldOfMatrixGroup( G, GF(q) ); + SetSize( G, q^(m*(m-1)) * (q^m+1) * s ); + SetInvariantBilinearForm( G, rec( matrix:=inv) ); + + inv := Zero(GF(q)) * IdentityMat(d); + for k in [1..(d/2)-1] do + inv[k][d-k+1] := 1 * One(GF(q)); + od; + inv[d/2][d/2] := PrimitiveElement(GF(q)); + inv[(d/2)+1][(d/2)+1] := -1 * One(GF(q)); + + SetInvariantQuadraticForm( G, rec( matrix:=inv) ); + SetIsFullSubgroupGLorSLRespectingBilinearForm( G, true ); + + elif e = 0 then + gens := __LGOStandardGensSOCircle(d,q); + + m:= ( d-1 ) / 2; + + s := 1; + q2 := q^2; + q2i:= 1; + for i in [ 1 .. m ] do + q2i:= q2 * q2i; + s := s * (q2i-1); + od; + + perm := (); + k := 1; + while k < (d+1)/2 do + perm := perm * (k,d-k+1); + k := k+1; + od; + inv := PermutationMat(perm,d) * One(GF(q)); + inv[(d+1)/2][(d+1)/2] := One(GF(q)) * (- 1/2); + + G := GroupByGenerators(gens); + SetDimensionOfMatrixGroup( G, d ); + SetFieldOfMatrixGroup( G, GF(q) ); + SetSize( G, q^(m^2) * s ); + SetInvariantBilinearForm( G, rec( matrix:=inv) ); + + #inv := Zero(GF(q)) * IdentityMat(d); + #for k in [1..(d/2)-1] do + # inv[k][d-k+1] := 1; + #od; + #inv[d/2][d/2] := PrimitiveElement(GF(q)); + #inv[(d/2)+1][(d/2)+1] := -1 * One(GF(q)); + + #SetInvariantQuadraticForm( G, rec( matrix:=inv) ); + # Quadratic Form of Circle Typ??? TODO + SetIsFullSubgroupGLorSLRespectingBilinearForm( G, true ); + + else + Error("e has to be 1, -1 or 0."); + fi; + + return G; + +end +); + + + +##### +# UnitriangularDecompositionSOPlus +##### + +InstallGlobalFunction( UnitriangularDecompositionSOPlus, +function(arg) + local g, u1, u2, j, r ,c, z, fld, f, i, a, d, stdgens, TransvecAtAlpha2, TransvecAtAlpha3, TransvecAtAlpha4, ShiftTransvection3ByJ, ShiftTransvection3ByI, ShiftTransvection4, ShiftTransvection2ByJ, ShiftTransvection2ByI, test, CalcXY, XX, YY, DeltaStarNumber, ell, slp, hs, tmppos, tmppos2, AEMrespos, u1pos, u2pos, tvpos, T2pos, T3pos, uipos, deltaStar; + + + ##### + # TransvectionAtAlpha2() + ##### + + TransvecAtAlpha2 := function( alpha ) + + local cc, ell, instr; + + # if omega = 1 then we overwrite the position for tv with Ti(1) + if IsOne( alpha ) then + Add(slp, [ [ T2pos[1], 1 ], tvpos ] ); + return; + fi; + + cc := CoefficientsPrimitiveElement( fld, alpha ); + instr := []; + + for ell in [ 1..Length(cc) ] do + + if not IsZero( cc[ell] ) then + Append( instr, [ T2pos[ell], Int(cc[ell]) ] ); + fi; + od; + + if Length( instr ) = 0 then + Error("TransvecAtAlpha2: this should not happen"); + fi; + + Add( slp, [ instr,tvpos ] ); + + return; + + end; + + ##### + # ShiftTransvection2ByI() + ##### + + ShiftTransvection2ByI := function(i) + + local instr; + + instr := AEM( 8, AEMrespos, tmppos, i-2 ); + Append( slp, instr ); + Add( slp, [ [ AEMrespos, -1, tvpos , 1, AEMrespos, 1 ], tvpos ] ); + + end; + + ##### + # ShiftTransvection2ByJ() + ##### + + ShiftTransvection2ByJ := function(i, abnr) + + local ui; + + ui := (d/2)-2; + + while ui-i+1-(d/2-abnr) > 0 do + Add(slp, [[uipos[ui-(d/2-abnr)],1,tvpos,1,uipos[ui-(d/2-abnr)],-1],tvpos]); + ui := ui-1; + od; + + end; + + ##### + # TransvectionAtAlpha3() + ##### + + TransvecAtAlpha3 := function( alpha ) + + local cc, ell, instr; + + # if omega = 1 then we overwrite the position for tv with Ti(1) + if IsOne( alpha ) then + Add(slp, [ [ T3pos[1], 1 ], tvpos ] ); + return; + fi; + + cc := CoefficientsPrimitiveElement( fld, alpha ); + instr := []; + + for ell in [ 1..Length(cc) ] do + + if not IsZero( cc[ell] ) then + Append( instr, [ T3pos[ell], Int(cc[ell]) ] ); + fi; + od; + + if Length( instr ) = 0 then + Error("TransvecAtAlpha3: this should not happen"); + fi; + + Add( slp, [ instr,tvpos ] ); + + return; + + end; + + ##### + # ShiftTransvection3ByI() + ##### + + ShiftTransvection3ByI := function(i) + + local ui; + + i := d-i+1; + ui := 1; + + while ui < i do + Add(slp, [[uipos[ui],-1,tvpos,1,uipos[ui],1],tvpos]); + ui := ui+1; + od; + + end; + + ##### + # ShiftTransvection3ByJ() + ##### + + ShiftTransvection3ByJ := function(i) + + local instr; + + i := i-1; + + Add(slp,[[2,1,8,-1],tmppos2]); + instr := AEM( tmppos2, AEMrespos, tmppos, i-1 ); + Append( slp, instr ); + Add( slp, [ [ AEMrespos, 1, tvpos , 1, AEMrespos, -1 ], tvpos ] ); + + end; + + + # ############ + # Back to Function + # ############ + + if Length( arg ) >= 2 and IsList( arg[1] ) and IsMatrix( arg[2] ) then + + stdgens := arg[1]; # the LGO standard generators + g := arg[2]; + + if Length( stdgens ) < 1 or not IsMatrix( stdgens[1] ) then + + Error("first argument must be the LGO standard generators"); + return; + fi; + + if not IsMatrix( g ) then + Error("second argument must be a matrix"); return; + fi; + else + Error("input: LGO standard generators and a matrix"); + return; + fi; + + if Length(arg) = 3 then + + # The first 10 entries are the stdgens and their inverses + slp := arg[3]; + + if not IsList(slp) then + Error("third argument must be a list"); + return; + fi; + else + # We write an SLP into the variable slp + # The first 18 entries are the stdgens and the inverses + # s, t, del, v, x, s^-1, t^-1, del^-1, v^-1, x^-1 + slp := [ [1,1], [2,1], [3,1], [4,1], [5,1], [6,1], [7,1], [8,1], [9,1], + [1,-1],[2,-1],[3,-1],[4,-1],[5,-1], [6,-1], [7,-1], [8,-1], [9,-1] ]; + fi; + + d := Length( g ); + fld := FieldOfMatrixList( stdgens ); + + # To create an MSLP, we allocate all the memory needed at the beginning. + Add( slp, [1,0] ); tmppos := Length(slp); #19 + Add( slp, [1,0] ); AEMrespos := Length(slp); #20 + Add( slp, [1,0] ); u1pos := Length(slp); #21 + Add( slp, [1,0] ); u2pos := Length(slp); #22 + Add( slp, [1,0] ); tvpos := Length(slp); #23 + Add( slp, [1,0] ); tmppos2 := Length(slp); #24 + Add( slp, [1,0] ); deltaStar := Length(slp); #25 + + + u1 := MutableCopyMat( One(g) ); + u2 := MutableCopyMat( One(g) ); + + # If g is already a monomial matrix return u_1 = u_2 = I_d + if TestIfMonomial( g ) then + Add( slp, [ [1,0],[1,0] ] ); + return [ slp, [u1,g,u2] ]; + fi; + + f := LogInt(Size(fld), Characteristic(fld)); #ie q=p^f + + hs := HighestSlotOfSLP(slp); + + # deltaStar + CalcXY := Size(fld)-1; + YY := 0; + while CalcXY mod 2 = 0 do + YY := YY + 1; + CalcXY := Int(CalcXY*0.5); + od; + XX := (Size(fld)-1)/(2^YY); + if XX = 1 then + Add( slp, [ [9,1], deltaStar ] ); + else + DeltaStarNumber := (1-XX)/2 mod (Size(fld)-1); + Add( slp, [ [6,DeltaStarNumber,5,DeltaStarNumber,9,1], deltaStar ] ); + fi; + + # We create the help variables for the block top left or bottom right + T2pos := [ hs + 1 .. hs + f ]; + + hs := hs + f; + + for ell in [ 1..f ] do + Add(slp, [1,0] ); + od; + + for ell in [0..f-1] do + + Add(slp, [ [deltaStar, -ell, 8, -2, deltaStar, ell, 8 ,2 ], tmppos ] ); + Add(slp, [ [tmppos, 1, 2, 1, 4, -1, 2, -1, tmppos, -1], T2pos[ell+1] ] ); + + od; + + # We create the help variables for the block in the bottom left + T3pos := [ hs + 1 .. hs + f ]; + + hs := hs + f; + + for ell in [ 1..f ] do + Add(slp, [1,0] ); + od; + + for ell in [0..f-1] do + + Add(slp, [ [deltaStar, -ell, 8, -2, deltaStar, ell, 8 ,2 ], tmppos ] ); + Add(slp, [ [tmppos, 1, 1, 1, 3, -1, 1, -1, tmppos, -1], T3pos[ell+1] ] ); + + od; + + # We create the help variables for the shift + + uipos := [ hs + 1 .. (hs + (d/2)-2) ]; + + hs := hs + ((d/2)-2) ; + + for ell in [ 1 .. ((d/2)-2) ] do + Add(slp, [1,0] ); + od; + + Add( slp, [[2,1],uipos[1]]); + + for ell in [2..((d/2)-2) ] do + Add( slp, [ [ 8, -1, uipos[ell-1] , 1, 8, 1 ], uipos[ell] ] ); + od; + + ############ + # Tests + ############ + + #test :=PseudoRandom(fld); + + #Display(test); + + #Add(slp, [[T3pos[2],1], T3pos[2]]); + + #TransvecAtAlpha2(test); + #ShiftTransvection2ByI(4); + #ShiftTransvection2ByJ(1, 4); + + #TransvecAtAlpha4(test); + #ShiftTransvection4(7); + + #TransvecAtAlpha3(test); + #ShiftTransvection3ByJ(4); + #ShiftTransvection3ByI(6); + + #Add(slp, [[tvpos,1],tvpos]); + + #return MakeSLP(slp,9); + + ############ + # Main + ############ + + g := MutableCopyMat( g ); + + for c in [ d, d-1..d/2+1 ] do + + # Find the first non-zero entry in column c + # g_{r,c} will be the pivot. + j := 1; r := 0; + + while r <= d and j <= d and r = 0 do + + if not IsZero(g[j][c]) then + r := j; + fi; + + j := j + 1; + + od; + + if r = 0 then + Error("matrix has 0 column"); + fi; + + a := g[r][c]^-1; + + if r <= d-1 then + + # Clear the rest of column c + for i in [ r+1..d ] do + + if not IsZero(g[i][c]) then + + z := -g[i][c] * a; + + # add z times row r of g to row i + # add z times row r of u1 to row i + #g[i] := g[i] + z*g[r]; + #u1[i] := u1[i] + z*u1[r]; + #Mul := List( One(SU(d,Size(fld))), ShallowCopy ); + + if (i+r <> d+1) then + if(r <= d/2) then + if (i <= d/2) then + + if i in [1..d/2] and r in [1..d/2] then + TransvecAtAlpha2(z); + ShiftTransvection2ByI(i); + ShiftTransvection2ByJ(r, i); + elif i in [((d/2)+1)..d] and r in [((d/2)+1)..d] then + TransvecAtAlpha2(-z); + ShiftTransvection2ByJ(d-r+1); + ShiftTransvection2ByI(d-i+1,d-r+1); + elif i+r < d+1 then + TransvecAtAlpha3(-z); + ShiftTransvection3ByJ(d-i+1); + ShiftTransvection3ByI(d-r+1); + else + TransvecAtAlpha3(z); + ShiftTransvection3ByJ(r); + ShiftTransvection3ByI(i); + fi; + + #Mul[i][r] := z; + g[i] := g[i] + z*g[r]; + u1[i] := u1[i] + z*u1[r]; + + #Mul[d-r+1][d-i+1] := -z; + g[d-r+1] := g[d-r+1] + (-z)*g[d-i+1]; + u1[d-r+1] := u1[d-r+1] + (-z)*u1[d-i+1]; + else + + if i in [1..d/2] and r in [1..d/2] then + TransvecAtAlpha2(z); + ShiftTransvection2ByI(i); + ShiftTransvection2ByJ(r, i); + elif i in [((d/2)+1)..d] and r in [((d/2)+1)..d] then + TransvecAtAlpha2(-z); + ShiftTransvection2ByJ(d-r+1); + ShiftTransvection2ByI(d-i+1,d-r+1); + elif i+r < d+1 then + TransvecAtAlpha3(-z); + ShiftTransvection3ByJ(d-i+1); + ShiftTransvection3ByI(d-r+1); + else + TransvecAtAlpha3(z); + ShiftTransvection3ByJ(r); + ShiftTransvection3ByI(i); + fi; + + #Mul[i][r] := z; + g[i] := g[i] + z*g[r]; + u1[i] := u1[i] + z*u1[r]; + + #Mul[d-r+1][d-i+1] := z; + g[d-r+1] := g[d-r+1] + (-z)*g[d-i+1]; + u1[d-r+1] := u1[d-r+1] + (-z)*u1[d-i+1]; + fi; + else + + if i in [1..d/2] and r in [1..d/2] then + TransvecAtAlpha2(z); + ShiftTransvection2ByI(i); + ShiftTransvection2ByJ(r, i); + elif i in [((d/2)+1)..d] and r in [((d/2)+1)..d] then + TransvecAtAlpha2(-z); + ShiftTransvection2ByI(d-r+1); + ShiftTransvection2ByJ(d-i+1,d-r+1); + elif i+r < d+1 then + TransvecAtAlpha3(-z); + ShiftTransvection3ByJ(d-i+1); + ShiftTransvection3ByI(d-r+1); + else + TransvecAtAlpha3(z); + ShiftTransvection3ByJ(r); + ShiftTransvection3ByI(i); + fi; + + #Mul[i][r] := z; + g[i] := g[i] + z*g[r]; + u1[i] := u1[i] + z*u1[r]; + + #Mul[d-r+1][d-i+1] := -z; + g[d-r+1] := g[d-r+1] + (-z)*g[d-i+1]; + u1[d-r+1] := u1[d-r+1] + (-z)*u1[d-i+1]; + + fi; + + #Mul[i][r] := z; + #g[i] := g[i] + z*g[r]; + #u1[i] := u1[i] + z*u1[r]; + + #Mul[d-r+1][d-i+1] := -z; + #g[d-r+1] := g[d-r+1] + (-z)*g[d-i+1]; + #u1[d-r+1] := u1[d-r+1] + (-z)*u1[d-i+1]; + + Add(slp,[[tvpos,1,u1pos,1],u1pos]); + + fi; + fi; + od; + fi; + + + # Step Two: Clear all entries in row r apart from g[r][c] + # This coincides with multiplying t_{c,j} from right. + if c >= 2 then + + # Now clear the rest of row r + for j in [ c-1, c-2..1 ] do + + if not IsZero( g[r][j] ) then + + z := - g[r][j] * a; + + if (c+j <> d+1) then + if (j > d/2) then + + if c in [1..d/2] and j in [1..d/2] then + TransvecAtAlpha2(z); + ShiftTransvection2ByI(c); + ShiftTransvection2ByJ(j, c); + elif c in [((d/2)+1)..d] and j in [((d/2)+1)..d] then + TransvecAtAlpha2(-z); + ShiftTransvection2ByI(d-j+1); + ShiftTransvection2ByJ(d-c+1,d-j+1); + elif c+j < d+1 then + TransvecAtAlpha3(z); + ShiftTransvection3ByJ(d-c+1); + ShiftTransvection3ByI(d-j+1); + else + TransvecAtAlpha3(z); + ShiftTransvection3ByJ(j); + ShiftTransvection3ByI(c); + fi; + + #Mul[c][j] := z; + g{[1..d]}[j] := g{[1..d]}[j] + z * g{[1..d]}[c]; + u2{[1..d]}[j] := u2{[1..d]}[j] + z * u2{[1..d]}[c]; + + #Mul[d-j+1][d-c+1] := -z; + g{[1..d]}[d-c+1] := g{[1..d]}[d-c+1] + (-z) * g{[1..d]}[d-j+1]; + u2{[1..d]}[d-c+1] := u2{[1..d]}[d-c+1] + (-z) * u2{[1..d]}[d-j+1]; + else + + if c in [1..d/2] and j in [1..d/2] then + TransvecAtAlpha2(z); + ShiftTransvection2ByI(c); + ShiftTransvection2ByJ(j, c); + elif c in [((d/2)+1)..d] and j in [((d/2)+1)..d] then + TransvecAtAlpha2(-z); + ShiftTransvection2ByI(d-j+1); + ShiftTransvection2ByJ(d-c+1,d-j+1); + elif c+j < d+1 then + TransvecAtAlpha3(z); + ShiftTransvection3ByJ(d-c+1); + ShiftTransvection3ByI(d-j+1); + else + TransvecAtAlpha3(z); + ShiftTransvection3ByJ(j); + ShiftTransvection3ByI(c); + fi; + + #Mul[c][j] := z; + g{[1..d]}[j] := g{[1..d]}[j] + z * g{[1..d]}[c]; + u2{[1..d]}[j] := u2{[1..d]}[j] + z * u2{[1..d]}[c]; + + #Mul[d-j+1][d-c+1] := z; + g{[1..d]}[d-c+1] := g{[1..d]}[d-c+1] + (-z) * g{[1..d]}[d-j+1]; + u2{[1..d]}[d-c+1] := u2{[1..d]}[d-c+1] + (-z) * u2{[1..d]}[d-j+1]; + fi; + + #Mul[c][j] := z; + #g{[1..d]}[j] := g{[1..d]}[j] + z * g{[1..d]}[c]; + #u2{[1..d]}[j] := u2{[1..d]}[j] + z * u2{[1..d]}[c]; + + #Mul[d-j+1][d-c+1] := -z; + #g{[1..d]}[d-c+1] := g{[1..d]}[d-c+1] + (-z) * g{[1..d]}[d-j+1]; + #u2{[1..d]}[d-c+1] := u2{[1..d]}[d-c+1] + (-z) * u2{[1..d]}[d-j+1]; + + Add(slp,[[u2pos,1,tvpos,1],u2pos]); + + fi; + fi; + od; + fi; + od; + + # Now u1^-1 * g * u2^-1 is the input matrix + #return [g,u1,u2]; + + Add( slp, [ [u1pos,1], [u2pos,1] ]); + + # Now u1^-1 * g * u2^-1 is the input matrix + return [slp,[g, u1, u2], hs]; + + +end +); + + + +##### +# UnitriangularDecompositionSOCircle +##### + +InstallGlobalFunction( UnitriangularDecompositionSOCircle, +function(arg) + local g, u1, u2, j, r ,c, z, fld, f, i, a, d, stdgens, TransvecAtAlpha2, TransvecAtAlpha3, TransvecAtAlpha5, ShiftTransvection3ByJ, ShiftTransvection3ByI, ShiftTransvection5, ShiftTransvection2ByJ, ShiftTransvection2ByI, test, CalcXY, XX, YY, DeltaStarNumber, ell, slp, hs, tmppos, tmppos2, AEMrespos, u1pos, u2pos, tvpos, T2pos, T3pos, uipos, deltaStar, T5pos, jjj; + + + ##### + # TransvectionAtAlpha2() + ##### + + TransvecAtAlpha2 := function( alpha ) + + local cc, ell, instr; + + # if omega = 1 then we overwrite the position for tv with Ti(1) + if IsOne( alpha ) then + Add(slp, [ [ T2pos[1], 1 ], tvpos ] ); + return; + fi; + + cc := CoefficientsPrimitiveElement( fld, alpha ); + instr := []; + + for ell in [ 1..Length(cc) ] do + + if not IsZero( cc[ell] ) then + Append( instr, [ T2pos[ell], Int(cc[ell]) ] ); + fi; + od; + + if Length( instr ) = 0 then + Error("TransvecAtAlpha2: this should not happen"); + fi; + + Add( slp, [ instr,tvpos ] ); + + return; + + end; + + ##### + # ShiftTransvection2ByI() + ##### + + ShiftTransvection2ByI := function(i) + + local instr; + + i := i-1; + + instr := AEM( 5, AEMrespos, tmppos, i-1 ); + Append( slp, instr ); + Add( slp, [ [ AEMrespos, -1, tvpos , 1, AEMrespos, 1 ], tvpos ] ); + + end; + + ##### + # ShiftTransvection2ByJ() + ##### + + ShiftTransvection2ByJ := function(i, abnr) + + local ui; + + ui := (d/2)-2; + + while ui-i+1-(d/2-abnr) > 0 do + Add(slp, [[uipos[ui-(d/2-abnr)],1,tvpos,1,uipos[ui-(d/2-abnr)],-1],tvpos]); + ui := ui-1; + od; + + end; + + ##### + # TransvectionAtAlpha3() + ##### + + TransvecAtAlpha3 := function( alpha ) + + local cc, ell, instr; + + # if omega = 1 then we overwrite the position for tv with Ti(1) + if IsOne( alpha ) then + Add(slp, [ [ T3pos[1], 1 ], tvpos ] ); + return; + fi; + + cc := CoefficientsPrimitiveElement( fld, alpha ); + instr := []; + + for ell in [ 1..Length(cc) ] do + + if not IsZero( cc[ell] ) then + Append( instr, [ T3pos[ell], Int(cc[ell]) ] ); + fi; + od; + + if Length( instr ) = 0 then + Error("TransvecAtAlpha3: this should not happen"); + fi; + + Add( slp, [ instr,tvpos ] ); + + return; + + end; + + ##### + # ShiftTransvection3ByI() + ##### + + ShiftTransvection3ByI := function(i) + + local ui; + + i := d-i+1; + ui := 1; + + while ui < i do + Add(slp, [[uipos[ui],-1,tvpos,1,uipos[ui],1],tvpos]); + ui := ui+1; + od; + + end; + + ##### + # ShiftTransvection3ByJ() + ##### + + ShiftTransvection3ByJ := function(i) + + local instr; + + i := i-1; + + Add(slp,[[5,1,4,-1],tmppos2]); + instr := AEM( tmppos2, AEMrespos, tmppos, i-1 ); + Append( slp, instr ); + Add( slp, [ [ AEMrespos, -1, tvpos , 1, AEMrespos, 1 ], tvpos ] ); + + end; + + ##### + # TransvectionAtAlpha5() + ##### + + TransvecAtAlpha5 := function( alpha ) + + local cc, ell, instr; + + # if omega = 1 then we overwrite the position for tv with Ti(1) + if IsOne( alpha ) then + Add(slp, [ [ T5pos[1], 1 ], tvpos ] ); + return; + fi; + + cc := CoefficientsPrimitiveElement( fld, alpha ); + instr := []; + + for ell in [ 1..Length(cc) ] do + + if not IsZero( cc[ell] ) then + Append( instr, [ T5pos[ell], Int(cc[ell]) ] ); + fi; + od; + + if Length( instr ) = 0 then + Error("TransvecAtAlpha5: this should not happen"); + fi; + + Add( slp, [ instr,tvpos ] ); + + end; + + ##### + # ShiftTransvection5() + ##### + + ShiftTransvection5 := function(i) + local instr; + + i := d-i+1; + + if (i= 2 and IsList( arg[1] ) and IsMatrix( arg[2] ) then + + stdgens := arg[1]; # the LGO standard generators + g := arg[2]; + + if Length( stdgens ) < 1 or not IsMatrix( stdgens[1] ) then + + Error("first argument must be the LGO standard generators"); + return; + fi; + + if not IsMatrix( g ) then + Error("second argument must be a matrix"); return; + fi; + else + Error("input: LGO standard generators and a matrix"); + return; + fi; + + if Length(arg) = 3 then + + # The first 10 entries are the stdgens and their inverses + slp := arg[3]; + + if not IsList(slp) then + Error("third argument must be a list"); + return; + fi; + else + # We write an SLP into the variable slp + # The first 12 entries are the stdgens and the inverses + # s, t, del, v, x, s^-1, t^-1, del^-1, v^-1, x^-1 + slp := [ [1,1], [2,1], [3,1], [4,1], [5,1], [6,1], + [1,-1],[2,-1],[3,-1],[4,-1],[5,-1], [6,-1] ]; + fi; + + d := Length( g ); + fld := FieldOfMatrixList( stdgens ); + + # To create an MSLP, we allocate all the memory needed at the beginning. + Add( slp, [1,0] ); tmppos := Length(slp); #13 + Add( slp, [1,0] ); AEMrespos := Length(slp); #14 + Add( slp, [1,0] ); u1pos := Length(slp); #15 + Add( slp, [1,0] ); u2pos := Length(slp); #16 + Add( slp, [1,0] ); tvpos := Length(slp); #17 + Add( slp, [1,0] ); tmppos2 := Length(slp); #18 + Add( slp, [1,0] ); deltaStar := Length(slp); #19 + + + u1 := MutableCopyMat( One(g) ); + u2 := MutableCopyMat( One(g) ); + + # If g is already a monomial matrix return u_1 = u_2 = I_d + if TestIfMonomial( g ) then + Add( slp, [ [1,0],[1,0] ] ); + return [ slp, [u1,g,u2] ]; + fi; + + f := LogInt(Size(fld), Characteristic(fld)); #ie q=p^f + + hs := HighestSlotOfSLP(slp); + + # deltaStar + CalcXY := Size(fld)-1; + YY := 0; + while CalcXY mod 2 = 0 do + YY := YY + 1; + CalcXY := Int(CalcXY*0.5); + od; + XX := (Size(fld)-1)/(2^YY); + if XX = 1 then + Add( slp, [ [6,1], deltaStar ] ); + else + DeltaStarNumber := (1-XX)/2 mod (Size(fld)-1); + Add( slp, [ [3,DeltaStarNumber,6,1], deltaStar ] ); + fi; + + jjj := Int(2^(-1) * One(fld)); + Add(slp, [ [5, -1, 2, -1, 5, 1, 2 , jjj, 5, -1, 2, 1, 5, 1, 2, -jjj ], tmppos2 ] ); + + # We create the help variables for the block top left or bottom right + T2pos := [ hs + 1 .. hs + f ]; + + hs := hs + f; + + for ell in [ 1..f ] do + Add(slp, [1,0] ); + od; + + for ell in [0..f-1] do + + Add(slp, [ [deltaStar, -ell, 5, -2, deltaStar, ell, 5 ,2 ], tmppos ] ); + Add(slp, [ [tmppos, 1, 1, -1, 4, -1, tmppos2, -1, 4, 1, 1, 1, tmppos, -1], T2pos[ell+1] ] ); + + od; + + # We create the help variables for the block in the bottom left + T3pos := [ hs + 1 .. hs + f ]; + + hs := hs + f; + + for ell in [ 1..f ] do + Add(slp, [1,0] ); + od; + + for ell in [0..f-1] do + + Add(slp, [ [deltaStar, -ell, 5, -2, deltaStar, ell, 5 ,2 ], tmppos ] ); + Add(slp, [ [tmppos, 1, 1, -1, 4, -1, 1, -1, 4, -1, tmppos2, 1, 4, 1, 1, 1, 4, 1, 1, 1, tmppos, -1], T3pos[ell+1] ] ); + + od; + + # We create the help variables for the centre row and column + T5pos := [ hs + 1 .. hs + f ]; + + hs := hs + f; + + for ell in [ 1..f ] do + Add(slp, [1,0] ); + od; + + for ell in [0..f-1] do + + Add(slp, [ [deltaStar, -ell, 5, -2, deltaStar, ell, 5 ,2 ], tmppos ] ); + Add(slp, [ [tmppos, 1, 1, -1, 2, -jjj, 1, 1, tmppos, -1], T5pos[ell+1] ] ); + + od; + + # We create the help variables for the shift + uipos := [ hs + 1 .. (hs + ((d-1)/2)-2) ]; + + hs := hs + (((d-1)/2)-2) ; + + for ell in [ 1 .. (((d-1)/2)-2) ] do + Add(slp, [1,0] ); + od; + + if (uipos <> [] ) then + Add( slp, [[4,1],uipos[1]]); + fi; + + for ell in [2..(((d-1)/2)-2) ] do + Add( slp, [ [ 5, -1, uipos[ell-1] , 1, 5, 1 ], uipos[ell] ] ); + od; + + ############ + # Tests + ############ + + #test :=PseudoRandom(fld); + #test := 2 * One(GF(3)); + #Display(test); + + #Add(slp, [[T5pos[2],1],tvpos]); + + #TransvecAtAlpha2(test); + #ShiftTransvection2ByI(3); + #ShiftTransvection2ByJ(1, 3); + + #TransvecAtAlpha3(test); + #ShiftTransvection3ByJ(5); + #ShiftTransvection3ByI(8); + + #TransvecAtAlpha5(test); + #ShiftTransvection5(9); + + #Add(slp, [[tvpos,1],tvpos]); + + #return MakeSLP(slp,6); + + ############ + # Main + ############; + + g := MutableCopyMat( g ); + + for c in [ d, d-1..(d-1)/2 ] do + + # Find the first non-zero entry in column c + # g_{r,c} will be the pivot. + j := 1; r := 0; + + while r <= d and j <= d and r = 0 do + + if not IsZero(g[j][c]) then + r := j; + fi; + + j := j + 1; + + od; + + if r = 0 then + Error("matrix has 0 column"); + fi; + + a := g[r][c]^-1; + + if r <= d-1 then + + if (not(IsZero(g[(d+1)/2][c])) and (c <> ((d+1)/2))) then + i := (d+1)/2; + z := -g[i][c] * a; + + if (i+r <> d+1) then + + TransvecAtAlpha5(2*z); + ShiftTransvection5(d-r+1); + Add(slp,[[tvpos,1,u1pos,1],u1pos]); + + g[d-r+1] := g[d-r+1] + z^2 * g[r]; + u1[d-r+1] := u1[d-r+1] + z^2 * u1[r]; + + #Mul[d-r+1][d-i+1] := -z^phi; + g[d-r+1] := g[d-r+1] + 2*z * g[d-i+1]; + u1[d-r+1] := u1[d-r+1] + 2*z * u1[d-i+1]; + + g[i] := g[i] + z*g[r]; + u1[i] := u1[i] + z*u1[r]; + fi; + fi; + + + # Second: Clear the rest of column c + for i in [ r+1..d ] do + + if not IsZero(g[i][c]) and (i <> (d+1)/2) then + + z := -g[i][c] * a; + + # add z times row r of g to row i + # add z times row r of u1 to row i + #g[i] := g[i] + z*g[r]; + #u1[i] := u1[i] + z*u1[r]; + #Mul := List( One(G), ShallowCopy ); + + if (i+r <> d+1) then + + if i in [1..(d+1)/2] and r in [1..(d+1)/2] then + TransvecAtAlpha2(z); + ShiftTransvection2ByI(i); + ShiftTransvection2ByJ(r, i); + elif i in [(((d+1)/2)+1)..d] and r in [(((d+1)/2)+1)..d] then + TransvecAtAlpha2(-z); + ShiftTransvection2ByI(d-r+1); + ShiftTransvection2ByJ(d-i+1,d-r+1); + elif i+r < d+1 then + TransvecAtAlpha3(-z); + ShiftTransvection3ByJ(d-i+1); + ShiftTransvection3ByI(d-r+1); + else + TransvecAtAlpha3(z); + ShiftTransvection3ByJ(r); + ShiftTransvection3ByI(i); + fi; + + #Mul[i][r] := z; + g[i] := g[i] + z*g[r]; + u1[i] := u1[i] + z*u1[r]; + + #Mul[d-r+1][d-i+1] := -z^phi; + g[d-r+1] := g[d-r+1] + (-z) * g[d-i+1]; + u1[d-r+1] := u1[d-r+1] + (-z) * u1[d-i+1]; + + Add(slp,[[tvpos,1,u1pos,1],u1pos]); + + fi; + fi; + od; + fi; + + + + # Step Two: Clear all entries in row r apart from g[r][c] + # This coincides with multiplying t_{c,j} from right. + if c >= 2 then + + + if not IsZero(g[r][(d+1)/2]) and (r <> ((d+1)/2)) then + j := (d+1)/2; + z := -g[r][j] * a; + + if (c+j <> d+1) then + + TransvecAtAlpha5(z); + ShiftTransvection5(c); + Add(slp,[[u2pos,1,tvpos,1],u2pos]); + + g{[1..d]}[d-c+1] := g{[1..d]}[d-c+1] + ((1/2)*z)^2 * g{[1..d]}[c]; + u2{[1..d]}[d-c+1] := u2{[1..d]}[d-c+1] + ((1/2)*z)^2 * u2{[1..d]}[c]; + + g{[1..d]}[d-c+1] := g{[1..d]}[d-c+1] + (1/2)*z * g{[1..d]}[d-j+1]; + u2{[1..d]}[d-c+1] := u2{[1..d]}[d-c+1] + (1/2)*z * u2{[1..d]}[d-j+1]; + + g{[1..d]}[j] := g{[1..d]}[j] + z * g{[1..d]}[c]; + u2{[1..d]}[j] := u2{[1..d]}[j] + z * u2{[1..d]}[c]; + + fi; + fi; + + # Now clear the rest of row r + for j in [ c-1, c-2..1 ] do + + if not IsZero( g[r][j] ) and (j <> (d+1)/2) then + + z := - g[r][j] * a; + + if (c+j <> d+1) then + + if c in [1..(d+1)/2] and j in [1..(d+1)/2] then + TransvecAtAlpha2(z); + ShiftTransvection2ByI(c); + ShiftTransvection2ByJ(j, c); + elif c in [(((d+1)/2)+1)..d] and j in [(((d+1)/2)+1)..d] then + TransvecAtAlpha2(-z); + ShiftTransvection2ByI(d-j+1); + ShiftTransvection2ByJ(d-c+1,d-j+1); + elif c+j < d+1 then + TransvecAtAlpha3(-z); + ShiftTransvection3ByJ(d-c+1); + ShiftTransvection3ByI(d-j+1); + else + TransvecAtAlpha3(z); + ShiftTransvection3ByJ(j); + ShiftTransvection3ByI(c); + fi; + + #Mul[c][j] := z; + g{[1..d]}[j] := g{[1..d]}[j] + z * g{[1..d]}[c]; + u2{[1..d]}[j] := u2{[1..d]}[j] + z * u2{[1..d]}[c]; + + #Mul[d-j+1][d-c+1] := -z^phi; + g{[1..d]}[d-c+1] := g{[1..d]}[d-c+1] + (-z) * g{[1..d]}[d-j+1]; + u2{[1..d]}[d-c+1] := u2{[1..d]}[d-c+1] + (-z) * u2{[1..d]}[d-j+1]; + + Add(slp,[[u2pos,1,tvpos,1],u2pos]); + + fi; + fi; + od; + fi; + od; + + Add( slp, [ [u1pos,1], [u2pos,1] ]); + + # Now u1^-1 * g * u2^-1 is the input matrix + return [slp,[g, u1, u2], hs]; + +end +); + + + +##### +# UnitriangularDecompositionSOMinus +##### + +InstallGlobalFunction( UnitriangularDecompositionSOMinus, +function(arg) + + local g, u1, u2, j, r ,c, z, fld, f, i, a, d, w, A, B, C, k, mat, A2, B2, C2, A3, B3, C3, StartValue, slp, TransvecAtAlpha2, TransvecAtAlpha3, TransvecAtAlpha5, TransvecAtAlpha6, ShiftTransvection2ByI, ShiftTransvection3ByI, ShiftTransvection2ByJ, ShiftTransvection3ByJ, ShiftTransvection5, ShiftTransvection6, tvpos, T2pos, T3pos, T5pos, T6pos, uipos, tmppos, tmppos2, hs, ell, StartValueForFirstCentreRow, stdgens, AEMrespos, u1pos, u2pos, jjj, MakeEntry1, test; + + ##### + # TransvectionAtAlpha2() + ##### + + TransvecAtAlpha2 := function( alpha ) + + local cc, ell, instr; + + # if omega = 1 then we overwrite the position for tv with Ti(1) + if IsOne( alpha ) then + Add(slp, [ [ T2pos[1], 1 ], tvpos ] ); + return; + fi; + + cc := CoefficientsPrimitiveElement( fld, alpha ); + instr := []; + + for ell in [ 1..Length(cc) ] do + + if not IsZero( cc[ell] ) then + Append( instr, [ T2pos[ell], Int(cc[ell]) ] ); + fi; + od; + + if Length( instr ) = 0 then + Error("TransvecAtAlpha2: this should not happen"); + fi; + + Add( slp, [ instr,tvpos ] ); + + return; + + end; + + ##### + # ShiftTransvection2ByI() + ##### + + ShiftTransvection2ByI := function(i) + + local instr; + + i := i-1; + + instr := AEM( 5, AEMrespos, tmppos, i-1 ); + Append( slp, instr ); + Add( slp, [ [ AEMrespos, -1, tvpos , 1, AEMrespos, 1 ], tvpos ] ); + + end; + + ##### + # ShiftTransvection2ByJ() + ##### + + ShiftTransvection2ByJ := function(i, abnr) + + local ui; + + ui := (d/2)-2; + + while ui-i+1-(d/2-abnr) > 0 do + Add(slp, [[uipos[ui-(d/2-abnr)],1,tvpos,1,uipos[ui-(d/2-abnr)],-1],tvpos]); + ui := ui-1; + od; + + end; + + ##### + # TransvectionAtAlpha3() + ##### + + TransvecAtAlpha3 := function( alpha ) + + local cc, ell, instr; + + # if omega = 1 then we overwrite the position for tv with Ti(1) + if IsOne( alpha ) then + Add(slp, [ [ T3pos[1], 1 ], tvpos ] ); + return; + fi; + + cc := CoefficientsPrimitiveElement( fld, alpha ); + instr := []; + + for ell in [ 1..Length(cc) ] do + + if not IsZero( cc[ell] ) then + Append( instr, [ T3pos[ell], Int(cc[ell]) ] ); + fi; + od; + + if Length( instr ) = 0 then + Error("TransvecAtAlpha3: this should not happen"); + fi; + + Add( slp, [ instr,tvpos ] ); + + return; + + end; + + ##### + # ShiftTransvection3ByI() + ##### + + ShiftTransvection3ByI := function(i) + + local ui; + + i := d-i+1; + ui := 1; + + while ui < i do + Add(slp, [[uipos[ui],-1,tvpos,1,uipos[ui],1],tvpos]); + ui := ui+1; + od; + + end; + + ##### + # ShiftTransvection3ByJ() + ##### + + ShiftTransvection3ByJ := function(i) + + local instr; + + i := i-1; + + Add(slp,[[5,1,4,-1],tmppos2]); + instr := AEM( tmppos2, AEMrespos, tmppos, i-1 ); + Append( slp, instr ); + Add( slp, [ [ AEMrespos, -1, tvpos , 1, AEMrespos, 1 ], tvpos ] ); + + end; + + ##### + # TransvectionAtAlpha5() + ##### + + TransvecAtAlpha5 := function( alpha ) + + local cc, ell, instr; + + # if omega = 1 then we overwrite the position for tv with Ti(1) + if IsOne( alpha ) then + Add(slp, [ [ T5pos[1], 1 ], tvpos ] ); + return; + fi; + + cc := CoefficientsPrimitiveElement( fld, alpha ); + instr := []; + + for ell in [ 1..Length(cc) ] do + + if not IsZero( cc[ell] ) then + Append( instr, [ T5pos[ell], Int(cc[ell]) ] ); + fi; + od; + + if Length( instr ) = 0 then + Error("TransvecAtAlpha5: this should not happen"); + fi; + + Add( slp, [ instr,tvpos ] ); + + end; + + ##### + # ShiftTransvection5() + ##### + + ShiftTransvection5 := function(i) + local instr; + + i := d-i+1; + + if (i Zero(GF(q))) then + return [j,Int((2^(-1)*alpha^(-1)*(gamma^(-2*j)-gamma^(-2*j*q)))), (gamma^(2*-j)+gamma^(2*-j*q)-2^(-1)*(gamma^(-2*j)+gamma^(-2*j*q)) + 2)]; + fi; + od; + + end; + + + # ############ + # Back to Function + # ############ + + if Length( arg ) >= 2 and IsList( arg[1] ) and IsMatrix( arg[2] ) then + + stdgens := arg[1]; # the LGO standard generators + g := arg[2]; + + if Length( stdgens ) < 1 or not IsMatrix( stdgens[1] ) then + + Error("first argument must be the LGO standard generators"); + return; + fi; + + if not IsMatrix( g ) then + Error("second argument must be a matrix"); return; + fi; + else + Error("input: LGO standard generators and a matrix"); + return; + fi; + + if Length(arg) = 3 then + + # The first 10 entries are the stdgens and their inverses + slp := arg[3]; + + if not IsList(slp) then + Error("third argument must be a list"); + return; + fi; + else + # We write an SLP into the variable slp + # The first 12 entries are the stdgens and the inverses + # s, t, del, v, x, s^-1, t^-1, del^-1, v^-1, x^-1 + slp := [ [1,1], [2,1], [3,1], [4,1], [5,1], [6,1], + [1,-1],[2,-1],[3,-1],[4,-1],[5,-1], [6,-1] ]; + fi; + + d := Length( g ); + fld := FieldOfMatrixList( stdgens ); + + mat := GeneratorsOfGroup(MSO(-1,d,Size(fld)))[3]; + w := mat[1][1]; #TODO Choose primitiveElement from LGO Standard generator, such that the generator are the same + A := mat[d/2][d/2]; + B := mat[d/2][(d/2)+1]; + C := mat[(d/2)+1][d/2]; + + # To create an MSLP, we allocate all the memory needed at the beginning. + Add( slp, [1,0] ); tmppos := Length(slp); #13 + Add( slp, [1,0] ); AEMrespos := Length(slp); #14 + Add( slp, [1,0] ); u1pos := Length(slp); #15 + Add( slp, [1,0] ); u2pos := Length(slp); #16 + Add( slp, [1,0] ); tvpos := Length(slp); #17 + Add( slp, [1,0] ); tmppos2 := Length(slp); #18 + + u1 := MutableCopyMat( One(g) ); + u2 := MutableCopyMat( One(g) ); + + # If g is already a monomial matrix return u_1 = u_2 = I_d + if TestIfMonomial( g ) then + Add( slp, [ [1,0],[1,0] ] ); + return [ slp, [u1,g,u2] ]; + fi; + + f := LogInt(Size(fld), Characteristic(fld)); #ie q=p^f + + hs := HighestSlotOfSLP(slp); + + jjj := Int(2^(-1) * One(fld)); + Add(slp, [ [5, -1, 2, -1, 5, 1, 2 , jjj, 5, -1, 2, 1, 5, 1, 2, -jjj ], tmppos2 ] ); + + # We create the help variables for the block top left or bottom right + T2pos := [ hs + 1 .. hs + f ]; + + hs := hs + f; + + for ell in [ 1..f ] do + Add(slp, [1,0] ); + od; + + for ell in [0..f-1] do + + Add(slp, [ [3, -ell, 5, -2, 3, ell, 5 ,2 ], tmppos ] ); + Add(slp, [ [tmppos, 1, 1, -1, 4, -1, tmppos2, -1, 4, 1, 1, 1, tmppos, -1], T2pos[ell+1] ] ); + + od; + + # We create the help variables for the block in the bottom left + T3pos := [ hs + 1 .. hs + f ]; + + hs := hs + f; + + for ell in [ 1..f ] do + Add(slp, [1,0] ); + od; + + for ell in [0..f-1] do + + Add(slp, [ [3, -ell, 5, -2, 3, ell, 5 ,2 ], tmppos ] ); + Add(slp, [ [tmppos, 1, 1, -1, 4, -1, 1, -1, 4, -1, tmppos2, 1, 4, 1, 1, 1, 4, 1, 1, 1, tmppos, -1], T3pos[ell+1] ] ); + + od; + + # We create the help variables for the sencond centre row and column + T5pos := [ hs + 1 .. hs + f ]; + + hs := hs + f; + + for ell in [ 1..f ] do + Add(slp, [1,0] ); + od; + + for ell in [0..f-1] do + + Add(slp, [ [3, -ell, 5, -2, 3, ell, 5 ,2 ], tmppos ] ); + Add(slp, [ [tmppos, 1, 1, -1, 2, 1, 1, 1, tmppos, -1], T5pos[ell+1] ] ); + + od; + + # We create the help variables for the first centre row and column + T6pos := [ hs + 1 .. hs + f ]; + + hs := hs + f; + + for ell in [ 1..f ] do + Add(slp, [1,0] ); + od; + + StartValue := StartValueForFirstCentreRow(Size(fld)); + MakeEntry1 := StartValue[2]; + z := -StartValue[3]; + StartValue := StartValue[1]; + Add(slp, [ [3,-StartValue, 2, 2, 3, StartValue, 3, -StartValue, 2, -1, 3, StartValue, 2, 2 ], tmppos2 ] ); + if z <> Zero(fld) then + TransvecAtAlpha5(z); + Add(slp,[[tmppos2,1,1,-1,tvpos,1,1,1],tmppos2]); + fi; + MakeEntry1 := Int((-1)*MakeEntry1^(-1) * One(fld)); + Add(slp, [ [tmppos2,MakeEntry1 ], tmppos2 ] ); + + for ell in [0..f-1] do + + Add(slp, [ [3, -ell, 5, -2, 3, ell, 5 ,2 ], tmppos ] ); + Add(slp, [ [tmppos, 1, 1, -1, tmppos2, 1, 1, 1, tmppos, -1], T6pos[ell+1] ] ); + + od; + + # We create the help variables for the shift + uipos := [ hs + 1 .. (hs + (d/2)-2) ]; + + hs := hs + ((d/2)-2) ; + + for ell in [ 1 .. ((d/2)-2) ] do + Add(slp, [1,0] ); + od; + + Add( slp, [[4,1],uipos[1]]); + + for ell in [2..((d/2)-2) ] do + Add( slp, [ [ 5, -1, uipos[ell-1] , 1, 5, 1 ], uipos[ell] ] ); + od; + + ############ + # Tests + ############ + + #test :=PseudoRandom(fld); + #Display(test); + + #Add(slp, [[T5pos[2],1],tvpos]); + + #TransvecAtAlpha2(test); + #ShiftTransvection2ByI(4); + #ShiftTransvection2ByJ(1, 4); + + #TransvecAtAlpha3(test); + #ShiftTransvection3ByJ(5); + #ShiftTransvection3ByI(8); + + #TransvecAtAlpha5(test); + #ShiftTransvection5(9); + + #Add(slp, [[T5pos[2],1],tvpos]); + + #return MakeSLP(slp,6); + + ############ + # Main + ############; + + g := MutableCopyMat( g ); + + for c in [ d, d-1..(d/2)+2 ] do + + # Find the first non-zero entry in column c + # g_{r,c} will be the pivot. + j := 1; r := 0; + + while r <= d and j <= d and r = 0 do + + if not IsZero(g[j][c]) then + r := j; + fi; + + j := j + 1; + + od; + + if r = 0 then + Error("matrix has 0 column"); + fi; + + a := g[r][c]^-1; + + if r <= d-1 then + + if (not(IsZero(g[d/2][c]))) then + i := (d/2); + z := -g[i][c] * a; + + if (i+r <> d+1) then + + TransvecAtAlpha6(-z/(2*w)); + ShiftTransvection6(d-r+1); + Add(slp,[[tvpos,1,u1pos,1],u1pos]); + + g[d-r+1] := g[d-r+1] + -(z^2)/(4*w) * g[r]; + u1[d-r+1] := u1[d-r+1] + -(z^2)/(4*w) * u1[r]; + + #Mul[d-r+1][d-i+1] := -z^phi; + g[d-r+1] := g[d-r+1] + -z/(2*w) * g[d-i]; + u1[d-r+1] := u1[d-r+1] + -z/(2*w) * u1[d-i]; + + g[i] := g[i] + z*g[r]; + u1[i] := u1[i] + z*u1[r]; + fi; + fi; + + + if (not(IsZero(g[(d/2)+1][c]))) then + i := (d/2)+1; + z := -g[i][c] * a; + + if (i+r <> d+1) then + + TransvecAtAlpha5(2^(-1)*z); + ShiftTransvection5(d-r+1); + Add(slp,[[tvpos,1,u1pos,1],u1pos]); + + g[d-r+1] := g[d-r+1] + z^2/4 * g[r]; + u1[d-r+1] := u1[d-r+1] + z^2/4 * u1[r]; + + #Mul[d-r+1][d-i+1] := -z^phi; + g[d-r+1] := g[d-r+1] + z/2 * g[d-i+2]; + u1[d-r+1] := u1[d-r+1] + z/2 * u1[d-i+2]; + + g[i] := g[i] + z*g[r]; + u1[i] := u1[i] + z*u1[r]; + fi; + fi; + + + # Clear the rest of column c + for i in [ r+1..d ] do + + if not IsZero(g[i][c]) then + + z := -g[i][c] * a; + + # add z times row r of g to row i + # add z times row r of u1 to row i + #g[i] := g[i] + z*g[r]; + #u1[i] := u1[i] + z*u1[r]; + #Mul := List( One(SU(d,Size(fld))), ShallowCopy ); + + if (i+r <> d+1) then + + if i in [1..d/2] and r in [1..d/2] then + TransvecAtAlpha2(z); + ShiftTransvection2ByI(i); + ShiftTransvection2ByJ(r, i); + elif i in [((d/2)+1)..d] and r in [((d/2)+1)..d] then + TransvecAtAlpha2(-z); + ShiftTransvection2ByI(d-r+1); + ShiftTransvection2ByJ(d-i+1,d-r+1); + elif i+r < d+1 then + TransvecAtAlpha3(-z); + ShiftTransvection3ByJ(d-i+1); + ShiftTransvection3ByI(d-r+1); + else + TransvecAtAlpha3(z); + ShiftTransvection3ByJ(r); + ShiftTransvection3ByI(i); + fi; + + #Mul[i][r] := z; + g[i] := g[i] + z*g[r]; + u1[i] := u1[i] + z*u1[r]; + + #Mul[d-r+1][d-i+1] := -z; + g[d-r+1] := g[d-r+1] + (-z)*g[d-i+1]; + u1[d-r+1] := u1[d-r+1] + (-z)*u1[d-i+1]; + + Add(slp,[[tvpos,1,u1pos,1],u1pos]); + + fi; + fi; + od; + fi; + + + # Step Two: Clear all entries in row r apart from g[r][c] + # This coincides with multiplying t_{c,j} from right. + if c >= 2 then + + if not IsZero(g[r][(d/2)+1]) then + j := (d/2)+1; + z := -g[r][j] * a; + + if (c+j <> d+1) then + + TransvecAtAlpha5(z); + ShiftTransvection5(c); + Add(slp,[[u2pos,1,tvpos,1],u2pos]); + + g{[1..d]}[d-c+1] := g{[1..d]}[d-c+1] + z^2 * g{[1..d]}[c]; + u2{[1..d]}[d-c+1] := u2{[1..d]}[d-c+1] + z^2 * u2{[1..d]}[c]; + + g{[1..d]}[d-c+1] := g{[1..d]}[d-c+1] + 2*z * g{[1..d]}[d-j+2]; + u2{[1..d]}[d-c+1] := u2{[1..d]}[d-c+1] + 2*z * u2{[1..d]}[d-j+2]; + + g{[1..d]}[j] := g{[1..d]}[j] + z * g{[1..d]}[c]; + u2{[1..d]}[j] := u2{[1..d]}[j] + z * u2{[1..d]}[c]; + fi; + fi; + + + if not IsZero(g[r][d/2]) then + j := (d/2); + z := -g[r][j] * a; + + if (c+j <> d+1) then + + TransvecAtAlpha6(z); + ShiftTransvection6(c); + Add(slp,[[u2pos,1,tvpos,1],u2pos]); + + g{[1..d]}[d-c+1] := g{[1..d]}[d-c+1] + -w*z^2 * g{[1..d]}[c]; + u2{[1..d]}[d-c+1] := u2{[1..d]}[d-c+1] + -w*z^2 * u2{[1..d]}[c]; + + g{[1..d]}[d-c+1] := g{[1..d]}[d-c+1] + -2*w*z * g{[1..d]}[d-j]; + u2{[1..d]}[d-c+1] := u2{[1..d]}[d-c+1] + -2*w*z * u2{[1..d]}[d-j]; + + g{[1..d]}[j] := g{[1..d]}[j] + z * g{[1..d]}[c]; + u2{[1..d]}[j] := u2{[1..d]}[j] + z * u2{[1..d]}[c]; + fi; + fi; + + + # Now clear the rest of row r + for j in [ c-1, c-2..1 ] do + + if not IsZero( g[r][j] ) then + + z := - g[r][j] * a; + + if (c+j <> d+1) then + + if c in [1..d/2] and j in [1..d/2] then + TransvecAtAlpha2(z); + ShiftTransvection2ByI(c); + ShiftTransvection2ByJ(j, c); + elif c in [((d/2)+1)..d] and j in [((d/2)+1)..d] then + TransvecAtAlpha2(-z); + ShiftTransvection2ByI(d-j+1); + ShiftTransvection2ByJ(d-c+1,d-j+1); + elif c+j < d+1 then + TransvecAtAlpha3(z); + ShiftTransvection3ByJ(d-c+1); + ShiftTransvection3ByI(d-j+1); + else + TransvecAtAlpha3(z); + ShiftTransvection3ByJ(j); + ShiftTransvection3ByI(c); + fi; + + #Mul[c][j] := z; + g{[1..d]}[j] := g{[1..d]}[j] + z * g{[1..d]}[c]; + u2{[1..d]}[j] := u2{[1..d]}[j] + z * u2{[1..d]}[c]; + + #Mul[d-j+1][d-c+1] := -z; + g{[1..d]}[d-c+1] := g{[1..d]}[d-c+1] + (-z) * g{[1..d]}[d-j+1]; + u2{[1..d]}[d-c+1] := u2{[1..d]}[d-c+1] + (-z) * u2{[1..d]}[d-j+1]; + + Add(slp,[[u2pos,1,tvpos,1],u2pos]); + + fi; + fi; + od; + fi; + od; + + # Is there a way to improve this here? + if (g[d/2][(d/2)+1] <> Zero(fld)) and (g[(d/2)+1][(d/2)+1] <> Zero(fld)) then + k := 1; + A2 := A; + B2 := B; + C2 := C; + while true do + if (A*g[d/2][(d/2)+1]+B*g[(d/2)+1][(d/2)+1] = Zero(fld)) or (A*g[d/2][(d/2)]+B*g[(d/2)+1][(d/2)] = Zero(fld)) then + mat := MutableCopyMat(mat); + mat[1][1] := w^k; + mat[d][d] := w^(-k); + mat[d/2][d/2] := A; + mat[d/2][(d/2)+1] := B; + mat[(d/2)+1][d/2] := C; + mat[(d/2)+1][(d/2)+1] := A; + g := mat*g; + u1 := mat*u1; + Add(slp,[[3,k,u1pos,1],u1pos]); + break; + fi; + k := k+1; + A3 := A*A2+B*C2; + B3 := A*B2+A2*B; + C3 := A*C2+A2*C; + A := A3; + B := B3; + C := C3; + od; + fi; + + #test := MakeSLP(slp,6); + #if (ResultOfStraightLineProgram(test,stdgens) <> u1) then + # Error("u1"); + #fi; + #test := slp; + #Add(test,[[u2pos,1],u2pos]); + #test := MakeSLP(test,6); + #if (ResultOfStraightLineProgram(test,stdgens) <> u2) then + # Error("u2"); + #fi; + + Add( slp, [ [u1pos,1], [u2pos,1] ]); + + # Now u1^-1 * g * u2^-1 is the input matrix + return [slp,[g, u1, u2], hs]; + +end +); + + + +##### +# MonomialSLPSOPlus +##### + +InstallGlobalFunction( MonomialSLPSOPlus, +function( arg ) + + local slp, c, n, m, result, i, k, u1, u2, result2, test, g, stdgens, mat, perm, fld, mb, v, list, j, tp, tc, nu, random, diag, p_signwr, p_signpos, vpos, vipos, spos, upos, unpos, tpos, left, right, tmpvalue, perm2, L2, R2, cnt, pot, perm3, w, vf, instr, s, slpnu, Ev, Evf, EvfMinus, Es; + + + # Check for correct Input + if Length(arg) >= 2 and IsList(arg[1]) and IsMatrix(arg[2]) then + + stdgens := arg[1]; # the LGO standard generators + mat := arg[2]; # the monomial matrix + n := Length(stdgens[1]); + m := (n/2)-1; + + # Compute the permutation in Sym(n) of mat + perm := PermutationMonomialMatrix( mat ); + diag := perm[1]; + perm := perm[2]; + p_signwr := (stdgens[1]^0); + + if Length(stdgens) < 1 or not IsMatrix( stdgens[1]) then + Error("Input: first argument must be the LGO standard generators"); + return; + fi; + + else + Error("input: LGO standard generators and a matrix"); + return; + fi; + + fld := FieldOfMatrixList( stdgens ); + + if Length(arg) = 3 then + + # The first 10 entries are the stdgens and their inverses + slp := arg[3]; + + if not IsList(slp) then + Error("Input: third argument must be a list"); + return; + fi; + + cnt := HighestSlotOfSLP(slp); + + # Info( InfoBruhat, 2, " and additional: ",7," memory slots ", "in PermSLP()\n"); + + else + + # we write an SLP into the variable slp + # The first 12 entries are the stdgens and the inverses + # s, t, del, v, x, s^-1, t^-1, del^-1, v^-1, x^-1 + # The entries 13 (resAEM) and 14 (tmpAEM) are used to save AEM-values + slp := [ [1, 1], [2, 1], [3, 1], [4, 1], [5, 1], [6, 1], [7, 1], [8, 1], [9, 1], + [1,-1], [2,-1], [3,-1], [4,-1], [5,-1], [6,-1], [7,-1], [8,-1], [9,-1], + [1, 0], [1, 0] ]; + + cnt := 20; + + # Info( InfoBruhat, 2, "Memory Usage is: ",19," memory slots ", "in PermSLP()\n"); + + fi; + + # Initialize the additional memory quota + Add(slp, [ [1,0], cnt + 1 ] ); p_signpos := cnt + 1; #13 or 20+3f + Add(slp, [ [8,-1], cnt + 2 ] ); vpos := cnt + 2; #14 or 21+3f + Add(slp, [ [8,-1], cnt + 3 ] ); vipos := cnt + 3; #15 or 22+3f + Add(slp, [ [1,1], cnt + 4 ] ); spos := cnt + 4; #16 or 23+3f + Add(slp, [ [2,1], cnt + 5 ] ); upos := cnt + 5; #17 or 24+3f + Add(slp, [ [2,0], cnt + 6 ] ); unpos := cnt + 6; #18 or 25+3f + Add(slp, [ [1,0], cnt + 7 ] ); tpos := cnt + 7; #19 or 26+3f + Add(slp, [ [1,0], cnt + 8 ] ); left := cnt + 8; #20 or 27+3f + Add(slp, [ [1,0], cnt + 9 ] ); right := cnt + 9; #21 or 28+3f + + if IsDiagonalMat( mat ) then + # In order to make it coincide with the other possible output. + # This is ok since it is Id + Add( slp, [ [p_signpos,-1] , p_signpos ] ); + return [ slp, [ stdgens[1]^0, mat ] ]; + fi; + + Add(slp, [[2,1,1,1], upos]); + Add(slp, [[2,1,1,1], spos]); + + c := CycleFromPermutation(perm); + u1 := One(SymmetricGroup(n)); + u2 := One(SymmetricGroup(n)); + result := []; + result2 := []; + m := n/2; + L2 := IdentityMat(n,fld); + R2 := IdentityMat(n,fld); + w := PrimitiveElement(fld); + v := PermutationMonomialMatrix(stdgens[8])[2]; + # set alpha in SU + while (CheckContinue(perm,m)) do + c := CycleFromPermutation(perm); + list := [1..n]; + for i in [1..n] do + list[i] := false; + od; + mb := false; + for j in Reversed([m+1..n]) do + i := FindCorrectCycel(c,j); + if i <> () then + k := LargestMovedPoint(i); + if j = m+1 then + perm := v*perm; + u1 := v*u1; + L2 := stdgens[8]*L2; + Add( slp, [ [8,1,left,1] , left ] ); + mb := true; + else + if k <= m then + + elif SmallestMovedPoint(i) > m then + for nu in Orbit(GroupByGenerators([i]),j) do + list[nu] := true; + od; + elif (n-k+1)^i = n-k+1 then + for nu in [1..(n/2)-(n-j+1)] do + if TestPermutationProd2(c, CycleFromPermutation(perm^(k,n-k+1)(k-nu,n-k+1+nu)), n-k+1, list, n) then + # Dieser Case wird manchmal ausgeführt. + tmpvalue := L2[k]; + L2[k] := L2[n-k+1]; + L2[n-k+1] := tmpvalue; + tmpvalue := R2{[1..n]}[k]; + R2{[1..n]}[k] := R2{[1..n]}[n-k+1]; + R2{[1..n]}[n-k+1] := tmpvalue; + + tmpvalue := L2[k-nu]; + L2[k-nu] := L2[n-k+1+nu]; + L2[n-k+1+nu] := tmpvalue; + tmpvalue := R2{[1..n]}[k-nu]; + R2{[1..n]}[k-nu] := R2{[1..n]}[n-k+1+nu]; + R2{[1..n]}[n-k+1+nu] := tmpvalue; + + perm := perm^(k,n-k+1)(k-nu,n-k+1+nu); + u1 := (k,n-k+1)(k-nu,n-k+1+nu) * u1; + u2 := u2 * (k,n-k+1)(k-nu,n-k+1+nu); + + Add( slp, [ [vpos,(n-k),spos,1,vpos,-(n-k)] , tpos ] ); + for slpnu in [1..nu-1] do + Add( slp, [ [vpos,(n-k+slpnu),2,1,vpos,-(n-k+slpnu)], upos] ); + # Maybe we can change the previous line into Add( slp, [ [vpos,1,upos,1,vpos,-1], upos] ); such that we don't get high numbers by the conjugation. Test that! + Add( slp, [ [upos,-1,tpos,1,upos,1] , tpos ] ); + od; + Add( slp, [ [tpos,1,left,1] , left ] ); + Add( slp, [ [right,1,tpos,1] , right] ); + + mb := true; + break; + + elif perm^(k,n-k+1)(k-nu,n-k+1+nu) = perm then + # Dieser Case wird manchmal ausgeführt. + tmpvalue := L2[k]; + L2[k] := L2[n-k+1]; + L2[n-k+1] := tmpvalue; + tmpvalue := L2[k-nu]; + L2[k-nu] := L2[n-k+1+nu]; + L2[n-k+1+nu] := tmpvalue; + + perm := (k,n-k+1)(k-nu,n-k+1+nu) * perm; + u1 := (k,n-k+1)(k-nu,n-k+1+nu) * u1; + + Add( slp, [ [vpos,(n-k),spos,1,vpos,-(n-k)] , tpos ] ); + for slpnu in [1..nu-1] do + Add( slp, [ [vpos,(n-k+slpnu),2,1,vpos,-(n-k+slpnu)], upos] ); + # Maybe we can change the previous line into Add( slp, [ [vpos,1,upos,1,vpos,-1], upos] ); such that we don't get high numbers by the conjugation. Test that! + Add( slp, [ [upos,-1,tpos,1,upos,1] , tpos ] ); + od; + Add( slp, [ [tpos,-1,left,1] , left ] ); + + mb := true; + break; + fi; + od; + for nu in [1..(n/2)-(n-j+1)] do + if TestPermutationProd2(c, CycleFromPermutation((k,n-k+1)(k-nu,n-k+1+nu)*perm), n-k+1, list, n) then + tmpvalue := L2[k]; + L2[k] := L2[n-k+1]; + L2[n-k+1] := tmpvalue; + tmpvalue := L2[k-nu]; + L2[k-nu] := L2[n-k+1+nu]; + L2[n-k+1+nu] := tmpvalue; + + perm := (k,n-k+1)(k-nu,n-k+1+nu) * perm; + u1 := (k,n-k+1)(k-nu,n-k+1+nu) * u1; + + Add( slp, [ [vpos,(n-k),spos,1,vpos,-(n-k)] , tpos ] ); + for slpnu in [1..nu-1] do + Add( slp, [ [vpos,(n-k+slpnu),2,1,vpos,-(n-k+slpnu)], upos] ); + # Maybe we can change the previous line into Add( slp, [ [vpos,1,upos,1,vpos,-1], upos] ); such that we don't get high numbers by the conjugation. Test that! + Add( slp, [ [upos,-1,tpos,1,upos,1] , tpos ] ); + od; + Add( slp, [ [tpos,-1,left,1] , left ] ); + + mb := true; + break; + fi; + od; + if mb = false then + for nu in Orbit(GroupByGenerators([i]),j) do + list[nu] := true; + od; + fi; + else + for nu in [1..(n/2)-(n-j+1)] do + if ((n-k+1)^(FindCorrectCycel(CycleFromPermutation((k,n-k+1)(k-nu,n-k+1+nu)*perm),j)) = (n-k+1)) and TestPermutationProd(c, CycleFromPermutation((k,n-k+1)(k-nu,n-k+1+nu)*perm), list, n) then + # Dieser Case wird manchmal ausgeführt + + tmpvalue := L2[k]; + L2[k] := L2[n-k+1]; + L2[n-k+1] := tmpvalue; + tmpvalue := L2[k-nu]; + L2[k-nu] := L2[n-k+1+nu]; + L2[n-k+1+nu] := tmpvalue; + + perm := (k,n-k+1)(k-nu,n-k+1+nu)*perm; + u1 := (k,n-k+1)(k-nu,n-k+1+nu) * u1; + + Add( slp, [ [vpos,(n-k),spos,1,vpos,-(n-k)] , tpos ] ); + for slpnu in [1..nu-1] do + Add( slp, [ [vpos,(n-k+slpnu),2,1,vpos,-(n-k+slpnu)], upos] ); + # Maybe we can change the previous line into Add( slp, [ [vpos,1,upos,1,vpos,-1], upos] ); such that we don't get high numbers by the conjugation. Test that!!!!! + Add( slp, [ [upos,-1,tpos,1,upos,1] , tpos ] ); + od; + Add( slp, [ [tpos,-1,left,1] , left ] ); + + mb := true; + break; + fi; + od; + fi; + fi; + if mb then + break; + fi; + else + list[j] := true; + fi; + od; + od; + + Add(slp, [[2,1], upos]); + + ################ + # Some Tests + + #if PermutationMonomialMatrix(L2)[2] <> u1 then + # Error("L2"); + #fi; + #if PermutationMonomialMatrix(R2)[2] <> u2 then + # Error("R2"); + #fi; + + #Add( slp, [ [left,1,p_signpos,1,right,1] , p_signpos ] ); + #Add( slp, [ right ,1 ] ); + #slp := MakeSLP(slp,9); + #if PermutationMonomialMatrix(ResultOfStraightLineProgram(slp,stdgens))[2] <> u2 then + # Error("Here"); + #fi; + + #Error("Here"); + + #return slp; + #return MakeSLP(slp,9); + + # return [perm,u1,u2]; + + #Print(nu); + #Print(n-k+nu-1); + #if k = 8 then + #Display((k,n-k+1)(k-nu,n-k+1+nu)); + #Add( slp, [ tpos ,1 ] ); + #return MakeSLP(slp,9); + #fi; + + ################ + + c := CycleFromPermutation(perm); + for i in c do + k := LargestMovedPoint(i); + if k <= m then + Add(result, i); + else + Add(result2, i); + fi; + od; + + Add( slp, [ [left,-1] , left ] ); + Add( slp, [ [right,-1] , right ] ); + + result := Set(result); + result2 := Set(result2); + + perm := One(SymmetricGroup(n)); + for i in [1..Size(result)] do + perm := perm * result[i]; + od; + + perm2 := One(SymmetricGroup(n)); + for i in [1..Size(result2)] do + perm2 := perm2 * result2[i]; + od; + + v := (CycleFromPermutation(PermutationMonomialMatrix(stdgens[8])[2])[1])^(-1); + Ev := MonomialMatrixToEasyForm(stdgens[8]^(-1)); + vf := (CycleFromPermutation(PermutationMonomialMatrix(stdgens[8])[2])[1])^(-1); + Evf := MonomialMatrixToEasyForm(stdgens[8]^(-1)); + EvfMinus := MonomialMatrixToEasyForm(stdgens[8]); + s := CycleFromPermutation(PermutationMonomialMatrix(stdgens[2])[2])[1]; + Es := MonomialMatrixToEasyForm(stdgens[2]); + + Add( slp, [ [8,1], vpos ] ); + Add( slp, [ [8,-1], vipos ] ); + Add( slp, [ [2,1], spos ] ); + + perm3 := perm; + tmpvalue := MonomialMatrixToEasyForm(IdentityMat(n,fld)); + + for i in [ 1 .. m-1 ] do + + pot := i^perm - i; + + # Need to update perm since pi_{i-1} may change pos of i + perm := perm * v ^pot; + for j in [1..pot] do + tmpvalue := MultiplicationOfEasyForm(tmpvalue,Ev); + od; + + # memory slots 19 and 20 are used for resAEM and tmpAEM + instr := AEM( vipos, 19, 20, pot ); + Append( slp, instr ); + Add( slp, [ [p_signpos, 1, 19, 1], p_signpos ] ); # permpos + + #Compute v_i+1, save command in slp + v := s * v; + Ev := MultiplicationOfEasyForm(Es,Ev); + + Add(slp,[ [spos,1, vipos,1 ], vipos ] ); # vipos + # Don't be confused with notation in Paper + # There we used v1 (which coincides with v^-1) + + s := s ^( vf ^-1 ); + Es := MultiplicationOfEasyForm(MultiplicationOfEasyForm(Evf,Es),EvfMinus); + Add(slp, [ [17, 1, spos, 1, 8, 1], spos ] ); # spos + + + od; + + Add(slp,[ [ p_signpos,-1 ], p_signpos ] ); + Add( slp, [ [left,1,p_signpos,1,right,1] , p_signpos ] ); + Add( slp, [ p_signpos ,1 ] ); + + tmpvalue := EasyFormToMonomialMatrix(tmpvalue,n,fld); + tmpvalue := R2*tmpvalue*L2; + mat := tmpvalue*mat; + + return [slp, [tmpvalue , mat ] ]; + +end +); + + + +##### +# MonomialSLPSOCircle +##### + +InstallGlobalFunction( MonomialSLPSOCircle, +function( arg ) + local slp, c, n, m, result, i, k, u1, u2, result2, test, g, stdgens, mat, perm, fld, p_signpos, vpos, vipos, spos, upos, unpos, tpos, left, right, cnt, v, vf, s, pot, p_signwr, instr, swr, vwr, viwr, p_sign, leftma, rightma, L, R, diag, w, alpha, tmpvalue, rowlist, L2, R2, tmpSave, perm2, perm3, q, Ev, Evf, EvfMinus, Es, j, vTest, vfTest, sTest, resTest; + + # Check for correct Input + if Length(arg) >= 2 and IsList(arg[1]) and IsMatrix(arg[2]) then + + stdgens := arg[1]; # the LGO standard generators + mat := arg[2]; # the monomial matrix + n := Length(stdgens[1]); + m := (n+1)/2; + + # Compute the permutation in Sym(n) of mat + perm := PermutationMonomialMatrix( mat ); + perm := perm[2]; + p_signwr := (stdgens[1]^0); + + if Length(stdgens) < 1 or not IsMatrix( stdgens[1]) then + Error("Input: first argument must be the LGO standard generators"); + return; + fi; + + else + Error("input: LGO standard generators and a matrix"); + return; + fi; + + fld := FieldOfMatrixList( stdgens ); + + if Length(arg) = 3 then + + # The first 10 entries are the stdgens and their inverses + slp := arg[3]; + + if not IsList(slp) then + Error("Input: third argument must be a list"); + return; + fi; + + cnt := HighestSlotOfSLP(slp); + + # Info( InfoBruhat, 2, " and additional: ",7," memory slots ", "in PermSLP()\n"); + + else + + # we write an SLP into the variable slp + # The first 14 entries are the stdgens and the inverses + # s, t, del, v, x, s^-1, t^-1, del^-1, v^-1, x^-1 + # The entries 11 (resAEM) and 12 (tmpAEM) are used to save AEM-values + slp := [ [1, 1], [2, 1], [3, 1], [4, 1], [5, 1], [6, 1], + [1,-1], [2,-1], [3,-1], [4,-1], [5,-1], [6,-1], + [1, 0], [1, 0] ]; + + cnt := 14; + + # Info( InfoBruhat, 2, "Memory Usage is: ",14," memory slots ", "in PermSLP()\n"); + + fi; + + # Initialize the additional memory quota + Add(slp, [ [1,0], cnt + 1 ] ); p_signpos := cnt + 1; #13 or 20+3f + Add(slp, [ [5,-1], cnt + 2 ] ); vpos := cnt + 2; #14 or 21+3f + Add(slp, [ [5,-1], cnt + 3 ] ); vipos := cnt + 3; #15 or 22+3f + Add(slp, [ [1,1], cnt + 4 ] ); spos := cnt + 4; #16 or 23+3f + Add(slp, [ [4,1], cnt + 5 ] ); upos := cnt + 5; #17 or 24+3f + Add(slp, [ [4,0], cnt + 6 ] ); unpos := cnt + 6; #18 or 25+3f + Add(slp, [ [1,0], cnt + 7 ] ); tpos := cnt + 7; #19 or 26+3f + Add(slp, [ [1,0], cnt + 8 ] ); left := cnt + 8; #20 or 27+3f + Add(slp, [ [1,0], cnt + 9 ] ); right := cnt + 9; #21 or 28+3f + + if IsDiagonalMat( mat ) then + # In order to make it coincide with the other possible output. + # This is ok since it is Id + # Add( slp, [ [p_signpos,-1] , p_signpos ] ); + Add( slp, [ p_signpos ,1 ] ); + return [ slp, [ stdgens[1]^0, mat ] ]; + fi; + + c := CycleFromPermutation(perm); + u1 := One(SymmetricGroup(n)); + u2 := One(SymmetricGroup(n)); + result := []; + result2 := []; + L2 := IdentityMat(n,fld); + R2 := IdentityMat(n,fld); + while (CheckContinue(perm,m)) do + c := CycleFromPermutation(perm); + for i in c do + k := LargestMovedPoint(i); + if k < m then + Add(result, i); + elif SmallestMovedPoint(i) > m then + + elif (n-k+1)^i = n-k+1 then + tmpvalue := L2[k]; + L2[k] := L2[n-k+1]; + L2[n-k+1] := tmpvalue; + tmpvalue := R2{[1..n]}[k]; + R2{[1..n]}[k] := R2{[1..n]}[n-k+1]; + R2{[1..n]}[n-k+1] := tmpvalue; + perm := perm^(k,n-k+1); + u1 := (k,n-k+1) * u1; + Add( slp, [ [vpos,-(k-1),spos,1,vpos,k-1] , tpos ] ); + Add( slp, [ [tpos,-1,left,1] , left ] ); + Add( slp, [ [right,1,tpos,1] , right] ); + u2 := u2 * (k,n-k+1); + break; + else + tmpvalue := L2[k]; + L2[k] := L2[n-k+1]; + L2[n-k+1] := tmpvalue; + perm := (k,n-k+1)*perm; + u1 := (k,n-k+1) * u1; + Add( slp, [ [vpos,-(k-1),spos,1,vpos,k-1] , tpos ] ); + Add( slp, [ [tpos,1,left,1] , left ] ); + break; + fi; + od; + od; + + c := CycleFromPermutation(perm); + for i in c do + k := LargestMovedPoint(i); + if k <= m then + Add(result, i); + else + Add(result2, i); + fi; + od; + + Add( slp, [ [left,-1] , left ] ); + Add( slp, [ [right,-1] , right ] ); + + result := Set(result); + result2 := Set(result2); + + perm := One(SymmetricGroup(n)); + for i in [1..Size(result)] do + perm := perm * result[i]; + od; + + perm2 := One(SymmetricGroup(n)); + for i in [1..Size(result2)] do + perm2 := perm2 * result2[i]; + od; + + v := (CycleFromPermutation(PermutationMonomialMatrix(stdgens[5])[2])[1])^(-1); + Ev := MonomialMatrixToEasyForm(stdgens[5]^(-1)); + vf := (CycleFromPermutation(PermutationMonomialMatrix(stdgens[5])[2])[1])^(-1); + Evf := MonomialMatrixToEasyForm(stdgens[5]^(-1)); + EvfMinus := MonomialMatrixToEasyForm(stdgens[5]); + s := CycleFromPermutation(PermutationMonomialMatrix(stdgens[4])[2])[1]; + Es := MonomialMatrixToEasyForm(stdgens[4]); + + Add( slp, [ [5,1], vpos ] ); + Add( slp, [ [5,-1], vipos ] ); + Add( slp, [ [4,1], spos ] ); + + perm3 := perm; + tmpvalue := MonomialMatrixToEasyForm(IdentityMat(n,fld)); + + for i in [ 1 .. m-2 ] do + + pot := i^perm - i; + + # Need to update perm since pi_{i-1} may change pos of i + perm := perm * v^pot; + for j in [1..pot] do + tmpvalue := MultiplicationOfEasyForm(tmpvalue,Ev); + od; + + # memory slots 13 and 14 are used for resAEM and tmpAEM + instr := AEM( vipos, 13, 14, pot ); + Append( slp, instr ); + Add( slp, [ [p_signpos, 1, 13, 1], p_signpos ] ); # permpos + + #Compute v_i+1, save command in slp + v := s * v; + Ev := MultiplicationOfEasyForm(Es,Ev); + + Add(slp,[ [spos,1, vipos,1 ], vipos ] ); # vipos + # Don't be confused with notation in Paper + # There we used v1 (which coincides with v^-1) + + s := s ^( vf ^-1 ); + Es := MultiplicationOfEasyForm(MultiplicationOfEasyForm(Evf,Es),EvfMinus); + Add(slp, [ [11, 1, spos, 1, 5, 1], spos ] ); # spos + od; + + Add(slp,[ [ p_signpos,-1 ], p_signpos ] ); + Add( slp, [ [left,1,p_signpos,1,right,1] , p_signpos ] ); + Add( slp, [ p_signpos ,1 ] ); + + tmpvalue := EasyFormToMonomialMatrix(tmpvalue,n,fld); + tmpvalue := R2*tmpvalue*L2; + mat := tmpvalue*mat; + mat[m][m] := One(fld); + + return [slp, [tmpvalue , mat ] ]; + +end +); + + + +##### +# MonomialSLPSOMinus +##### + +InstallGlobalFunction( MonomialSLPSOMinus, +function( arg ) + + local slp, c, n, m, result, i, k, u1, u2, result2, test, g, stdgens, mat, perm, fld, p_signpos, vpos, vipos, spos, upos, unpos, tpos, left, right, cnt, v, vf, s, pot, p_signwr, instr, p_sign, leftma, rightma, L, R, diag, w, alpha, tmpvalue, rowlist, L2, R2, tmpSave, perm2, perm3, delta, A, B, C, A2, B2, C2, A3, B3, C3, Es, Ev, Evf, EvfMinus, j; + + # Check for correct Input + if Length(arg) >= 2 and IsList(arg[1]) and IsMatrix(arg[2]) then + + stdgens := arg[1]; # the LGO standard generators + mat := arg[2]; # the monomial matrix + n := Length(stdgens[1]); + m := (n/2)-1; + + # Compute the permutation in Sym(n) of mat + perm := PermutationMonomialMatrix( mat ); + diag := perm[1]; + perm := perm[2]; + p_signwr := (stdgens[1]^0); + + if Length(stdgens) < 1 or not IsMatrix( stdgens[1]) then + Error("Input: first argument must be the LGO standard generators"); + return; + fi; + + else + Error("input: LGO standard generators and a matrix"); + return; + fi; + + fld := FieldOfMatrixList( stdgens ); + + if Length(arg) = 3 then + + # The first 10 entries are the stdgens and their inverses + slp := arg[3]; + + if not IsList(slp) then + Error("Input: third argument must be a list"); + return; + fi; + + cnt := HighestSlotOfSLP(slp); + + # Info( InfoBruhat, 2, " and additional: ",7," memory slots ", "in PermSLP()\n"); + + else + + # we write an SLP into the variable slp + # The first 12 entries are the stdgens and the inverses + # s, t, del, v, x, s^-1, t^-1, del^-1, v^-1, x^-1 + # The entries 13 (resAEM) and 14 (tmpAEM) are used to save AEM-values + slp := [ [1, 1], [2, 1], [3, 1], [4, 1], [5, 1], [6, 1], + [1,-1], [2,-1], [3,-1], [4,-1], [5,-1], [6,-1], + [1, 0], [1, 0] ]; + + cnt := 14; + + # Info( InfoBruhat, 2, "Memory Usage is: ",19," memory slots ", "in PermSLP()\n"); + + fi; + + # Initialize the additional memory quota + Add(slp, [ [1,0], cnt + 1 ] ); p_signpos := cnt + 1; #13 or 20+3f + Add(slp, [ [5,-1], cnt + 2 ] ); vpos := cnt + 2; #14 or 21+3f + Add(slp, [ [5,-1], cnt + 3 ] ); vipos := cnt + 3; #15 or 22+3f + Add(slp, [ [1,1], cnt + 4 ] ); spos := cnt + 4; #16 or 23+3f + Add(slp, [ [4,1], cnt + 5 ] ); upos := cnt + 5; #17 or 24+3f + Add(slp, [ [4,0], cnt + 6 ] ); unpos := cnt + 6; #18 or 25+3f + Add(slp, [ [1,0], cnt + 7 ] ); tpos := cnt + 7; #19 or 26+3f + Add(slp, [ [1,0], cnt + 8 ] ); left := cnt + 8; #20 or 27+3f + Add(slp, [ [1,0], cnt + 9 ] ); right := cnt + 9; #21 or 28+3f + + if IsDiagonalMat( mat ) then + # In order to make it coincide with the other possible output. + # This is ok since it is Id + Add( slp, [ [p_signpos,-1] , p_signpos ] ); + return [ slp, [ stdgens[1]^0, mat ] ]; + fi; + + c := CycleFromPermutation(perm); + u1 := One(SymmetricGroup(n)); + u2 := One(SymmetricGroup(n)); + result := []; + result2 := []; + m := (n/2)-1; + L2 := IdentityMat(n,fld); + R2 := IdentityMat(n,fld); + w := PrimitiveElement(fld); + # set alpha in SU + while (CheckContinue(perm,m)) do + c := CycleFromPermutation(perm); + for i in c do + k := LargestMovedPoint(i); + if k <= m then + Add(result, i); + elif SmallestMovedPoint(i) > m+2 then + + elif SmallestMovedPoint(i) in [m+1,m+2] then + + elif (n-k+1)^i = n-k+1 then + tmpvalue := L2[k]; + L2[k] := L2[n-k+1]; + L2[n/2] := -1*L2[n/2]; + L2[n-k+1] := tmpvalue; + tmpvalue := R2{[1..n]}[k]; + R2{[1..n]}[k] := R2{[1..n]}[n-k+1]; + R2{[1..n]}[n/2] := -1*R2{[1..n]}[n/2]; + R2{[1..n]}[n-k+1] := tmpvalue; + perm := perm^(k,n-k+1); + u1 := (k,n-k+1) * u1; + Add( slp, [ [vpos,(n-k),spos,1,vpos,-(n-k)] , tpos ] ); + Add( slp, [ [tpos,1,left,1] , left ] ); + Add( slp, [ [right,1,tpos,1] , right] ); + u2 := u2 * (k,n-k+1); + break; + else + tmpvalue := L2[k]; + L2[k] := L2[n-k+1]; + L2[n/2] := -1*L2[n/2]; + L2[n-k+1] := tmpvalue; + perm := (k,n-k+1)*perm; + u1 := (k,n-k+1) * u1; + Add( slp, [ [vpos,(n-k),spos,1,vpos,-(n-k)] , tpos ] ); + Add( slp, [ [tpos,1,left,1] , left ] ); + break; + fi; + od; + od; + + c := CycleFromPermutation(perm); + for i in c do + k := LargestMovedPoint(i); + if k <= m then + Add(result, i); + elif SmallestMovedPoint(i) > m+2 then + Add(result2, i); + fi; + od; + + result := Set(result); + result2 := Set(result2); + + Add( slp, [ [left,-1] , left ] ); + Add( slp, [ [right,-1] , right ] ); + + #Add( slp, [ [left,1,p_signpos,1,right,1] , p_signpos ] ); + #Display(u1); + #Display(u2); + #Display(perm); + #Add( slp, [ right ,1 ] ); + + #test := slp; + #Add(test, [[left,1],p_signpos]); + #test := MakeSLP(test,6); + #if (ResultOfStraightLineProgram(test,stdgens) <> L2) then + # Error("u1"); + #fi; + + #test := slp; + #Add(test, [[right,1],p_signpos]); + #test := MakeSLP(test,6); + #if (ResultOfStraightLineProgram(test,stdgens) <> R2) then + # Error("u2"); + #fi; + + #Error("Here"); + #return MakeSLP(slp,6); + + + perm := One(SymmetricGroup(n)); + for i in [1..Size(result)] do + perm := perm * result[i]; + od; + + perm2 := One(SymmetricGroup(n)); + for i in [1..Size(result2)] do + perm2 := perm2 * result2[i]; + od; + + v := (CycleFromPermutation(PermutationMonomialMatrix(stdgens[5])[2])[1])^(-1); + Ev := MonomialMatrixToEasyForm(stdgens[5]^(-1)); + vf := (CycleFromPermutation(PermutationMonomialMatrix(stdgens[5])[2])[1])^(-1); + Evf := MonomialMatrixToEasyForm(stdgens[5]^(-1)); + EvfMinus := MonomialMatrixToEasyForm(stdgens[5]); + s := CycleFromPermutation(PermutationMonomialMatrix(stdgens[4])[2])[1]; + Es := MonomialMatrixToEasyForm(stdgens[4]); + + Add( slp, [ [5,1], vpos ] ); + Add( slp, [ [5,-1], vipos ] ); + Add( slp, [ [4,1], spos ] ); + + perm3 := perm; + tmpvalue := MonomialMatrixToEasyForm(IdentityMat(n,fld)); + + for i in [ 1 .. m-1 ] do + + pot := i^perm - i; + + # Need to update perm since pi_{i-1} may change pos of i + perm := perm * v ^pot; + for j in [1..pot] do + tmpvalue := MultiplicationOfEasyForm(tmpvalue,Ev); + od; + + # memory slots 13 and 14 are used for resAEM and tmpAEM + instr := AEM( vipos, 13, 14, pot ); + Append( slp, instr ); + Add( slp, [ [p_signpos,1,13,1 ], p_signpos ] ); # permpos + + #Compute v_i+1, save command in slp + v := s * v; + Ev := MultiplicationOfEasyForm(Es,Ev); + + Add(slp,[ [spos,1, vipos,1 ], vipos ] ); # vipos + # Don't be confused with notation in Paper + # There we used v1 (which coincides with v^-1) + + s := s ^( vf ^-1 ); + Es := MultiplicationOfEasyForm(MultiplicationOfEasyForm(Evf,Es),EvfMinus); + Add(slp, [ [11, 1, spos,1, 5,1 ], spos ] ); # spos + + + od; + + Add(slp,[ [ p_signpos,-1 ], p_signpos ] ); + Add( slp, [ [left,1,p_signpos,1,right,1] , p_signpos ] ); + + #tmpvalue := PermutationMat(perm2^(-1),n, fld); + #tmpvalue{[1..n/2]}{[1..n/2]} := PermutationMat(perm3^(-1),n/2, fld); + + #tmpvalue :=R2*tmpvalue*L2; + #mat := tmpvalue*mat; + #Display(mat); + + tmpvalue := EasyFormToMonomialMatrix(tmpvalue,n,fld); + tmpvalue := R2*tmpvalue*L2; + mat := tmpvalue*mat; + + #test := slp; + #Add(test, [[p_signpos,1],p_signpos]); + #test := MakeSLP(test,6); + #if (ResultOfStraightLineProgram(test,stdgens)^(-1) <> tmpvalue) then + # Error("before middle"); + #fi; + #Display("Before Middle correct"); + #Display(ResultOfStraightLineProgram(test,stdgens)^(-1)); + #Print("---\n"); + #Display(tmpvalue); + + # The permutation is now (m+1,m+2) + # Need a better way to find this. This is still unbelievable slow! + #if not(IsDiagonalMat(mat)) then + # delta := stdgens[3]; + # for i in [1..Size(fld)] do + # if IsMonomialMatrix(delta) and PermutationMonomialMatrix(delta)[2] = (m+1,m+2) then + # mat := delta*mat; + # Add( slp, [[ 3 ,i, p_signpos,1], p_signpos ] ); + # tmpvalue := delta*tmpvalue; + # break; + # fi; + # delta := delta*stdgens[3]; + # od; + #fi; + + # This is still not fast enough. Is there a better way to find the monomial matrix (m+1,m+2) in SOMinus ?? + # This is independent from the matrix size but needs more time for a larger field. + if (mat[n/2][(n/2)+1] <> Zero(fld)) then + k := 1; + delta := stdgens[3]; + A := delta[m+1][m+1]; + B := delta[m+1][m+2]; + C := delta[m+2][m+1]; + A2 := A; + B2 := B; + C2 := C; + while true do + if (A*mat[m+1][m+2]+B*mat[m+2][m+2] = Zero(fld)) then + #g := delta^k*g; + delta := MutableCopyMat(delta); + delta[1,1] := delta[1,1]^k; + delta[n,n] := delta[n,n]^k; + delta[m+1][m+1] := A; + delta[m+1][m+2] := B; + delta[m+2][m+1] := C; + delta[m+2][m+2] := A; + mat := delta*mat; + tmpvalue := delta*tmpvalue; + Add( slp, [[p_signpos,1,3,-k], p_signpos ] ); + + #test := slp; + #Add(test, [[p_signpos,1],p_signpos]); + #test := MakeSLP(test,6); + #if (ResultOfStraightLineProgram(test,stdgens)^(-1) <> tmpvalue) then + # Error("middle"); + #fi; + + break; + fi; + k := k+1; + A3 := A*A2+B*C2; + B3 := A*B2+A2*B; + C3 := A*C2+A2*C; + A := A3; + B := B3; + C := C3; + od; + fi; + + Add( slp, [ p_signpos ,1 ] ); + + return [slp, [ tmpvalue, mat ] ]; + +end +); + + + +##### +# FindCorrectCycel +##### + +InstallGlobalFunction( FindCorrectCycel, +function(perm, j) + local i; + + for i in perm do + if j^i <> j then + return i; + fi; + od; + + return (); + +end +); + + + +##### +# TestPermutationProd +##### + +InstallGlobalFunction( TestPermutationProd, +function(op, np, l, n) + local i; + + for i in [(n/2)+1..n] do + if l[i] then + if FindCorrectCycel(op,i) <> FindCorrectCycel(np,i) then + return false; + fi; + fi; + od; + + return true; + +end +); + + + +##### +# TestPermutationProd2 +##### + +InstallGlobalFunction( TestPermutationProd2, +function(op, np, tn, l, n) + local gno, gnn, oc, nc, i, ii; + + oc := FindCorrectCycel(op,tn); + nc := FindCorrectCycel(np,tn); + + gno := 0; + gnn := 0; + + for i in [1..(n/2)] do + if i^oc <> i then + gno := gno + 1; + fi; + if i^nc <> i then + gnn := gnn + 1; + fi; + od; + + if gnn/Order(nc) > gno/Order(oc) then + for i in [(n/2)+1..n] do + if l[i] then + gno := 0; + gnn := 0; + oc := FindCorrectCycel(op,n-i+1); + nc := FindCorrectCycel(np,n-i+1); + if nc = () then + + else + for ii in [1..(n/2)] do + if ii^oc <> ii then + gno := gno + 1; + fi; + if ii^nc <> ii then + gnn := gnn + 1; + fi; + od; + if gnn/Order(nc) < gno/Order(oc) then + return false; + fi; + fi; + fi; + od; + return true; + else + return false; + fi; + +end +); + + + +##### +# MonomialMatrixToEasyForm +##### + +InstallGlobalFunction( MonomialMatrixToEasyForm, +function (M) + local list, perm, i, j, n, fld; + + n := Length(M); + fld := FieldOfMatrixList( [M] ); + list := []; + + for i in [1..n] do + for j in [1..n] do + if M[j][i] <> Zero(fld) then + Add(list,M[j][i]); + break; + fi; + od; + od; + + perm := PermutationMonomialMatrix( M )[2]; + + return [list,perm]; + +end +); + + + +##### +# EasyFormToMonomialMatrix +##### + +InstallGlobalFunction( EasyFormToMonomialMatrix, +function( tupel, n, fld ) + local M, i, j; + + M := PermutationMat(tupel[2],n,fld); + for i in [1..n] do + for j in [1..n] do + if M[j][i] <> Zero(fld) then + M[j][i] := tupel[1][i]; + fi; + od; + od; + + return M; +end +); + + + +##### +# MultiplicationOfEasyForm +##### + +InstallGlobalFunction( MultiplicationOfEasyForm, +function ( tupel1, tupel2) + local perm1, perm2, list1, list2, perm, list, i; + + list1 := tupel1[1]; + perm1 := tupel1[2]; + list2 := tupel2[1]; + perm2 := tupel2[2]; + + perm := perm1*perm2; + list := ShallowCopy(list1); + + for i in [1..Length(list1)] do + list[i^(perm2)] := list1[i] * list2[i^(perm2)]; + od; + + return [list,perm]; + +end +); + + + +##### +# DiagSLPSOPlus +##### + +InstallGlobalFunction( DiagSLPSOPlus, +function( arg ) + + local stdgens, diag, fld, slp, a_i, d, omega, delta, u, v, cnt, hiposm, hipos, respos, hres, instr, i, decomp, y, x, startpower; + + if Length(arg) >= 2 and IsList(arg[1]) and IsMatrix(arg[2]) then + + stdgens := arg[1]; # the LGO standard generators + diag := arg[2]; + + if Length(stdgens) < 1 or not IsMatrix( stdgens[1] ) then + Error("Input: first argument must be the LGO standard generators"); + return; + fi; + + if not IsDiagonalMat( diag ) then + Error("Input: second argument must be a diagonal matrix"); + return; + fi; + else + Error("Input: LGO standard generators and a diagonal matrix"); + return; + fi; + + fld := FieldOfMatrixList( stdgens ); + + if Length(arg) >= 3 and Length(arg) <= 4 then + + # The first 12 entries are the stdgens and their inverses + slp := arg[3]; + + if not IsList(slp) then + Error("Input: third argument must be a list"); + return fail; + fi; + + cnt := arg[4]; # <--- Laesst sich das umgehen? Jeweils den hoechsten Slot mitzaehlen? + # Info( InfoBruhat, 2, " and additional: ",3," memory slots ", "in DiagonalDecomposition()\n"); + + else + # We write an SLP into the variable slp + # The first 10 entries are the stdgens and their inverses + # s^-1 t^-1 del^-1 v^-1 x^-1 + # The entries #13 (resAEM),#14 (tmpAEM) are used to save AEM-values + slp := [ [1, 1], [2, 1], [3, 1], [4, 1], [5, 1], [6, 1], [7, 1], [8, 1], [9, 1], + [1,-1], [2,-1], [3,-1], [4,-1], [5,-1], [6,-1], [7,-1], [8,-1], [9,-1], + [1, 0], [1, 0] ]; + + cnt := 20; + # Info( InfoBruhat, 2, "Memory Usage is: ",3," memory slots ", "in DiagonalDecomposition()\n"); + fi; + + # Initialize the additional memory quota + #hi-2 + Add(slp, [ [1,0], cnt + 1 ] ); hiposm := cnt + 1; #15 or 27+3f + #hi-1 + Add(slp, [ [1,0], cnt + 2 ] ); hipos := cnt + 2; #16 or 28+3f + # result + Add(slp, [ [1,0], cnt + 3 ] ); respos := cnt + 3; #17 or 29+3f + + # Needed elements for calculations + d := Length( diag ); + omega := (stdgens[5])[1][1]; + delta := IdentityMat(d,GF(Size(fld))); + delta[1][1] := omega; + delta[d][d] := omega^(-1); + + # Easy case + if diag = One(diag) then + Add( slp, [ [1,0], respos ] ); + Add( slp, [ respos, 1]); + return [ slp]; + fi; + + # Find start element + decomp := FindPrimePowerDecomposition(Size(fld)); + y := decomp[1]; + x := decomp[2]; + + #for i in [0..(Size(fld)-1)] do + # if ((2*i+x-1) mod (Size(fld)-1)) = 0 then + # startpower := i; + # break; + # fi; + #od; + + startpower := (Size(fld)-x)/2; + + instr := AEM( 5, 19, 20, startpower ); + Append( slp, instr ); + Add(slp, [[19,1,9,1], hipos]); + instr := AEM( 6, 19, 20, startpower ); + Append( slp, instr ); + Add(slp, [[19,1,hipos,1], hipos]); + Add(slp, [[8,1], hiposm]); + + for i in [ 1..(d/2) ] do + + a_i := LogFFE( diag[i][i], omega ); + # The memory slots 13 and 14 are res and tmp-slot for AEM + instr := AEM( hipos, 19, 20, a_i ); + Append( slp, instr ); + Add( slp, [ [respos, 1, 19, 1 ], respos ] ); + Add( slp, [ [hiposm, -1 , hipos, 1, hiposm,1 ], hipos ] ); + + od; + + Add( slp, [ respos ,1 ] ); + + return [slp]; + +end +); + + + +##### +# DiagSLPSOCircle +##### + +InstallGlobalFunction( DiagSLPSOCircle, +function(arg) + local stdgens, diag, fld, slp, a_i, d, omega, cnt, hiposm, hipos, respos, hres, instr, i, q, decomp, y, x, startpower; + + if Length(arg) >= 2 and IsList(arg[1]) and IsMatrix(arg[2]) then + + stdgens := arg[1]; # the LGO standard generators + diag := arg[2]; + + if Length(stdgens) < 1 or not IsMatrix( stdgens[1] ) then + Error("Input: first argument must be the LGO standard generators"); + return; + fi; + + if not IsDiagonalMat( diag ) then + Error("Input: second argument must be a diagonal matrix"); + return; + fi; + else + Error("Input: LGO standard generators and a diagonal matrix"); + return; + fi; + + fld := FieldOfMatrixList( stdgens ); + q := Characteristic(fld); + + if Length(arg) >= 3 and Length(arg) <= 4 then + + # The first 14 entries are the stdgens and their inverses + slp := arg[3]; + + if not IsList(slp) then + Error("Input: third argument must be a list"); + return fail; + fi; + + cnt := HighestSlotOfSLP( slp ); # <--- Laesst sich das umgehen? Jeweils den hoechsten Slot mitzaehlen? + #cnt := arg[4]; # <--- Laesst sich das umgehen? Jeweils den hoechsten Slot mitzaehlen? + #Info( InfoBruhat, 2, " and additional: ",3," memory slots ", "in DiagonalDecomposition()\n"); + + else + # We write an SLP into the variable slp + # The first 14 entries are the stdgens and their inverses + # s^-1 t^-1 del^-1 v^-1 x^-1 + # The entries #15 (resAEM),#16 (tmpAEM) are used to save AEM-values + slp := [ [1, 1], [2, 1], [3, 1], [4, 1], [5, 1], [6, 1], + [1,-1], [2,-1], [3,-1], [4,-1], [5,-1], [6,-1], + [1, 0], [1, 0] ]; + + cnt := 14; + #Info( InfoBruhat, 2, "Memory Usage is: ",3," memory slots ", "in DiagonalDecomposition()\n"); + fi; + + # Initialize the additional memory quota + #hi-2 + Add(slp, [ [1,0], cnt + 1 ] ); hipos := cnt + 1; #17 or 28+3f + # result + Add(slp, [ [1,0], cnt + 2 ] ); respos := cnt + 2; #18 or 29+3f + + d := Length( diag ); + omega := PrimitiveElement(GF(Size(fld))); + + # Easy case + if diag = One(diag) then + Add( slp, [ [1,0], respos ] ); + Add( slp, [ respos, 1]); + return [slp]; + fi; + + # Find start element + decomp := FindPrimePowerDecomposition(Size(fld)); + y := decomp[1]; + x := decomp[2]; + + #for i in [0..(Size(fld)-1)] do + # if ((2*i+x-1) mod (Size(fld)-1)) = 0 then + # startpower := i; + # break; + # fi; + #od; + + startpower := (Size(fld)-x)/2; + + instr := AEM( 3, 13, 14, startpower ); + Append( slp, instr ); + Add(slp, [[13,1,6,1], hipos]); + + for i in [ 1..((d-1)/2) ] do + + a_i := LogFFE( diag[i][i], omega ); + + # The memory slots 15 and 16 are res and tmp-slot for AEM + instr := AEM( hipos, 13, 14, a_i ); + Append( slp, instr ); + Add( slp, [ [respos, 1, 13, 1 ], respos ] ); + Add( slp, [ [5, -1 , hipos, 1, 5,1 ], hipos ] ); + + od; + + Add( slp, [ respos ,1 ] ); + + return [slp]; + +end +); + + + +##### +# DiagSLPSOMinus +##### + +InstallGlobalFunction( DiagSLPSOMinus, +function( arg ) + + local stdgens, diag, fld, slp, a_i, d, omega, delta, u, v, cnt, hiposm, hipos, respos, hres, instr, i, decomp, y, x, startpower, tmpv; + + if Length(arg) >= 2 and IsList(arg[1]) and IsMatrix(arg[2]) then + + stdgens := arg[1]; # the LGO standard generators + diag := arg[2]; + + if Length(stdgens) < 1 or not IsMatrix( stdgens[1] ) then + Error("Input: first argument must be the LGO standard generators"); + return; + fi; + + if not IsDiagonalMat( diag ) then + Error("Input: second argument must be a diagonal matrix"); + return; + fi; + else + Error("Input: LGO standard generators and a diagonal matrix"); + return; + fi; + + fld := FieldOfMatrixList( stdgens ); + + if Length(arg) >= 3 and Length(arg) <= 4 then + + # The first 12 entries are the stdgens and their inverses + slp := arg[3]; + + if not IsList(slp) then + Error("Input: third argument must be a list"); + return fail; + fi; + + cnt := arg[4]; # <--- Laesst sich das umgehen? Jeweils den hoechsten Slot mitzaehlen? + # Info( InfoBruhat, 2, " and additional: ",3," memory slots ", "in DiagonalDecomposition()\n"); + + else + # We write an SLP into the variable slp + # The first 10 entries are the stdgens and their inverses + # s^-1 t^-1 del^-1 v^-1 x^-1 + # The entries #13 (resAEM),#14 (tmpAEM) are used to save AEM-values + slp := [ [1, 1], [2, 1], [3, 1], [4, 1], [5, 1], [6, 1], + [1,-1], [2,-1], [3,-1], [4,-1], [5,-1], [6,-1], + [1, 0], [1, 0] ]; + + cnt := 14; + # Info( InfoBruhat, 2, "Memory Usage is: ",3," memory slots ", "in DiagonalDecomposition()\n"); + fi; + + # Initialize the additional memory quota + #hi-2 + Add(slp, [ [1,0], cnt + 1 ] ); hiposm := cnt + 1; #15 or 27+3f + #hi-1 + Add(slp, [ [1,0], cnt + 2 ] ); hipos := cnt + 2; #16 or 28+3f + # result + Add(slp, [ [1,0], cnt + 3 ] ); respos := cnt + 3; #17 or 29+3f + + # Needed elements for calculations + d := Length( diag ); + omega := (stdgens[3])[1][1]; + + # Easy case + if diag = One(diag) then + Add( slp, [ [1,0], respos ] ); + Add( slp, [ respos, 1]); + return [ slp]; + fi; + + if (Size(fld)= 3) then + Add(slp, [[6,1], hipos]); + Add(slp, [[5,1], hiposm]); + + for i in [ 1..(d/2)-1 ] do + + a_i := LogFFE( diag[i][i], omega ); + # The memory slots 13 and 14 are res and tmp-slot for AEM + instr := AEM( hipos, 13, 14, a_i ); + Append( slp, instr ); + Add( slp, [ [respos, 1, 13, 1 ], respos ] ); + Add( slp, [ [hiposm, -1 , hipos, 1, hiposm,1 ], hipos ] ); + + od; + + if diag[d/2][d/2] <> One(fld) then + Add( slp, [ [3, 2, respos, 1 ], respos ] ); + fi; + + else + if diag[d/2][d/2] <> One(fld) then + instr := AEM( 3, 13, 14, (Size(fld)+1)/2 ); + Append( slp, instr ); + Add(slp, [[13,1], hipos]); + Add(slp, [[13,1], respos]); + tmpv := ((stdgens[3])[1][1])^((Size(fld)+1)/2); + instr := AEM( hipos, 13, 14, (Size(fld)+1)/2 ); + Append( slp, instr ); + Add(slp, [[13,1], hipos]); + Add(slp, [[hipos,1,6,1], hipos]); + Add(slp, [[5,1], hiposm]); + + a_i := LogFFE( diag[1][1]*tmpv^(-1), omega ); + instr := AEM( hipos, 13, 14, a_i ); + Append( slp, instr ); + Add( slp, [ [respos, 1, 13, 1 ], respos ] ); + Add( slp, [ [hiposm, -1 , hipos, 1, hiposm,1 ], hipos ] ); + + for i in [ 2..(d/2)-1 ] do + + a_i := LogFFE( diag[i][i], omega ); + # The memory slots 13 and 14 are res and tmp-slot for AEM + instr := AEM( hipos, 13, 14, a_i ); + Append( slp, instr ); + Add( slp, [ [respos, 1, 13, 1 ], respos ] ); + Add( slp, [ [hiposm, -1 , hipos, 1, hiposm,1 ], hipos ] ); + + od; + + else + instr := AEM( 3, 13, 14, ((Size(fld)+1)/2)^2 ); + Append( slp, instr ); + Add(slp, [[13,1], hipos]); + Add(slp, [[hipos,1,6,1], hipos]); + Add(slp, [[5,1], hiposm]); + + for i in [ 1..(d/2)-1 ] do + + a_i := LogFFE( diag[i][i], omega ); + # The memory slots 13 and 14 are res and tmp-slot for AEM + instr := AEM( hipos, 13, 14, a_i ); + Append( slp, instr ); + Add( slp, [ [respos, 1, 13, 1 ], respos ] ); + Add( slp, [ [hiposm, -1 , hipos, 1, hiposm,1 ], hipos ] ); + + od; + fi; + fi; + + Add( slp, [ respos ,1 ] ); + + return [slp]; + +end +); + + + +##### +# BruhatDecompositionSO +##### + +InstallGlobalFunction( BruhatDecompositionSO, +function(stdgens, g) + + local slp, u1, pm, u2, p_sign, diag, res1, res2, res3, lastline, line, pgr; + + if (Length(g) mod 2) = 0 then + + if (g in MSO(1,Length(g),Size(FieldOfMatrixList( stdgens )))) then + + # We write an SLP into the variable slp + # The first 12 entries are the stdgens and their inverses + # s, t, del, v, u, x, s^-1, t^-1, del^-1, v^-1, u^-1, x^-1 + + #Info( InfoBruhat, 1, "returns an SLP to generate u1, u2, p_sign, diag\n" ); + + # Compute the matrices u1,u2 of Bruhat-Decomposition and the instructions + # for an SLP that compute u1 and u2 + res1 := UnitriangularDecompositionSOPlus( stdgens, g); + + slp := res1[1]; + u1 := res1[2][2]; + pm := res1[2][1]; # the monomial matrix w + u2 := res1[2][3]; + + lastline := ShallowCopy( slp[ Length(slp) ] ); # remember famous last words + # Since entries of the form [list1,list2] should only occur at the end + Remove(slp); + + # Decompose w in to a signed Permutation-Matrix generated by + # and a Diagonal-Matrix diag. + + res2 := MonomialSLPSOPlus(stdgens, pm, slp ); + + slp := ShallowCopy(res2[1]); + p_sign := res2[2][1]; + diag := res2[2][2]; + + # Now w = p_sign * diag + # and p_sign is can be evaluated as word in < s, v, x > using slp. + + # Make again all entries of slp admissible for SLP + # We inverted a Monomial-Matrix in PermSLP to get the proper result. + # Thus we have to copy a little variaton at the end of our final slp + # (else we would display a twice inverted matrix where we wanted once) + line := slp[ Length(slp) ]; + Append(lastline, [ slp[ Length(slp)] ]); + + # Determine the SLP for the Diagonal-Matrix + res3 := DiagSLPSOPlus(stdgens, diag, slp, res1[3]+10); + slp := res3[1]; + + # Here the last entry is of admissible form. Just add it to the end. + Append( lastline, [ slp[ Length(slp)] ] ); # remember famous last words + Remove( slp ); + Append( slp, [lastline] ); + + # Info( InfoBruhat, 2, "The Total Memory Usage is: " , res1[3]+9+14, " memory slots\n" ); + + pgr := MakeSLP(slp,9); + + # The result R of pgr satisfies: + # R[1]^-1*R[3]*R[4]*R[2]^-1 and + # R[1] = u1, R[2] = u2, R[3] = p_sign, R[4] = diag + return [pgr, [ u1, u2, p_sign^(-1), diag ]]; + + elif (g in MSO(-1,Length(g),Size(FieldOfMatrixList( stdgens )))) then + + # We write an SLP into the variable slp + # The first 12 entries are the stdgens and their inverses + # s, t, del, v, u, x, s^-1, t^-1, del^-1, v^-1, u^-1, x^-1 + + #Info( InfoBruhat, 1, "returns an SLP to generate u1, u2, p_sign, diag\n" ); + + # Compute the matrices u1,u2 of Bruhat-Decomposition and the instructions + # for an SLP that compute u1 and u2 + res1 := UnitriangularDecompositionSOMinus( stdgens, g); + + slp := res1[1]; + u1 := res1[2][2]; + pm := res1[2][1]; # the monomial matrix w + u2 := res1[2][3]; + + lastline := ShallowCopy( slp[ Length(slp) ] ); # remember famous last words + # Since entries of the form [list1,list2] should only occur at the end + Remove(slp); + + # Decompose w in to a signed Permutation-Matrix generated by + # and a Diagonal-Matrix diag. + + res2 := MonomialSLPSOMinus(stdgens, pm, slp ); + + slp := ShallowCopy(res2[1]); + p_sign := res2[2][1]; + diag := res2[2][2]; + + # Now w = p_sign * diag + # and p_sign is can be evaluated as word in < s, v, x > using slp. + + # Make again all entries of slp admissible for SLP + # We inverted a Monomial-Matrix in PermSLP to get the proper result. + # Thus we have to copy a little variaton at the end of our final slp + # (else we would display a twice inverted matrix where we wanted once) + line := slp[ Length(slp) ]; + Append(lastline, [ slp[ Length(slp)] ]); + + # Determine the SLP for the Diagonal-Matrix + res3 := DiagSLPSOMinus(stdgens, diag, slp, res1[3]+10); + slp := res3[1]; + + # Here the last entry is of admissible form. Just add it to the end. + Append( lastline, [ slp[ Length(slp)] ] ); # remember famous last words + Remove( slp ); + Append( slp, [lastline] ); + + # Info( InfoBruhat, 2, "The Total Memory Usage is: " , res1[3]+9+14, " memory slots\n" ); + + pgr := MakeSLP(slp,6); + + # The result R of pgr satisfies: + # R[1]^-1*R[3]*R[4]*R[2]^-1 and + # R[1] = u1, R[2] = u2, R[3] = p_sign, R[4] = diag + return [pgr, [ u1, u2, p_sign^(-1), diag ]]; + + else + Print("g is not an element of the orthogonal group. Abort."); + fi; + + elif (g in MSO(0,Length(g),Size(FieldOfMatrixList( stdgens )))) then + + # We write an SLP into the variable slp + # The first 12 entries are the stdgens and their inverses + # s, t, del, v, u, x, s^-1, t^-1, del^-1, v^-1, u^-1, x^-1 + + #Info( InfoBruhat, 1, "returns an SLP to generate u1, u2, p_sign, diag\n" ); + + # Compute the matrices u1,u2 of Bruhat-Decomposition and the instructions + # for an SLP that compute u1 and u2 + res1 := UnitriangularDecompositionSOCircle( stdgens, g); + + slp := res1[1]; + u1 := res1[2][2]; + pm := res1[2][1]; # the monomial matrix w + u2 := res1[2][3]; + + lastline := ShallowCopy( slp[ Length(slp) ] ); # remember famous last words + # Since entries of the form [list1,list2] should only occur at the end + Remove(slp); + + # Decompose w in to a signed Permutation-Matrix generated by + # and a Diagonal-Matrix diag. + + res2 := MonomialSLPSOCircle(stdgens, pm, slp ); + + slp := ShallowCopy(res2[1]); + p_sign := res2[2][1]; + diag := res2[2][2]; + + # Now w = p_sign * diag + # and p_sign is can be evaluated as word in < s, v, x > using slp. + + # Make again all entries of slp admissible for SLP + # We inverted a Monomial-Matrix in PermSLP to get the proper result. + # Thus we have to copy a little variaton at the end of our final slp + # (else we would display a twice inverted matrix where we wanted once) + line := slp[ Length(slp) ]; + Append(lastline, [ slp[ Length(slp)] ]); + + # Determine the SLP for the Diagonal-Matrix + res3 := DiagSLPSOCircle(stdgens, diag, slp); + slp := res3[1]; + + # Here the last entry is of admissible form. Just add it to the end. + Append( lastline, [ slp[ Length(slp)] ] ); # remember famous last words + Remove( slp ); + Append( slp, [lastline] ); + + # Info( InfoBruhat, 2, "The Total Memory Usage is: " , res1[3]+9+14, " memory slots\n" ); + + pgr := MakeSLP(slp,6); + + # The result R of pgr satisfies: + # R[1]^-1*R[3]*R[4]*R[2]^-1 and + # R[1] = u1, R[2] = u2, R[3] = p_sign, R[4] = diag + return [pgr, [ u1, u2, p_sign^(-1), diag ]]; + + else + Print("g is not an element of the orthogonal group. Abort."); + fi; + +end +); + + + +InstallGlobalFunction( BruhatDecompositionSOMinus, +function(stdgens, g) + + local slp, u1, pm, u2, p_sign, diag, res1, res2, res3, lastline, line, pgr; + + if (Length(g) mod 2) = 0 then + + if (g in MSO(-1,Length(g),Size(FieldOfMatrixList( stdgens )))) then + + # We write an SLP into the variable slp + # The first 12 entries are the stdgens and their inverses + # s, t, del, v, u, x, s^-1, t^-1, del^-1, v^-1, u^-1, x^-1 + + #Info( InfoBruhat, 1, "returns an SLP to generate u1, u2, p_sign, diag\n" ); + + # Compute the matrices u1,u2 of Bruhat-Decomposition and the instructions + # for an SLP that compute u1 and u2 + res1 := UnitriangularDecompositionSOMinus( stdgens, g); + + slp := res1[1]; + u1 := res1[2][2]; + pm := res1[2][1]; # the monomial matrix w + u2 := res1[2][3]; + + lastline := ShallowCopy( slp[ Length(slp) ] ); # remember famous last words + # Since entries of the form [list1,list2] should only occur at the end + Remove(slp); + + # Decompose w in to a signed Permutation-Matrix generated by + # and a Diagonal-Matrix diag. + + res2 := MonomialSLPSOMinus(stdgens, pm, slp ); + + slp := ShallowCopy(res2[1]); + p_sign := res2[2][1]; + diag := res2[2][2]; + + # Now w = p_sign * diag + # and p_sign is can be evaluated as word in < s, v, x > using slp. + + # Make again all entries of slp admissible for SLP + # We inverted a Monomial-Matrix in PermSLP to get the proper result. + # Thus we have to copy a little variaton at the end of our final slp + # (else we would display a twice inverted matrix where we wanted once) + line := slp[ Length(slp) ]; + Append(lastline, [ slp[ Length(slp)] ]); + + # Determine the SLP for the Diagonal-Matrix + res3 := DiagSLPSOMinus(stdgens, diag, slp, res1[3]+10); + slp := res3[1]; + + # Here the last entry is of admissible form. Just add it to the end. + Append( lastline, [ slp[ Length(slp)] ] ); # remember famous last words + Remove( slp ); + Append( slp, [lastline] ); + + # Info( InfoBruhat, 2, "The Total Memory Usage is: " , res1[3]+9+14, " memory slots\n" ); + + pgr := MakeSLP(slp,6); + + # The result R of pgr satisfies: + # R[1]^-1*R[3]*R[4]*R[2]^-1 and + # R[1] = u1, R[2] = u2, R[3] = p_sign, R[4] = diag + return [pgr, [ u1, u2, p_sign^(-1), diag ]]; + + else + Print("g is not an element of the orthogonal group. Abort."); + fi; + + else + Print("g is not an element of the orthogonal group. Abort."); + fi; + +end +); + diff --git a/gap/matrix/wordsInNiceGens/BruhatDecompositionSL.gd b/gap/matrix/wordsInNiceGens/BruhatDecompositionSL.gd new file mode 100755 index 00000000..d182a149 --- /dev/null +++ b/gap/matrix/wordsInNiceGens/BruhatDecompositionSL.gd @@ -0,0 +1,630 @@ +############################################################################# +# BruhatDecompositionSL.gd +############################################################################# +############################################################################# +## +## BruhatDecomposition package +## +## Daniel Rademacher, RWTH Aachen University +## Alice Niemeyer, RWTH Aachen University +## +## Licensed under the GPL 3 or later. +## +############################################################################# + +#! @Chapter Special Linear Group +#! @ChapterLabel SpecialLinearGroup +#! +#! This chapter deals with the special linear group + +#! @Section Introduction and Quick Start of functions for SL +#! @SectionLabel LabelIntroductionAndQuickStartSL + +###################################### +#! Concept: +#! This implementation follows the ideas of +#! "Straight-line programs with memory and matrix Bruhat decomposition" +#! by Alice Niemeyer, Tomasz Popiel and Cheryl Praeger. +#! In the following all references will mean this paper +#! and in case we differ from this paper (due to readability or bug-fixing) +#! this will also be remarked. \smallskip +#! +#! Let g \in SL(d,p^f) +#! Bruhat Decomposition computes g = u_1 \cdot w \cdot u_2, where +#! - u_1,u_2 are lower triangular matrices +#! - w is monomial matrix \smallskip +#! +#! In this algorithm we want to compute the Bruhat-Decomposition of g +#! and give g (respectively u_1,w and u_2) as word in the so called +#! "LGO standard generators" (REF TODO). \smallskip +#! +#! 1) While computing u_1 (resp u_2) with some kind of Gauß-Algorithm, +#! we express the matrices as product of so called transvections +#! - For 1 \leq j < i \leq d: t_{i,j}(\alpha) is the matrix T with +#! 1-entries on diagonal, T_{i,j} = \alpha, 0 elsewhere \newline +#! Each t_{i,j}(\alpha) can be computed from t_{2,1}(\alpha) via recursion, +#! where we have to distinguish the odd and even dimensons (p12 Lemma 4.2). +#! This again can be expressed as a product of t_{2,1}(\omega^\ell) +#! (where omega is a primitive element and 0 \leq \ell < f). +#! The transvections as words in the standard generators are described in +#! (p12 Lemma 4.2). \newline +#! This yields a decomposition of u_1 and u_2 in standard generators. \smallskip +#! +#! 2) In a further step we will decompose the monomial Matrix w in +#! a signed permutation matrix p_sign and a diagonal Matrix diag. +#! ( How to associate p_sign with a product of generators is +#! further described in (PART I b) and (PART III) ) \smallskip +#! +#! 3) The last step is the decomposition of the diagonal Matrix in 2) +#! as word in the standard generators. \smallskip +#! +#! We won't do this matrix multiplications directly, but write them +#! in a list to evaluate in a StraightLineProgram. (Section 2) +#! Although described differently in the paper, we sometimes will allow +#! instructions to multiply more than two elements (eg during conjugating). +#! This doesn't affect the optimality of an slp much, but higly increases +#! the readability of our implementation. \smallskip +###################################### +#! @Section Implemented Subfunctions (Part I) +#! @SectionLabel LabelSubfunctionsPart1 +#! +#! Later we will need some additional functions. Why they are needed and where they are needed is described here.

+#! +#! +#! MakeSLP(): After the BruhatDecompositionSL() we get a list of instructions to calculate the matrices we want using the LGO standard generators. MakeSLP() is used to get a SLP out of these instructions. +#! CoefficientsPrimitiveElement(): It expresses an element w in a field fld as a linear combination of a Primitive Element. This is important for the transvections. (TODO Add Reference!) +#! MyPermutationMat(): Turns a permutation into a permutation matrix. We need it to calculate the LGO standard generator. +#! LGOStandardGensSL(): This function computes the standard generators of SL +#! as given by C. R. Leedham-Green and E. A. O'Brien in +#! "Constructive Recognition of Classical Groups in odd characteristic". +#! (TODO Add Reference!)

+#! +#! HighestSlotOfSLP(): The following function determines the highest slot of a SLP constructed from the list slp will write in. This is important to glue SLPs together. +#! +#! MatToWreathProd() and WreathProdToMat(): +#! In PermSLP() [] we want to transform the monomial matrix w given by +#! UnipotentDecomposition() into a diagonal matrix. +#! (The exact procedure is described in PermSLP() [])

+#! Since multiplying the LGO standard-generators s,v and x not only involves +#! permutations but we also have to consider which non-zero entries are +1 and +#! which -1, we want to associate this matrices with permutations on 2d points. (cf. Wreath-Product)

+#! +#! [s,v,x] \to Sym(2d), M \to Mwr where +#! i^{Mwr} = j and (i+d)^{Mwr}= j+d if M_{i,j} = 1 and +#! i^{Mwr} = j+d and (i+d)^{Mwr}= j if M_{i,j} = -1 +#! for 1 \leq i \leq d.

+#! +#! Due to their relation to wreath-products, we will call denote the image +#! of a matrix M \in [s,v,x] by Mwr.

+#! +#! In fact the association from MatToWreathProd() [] is an isomorphism and we can associate to each +#! permutation we compute during PermSLP() [] a signed permutation matrix (a monomial matrix with only +1 and -1 as non-zero entries).

+ +#! M_{i,j} = 1 if i^{Mwr} = j \leq d and +#! M_{i,j} = -1 if i^{Mwr} = j+d +#! +#! +#! AEM(): Write instructions for Ancient Egyptian Multiplication in slp. At several occasions we will need to compute a high power of some value saved in a memory slot. +#! +#! TestIfMonomial(): Tests if a given matrix M is monomial matrix. We use it to decide whether we are already finished in UnipotentDecomposition(). +#! +#! +#! +#! For some functions also exist a NC version. See []. +#! +#! +#! @Section UnipotentDecomposition (Part II - a) +#! @SectionLabel LabelUnipotentDecomposition2a +#! +#! In this section is the UnipotentDecomposition() described. This method is used to compute the +#! Unitriangular decomposition of the matrix g. []

+#! +#! For this we use five local functions in the UnipotentDecomposition(). They are +#! TransvecAtAlpha(), +#! ShiftTransvections(), FastShiftTransvections(), BackShiftTransvections() and +#! FastBackShiftTransvections().

+ +#! The difference to UnipotentDecompositionWithTi() [] is that this +#! version won't store all the transvections t_{i,i-1}(\omega^l). +#! This will increase the runtime but reduce the memory usage by (d-3) \cdot f compared to +#! the UnipotentDecompositionWithTi().

+#! +#! The function can be called for example by +#! +#!gap> d := 3;; +#!gap> q := 5;; +#!gap> L := SL(d, q);; +#!gap> m := PseudoRandom(L);; +#!gap> stdgens := LGOStandardGensSL(d, q);; +#!gap> UnipotentDecomposition( stdgens, g);; +#! +#! +#! @Section UnipotentDecomposition saving Transvections (Part II - b) +#! @SectionLabel LabelUnipotentDecomposition2b +#! +#! In this section is the UnipotentDecompositionWithTi() described. +#! This method is used to compute the +#! Unitriangular decomposition of the matrix g. []

+#! +#! In this version we will store all the transvections t_{i,i-1}(\omega^l). +#! This will increase the memory usage by (d-3) \cdot f but reduce runtime.

+#! +#! In UnipotentDecompositionWithTi() we use two local functions. They are +#! TransvectionAtAlpha() and +#! ComputeAllTransvections().

+#! +#! The function can be called for example by +#! +#!gap> d := 3;; +#!gap> q := 5;; +#!gap> L := SL(d, q);; +#!gap> m := PseudoRandom(L);; +#!gap> stdgens := LGOStandardGensSL(d, q);; +#!gap> UnipotentDecompositionWithTi( stdgens, g);; +#! +#! +#! +#! @Section Decomposing the Monomial Matrix (Part III) +#! @SectionLabel LabelDecomposingMonomialMatrices +#! +#! We use three functions to decompose the monomial matrix w we get from +#! UnipotentDecomposition(). They are: +#! +#! PermutationMonomialMatrix(): Find the permutation (in Sym(d) corresponding to the monomial matrix w) and diag a diagonal matrix, where diag[i] is the non-zero entry of row i. [] +#! PermSLP(): +#! In this function we will transform a monomial matrix w \in SL(d,q) into a diagonal matrix diag. Using only the standard-generators s,v,x. This will lead to a monomial matrix p_{sign} with only \pm 1 in non-zero entries and p_{sign} \cdot diag = w (i.e. diag = (p_{sign})^{-1} \cdot w ).

+#! Furthermore we will return list slp of instructions which will (when evaluated at the LGO standard-generators) yield diag. +#! +#! It is sufficient for diag to be diagonal, if the permutation associated with w (i.e. i^{\pi_w} = j if M_{i,j} \neq 0) is the inverse of the permutation associated to p_{sign} (again only to Sym(d) ).

+#! +#! In PermSLP() we thus transform \pi_w to () using only \{ \pi_s, \pi_v, \pi_x \}. +#! In order to know diag without computing all matrix multiplications, (we don't know the signs of p_{sign}), we compute a second permutation simultaneously (here using their identification with permutations in Sym(2d) and identifying \{ \pi_s, \pi_v, \pi_x \} with \{s,v,x\} ). [] +#! DiagonalDecomposition(): Writes a list of instructions which evaluated on LGO standard-generators yield the diagonal matrix of the input. [] +#! +#! +#! To these three functions is also a NC version implemented. See []. +#! +#! +#! @Section Main Function (Part IV) +#! @SectionLabel LabelMainFunctionSL +#! +#! In BruhatDecompositionSL() [] we put everything together. We use the three functions UnipotentDecomposition() [], PermSLP() [] and DiagonalDecomposition() [] to compute matrices with u_1^{-1} \cdot p_{sign} \cdot diag \cdot u_2^{-1} = g and a SLP pgr that computes these matrices with the LGO standard generators.

+#! +#! Here is an exampel: +#! +#!gap> mat := [ [ Z(5)^2, Z(5)^0, Z(5)^2 ], +#!> [ Z(5)^3, 0*Z(5), 0*Z(5) ], +#!> [ 0*Z(5), Z(5)^2, Z(5)^2 ] ];;#! +#!gap> L := BruhatDecompositionSL(LGOStandardGensSL(3,5), mat); +#!gap> result := ResultOfStraightLineProgram(L[1], LGOStandardGensSL(3,5)); +#! +#! +#! BruhatDecompositionSLWithTi() [] works like BruhatDecompositionSL() [] but uses UnipotentDecompositionWithTi() [] instead of UnipotentDecomposition() [].

+#! +#! You can use it in the same way like BruhatDecompositionSL(): +#! +#!gap> mat := [ [ Z(5)^2, Z(5)^0, Z(5)^2 ], +#!> [ Z(5)^3, 0*Z(5), 0*Z(5) ], +#!> [ 0*Z(5), Z(5)^2, Z(5)^2 ] ];; +#!gap> L := BruhatDecompositionSLWithTi(LGOStandardGensSL(3,5), mat); +#!gap> result := ResultOfStraightLineProgram(L[1], LGOStandardGensSL(3,5)); +#! +#! +#! To both functions is also a NC version implemented. See []. +#! +#! +#! @Section NC Version +#! @SectionLabel LabelNCVersionSL +#! +#! Here is the NC version of the Bruhat Decomposition described. +#! In all implemented functions are all used functions replaced through their NC version (if one exists). +#! Moreover are all checks from functions of MyBruhatDecomposition removed.

+#! +#! These functions has been modified by this actions and got a NC Version: +#! +#! MakeSLP()[] \to MakeSLPNC()[] (uses the NC version of StraightLineProgram) +#! MyPermutationMat() [] \to MyPermutationMatNC() [] (uses the NC version of ConvertToMatrixRep) +#! LGOStandardGensSL() [] \to LGOStandardGensSLNC() [] (uses the NC version of MyPermutationMat()) +#! MatToWreathProd() [] \to MatToWreathProdNC() [] (no checks for user input) +#! TestIfMonomial() [] \to TestIfMonomialNC() [] (no checks for user input) +#! UnipotentDecomposition() [] \to UnipotentDecompositionNC() [] (no checks for user input) +#! UnipotentDecompositionWithTi() [] \to UnipotentDecompositionWithTiNC() [] (no checks for user input) +#! PermutationMonomialMatrix() [] \to PermutationMonomialMatrixNC() [] (no checks for user input) +#! PermSLP() [] \to PermSLPNC() [] (no checks for unser input and uses PermutationMonomialMatrixNC()) +#! DiagonalDecomposition() [] \to DiagonalDecompositionNC() [] (no checks for user input) +#! BruhatDecompositionSL() [] \to BruhatDecompositionSLNC() [] (uses UnipotentDecompositionNC(), PermSLPNC() and DiagonalDecompositionNC) +#! BruhatDecompositionSLWithTi() [] \to BruhatDecompositionSLWithTiNC() [] (uses UnipotentDecompositionWithTiNC(), PermSLPNC() and DiagonalDecompositionNC()) +#! + + +#! @Section Functions for SL +#! @SectionLabel LabelFunctionsSL + +###################################### +# +# NC Version: +# In all implemented functions are all used functions replaced through +# their NC version (if one exists). Moreover are all checks from functions +# of BruhatDecomposition have been removed +# +# This functions has been modified by this actions and got a NC Version: +# MakeSLP -> MakeSLPNC (uses the NC version of StraightLineProgram) +# MyPermutationMat -> MyPermutationMatNC (uses ConvertToMatrixRepNC) +# LGOStandardGensSL -> LGOStandardGensSLNC (uses MyPermutationMatNC) +# The NC versions of the following functions do not check for user input +# MatToWreathProd -> MatToWreathProdNC +# TestIfMonomial -> TestIfMonomialNC +# UnipotentDecomposition -> UnipotentDecompositionNC +# UnipotentDecompositionWithTi -> UnipotentDecompositionWithTiNC +# PermutationMonomialMatrix -> PermutationMonomialMatrixNC +# PermSLP -> PermSLPNC (also uses other NC versions of other functions) +# DiagonalDecomposition -> DiagonalDecompositionNC +# BruhatDecompositionSLNC and BruhatDecompositionSLWithTiNC now use the NC +# versions of UnipotentDecomposition, PermSLP and DiagonalDecomposition +# BruhatDecompositionSL -> BruhatDecompositionSLNC +# BruhatDecompositionSLWithTi -> BruhatDecompositionSLWithTiNC +# +###################################### + + +#################### +# PART I - a) +# Originally implemented subfunctions +#################### + +InfoBruhat := NewInfoClass("InfoBruhat");; +SetInfoLevel( InfoBruhat, 2 ); + +##### +# MakeSLP() +##### + +#! @BeginGroup MakeSLPGroup +#! @Arguments slp genlen +#! @Returns An SLP using the instructions of slp and genlen inputs +#! @Description +#! slp: A list of instructions for a straight-line program, \newline +#! genlen: The number of inputs for our SLP (ie the number of generators ) \newline +#! To increase readability, the lists slp as defined later +#! (see Unipotent-, Diagonal-, BruhatDecompositionSL and PermSLP) +#! start with [1,1],[2,1],.. [5,1]. However this represents the LGO standard- +#! generators and is the input of our straight-line program. +#! Defining and SLP we thus have to exclude this instructions from our list. +DeclareGlobalFunction( "MakeSLP" ); +DeclareGlobalFunction( "MakeSLPNC" ); +#! @EndGroup + + +##### +# CoefficientsPrimitiveElement() +##### + +#! @Arguments fld alpha +#! @Returns Coefficients (A vector c sth for omega primitive element alpha = sum c[i] omega^(i-1)) +#! @Description +#! fld: A field, \newline +#! alpha: An element of fld \newline +#! The following function has been written by Thomas Breuer. +#! It expresses an element alpha in a field fld as +#! a linear combination of a Primitive Element. +DeclareGlobalFunction( "CoefficientsPrimitiveElement" ); + + + +##### +# MyPermutationMat() +##### + +#! @BeginGroup MyPermutationMatGroup +#! @Arguments perm dim fld +#! @Returns The permutation matrix of perm over M_{d x d}(fld) (ie res_{i,j} = One(fld) if i^{perm} = j) +#! @Description +#! perm: A permutation, \newline +#! dim: A natural number, \newline +#! fld: A field \newline +#! Given a permutation an integer d > 0 and a field fld, this function computes +#! the permutation matrix P in M_{d x d}(fld). +DeclareGlobalFunction( "MyPermutationMat" ); +DeclareGlobalFunction( "MyPermutationMatNC" ); +#! @EndGroup + + +##### +# LGOStandardGensSL +##### + +#! @BeginGroup LGOStandardGensSLGroup +#! @Arguments d q +#! @Returns stdgens (the LGO standard-generators of SL(d,q)) +#! @Description +#! d: the dimension of our matrix, \newline +#! q: A prime power q = p^f, where F_q ist the field whereover the matrices are defined \newline +#! This function computes the standard generators of SL +#! as given by C. R. Leedham-Green and E. A. O'Brien in +#! "Constructive Recognition of Classical Groups in odd characteristic" +#! (This matrices can also be found in the paper ch 3.1 ps 6-7) +DeclareGlobalFunction( "LGOStandardGensSL" ); +DeclareGlobalFunction( "LGOStandardGensSLNC" ); +#! @EndGroup + + +#################### +# PART I - b) +# Additionally implemented subfunctions +#################### + +##### +# HighestSlotOfSLP() +##### + +# We can't use Length(slp) as done in the original code to determine which +# slots are already used, because not every entry of slp creates a new slot +# while others may increase the highest slot used by more than one. +# (After explicitly writing in a slot j>N, the SLP continues creating slots +# j+1,j+2,.. if no slot is explicitly given.) + +#! @Arguments slp +#! @Returns highestslot (The number of slots this SLP will need if evaluated) +#! @Description +#! slp: A list of instructions satisfying the properties for an SLP \newline +#! The following function determines the highest slot a SLP +#! constructed from the list slp will write in. +DeclareGlobalFunction( "HighestSlotOfSLP" ); + + + +##### +# MatToWreathProd() and WreathProdToMat() +##### + +#! @BeginGroup MatToWreathProdGroup +#! @Arguments M +#! @Returns perm (the permutation Mwr) +#! @Description +#! M: A monomial matrix with only +1 and -1 entries \newline +#! In PermSLP we want to transform the monomial matrix w given by +#! UnipotentDecomposition() into a diagonal matrix. +#! (The exact procedure is described in PermSLP) +#! Since multiplying the LGO standard-generators s,v and x not only involves +#! permutations but we also have to consider which non-zero entries are +1 and +#! which -1, we want to associate this matrices with permutations on 2d points. +#! (cf Wreath-Product) +#! \langle s,v,x \rangle \rightarrow Sym(2d), M \rightarrow Mwr where +#! i^{Mwr} = j and (i+d)^{Mwr}= j+d if M_{i,j} = 1 and +#! i^{Mwr} = j+d and (i+d)^{Mwr}= j if M_{i,j} = -1 +#! for 1\leq i\leq d +#! Due to their relation to wreath-products, we will call denote the image +#! of a matrix M \in \langle s,v,x \rangle by Mwr +DeclareGlobalFunction( "MatToWreathProd" ); +DeclareGlobalFunction( "MatToWreathProdNC" ); +#! @EndGroup + + +#! @Arguments perm dim fld +#! @Returns res (The Matrix M satisfying the below properties) +#! @Description +#! perm: A permutation in Sym(2d) sth. {{i,i+d}}_1: 1 \leq i \leq d are blocks, \newline +#! dim: The dimension of the matrix we want perm send to, \newline +#! fld: The field whereover the matrix is defined. \newline +#! In fact the association above is an isomorphism and we can associate to each +#! permutation we compute during PermSLP a unique monomial matrix whose non-zero +#! entries are +1 or -1. +#! M_{i,j} = 1 if i^{Mwr} = j \leq d and +#! M_{i,j} = -1 if i^{Mwr} = j+d +DeclareGlobalFunction( "WreathProdToMat" ); + + + +##### +# AEM (Ancient Egytian Multiplication) +##### + +#! @Arguments spos respos tmppos k +#! @Returns instr (Lines of an SLP that will (when evaluated) take the value b saved in spos and write b^k in respos) +#! @Description +#! AEM (Ancient Egytian Multiplication) \newline +#! spos: The memory slot, where a value b is saved in, \newline +#! respos: The memory slot we want the exponentation to be written in, \newline +#! tmppos: A memory slot for temporary results, \newline +#! k: An integer \newline +#! At several occasions we will need to compute a high power of some value +#! saved in a memory slot. For this purpose there is a variaton of AEM +#! implemented below. +#! Remarks: tmpos and respos must differ. +#! If spos = respos or spos = tmpos it will be overwritten. +DeclareGlobalFunction( "AEM" ); + + + +##### +# TestIfMonomial() +##### + +#! @BeginGroup TestIfMonomialGroup +#! @Arguments M +#! @Returns True if M is a monomial matrix, otherwise false. +#! @Description +#! M: A Matrix \newline +#! Tests if a given matrix M is a monomial matrix. +#! There is function in GAP, however it does not seem to work for SL(d,q). +DeclareGlobalFunction( "TestIfMonomial" ); +DeclareGlobalFunction( "TestIfMonomialNC" ); +#! @EndGroup + + +#################### +# PART II - a) +# UnipotentDecomposition and Transvections +#################### + +##### +# Transvections2() +##### + +#! @Arguments stdgens omega slp pos +#! @Returns slp: The list of instruction with additional instructions writing t_{2,1}(\omega^\ell) in Slot pos[l+1] 0 \leq \ell \leq f-1. +#! @Description +#! stdgens: The LGO standard-generators of SL(d,q) \newline +#! omega: A primitive element of GF(q) \newline +#! slp: A list of instructions \newline +#! pos: A list of numbers, denoting where to save the transvections +#! t_{2,1}(\omega^\ell) for 0 \leq \ell \leq f-1 \newline +#! Let stdgens be the list of standard generators for SL(d,p^f) +#! and let omega be a primitive element of G(p^f). +#! This function computes T_2 := \{ t_{2,1}(\omega^\ell) \mid 0 \leq \ell \leq f-1 \} +#! Record what we do in slp +#! This function coincides with eq (6) p12. +DeclareGlobalFunction( "Transvections2" ); + + + +##### +# UnipotentDecomposition() +##### + +#! @BeginGroup UnipotentDecompositionGroup +#! @Arguments stdgens g +#! @Returns slp (A list of instructions yielding u_1,u_2 if evaluated as SLP), [u_1,g,u_2] (The matrices of the Bruhat-Decomposition) +#! @Description +#! stdgens: The LGO standard-generators \newline +#! g: A matrix in SL(d,q) \newline +#! Computes the Unitriangular decomposition of the matrix g. +DeclareGlobalFunction( "UnipotentDecomposition" ); +DeclareGlobalFunction( "UnipotentDecompositionNC" ); +#! @EndGroup + + +#################### +# PART II - b) +# Basically the same as in II - a) +# But now we save all Transvections +#################### + +#! @BeginGroup UnipotentDecompositionWithTiGroup +#! @Arguments stdgens g +#! @Returns slp (A list of instructions yielding u_1,u_2 if evaluated as SLP), [u_1,g,u_2] (The matrices of the Bruhat-Decomposition) +#! @Description +#! stdgens: The LGO standard-generators \newline +#! g: A matrix in SL(d,q) \newline +#! Computes the Bruhat decomposition of the matrix g, given +#! the standard generators for the group. +#! In this version we will store all the transvections t_{i,i-1}(\omega^\ell). +#! this will increase the memory usage by (d-3) \cdot f but reduce the runtime. +DeclareGlobalFunction( "UnipotentDecompositionWithTi" ); +DeclareGlobalFunction( "UnipotentDecompositionWithTiNC" ); +#! @EndGroup + + +##################### +# PART III +# Decomposition of Permutation and Diagonal-Matrix +#################### + +##### +# PermutationMonomialMatrix() +##### + +#! @BeginGroup PermutationMonomialMatrixGroup +#! @Arguments M +#! @Returns diag (The vector of non-zero entries, where diag[i] is the non-zero entry of row i.), perm (The permutation associated to M, i.e. i^{perm} = j if M_{i,j} is not 0) +#! @Description +#! M: A monomial matrix. \newline +#! Find the permutation (in Sym(d)) corresponding to the input monomial matrix. +DeclareGlobalFunction( "PermutationMonomialMatrix" ); +DeclareGlobalFunction( "PermutationMonomialMatrixNC" ); +#! @EndGroup + + + +##### +# PermSLP() +##### + +#! @BeginGroup PermSLPGroup +#! @Arguments stdgens mat slp +#! @Returns slp (A list of instructions to evaluate p_sign if slp was Input then this instructions are added to slp), p_sign (The signed permutation matrix), mat (The diagonal matrix diag) +#! @Description +#! stdgens: The LGO standard-generators \newline +#! mat: A monomial matrix (ie w) \newline +#! slp: An already existing list of instructions *optional \newline +#! In this function we will transform a monomial matrix w \in SL(d,q) into +#! a diagonal matrix diag. Using only the standard-generators s,v,x this +#! will lead to a monomial matrix p_sign with only +-1 in non-zero entries +#! and p_sign*diag = w (i.e. diag = p_sign^-1*w ). +#! Furthermore we will return list slp of instructions which will +#! (when evaluated at the LGO standard-generators) yield diag. \newline +#! It is sufficient for diag to be diagonal, if the permutation associated +#! with w (i.e. i^\pi_w = j if M_{i,j} not 0) is the inverse of the permutation +#! associated to p_sign (again only to Sym( d ) ) \newline +#! In PermSLP we thus transform \pi_w to () using only \{ \pi_s, \pi_v, \pi_x \} +#! In order to know diag without computing all matrix multiplications, +#! (we don't know the signs of p_sign), we compute a second permutation +#! simultaneously (here using their identification with permutations in Sym(2d) +#! and identifying \{ \pi_s, \pi_v, \pi_x \} with \{ s,v,x \} ) +DeclareGlobalFunction( "PermSLP" ); +DeclareGlobalFunction( "PermSLPNC" ); +#! @EndGroup + + + +##### +# DiagonalDecomposition() +##### + +#! @BeginGroup DiagonalDecompositionGroup +#! @Arguments stdgens diag slp +#! @Returns slp (A list of instructions to evaluate diag if slp was Input then this instructions are added to slp), hres (The the identity matrix) +#! @Description +#! stdgens: The LGO standard-generators \newline +#! diag: A diagonal matrix (eg diag) \newline +#! slp: An already existing list of instructions *optional \newline +#! Writes a list of instructions which evaluated on LGO standard-generators +#! yield the diagonal matrix of the input. +DeclareGlobalFunction( "DiagonalDecomposition" ); +DeclareGlobalFunction( "DiagonalDecompositionNC" ); +#! @EndGroup + + + +#################### +# PART IV +# Main Functions. Constructs slp for the StraightLineProgram +##################### + +##### +# BruhatDecompositionSL() +##### + +#! @BeginGroup BruhatDecompositionSLGroup +#! @Arguments stdgens g +#! @Returns pgr (A SLP to compute u_1,u_2,p_{sign} and diag and the matrices u_1, u_2, p_{sign} and diag itself.) +#! @Description +#! stdgens: The LGO standard-generators \newline +#! g: A matrix in SL(d,q) \newline +#! Uses UnipotentDecomposition(), PermSLP() and DiagonalDecomposition() +#! to write a matrix g \in SL(d,q) as g = u_1^{-1} \cdot p_{sign} \cdot diag \cdot u_2^{-1} +#! where u_1,u_2 are lower unitriangular matrices, p_{sign} is a monomial matrix +#! with only +1 and -1 as non-zero entries and diag a diagonal matrix. +#! It furthermore yields an SLP that returns the above matrices if evaluated +#! with the LGO standard-generators. +DeclareGlobalFunction( "BruhatDecompositionSL" ); +DeclareGlobalFunction( "BruhatDecompositionSLNC" ); +#! @EndGroup + + + +##### +# BruhatDecompositionSLWithTi() +##### + +#! @BeginGroup BruhatDecompositionSLWithTiGroup +#! @Arguments stdgens g +#! @Returns pgr (A SLP to compute u_1,u_2,p_{sign} and diag and the matrices u_1, u_2, p_{sign} and diag itself.) +#! @Description +#! stdgens: The LGO standard-generators \newline +#! g: A matrix in SL(d,q) \newline +#! As BruhatDecompositionSL() but replaces UnipotentDecomposition() +#! by UnipotentDecompositionWithTi(). +DeclareGlobalFunction( "BruhatDecompositionSLWithTi" ); +DeclareGlobalFunction( "BruhatDecompositionSLWithTiNC" ); +#! @EndGroup diff --git a/gap/matrix/wordsInNiceGens/BruhatDecompositionSL.gi b/gap/matrix/wordsInNiceGens/BruhatDecompositionSL.gi new file mode 100755 index 00000000..e5063c3b --- /dev/null +++ b/gap/matrix/wordsInNiceGens/BruhatDecompositionSL.gi @@ -0,0 +1,3844 @@ +###################################### +# BruhatDecompositionSL.gi +###################################### + +###################################### +# Concept: +# This implementation follows the ideas of +# "Straight-line programs with memory and matrix Bruhat decomposition" +# by Alice Niemeyer, Tomasz Popiel & Cheryl Praeger. +# In the following all references will mean this paper +# and in case we differ from this paper (due to readability or bug-fixing) +# this will also be remarked. +# +# Let g \in SL(d,p^f) +# Bruhat Decomposition computes g = u1 * w * u2, where +# - u1,u2 are lower triangular matrices +# - w is monomial matrix +# +# In this algorithm we want to compute the Bruhat-Decomposition of g +# and give g (respectively u1,w and u2) as word in the so called +# "LGO standard generators" (Section 3.1). +# +# 1) While computing u1 (resp u2) with some kind of Gauß-Algorithm, +# we express the matrices as product of so called transvections +# - For 1 <= j < i <= d: t_{i,j}(\alpha) is the matrix T with +# 1-entries on diagonal, T_i,j = \alpha, 0 elsewhere +# Each t_{i,j}(\alpha) can be computed from t_{2,1}(\alpha) via recursion, +# where we have to distinguish the odd and even dimensons (p12 Lemma 4.2). +# This again can be expressed as a product of t_{2,1}(omega^\ell) +# (where omega is a primitive element and 0 <= ell < f). +# The transvections as words in the standard generators are described in +# (p12 Lemma 4.2). +# This yields a decomposition of u1 and u2 in standard generators. +# +# 2) In a further step we will decompose the monomial Matrix w in +# a signed permutation matrix p_sign and a diagonal Matrix diag. +# ( How to associate p_sign with a product of generators is +# further described in (PART I b) and (PART III) ) +# +# 3) The last step is the decomposition of the diagonal Matrix in 2) +# as word in the standard generators. +# +# We won't do this matrix multiplications directly, but write them +# in a list to evaluate in a StraightLineProgram. (Section 2) +# Although described differently in the paper, we sometimes will allow +# instructions to multiply more than two elements (eg during conjugating). +# This doesn't affect the optimality of an slp much, but higly increases +# the readability of our implementation. +###################################### + + + +#################### +# PART I - a) +# Originally implemented subfunctions +#################### + +InfoBruhat := NewInfoClass("InfoBruhat");; +SetInfoLevel( InfoBruhat, 2 ); +##### +# MakeSLP() +##### + +# To increase readability, the lists slp as defined later +# (see Unipotent-, Diagonal-, BruhatDecomposition and PermSLP) +# start with [1,1],[2,1],.. [5,1]. However this represents the LGO standard- +# generators and is the input of our straight-line program. +# Defining and SLP we thus have to exclude this instructions from our list. + +# Input: slp: A list of instructions for a straight-line program +# genlen: The number of inputs for our SLP +# (ie the number of generators ) + +# Output: An SLP using the instructions of slp and genlen inputs + +# +# BruhatDecomposition: Computes the Bruhat Decomposition of matrices of the classical groups. +# +# Implementations +# + +InstallGlobalFunction( MakeSLP, + function( slp, genlen ) + + return StraightLineProgram( slp{[ genlen+1 .. Length(slp) ]}, genlen ); + +end +); + + +InstallGlobalFunction( MakeSLPNC, +function( slp, genlen ) + + return StraightLineProgramNC( slp{[ genlen+1 .. Length(slp) ]}, genlen ); + +end +); + + + +##### +# CoefficientsPrimitiveElement() +##### + +# The following function has been written by Thomas Breuer. +# It expresses an element alpha in a field fld as +# a linear combination of a Primitive Element. + +# Input: fld: A field, +# alpha : An element of fld + +# Output: Coefficients: A vector c sth for omega primitive element +# alpha = sum c[i] omega^(i-1) + +InstallGlobalFunction( CoefficientsPrimitiveElement, +function ( fld, alpha ) + + if Size( fld ) <= MAXSIZE_GF_INTERNAL then + + return Coefficients( CanonicalBasis( fld ), alpha ); + else + + alpha := FFECONWAY.WriteOverLargerField( alpha, DegreeOverPrimeField( fld ) ); + + if IsCoeffsModConwayPolRep( alpha ) then + return alpha![1]; + elif IsModulusRep(alpha) then + return [alpha]; + else + Error( "this should not happen" ); + fi; + fi; + +end +); + + +##### +# MyPermutationMat() +##### + +# Given a permutation an integer d > 0 and a field fld, this function computes +# the permutation matrix P in M_{d x d}(fld). + +# Input: +# perm: A permutation +# dim: A natural number +# fld: A field + +# Output: res: The permutation matrix of perm over M_{d x d}(fld) +# (ie res_{i,j} = One(fld) if i^perm = j) + +InstallGlobalFunction( MyPermutationMat, +function(perm, dim, fld) + + local res; + + res := PermutationMat(perm, dim) * One(fld); + ConvertToMatrixRep(res); + + return res; + +end +); + + +InstallGlobalFunction( MyPermutationMatNC, +function(perm, dim, fld) + + local res; + + res := PermutationMat( perm, dim ) * One( fld ); + ConvertToMatrixRepNC(res); + + return res; + +end +); + + + +##### +# LGOStandardGensSL +##### + +# This function computes the standard generators of SL +# as given by C. R. Leedham-Green and E. A. O'Brien in +# "Constructive Recognition of Classical Groups in odd characteristic" +# (This matrices can also be found in the paper ch 3.1 ps 6-7) + +# Input: +# d: the dimension of our matrix +# q: A prime power q = p^f, where F_q ist the field whereover the matrices +# are defined + +# Output: stdgens the LGO standard-generators of SL(d,q) + +InstallGlobalFunction( LGOStandardGensSL, +function( d, q ) + + local t, w, s, x, v, i, delta, fld; + + fld := GF(q); + + if d < 3 then + Error("LGOStandardGens: d has to be at least 3\n"); + return; + fi; + + # t: The transvection + t := IdentityMat( d, fld ); + t[1][2] := One(fld); + + # delta: The diagonal matrix + delta := IdentityMat(d,fld); + delta[1][1] := PrimitiveRoot(fld); + delta[2][2] := PrimitiveRoot(fld)^-1; + + # s: The transposition + s := IdentityMat( d, fld ); + s{[1..2]}{[1..2]} := MyPermutationMat( (1,2), 2, fld ); + s[2][1] := - s[2][1]; + + + # x: The 4-cycle (resp identity if d odd) + if IsEvenInt(d) then + x := MyPermutationMat( (1,2,3,4), d, fld ); + x[4][1] := - x[4][1]; + else + x := IdentityMat(d,fld); + fi; + + # v: The cycle + if IsEvenInt(d) then + if d = 2 then + v := (); + else + v := (1,3)(2,4); + for i in [5,7 .. d-1] do + v := v * (1,i)(2,i+1); + od; + fi; + v := MyPermutationMat( v, d, fld ); + + else + v := 0* IdentityMat(d,fld); + v[1][d] := One(fld); + v{[ 2..d ]}{[ 1..d-1 ]} := - IdentityMat( d-1 , fld ); + fi; + + return [ s, t, delta, v, x ]; + +end +); + + +InstallGlobalFunction( LGOStandardGensSLNC, +function( d, q ) + + local s, t, delta, v, x, i, fld; + + fld := GF(q); + + + # s: The transposition + s := IdentityMat( d, fld ); + s{[ 1..2 ]}{[ 1..2 ]} := MyPermutationMatNC( (1,2), 2, fld ); + s[2][1] := - s[2][1]; + + + # t: The transvection + t := IdentityMat( d, fld ); + t[1][2] := One(fld); + + + # delta: The diagonal matrix + delta := IdentityMat(d,fld); + delta[1][1] := PrimitiveElement(fld); + delta[2][2] := PrimitiveElement(fld)^-1; + + + # v: The cycle + if IsEvenInt(d) then + if d = 2 then + v := (); + else + v := (1,3)(2,4); + for i in [ 5,7 .. d-1 ] do + v := v * (1,i)(2,i+1); + od; + fi; + v := MyPermutationMatNC( v, d, fld ); + + else + v := 0* IdentityMat(d,fld); + v[1][d] := One(fld); + v{[ 2..d ]}{[ 1..d-1 ]} := - IdentityMat( d-1 , fld ); + fi; + + + # x: The 4-cycle (resp identity if d odd) + if IsEvenInt(d) then + x := MyPermutationMatNC( (1,2,3,4), d, fld ); + x[4][1] := - x[4][1]; + else + x := IdentityMat(d,fld); + fi; + + + return [ s, t, delta, v, x ]; + +end +); + + + + +#################### +# PART I - b) +# Additionally implemented subfunctions +#################### + +##### +# HighestSlotOfSLP() +##### + +# We can't use Length(slp) as done in the original code to determine which +# slots are already used, because not every entry of slp creates a new slot +# while others may increase the highest slot used by more than one. +# (After explicitly writing in a slot j>N, the SLP continues creating slots +# j+1,j+2,.. if no slot is explicitly given.) + +# The following function determines the highest slot a SLP +# constructed from the list slp will write in. + +# Input: slp: A list of instructions satisfying the properties for an SLP + +# Output: highestslot: The number of slots this SLP will need if evaluated + +InstallGlobalFunction( HighestSlotOfSLP, +function(slp) + + local len, i, highestslot; + + len := Length(slp); + highestslot := 0; + + for i in [ 1..len ] do + + if IsList( slp[i][1] ) and not IsList( slp[i][2] ) then + # ie slp[i] = [list,i], thus will write in i. + highestslot := Maximum( highestslot, slp[i][2] ); + elif not IsList( slp[i][1] ) then + # ie slp[i] = list, thus creates new highest slot + highestslot := highestslot + 1; + else + # ie slp[i] = [list_1,..list_n], thus the end of slp + # and only shows slots + fi; + od; + + return highestslot; + +end +); + + +##### +# MatToWreathProd() and WreathProdToMat() +##### + +# In PermSLP we want to transform the monomial matrix w given by +# UnipotentDecomposition() into a diagonal matrix. +# (The exact procedure is described in PermSLP) +# Since multiplying the LGO standard-generators s,v and x not only involves +# permutations but we also have to consider which non-zero entries are +1 and +# which -1, we want to associate this matrices with permutations on 2d points. +# (cf Wreath-Product) + +# < s,v,x > -> Sym(2d), M -> Mwr where +# i^Mwr = j and (i+d)^Mwr= j+d if M_i,j = 1 and +# i^Mwr = j+d and (i+d)^Mwr= j if M_i,j = -1 +# for 1<=i<=d + +# Due to their relation to wreath-products, we will call denote the image +# of a matrix M \in < s,v,x > by Mwr + +# Input: M: A monomial matrix with only +1 and -1 entries + +# Output: perm: the permutation Mwr + +InstallGlobalFunction( MatToWreathProd, +function( M ) + + local zero, d, found, perm, perm2, diag, r, j; + + zero := Zero( M[1][1] ); + d := DimensionsMat(M); + if d[1] <> d[2] then Error("Matrix must be square"); return; fi; + d := d[1]; + + found:= BlistList( [1..d], [] ); + perm := []; + diag := []; + + for r in [1..d] do + j := PositionNot( M[r], zero ); + if d < j or found[j] then return false; fi; + diag[r] := M[r][j]; + if PositionNot( M[r], zero, j ) <= d then + return false; + fi; + found[j] := true; + if M[r][j] = One(M[1][1]) then + perm[ r ] := j; + perm[ r+d ] := j+d; + elif M[r][j] = -One(M[1][1]) then + perm[ r ] := j+d; + perm[ r+d ] := j; + fi; + od; + + perm := PermList(perm); + + return perm; +end +); + + +InstallGlobalFunction( MatToWreathProdNC, +function( M ) + + local zero, d, found, perm, perm2, diag, r, j; + + zero := Zero( M[1][1] ); + d := Length( M ); + + found:= BlistList( [1..d], [] ); + perm := []; + diag := []; + + for r in [ 1..d ] do + j := PositionNot( M[r], zero ); + if d < j or found[j] then return false; fi; + diag[r] := M[r][j]; + if PositionNot( M[r], zero, j ) <= d then + return false; + fi; + found[j] := true; + if M[r][j] = One(M[1][1]) then + perm[ r ] := j; + perm[ r+d ] := j+d; + elif M[r][j] = -One(M[1][1]) then + perm[ r ] := j+d; + perm[ r+d ] := j; + fi; + od; + + perm := PermList(perm); + + return perm; +end +); + + + +# In fact the association above is an isomorphism and we can associate to each +# permutation we compute during PermSLP a unique monomial matrix whose non-zero +# entries are +1 or -1. + +# M_i,j = 1 if i^Mwr = j <= d and +# M_i,j = -1 if i^Mwr = j+d + +# Input: perm: A permutation in Sym(2d) sth. {{i,i+d}}_1<=i<=d are blocks +# dim: The dimension of the matrix we want perm send to +# fld: The field whereover the matrix is defined. + +# Output: res: The Matrix M satisfying the above properties + +InstallGlobalFunction( WreathProdToMat, +function( perm, dim, fld ) + + local res,sign,r,one,tmp; + + one := One(fld); + sign := []; + tmp := []; + + for r in [1..dim] do + + if r^perm <= dim then + + sign[ r ] := one; + tmp[ r ] := r^perm; + + else + + sign[ r ] := - one; + tmp[ r ] := r^perm - dim; + + fi; + + od; + + perm := PermList(tmp); + res := PermutationMat( perm, dim ) * one; + + for r in [ 1..dim ] do + res[ r ][ r^perm ]:= sign[ r ]; + od; + + ConvertToMatrixRep( res ); + + return res; + +end +); + +##### +# AEM (Ancient Egytian Multiplication) +##### + +# At several occasions we will need to compute a high power of some value +# saved in a memory slot. For this purpose there is a variaton of AEM +# implemented below. + +# Input: spos: The memory slot, where a value b is saved in +# respos: The memory slot we want the exponentation to be written in +# tmppos: A memory slot for temporary results +# k: An integer. + +# Output: instr: Lines of an SLP that will (when evaluated) take the value b +# saved in spos and write b^k in respos + +# Remarks: tmpos and respos must differ. +# If spos = respos or spos = tmpos it will be overwritten. + +InstallGlobalFunction( AEM, +function(spos,respos,tmppos,k) + + local instr,i; + + instr:=[]; + instr[1] := [ [spos,0], respos ]; + instr[2] := [ [spos,1], tmppos ]; + i:=3; + + if k < 0 then + instr[2] := [ [spos,-1], tmppos ]; + k:=-k; + fi; + + while k > 0 do + + if IsOddInt(k) then + instr[i] := [ [respos,1,tmppos,1], respos ]; + i := i + 1; + fi; + + instr[i] := [ [tmppos,2], tmppos ]; + k := QuoInt( k, 2 ); + i := i + 1; + od; + + return instr; + +end +); + +##### +# TestIfMonomial() +##### + +# Tests if a given matrix M is monomial matrix +# there is function in GAP, however it does not seem to work for SL(d,q). + +# Input: M: A Matrix + +# Output: true if M is Monomial, false else + +InstallGlobalFunction( TestIfMonomial, +function( M ) + + local zero, d, found, r, j; + + zero := Zero( M[1][1] ); + d := DimensionsMat(M); + + if d[1] <> d[2] then + return false; + fi; + + d := d[1]; + found:= BlistList( [1..d], [] ); + + for r in [ 1..d ] do + + j := PositionNot( M[r], zero ); + + if d < j or found[j] then + return false; + fi; + + if PositionNot( M[r], zero, j ) <= d then + return false; + fi; + + found[j] := true; + + od; + + return true; + +end +); + + +InstallGlobalFunction( TestIfMonomialNC, +function( M ) + + local zero, d, found, r, j; + + zero := Zero( M[1][1] ); + d := Length( M ); + + found:= BlistList( [1..d], [] ); + + for r in [ 1..d ] do + + j := PositionNot( M[r], zero ); + + if d < j or found[j] then + return false; + fi; + + if PositionNot( M[r], zero, j ) <= d then + return false; + fi; + + found[j] := true; + + od; + + return true; + +end +); + + + +#################### +# PART II - a) +# UnipotentDecomposition and Transvections +#################### + +##### +# Transvections2() +##### + +# Let stdgens be the list of standard generators for SL(d,p^f) +# and let omega be a primitive element of G(p^f). +# This function computes T_2 := { t21(omega^ell) | 0 <= ell <= f-1 } +# Record what we do in slp + +# This function coincides with eq (6) p12 + +# Input: stdgens: The LGO standard-generators of SL(d,q) +# omega: A primitive element of GF(q) +# slp: A list of instructions +# pos: A list of numbers, denoting where to save the transvections +# t_{2,1}(omega^ell) 0 <= ell < f + +# Output: slp: The list of instruction with additional instructions writing +# t_{2,1}(\omega^ell) in Slot pos[l+1] 0 <= ell < f. + +InstallGlobalFunction( Transvections2, +function( stdgens, omega, slp, pos ) + + local ell, f, fld; + + fld := DefaultField( omega ); + f := LogInt( Size(fld), Characteristic(fld) ); + + for ell in [0..f-1] do + + if IsOddInt( Length( stdgens[1] ) ) then + #del^-1*v*del^v*v^-1 (see p12 (6)) + Add(slp, [ [8,ell, 4,1, 8,ell, 9,1 ], pos[ell+1] ] ); + else + #del^-ell*x^-1*del^-ell*x (see p12 (6)) + Add(slp, [ [8,ell, 10,1, 8,ell,5,1], pos[ell+1] ] ); + fi; + + #t_{2,1}*s*t^-1*s^-1*t_{2,1}^-1 + Add(slp,[ [pos[ell+1],1, 1,1, 7,1, 6,1, pos[ell+1],-1 ], + pos[ell+1] ] ); + od; + + return slp; + +end +); + +##### +# UnipotentDecomposition() +##### +# Computes the Unitriangular decomposition of the matrix g + +# Input: +# stdgens: The LGO standard-generators +# g: a matrix in SL(d,q) + +# Output: slp: A list of instructions yielding u1,u2 if evaluated as SLP +# [u1,g,u2]: The matrices of Bruhat-Decomposition + +InstallGlobalFunction( UnipotentDecomposition, +function( arg ) + + local stdgens, c, r, i, j, a, z, d, f, ell, fld, u1, u2, g, slp, instr, + tmppos, AEMrespos, vxpos, vxipos, u1pos, u2pos, tvpos, + tir1pos, tirzpos, tcj1pos, tcjzpos, T2pos, Tipos, Ti_1pos, + TransvecAtAlpha, ShiftTransvections, FastShiftTransvections, + BackShiftTransvections, FastBackShiftTransvections; + +# ############### +# Local Functions +# ############### + +# The following five functions are local as they have side effects. +# In particular, they modify the global variables T_i and Ti_1 + + ##### + # TransvectionAtAlpha() + ##### + + # Let alpha in GF(p^f), alpha = Sum a_l omega^l, omega a primitive element + # Let slp be the list of instructions in UnipotentDecomposition and Tipos + # denote the slots where transvections t_{i,j}(omega^ell) 0 <= ell < f + # are saved. This function computes + # t_{i,j}(alpha) = product t_{i,j}(omega^ell)^{a_ell} (see Lemma 4.2) + # where the exponents a_ell are given by CoefficientsPrimitiveElement. + # (For Definition of Transvections see paper p11) + + TransvecAtAlpha := function( alpha ) + + local cc, ell, instr; + + # if omega = 1 then we overwrite the position for tv with Ti(1) + if IsOne( alpha ) then + Add(slp, [ [ Tipos[1], 1 ], tvpos ] ); + return; + fi; + + cc := CoefficientsPrimitiveElement( fld, alpha ); + instr := []; + + for ell in [ 1..Length(cc) ] do + + if not IsZero( cc[ell] ) then + Append( instr, [ Tipos[ell], Int(cc[ell]) ] ); + fi; + od; + + if Length( instr ) = 0 then + Error("TransvecAtAlpha: this should not happen"); + fi; + + Add( slp, [ instr,tvpos ] ); + + return; + + end; + + + ##### + # ShiftTransvections() + ##### + + # Let Ti be the set of transvections { t_{i(i-1)}(omega^ell) } + # and Ti_1 the set of transvections { t_{(i-1)(i-2)}(omega^ell) }. + + # ShiftTransvections computes { t_{i+1,i}(omega^ell) } for given + # Ti and Ti_1 (This coincides with eq(8) p12) + # stores them in the variable Ti and stores + # the transvections { t_{i,i-1}(omega^ell) } in the variable Ti_1. + + # This corresponds to ( eq (7+8) p12 ) + + ShiftTransvections := function(i) + + local ell; + + # For i = 2: Ti=T2. + if i <= 2 then return; fi; + + if IsOddInt(d) then + # If d is Odd: Conjugate the last Ti (eq (8)) + for ell in [ 1..f ] do + Add( slp, [ [ 4,1, Tipos[ell],1, 9,1], Tipos[ell] ] ); + od; + else + if i = 3 then + # Compute T3 differently (eq (7)) + for ell in [ 1..f ] do + # Copy what is in Ti into Ti_1 + Add(slp, [ [Tipos[ell],1 ], Ti_1pos[ell] ] ); + # Write the new instruction to compute Ti + Add( slp, [ [ vxipos,1, Tipos[ell],1, vxpos,1], + Tipos[ell] ] ); + od; + else + # If d is Even: Conjugate the 2nd last Ti (eq (8)) + for ell in [ 1..f ] do + # Copy the instruction in Ti into tmp position, + Add(slp,[ [ Tipos[ell], 1 ], tmppos ] ); + # conjugate Ti_1 by v and write into Tipos + Add( slp, [ [ 9,1, Ti_1pos[ell],1, 4,1], Tipos[ell] ] ); + Add(slp, [ [tmppos,1], Ti_1pos[ell] ] ); + od; + fi; + fi; + end; + + + ##### + # FastShiftTransvections() + ##### + + # Given t_2,1 we compute t_{i,i-1} using fast exponentation. + # This algorithm will be called in each step of the main loop and + # is more efficient than calling ShiftTransvections (r-2) times. + + FastShiftTransvections := function(i) + + local ell; + + # For i = 2: Ti=T2. + if i <= 2 then return; fi; + + if IsOddInt(d) then + + instr := AEM( 4, AEMrespos, tmppos, i-2 ); + Append( slp, instr ); + + # If d is Odd: Conjugate the last Ti (eq (8)) + for ell in [ 1..f ] do + Add( slp, [ [ AEMrespos,1, Tipos[ell],1, AEMrespos,-1 ], + Tipos[ell] ] ); + od; + else + if i = 3 then + # Compute T3 differently (eq (7)) + for ell in [ 1..f ] do + # Copy what is in Ti into Ti_1 + Add(slp, [ [Tipos[ell],1], Ti_1pos[ell] ] ); + # Write the new instruction to compute Ti + Add( slp, [ [ vxipos,1, Tipos[ell],1, vxpos,1], + Tipos[ell] ] ); + od; + elif IsOddInt(i) then + + #T_i = v^-(i-3)/2*T_3*v^(i-3)/2 + #T_i-1=v^-(i-3)/2*T_2*v^(i-3)/2 + + #Set T3 and T2 in Position + for ell in [ 1..f ] do + # Copy what is in Ti into Ti_1 + Add(slp, [[Tipos[ell],1],Ti_1pos[ell]] ); + # Write the new instruction to compute Ti + Add( slp, [ [ vxipos,1, Tipos[ell],1, vxpos,1], + Tipos[ell] ] ); + od; + + instr := AEM(4,AEMrespos,tmppos,(i-3)/2); + Append( slp, instr ); + # now AEMrespos knows v^(i-3)/2 + + for ell in [ 1..f ] do + + Add( slp, [ [ AEMrespos,-1, Tipos[ell],1, AEMrespos,1], + Tipos[ell] ] ); + + Add( slp, [ [ AEMrespos,-1, Ti_1pos[ell],1, AEMrespos,1], + Ti_1pos[ell] ] ); + od; + + else + + #T_i = v^-(i-2)/2*T_2*v^(i-2)/2 + #T_i-1=v* v^-(i-2)/2*T_3*v^(i-2)/2* v^-1 + #So save t_3 in Ti_1pos + for ell in [ 1..f ] do + Add( slp, [ [ vxipos,1, Tipos[ell],1, vxpos,1], + Ti_1pos[ell] ] ); + od; + + # and compute v^(i-2)/2 + instr := AEM(4,AEMrespos,tmppos,(i-2)/2); + Append( slp, instr ); + + for ell in [ 1..f ] do + Add( slp, [ [ AEMrespos,-1, Tipos[ell],1, AEMrespos,1], + Tipos[ell] ] ); + + Add( slp, [ [ AEMrespos,-1, Ti_1pos[ell],1, AEMrespos,1], + Ti_1pos[ell] ] ); + + Add( slp, [ [ 4,1, Ti_1pos[ell],1, 9,1], Ti_1pos[ell] ] ); + od; + fi; + fi; + + end; + + ##### + # BackShiftTransvections() + ##### + + # This function is very similar to ShiftTransvections, + # except it works in the reverse order, namely + # BackShiftTransvections computes t{(i+1)i} + # given t_{(i+2)i} and t_{(i+3)(i+2)} + + BackShiftTransvections := function(i) + + local ell; + + if IsOddInt(d) then + # for odd d we have to conjugate the previous Ti by v + for ell in [ 1..f ] do + Add(slp, [[ 9,1, Tipos[ell],1, 4,1], Tipos[ell]]); + od; + else + if i = 1 then + # We compute T3 differently + for ell in [ 1..f ] do + + Add( slp, [ [Tipos[ell],1], tmppos ] ); + # write the new instruction to compute Ti + Add( slp, [ [ vxpos,1, Tipos[ell],1, vxipos,1], + Tipos[ell] ] ); + # copy what is in tmppos into Ti_1 + Add(slp, [[tmppos,1],Ti_1pos[ell]] ); + od; + else + # for even d we have to conjugate the 2nd last Ti + for ell in [ 1..f ] do + + # copy the instruction in Ti into the tmp position + Add(slp,[[Tipos[ell],1], tmppos]); + # now conjugate T_{i+1} by v and write into Tipos + Add( slp, [ [ 4,1, Ti_1pos[ell],1, 9,1], + Tipos[ell] ] ); + + Add( slp, [ [tmppos,1], Ti_1pos[ell] ] ); + od; + fi; + fi; + end; + + ##### + # FastBackShiftTransvections() + ##### + + # As for ShiftTransvections, we need an efficient way to compute + # BackShiftTransvections multiple times in a row. + + FastBackShiftTransvections := function(i) + + local ell; + + if IsOddInt( d ) then + + instr := AEM( 4, AEMrespos, tmppos, i - d + 1 ); + Append( slp, instr ); + + # If d is Odd: Conjugate the last Ti (eq (8)) + for ell in [ 1..f ] do + + Add( slp, [ [ AEMrespos,1, Tipos[ell],1, AEMrespos,-1 ], + Tipos[ell] ] ); + od; + else + # The case i = 1 cant occur in our implementation + if IsOddInt(i) then + + instr := AEM( 4, AEMrespos, tmppos, (i-d+1)/2 ); + Append( slp, instr ); + + for ell in [ 1..f ] do + + Add( slp, [ [ AEMrespos,-1, Tipos[ell],1, AEMrespos,1], + Tipos[ell] ] ); + + Add( slp, [ [ AEMrespos,-1, Ti_1pos[ell],1, AEMrespos,1], + Ti_1pos[ell] ] ); + od; + else + for ell in [ 1..f ] do + + Add( slp, [ [ Tipos[ell],1 ], tmppos ] ); + Add( slp, [ [ Ti_1pos[ell],1], Tipos[ell] ] ); + Add(slp,[ [ tmppos,1 ], Ti_1pos[ell] ] ); + od; + + instr := AEM( 4, AEMrespos, tmppos, (d-c)/2 ); + Append( slp, instr ); + + for ell in [ 1..f ] do + Add( slp, [ [ AEMrespos,1, Tipos[ell],1, AEMrespos,-1], + Tipos[ell] ] ); + + Add( slp, [ [ AEMrespos,1, Ti_1pos[ell],1, AEMrespos,-1], + Ti_1pos[ell] ] ); + + Add( slp, [ [ 9,1, Ti_1pos[ell],1, 4,1], Ti_1pos[ell] ] ); + od; + + fi; + fi; + + end; + +# ############ +# Back to Function +# ############ + + if Length( arg ) >= 2 and IsList( arg[1] ) and IsMatrix( arg[2] ) then + + stdgens := arg[1]; # the LGO standard generators + g := arg[2]; + + if Length( stdgens ) < 1 or not IsMatrix( stdgens[1] ) then + + Error("first argument must be the LGO standard generators"); + return; + fi; + + if not IsMatrix( g ) then + Error("second argument must be a matrix"); return; + fi; + else + Error("input: LGO standard generators and a matrix"); + return; + fi; + + if Length(arg) = 3 then + + # The first 10 entries are the stdgens and their inverses + slp := arg[3]; + + if not IsList(slp) then + Error("third argument must be a list"); + return; + fi; + else + # We write an SLP into the variable slp + # The first 10 entries are the stdgens and the inverses + # s, t, del, v, x, s^-1, t^-1, del^-1, v^-1, x^-1 + slp := [ [1,1], [2,1], [3,1], [4,1], [5,1], + [1,-1],[2,-1],[3,-1],[4,-1],[5,-1] ]; + fi; + + # the matrix + d := Length( g ); + fld := FieldOfMatrixList( stdgens ); + + # To create an MSLP, we allocate all the memory needed at the beginning. + Add( slp, [1,0] ); tmppos := Length(slp); #11 + Add( slp, [1,0] ); AEMrespos := Length(slp); #12 + Add( slp,[4,1,10,1]); vxpos := Length(slp); #13 v*x^-1 + Add( slp, [13,-1] ); vxipos := Length(slp); #14 (v*x^-1)^-1 + Add( slp, [1,0] ); u1pos := Length(slp); #15 + Add( slp, [1,0] ); u2pos := Length(slp); #16 + Add( slp, [1,0] ); tir1pos := Length(slp); #17 + Add( slp, [1,0] ); tirzpos := Length(slp); #18 + Add( slp, [1,0] ); tvpos := Length(slp); #19 + + # To save two slots of we allow two slots to be used by each two values + # This does not create a conflict and increases the readability + tcj1pos :=17; tcjzpos :=18; + + u1 := MutableCopyMat( One(g) ); + u2 := MutableCopyMat( One(g) ); + + # If g is already a monomial matrix return u_1 = u_2 = I_d + if TestIfMonomial( g ) then + Add( slp, [ [1,0],[1,0] ] ); + return [ slp, [u1,g,u2] ]; + fi; + + f := LogInt(Size(fld), Characteristic(fld)); #ie q=p^f + + # We create the space for the T2 := { t_{2,1}(omega^ell)} + # A Call of Transvections2 adds T2 to slp. + T2pos := [ HighestSlotOfSLP(slp)+1 .. HighestSlotOfSLP(slp)+f ]; + + for ell in [ 1..f ] do + Add(slp, [1,0] ); + od; + + slp := Transvections2( stdgens, PrimitiveRoot(fld), slp, T2pos ); + # The positions of the transvections of T2 in slp are now + # in the list T2pos. + # In part. t_{2,1}(w^i) is in position T2pos[i]. + + # Now we create the space for the Ti + Ti_1pos := [ HighestSlotOfSLP(slp)+1 .. HighestSlotOfSLP(slp)+f ]; + + for ell in [ 1..f ] do + Add(slp, [1,0]); + od; + + Tipos := [ HighestSlotOfSLP(slp)+1.. HighestSlotOfSLP(slp)+f ]; + + for ell in [ 1..f ] do + Add(slp, [1,0] ); + od; + + # Up until here the slp and the memory agree. + # From now on we only overwrite existing memory positions. + + Info( InfoBruhat, 2, "Memory Usage is: ",19 + 3*f," memory slots ", + "in UnipotentDecomposition()\n"); + + + ######################## + # This is the usual Bruhat Decomposition + # with additional Transvections + # Changing columns means :changing u1, multiplying transvections + # at u1 from left, compute ShiftTransvections + # Changing rows means :changing u2, multiplying transvections + # at u2 from right, BackShiftTransvections + ######################## + + # We perform something like a GAUSS algorithm + # as described in Taylor with SLPs as in the MSLP paper + + g := MutableCopyMat( g ); + + for c in [ d, d-1..2 ] do + + # Find the first non-zero entry in column c + # g_{r,c} will be the pivot. + j := 1; r := 0; + + while r <= d and j <= d and r = 0 do + + if not IsZero(g[j][c]) then + r := j; + fi; + + j := j + 1; + + od; + + if r = 0 then + Error("matrix has 0 column"); + fi; + + # Step One: Clear all entries in column c apart from g[r][c] + # This coincides with multiplying t_{i,r} from left. + + # Reinitialize Ti and Ti_1 + # Tipos <- { t_{2,1}(\omega^l) }, ti_1pos <- { I_d } + for ell in [ 1..f ] do + Add(slp, [ [1,0], Ti_1pos[ell] ] ); + od; + for ell in [ 1..f ] do + Add(slp, [ [T2pos[ell],1], Tipos[ell] ] ); + od; + + # If r is not the last row, we clear the rest of colum c: + + # First we clear the entry g[r+1][c] + # Thus compute { t_{r,r-1}(\omega^l) } + if r > 2 then + FastShiftTransvections( r ); + fi; + + # Note: If r = d then Tipos= { t_{d,d-1} } and + # there are no entries to clear below row r in column c. + + a := g[r][c]^-1; + + if r <= d-1 then + + # SLP-instructions: Compute { t_{r+1,r}(\omega^l) } + # Save them in Tipos + ShiftTransvections( r+1 ); + + if not IsZero( g[r+1][c] ) then + + z := - g[r+1][c] * a; + + # add z times row r of g to row r+1 + # add z times row r of u1 to row r+1 + g[r+1] := g[r+1] + z * g[r]; + u1[r+1] := u1[r+1] + z * u1[r]; + + # SLP-instructions: Compute t_{r+1,r}(z) (cf Lemma 4.2 p12) + # tvpos <- t_{r+1,r}(z) + TransvecAtAlpha(z); + + # SLP-instructions: u_1 -> t_{r+1,r}(z) * u_1 + Add( slp, [ [tvpos,1, u1pos,1 ], u1pos ] ); + + fi; + + Add(slp, [ [Tipos[1],1],tir1pos ] ); + # we have now cleared the entry in g[r+1][c] + + # Second: Clear the rest of column c + for i in [ r+2..d ] do + + ShiftTransvections( i ); + # Now Ti contains all the Transvections + # \{ t_{i,i-1}(ell) \} + + if not IsZero(g[i][c]) then + + z := -g[i][c] * a; + + # add z times row r of g to row i + # add z times row r of u1 to row i + g[i] := g[i] + z*g[r]; + u1[i] := u1[i] + z*u1[r]; + + # SLP-instructions: Compute t_{i,i-1}(z) (cf Lemma 4.2 p12) + # tvpos <- t_{i,i-1}(z) + TransvecAtAlpha(z); + + # In tir1pos is the value t_{i-1,r}(1) + # SLP-instructions: compute t_{i,r}(z) + instr := [tvpos,-1,tir1pos,-1,tvpos, 1,tir1pos, 1]; + Add( slp, [ instr, tirzpos ] ); # tirz + + # SLP-instructions: u_1 -> t_{i,r}(z) * u_1 + instr := [ tirzpos, 1, u1pos,1]; + Add( slp, [ instr, u1pos ] ); + + fi; + + # SLP-instructions: Iterate t_{i,r}(1) -> t_{i+1,r}(1) + instr := [ Tipos[1],-1, tir1pos,-1, Tipos[1],1, tir1pos,1 ]; + Add(slp, [ instr, tir1pos ] ); + + od; + + fi; # r <= d-1 + + # Step Two: Clear all entries in row r apart from g[r][c] + # This coincides with multiplying t_{c,j} from right. + if c >= 2 then + + # if c = d then Ti already contains t_d(d-1) + # if c <= d-1 then we swap Ti and Ti-1 so that + # initially Ti contains t_(d-1)(d-2) and + # Ti_1 contains t_d(d-1) and then shift back + if IsEvenInt(d) and c <= d-1 then + + for ell in [ 1..f ] do + + Add(slp, [ [ Tipos[ell],1 ], tmppos ] ); + Add(slp, [ [ Ti_1pos[ell],1 ], Tipos[ell] ] ); + Add(slp, [ [ tmppos,1 ], Ti_1pos[ell] ] ); + + od; + + elif c <= d-1 then + BackShiftTransvections( c ); + fi; + + # First we clear the entry g[r][c-1] + # Thus determine SLP-instructions: + # given t_{d-1,d-2} = Tipos, write Tipos <- t_{c,c-1} (d odd) + # resp. + # t_{d-1,d-2} = Tipos Tipos <- t_{c,c-1} + # t_{d,d-1} = Ti_1pos Ti_1pos <- t_{c+1,c} (d even) + if c <= d-2 then + FastBackShiftTransvections(c); + fi; + # Now Tipos = { t_{c,c-1}(\omega^l) } + + if not IsZero( g[r][c-1] ) then + + z := -g[r][c-1] * a; + + # SLP-instructions: Compute t_{c,c-1}(z) (cf Lemma 4.2 p12) + # tvpos <- t_{c,c-1}(z) + TransvecAtAlpha(z); + + # add z times column c of g to column c-1 + # add z times column c of u2 to column c-1 + g{[ 1..d ]}[ c-1 ] := g{[ 1..d ]}[ c-1 ] + z * g{[1..d]}[c]; + u2{[1..d]}[c-1] := u2{[1..d]}[c-1] + z * u2{[1..d]}[c]; + + # SLP-instructions: u_2 -> u_2 * t_{c,c-1}(z) + instr := [ u2pos, 1, tvpos,1]; + Add(slp,[instr, u2pos] ); # u2 overwritten + + fi; + + Add(slp, [ [Tipos[1],1], tcj1pos ] ); + + # If c = d then Ti_1 is not correct yet. + if IsEvenInt(d) and c = d then + for ell in [ 1..f ] do + Add( slp, [ [ Tipos[ell],1 ], tmppos ] ); + Add( slp, [ [ Ti_1pos[ell],1 ], Tipos[ell] ] ); + Add( slp, [ [ tmppos,1 ], Ti_1pos[ell] ] ); + od; + elif c-2 > 0 then + BackShiftTransvections( c-2 ); + fi; + + # Now clear the rest of row r + for j in [ c-2, c-3..1 ] do + + if not IsZero( g[r][j] ) then + + z := - g[r][j] * a; + + # SLP-instructions: Compute t_{j+,j}(z) (cf Lemma 4.2 p12) + # tvpos <- t_{j+1,j}(z) + TransvecAtAlpha(z); + + # SLP-instructions to compute t_{c,j}(z) using (eq (9) p12) + instr := [ tcj1pos,-1, tvpos,-1, tcj1pos,1, tvpos,1 ]; + Add( slp, [ instr,tcjzpos ] ); # tcjz + + # add z times column c of g to column j + # add z times column c of u2 to column j + g{[1..d]}[j] := g{[1..d]}[j] + z * g{[1..d]}[c]; + u2{[1..d]}[j] := u2{[1..d]}[j] + z * u2{[1..d]}[c]; + + # SLP-instructions: u_2 -> u_2 * t_{c,j}(z) + instr := [ u2pos,1, tcjzpos,1 ]; + Add( slp, [ instr, u2pos ] ); + fi; + + # SLP-instructions: Iterate t_{c,j+1}(1) -> t_{c,j}(1) + instr := [ tcj1pos,-1, Tipos[1],-1, tcj1pos,1, Tipos[1],1 ]; + Add(slp, [ instr, tcj1pos ]); + + # SLP-instructions: + # Iterate { t_{j+1,j}(\omega^l) } -> { t_{j,j-1}(\omega^l) } + if j > 1 then + BackShiftTransvections( j ); + fi; + od; + fi; + od; + + ## Add lastline to the slp to display u1 and u2 + ## Thus StraightLineProgram yields [u1,u2] as result + Add( slp, [ [u1pos,1], [u2pos,1] ]); + + # Now u1^-1 * g * u2^-1 is the input matrix + return [slp, [u1, g, u2] ]; + +end +); + + +InstallGlobalFunction( UnipotentDecompositionNC, +function( arg ) + + local stdgens, c, r, i, j, a, z, d, f, ell, fld, u1, u2, g, slp, instr, + tmppos, AEMrespos, vxpos, vxipos, u1pos, u2pos, tvpos, + tir1pos, tirzpos, tcj1pos, tcjzpos, T2pos, Tipos, Ti_1pos, + TransvecAtAlpha, ShiftTransvections, FastShiftTransvections, + BackShiftTransvections, FastBackShiftTransvections; + +# ############### +# Local Functions +# ############### + +# The following five functions are local as they have side effects. +# In particular, they modify the global variables T_i and Ti_1 + + ##### + # TransvectionAtAlpha() + ##### + + # Let alpha in GF(p^f), alpha = Sum a_l omega^l, omega a primitive element + # Let slp be the list of instructions in UnipotentDecomposition and Tipos + # denote the slots where transvections t_{i,j}(omega^ell) 0 <= ell < f + # are saved. This function computes + # t_{i,j}(alpha) = product t_{i,j}(omega^ell)^{a_ell} (see Lemma 4.2) + # where the exponents a_ell are given by CoefficientsPrimitiveElement. + # (For Definition of Transvections see paper p11) + + TransvecAtAlpha := function( alpha ) + + local cc, ell, instr; + + # if omega = 1 then we overwrite the position for tv with Ti(1) + if IsOne( alpha ) then + Add(slp, [ [ Tipos[1], 1 ], tvpos ] ); + return; + fi; + + cc := CoefficientsPrimitiveElement( fld, alpha ); + instr := []; + + for ell in [ 1..Length(cc) ] do + + if not IsZero( cc[ell] ) then + Append( instr, [ Tipos[ell], Int(cc[ell]) ] ); + fi; + od; + + if Length( instr ) = 0 then + Error("TransvecAtAlpha: this should not happen"); + fi; + + Add( slp, [ instr,tvpos ] ); + + return; + + end; + + + ##### + # ShiftTransvections() + ##### + + # Let Ti be the set of transvections { t_{i(i-1)}(omega^ell) } + # and Ti_1 the set of transvections { t_{(i-1)(i-2)}(omega^ell) }. + + # ShiftTransvections computes { t_{i+1,i}(omega^ell) } for given + # Ti and Ti_1 (This coincides with eq(8) p12) + # stores them in the variable Ti and stores + # the transvections { t_{i,i-1}(omega^ell) } in the variable Ti_1. + + # This corresponds to ( eq (7+8) p12 ) + + ShiftTransvections := function( i ) + + local ell; + + # For i = 2: Ti=T2. + if i <= 2 then return; fi; + + if IsOddInt(d) then + # If d is Odd: Conjugate the last Ti (eq (8)) + for ell in [ 1..f ] do + Add( slp, [ [ 4,1, Tipos[ell],1, 9,1], Tipos[ell] ] ); + od; + else + if i = 3 then + # Compute T3 differently (eq (7)) + for ell in [ 1..f ] do + # Copy what is in Ti into Ti_1 + Add(slp, [ [Tipos[ell],1 ], Ti_1pos[ell] ] ); + # Write the new instruction to compute Ti + Add( slp, [ [ vxipos,1, Tipos[ell],1, vxpos,1], + Tipos[ell] ] ); + od; + else + # If d is Even: Conjugate the 2nd last Ti (eq (8)) + for ell in [ 1..f ] do + # Copy the instruction in Ti into tmp position, + Add(slp,[ [ Tipos[ell], 1 ], tmppos ] ); + # conjugate Ti_1 by v and write into Tipos + Add( slp, [ [ 9,1, Ti_1pos[ell],1, 4,1], Tipos[ell] ] ); + Add(slp, [ [tmppos,1], Ti_1pos[ell] ] ); + od; + fi; + fi; + end; + + + ##### + # FastShiftTransvections() + ##### + + # Given t_2,1 we compute t_{i,i-1} using fast exponentation. + # This algorithm will be called in each step of the main loop and + # is more efficient than calling ShiftTransvections (r-2) times. + + FastShiftTransvections := function( i ) + + local ell; + + # For i = 2: Ti=T2. + if i <= 2 then return; fi; + + if IsOddInt( d ) then + + instr := AEM( 4, AEMrespos, tmppos, i-2 ); + Append( slp, instr ); + + # If d is Odd: Conjugate the last Ti (eq (8)) + for ell in [ 1..f ] do + Add( slp, [ [ AEMrespos,1, Tipos[ell],1, AEMrespos,-1 ], + Tipos[ell] ] ); + od; + else + if i = 3 then + # Compute T3 differently (eq (7)) + for ell in [ 1..f ] do + # Copy what is in Ti into Ti_1 + Add(slp, [ [Tipos[ell],1], Ti_1pos[ell] ] ); + # Write the new instruction to compute Ti + Add( slp, [ [ vxipos,1, Tipos[ell],1, vxpos,1], + Tipos[ell] ] ); + od; + elif IsOddInt( i ) then + + #T_i = v^-(i-3)/2*T_3*v^(i-3)/2 + #T_i-1=v^-(i-3)/2*T_2*v^(i-3)/2 + + #Set T3 and T2 in Position + for ell in [ 1..f ] do + # Copy what is in Ti into Ti_1 + Add(slp, [[Tipos[ell],1],Ti_1pos[ell]] ); + # Write the new instruction to compute Ti + Add( slp, [ [ vxipos,1, Tipos[ell],1, vxpos,1], + Tipos[ell] ] ); + od; + + instr := AEM(4,AEMrespos,tmppos,(i-3)/2); + Append( slp, instr ); + # now AEMrespos knows v^(i-3)/2 + + for ell in [ 1..f ] do + + Add( slp, [ [ AEMrespos,-1, Tipos[ell],1, AEMrespos,1], + Tipos[ell] ] ); + + Add( slp, [ [ AEMrespos,-1, Ti_1pos[ell],1, AEMrespos,1], + Ti_1pos[ell] ] ); + od; + + else + + #T_i = v^-(i-2)/2*T_2*v^(i-2)/2 + #T_i-1=v* v^-(i-2)/2*T_3*v^(i-2)/2* v^-1 + #So save t_3 in Ti_1pos + for ell in [ 1..f ] do + Add( slp, [ [ vxipos,1, Tipos[ell],1, vxpos,1], + Ti_1pos[ell] ] ); + od; + + # and compute v^(i-2)/2 + instr := AEM(4,AEMrespos,tmppos,(i-2)/2); + Append( slp, instr ); + + for ell in [ 1..f ] do + Add( slp, [ [ AEMrespos,-1, Tipos[ell],1, AEMrespos,1], + Tipos[ell] ] ); + + Add( slp, [ [ AEMrespos,-1, Ti_1pos[ell],1, AEMrespos,1], + Ti_1pos[ell] ] ); + + Add( slp, [ [ 4,1, Ti_1pos[ell],1, 9,1], Ti_1pos[ell] ] ); + od; + fi; + fi; + + end; + + + ##### + # BackShiftTransvections() + ##### + + # This function is very similar to ShiftTransvections, + # except it works in the reverse order, namely + # BackShiftTransvections computes t{(i+1)i} + # given t_{(i+2)i} and t_{(i+3)(i+2)} + + BackShiftTransvections := function( i ) + + local ell; + + if IsOddInt(d) then + # for odd d we have to conjugate the previous Ti by v + for ell in [ 1..f ] do + Add(slp, [[ 9,1, Tipos[ell],1, 4,1], Tipos[ell] ] ); + od; + else + if i = 1 then + # We compute T3 differently + for ell in [ 1..f ] do + + Add( slp, [ [Tipos[ell],1], tmppos ] ); + # write the new instruction to compute Ti + Add( slp, [ [ vxpos,1, Tipos[ell],1, vxipos,1], + Tipos[ell] ] ); + # copy what is in tmppos into Ti_1 + Add(slp, [ [ tmppos,1 ], Ti_1pos[ell] ] ); + od; + else + # for even d we have to conjugate the 2nd last Ti + for ell in [ 1..f ] do + + # copy the instruction in Ti into the tmp position + Add(slp,[[Tipos[ell],1], tmppos]); + # now conjugate T_{i+1} by v and write into Tipos + Add( slp, [ [ 4,1, Ti_1pos[ell],1, 9,1], + Tipos[ell] ] ); + + Add( slp, [ [ tmppos,1 ], Ti_1pos[ell] ] ); + od; + fi; + fi; + end; + + + ##### + # FastBackShiftTransvections() + ##### + + # As for ShiftTransvections, we need an efficient way to compute + # BackShiftTransvections multiple times in a row. + + FastBackShiftTransvections := function( i ) + + local ell; + + if IsOddInt( d ) then + + instr := AEM( 4, AEMrespos, tmppos, i - d + 1 ); + Append( slp, instr ); + + # If d is Odd: Conjugate the last Ti (eq (8)) + for ell in [ 1..f ] do + + Add( slp, [ [ AEMrespos,1, Tipos[ell],1, AEMrespos,-1 ], + Tipos[ell] ] ); + od; + else + # The case i = 1 cant occur in our implementation + if IsOddInt( i ) then + + instr := AEM( 4, AEMrespos, tmppos, (i-d+1)/2 ); + Append( slp, instr ); + + for ell in [ 1..f ] do + + Add( slp, [ [ AEMrespos,-1, Tipos[ell],1, AEMrespos,1], + Tipos[ell] ] ); + + Add( slp, [ [ AEMrespos,-1, Ti_1pos[ell],1, AEMrespos,1], + Ti_1pos[ell] ] ); + od; + else + for ell in [ 1..f ] do + + Add( slp, [ [ Tipos[ell],1 ], tmppos ] ); + Add( slp, [ [ Ti_1pos[ell],1], Tipos[ell] ] ); + Add(slp,[ [ tmppos,1 ], Ti_1pos[ell] ] ); + od; + + instr := AEM( 4, AEMrespos, tmppos, (d-c)/2 ); + Append( slp, instr ); + + for ell in [ 1..f ] do + Add( slp, [ [ AEMrespos,1, Tipos[ell],1, AEMrespos,-1], + Tipos[ell] ] ); + + Add( slp, [ [ AEMrespos,1, Ti_1pos[ell],1, AEMrespos,-1], + Ti_1pos[ell] ] ); + + Add( slp, [ [ 9,1, Ti_1pos[ell],1, 4,1], Ti_1pos[ell] ] ); + od; + + fi; + fi; + + end; + +# ############ +# Back to Function +# ############ + + stdgens := arg[1]; # the LGO standard generators + g := arg[2]; + + if Length( arg ) = 3 then + + # The first 10 entries are the stdgens and their inverses + slp := arg[3]; + + else + # We write an SLP into the variable slp + # The first 10 entries are the stdgens and the inverses + # s, t, del, v, x, s^-1, t^-1, del^-1, v^-1, x^-1 + slp := [ [1,1], [2,1], [3,1], [4,1], [5,1], + [1,-1],[2,-1],[3,-1],[4,-1],[5,-1] ]; + fi; + + # the matrix + d := Length( g ); + fld := FieldOfMatrixList( stdgens ); + + # To create an MSLP, we allocate all the memory needed at the beginning. + Add( slp, [1,0] ); tmppos := Length(slp); #11 + Add( slp, [1,0] ); AEMrespos := Length(slp); #12 + Add( slp,[4,1,10,1]); vxpos := Length(slp); #13 v*x^-1 + Add( slp, [13,-1] ); vxipos := Length(slp); #14 (v*x^-1)^-1 + Add( slp, [1,0] ); u1pos := Length(slp); #15 + Add( slp, [1,0] ); u2pos := Length(slp); #16 + Add( slp, [1,0] ); tir1pos := Length(slp); #17 + Add( slp, [1,0] ); tirzpos := Length(slp); #18 + Add( slp, [1,0] ); tvpos := Length(slp); #19 + + # To save two slots of we allow two slots to be used by each two values + # This does not create a conflict and increases the readability + tcj1pos :=17; tcjzpos :=18; + + u1 := MutableCopyMat( One(g) ); + u2 := MutableCopyMat( One(g) ); + + # If g is already a monomial matrix return u_1 = u_2 = I_d + if TestIfMonomialNC( g ) then + Add( slp, [ [u1pos,1], [u2pos,1] ] ); + return [ slp, [u1,g,u2] ]; + fi; + + f := LogInt(Size(fld), Characteristic(fld)); #ie q=p^f + + # We create the space for the T2 := { t_{2,1}(omega^ell)} + # A Call of Transvections2 adds T2 to slp. + T2pos := [ HighestSlotOfSLP(slp)+1 .. HighestSlotOfSLP(slp)+f ]; + + for ell in [ 1..f ] do + Add(slp, [1,0] ); + od; + + slp := Transvections2( stdgens, PrimitiveElement(fld), slp, T2pos ); + # The positions of the transvections of T2 in slp are now + # in the list T2pos. + # In part. t_{2,1}(w^i) is in position T2pos[i]. + + # Now we create the space for the Ti + Ti_1pos := [ HighestSlotOfSLP(slp)+1 .. HighestSlotOfSLP(slp)+f ]; + + for ell in [ 1..f ] do + Add(slp, [1,0]); + od; + + Tipos := [ HighestSlotOfSLP(slp)+1.. HighestSlotOfSLP(slp)+f ]; + + for ell in [ 1..f ] do + Add(slp, [1,0] ); + od; + + # Up until here the slp and the memory agree. + # From now on we only overwrite existing memory positions. + + Info( InfoBruhat, 2, "Memory Usage is: ",19 + 3*f," memory slots ", + "in UnipotentDecomposition()\n"); + + + ######################## + # This is the usual Bruhat Decomposition + # with additional Transvections + # Changing columns means :changing u1, multiplying transvections + # at u1 from left, compute ShiftTransvections + # Changing rows means :changing u2, multiplying transvections + # at u2 from right, BackShiftTransvections + ######################## + + # We perform something like a GAUSS algorithm + # as described in Taylor with SLPs as in the MSLP paper + + g := MutableCopyMat( g ); + + for c in [ d,d-1..2 ] do + + # Find the first non-zero entry in column c + # g_{r,c} will be the pivot. + j := 1; r := 0; + + while r <= d and j <= d and r = 0 do + + if not IsZero( g[j][c] ) then + r := j; + fi; + + j := j + 1; + + od; + + if r = 0 then + Error("matrix has 0 column"); + fi; + + # Step One: Clear all entries in column c apart from g[r][c] + # This coincides with multiplying t_{i,r} from left. + + # Reinitialize Ti and Ti_1 + # Tipos <- { t_{2,1}(\omega^l) }, ti_1pos <- { I_d } + for ell in [ 1..f ] do + Add(slp, [ [1,0], Ti_1pos[ell] ] ); + od; + for ell in [ 1..f ] do + Add(slp, [ [ T2pos[ell],1 ], Tipos[ell] ] ); + od; + + # If r is not the last row, we clear the rest of colum c: + + # First we clear the entry g[r+1][c] + # Thus compute { t_{r,r-1}(\omega^l) } + if r > 2 then + FastShiftTransvections( r ); + fi; + + # Note: If r = d then Tipos= { t_{d,d-1} } and + # there are no entries to clear below row r in column c. + + a := g[r][c]^-1; + + if r <= d-1 then + + # SLP-instructions: Compute { t_{r+1,r}(\omega^l) } + # Save them in Tipos + ShiftTransvections( r+1 ); + + if not IsZero( g[r+1][c] ) then + + z := - g[r+1][c] * a; + + # add z times row r of g to row r+1 + # add z times row r of u1 to row r+1 + g[r+1] := g[r+1] + z * g[r]; + u1[r+1] := u1[r+1] + z * u1[r]; + + # SLP-instructions: Compute t_{r+1,r}(z) (cf Lemma 4.2 p12) + # tvpos <- t_{r+1,r}(z) + TransvecAtAlpha(z); + + # SLP-instructions: u_1 -> t_{r+1,r}(z) * u_1 + Add( slp, [ [tvpos,1, u1pos,1 ], u1pos ] ); + + fi; + + Add(slp, [ [ Tipos[1],1 ], tir1pos ] ); + # we have now cleared the entry in g[r+1][c] + + # Second: Clear the rest of column c + for i in [ r+2..d ] do + + ShiftTransvections( i ); + # Now Ti contains all the Transvections + # \{ t_{i,i-1}(ell) \} + + if not IsZero(g[i][c]) then + + z := -g[i][c] * a; + + # add z times row r of g to row i + # add z times row r of u1 to row i + g[i] := g[i] + z * g[r]; + u1[i] := u1[i] + z * u1[r]; + + # SLP-instructions: Compute t_{i,i-1}(z) (cf Lemma 4.2 p12) + # tvpos <- t_{i,i-1}(z) + TransvecAtAlpha(z); + + # In tir1pos is the value t_{i-1,r}(1) + # SLP-instructions: compute t_{i,r}(z) + instr := [tvpos,-1,tir1pos,-1,tvpos, 1,tir1pos, 1]; + Add( slp, [ instr, tirzpos ] ); # tirz + + # SLP-instructions: u_1 -> t_{i,r}(z) * u_1 + instr := [ tirzpos, 1, u1pos,1]; + Add( slp, [ instr, u1pos ] ); + + fi; + + # SLP-instructions: Iterate t_{i,r}(1) -> t_{i+1,r}(1) + instr := [ Tipos[1],-1, tir1pos,-1, Tipos[1],1, tir1pos,1 ]; + Add(slp, [ instr, tir1pos ] ); + + od; + + fi; # r <= d-1 + + # Step Two: Clear all entries in row r apart from g[r][c] + # This coincides with multiplying t_{c,j} from right. + if c >= 2 then + + # if c = d then Ti already contains t_d(d-1) + # if c <= d-1 then we swap Ti and Ti-1 so that + # initially Ti contains t_(d-1)(d-2) and + # Ti_1 contains t_d(d-1) and then shift back + if IsEvenInt(d) and c <= d-1 then + + for ell in [ 1..f ] do + + Add(slp, [ [ Tipos[ell],1 ], tmppos ] ); + Add(slp, [ [ Ti_1pos[ell],1 ], Tipos[ell] ] ); + Add(slp, [ [ tmppos,1 ], Ti_1pos[ell] ] ); + + od; + + elif c <= d-1 then + BackShiftTransvections( c ); + fi; + + # First we clear the entry g[r][c-1] + # Thus determine SLP-instructions: + # given t_{d-1,d-2} = Tipos, write Tipos <- t_{c,c-1} (d odd) + # resp. + # t_{d-1,d-2} = Tipos Tipos <- t_{c,c-1} + # t_{d,d-1} = Ti_1pos Ti_1pos <- t_{c+1,c} (d even) + if c <= d-2 then + FastBackShiftTransvections( c ); + fi; + # Now Tipos = { t_{c,c-1}(\omega^l) } + + if not IsZero( g[r][c-1] ) then + + z := -g[r][c-1] * a; + + # SLP-instructions: Compute t_{c,c-1}(z) (cf Lemma 4.2 p12) + # tvpos <- t_{c,c-1}(z) + TransvecAtAlpha(z); + + # add z times column c of g to column c-1 + # add z times column c of u2 to column c-1 + g{[1..d]}[ c-1 ] := g{[1..d]}[ c-1 ] + z * g{[ 1..d ]}[c]; + u2{[1..d]}[ c-1 ] := u2{[1..d]}[ c-1 ] + z * u2{[ 1..d ]}[c]; + + # SLP-instructions: u_2 -> u_2 * t_{c,c-1}(z) + instr := [ u2pos, 1, tvpos,1]; + Add( slp, [ instr, u2pos ] ); # u2 overwritten + + fi; + + Add(slp, [ [Tipos[1],1], tcj1pos ] ); + + # If c = d then Ti_1 is not correct yet. + if IsEvenInt( d ) and c = d then + for ell in [ 1..f ] do + Add( slp, [ [ Tipos[ell],1 ], tmppos ] ); + Add( slp, [ [ Ti_1pos[ell],1 ], Tipos[ell] ] ); + Add( slp, [ [ tmppos,1 ], Ti_1pos[ell] ] ); + od; + elif c-2 > 0 then + BackShiftTransvections( c-2 ); + fi; + + # Now clear the rest of row r + for j in [ c-2, c-3..1 ] do + + if not IsZero( g[r][j] ) then + + z := - g[r][j] * a; + + # SLP-instructions: Compute t_{j+,j}(z) (cf Lemma 4.2 p12) + # tvpos <- t_{j+1,j}(z) + TransvecAtAlpha(z); + + # SLP-instructions to compute t_{c,j}(z) using (eq (9) p12) + instr := [ tcj1pos,-1, tvpos,-1, tcj1pos,1, tvpos,1 ]; + Add( slp, [ instr,tcjzpos ] ); # tcjz + + # add z times column c of g to column j + # add z times column c of u2 to column j + g{[1..d]}[j] := g{[1..d]}[j] + z * g{[1..d]}[c]; + u2{[1..d]}[j] := u2{[1..d]}[j] + z * u2{[1..d]}[c]; + + # SLP-instructions: u_2 -> u_2 * t_{c,j}(z) + instr := [ u2pos,1, tcjzpos,1 ]; + Add( slp, [ instr, u2pos ] ); + fi; + + # SLP-instructions: Iterate t_{c,j+1}(1) -> t_{c,j}(1) + instr := [ tcj1pos,-1, Tipos[1],-1, tcj1pos,1, Tipos[1],1 ]; + Add(slp, [ instr, tcj1pos ]); + + # SLP-instructions: + # Iterate { t_{j+1,j}(\omega^l) } -> { t_{j,j-1}(\omega^l) } + if j > 1 then + BackShiftTransvections( j ); + fi; + od; + fi; + od; + + ## Add lastline to the slp to display u1 and u2 + ## Thus StraightLineProgram yields [u1,u2] as result + Add( slp, [ [u1pos,1], [u2pos,1] ]); + + # Now u1^-1 * g * u2^-1 is the input matrix + return [slp, [u1, g, u2] ]; + +end +); + + + +#################### +# PART II - b) +# Basically the same as in II - a) +# But now we save all Transvections +#################### + +# Compute the Bruhat decomposition of the matrix g, given +# the standard generators for the group. +# In this version we will store all the transvections t_i,i-1(w^l). +# this will increase the memory usage by (d-3)*f but reduce runtime + +InstallGlobalFunction( UnipotentDecompositionWithTi, +function(arg) + + local stdgens, c, r, i, j, a, z, f, ell, fld, d, slp, instr, lastline, + u1, u2, g, Tipos, u1pos, u2pos, tir1pos, tirzpos, tcj1pos, + tcjzpos, tvpos, T2pos, vxpos, vxipos, + TransvectionAtAlpha, ComputeAllTransvections; + + +# ############### +# Local Functions +# ############### + + ##### + # TransvectionAtAlpha() + ##### + + # Let alpha in GF(p^f), alpha = sum a_ell omega^ell + # where omega is a primitive element + # Suppose further that Tipos is a list of transvections + # of the form { t_{i,i-1}(omega^l) }, 2 <= i <= d, 0 <= ell < f. + # Then this function computes t_{i,i-1}( alpha ) by (Lemma 4.2) + # And saves the result in tvpos. + + TransvectionAtAlpha := function( i, alpha ) + + local cc, ell; + + if IsOne( alpha ) then + Add( slp , [ [Tipos[i][1],1] , tvpos ] ); + return true; + fi; + + cc := CoefficientsPrimitiveElement( fld, alpha ); + instr := []; + + for ell in [ 1..Length(cc) ] do + + if not IsZero( cc[ell] ) then + Append( instr, [ Tipos[i][ell], Int( cc[ell] ) ] ); + fi; + od; + + Add( slp, [ instr, tvpos ] ); + + return true; + + end; + + ##### + # ComputeAllTransvections() + ##### + + ## We first compute all the Ti for i >= 3 and add them to the SLP + ## This are eq (7) and (8) p12 + ## Used instead of Schift- and BackshiftTransvections + + ComputeAllTransvections := function() + + local i; + + for i in [ 3..d ] do + + if IsOddInt( d ) then + # If d is Odd: Conjugate the previous Ti + for ell in [ 1..f ] do + Add(slp,[ [4,1, Tipos[i-1][ell],1, 9,1], + Tipos[i][ell] ] ); + od; + elif i = 3 then + # Compute T3 differently + for ell in [ 1..f ] do + Add( slp, [ [ vxipos,1, Tipos[i-1][ell],1, vxpos,1], + Tipos[3][ell] ] ); + od; + else + # If d is Even: Conjugate the 2nd last Ti + for ell in [ 1..f ] do + Add( slp , [ [ 9,1, Tipos[i-2][ell],1, 4,1 ], + Tipos[i][ell] ] ); + od; + fi; + + od; + end; + +# ############### +# Back to Function +# ############### + + if Length(arg) >= 2 and IsList(arg[1]) and IsMatrix(arg[2]) then + + stdgens := arg[1]; # the LGO standard generators + g := arg[2]; + + if Length(stdgens) < 1 or not IsMatrix( stdgens[1]) then + Error("first argument must be the LGO standard generators"); + return; + fi; + + if not IsMatrix( g ) then + Error("second argument must be a matrix"); + return; + fi; + else + + Error("input: LGO standard generators and a matrix"); + return; + fi; + + if Length(arg) = 3 then + + # The first 10 entries are the stdgens and their inverses + slp := arg[3]; + if not IsList(slp) then + Error("third argument must be a list"); + return; + fi; + else + # we write an SLP into the variable slp + # The first 10 entries are the stdgens and inverses + # s, t, del, v, x, s^-1, t^-1, del^-1, v^-1, x^-1 + slp := [ [1,1], [2,1], [3,1], [4,1], [5,1], + [1,-1],[2,-1],[3,-1],[4,-1],[5,-1] ]; + fi; + + # the matrix + g := MutableCopyMat(g); #ie Matrix can be modified + d := Length(g); + fld := FieldOfMatrixList(stdgens); + + # To create a MSLP, we allocate all the memory needed at the beginning. + Add( slp, [4,1,10,1]); vxpos := Length(slp); #11 v*x^-1 + Add( slp, [11,-1]); vxipos := Length(slp); #12 (v*x^-1)^-1 + Add( slp, [1,0] ); u1pos := Length(slp); #13 + Add( slp, [1,0] ); u2pos := Length(slp); #14 + Add( slp, [1,0] ); tvpos := Length(slp); #15 + + # The implementation allows us to use the same slot for different purposes + tir1pos := 11; tirzpos := 12; + tcj1pos := 11; tcjzpos := 12; + + # u1,u2 coincide with the Input used in paper p16 Alg1. + u1 := MutableCopyMat( One(g)); #Copy of id_dxd + u2 := MutableCopyMat( One(g)); #Copy of id_dxd + + # add lastline to the slp to display the memory contents u1,u2 + lastline := [ [u1pos,1], [u2pos,1] ]; + + f := LogInt( Size(fld), Characteristic(fld) ); + + # now we create the space for the T2 \{ t_{2,1}(w^l) \} + T2pos := [ HighestSlotOfSLP(slp)+1 .. HighestSlotOfSLP(slp)+f ]; + + for ell in [ 1..f ] do + Add(slp, [1,0] ); + od; + + slp := Transvections2( stdgens, PrimitiveElement(fld), slp, T2pos ); + # Now slp computes T2 and the positions of the transvections + # of T2 in the slp are in the list T2pos + # now we create the space for all of the other Ti + Tipos := []; + Tipos[2] := T2pos; + + for i in [3 .. d] do + + Tipos[i] := [ HighestSlotOfSLP(slp)+1..HighestSlotOfSLP(slp)+f ]; + + for ell in [1 .. f] do + Add(slp, [1,0]); + od; + od; + + # Up until here the slp and the memory agree. + # From now on we only overwrite existing memory positions. + Info( InfoBruhat, 2, "Memory Usage is: ",HighestSlotOfSLP(slp)," memory slots ", + "in UnipotentDecompositionWithTi()\n"); + + ComputeAllTransvections(); + + # Now we don't need vxpos and vxipos again, + # we now use the slots alternating for tir1pos and tirzpos resp. + # for tcj1pos and tcjzpos + + for i in [ 2..d ] do + Append( lastline, List( Tipos[i], j -> [j,1] )); + od; + + # As described in the MSLP paper + # We perform something like a GAUSS algorithm + + for c in [ d, d-1..2 ] do + + # find the first non-zero entry in column c + j := 1; r := 0; + while r <= d and r = 0 do + + if not IsZero( g[j][c] ) then + r := j; + fi; + + j := j + 1; + od; + + # Now we clear all entries in column c apart from g[r][c] + # if r is not the last row, we clear the rest of colum c + # first we clear the entry g[r+1][c] + + a := g[r][c]^-1; + + if r <= d-1 then + + if not IsZero( g[r+1][c] ) then + + z := - g[r+1][c] * a; + + TransvectionAtAlpha( r+1, z ); + + # add z times row r of g to row r+1 + # add z times row r of u1 to row r+1 + g[r+1] := g[r+1] + z * g[r]; + u1[r+1] := u1[r+1] + z * u1[r]; + # This is just Gauß: + + Add(slp, [ [tvpos,1, u1pos, 1], u1pos] ); + fi; + + Add( slp, [ [Tipos[r+1][1],1], tir1pos ] ); + # we have now cleared the entry in g[r+1][c] + + # Now clear the rest of column c + for i in [ r+2..d ] do + if not IsZero( g[i][c] ) then + + z := -g[i][c] * a; + + TransvectionAtAlpha(i, z ); + + instr := [ tvpos,-1, tir1pos,-1, + tvpos,1, tir1pos,1 ]; + Add(slp,[instr,tirzpos]); # tirz + + # add z times row r of g to row i + # add z times row r of u1 to row i + g[i] := g[i] + z * g[r]; + u1[i] := u1[i] + z * u1[r]; + + instr := [ tirzpos, 1, u1pos,1]; + Add(slp,[instr, u1pos] ); + + + fi; + + # get tir1 ready for the next i + instr := [ Tipos[i][1],-1,tir1pos,-1, + Tipos[i][1],1,tir1pos,1 ]; + + Add(slp, [instr,tir1pos]); + od; + fi; # r <= d-1 + + # Next we clear row r apart from g[r][c] + if c >= 2 then + # if c = d then Ti already contains t_d(d-1) + # if c <= d-1 then we swap Ti and Ti-1 so that + # initially Ti contains t_(d-1)(d-2) and + # Ti_1 contains t_d(d-1) and then shift back + # now Ti contains t_c(c-1) + if not IsZero( g[r][c-1] ) then + + z := - g[r][c-1] * a; + + TransvectionAtAlpha( c, z ); + + # Add z times column c of g to column c-1, + # add z times column c of u2 to column c-1 + g{[1..d]}[c-1] := g{[1..d]}[c-1] + z * g{[1..d]}[c]; + u2{[1..d]}[c-1] := u2{[1..d]}[c-1] + z * u2{[1..d]}[c]; + + # Copy this in slp + instr := [ u2pos, 1, tvpos,1]; + Add(slp,[instr, u2pos] ); # u2 overwritten + + + + fi; + Add(slp, [ [Tipos[c][1],1 ], tcj1pos ] ); + + # Now clear the rest of row r + for j in [ c-2, c-3..1 ] do + + if not IsZero( g[r][j] ) then + + z := - g[r][j] * a; + + TransvectionAtAlpha( j+1, z ); + + instr := [ tcj1pos,-1, tvpos,-1, tcj1pos,1, tvpos,1 ]; + Add(slp, [instr,tcjzpos] ); # tcjz + + # add z times column c of g to column j + # add z times column c of u2 to column j + g{[1..d]}[j] := g{[1..d]}[j] + z*g{[1..d]}[c]; + u2{[1..d]}[j] := u2{[1..d]}[j] + z*u2{[1..d]}[c]; + + instr := [ u2pos, 1, tcjzpos,1]; + Add( slp, [instr, u2pos] ); # u2 overwritten + + fi; + + # get tcj1 ready for the next iteration + instr := [tcj1pos,-1, Tipos[j+1][1],-1, + tcj1pos,1, Tipos[j+1][1],1 ]; + Add( slp, [ instr, tcj1pos ] ); + od; + fi; + od; + + Add( slp, lastline ); + + return [slp, [u1, g, u2] ]; + +end +); + + +InstallGlobalFunction( UnipotentDecompositionWithTiNC, +function( arg ) + + local stdgens, c, r, i, j, a, z, f, ell, fld, d, slp, instr, lastline, + u1, u2, g, Tipos, u1pos, u2pos, tir1pos, tirzpos, tcj1pos, + tcjzpos, tvpos, T2pos, vxpos, vxipos, + TransvectionAtAlpha, ComputeAllTransvections; + + +# ############### +# Local Functions +# ############### + + ##### + # TransvectionAtAlpha() + ##### + + # Let alpha in GF(p^f), alpha = sum a_ell omega^ell + # where omega is a primitive element + # Suppose further that Tipos is a list of transvections + # of the form { t_{i,i-1}(omega^l) }, 2 <= i <= d, 0 <= ell < f. + # Then this function computes t_{i,i-1}( alpha ) by (Lemma 4.2) + # And saves the result in tvpos. + + TransvectionAtAlpha := function( i, alpha ) + + local cc, ell; + + if IsOne( alpha ) then + Add( slp , [ [Tipos[i][1],1] , tvpos ] ); + return true; + fi; + + cc := CoefficientsPrimitiveElement( fld, alpha ); + instr := []; + + for ell in [ 1..Length(cc) ] do + + if not IsZero( cc[ell] ) then + Append( instr, [ Tipos[i][ell], Int( cc[ell] ) ] ); + fi; + od; + + Add( slp, [ instr, tvpos ] ); + + return true; + + end; + + ##### + # ComputeAllTransvections() + ##### + + ## We first compute all the Ti for i >= 3 and add them to the SLP + ## This are eq (7) and (8) p12 + ## Used instead of Schift- and BackshiftTransvections + + ComputeAllTransvections := function() + + local i; + + for i in [ 3..d ] do + + if IsOddInt( d ) then + # If d is Odd: Conjugate the previous Ti + for ell in [ 1..f ] do + Add(slp,[ [4,1, Tipos[i-1][ell],1, 9,1], + Tipos[i][ell] ] ); + od; + elif i = 3 then + # Compute T3 differently + for ell in [ 1..f ] do + Add( slp, [ [ vxipos,1, Tipos[i-1][ell],1, vxpos,1], + Tipos[3][ell] ] ); + od; + else + # If d is Even: Conjugate the 2nd last Ti + for ell in [ 1..f ] do + Add( slp , [ [ 9,1, Tipos[i-2][ell],1, 4,1 ], + Tipos[i][ell] ] ); + od; + fi; + + od; + end; + +# ############### +# Back to Function +# ############### + + stdgens := arg[1]; # the LGO standard generators + g := arg[2]; + + if Length(arg) = 3 then + + # The first 10 entries are the stdgens and their inverses + slp := arg[3]; + + else + # we write an SLP into the variable slp + # The first 10 entries are the stdgens and inverses + # s, t, del, v, x, s^-1, t^-1, del^-1, v^-1, x^-1 + slp := [ [1,1], [2,1], [3,1], [4,1], [5,1], + [1,-1],[2,-1],[3,-1],[4,-1],[5,-1] ]; + fi; + + # the matrix + g := MutableCopyMat(g); #ie Matrix can be modified + d := Length(g); + fld := FieldOfMatrixList(stdgens); + + # To create a MSLP, we allocate all the memory needed at the beginning. + Add( slp, [4,1,10,1]); vxpos := Length(slp); #11 v*x^-1 + Add( slp, [11,-1]); vxipos := Length(slp); #12 (v*x^-1)^-1 + Add( slp, [1,0] ); u1pos := Length(slp); #13 + Add( slp, [1,0] ); u2pos := Length(slp); #14 + Add( slp, [1,0] ); tvpos := Length(slp); #15 + + # The implementation allows us to use the same slot for different purposes + tir1pos := 11; tirzpos := 12; + tcj1pos := 11; tcjzpos := 12; + + # u1,u2 coincide with the Input used in paper p16 Alg1. + u1 := MutableCopyMat( One(g)); #Copy of id_dxd + u2 := MutableCopyMat( One(g)); #Copy of id_dxd + + # add lastline to the slp to display the memory contents u1,u2 + lastline := [ [u1pos,1], [u2pos,1] ]; + + f := LogInt( Size(fld), Characteristic(fld) ); + + # now we create the space for the T2 \{ t_{2,1}(w^l) \} + T2pos := [ HighestSlotOfSLP(slp)+1 .. HighestSlotOfSLP(slp)+f ]; + + for ell in [ 1..f ] do + Add(slp, [1,0] ); + od; + + slp := Transvections2( stdgens, PrimitiveElement(fld), slp, T2pos ); + # Now slp computes T2 and the positions of the transvections + # of T2 in the slp are in the list T2pos + # now we create the space for all of the other Ti + Tipos := []; + Tipos[2] := T2pos; + + for i in [3 .. d] do + + Tipos[i] := [ HighestSlotOfSLP(slp)+1..HighestSlotOfSLP(slp)+f ]; + + for ell in [ 1..f ] do + Add(slp, [1,0]); + od; + od; + + # Up until here the slp and the memory agree. + # From now on we only overwrite existing memory positions. + Info( InfoBruhat, 2, "Memory Usage is: ",HighestSlotOfSLP(slp)," memory slots ", + "in UnipotentDecompositionWithTi()\n"); + + ComputeAllTransvections(); + + # Now we don't need vxpos and vxipos again, + # we now use the slots alternating for tir1pos and tirzpos resp. + # for tcj1pos and tcjzpos + + for i in [ 2..d ] do + Append( lastline, List( Tipos[i], j -> [j,1] ) ); + od; + + if TestIfMonomialNC( g ) then + Add( slp, lastline ); + return [ slp, [u1, g, u2] ]; + fi; + # As described in the MSLP paper + # We perform something like a GAUSS algorithm + + for c in [ d, d-1..2 ] do + + # find the first non-zero entry in column c + j := 1; r := 0; + while r <= d and r = 0 do + + if not IsZero( g[j][c] ) then + r := j; + fi; + + j := j + 1; + od; + + # Now we clear all entries in column c apart from g[r][c] + # if r is not the last row, we clear the rest of colum c + # first we clear the entry g[r+1][c] + + a := g[r][c]^-1; + + if r <= d-1 then + + if not IsZero( g[r+1][c] ) then + + z := - g[r+1][c] * a; + + TransvectionAtAlpha( r+1, z ); + + # add z times row r of g to row r+1 + # add z times row r of u1 to row r+1 + g[r+1] := g[r+1] + z * g[r]; + u1[r+1] := u1[r+1] + z * u1[r]; + # This is just Gauß: + + Add(slp, [ [tvpos,1, u1pos, 1], u1pos] ); + fi; + + Add( slp, [ [Tipos[r+1][1],1], tir1pos ] ); + # we have now cleared the entry in g[r+1][c] + + # Now clear the rest of column c + for i in [ r+2..d ] do + if not IsZero( g[i][c] ) then + + z := -g[i][c] * a; + + TransvectionAtAlpha(i, z ); + + instr := [ tvpos,-1, tir1pos,-1, + tvpos,1, tir1pos,1 ]; + Add(slp,[instr,tirzpos]); # tirz + + # add z times row r of g to row i + # add z times row r of u1 to row i + g[i] := g[i] + z * g[r]; + u1[i] := u1[i] + z * u1[r]; + + instr := [ tirzpos, 1, u1pos,1]; + Add(slp,[instr, u1pos] ); + + + fi; + + # get tir1 ready for the next i + instr := [ Tipos[i][1],-1,tir1pos,-1, + Tipos[i][1],1,tir1pos,1 ]; + + Add(slp, [ instr, tir1pos ] ); + od; + fi; # r <= d-1 + + # Next we clear row r apart from g[r][c] + if c >= 2 then + # if c = d then Ti already contains t_d(d-1) + # if c <= d-1 then we swap Ti and Ti-1 so that + # initially Ti contains t_(d-1)(d-2) and + # Ti_1 contains t_d(d-1) and then shift back + # now Ti contains t_c(c-1) + if not IsZero( g[r][c-1] ) then + + z := - g[r][c-1] * a; + + TransvectionAtAlpha( c, z ); + + # Add z times column c of g to column c-1, + # add z times column c of u2 to column c-1 + g{[1..d]}[c-1] := g{[1..d]}[c-1] + z * g{[1..d]}[c]; + u2{[1..d]}[c-1] := u2{[1..d]}[c-1] + z * u2{[1..d]}[c]; + + # Copy this in slp + instr := [ u2pos, 1, tvpos,1]; + Add(slp,[ instr, u2pos ] ); # u2 overwritten + + + + fi; + Add(slp, [ [Tipos[c][1],1 ], tcj1pos ] ); + + # Now clear the rest of row r + for j in [ c-2, c-3..1 ] do + + if not IsZero( g[r][j] ) then + + z := - g[r][j] * a; + + TransvectionAtAlpha( j+1, z ); + + instr := [ tcj1pos,-1, tvpos,-1, tcj1pos,1, tvpos,1 ]; + Add(slp, [ instr, tcjzpos ] ); # tcjz + + # add z times column c of g to column j + # add z times column c of u2 to column j + g{[1..d]}[j] := g{[1..d]}[j] + z * g{[1..d]}[c]; + u2{[1..d]}[j] := u2{[1..d]}[j] + z * u2{[1..d]}[c]; + + instr := [ u2pos, 1, tcjzpos,1 ]; + Add( slp, [ instr, u2pos ] ); # u2 overwritten + + fi; + + # get tcj1 ready for the next iteration + instr := [tcj1pos,-1, Tipos[j+1][1],-1, + tcj1pos,1, Tipos[j+1][1],1 ]; + Add( slp, [ instr, tcj1pos ] ); + od; + fi; + od; + + Add( slp, lastline ); + + return [slp, [u1, g, u2] ]; + +end +); + + + +##################### +# PART III +# Decomposition of Permutation and Diagonal-Matrix +#################### + +##### +# PermutationMonomialMatrix() +##### +# Find the permutation (in Sym(d) corresponding to a monomial matrix + +# Input: M: A monomial matrix + +# Output: diag: The vector of non-zero entries, where diag[i] is the non-zero +# entry of row i. +# perm: The permutation associated to M +# (ie i^perm = j if M_i,j not 0) + +InstallGlobalFunction( PermutationMonomialMatrix, +function( M ) + + local zero, d, found, perm, diag, r, j; + + zero := Zero( M[1][1] ); + d := DimensionsMat(M); + + if d[1] <> d[2] then + Error("Matrix must be square"); + return; + fi; + + d := d[1]; + found:= BlistList( [1..d], [] ); + perm := []; + diag := []; + + for r in [ 1..d ] do + + j := PositionNot( M[r], zero ); + + if d < j or found[j] then + return false; + fi; + + diag[r] := M[r][j]; + + if PositionNot( M[r], zero, j ) <= d then + return false; + fi; + + found[j] := true; + perm[r] := j; + + od; + + return [ diag, PermList(perm) ]; + +end +); + + + +##### +# PermutationMonomialMatrixNC() +##### +# Find the permutation (in Sym(d) corresponding to a monomial matrix + +# Input: M: A monomial matrix + +# Output: diag: The vector of non-zero entries, where diag[i] is the non-zero +# entry of row i. +# perm: The permutation associated to M +# (ie i^perm = j if M_i,j not 0) + +InstallGlobalFunction( PermutationMonomialMatrixNC, +function( M ) + + local zero, d, found, perm, diag, r, j; + + zero := Zero( M[1][1] ); + d := DimensionsMat(M); + + d := d[1]; + found:= BlistList( [1..d], [] ); + perm := []; + diag := []; + + for r in [ 1..d ] do + + j := PositionNot( M[r], zero ); + + if d < j or found[j] then + return false; + fi; + + diag[r] := M[r][j]; + + if PositionNot( M[r], zero, j ) <= d then + return false; + fi; + + found[j] := true; + perm[r] := j; + + od; + + return [ diag, PermList(perm) ]; + +end +); + + + +##### +# PermSLP() +##### + +# In this function we will transform a monomial matrix w \in SL(d,q) into +# a diagonal matrix diag. Using only the standard-generators s,v,x this +# will lead to a monomial matrix p_sign with only +-1 in non-zero entries +# and p_sign*diag = w (ie diag = p_sign^-1*w ) +# Furthermore we will return list slp of instructions which will +# (when evaluated at the LGO standard-generators) yield diag. + +# It is sufficient for diag to be diagonal, if the permutation associated +# with w (ie i^\pi_w = j if M_i,j not 0) is the inverse of the permutation +# associated to p_sign (again only to Sym(d) ) + +# In PermSLP we thus transform \pi_w to () using only { \pi_s, \pi_v, \pi_x } +# In order to know diag without computing all matrix multiplications, +# (we don't know the signs of p_sign), we compute a second permutation +# simultaneously (here using their identification with permutations in Sym(2d) +# and identifying { \pi_s, \pi_v, \pi_x } with {s,v,x} ) + +# Input: stdgens: The LGO standard-generators +# mat: A monomial matrix (ie w) +# slp: An already existing list of instructions *optional + +# Output: slp: A list of instructions to evaluate p_sign +# (if slp was Input then this instructions are added to slp) +# p_sign: The signed permutation matrix +# mat: the diagonal matrix diag + +InstallGlobalFunction( PermSLP, +function (arg) + + local stdgens, s, t, v, vi, perm, slp, instr, cnt, pot, d, fld, i, j, + spos, tpos, vpos, vipos, p_signpos, xpos, xnpos, x0, x0new, + Ceiling, mat, p_sign, swr, vwr, viwr, x0wr, xnewwr, twr, p_signwr; + + # There is a Ceil Function in GAP + # However the one in GAP doesnt work for integers + Ceiling := function(x) + + if IsInt(x) then + return x; + fi; + + return Int(x) + 1; + end; + + # Check for correct Input + if Length(arg) >= 2 and IsList(arg[1]) and IsMatrix(arg[2]) then + + stdgens := arg[1]; # the LGO standard generators + mat := arg[2]; # the monomial matrix + + # Compute the permutation in Sym(d) of mat + perm := PermutationMonomialMatrix( mat ); + perm := perm[2]; + # Compute {I_d}wr + p_signwr := MatToWreathProd( stdgens[1]^0 ); + + # transforming perm -> () means I_d -> p_sign + + if Length(stdgens) < 1 or not IsMatrix( stdgens[1]) then + Error("Input: first argument must be the LGO standard generators"); + return; + fi; + + else + + Error("input: LGO standard generators and a matrix"); + return; + fi; + + fld := FieldOfMatrixList( stdgens ); + + if Length(arg) = 3 then + + # The first 10 entries are the stdgens and their inverses + slp := arg[3]; + + if not IsList(slp) then + Error("Input: third argument must be a list"); + return; + fi; + + cnt := HighestSlotOfSLP(slp); + + Info( InfoBruhat, 2, " and additional: ",7," memory slots ", + "in PermSLP()\n"); + else + + # we write an SLP into the variable slp + # The first 10 entries are the stdgens and the inverses + # s, t, del, v, x, s^-1, t^-1, del^-1, v^-1, x^-1 + # The entries 11 (resAEM) and 12 (tmpAEM) are used to save AEM-values + slp := [ [1, 1], [2, 1], [3, 1], [4, 1], [5, 1], + [1,-1], [2,-1], [3,-1], [4,-1], [5,-1], + [1, 0], [1, 0] ]; + + cnt := 12; + + Info( InfoBruhat, 2, "Memory Usage is: ",19," memory slots ", + "in PermSLP()\n"); + fi; + + # Initialize the additional memory quota + Add(slp, [ [1,0], cnt + 1 ] ); p_signpos := cnt + 1; #13 or 20+3f + Add(slp, [ [4,1], cnt + 2 ] ); vpos := cnt + 2; #14 or 21+3f + Add(slp, [ [1,0], cnt + 3 ] ); vipos := cnt + 3; #15 or 22+3f + Add(slp, [ [1,1], cnt + 4 ] ); spos := cnt + 4; #16 or 23+3f + Add(slp, [ [5,1], cnt + 5 ] ); xpos := cnt + 5; #17 or 24+3f + Add(slp, [ [5,0], cnt + 6 ] ); xnpos := cnt + 6; #18 or 25+3f + Add(slp, [ [1,0], cnt + 7 ] ); tpos := cnt + 7; #19 or 26+3f + + d := Length( stdgens[1] ); + + # Define the permutation representations for matrix s in Sym(d) and Sym(2d) + # We will denote the representation in Sym(d) by s + s := (1,2); + swr := MatToWreathProd( stdgens[1] ); + + if IsDiagonalMat( mat ) then + # In order to make it coincide with the other possible output. + # This is ok since it is Id + Add( slp, [ [p_signpos,-1] , p_signpos ] ); + return [ slp, [ stdgens[1]^0, mat ] ]; + fi; + + if IsOddInt(d) then + # For d odd, v is a d-cycle + v := [ 2..d ]; + Add( v, 1 ); + v := ( PermList(v) )^-1; + + vwr := MatToWreathProd( stdgens[4] ); + + # vi is (1,d,d-1,....,2) + vi := v; + viwr := vwr; + + Add( slp, [ [4,1], vipos ] ); + + for i in [ 1 .. d ] do + + pot := i^perm - i; + + # Need to update perm since pi_{i-1} may change pos of i + perm := perm * vi ^pot; + p_signwr := p_signwr * viwr^pot; + + # memory slots 11 and 12 are used for resAEM and tmpAEM + instr := AEM( vipos, 11, 12, pot ); + Append( slp, instr ); + Add( slp, [ [p_signpos,1, 11,1 ], p_signpos ] ); # permpos + + #Compute v_i+1, save command in slp + vi := s * vi; + viwr := swr * viwr; + + Add(slp,[ [spos,1, vipos,1 ], vipos ] ); # vipos + # Don't be confused with notation in Paper + # There we used v1 (which coincides with v^-1) + + s := s ^( v ^-1 ); + swr := swr^( vwr^-1 ); + Add(slp, [ [4,1, spos,1, 9,1 ], spos ] ); # spos + + od; + + p_sign := WreathProdToMat( p_signwr, d, fld ); + mat := p_sign * mat; # diag + + # diag = p_sign * pm, so return p_sign^-1 + p_sign := p_sign^-1; # p_sign + Add(slp,[ [ p_signpos,-1 ], p_signpos ] ); # bpos + + return [slp, [ p_sign, mat ] ]; + + else + + # If d is even we do not have a d-cycle in stdgens + v := [ 3..d ]; + Add( v, 1 ); Add( v, 2 ); + v := PermList( v ); + vwr := MatToWreathProd( stdgens[4] ); + # This corresponds to v in stdgens + + x0 := (1,2,3,4); + x0wr := MatToWreathProd( stdgens[5] ); + # This corresponds to x in stdgens + + # s and swr are independent from d odd or even, defined above if-case + + # v*s is the d-cycle (1,3,5,7, ...,2,4,6,8, ... d) + # x0*s is (2,3,4) + + for i in [ 1..d ] do + if IsOddInt(i) then + + x0new := x0 ^( v * s ); + xnewwr := x0wr^(vwr * swr); + + Add( slp, [ [spos,-1, vpos,-1, xpos,1, vpos,1, spos,1 ], + xnpos ] ); + fi; + + t := s ^( x0 * s ); + twr := swr^(x0wr * swr); + + Add(slp, [ [spos,-1, xpos,-1, spos,1, xpos,1, spos,1 ], tpos ] ); + + vi := ( v * s )^-1; + viwr := (vwr * swr )^-1; + + Add( slp, [ [spos,-1,vpos,-1], vipos ] ); + + if IsEvenInt( i^perm -i) then + + pot := (i^perm - i) / 2; + + perm := perm * vi ^pot; + p_signwr := p_signwr * viwr^pot ; + + instr := AEM( vipos, 11, 12, pot ); + Append( slp, instr ); + Add(slp,[ [p_signpos,1, 11,1], p_signpos ] ); + + else + + pot := ( i^perm - i - 1 ) / 2 + Ceiling( Order(vi) / 2 ); + + perm := perm * vi ^pot; + p_signwr := p_signwr * viwr^pot; + + # The memory slots 11 and 12 are res and tmp-slot for AEM + instr := AEM( vipos, 11,12, pot ); + Append( slp, instr ); + Add(slp,[ [ p_signpos,1, 11,1 ], p_signpos ] ); + + fi; + + s := s ^ x0; + swr := swr^x0wr; + + Add( slp, [ [ xpos,-1, spos,1, xpos,1 ], spos ] ); + + v := v * t; + vwr := vwr * twr; + + Add( slp, [ [vpos,1, tpos,1 ], vpos ] ); + + if IsEvenInt(i) then + x0 := x0new; + x0wr := xnewwr; + + j := xpos; + xpos := xnpos; + xnpos := j; + fi; + od; + + # We now transfer the permutation p_sign in Sym(2d) back + # to the signed permutation matrix p_sign + p_sign := WreathProdToMat( p_signwr, d, fld ); + mat := p_sign * mat; + + p_sign := p_sign^-1; + Add(slp, [ [ p_signpos,-1 ], p_signpos ] ); # bpos + + return [slp, [ p_sign, mat ] ]; + fi; + +end +); + + +InstallGlobalFunction( PermSLPNC, +function ( arg ) + + local stdgens, s, t, v, vi, perm, slp, instr, cnt, pot, d, fld, i, j, + spos, tpos, vpos, vipos, p_signpos, xpos, xnpos, AEMrespos, tmppos, + x0, x0new, Ceiling, mat, p_sign, + swr, vwr, viwr, x0wr, xnewwr, twr, p_signwr; + + # There is a Ceil Function in GAP + # However the one in GAP doesnt work for integers + Ceiling := function(x) + + if IsInt(x) then + return x; + fi; + + return Int(x) + 1; + end; + + stdgens := arg[1]; # the LGO standard generators + mat := arg[2]; # the monomial matrix + + # Compute the permutation in Sym(d) of mat + perm := PermutationMonomialMatrixNC( mat ); + perm := perm[2]; + # Compute {I_d}wr + p_signwr := MatToWreathProdNC( stdgens[1]^0 ); + + # transforming perm -> () means I_d -> p_sign + + fld := FieldOfMatrixList( stdgens ); + + if Length( arg ) = 3 then + + # The first 10 entries are the stdgens and their inverses + slp := arg[3]; + + cnt := HighestSlotOfSLP(slp); + + Info( InfoBruhat, 2, " and additional: ",7," memory slots ", + "in PermSLP()\n"); + else + + # we write an SLP into the variable slp + # The first 10 entries are the stdgens and the inverses + # s, t, del, v, x, s^-1, t^-1, del^-1, v^-1, x^-1 + # The entries 11 = AEMrespos and 12 = tmppos save AEM-values + slp := [ [1, 1], [2, 1], [3, 1], [4, 1], [5, 1], + [1,-1], [2,-1], [3,-1], [4,-1], [5,-1], + [1, 0], [1, 0] ]; + + cnt := 12; + + Info( InfoBruhat, 2, "Memory Usage is: ",19," memory slots ", + "in PermSLP()\n"); + fi; + AEMrespos := 11; tmppos := 12; + + # Initialize the additional memory quota + Add(slp, [ [1,0], cnt + 1 ] ); p_signpos := cnt + 1; #13 or 20+3f + Add(slp, [ [4,1], cnt + 2 ] ); vpos := cnt + 2; #14 or 21+3f + Add(slp, [ [1,0], cnt + 3 ] ); vipos := cnt + 3; #15 or 22+3f + Add(slp, [ [1,1], cnt + 4 ] ); spos := cnt + 4; #16 or 23+3f + Add(slp, [ [5,1], cnt + 5 ] ); xpos := cnt + 5; #17 or 24+3f + Add(slp, [ [5,0], cnt + 6 ] ); xnpos := cnt + 6; #18 or 25+3f + Add(slp, [ [1,0], cnt + 7 ] ); tpos := cnt + 7; #19 or 26+3f + + d := Length( stdgens[1] ); + + # Define the permutation representations for matrix s in Sym(d) and Sym(2d) + # We will denote the representation in Sym(d) by s + s := (1,2); + swr := MatToWreathProdNC( stdgens[1] ); + + if IsDiagonalMat( mat ) then + Add( slp, [ [ p_signpos,-1 ] , p_signpos ] ); + return [ slp, [ stdgens[1]^0, mat ] ]; + fi; + + if IsOddInt(d) then + # For d odd, v is a d-cycle + v := [ 2..d ]; + Add( v, 1 ); + v := ( PermList(v) )^-1; + + vwr := MatToWreathProdNC( stdgens[4] ); + + # vi is (1,d,d-1,....,2) + vi := v; + viwr := vwr; + + Add( slp, [ [4,1], vipos ] ); + + for i in [ 1..d ] do + + pot := i^perm - i; + + # Need to update perm since pi_{i-1} may change pos of i + perm := perm * vi ^pot; + p_signwr := p_signwr * viwr^pot; + + instr := AEM( vipos, AEMrespos, tmppos, pot ); + Append( slp, instr ); + Add( slp, [ [ p_signpos,1, AEMrespos,1 ], p_signpos ] ); + + #Compute v_i+1, save command in slp + vi := s * vi; + viwr := swr * viwr; + + Add(slp,[ [spos,1, vipos,1 ], vipos ] ); # vipos + # Don't be confused with notation in Paper + # There we used v1 (which coincides with v^-1) + + s := s ^( v ^-1 ); + swr := swr^( vwr^-1 ); + Add(slp, [ [4,1, spos,1, 9,1 ], spos ] ); # spos + + od; + + p_sign := WreathProdToMat( p_signwr, d, fld ); + mat := p_sign * mat; # diag + + # diag = p_sign * pm, so return p_sign^-1 + p_sign := p_sign^-1; # p_sign + Add(slp,[ [ p_signpos,-1 ], p_signpos ] ); # bpos + + return [slp, [ p_sign, mat ] ]; + + else + + # If d is even we do not have a d-cycle in stdgens + v := [ 3..d ]; + Add( v, 1 ); Add( v, 2 ); + v := PermList( v ); + vwr := MatToWreathProdNC( stdgens[4] ); + # This corresponds to v in stdgens + + x0 := (1,2,3,4); + x0wr := MatToWreathProdNC( stdgens[5] ); + # This corresponds to x in stdgens + + # s and swr are independent from d odd or even, defined above if-case + + # v*s is the d-cycle (1,3,5,7, ...,2,4,6,8, ... d) + # x0*s is (2,3,4) + + for i in [ 1..d ] do + if IsOddInt(i) then + + x0new := x0 ^( v * s ); + xnewwr := x0wr^(vwr * swr); + + Add( slp, [ [spos,-1, vpos,-1, xpos,1, vpos,1, spos,1 ], + xnpos ] ); + fi; + + t := s ^( x0 * s ); + twr := swr^(x0wr * swr); + + Add(slp, [ [spos,-1, xpos,-1, spos,1, xpos,1, spos,1 ], tpos ] ); + + vi := ( v * s )^-1; + viwr := (vwr * swr )^-1; + + Add( slp, [ [spos,-1,vpos,-1], vipos ] ); + + if IsEvenInt( i^perm -i) then + + pot := (i^perm - i) / 2; + + perm := perm * vi ^pot; + p_signwr := p_signwr * viwr^pot ; + + instr := AEM( vipos, AEMrespos, tmppos, pot ); + Append( slp, instr ); + Add(slp,[ [p_signpos,1, AEMrespos,1], p_signpos ] ); + + else + + pot := ( i^perm - i - 1 ) / 2 + Ceiling( Order(vi) / 2 ); + + perm := perm * vi ^pot; + p_signwr := p_signwr * viwr^pot; + + instr := AEM( vipos, AEMrespos,tmppos, pot ); + Append( slp, instr ); + Add(slp,[ [ p_signpos,1, AEMrespos,1 ], p_signpos ] ); + + fi; + + s := s ^ x0; + swr := swr^x0wr; + + Add( slp, [ [ xpos,-1, spos,1, xpos,1 ], spos ] ); + + v := v * t; + vwr := vwr * twr; + + Add( slp, [ [vpos,1, tpos,1 ], vpos ] ); + + if IsEvenInt(i) then + x0 := x0new; + x0wr := xnewwr; + + j := xpos; + xpos := xnpos; + xnpos := j; + fi; + od; + + # We now transfer the permutation p_sign in Sym(2d) back + # to the signed permutation matrix p_sign + p_sign := WreathProdToMat( p_signwr, d, fld ); + mat := p_sign * mat; + + p_sign := p_sign^-1; + Add(slp, [ [ p_signpos,-1 ], p_signpos ] ); + + return [slp, [ p_sign, mat ] ]; + fi; + +end +); + + + +##### +# DiagonalDecomposition() +##### + +# Writes a list of instructions which evaluated on LGO standard-generators +# yield the diagonal matrix of the input. + +# Input: stdgens: The LGO standard-generators +# diag: A diagonal matrix (eg diag) +# slp: An already existing list of instructions *optional + +# Output: slp: A list of instructions to evaluate diag +# (if slp was Input then this instructions are added to slp) +# hres: The the identity matrix + +InstallGlobalFunction( DiagonalDecomposition, +function(arg) + + local stdgens, delta, x, v, h, hi, him, slp, d, fld, omega, + lambdai, i, hipos, hiposm, temp, respos, hres, diag, cnt, instr; + + if Length(arg) >= 2 and IsList(arg[1]) and IsMatrix(arg[2]) then + + stdgens := arg[1]; # the LGO standard generators + diag := arg[2]; + + if Length(stdgens) < 1 or not IsMatrix( stdgens[1] ) then + Error("Input: first argument must be the LGO standard generators"); + return; + fi; + + if not IsDiagonalMat( diag ) then + Error("Input: second argument must be a diagonal matrix"); + return; + fi; + else + Error("Input: LGO standard generators and a diagonal matrix"); + return; + fi; + + fld := FieldOfMatrixList( stdgens ); + + if Length(arg) = 3 then + + # The first 10 entries are the stdgens and their inverses + slp := arg[3]; + + if not IsList(slp) then + Error("Input: third argument must be a list"); + return fail; + fi; + + cnt := HighestSlotOfSLP( slp ); + Info( InfoBruhat, 2, " and additional: ",3," memory slots ", + "in DiagonalDecomposition()\n"); + + else + # We write an SLP into the variable slp + # The first 10 entries are the stdgens and their inverses + # s^-1 t^-1 del^-1 v^-1 x^-1 + # The entries #11 (resAEM),#12 (tmpAEM) are used to save AEM-values + slp := [ [1, 1], [2, 1], [3, 1], [4, 1], [5, 1], + [1,-1], [2,-1], [3,-1], [4,-1], [5,-1], + [1, 0], [1, 0] ]; + + cnt := 12; + Info( InfoBruhat, 2, "Memory Usage is: ",3," memory slots ", + "in DiagonalDecomposition()\n"); + fi; + + # Define the LGO standard-generators given in the input + delta := stdgens[3]; + v := stdgens[4]; + x := stdgens[5]; + + # Initialize the additional memory quota + #hi-2 + Add(slp, [ [1,0], cnt + 1 ] ); hiposm := cnt + 1; #13 or 27+3f + #hi-1 + Add(slp, [ [1,0], cnt + 2 ] ); hipos := cnt + 2; #14 or 28+3f + # result + Add(slp, [ [1,0], cnt + 3 ] ); respos := cnt + 3; #15 or 29+3f + + d := Length( diag ); + omega := PrimitiveRoot( fld ); + + if diag = One(diag) then + Add( slp, [ [1,0], respos ] ); + Add( slp, [ respos, 1]); + return [ slp, diag ]; + fi; + + lambdai := 0; + hres := diag^0; + + for i in [ 1..d-1 ] do + + lambdai := lambdai + LogFFE( diag[i][i], omega ); + + if i = 1 then + # h_1 = delta + hi := delta; + Add(slp,[ [3,1], hipos ] ); + + elif i = 2 and IsEvenInt(d) then + # h_2 = xi * delta * x + him := delta; + hi := x^-1 * delta * x; + + Add(slp, [ [3,1], hiposm ] ); + Add(slp, [ [10,1, 3,1, 5,1 ], hipos ] ); + + elif IsOddInt(d) then + # h_i = v h_{i-1} v^-1 + hi := v * hi * v^-1; + + Add(slp, [ [4,1, hipos,1, 9,1 ], hipos ] ); + + else + # h_i = v^-1 h_{i-2} v + # first we overwrite what is in hiposm + # since we will not need hiposm any longer + Add(slp, [ [9,1, hiposm,1, 4,1 ], hiposm ] ); + # now we swap meaning of hipos and hiposm + temp := hipos; + hipos := hiposm; # contains h_i + hiposm := temp; # contains h_{i-1} + temp := hi; + hi := v^-1 * him * v; + him := temp; + + fi; + + # The memory slots 11 and 12 are res and tmp-slot for AEM + instr := AEM( hipos, 11, 12, lambdai ); + Append( slp, instr ); + Add( slp, [ [respos,1, 11,1 ], respos ] ); + + hres := hres * hi^lambdai; + + od; + + Add( slp, [ respos,1 ] ); + + return [ slp, hres ]; + +end +); + + +InstallGlobalFunction( DiagonalDecompositionNC, +function( arg ) + + local stdgens, delta, v, x, h, hi, him, slp, d, fld, omega, + lambdai, i, temp, hres, diag, cnt, instr, + hipos, hiposm, respos, AEMrespos, tmppos; + + stdgens := arg[1]; # the LGO standard generators + diag := arg[2]; + + fld := FieldOfMatrixList( stdgens ); + + if Length(arg) = 3 then + + # The first 10 entries are the stdgens and their inverses + slp := arg[3]; + + cnt := HighestSlotOfSLP( slp ); + Info( InfoBruhat, 2, " and additional: ",3," memory slots ", + "in DiagonalDecomposition()\n"); + + else + # We write an SLP into the variable slp + # The first 10 entries are the stdgens and their inverses + # s^-1 t^-1 del^-1 v^-1 x^-1 + # The entries 11 = AEMrespos and 12 = tmppos save AEM-values + slp := [ [1, 1], [2, 1], [3, 1], [4, 1], [5, 1], + [1,-1], [2,-1], [3,-1], [4,-1], [5,-1], + [1, 0], [1, 0] ]; + + cnt := 12; + Info( InfoBruhat, 2, "Memory Usage is: ",3," memory slots ", + "in DiagonalDecomposition()\n"); + fi; + AEMrespos := 11; tmppos := 12; + + # Define the LGO standard-generators given in the input + + delta := stdgens[3]; + v := stdgens[4]; + x := stdgens[5]; + + # Initialize the additional memory quota + #hi-2 + Add(slp, [ [1,0], cnt + 1 ] ); hiposm := cnt + 1; #13 or 27+3f + #hi-1 + Add(slp, [ [1,0], cnt + 2 ] ); hipos := cnt + 2; #14 or 28+3f + # result + Add(slp, [ [1,0], cnt + 3 ] ); respos := cnt + 3; #15 or 29+3f + + d := Length( diag ); + omega := PrimitiveElement( fld ); + + if diag = One( diag ) then + Add( slp, [ [1,0], respos ] ); + Add( slp, [ respos, 1] ); + return [ slp, diag ]; + fi; + + lambdai := 0; + hres := diag^0; + + for i in [ 1..d-1 ] do + + lambdai := lambdai + LogFFE( diag[i][i], omega ); + + if i = 1 then + # h_1 = delta + hi := delta; + Add(slp,[ [3,1], hipos ] ); + + elif i = 2 and IsEvenInt( d ) then + # h_2 = xi * delta * x + him := delta; + hi := x^-1 * delta * x; + + Add(slp, [ [3,1], hiposm ] ); + Add(slp, [ [10,1, 3,1, 5,1 ], hipos ] ); + + elif IsOddInt( d ) then + # h_i = v h_{i-1} v^-1 + hi := v * hi * v^-1; + + Add(slp, [ [4,1, hipos,1, 9,1 ], hipos ] ); + + else + # h_i = v^-1 h_{i-2} v + # first we overwrite what is in hiposm + # since we will not need hiposm any longer + Add(slp, [ [9,1, hiposm,1, 4,1 ], hiposm ] ); + # now we swap meaning of hipos and hiposm + temp := hipos; + hipos := hiposm; # contains h_i + hiposm := temp; # contains h_{i-1} + temp := hi; + hi := v^-1 * him * v; + him := temp; + + fi; + + instr := AEM( hipos, AEMrespos, tmppos, lambdai ); + Append( slp, instr ); + Add( slp, [ [respos,1, AEMrespos,1 ], respos ] ); + + hres := hres * hi^lambdai; + + od; + + Add( slp, [ respos,1 ] ); + + return [ slp, hres ]; + +end +); + + + +#################### +# PART IV +# Main Functions. Constructs slp for the StraightLineProgram +##################### + +##### +# BruhatDecompositionSL() +##### + +# Uses UnipotentDecomposition(), PermSLP() and DiagonalDecomposition() +# to write a matrix g \in SL(d,q) as g = u1^-1*p_sign*diag*u2^-2 +# where u1,u2 are lower unitriangular matrices, p_sign a monomial matrix +# with only +1 and -1 as non-zero entries and diag a diagonal matrix. +# It furthermore yields an SLP that reurns the above matrices if evaluated +# at the LGO standard-generators. + +# Input: stdgens: The LGO standard-generators +# g: A matrix in SL(d,q) + +# Output: pgr: A SLP to compute u1,u2,p_sign and diag +# and the matrices u1, u2, p_sign and diag itself + +InstallGlobalFunction( BruhatDecompositionSL, +function(stdgens, g) + + local slp, u1, pm, u2, p_sign, diag, res1, res2, res3, lastline, line, pgr; + + # We write an SLP into the variable slp + # The first 10 entries are the stdgens and their inverses + # s, t, del, v, x, s^-1, t^-1, del^-1, v^-1, x^-1 + + Info( InfoBruhat, 1, + "returns an SLP to generate u1, u2, p_sign, diag\n" ); + + # Compute the matrices u1,u2 of Bruhat-Decomposition and the instructions + # for an SLP that compute u1 and u2 + res1 := UnipotentDecomposition( stdgens, g); + + slp := res1[1]; + u1 := res1[2][1]; + pm := res1[2][2]; # the monomial matrix w + u2 := res1[2][3]; + + lastline := ShallowCopy( slp[ Length(slp) ] ); # remember famous last words + # Since entries of the form [list1,list2] should only occur at the end + Remove(slp); + + # Decompose w in to a signed Permutation-Matrix generated by + # and a Diagonal-Matrix diag. + + res2 := PermSLP(stdgens, pm, slp ); + + slp := ShallowCopy(res2[1]); + p_sign := res2[2][1]; + diag := res2[2][2]; + # Now w = p_sign * diag + # and p_sign is can be evaluated as word in < s, v, x > using slp. + + # Make again all entries of slp admissible for SLP + # We inverted a Monomial-Matrix in PermSLP to get the proper result. + # Thus we have to copy a little variaton at the end of our final slp + # (else we would display a twice inverted matrix where we wanted once) + line := slp[ Length(slp) ]; + Append(lastline,[ [line[1][1], 1] ]); + + # Determine the SLP for the Diagonal-Matrix + res3 := DiagonalDecomposition(stdgens, diag, slp); + slp := res3[1]; + + # Here the last entry is of admissible form. Just add it to the end. + Append( lastline, [ slp[ Length(slp)] ] ); # remember famous last words + Remove( slp ); + Append( slp, [lastline] ); + + Info( InfoBruhat, 2, "The Total Memory Usage is: " + , HighestSlotOfSLP(slp), " memory slots\n" ); + + pgr := MakeSLP(slp,5); + + # The result R of pgr satisfies: + # R[1]^-1*R[3]*R[4]*R[2]^-1 and + # R[1] = u1, R[2] = u2, R[3] = p_sign, R[4] = diag + return [pgr, [ u1, u2, p_sign, diag ]]; + +end +); + + +InstallGlobalFunction( BruhatDecompositionSLNC, +function(stdgens, g) + + local slp, u1, pm, u2, p_sign, diag, res1, res2, res3, lastline, line, pgr; + + # We write an SLP into the variable slp + # The first 10 entries are the stdgens and their inverses + # s, t, del, v, x, s^-1, t^-1, del^-1, v^-1, x^-1 + + Info( InfoBruhat, 1, + "returns an SLP to generate u1, u2, p_sign, diag\n" ); + + # Compute the matrices u1,u2 of Bruhat-Decomposition and the instructions + # for an SLP that compute u1 and u2 + res1 := UnipotentDecompositionNC( stdgens, g); + + slp := res1[1]; + u1 := res1[2][1]; + pm := res1[2][2]; # the monomial matrix w + u2 := res1[2][3]; + + lastline := ShallowCopy( slp[ Length(slp) ] ); # remember famous last words + # Since entries of the form [list1,list2] should only occur at the end + Remove(slp); + + # Decompose w in to a signed Permutation-Matrix generated by + # and a Diagonal-Matrix diag. + + res2 := PermSLPNC(stdgens, pm, slp ); + + slp := ShallowCopy( res2[1] ); + p_sign := res2[2][1]; + diag := res2[2][2]; + # Now w = p_sign * diag + # and p_sign is can be evaluated as word in < s, v, x > using slp. + + # Make again all entries of slp admissible for SLP + # We inverted a Monomial-Matrix in PermSLP to get the proper result. + # Thus we have to copy a little variaton at the end of our final slp + # (else we would display a twice inverted matrix where we wanted once) + line := slp[ Length(slp) ]; + Append(lastline,[ [line[1][1], 1] ]); + + # Determine the SLP for the Diagonal-Matrix + res3 := DiagonalDecompositionNC( stdgens, diag, slp ); + slp := res3[1]; + + # Here the last entry is of admissible form. Just add it to the end. + Append( lastline, [ slp[ Length(slp) ] ] ); # remember famous last words + Remove( slp ); + Append( slp, [ lastline ] ); + + Info( InfoBruhat, 2, "The Total Memory Usage is: " + , HighestSlotOfSLP(slp), " memory slots\n" ); + + + pgr := MakeSLPNC( slp, 5 ); + + # The result R of pgr satisfies: + # R[1]^-1*R[3]*R[4]*R[2]^-1 and + # R[1] = u1, R[2] = u2, R[3] = p_sign, R[4] = diag + return [pgr, [ u1, u2, p_sign, diag ] ]; + +end +); + + + +##### +# BruhatDecompositionSLWithTi() +##### + +# As BruhatDecompositionSL() but replace UnipotentDecomposition() +# by UnipotentDecompositionWithTi. + +# Input: stdgens: The LGO standard-generators +# g: A matrix in SL(d,q) + +# Output: pgr: A SLP to compute u1,u2,p_sign, diag +# and all transvections t_{i,i-1}(omega^ell) +# the matrices u1, u2, p_sign and diag itself + +InstallGlobalFunction( BruhatDecompositionSLWithTi, +function(stdgens, g) + + local slp, u1, pm, u2, p_sign, diag, res1, res2, res3, + lastline, line, transvections, pgr; + + # We write an SLP into the variable slp + # The first 10 entries are the stdgens and their inverses + # s, t, del, v, x, s^-1, t^-1, del^-1, v^-1, x^-1 + + Info( InfoBruhat, 1, + "returns an SLP to generate u1, u2, p_sign, diag\n" ); + + # Compute the matrices u1,u2 of Bruhat-Decomposition and the instructions + # for an SLP that compute u1 and u2 + res1 := UnipotentDecompositionWithTi( stdgens, g); + + slp := res1[1]; + u1 := res1[2][1]; + pm := res1[2][2]; # the monomial matrix w + u2 := res1[2][3]; + + lastline := ShallowCopy( slp[ Length(slp) ] ); # remember famous last words + transvections := ShallowCopy( lastline{[ 3..Length(lastline) ]} ); + lastline := lastline{[ 1..2 ]}; + + # Since entries of the form [list1,list2] should only occur at the end + Remove(slp); + + # Decompose w in to a signed Permutation-Matrix generated by + # and a Diagonal-Matrix diag. + + res2 := PermSLP(stdgens, pm, slp ); + + slp := ShallowCopy(res2[1]); + p_sign := res2[2][1]; + diag := res2[2][2]; + # Now w = p_sign * diag + # and p_sign is can be evaluated as word in < s, v, x > using slp. + + # Make again all entries of slp admissible for SLP + # We inverted a Monomial-Matrix in PermSLP to get the proper result. + # Thus we have to copy a little variaton at the end of our final slp + # (else we would display a twice inverted matrix where we wanted once) + line := slp[ Length(slp) ]; + Append(lastline,[ [line[1][1], 1] ]); + + # Determine the SLP for the Diagonal-Matrix + res3 := DiagonalDecomposition(stdgens, diag, slp); + slp := res3[1]; + + # Here the last entry is of admissible form. Just add it to the end. + Append( lastline, [ slp[ Length(slp)] ] ); # remember famous last words + Append( lastline, transvections ); + Remove( slp ); + Append( slp, [lastline] ); + + Info( InfoBruhat, 2, "The Total Memory Usage is: " + , HighestSlotOfSLP(slp), " memory slots\n" ); + + + pgr := MakeSLP(slp,5); + + # The result R of pgr satisfies: + # R[1]^-1*R[3]*R[4]*R[2]^-1 and + # R[1] = u1, R[2] = u2, R[3] = p_sign, R[4] = diag + # Furthermore R[5] ... R[ Length(R) ] are the transvections. + return [pgr, [ u1, u2, p_sign, diag ]]; + +end +); + + +InstallGlobalFunction( BruhatDecompositionSLWithTiNC, +function(stdgens, g) + + local slp, u1, pm, u2, p_sign, diag, res1, res2, res3, + lastline, line, transvections, pgr; + + # We write an SLP into the variable slp + # The first 10 entries are the stdgens and their inverses + # s, t, del, v, x, s^-1, t^-1, del^-1, v^-1, x^-1 + + Info( InfoBruhat, 1, + "returns an SLP to generate u1, u2, p_sign, diag\n" ); + + # Compute the matrices u1,u2 of Bruhat-Decomposition and the instructions + # for an SLP that compute u1 and u2 + res1 := UnipotentDecompositionWithTiNC( stdgens, g); + + slp := res1[1]; + u1 := res1[2][1]; + pm := res1[2][2]; # the monomial matrix w + u2 := res1[2][3]; + + lastline := ShallowCopy( slp[ Length(slp) ] ); # remember famous last words + transvections := ShallowCopy( lastline{[ 3..Length(lastline) ]} ); + lastline := lastline{[ 1..2 ]}; + + # Since entries of the form [list1,list2] should only occur at the end + Remove(slp); + + # Decompose w in to a signed Permutation-Matrix generated by + # and a Diagonal-Matrix diag. + + res2 := PermSLPNC(stdgens, pm, slp ); + + slp := ShallowCopy(res2[1]); + p_sign := res2[2][1]; + diag := res2[2][2]; + # Now w = p_sign * diag + # and p_sign is can be evaluated as word in < s, v, x > using slp. + + # Make again all entries of slp admissible for SLP + # We inverted a Monomial-Matrix in PermSLP to get the proper result. + # Thus we have to copy a little variaton at the end of our final slp + # (else we would display a twice inverted matrix where we wanted once) + line := slp[ Length(slp) ]; + Append( lastline, [ [ line[1][1],1 ] ] ); + + # Determine the SLP for the Diagonal-Matrix + res3 := DiagonalDecompositionNC( stdgens, diag, slp ); + slp := res3[1]; + + # Here the last entry is of admissible form. Just add it to the end. + Append( lastline, [ slp[ Length(slp)] ] ); # remember famous last words + Append( lastline, transvections ); + Remove( slp ); + Append( slp, [lastline] ); + + Info( InfoBruhat, 2, "The Total Memory Usage is: " + , HighestSlotOfSLP(slp), " memory slots\n" ); + + + pgr := MakeSLPNC( slp, 5 ); + + # The result R of pgr satisfies: + # R[1]^-1*R[3]*R[4]*R[2]^-1 and + # R[1] = u1, R[2] = u2, R[3] = p_sign, R[4] = diag + # Furthermore R[5] ... R[ Length(R) ] are the transvections. + return [pgr, [ u1, u2, p_sign, diag ]]; + +end +); + diff --git a/gap/matrix/wordsInNiceGens/BruhatDecompositionSU.gd b/gap/matrix/wordsInNiceGens/BruhatDecompositionSU.gd new file mode 100755 index 00000000..1364ef93 --- /dev/null +++ b/gap/matrix/wordsInNiceGens/BruhatDecompositionSU.gd @@ -0,0 +1,407 @@ +############################################################################# +# BruhatDecompositionSU.gd +############################################################################# +############################################################################# +## +## BruhatDecomposition package +## +## Daniel Rademacher, RWTH Aachen University +## Alice Niemeyer, RWTH Aachen University +## +## Licensed under the GPL 3 or later. +## +############################################################################# + +#! @Chapter Special Unitary Group +#! @ChapterLabel SpecialUnitaryGroup +#! +#! This chapter deals with the special unitary group + +#! @Section Introduction and Quick Start of functions for SU +#! @SectionLabel LabelIntroductionAndQuickStartSU +#! +#! TODO + + + + + + +#! @Section Functions for SU +#! @SectionLabel LabelFunctionsSU + +#################### +# PART I - a) +# Originally implemented subfunctions +#################### + +InfoBruhat := NewInfoClass("InfoBruhat");; +SetInfoLevel( InfoBruhat, 2 ); + +##### +# MakePermutationMat() +##### + +#! @Arguments perm dim fld +#! @Returns The permutation matrix of perm over M_{d x d}(fld) (ie res_{i,j} = One(fld) if i^{perm} = j) +#! @Description +#! perm: A permutation, \newline +#! dim: A natural number, \newline +#! fld: A field \newline +#! This is the same function as MyPermutationMat. +DeclareGlobalFunction( "MakePermutationMat" ); + + + +##### +# LGOStandardGensSU +##### + +#! @Arguments d q +#! @Returns stdgens (the LGO standard-generators of SU(d,q)) +#! @Description +#! d: The dimension of our matrix. \newline +#! q: A prime power q = p^f, where F_q ist the field whereover the matrices are defined \newline +#! This function computes the standard generators of SU +#! as given by C. R. Leedham-Green and E. A. O'Brien in +#! "Constructive Recognition of Classical Groups in odd characteristic". If q is even, LGOStandardGensSUEvenChar(d,q) is called automatically. +DeclareGlobalFunction( "LGOStandardGensSU" ); + + + +##### +# LGOStandardGensSUEvenChar +##### + +#! @Arguments d q +#! @Returns stdgens (the LGO standard-generators of SU(d,q)) for q even +#! @Description +#! d: The dimension of our matrix. \newline +#! q: A 2 power q = 2^f, where F_q ist the field whereover the matrices are defined \newline +#! This function computes the standard generators of Sp +#! as given by C. R. Leedham-Green and E. A. O'Brien in +#! "Constructive Recognition of Classical Groups in even characteristic" +DeclareGlobalFunction( "LGOStandardGensSUEvenChar" ); + + + +##### +# CoefficientsPrimitiveElementS +##### + +#! @Arguments fld, alpha, basis +#! @Returns Coefficients (A vector c sth alpha = sum c[i] b[i]) +#! @Description +#! fld: A field, \newline +#! alpha: An element of fld \newline +#! basis: A F_p basis of fld \newline +#! It expresses an element alpha in a field fld as +#! a linear combination of the basis elements. +DeclareGlobalFunction( "CoefficientsPrimitiveElementS" ); + + + +#################### +# PART II - a) +# UnipotentDecomposition and Transvections +#################### + +##### +# UnitriangularDecompositionSUEven +##### + +#! @Arguments stdgens g +#! @Returns slp (A list of instructions yielding u_1,u_2 if evaluated as SLP), [u_1,g,u_2] (The matrices of the Bruhat-Decomposition) +#! @Description +#! stdgens: The LGO standard-generators \newline +#! g: A matrix in SU(d,q) where d is even and q is odd \newline +#! Computes the Unitriangular decomposition of the matrix g. +DeclareGlobalFunction( "UnitriangularDecompositionSUEven" ); + + + +##### +# UnitriangularDecompositionSUEvenAndEvenChar +##### + +#! @Arguments stdgens g +#! @Returns slp (A list of instructions yielding u_1,u_2 if evaluated as SLP), [u_1,g,u_2] (The matrices of the Bruhat-Decomposition) +#! @Description +#! stdgens: The LGO standard-generators \newline +#! g: A matrix in SU(d,q) where d is even and q is even \newline +#! Computes the Unitriangular decomposition of the matrix g. +DeclareGlobalFunction( "UnitriangularDecompositionSUEvenAndEvenChar" ); + + + +##### +# UnitriangularDecompositionSUOdd +##### + +#! @Arguments stdgens g +#! @Returns slp (A list of instructions yielding u_1,u_2 if evaluated as SLP), [u_1,g,u_2] (The matrices of the Bruhat-Decomposition) +#! @Description +#! stdgens: The LGO standard-generators \newline +#! g: A matrix in SU(d,q) where d is odd and q is odd \newline +#! Computes the Unitriangular decomposition of the matrix g. +DeclareGlobalFunction( "UnitriangularDecompositionSUOdd" ); + + + +##### +# UnitriangularDecompositionSUOddAndEvenChar +##### + +#! @Arguments stdgens g +#! @Returns slp (A list of instructions yielding u_1,u_2 if evaluated as SLP), [u_1,g,u_2] (The matrices of the Bruhat-Decomposition) +#! @Description +#! stdgens: The LGO standard-generators \newline +#! g: A matrix in SU(d,q) where d is odd and q is even \newline +#! Computes the Unitriangular decomposition of the matrix g. +DeclareGlobalFunction( "UnitriangularDecompositionSUOddAndEvenChar" ); + + + +##### +# UnitriangularDecompositionSU +##### + +#! @Arguments stdgens g +#! @Returns slp (A list of instructions yielding u_1,u_2 if evaluated as SLP), [u_1,g,u_2] (The matrices of the Bruhat-Decomposition) +#! @Description +#! stdgens: The LGO standard-generators \newline +#! g: A matrix in SU(d,q) \newline +#! Computes the Unitriangular decomposition of the matrix g. Depending on q and d the correct function of UnitriangularDecompositionSUEven, UnitriangularDecompositionSUOdd and UnitriangularDecompositionSUOdd is choosen. +DeclareGlobalFunction( "UnitriangularDecompositionSU" ); + + + +##################### +# PART III +# Decomposition of Permutation and Diagonal-Matrix +#################### + +##### +# MonomialSLPSUOdd +##### + +#! @Arguments stdgens mat slp +#! @Returns slp (A list of instructions to evaluate tmpvalue. If slp is also given as input then this instructions are added to slp), [tmpvalue,diag] (tmpvalue is a monomial matix such that tmpvalue*mat = diag where diag is a diagonal matrix) +#! @Description +#! stdgens: The LGO standard-generators \newline +#! mat: A monomial matrix (ie w) in SU(d,q) with d odd and q odd \newline +#! slp: An already existing list of instructions *optional \newline +#! In this function we will transform a monomial matrix mat \in SU(d,q) with d even and q odd into +#! a diagonal matrix diag. Using only the standard-generators s,u,v this +#! will lead to a monomial matrix tmpvalue +#! and tmpvalue^{-1} \cdot diag = mat (i.e. diag = tmpvalue*mat ). +#! Furthermore we will return list slp of instructions which will +#! (when evaluated at the LGO standard-generators) yields diag. +DeclareGlobalFunction( "MonomialSLPSUOdd" ); + + + +##### +# MonomialSLPSUOddAndEvenChar +##### + +#! @Arguments stdgens mat slp +#! @Returns slp (A list of instructions to evaluate tmpvalue. If slp is also given as input then this instructions are added to slp), [tmpvalue,diag] (tmpvalue is a monomial matix such that tmpvalue*mat = diag where diag is a diagonal matrix) +#! @Description +#! stdgens: The LGO standard-generators \newline +#! mat: A monomial matrix (ie w) in SU(d,q) with d odd and q even \newline +#! slp: An already existing list of instructions *optional \newline +#! In this function we will transform a monomial matrix mat \in SU(d,q) with d even and q odd into +#! a diagonal matrix diag. Using only the standard-generators s,u,v this +#! will lead to a monomial matrix tmpvalue +#! and tmpvalue^{-1} \cdot diag = mat (i.e. diag = tmpvalue*mat ). +#! Furthermore we will return list slp of instructions which will +#! (when evaluated at the LGO standard-generators) yields diag. +DeclareGlobalFunction( "MonomialSLPSUOddAndEvenChar" ); + + + +##### +# MonomialSLPSUEvenAndEvenChar +##### + +#! @Arguments stdgens mat slp +#! @Returns slp (A list of instructions to evaluate tmpvalue. If slp is also given as input then this instructions are added to slp), [tmpvalue,diag] (tmpvalue is a monomial matix such that tmpvalue*mat = diag where diag is a diagonal matrix) +#! @Description +#! stdgens: The LGO standard-generators \newline +#! mat: A monomial matrix (ie w) in SU(d,q) with d even and q even \newline +#! slp: An already existing list of instructions *optional \newline +#! In this function we will transform a monomial matrix mat \in SU(d,q) with d even and q even into +#! a diagonal matrix diag. Using only the standard-generators s,u,v this +#! will lead to a monomial matrix tmpvalue +#! and tmpvalue^{-1} \cdot diag = mat (i.e. diag = tmpvalue*mat ). +#! Furthermore we will return list slp of instructions which will +#! (when evaluated at the LGO standard-generators) yields diag. +DeclareGlobalFunction( "MonomialSLPSUEvenAndEvenChar" ); + + + +##### +# MonomialSLPSUEven +##### + +#! @Arguments stdgens mat slp +#! @Returns slp (A list of instructions to evaluate tmpvalue. If slp is also given as input then this instructions are added to slp), [tmpvalue,diag] (tmpvalue is a monomial matix such that tmpvalue*mat = diag where diag is a diagonal matrix) +#! @Description +#! stdgens: The LGO standard-generators \newline +#! mat: A monomial matrix (ie w) in SU(d,q) with d even and q odd \newline +#! slp: An already existing list of instructions *optional \newline +#! In this function we will transform a monomial matrix mat \in SU(d,q) with d odd and q odd into +#! a diagonal matrix diag. Using only the standard-generators s,u,v this +#! will lead to a monomial matrix tmpvalue +#! and tmpvalue^{-1} \cdot diag = mat (i.e. diag = tmpvalue*mat ). +#! Furthermore we will return list slp of instructions which will +#! (when evaluated at the LGO standard-generators) yields diag. +DeclareGlobalFunction( "MonomialSLPSUEven" ); + + + +##### +# CheckContinue +##### + +#! @Arguments perm m +#! @Returns True or false +#! @Description +#! perm: A permutation \newline +#! m: A natural number. If this function is called by MonomialSLPSU then m = \frac{d}{2} or m = \frac{(d-1)}{2} \newline +#! This is a help function for MonomialSLPSU. This function checks whether for all cycle c of perm holds: LargestMovedPoint(c) \leq m or SmallestMovedPoint(c) > m. +#! Notice that this is the condition for the main loop of MonomialSLPSU. +DeclareGlobalFunction( "CheckContinue" ); + + + +##### +# CycleFromPermutation +##### + +#! @Arguments g +#! @Returns List of permutations +#! @Description +#! g: A permutation \newline +#! This is a help function for MonomialSLPSUOdd. This function computes the cycles of g and stores them in the output list. +DeclareGlobalFunction( "CycleFromPermutation" ); + + + +##### +# CycleFromListMine +##### + +#! @Arguments nc h +#! @Returns TODO +#! @Description +#! nc: A subset of [1,...,h] \newline +#! h: A natural number (the largest moved point of a permutation) \newline +#! This is a help function for CycleFromPermutation. This function computes a cycle in Sym_h which corresponds to nc. +DeclareGlobalFunction( "CycleFromListMine" ); + + + +##### +# DiagSLPSUOdd +##### + +#! @Arguments stdgens diag slp +#! @Returns slp (A list of instructions to evaluate diag if slp was Input then this instructions are added to slp) +#! @Description +#! stdgens: The LGO standard-generators \newline +#! diag: A diagonal matrix (eg diag) in SU(d,q) with d odd and q odd \newline +#! slp: An already existing list of instructions *optional \newline +#! Writes a list of instructions which evaluated with LGO standard-generators +#! yield the diagonal matrix of the input. +DeclareGlobalFunction( "DiagSLPSUOdd" ); + + + +##### +# DiagSLPSUOddAndEvenChar +##### + +#! @Arguments stdgens diag slp +#! @Returns slp (A list of instructions to evaluate diag if slp was Input then this instructions are added to slp) +#! @Description +#! stdgens: The LGO standard-generators \newline +#! diag: A diagonal matrix (eg diag) in SU(d,q) with d odd and q even \newline +#! slp: An already existing list of instructions *optional \newline +#! Writes a list of instructions which evaluated with LGO standard-generators +#! yield the diagonal matrix of the input. +DeclareGlobalFunction( "DiagSLPSUOddAndEvenChar" ); + + + + +##### +# DiagSLPSU +##### + +#! @Arguments stdgens diag slp +#! @Returns slp (A list of instructions to evaluate diag if slp was Input then this instructions are added to slp) +#! @Description +#! stdgens: The LGO standard-generators \newline +#! diag: A diagonal matrix (eg diag) in SU(d,q) \newline +#! slp: An already existing list of instructions *optional \newline +#! Writes a list of instructions which evaluated with LGO standard-generators +#! yield the diagonal matrix of the input. Depending on q and d the correct function of DiagSLPSUEven, DiagSLPSUEvenAndEvenChar and DiagSLPSUOdd is choosen. +DeclareGlobalFunction( "DiagSLPSU" ); + + + + +##### +# DiagSLPSUEven +##### + +#! @Arguments stdgens diag slp +#! @Returns slp (A list of instructions to evaluate diag if slp was Input then this instructions are added to slp) +#! @Description +#! stdgens: The LGO standard-generators \newline +#! diag: A diagonal matrix (eg diag) in SU(d,q) with d even and q odd \newline +#! slp: An already existing list of instructions *optional \newline +#! Writes a list of instructions which evaluated with LGO standard-generators +#! yield the diagonal matrix of the input. +DeclareGlobalFunction( "DiagSLPSUEven" ); + + + +##### +# DiagSLPSUEvenAndEvenChar +##### + +#! @Arguments stdgens diag slp +#! @Returns slp (A list of instructions to evaluate diag if slp was Input then this instructions are added to slp) +#! @Description +#! stdgens: The LGO standard-generators \newline +#! diag: A diagonal matrix (eg diag) in SU(d,q) with d even and q even \newline +#! slp: An already existing list of instructions *optional \newline +#! Writes a list of instructions which evaluated with LGO standard-generators +#! yield the diagonal matrix of the input. +DeclareGlobalFunction( "DiagSLPSUEvenAndEvenChar" ); + + + +#################### +# PART IV +# Main Functions. Constructs slp for the StraightLineProgram +##################### + +##### +# BruhatDecompositionSU +##### + +#! @Arguments stdgens g +#! @Returns pgr (A SLP to compute u_1,u_2,p_{sign} and diag and the matrices u_1, u_2, p_{sign} and diag itself.) +#! @Description +#! stdgens: The LGO standard-generators \newline +#! g: A matrix in SU(d,q) \newline +#! Uses UnitriangularDecompositionSU(), MonomialSLPSU() and DiagSLPSU() +#! to write a matrix g \in SU(d,q) as g = u_1^{-1} \cdot p_{sign} \cdot diag \cdot u_2^{-1} +#! where u_1,u_2 are lower unitriangular matrices, p_{sign} is a monomial matrix and diag a diagonal matrix. +#! It furthermore yields an SLP that returns the above matrices if evaluated +#! with the LGO standard-generators. +DeclareGlobalFunction( "BruhatDecompositionSU" ); diff --git a/gap/matrix/wordsInNiceGens/BruhatDecompositionSU.gi b/gap/matrix/wordsInNiceGens/BruhatDecompositionSU.gi new file mode 100755 index 00000000..de20aaee --- /dev/null +++ b/gap/matrix/wordsInNiceGens/BruhatDecompositionSU.gi @@ -0,0 +1,4997 @@ +###################################### +# BruhatDecompositionSU.gi +###################################### + +#################### +# PART I - a) +# Originally implemented subfunctions +#################### + +InfoBruhat := NewInfoClass("InfoBruhat");; +SetInfoLevel( InfoBruhat, 2 ); + +##### +# MakePermutationMat() +##### + +InstallGlobalFunction( MakePermutationMat, +function(perm, dim, fld) + + local res; + + res := PermutationMat(perm, dim) * One(fld); + ConvertToMatrixRep(res); + + return res; + +end +); + + + +##### +# CoefficientsPrimitiveElementS() +##### + +InstallGlobalFunction( CoefficientsPrimitiveElementS, +function(fld, alpha, basis) + + return Coefficients( basis, alpha ); + +end +); + + + +##### +# UnitriangularDecompositionSUEven +##### + +InstallGlobalFunction( UnitriangularDecompositionSUEven, +function(arg) + local u1, u2, d, fld, f, alpha, c, r, j, a, z, i, Galois, phi, stdgens, g, ell, slp, hs, tmppos, AEMrespos, u1pos, u2pos, tvpos, T2pos, T3pos, T4pos, tmppos2, uipos, q, f2, TransvecAtAlpha2, TransvecAtAlpha3, TransvecAtAlpha4, test, ShiftTransvection3ByJ, ShiftTransvection3ByI, ShiftTransvection4, ShiftTransvection2ByJ, ShiftTransvection2ByI; + + ##### + # TransvectionAtAlpha2() + ##### + + TransvecAtAlpha2 := function( alpha ) + + local cc, ell, instr; + + # if omega = 1 then we overwrite the position for tv with Ti(1) + if IsOne( alpha ) then + Add(slp, [ [ T2pos[1], 1 ], tvpos ] ); + return; + fi; + + cc := CoefficientsPrimitiveElement( fld, alpha ); + instr := []; + + for ell in [ 1..Length(cc) ] do + + if not IsZero( cc[ell] ) then + Append( instr, [ T2pos[ell], Int(cc[ell]) ] ); + fi; + od; + + if Length( instr ) = 0 then + Error("TransvecAtAlpha2: this should not happen"); + fi; + + Add( slp, [ instr,tvpos ] ); + + return; + + end; + + ##### + # ShiftTransvection2ByI() + ##### + + ShiftTransvection2ByI := function(i) + + local instr; + + i := i-1; + + instr := AEM( 4, AEMrespos, tmppos, i-1 ); + Append( slp, instr ); + Add( slp, [ [ AEMrespos, -1, tvpos , 1, AEMrespos, 1 ], tvpos ] ); + + end; + + ##### + # ShiftTransvection2ByJ() + ##### + + ShiftTransvection2ByJ := function(i, abnr) + + local ui; + + ui := (d/2)-2; + + while ui-i+1-(d/2-abnr) > 0 do + Add(slp, [[uipos[ui-(d/2-abnr)],1,tvpos,1,uipos[ui-(d/2-abnr)],1],tvpos]); + ui := ui-1; + od; + + end; + + ##### + # TransvectionAtAlpha3() + ##### + + TransvecAtAlpha3 := function( alpha ) + + local cc, ell, instr; + + # if omega = 1 then we overwrite the position for tv with Ti(1) + if IsOne( alpha ) then + Add(slp, [ [ T3pos[1], 1 ], tvpos ] ); + return; + fi; + + cc := CoefficientsPrimitiveElement( fld, alpha ); + instr := []; + + for ell in [ 1..Length(cc) ] do + + if not IsZero( cc[ell] ) then + Append( instr, [ T3pos[ell], Int(cc[ell]) ] ); + fi; + od; + + if Length( instr ) = 0 then + Error("TransvecAtAlpha3: this should not happen"); + fi; + + Add( slp, [ instr,tvpos ] ); + + return; + + end; + + ##### + # ShiftTransvection3ByI() + ##### + + ShiftTransvection3ByI := function(i) + + local ui; + + i := d-i+1; + ui := 1; + + while ui < i do + Add(slp, [[uipos[ui],1,tvpos,1,uipos[ui],1],tvpos]); + ui := ui+1; + od; + + end; + + ##### + # ShiftTransvection3ByJ() + ##### + + ShiftTransvection3ByJ := function(i) + + local instr; + + i := i-1; + + Add(slp,[[4,1,5,1],tmppos2]); + instr := AEM( tmppos2, AEMrespos, tmppos, i-1 ); + Append( slp, instr ); + Add( slp, [ [ AEMrespos, -1, tvpos , 1, AEMrespos, 1 ], tvpos ] ); + + end; + + ##### + # TransvectionAtAlpha4() + ##### + + TransvecAtAlpha4 := function( alpha ) + + local cc, ell, instr, w, y, specialalpha, VS, basis; + + y := stdgens[7]; + w := y[1][1]; + specialalpha := w^((q+1)/2); + basis := []; + for ell in [1..f2] do + Add(basis,specialalpha^(-q)*(w^(q+1))^ell); + od; + + VS := VectorSpace(GF(Characteristic(fld)),basis); + + cc := CoefficientsPrimitiveElementS( fld, alpha, Basis(VS,basis)); + instr := []; + + for ell in [ 1..Length(cc) ] do + + if not IsZero( cc[ell] ) then + Append( instr, [ T4pos[ell], Int(cc[ell]) ] ); + fi; + od; + + if Length( instr ) = 0 then + Error("TransvecAtAlpha4: this should not happen"); + fi; + + Add( slp, [ instr,tvpos ] ); + + return; + + end; + + ##### + # ShiftTransvection4() + ##### + + ShiftTransvection4 := function(i) + local instr; + + i := d-i+1; + + if (i= 2 and IsList( arg[1] ) and IsMatrix( arg[2] ) then + + stdgens := arg[1]; # the LGO standard generators + g := arg[2]; + + if Length( stdgens ) < 1 or not IsMatrix( stdgens[1] ) then + + Error("first argument must be the LGO standard generators"); + return; + fi; + + if not IsMatrix( g ) then + Error("second argument must be a matrix"); return; + fi; + else + Error("input: LGO standard generators and a matrix"); + return; + fi; + + if Length(arg) = 3 then + + # The first 10 entries are the stdgens and their inverses + slp := arg[3]; + + if not IsList(slp) then + Error("third argument must be a list"); + return; + fi; + else + # We write an SLP into the variable slp + # The first 14 entries are the stdgens and the inverses + # s, t, del, v, x, s^-1, t^-1, del^-1, v^-1, x^-1 + slp := [ [1,1], [2,1], [3,1], [4,1], [5,1], [6,1], [7,1], + [1,-1],[2,-1],[3,-1],[4,-1],[5,-1], [6,-1], [7,-1] ]; + fi; + + d := Length( g ); + fld := FieldOfMatrixList( stdgens ); + Galois := GaloisGroup(fld); + Galois := Filtered(Galois, x -> Order(x) = 2); + phi := Galois[1]; + + # To create an MSLP, we allocate all the memory needed at the beginning. + Add( slp, [1,0] ); tmppos := Length(slp); #15 + Add( slp, [1,0] ); AEMrespos := Length(slp); #16 + Add( slp, [1,0] ); u1pos := Length(slp); #17 + Add( slp, [1,0] ); u2pos := Length(slp); #18 + Add( slp, [1,0] ); tvpos := Length(slp); #19 + Add( slp, [1,0] ); tmppos2 := Length(slp); #20 + + + u1 := MutableCopyMat( One(g) ); + u2 := MutableCopyMat( One(g) ); + + # If g is already a monomial matrix return u_1 = u_2 = I_d + if TestIfMonomial( g ) then + Add( slp, [ [1,0],[1,0] ] ); + return [ slp, [u1,g,u2] ]; + fi; + + f := LogInt(Size(fld), Characteristic(fld)); #ie q=p^f + q := RootInt(Characteristic(fld)^f); + + hs := HighestSlotOfSLP(slp); + + # We create the help variables for the block top left or bottom right + T2pos := [ hs + 1 .. hs + f ]; + + hs := hs + f; + + for ell in [ 1..f ] do + Add(slp, [1,0] ); + od; + + for ell in [0..f-1] do + + Add(slp, [ [7, -ell, 4, -1, 7, -ell, 4 ,1 ], tmppos ] ); + Add(slp, [ [tmppos, 1, 5, -1, 6, 1, 5, 1, tmppos, -1 ], T2pos[ell+1] ] ); + + od; + + # We create the help variables for the block in the bottom left + T3pos := [ hs + 1 .. hs + f ]; + + hs := hs + f; + + for ell in [ 1..f ] do + Add(slp, [1,0] ); + od; + + for ell in [0..f-1] do + + Add(slp, [ [7, -(ell+ (q+1)/2 ) , 4, -1, 7, -(ell+ (q+1)/2 ), 4 ,1 ], tmppos ] ); + Add(slp, [ [1, -1, 5, -1, tmppos, 1, 5, -1, 6, 1, 5, 1, tmppos, -1 , 5, 1, 1, 1], T3pos[ell+1] ] ); + + od; + + # We create the help variables for the diagonal + f2 := Int((f * 0.5)); + T4pos := [ hs + 1 .. hs + f2 ]; + + hs := hs + f2 ; + + for ell in [ 1..f2 ] do + Add(slp, [1,0] ); + od; + + for ell in [1..f2] do + + Add(slp, [ [7, -ell, 1, -1, 2, 1, 1, 1 , 7, ell], T4pos[ell] ] ); + + od; + + # We create the help variables for the shift + + uipos := [ hs + 1 .. (hs + (d/2)-2) ]; + + hs := hs + ((d/2)-2) ; + + for ell in [ 1 .. ((d/2)-2) ] do + Add(slp, [1,0] ); + od; + + Add( slp, [[5,1],uipos[1]]); + + for ell in [2..((d/2)-2) ] do + Add( slp, [ [ 4, -1, uipos[ell-1] , 1, 4, 1 ], uipos[ell] ] ); + od; + + ############ + # Tests + ############ + + #test :=PseudoRandom(fld); + + #Display(test); + + #TransvecAtAlpha2(test); + #ShiftTransvection2ByI(3); + #ShiftTransvection2ByJ(2, 3); + + #y := stdgens[7]; + #w := y[1][1]; + #specialalpha := w^((q+1)/2); + #basis := []; + #for ell in [1..f2] do + # Add(basis,specialalpha^(-q)*(w^(q+1))^ell); + #od; + + #VS := VectorSpace(GF(Characteristic(fld)),basis); + #test := PseudoRandom(VS); + + #Display(test); + #TransvecAtAlpha4(test); + #ShiftTransvection4(7); + + #TransvecAtAlpha3(test); + #ShiftTransvection3ByJ(4); + #ShiftTransvection3ByI(10); + + #Add(slp, [[tvpos,1],tvpos]); + + #return MakeSLP(slp,7); + + ############ + # Start function + ############ + + g := MutableCopyMat(g); + + for c in [ d, d-1.. (d/2)+1 ] do + + # Find the first non-zero entry in column c + # g_{r,c} will be the pivot. + j := 1; r := 0; + + while r <= d and j <= d and r = 0 do + + if not IsZero(g[j][c]) then + r := j; + fi; + + j := j + 1; + + od; + + if r = 0 then + Error("matrix has 0 column"); + fi; + + a := g[r][c]^-1; + + if r <= d-1 then + + + if not IsZero( g[r+1][c] ) then + + z := - g[r+1][c] * a; + + # add z times row r of g to row r+1 + # add z times row r of u1 to row r+1 + # g[r+1] := g[r+1] + z * g[r]; + # u1[r+1] := u1[r+1] + z * u1[r]; + #Mul := MutableCopyMat( One(g) ); + + if (r+r+1 <> d+1) then + + if r in [1..d/2] and r+1 in [1..d/2] then + TransvecAtAlpha2(z); + ShiftTransvection2ByI(r+1); + ShiftTransvection2ByJ(r, r+1); + else + TransvecAtAlpha2(-z^phi); + ShiftTransvection2ByI(d-r+1); + ShiftTransvection2ByJ(d-r,d-r+1); + fi; + + #Mul[r+1][r] := z; + g[r+1] := g[r+1] + z * g[r]; + u1[r+1] := u1[r+1] + z * u1[r]; + + #Mul[d-r+1][d-r] := -z^phi; + g[d-r+1] := g[d-r+1] + -z^phi * g[d-r]; + u1[d-r+1] := u1[d-r+1] + -z^phi * u1[d-r]; + + else + # Mul[r+1][r] := z; + + TransvecAtAlpha4(z); + ShiftTransvection4(r+1); + + g[r+1] := g[r+1] + z * g[r]; + u1[r+1] := u1[r+1] + z * u1[r]; + fi; + + Add(slp,[[tvpos,1,u1pos,1],u1pos]); + + #g := Mul * g; + #u1 := Mul * u1; + + fi; + + + # Second: Clear the rest of column c + for i in [ r+1..d ] do + + if not IsZero(g[i][c]) then + + z := -g[i][c] * a; + + # add z times row r of g to row i + # add z times row r of u1 to row i + #g[i] := g[i] + z*g[r]; + #u1[i] := u1[i] + z*u1[r]; + #Mul := MutableCopyMat( One(g) ); + + if (i+r <> d+1) then + + if i in [1..d/2] and r in [1..d/2] then + TransvecAtAlpha2(z); + ShiftTransvection2ByI(i); + ShiftTransvection2ByJ(r, i); + elif i in [((d/2)+1)..d] and r in [((d/2)+1)..d] then + TransvecAtAlpha2(-z^phi); + ShiftTransvection2ByI(d-r+1); + ShiftTransvection2ByJ(d-i+1,d-r+1); # Davor d-r in erster Komponente + elif i+r < d+1 then + TransvecAtAlpha3(-z^phi); + ShiftTransvection3ByJ(d-i+1); + ShiftTransvection3ByI(d-r+1); + else + TransvecAtAlpha3(z); + ShiftTransvection3ByJ(r); + ShiftTransvection3ByI(i); + fi; + + #Mul[i][r] := z; + g[i] := g[i] + z*g[r]; + u1[i] := u1[i] + z*u1[r]; + + #Mul[d-r+1][d-i+1] := -z^phi; + g[d-r+1] := g[d-r+1] + -z^phi * g[d-i+1]; + u1[d-r+1] := u1[d-r+1] + -z^phi * u1[d-i+1]; + else + #Mul[i][r] := z; + + TransvecAtAlpha4(z); + + if i > r then + ShiftTransvection4(i); + else + ShiftTransvection4(r); + fi; + + g[i] := g[i] + z*g[r]; + u1[i] := u1[i] + z*u1[r]; + fi; + + Add(slp,[[tvpos,1,u1pos,1],u1pos]); + + #g := Mul * g; + #u1 := Mul * u1; + + fi; + + od; + + fi; + + + # Step Two: Clear all entries in row r apart from g[r][c] + # This coincides with multiplying t_{c,j} from right. + if c >= 2 then + + if not IsZero( g[r][c-1] ) then + + z := -g[r][c-1] * a; + + # add z times column c of g to column c-1 + # add z times column c of u2 to column c-1 + #g{[ 1..d ]}[ c-1 ] := g{[ 1..d ]}[ c-1 ] + z * g{[1..d]}[c]; + #u2{[1..d]}[c-1] := u2{[1..d]}[c-1] + z * u2{[1..d]}[c]; + #Mul := MutableCopyMat( One(g) ); + + if (c+c-1 <> d+1) then + + if c in [1..d/2] and c-1 in [1..d/2] then + TransvecAtAlpha2(z); + ShiftTransvection2ByI(c); + ShiftTransvection2ByJ(c-1, c); + else + TransvecAtAlpha2(-z^phi); + ShiftTransvection2ByI(d-c+2); + ShiftTransvection2ByJ(d-c+1,d-c+2); + fi; + + #Mul[c][c-1] := z; + g{[ 1..d ]}[ c-1 ] := g{[ 1..d ]}[ c-1 ] + z * g{[1..d]}[c]; + u2{[1..d]}[c-1] := u2{[1..d]}[c-1] + z * u2{[1..d]}[c]; + + #Mul[d-c+2][d-c+1] := -z^phi; + g{[ 1..d ]}[ d-c+1 ] := g{[ 1..d ]}[ d-c+1 ] + (-z^phi) * g{[1..d]}[d-c+2]; + u2{[1..d]}[d-c+1] := u2{[1..d]}[d-c+1] + (-z^phi) * u2{[1..d]}[d-c+2]; + else + #Mul[c][c-1] := z; + + TransvecAtAlpha4(z); + ShiftTransvection4(c); + + g{[ 1..d ]}[ c-1 ] := g{[ 1..d ]}[ c-1 ] + z * g{[1..d]}[c]; + u2{[1..d]}[c-1] := u2{[1..d]}[c-1] + z * u2{[1..d]}[c]; + fi; + + Add(slp,[[u2pos,1,tvpos,1],u2pos]); + + #g := g * Mul; + #u2 := u2 * Mul; + + fi; + + # Now clear the rest of row r + for j in [ c-2, c-3..1 ] do + + if not IsZero( g[r][j] ) then + + z := - g[r][j] * a; + + # add z times column c of g to column j + # add z times column c of u2 to column j + # g{[1..d]}[j] := g{[1..d]}[j] + z * g{[1..d]}[c]; + #u2{[1..d]}[j] := u2{[1..d]}[j] + z * u2{[1..d]}[c]; + #Mul := MutableCopyMat( One(g) ); + + if (c+j <> d+1) then + + if c in [1..d/2] and j in [1..d/2] then + TransvecAtAlpha2(z); + ShiftTransvection2ByI(c); + ShiftTransvection2ByJ(j, c); + elif c in [((d/2)+1)..d] and j in [((d/2)+1)..d] then + TransvecAtAlpha2(-z^phi); + ShiftTransvection2ByI(d-j+1); + ShiftTransvection2ByJ(d-c+1,d-j+1); + elif c+j < d+1 then + TransvecAtAlpha3(-z^phi); + ShiftTransvection3ByJ(d-c+1); + ShiftTransvection3ByI(d-j+1); + else + TransvecAtAlpha3(z); + ShiftTransvection3ByJ(j); + ShiftTransvection3ByI(c); + fi; + + #Mul[c][j] := z; + g{[1..d]}[j] := g{[1..d]}[j] + z * g{[1..d]}[c]; + u2{[1..d]}[j] := u2{[1..d]}[j] + z * u2{[1..d]}[c]; + + #Mul[d-j+1][d-c+1] := -z^phi; + g{[1..d]}[d-c+1] := g{[1..d]}[d-c+1] + (-z^phi) * g{[1..d]}[d-j+1]; + u2{[1..d]}[d-c+1] := u2{[1..d]}[d-c+1] + (-z^phi) * u2{[1..d]}[d-j+1]; + else + + TransvecAtAlpha4(z); + + if c > j then + ShiftTransvection4(c); + else + ShiftTransvection4(j); + fi; + + #Mul[c][j] := z; + g{[1..d]}[j] := g{[1..d]}[j] + z * g{[1..d]}[c]; + u2{[1..d]}[j] := u2{[1..d]}[j] + z * u2{[1..d]}[c]; + fi; + + Add(slp,[[u2pos,1,tvpos,1],u2pos]); + + #g := g * Mul; + #u2 := u2 * Mul; + + fi; + od; + + fi; + od; + + #Add(slp,[[u1pos,1],u1pos]); + #test := MakeSLP(slp,7); + #if not(ResultOfStraightLineProgram(test,stdgens)= u1) then + # Error("u1"); + #fi; + #Add(slp,[[u2pos,1],u2pos]); + #test := MakeSLP(slp,7); + #if not(ResultOfStraightLineProgram(test,stdgens)= u2) then + # Error("u1"); + #fi; + #Display(ResultOfStraightLineProgram(slp,stdgens)= u1); + #Display(ResultOfStraightLineProgram(slp,stdgens)= u2); + #return slp; + #Display(g); + + Add( slp, [ [u1pos,1], [u2pos,1] ]); + + # Now u1^-1 * g * u2^-1 is the input matrix + return [slp,[g, u1, u2], hs]; + +end +); + + + +##### +# UnitriangularDecompositionSUEvenAndEvenChar +##### + +InstallGlobalFunction( UnitriangularDecompositionSUEvenAndEvenChar, +function(arg) + local u1, u2, d, fld, f, alpha, c, r, j, a, z, i, Galois, phi, stdgens, g, ell, slp, hs, tmppos, AEMrespos, u1pos, u2pos, tvpos, T2pos, T3pos, T4pos, tmppos2, uipos, q, f2, TransvecAtAlpha2, TransvecAtAlpha3, TransvecAtAlpha4, test, ShiftTransvection3ByJ, ShiftTransvection3ByI, ShiftTransvection4, ShiftTransvection2ByJ, ShiftTransvection2ByI; + + ##### + # TransvectionAtAlpha2() + ##### + + TransvecAtAlpha2 := function( alpha ) + + local cc, ell, instr; + + # if omega = 1 then we overwrite the position for tv with Ti(1) + if IsOne( alpha ) then + Add(slp, [ [ T2pos[1], 1 ], tvpos ] ); + return; + fi; + + cc := CoefficientsPrimitiveElement( fld, alpha ); + instr := []; + + for ell in [ 1..Length(cc) ] do + + if not IsZero( cc[ell] ) then + Append( instr, [ T2pos[ell], Int(cc[ell]) ] ); + fi; + od; + + if Length( instr ) = 0 then + Error("TransvecAtAlpha2: this should not happen"); + fi; + + Add( slp, [ instr,tvpos ] ); + + return; + + end; + + ##### + # ShiftTransvection2ByI() + ##### + + ShiftTransvection2ByI := function(i) + + local instr; + + i := i-1; + + instr := AEM( 4, AEMrespos, tmppos, i-1 ); + Append( slp, instr ); + Add( slp, [ [ AEMrespos, -1, tvpos , 1, AEMrespos, 1 ], tvpos ] ); + + end; + + ##### + # ShiftTransvection2ByJ() + ##### + + ShiftTransvection2ByJ := function(i, abnr) + + local ui; + + ui := (d/2)-2; + + while ui-i+1-(d/2-abnr) > 0 do + Add(slp, [[uipos[ui-(d/2-abnr)],1,tvpos,1,uipos[ui-(d/2-abnr)],1],tvpos]); + ui := ui-1; + od; + + end; + + ##### + # TransvectionAtAlpha3() + ##### + + TransvecAtAlpha3 := function( alpha ) + + local cc, ell, instr; + + # if omega = 1 then we overwrite the position for tv with Ti(1) + if IsOne( alpha ) then + Add(slp, [ [ T3pos[1], 1 ], tvpos ] ); + return; + fi; + + cc := CoefficientsPrimitiveElement( fld, alpha ); + instr := []; + + for ell in [ 1..Length(cc) ] do + + if not IsZero( cc[ell] ) then + Append( instr, [ T3pos[ell], Int(cc[ell]) ] ); + fi; + od; + + if Length( instr ) = 0 then + Error("TransvecAtAlpha3: this should not happen"); + fi; + + Add( slp, [ instr,tvpos ] ); + + return; + + end; + + ##### + # ShiftTransvection3ByI() + ##### + + ShiftTransvection3ByI := function(i) + + local ui; + + i := d-i+1; + ui := 1; + + while ui < i do + Add(slp, [[uipos[ui],1,tvpos,1,uipos[ui],1],tvpos]); + ui := ui+1; + od; + + end; + + ##### + # ShiftTransvection3ByJ() + ##### + + ShiftTransvection3ByJ := function(i) + + local instr; + + i := i-1; + + Add(slp,[[4,1,5,1],tmppos2]); + instr := AEM( tmppos2, AEMrespos, tmppos, i-1 ); + Append( slp, instr ); + Add( slp, [ [ AEMrespos, -1, tvpos , 1, AEMrespos, 1 ], tvpos ] ); + + end; + + ##### + # TransvectionAtAlpha4() + ##### + + TransvecAtAlpha4 := function( alpha ) + + local cc, ell, instr, w, y, VS, basis; + + y := stdgens[7]; + w := y[1][1]; + basis := []; + for ell in [1..f2] do + Add(basis,(w^(q+1))^ell); + od; + + VS := VectorSpace(GF(Characteristic(fld)),basis); + + cc := CoefficientsPrimitiveElementS( fld, alpha, Basis(VS,basis)); ### TODO Replace Basis! Basis is unbelieveable slow! + instr := []; + + for ell in [ 1..Length(cc) ] do + + if not IsZero( cc[ell] ) then + Append( instr, [ T4pos[ell], Int(cc[ell]) ] ); + fi; + od; + + if Length( instr ) = 0 then + Error("TransvecAtAlpha4: this should not happen"); + fi; + + Add( slp, [ instr,tvpos ] ); + + return; + + end; + + ##### + # ShiftTransvection4() + ##### + + ShiftTransvection4 := function(i) + local instr; + + i := d-i+1; + + if (i= 2 and IsList( arg[1] ) and IsMatrix( arg[2] ) then + + stdgens := arg[1]; # the LGO standard generators + g := arg[2]; + + if Length( stdgens ) < 1 or not IsMatrix( stdgens[1] ) then + + Error("first argument must be the LGO standard generators"); + return; + fi; + + if not IsMatrix( g ) then + Error("second argument must be a matrix"); return; + fi; + else + Error("input: LGO standard generators and a matrix"); + return; + fi; + + if Length(arg) = 3 then + + # The first 10 entries are the stdgens and their inverses + slp := arg[3]; + + if not IsList(slp) then + Error("third argument must be a list"); + return; + fi; + else + # We write an SLP into the variable slp + # The first 14 entries are the stdgens and the inverses + # s, t, del, v, x, s^-1, t^-1, del^-1, v^-1, x^-1 + slp := [ [1,1], [2,1], [3,1], [4,1], [5,1], [6,1], [7,1], + [1,-1],[2,-1],[3,-1],[4,-1],[5,-1], [6,-1], [7,-1] ]; + fi; + + d := Length( g ); + fld := FieldOfMatrixList( stdgens ); + Galois := GaloisGroup(fld); + Galois := Filtered(Galois, x -> Order(x) = 2); + phi := Galois[1]; + + # To create an MSLP, we allocate all the memory needed at the beginning. + Add( slp, [1,0] ); tmppos := Length(slp); #15 + Add( slp, [1,0] ); AEMrespos := Length(slp); #16 + Add( slp, [1,0] ); u1pos := Length(slp); #17 + Add( slp, [1,0] ); u2pos := Length(slp); #18 + Add( slp, [1,0] ); tvpos := Length(slp); #19 + Add( slp, [1,0] ); tmppos2 := Length(slp); #20 + + + u1 := MutableCopyMat( One(g) ); + u2 := MutableCopyMat( One(g) ); + + # If g is already a monomial matrix return u_1 = u_2 = I_d + if TestIfMonomial( g ) then + Add( slp, [ [1,0],[1,0] ] ); + return [ slp, [u1,g,u2] ]; + fi; + + f := LogInt(Size(fld), Characteristic(fld)); #ie q=p^f + q := RootInt(Characteristic(fld)^f); + + hs := HighestSlotOfSLP(slp); + + # We create the help variables for the block top left or bottom right + T2pos := [ hs + 1 .. hs + f ]; + + hs := hs + f; + + for ell in [ 1..f ] do + Add(slp, [1,0] ); + od; + + for ell in [0..f-1] do + + Add(slp, [ [7, -ell, 4, -1, 7, -ell, 4 ,1 ], tmppos ] ); + Add(slp, [ [tmppos, 1, 5, -1, 6, 1, 5, 1, tmppos, -1 ], T2pos[ell+1] ] ); + + od; + + # We create the help variables for the block in the bottom left + T3pos := [ hs + 1 .. hs + f ]; + + hs := hs + f; + + for ell in [ 1..f ] do + Add(slp, [1,0] ); + od; + + for ell in [0..f-1] do + + Add(slp, [ [7, -(ell+ 0 ) , 4, -1, 7, -(ell+ 0 ), 4 ,1 ], tmppos ] ); + Add(slp, [ [1, -1, 5, -1, tmppos, 1, 5, -1, 6, 1, 5, 1, tmppos, -1 , 5, 1, 1, 1], T3pos[ell+1] ] ); + + od; + + # We create the help variables for the diagonal + f2 := Int((f * 0.5)); + T4pos := [ hs + 1 .. hs + f2 ]; + + hs := hs + f2 ; + + for ell in [ 1..f2 ] do + Add(slp, [1,0] ); + od; + + for ell in [1..f2] do + + Add(slp, [ [7, -ell, 1, -1, 2, 1, 1, 1 , 7, ell], T4pos[ell] ] ); + + od; + + # We create the help variables for the shift + + uipos := [ hs + 1 .. (hs + (d/2)-2) ]; + + hs := hs + ((d/2)-2) ; + + for ell in [ 1 .. ((d/2)-2) ] do + Add(slp, [1,0] ); + od; + + Add( slp, [[5,1],uipos[1]]); + + for ell in [2..((d/2)-2) ] do + Add( slp, [ [ 4, -1, uipos[ell-1] , 1, 4, 1 ], uipos[ell] ] ); + od; + + ############ + # Tests + ############ + + #test :=PseudoRandom(fld); + + #Display(test); + + #TransvecAtAlpha2(test); + #ShiftTransvection2ByI(3); + #ShiftTransvection2ByJ(2, 3); + + #y := stdgens[7]; + #w := y[1][1]; + #specialalpha := w^((q+1)/2); + #basis := []; + #for ell in [1..f2] do + # Add(basis,specialalpha^(-q)*(w^(q+1))^ell); + #od; + + #VS := VectorSpace(GF(Characteristic(fld)),basis); + #test := PseudoRandom(VS); + + #Display(test); + #TransvecAtAlpha4(test); + #ShiftTransvection4(7); + + #TransvecAtAlpha3(test); + #ShiftTransvection3ByJ(4); + #ShiftTransvection3ByI(10); + + #if fld = GF(4) then + # TransvecAtAlpha2(Z(2^2)^2); + # test:= slp; + # Add(test,[[tvpos,1],tvpos]); + # test := MakeSLP(test,7); + # Display(ResultOfStraightLineProgram(test,stdgens)); + # Error("here"); + #fi; + #test := slp; + #Add(test, [[T2pos[2],1],T2pos[2]]); + #test := MakeSLP(test,7); + #Display(ResultOfStraightLineProgram(test,stdgens)); + + #return MakeSLP(slp,7); + + ############ + # Start function + ############ + + g := MutableCopyMat(g); + + for c in [ d, d-1.. (d/2)+1 ] do + + # Find the first non-zero entry in column c + # g_{r,c} will be the pivot. + j := 1; r := 0; + + while r <= d and j <= d and r = 0 do + + if not IsZero(g[j][c]) then + r := j; + fi; + + j := j + 1; + + od; + + if r = 0 then + Error("matrix has 0 column"); + fi; + + a := g[r][c]^-1; + + if r <= d-1 then + + + if not IsZero( g[r+1][c] ) then + + z := - g[r+1][c] * a; + + # add z times row r of g to row r+1 + # add z times row r of u1 to row r+1 + # g[r+1] := g[r+1] + z * g[r]; + # u1[r+1] := u1[r+1] + z * u1[r]; + #Mul := MutableCopyMat( One(g) ); + + if (r+r+1 <> d+1) then + + if r in [1..d/2] and r+1 in [1..d/2] then + TransvecAtAlpha2(z); + ShiftTransvection2ByI(r+1); + ShiftTransvection2ByJ(r, r+1); + else + TransvecAtAlpha2(-z^phi); + ShiftTransvection2ByI(d-r+1); + ShiftTransvection2ByJ(d-r,d-r+1); + fi; + + #Mul[r+1][r] := z; + g[r+1] := g[r+1] + z * g[r]; + u1[r+1] := u1[r+1] + z * u1[r]; + + #Mul[d-r+1][d-r] := -z^phi; + g[d-r+1] := g[d-r+1] + -z^phi * g[d-r]; + u1[d-r+1] := u1[d-r+1] + -z^phi * u1[d-r]; + + else + # Mul[r+1][r] := z; + + TransvecAtAlpha4(z); + ShiftTransvection4(r+1); + + g[r+1] := g[r+1] + z * g[r]; + u1[r+1] := u1[r+1] + z * u1[r]; + fi; + + Add(slp,[[tvpos,1,u1pos,1],u1pos]); + + #g := Mul * g; + #u1 := Mul * u1; + fi; + + + # Second: Clear the rest of column c + for i in [ r+1..d ] do + + if not IsZero(g[i][c]) then + + z := -g[i][c] * a; + + # add z times row r of g to row i + # add z times row r of u1 to row i + #g[i] := g[i] + z*g[r]; + #u1[i] := u1[i] + z*u1[r]; + #Mul := MutableCopyMat( One(g) ); + + if (i+r <> d+1) then + if i in [1..d/2] and r in [1..d/2] then + TransvecAtAlpha2(z); + ShiftTransvection2ByI(i); + ShiftTransvection2ByJ(r, i); + elif i in [((d/2)+1)..d] and r in [((d/2)+1)..d] then + TransvecAtAlpha2(-z^phi); + ShiftTransvection2ByI(d-r+1); + ShiftTransvection2ByJ(d-i+1,d-r+1); # LOOK SO PLUS + elif i+r < d+1 then + TransvecAtAlpha3(-z^phi); + ShiftTransvection3ByJ(d-i+1); + ShiftTransvection3ByI(d-r+1); + else + TransvecAtAlpha3(z); + ShiftTransvection3ByJ(r); + ShiftTransvection3ByI(i); + fi; + + #Mul[i][r] := z; + g[i] := g[i] + z*g[r]; + u1[i] := u1[i] + z*u1[r]; + + #Mul[d-r+1][d-i+1] := -z^phi; + g[d-r+1] := g[d-r+1] + -z^phi * g[d-i+1]; + u1[d-r+1] := u1[d-r+1] + -z^phi * u1[d-i+1]; + else + #Mul[i][r] := z; + TransvecAtAlpha4(z); + + if i > r then + ShiftTransvection4(i); + else + ShiftTransvection4(r); + fi; + + g[i] := g[i] + z*g[r]; + u1[i] := u1[i] + z*u1[r]; + fi; + + Add(slp,[[tvpos,1,u1pos,1],u1pos]); + + #g := Mul * g; + #u1 := Mul * u1; + + fi; + od; + + fi; + + + # Step Two: Clear all entries in row r apart from g[r][c] + # This coincides with multiplying t_{c,j} from right. + if c >= 2 then + + if not IsZero( g[r][c-1] ) then + + z := -g[r][c-1] * a; + + # add z times column c of g to column c-1 + # add z times column c of u2 to column c-1 + #g{[ 1..d ]}[ c-1 ] := g{[ 1..d ]}[ c-1 ] + z * g{[1..d]}[c]; + #u2{[1..d]}[c-1] := u2{[1..d]}[c-1] + z * u2{[1..d]}[c]; + #Mul := MutableCopyMat( One(g) ); + + if (c+c-1 <> d+1) then + + if c in [1..d/2] and c-1 in [1..d/2] then + TransvecAtAlpha2(z); + ShiftTransvection2ByI(c); + ShiftTransvection2ByJ(c-1, c); + else + TransvecAtAlpha2(-z^phi); + ShiftTransvection2ByI(d-c+2); + ShiftTransvection2ByJ(d-c+1,d-c+2); + fi; + + #Mul[c][c-1] := z; + g{[ 1..d ]}[ c-1 ] := g{[ 1..d ]}[ c-1 ] + z * g{[1..d]}[c]; + u2{[1..d]}[c-1] := u2{[1..d]}[c-1] + z * u2{[1..d]}[c]; + + #Mul[d-c+2][d-c+1] := -z^phi; + g{[ 1..d ]}[ d-c+1 ] := g{[ 1..d ]}[ d-c+1 ] + (-z^phi) * g{[1..d]}[d-c+2]; + u2{[1..d]}[d-c+1] := u2{[1..d]}[d-c+1] + (-z^phi) * u2{[1..d]}[d-c+2]; + else + #Mul[c][c-1] := z; + + TransvecAtAlpha4(z); + ShiftTransvection4(c); + + g{[ 1..d ]}[ c-1 ] := g{[ 1..d ]}[ c-1 ] + z * g{[1..d]}[c]; + u2{[1..d]}[c-1] := u2{[1..d]}[c-1] + z * u2{[1..d]}[c]; + fi; + + Add(slp,[[u2pos,1,tvpos,1],u2pos]); + + #g := g * Mul; + #u2 := u2 * Mul; + + fi; + + # Now clear the rest of row r + for j in [ c-2, c-3..1 ] do + + if not IsZero( g[r][j] ) then + + z := - g[r][j] * a; + + # add z times column c of g to column j + # add z times column c of u2 to column j + # g{[1..d]}[j] := g{[1..d]}[j] + z * g{[1..d]}[c]; + #u2{[1..d]}[j] := u2{[1..d]}[j] + z * u2{[1..d]}[c]; + #Mul := MutableCopyMat( One(g) ); + + if (c+j <> d+1) then + + if c in [1..d/2] and j in [1..d/2] then + TransvecAtAlpha2(z); + ShiftTransvection2ByI(c); + ShiftTransvection2ByJ(j, c); + elif c in [((d/2)+1)..d] and j in [((d/2)+1)..d] then + TransvecAtAlpha2(-z^phi); + ShiftTransvection2ByI(d-j+1); + ShiftTransvection2ByJ(d-c+1,d-j+1); + elif c+j < d+1 then + TransvecAtAlpha3(-z^phi); + ShiftTransvection3ByJ(d-c+1); + ShiftTransvection3ByI(d-j+1); + else + TransvecAtAlpha3(z); + ShiftTransvection3ByJ(j); + ShiftTransvection3ByI(c); + fi; + + #Mul[c][j] := z; + g{[1..d]}[j] := g{[1..d]}[j] + z * g{[1..d]}[c]; + u2{[1..d]}[j] := u2{[1..d]}[j] + z * u2{[1..d]}[c]; + + #Mul[d-j+1][d-c+1] := -z^phi; + g{[1..d]}[d-c+1] := g{[1..d]}[d-c+1] + (-z^phi) * g{[1..d]}[d-j+1]; + u2{[1..d]}[d-c+1] := u2{[1..d]}[d-c+1] + (-z^phi) * u2{[1..d]}[d-j+1]; + else + + TransvecAtAlpha4(z); + + if c > j then + ShiftTransvection4(c); + else + ShiftTransvection4(j); + fi; + + #Mul[c][j] := z; + g{[1..d]}[j] := g{[1..d]}[j] + z * g{[1..d]}[c]; + u2{[1..d]}[j] := u2{[1..d]}[j] + z * u2{[1..d]}[c]; + fi; + + Add(slp,[[u2pos,1,tvpos,1],u2pos]); + + #g := g * Mul; + #u2 := u2 * Mul; + + fi; + od; + + fi; + od; + + #Add(slp,[[u1pos,1],u1pos]); + #test := MakeSLP(slp,7); + #if not(ResultOfStraightLineProgram(test,stdgens)= u1) then + # Error("u1"); + #fi; + #Add(slp,[[u2pos,1],u2pos]); + #test := MakeSLP(slp,7); + #if not(ResultOfStraightLineProgram(test,stdgens)= u2) then + # Error("u1"); + #fi; + #Display(ResultOfStraightLineProgram(slp,stdgens)= u1); + #Display(ResultOfStraightLineProgram(slp,stdgens)= u2); + #return slp; + #Display(g); + + Add( slp, [ [u1pos,1], [u2pos,1] ]); + + # Now u1^-1 * g * u2^-1 is the input matrix + return [slp,[g, u1, u2], hs]; + +end +); + + + +##### +# UnitriangularDecompositionSUOdd +##### + +InstallGlobalFunction( UnitriangularDecompositionSUOdd, +function(arg) + local u1, u2, d, fld, f, alpha, c, r, j, a, z, i, Mul, kon, x, Galois, phi, T2pos, T3pos, T4pos, T5pos, uipos, + TransvecAtAlpha2, ShiftTransvection2ByI, ShiftTransvection2ByJ, TransvecAtAlpha3, ShiftTransvection3ByI, ShiftTransvection3ByJ, + TransvecAtAlpha4, ShiftTransvection4, hs, ell, f2, q, stdgens, g, tmppos, tmppos2, u1pos, u2pos, AEMrespos, tvpos, test, + TransvecAtAlpha5, ShiftTransvection5, slp; + + ##### + # TransvectionAtAlpha2() + ##### + + TransvecAtAlpha2 := function( alpha ) + + local cc, ell, instr; + + # if omega = 1 then we overwrite the position for tv with Ti(1) + if IsOne( alpha ) then + Add(slp, [ [ T2pos[1], 1 ], tvpos ] ); + return; + fi; + + cc := CoefficientsPrimitiveElement( fld, alpha ); + instr := []; + + for ell in [ 1..Length(cc) ] do + + if not IsZero( cc[ell] ) then + Append( instr, [ T2pos[ell], Int(cc[ell]) ] ); + fi; + od; + + if Length( instr ) = 0 then + Error("TransvecAtAlpha2: this should not happen"); + fi; + + Add( slp, [ instr,tvpos ] ); + + return; + + end; + + ##### + # ShiftTransvection2ByI() + ##### + + ShiftTransvection2ByI := function(i) + + local instr; + + i := i-1; + + instr := AEM( 4, AEMrespos, tmppos, i-1 ); + Append( slp, instr ); + Add( slp, [ [ AEMrespos, -1, tvpos , 1, AEMrespos, 1 ], tvpos ] ); + + end; + + ##### + # ShiftTransvection2ByJ() + ##### + + ShiftTransvection2ByJ := function(i, abnr) + + local ui; + + ui := (d/2)-2; + + while ui-i+1-(d/2-abnr) > 0 do + Add(slp, [[uipos[ui-(d/2-abnr)],1,tvpos,1,uipos[ui-(d/2-abnr)],1],tvpos]); + ui := ui-1; + od; + + end; + + ##### + # TransvectionAtAlpha3() + ##### + + TransvecAtAlpha3 := function( alpha ) + + local cc, ell, instr; + + # if omega = 1 then we overwrite the position for tv with Ti(1) + if IsOne( alpha ) then + Add(slp, [ [ T3pos[1], 1 ], tvpos ] ); + return; + fi; + + cc := CoefficientsPrimitiveElement( fld, alpha ); + instr := []; + + for ell in [ 1..Length(cc) ] do + + if not IsZero( cc[ell] ) then + Append( instr, [ T3pos[ell], Int(cc[ell]) ] ); + fi; + od; + + if Length( instr ) = 0 then + Error("TransvecAtAlpha3: this should not happen"); + fi; + + Add( slp, [ instr,tvpos ] ); + + return; + + end; + + ##### + # ShiftTransvection3ByI() + ##### + + ShiftTransvection3ByI := function(i) + + local ui; + + i := d-i+1; + ui := 1; + + while ui < i do + Add(slp, [[uipos[ui],1,tvpos,1,uipos[ui],1],tvpos]); + ui := ui+1; + od; + + end; + + ##### + # ShiftTransvection3ByJ() + ##### + + ShiftTransvection3ByJ := function(i) + + local instr; + + i := i-1; + + Add(slp,[[4,1,5,1],tmppos2]); + instr := AEM( tmppos2, AEMrespos, tmppos, i-1 ); + Append( slp, instr ); + Add( slp, [ [ AEMrespos, -1, tvpos , 1, AEMrespos, 1 ], tvpos ] ); + + end; + + ##### + # TransvectionAtAlpha4() + ##### + + TransvecAtAlpha4 := function( alpha ) + + local cc, ell, instr, w, y, specialalpha, VS, basis; + + y := stdgens[7]; + w := y[d][d]; + specialalpha := w^((q+1)/2); + basis := []; + for ell in [1..f2] do + Add(basis,specialalpha^(-q)*(w^(q+1))^ell); + od; + + VS := VectorSpace(GF(Characteristic(fld)),basis); + + cc := CoefficientsPrimitiveElementS( fld, alpha, Basis(VS,basis)); + instr := []; + + for ell in [ 1..Length(cc) ] do + + if not IsZero( cc[ell] ) then + Append( instr, [ T4pos[ell], Int(cc[ell]) ] ); + fi; + od; + + if Length( instr ) = 0 then + Error("TransvecAtAlpha4: this should not happen"); + fi; + + Add( slp, [ instr,tvpos ] ); + + return; + + end; + + ##### + # ShiftTransvection4() + ##### + + ShiftTransvection4 := function(i) + local instr; + + i := d-i+1; + + if (i= 2 and IsList( arg[1] ) and IsMatrix( arg[2] ) then + + stdgens := arg[1]; # the LGO standard generators + g := arg[2]; + + if Length( stdgens ) < 1 or not IsMatrix( stdgens[1] ) then + + Error("first argument must be the LGO standard generators"); + return; + fi; + + if not IsMatrix( g ) then + Error("second argument must be a matrix"); return; + fi; + else + Error("input: LGO standard generators and a matrix"); + return; + fi; + + if Length(arg) = 3 then + + # The first 10 entries are the stdgens and their inverses + slp := arg[3]; + + if not IsList(slp) then + Error("third argument must be a list"); + return; + fi; + else + # We write an SLP into the variable slp + # The first 14 entries are the stdgens and the inverses + # s, t, del, v, x, s^-1, t^-1, del^-1, v^-1, x^-1 + slp := [ [1,1], [2,1], [3,1], [4,1], [5,1], [6,1], [7,1], + [1,-1],[2,-1],[3,-1],[4,-1],[5,-1], [6,-1], [7,-1] ]; + fi; + + d := Length( g ); + fld := FieldOfMatrixList( [g] ); + Galois := GaloisGroup(fld); + Galois := Filtered(Galois, x -> Order(x) = 2); + phi := Galois[1]; + + # To create an MSLP, we allocate all the memory needed at the beginning. + Add( slp, [1,0] ); tmppos := Length(slp); #15 + Add( slp, [1,0] ); AEMrespos := Length(slp); #16 + Add( slp, [1,0] ); u1pos := Length(slp); #17 + Add( slp, [1,0] ); u2pos := Length(slp); #18 + Add( slp, [1,0] ); tvpos := Length(slp); #19 + Add( slp, [1,0] ); tmppos2 := Length(slp); #20 + + + u1 := MutableCopyMat( One(g) ); + u2 := MutableCopyMat( One(g) ); + + # If g is already a monomial matrix return u_1 = u_2 = I_d + if TestIfMonomial( g ) then + Add( slp, [ [1,0],[1,0] ] ); + return [ slp, [u1,g,u2] ]; + fi; + + f := LogInt(Size(fld), Characteristic(fld)); #ie q=p^f + q := RootInt(Characteristic(fld)^f); + + hs := HighestSlotOfSLP(slp); + + # We create the help variables for the block top left or bottom right + T2pos := [ hs + 1 .. hs + f ]; + + hs := hs + f; + + for ell in [ 1..f ] do + Add(slp, [1,0] ); + od; + + Add(slp, [ [4, -1, 6, 1, 4, 1, 6 , -1, 4,-1, 6,-1, 4,1,6,1 ], tmppos2 ] ); + + for ell in [0..f-1] do + + Add(slp, [ [7, ell-((q^2+q)/2), 4, -2, 7, -(ell-((q^2+q)/2)), 4 ,2 ], tmppos ] ); + Add(slp, [ [5,-1,1,-1,tmppos, 1, tmppos2, -1, tmppos, -1, 1, 1, 5, 1], T2pos[ell+1] ] ); + + od; + + # We create the help variables for the block in the bottom left + T3pos := [ hs + 1 .. hs + f ]; + + hs := hs + f; + + for ell in [ 1..f ] do + Add(slp, [1,0] ); + od; + + Add(slp, [ [4, -1, 6, 1, 4, 1, 6 , -1, 4,-1, 6,-1, 4,1,6,1 ], tmppos2 ] ); + + for ell in [0..f-1] do + + Add(slp, [ [7, ell, 4, -2, 7, -ell, 4 ,2 ], tmppos ] ); + Add(slp, [ [tmppos, 1, tmppos2, -1, tmppos, -1], T3pos[ell+1] ] ); + + od; + + # We create the help variables for the diagonal + f2 := Int((f * 0.5)); + T4pos := [ hs + 1 .. hs + f2 ]; + + hs := hs + f2 ; + + for ell in [ 1..f2 ] do + Add(slp, [1,0] ); + od; + + for ell in [1..f2] do + + Add(slp, [ [7, ell, 1, -1, 2, 1, 1, 1 , 7, -ell], T4pos[ell] ] ); + + od; + + # We create the help variables for the centre row and column + T5pos := [ hs + 1 .. hs + f ]; + + hs := hs + f; + + for ell in [ 1..f ] do + Add(slp, [1,0] ); + od; + + for ell in [0..f-1] do + + Add(slp, [ [7, ell , 4, -2, 7, -ell, 4 ,2 ], tmppos ] ); + Add(slp, [ [tmppos, 1, 6, 1, tmppos, -1], T5pos[ell+1] ] ); + + #test := slp; + #test := MakeSLP(test,7); + #Display(ResultOfStraightLineProgram(test,stdgens)); + + od; + + # We create the help variables for the shift + + uipos := [ hs + 1 .. (hs + ((d-1)/2)-2) ]; + + hs := hs + (((d-1)/2)-2) ; + + for ell in [ 1 .. (((d-1)/2)-2) ] do + Add(slp, [1,0] ); + od; + + Add( slp, [[5,1],uipos[1]]); + + for ell in [2..(((d-1)/2)-2) ] do + Add( slp, [ [ 4, -1, uipos[ell-1] , 1, 4, 1 ], uipos[ell] ] ); + od; + + ############ + # Tests + ############ + + #test :=PseudoRandom(fld); + + #Display(test); + + #TransvecAtAlpha2(test); + #ShiftTransvection2ByI(5); + #ShiftTransvection2ByJ(4, 5); + + #y := stdgens[7]; + #w := y[d][d]; + #specialalpha := w^((q+1)/2); + #basis := []; + #for ell in [1..f2] do + # Add(basis,specialalpha^(-q)*(w^(q+1))^ell); + #od; + + #VS := VectorSpace(GF(Characteristic(fld)),basis); + #test := PseudoRandom(VS); + + #Display(test); + #TransvecAtAlpha4(test); + #ShiftTransvection4(7); + + #TransvecAtAlpha3(test); + #ShiftTransvection3ByJ(4); + #ShiftTransvection3ByI(10); + + #Add(slp, [[tvpos,1],tvpos]); + + #TransvecAtAlpha5(test); + #ShiftTransvection5(10); + + #return MakeSLP(slp,7); + + ############ + # Start function + ############ + + g := MutableCopyMat( g ); + + for c in [ d, d-1.. ((d+1)/2)+1 ] do + + # Find the first non-zero entry in column c + # g_{r,c} will be the pivot. + j := 1; r := 0; + + while r <= d and j <= d and r = 0 do + + if not IsZero(g[j][c]) then + r := j; + fi; + + j := j + 1; + + od; + + if r = 0 then + Error("matrix has 0 column"); + fi; + + a := g[r][c]^-1; + + if r <= d-1 then + + if (not(IsZero(g[(d+1)/2][c])) and (c <> ((d+1)/2))) then + i := (d+1)/2; + z := -g[i][c] * a; + + # add z times row r of g to row i + # add z times row r of u1 to row i + #g[i] := g[i] + z*g[r]; + #u1[i] := u1[i] + z*u1[r]; + + if (i+r <> d+1) then + #Mul := List( One(SU(11,25)), ShallowCopy ); + #Mul[i][r] := z; + + x := TransvecAtAlpha5(-z^phi); + ShiftTransvection5(d-r+1); + + #for x in fld do + # if ((-z)^phi)*(-z)+x+x^phi = Zero(fld) then + # #Mul[d-r+1][r] := x; + # break; + # fi; + #od; + + g[d-r+1] := g[d-r+1] + x * g[r]; + u1[d-r+1] := u1[d-r+1] + x * u1[r]; + + #Mul[d-r+1][d-i+1] := -z^phi; + g[d-r+1] := g[d-r+1] + -z^phi * g[d-i+1]; + u1[d-r+1] := u1[d-r+1] + -z^phi * u1[d-i+1]; + + g[i] := g[i] + z*g[r]; + u1[i] := u1[i] + z*u1[r]; + else + #Mul[i][r] := z; + + TransvecAtAlpha4(z); + + if i > r then + ShiftTransvection4(i); + else + ShiftTransvection4(r); + fi; + + g[i] := g[i] + z*g[r]; + u1[i] := u1[i] + z*u1[r]; + fi; + + Add(slp,[[tvpos,1,u1pos,1],u1pos]); + + #g := Mul * g; + #u1 := Mul * u1; + + fi; + + if not IsZero( g[r+1][c] ) and (r+1 <> (d+1)/2) then + + z := - g[r+1][c] * a; + + if (r+1 <> (d+1)/2) then + + # add z times row r of g to row r+1 + # add z times row r of u1 to row r+1 + # g[r+1] := g[r+1] + z * g[r]; + # u1[r+1] := u1[r+1] + z * u1[r]; + #Mul := List( One(G), ShallowCopy ); + + if (r+r+1 <> d+1) then + + if r+1 in [1..(d+1)/2] then + TransvecAtAlpha2(z); + ShiftTransvection2ByI(r+1); + ShiftTransvection2ByJ(r, r+1); + else + TransvecAtAlpha2(-z^phi); + ShiftTransvection2ByI(d-r+1); + ShiftTransvection2ByJ(d-r,d-r+1); + fi; + + #Mul[r+1][r] := z; + g[r+1] := g[r+1] + z * g[r]; + u1[r+1] := u1[r+1] + z * u1[r]; + + #Mul[d-r+1][d-r] := -(z)^phi; + g[d-r+1] := g[d-r+1] + -z^phi * g[d-r]; + u1[d-r+1] := u1[d-r+1] + -z^phi * u1[d-r]; + else + #Mul[r+1][r] := z; + + TransvecAtAlpha4(z); + ShiftTransvection4(r+1); + + g[r+1] := g[r+1] + z * g[r]; + u1[r+1] := u1[r+1] + z * u1[r]; + fi; + + Add(slp,[[tvpos,1,u1pos,1],u1pos]); + + #g := Mul * g; + #u1 := Mul * u1; + + else + #Mul := List( One(G), ShallowCopy ); + + if (r+r+1 <> d+1) then + + #Display("Test"); + #Mul[r+1][r] := z; + g[r+1] := g[r+1] + z * g[r]; + u1[r+1] := u1[r+1] + z * u1[r]; + + #Mul[d-r+1][d-r] := -z^phi; + g[d-r+1] := g[d-r+1] + -z^phi * g[d-r]; + u1[d-r+1] := u1[d-r+1] + -z^phi * u1[d-r]; + else + #Mul[r+1][r] := z; + + TransvecAtAlpha4(z); + ShiftTransvection4(r+1); + + g[r+1] := g[r+1] + z * g[r]; + u1[r+1] := u1[r+1] + z * u1[r]; + fi; + + Add(slp,[[tvpos,1,u1pos,1],u1pos]); + + #g := Mul * g; + #u1 := Mul * u1; + + fi; + fi; + + + # Second: Clear the rest of column c + for i in [ r+2..d ] do + + if not IsZero(g[i][c]) and (i <> (d+1)/2) then + + z := -g[i][c] * a; + + # add z times row r of g to row i + # add z times row r of u1 to row i + #g[i] := g[i] + z*g[r]; + #u1[i] := u1[i] + z*u1[r]; + #Mul := List( One(G), ShallowCopy ); + + if (i+r <> d+1) then + + if i in [1..(d+1)/2] and r in [1..(d+1)/2] then + TransvecAtAlpha2(z); + ShiftTransvection2ByI(i); + ShiftTransvection2ByJ(r, i); + elif i in [(((d+1)/2)+1)..d] and r in [(((d+1)/2)+1)..d] then + TransvecAtAlpha2(-z^phi); + ShiftTransvection2ByI(d-r+1); + ShiftTransvection2ByJ(d-i+1,d-r+1); # Davor d-r in erster Komponente + elif i+r < d+1 then + TransvecAtAlpha3(-z^phi); + ShiftTransvection3ByJ(d-i+1); + ShiftTransvection3ByI(d-r+1); + else + TransvecAtAlpha3(z); + ShiftTransvection3ByJ(r); + ShiftTransvection3ByI(i); + fi; + + #Mul[i][r] := z; + g[i] := g[i] + z*g[r]; + u1[i] := u1[i] + z*u1[r]; + + #Mul[d-r+1][d-i+1] := -z^phi; + g[d-r+1] := g[d-r+1] + -z^phi * g[d-i+1]; + u1[d-r+1] := u1[d-r+1] + -z^phi * u1[d-i+1]; + else + TransvecAtAlpha4(z); + + if i > r then + ShiftTransvection4(i); + else + ShiftTransvection4(r); + fi; + + g[i] := g[i] + z*g[r]; + u1[i] := u1[i] + z*u1[r]; + fi; + + Add(slp,[[tvpos,1,u1pos,1],u1pos]); + + #g := Mul * g; + #u1 := Mul * u1; + + fi; + od; + fi; + + + + # Step Two: Clear all entries in row r apart from g[r][c] + # This coincides with multiplying t_{c,j} from right. + if c >= 2 then + + + if not IsZero(g[r][(d+1)/2]) and (r <> ((d+1)/2)) then + j := (d+1)/2; + z := -g[r][j] * a; + + # add z times row r of g to row i + # add z times row r of u1 to row i + #g[i] := g[i] + z*g[r]; + #u1[i] := u1[i] + z*u1[r]; + + if (c+j <> d+1) then + #Mul := List( One(SU(11,25)), ShallowCopy ); + #Mul[c][j] := z; + + x := TransvecAtAlpha5(z); + ShiftTransvection5(c); + + #for x in fld do + # if ((-z)^phi)*(-z)+x+x^phi = Zero(fld) then + # #Mul[c][d-c+1] := x; + # break; + # fi; + #od; + #Mul[d-j+1][d-c+1] := -z^phi; + #Mul[c][d-c+1] := x; + #Display(g*Mul); + + g{[1..d]}[d-c+1] := g{[1..d]}[d-c+1] + x * g{[1..d]}[c]; + u2{[1..d]}[d-c+1] := u2{[1..d]}[d-c+1] + x * u2{[1..d]}[c]; + + g{[1..d]}[d-c+1] := g{[1..d]}[d-c+1] + (-z^phi) * g{[1..d]}[d-j+1]; + u2{[1..d]}[d-c+1] := u2{[1..d]}[d-c+1] + (-z^phi) * u2{[1..d]}[d-j+1]; + + g{[1..d]}[j] := g{[1..d]}[j] + z * g{[1..d]}[c]; + u2{[1..d]}[j] := u2{[1..d]}[j] + z * u2{[1..d]}[c]; + + else + #Mul[i][r] := z; + + TransvecAtAlpha4(z); + + if c > j then + ShiftTransvection4(c); + else + ShiftTransvection4(j); + fi; + + g{[1..d]}[j] := g{[1..d]}[j] + z * g{[1..d]}[c]; + u2{[1..d]}[j] := u2{[1..d]}[j] + z * u2{[1..d]}[c]; + fi; + + Add(slp,[[u2pos,1,tvpos,1],u2pos]); + + #g := g * Mul; + #u2 := u2 * Mul; + fi; + + + if not IsZero( g[r][c-1] ) and (c-1 <> (d+1)/2) then + + z := -g[r][c-1] * a; + + # add z times column c of g to column c-1 + # add z times column c of u2 to column c-1 + #g{[ 1..d ]}[ c-1 ] := g{[ 1..d ]}[ c-1 ] + z * g{[1..d]}[c]; + #u2{[1..d]}[c-1] := u2{[1..d]}[c-1] + z * u2{[1..d]}[c]; + + #Mul := List( One(G), ShallowCopy ); + + if (c+c-1 <> d+1) then + + if c in [1..(d+1)/2] and c-1 in [1..(d+1)/2] then + TransvecAtAlpha2(z); + ShiftTransvection2ByI(c); + ShiftTransvection2ByJ(c-1, c); + else + TransvecAtAlpha2(-z^phi); + ShiftTransvection2ByI(d-c+2); + ShiftTransvection2ByJ(d-c+1,d-c+2); + fi; + + #Mul[c][c-1] := z; + g{[ 1..d ]}[ c-1 ] := g{[ 1..d ]}[ c-1 ] + z * g{[1..d]}[c]; + u2{[1..d]}[c-1] := u2{[1..d]}[c-1] + z * u2{[1..d]}[c]; + + #Mul[d-c+2][d-c+1] := -z^phi; + g{[ 1..d ]}[ d-c+1 ] := g{[ 1..d ]}[ d-c+1 ] + (-z^phi) * g{[1..d]}[d-c+2]; + u2{[1..d]}[d-c+1] := u2{[1..d]}[d-c+1] + (-z^phi) * u2{[1..d]}[d-c+2]; + else + #Mul[c][c-1] := z; + + TransvecAtAlpha4(z); + ShiftTransvection4(c); + + g{[ 1..d ]}[ c-1 ] := g{[ 1..d ]}[ c-1 ] + z * g{[1..d]}[c]; + u2{[1..d]}[c-1] := u2{[1..d]}[c-1] + z * u2{[1..d]}[c]; + fi; + + Add(slp,[[u2pos,1,tvpos,1],u2pos]); + + #g := g * Mul; + #u2 := u2 * Mul; + fi; + + + # Now clear the rest of row r + for j in [ c-2, c-3..1 ] do + + if not IsZero( g[r][j] ) and (j <> (d+1)/2) then + + z := - g[r][j] * a; + + # add z times column c of g to column j + # add z times column c of u2 to column j + # g{[1..d]}[j] := g{[1..d]}[j] + z * g{[1..d]}[c]; + #u2{[1..d]}[j] := u2{[1..d]}[j] + z * u2{[1..d]}[c]; + + #Mul := List( One(G), ShallowCopy ); + + if (c+j <> d+1) then + + if c in [1..(d+1)/2] and j in [1..(d+1)/2] then + TransvecAtAlpha2(z); + ShiftTransvection2ByI(c); + ShiftTransvection2ByJ(j, c); + elif c in [(((d+1)/2)+1)..d] and j in [(((d+1)/2)+1)..d] then + TransvecAtAlpha2(-z^phi); + ShiftTransvection2ByI(d-j+1); + ShiftTransvection2ByJ(d-c+1,d-j+1); + elif c+j < d+1 then + TransvecAtAlpha3(-z^phi); + ShiftTransvection3ByJ(d-c+1); + ShiftTransvection3ByI(d-j+1); + else + TransvecAtAlpha3(z); + ShiftTransvection3ByJ(j); + ShiftTransvection3ByI(c); + fi; + + #Mul[c][j] := z; + g{[1..d]}[j] := g{[1..d]}[j] + z * g{[1..d]}[c]; + u2{[1..d]}[j] := u2{[1..d]}[j] + z * u2{[1..d]}[c]; + + #Mul[d-j+1][d-c+1] := -z^phi; + g{[1..d]}[d-c+1] := g{[1..d]}[d-c+1] + (-z^phi) * g{[1..d]}[d-j+1]; + u2{[1..d]}[d-c+1] := u2{[1..d]}[d-c+1] + (-z^phi) * u2{[1..d]}[d-j+1]; + else + + TransvecAtAlpha4(z); + + if c > j then + ShiftTransvection4(c); + else + ShiftTransvection4(j); + fi; + + #Mul[c][j] := z; + g{[1..d]}[j] := g{[1..d]}[j] + z * g{[1..d]}[c]; + u2{[1..d]}[j] := u2{[1..d]}[j] + z * u2{[1..d]}[c]; + fi; + + Add(slp,[[u2pos,1,tvpos,1],u2pos]); + + #g := g * Mul; + #u2 := u2 * Mul; + + fi; + od; + + fi; + od; + + #Add(slp,[[u1pos,1],u1pos]); + #test := MakeSLP(slp,7); + #if not(ResultOfStraightLineProgram(test,stdgens)= u1) then + # Error("u1"); + #fi; + #Add(slp,[[u2pos,1],u2pos]); + #test := MakeSLP(slp,7); + #if not(ResultOfStraightLineProgram(test,stdgens)= u2) then + # Error("u2"); + #fi; + + #Add(slp,[[u1pos,1],u1pos]); + #slp := MakeSLP(slp,7); + #Display(ResultOfStraightLineProgram(slp,stdgens)); + #Display(ResultOfStraightLineProgram(slp,stdgens)= u1); + #Display(ResultOfStraightLineProgram(slp,stdgens)= u2); + #return slp; + #Display(g); + + Add( slp, [ [u1pos,1], [u2pos,1] ]); + + # Now u1^-1 * g * u2^-1 is the input matrix + return [slp,[g, u1, u2], hs]; + +end +); + + + +##### +# UnitriangularDecompositionSUOddAndEvenChar +##### + +InstallGlobalFunction( UnitriangularDecompositionSUOddAndEvenChar, +function(arg) + local u1, u2, d, fld, f, alpha, c, r, j, a, z, i, Mul, kon, x, Galois, phi, T2pos, T3pos, T4pos, T5pos, uipos, + TransvecAtAlpha2, ShiftTransvection2ByI, ShiftTransvection2ByJ, TransvecAtAlpha3, ShiftTransvection3ByI, ShiftTransvection3ByJ, + TransvecAtAlpha4, ShiftTransvection4, hs, ell, f2, q, stdgens, g, tmppos, tmppos2, u1pos, u2pos, AEMrespos, tvpos, test, + TransvecAtAlpha5, ShiftTransvection5, slp; + + ##### + # TransvectionAtAlpha2() + ##### + + TransvecAtAlpha2 := function( alpha ) + + local cc, ell, instr; + + # if omega = 1 then we overwrite the position for tv with Ti(1) + if IsOne( alpha ) then + Add(slp, [ [ T2pos[1], 1 ], tvpos ] ); + return; + fi; + + cc := CoefficientsPrimitiveElement( fld, alpha ); + instr := []; + + for ell in [ 1..Length(cc) ] do + + if not IsZero( cc[ell] ) then + Append( instr, [ T2pos[ell], Int(cc[ell]) ] ); + fi; + od; + + if Length( instr ) = 0 then + Error("TransvecAtAlpha2: this should not happen"); + fi; + + Add( slp, [ instr,tvpos ] ); + + return; + + end; + + ##### + # ShiftTransvection2ByI() + ##### + + ShiftTransvection2ByI := function(i) + + local instr; + + i := i-1; + + instr := AEM( 4, AEMrespos, tmppos, i-1 ); + Append( slp, instr ); + Add( slp, [ [ AEMrespos, -1, tvpos , 1, AEMrespos, 1 ], tvpos ] ); + + end; + + ##### + # ShiftTransvection2ByJ() + ##### + + ShiftTransvection2ByJ := function(i, abnr) + + local ui; + + ui := (d/2)-2; + + while ui-i+1-(d/2-abnr) > 0 do + Add(slp, [[uipos[ui-(d/2-abnr)],1,tvpos,1,uipos[ui-(d/2-abnr)],1],tvpos]); + ui := ui-1; + od; + + end; + + ##### + # TransvectionAtAlpha3() + ##### + + TransvecAtAlpha3 := function( alpha ) + + local cc, ell, instr; + + # if omega = 1 then we overwrite the position for tv with Ti(1) + if IsOne( alpha ) then + Add(slp, [ [ T3pos[1], 1 ], tvpos ] ); + return; + fi; + + cc := CoefficientsPrimitiveElement( fld, alpha ); + instr := []; + + for ell in [ 1..Length(cc) ] do + + if not IsZero( cc[ell] ) then + Append( instr, [ T3pos[ell], Int(cc[ell]) ] ); + fi; + od; + + if Length( instr ) = 0 then + Error("TransvecAtAlpha3: this should not happen"); + fi; + + Add( slp, [ instr,tvpos ] ); + + return; + + end; + + ##### + # ShiftTransvection3ByI() + ##### + + ShiftTransvection3ByI := function(i) + + local ui; + + i := d-i+1; + ui := 1; + + while ui < i do + Add(slp, [[uipos[ui],1,tvpos,1,uipos[ui],1],tvpos]); + ui := ui+1; + od; + + end; + + ##### + # ShiftTransvection3ByJ() + ##### + + ShiftTransvection3ByJ := function(i) + + local instr; + + i := i-1; + + Add(slp,[[4,1,5,1],tmppos2]); + instr := AEM( tmppos2, AEMrespos, tmppos, i-1 ); + Append( slp, instr ); + Add( slp, [ [ AEMrespos, -1, tvpos , 1, AEMrespos, 1 ], tvpos ] ); + + end; + + ##### + # TransvectionAtAlpha4() + ##### + + TransvecAtAlpha4 := function( alpha ) + + local cc, ell, instr, w, y, specialalpha, VS, basis; + + y := stdgens[7]; + w := y[((d+1)/2)-1][((d+1)/2)-1]; + basis := []; + for ell in [1..f2] do + Add(basis,(w^(q+1))^ell); + od; + + VS := VectorSpace(GF(Characteristic(fld)),basis); + + cc := CoefficientsPrimitiveElementS( fld, alpha, Basis(VS,basis)); + instr := []; + + for ell in [ 1..Length(cc) ] do + + if not IsZero( cc[ell] ) then + Append( instr, [ T4pos[ell], Int(cc[ell]) ] ); + fi; + od; + + if Length( instr ) = 0 then + Error("TransvecAtAlpha4: this should not happen"); + fi; + + Add( slp, [ instr,tvpos ] ); + + return; + + end; + + ##### + # ShiftTransvection4() + ##### + + ShiftTransvection4 := function(i) + local instr; + + i := d-i+1; + + if (i= 2 and IsList( arg[1] ) and IsMatrix( arg[2] ) then + + stdgens := arg[1]; # the LGO standard generators + g := arg[2]; + + if Length( stdgens ) < 1 or not IsMatrix( stdgens[1] ) then + + Error("first argument must be the LGO standard generators"); + return; + fi; + + if not IsMatrix( g ) then + Error("second argument must be a matrix"); return; + fi; + else + Error("input: LGO standard generators and a matrix"); + return; + fi; + + if Length(arg) = 3 then + + # The first 10 entries are the stdgens and their inverses + slp := arg[3]; + + if not IsList(slp) then + Error("third argument must be a list"); + return; + fi; + else + # We write an SLP into the variable slp + # The first 14 entries are the stdgens and the inverses + # s, t, del, v, x, s^-1, t^-1, del^-1, v^-1, x^-1 + slp := [ [1,1], [2,1], [3,1], [4,1], [5,1], [6,1], [7,1], + [1,-1],[2,-1],[3,-1],[4,-1],[5,-1], [6,-1], [7,-1] ]; + + # Change generators to match the one of odd characteristic + Add(slp, [[1,-1,4,-1,6,1,4,1,1,1],6]); + Add(slp, [[6,-1],13]); + Add(slp, [[1,1,4,1,5,1,4,-1,7,1,4,1,5,-1,4,-1,1,1],7]); + Add(slp, [[7,-1],14]); + fi; + + d := Length( g ); + fld := FieldOfMatrixList( [g] ); + Galois := GaloisGroup(fld); + Galois := Filtered(Galois, x -> Order(x) = 2); + phi := Galois[1]; + + # To create an MSLP, we allocate all the memory needed at the beginning. + Add( slp, [1,0] ); tmppos := Length(slp)-4; #15 + Add( slp, [1,0] ); AEMrespos := Length(slp)-4; #16 + Add( slp, [1,0] ); u1pos := Length(slp)-4; #17 + Add( slp, [1,0] ); u2pos := Length(slp)-4; #18 + Add( slp, [1,0] ); tvpos := Length(slp)-4; #19 + Add( slp, [1,0] ); tmppos2 := Length(slp)-4; #20 + + + u1 := MutableCopyMat( One(g) ); + u2 := MutableCopyMat( One(g) ); + + # If g is already a monomial matrix return u_1 = u_2 = I_d + if TestIfMonomial( g ) then + Add( slp, [ [1,0],[1,0] ] ); + return [ slp, [u1,g,u2] ]; + fi; + + f := LogInt(Size(fld), Characteristic(fld)); #ie q=p^f + q := RootInt(Characteristic(fld)^f); + + hs := HighestSlotOfSLP(slp); + + # We create the help variables for the block top left or bottom right + T2pos := [ hs + 1 .. hs + f ]; + + hs := hs + f; + + for ell in [ 1..f ] do + Add(slp, [1,0] ); + od; + + Add(slp, [ [4, -1, 6, 1, 4, 1, 6 , -1, 4,-1, 6,-1, 4,1,6,1 ], tmppos2 ] ); + + for ell in [0..f-1] do + + Add(slp, [ [7, ell, 4, -2, 7, -(ell), 4 ,2 ], tmppos ] ); + Add(slp, [ [5,-1,1,-1,tmppos, 1, tmppos2, -1, tmppos, -1, 1, 1, 5, 1], T2pos[ell+1] ] ); + + od; + + # We create the help variables for the block in the bottom left + T3pos := [ hs + 1 .. hs + f ]; + + hs := hs + f; + + for ell in [ 1..f ] do + Add(slp, [1,0] ); + od; + + Add(slp, [ [4, -1, 6, 1, 4, 1, 6 , -1, 4,-1, 6,-1, 4,1,6,1 ], tmppos2 ] ); + + for ell in [0..f-1] do + + Add(slp, [ [7, ell, 4, -2, 7, -ell, 4 ,2 ], tmppos ] ); + Add(slp, [ [tmppos, 1, tmppos2, -1, tmppos, -1], T3pos[ell+1] ] ); + + od; + + # We create the help variables for the diagonal + f2 := Int((f * 0.5)); + T4pos := [ hs + 1 .. hs + f2 ]; + + hs := hs + f2 ; + + for ell in [ 1..f2 ] do + Add(slp, [1,0] ); + od; + + for ell in [1..f2] do + + Add(slp, [ [7, ell, 1, -1, 2, 1, 1, 1 , 7, -ell], T4pos[ell] ] ); + + od; + + # We create the help variables for the centre row and column + T5pos := [ hs + 1 .. hs + f ]; + + hs := hs + f; + + for ell in [ 1..f ] do + Add(slp, [1,0] ); + od; + + for ell in [0..f-1] do + + Add(slp, [ [7, ell , 4, -2, 7, -ell, 4 ,2 ], tmppos ] ); + Add(slp, [ [tmppos, 1, 6, 1, tmppos, -1], T5pos[ell+1] ] ); + + #test := slp; + #test := MakeSLP(test,7); + #Display(ResultOfStraightLineProgram(test,stdgens)); + + od; + + # We create the help variables for the shift + + uipos := [ hs + 1 .. (hs + ((d-1)/2)-2) ]; + + hs := hs + (((d-1)/2)-2) ; + + for ell in [ 1 .. (((d-1)/2)-2) ] do + Add(slp, [1,0] ); + od; + + Add( slp, [[5,1],uipos[1]]); + + for ell in [2..(((d-1)/2)-2) ] do + Add( slp, [ [ 4, -1, uipos[ell-1] , 1, 4, 1 ], uipos[ell] ] ); + od; + + ############ + # Tests + ############ + + #test :=PseudoRandom(fld); + + #Display(test); + + #TransvecAtAlpha2(test); + #ShiftTransvection2ByI(3); + #ShiftTransvection2ByJ(1, 3); + + #y := stdgens[7]; + #w := y[d][d]; + #specialalpha := w^((q+1)/2); + #basis := []; + #for ell in [1..f2] do + # Add(basis,specialalpha^(-q)*(w^(q+1))^ell); + #od; + + #VS := VectorSpace(GF(Characteristic(fld)),basis); + #test := PseudoRandom(VS); + + #Display(test); + #TransvecAtAlpha4(test); + #ShiftTransvection4(7); + + #TransvecAtAlpha3(test); + #ShiftTransvection3ByJ(3); + #ShiftTransvection3ByI(6); + + #Add(slp, [[T4pos[2],1],tvpos]); + + #TransvecAtAlpha5(test); + #ShiftTransvection5(6); + + #return MakeSLP(slp,7); + + ############ + # Start function + ############ + + g := MutableCopyMat( g ); + + for c in [ d, d-1.. ((d+1)/2)+1 ] do + + # Find the first non-zero entry in column c + # g_{r,c} will be the pivot. + j := 1; r := 0; + + while r <= d and j <= d and r = 0 do + + if not IsZero(g[j][c]) then + r := j; + fi; + + j := j + 1; + + od; + + if r = 0 then + Error("matrix has 0 column"); + fi; + + a := g[r][c]^-1; + + if r <= d-1 then + + if (not(IsZero(g[(d+1)/2][c])) and (c <> ((d+1)/2))) then + i := (d+1)/2; + z := -g[i][c] * a; + + # add z times row r of g to row i + # add z times row r of u1 to row i + #g[i] := g[i] + z*g[r]; + #u1[i] := u1[i] + z*u1[r]; + + if (i+r <> d+1) then + #Mul := List( One(SU(d,q)), ShallowCopy ); + #Mul[i][r] := z; + + x := TransvecAtAlpha5(-z^phi); + ShiftTransvection5(d-r+1); + + #for x in fld do + # if ((-z)^phi)*(-z)+x+x^phi = Zero(fld) then + # #Mul[d-r+1][r] := x; + # break; + # fi; + #od; + + #Mul[d-r+1,r] := x; + g[d-r+1] := g[d-r+1] + x * g[r]; + u1[d-r+1] := u1[d-r+1] + x * u1[r]; + + #Mul[d-r+1][d-i+1] := -z^phi; + g[d-r+1] := g[d-r+1] + -z^phi * g[d-i+1]; + u1[d-r+1] := u1[d-r+1] + -z^phi * u1[d-i+1]; + + g[i] := g[i] + z*g[r]; + u1[i] := u1[i] + z*u1[r]; + else + #Mul[i][r] := z; + + TransvecAtAlpha4(z); + + if i > r then + ShiftTransvection4(i); + else + ShiftTransvection4(r); + fi; + + g[i] := g[i] + z*g[r]; + u1[i] := u1[i] + z*u1[r]; + fi; + + Add(slp,[[tvpos,1,u1pos,1],u1pos]); + + #g := Mul * g; + #u1 := Mul * u1; + + fi; + + if not IsZero( g[r+1][c] ) and (r+1 <> (d+1)/2) then + + z := - g[r+1][c] * a; + + if (r+1 <> (d+1)/2) then + + # add z times row r of g to row r+1 + # add z times row r of u1 to row r+1 + # g[r+1] := g[r+1] + z * g[r]; + # u1[r+1] := u1[r+1] + z * u1[r]; + #Mul := List( One(G), ShallowCopy ); + + if (r+r+1 <> d+1) then + + if r+1 in [1..(d+1)/2] then + TransvecAtAlpha2(z); + ShiftTransvection2ByI(r+1); + ShiftTransvection2ByJ(r, r+1); + else + TransvecAtAlpha2(-z^phi); + ShiftTransvection2ByI(d-r+1); + ShiftTransvection2ByJ(d-r,d-r+1); + fi; + + #Mul[r+1][r] := z; + g[r+1] := g[r+1] + z * g[r]; + u1[r+1] := u1[r+1] + z * u1[r]; + + #Mul[d-r+1][d-r] := -(z)^phi; + g[d-r+1] := g[d-r+1] + -z^phi * g[d-r]; + u1[d-r+1] := u1[d-r+1] + -z^phi * u1[d-r]; + else + #Mul[r+1][r] := z; + + TransvecAtAlpha4(z); + ShiftTransvection4(r+1); + + g[r+1] := g[r+1] + z * g[r]; + u1[r+1] := u1[r+1] + z * u1[r]; + fi; + + Add(slp,[[tvpos,1,u1pos,1],u1pos]); + + #g := Mul * g; + #u1 := Mul * u1; + + else + #Mul := List( One(G), ShallowCopy ); + + if (r+r+1 <> d+1) then + + #Display("Test"); + #Mul[r+1][r] := z; + g[r+1] := g[r+1] + z * g[r]; + u1[r+1] := u1[r+1] + z * u1[r]; + + #Mul[d-r+1][d-r] := -z^phi; + g[d-r+1] := g[d-r+1] + -z^phi * g[d-r]; + u1[d-r+1] := u1[d-r+1] + -z^phi * u1[d-r]; + else + #Mul[r+1][r] := z; + + TransvecAtAlpha4(z); + ShiftTransvection4(r+1); + + g[r+1] := g[r+1] + z * g[r]; + u1[r+1] := u1[r+1] + z * u1[r]; + fi; + + Add(slp,[[tvpos,1,u1pos,1],u1pos]); + + #g := Mul * g; + #u1 := Mul * u1; + + fi; + fi; + + + # Second: Clear the rest of column c + for i in [ r+2..d ] do + + if not IsZero(g[i][c]) and (i <> (d+1)/2) then + + z := -g[i][c] * a; + + # add z times row r of g to row i + # add z times row r of u1 to row i + #g[i] := g[i] + z*g[r]; + #u1[i] := u1[i] + z*u1[r]; + #Mul := List( One(G), ShallowCopy ); + + if (i+r <> d+1) then + + if i in [1..(d+1)/2] and r in [1..(d+1)/2] then + TransvecAtAlpha2(z); + ShiftTransvection2ByI(i); + ShiftTransvection2ByJ(r, i); + elif i in [(((d+1)/2)+1)..d] and r in [(((d+1)/2)+1)..d] then + TransvecAtAlpha2(-z^phi); + ShiftTransvection2ByI(d-r+1); + ShiftTransvection2ByJ(d-i+1,d-r+1); # Vorher d-r + elif i+r < d+1 then + TransvecAtAlpha3(-z^phi); + ShiftTransvection3ByJ(d-i+1); + ShiftTransvection3ByI(d-r+1); + else + TransvecAtAlpha3(z); + ShiftTransvection3ByJ(r); + ShiftTransvection3ByI(i); + fi; + + #Mul[i][r] := z; + g[i] := g[i] + z*g[r]; + u1[i] := u1[i] + z*u1[r]; + + #Mul[d-r+1][d-i+1] := -z^phi; + g[d-r+1] := g[d-r+1] + -z^phi * g[d-i+1]; + u1[d-r+1] := u1[d-r+1] + -z^phi * u1[d-i+1]; + else + TransvecAtAlpha4(z); + + if i > r then + ShiftTransvection4(i); + else + ShiftTransvection4(r); + fi; + + g[i] := g[i] + z*g[r]; + u1[i] := u1[i] + z*u1[r]; + fi; + + Add(slp,[[tvpos,1,u1pos,1],u1pos]); + + #g := Mul * g; + #u1 := Mul * u1; + + fi; + od; + fi; + + + + # Step Two: Clear all entries in row r apart from g[r][c] + # This coincides with multiplying t_{c,j} from right. + if c >= 2 then + + + if not IsZero(g[r][(d+1)/2]) and (r <> ((d+1)/2)) then + j := (d+1)/2; + z := -g[r][j] * a; + + # add z times row r of g to row i + # add z times row r of u1 to row i + #g[i] := g[i] + z*g[r]; + #u1[i] := u1[i] + z*u1[r]; + + if (c+j <> d+1) then + #Mul := List( One(SU(11,25)), ShallowCopy ); + #Mul[c][j] := z; + + x := TransvecAtAlpha5(z); + ShiftTransvection5(c); + + #for x in fld do + # if ((-z)^phi)*(-z)+x+x^phi = Zero(fld) then + # #Mul[c][d-c+1] := x; + # break; + # fi; + #od; + #Mul[d-j+1][d-c+1] := -z^phi; + #Mul[c][d-c+1] := x; + #Display(g*Mul); + + g{[1..d]}[d-c+1] := g{[1..d]}[d-c+1] + x * g{[1..d]}[c]; + u2{[1..d]}[d-c+1] := u2{[1..d]}[d-c+1] + x * u2{[1..d]}[c]; + + g{[1..d]}[d-c+1] := g{[1..d]}[d-c+1] + (-z^phi) * g{[1..d]}[d-j+1]; + u2{[1..d]}[d-c+1] := u2{[1..d]}[d-c+1] + (-z^phi) * u2{[1..d]}[d-j+1]; + + g{[1..d]}[j] := g{[1..d]}[j] + z * g{[1..d]}[c]; + u2{[1..d]}[j] := u2{[1..d]}[j] + z * u2{[1..d]}[c]; + + else + #Mul[i][r] := z; + + TransvecAtAlpha4(z); + + if c > j then + ShiftTransvection4(c); + else + ShiftTransvection4(j); + fi; + + g{[1..d]}[j] := g{[1..d]}[j] + z * g{[1..d]}[c]; + u2{[1..d]}[j] := u2{[1..d]}[j] + z * u2{[1..d]}[c]; + fi; + + Add(slp,[[u2pos,1,tvpos,1],u2pos]); + + #g := g * Mul; + #u2 := u2 * Mul; + + fi; + + + if not IsZero( g[r][c-1] ) and (c-1 <> (d+1)/2) then + + z := -g[r][c-1] * a; + + # add z times column c of g to column c-1 + # add z times column c of u2 to column c-1 + #g{[ 1..d ]}[ c-1 ] := g{[ 1..d ]}[ c-1 ] + z * g{[1..d]}[c]; + #u2{[1..d]}[c-1] := u2{[1..d]}[c-1] + z * u2{[1..d]}[c]; + + #Mul := List( One(G), ShallowCopy ); + + if (c+c-1 <> d+1) then + + if c in [1..(d+1)/2] and c-1 in [1..(d+1)/2] then + TransvecAtAlpha2(z); + ShiftTransvection2ByI(c); + ShiftTransvection2ByJ(c-1, c); + else + TransvecAtAlpha2(-z^phi); + ShiftTransvection2ByI(d-c+2); + ShiftTransvection2ByJ(d-c+1,d-c+2); + fi; + + #Mul[c][c-1] := z; + g{[ 1..d ]}[ c-1 ] := g{[ 1..d ]}[ c-1 ] + z * g{[1..d]}[c]; + u2{[1..d]}[c-1] := u2{[1..d]}[c-1] + z * u2{[1..d]}[c]; + + #Mul[d-c+2][d-c+1] := -z^phi; + g{[ 1..d ]}[ d-c+1 ] := g{[ 1..d ]}[ d-c+1 ] + (-z^phi) * g{[1..d]}[d-c+2]; + u2{[1..d]}[d-c+1] := u2{[1..d]}[d-c+1] + (-z^phi) * u2{[1..d]}[d-c+2]; + else + #Mul[c][c-1] := z; + + TransvecAtAlpha4(z); + ShiftTransvection4(c); + + g{[ 1..d ]}[ c-1 ] := g{[ 1..d ]}[ c-1 ] + z * g{[1..d]}[c]; + u2{[1..d]}[c-1] := u2{[1..d]}[c-1] + z * u2{[1..d]}[c]; + fi; + + Add(slp,[[u2pos,1,tvpos,1],u2pos]); + + #g := g * Mul; + #u2 := u2 * Mul; + + fi; + + + # Now clear the rest of row r + for j in [ c-2, c-3..1 ] do + + if not IsZero( g[r][j] ) and (j <> (d+1)/2) then + + z := - g[r][j] * a; + + # add z times column c of g to column j + # add z times column c of u2 to column j + # g{[1..d]}[j] := g{[1..d]}[j] + z * g{[1..d]}[c]; + #u2{[1..d]}[j] := u2{[1..d]}[j] + z * u2{[1..d]}[c]; + + #Mul := List( One(G), ShallowCopy ); + + if (c+j <> d+1) then + + if c in [1..(d+1)/2] and j in [1..(d+1)/2] then + TransvecAtAlpha2(z); + ShiftTransvection2ByI(c); + ShiftTransvection2ByJ(j, c); + elif c in [(((d+1)/2)+1)..d] and j in [(((d+1)/2)+1)..d] then + TransvecAtAlpha2(-z^phi); + ShiftTransvection2ByI(d-j+1); + ShiftTransvection2ByJ(d-c+1,d-j+1); + elif c+j < d+1 then + TransvecAtAlpha3(-z^phi); + ShiftTransvection3ByJ(d-c+1); + ShiftTransvection3ByI(d-j+1); + else + TransvecAtAlpha3(z); + ShiftTransvection3ByJ(j); + ShiftTransvection3ByI(c); + fi; + + #Mul[c][j] := z; + g{[1..d]}[j] := g{[1..d]}[j] + z * g{[1..d]}[c]; + u2{[1..d]}[j] := u2{[1..d]}[j] + z * u2{[1..d]}[c]; + + #Mul[d-j+1][d-c+1] := -z^phi; + g{[1..d]}[d-c+1] := g{[1..d]}[d-c+1] + (-z^phi) * g{[1..d]}[d-j+1]; + u2{[1..d]}[d-c+1] := u2{[1..d]}[d-c+1] + (-z^phi) * u2{[1..d]}[d-j+1]; + else + + TransvecAtAlpha4(z); + + if c > j then + ShiftTransvection4(c); + else + ShiftTransvection4(j); + fi; + + #Mul[c][j] := z; + g{[1..d]}[j] := g{[1..d]}[j] + z * g{[1..d]}[c]; + u2{[1..d]}[j] := u2{[1..d]}[j] + z * u2{[1..d]}[c]; + fi; + + Add(slp,[[u2pos,1,tvpos,1],u2pos]); + + #g := g * Mul; + #u2 := u2 * Mul; + + fi; + od; + + fi; + od; + + #test := slp; + #Add(test,[[u1pos,1],u1pos]); + #test := MakeSLP(test,7); + #if not(ResultOfStraightLineProgram(test,stdgens)= u1) then + # Error("u1"); + #fi; + #test := slp; + #Add(test,[[u2pos,1],u2pos]); + #test := MakeSLP(test,7); + #if not(ResultOfStraightLineProgram(test,stdgens)= u2) then + # Error("u2"); + #fi; + + #Add(slp,[[u1pos,1],u1pos]); + #slp := MakeSLP(slp,7); + #Display(ResultOfStraightLineProgram(slp,stdgens)); + #Display(ResultOfStraightLineProgram(slp,stdgens)= u1); + #Display(ResultOfStraightLineProgram(slp,stdgens)= u2); + #return slp; + #Display(g); + + Add( slp, [ [u1pos,1], [u2pos,1] ]); + + # Now u1^-1 * g * u2^-1 is the input matrix + return [slp,[g, u1, u2], hs]; + +end +); + + + +##### +# UnitriangularDecompositionSU +##### + +InstallGlobalFunction( UnitriangularDecompositionSU, +function(g) + + if (Length(g) mod 2) = 0 then + return UnitriangularDecompositionSUEven(g); + else + return UnitriangularDecompositionSUOdd(g); + fi; + +end +); + + + +##### +# LGOStandardGensSU +##### + +InstallGlobalFunction( LGOStandardGensSU, +function( d, q ) + + local w, alpha, s, t, delta, u, v, x, y, J, fld; + + if d < 6 then + Error("LGOStandardGens: d has to be at least 6\n"); + return; + fi; + + if (q mod 2 = 0) then + return LGOStandardGensSUEvenChar(d,q); + fi; + + w := PrimitiveElement(GF(q^2)); + alpha := w^((q+1)/2); + fld := GF(q^2); + + s := IdentityMat( d, fld ); + s[1][1] := Zero(fld); + s[d][d] := Zero(fld); + s[1][d] := alpha; + s[d][1] := alpha^(-q); + + t := IdentityMat( d, fld ); + t[1][d] := alpha; + + delta := IdentityMat( d, fld ); + delta[1][1] := w^(q+1); + delta[d][d] := w^((-(q+1))); + + v := 0 * IdentityMat( d, fld ); + if (IsEvenInt(d)) then + v[d/2][1] := One(fld); + v{[1..(d/2)-1]}{[2..d/2]} := IdentityMat((d/2)-1,fld); + v[d/2+1][d] := One(fld); + v{[(d/2)+2..d]}{[(d/2)+1..d-1]} := IdentityMat((d/2)-1,fld); + else + v[(d-1)/2][1] := One(fld); + v{[1..((d-1)/2)-1]}{[2..(d-1)/2]} := IdentityMat(((d-1)/2)-1,fld); + v[((d+1)/2)+1][d] := One(fld); + v[(d+1)/2][(d+1)/2] := One(fld); + v{[((d+1)/2)+2..d]}{[((d+1)/2)+1..d-1]} := IdentityMat(((d-1)/2)-1,fld); + fi; + + u := IdentityMat( d, fld );; + J := [[Zero(fld),One(fld)],[One(fld),Zero(fld)]]; + u{[1,2]}{[1,2]} := J; + u{[d-1,d]}{[d-1,d]} := J; + + x := IdentityMat( d, fld );; + if (IsEvenInt(d)) then + x[1][2] := One(fld); + x[d-1][d] := -One(fld); + else + x[(d+1)/2][1] := One(fld) * -1; + x[d][1] := One(fld)* -2^(-1); + x[d][(d+1)/2] := One(fld); + fi; + + y := IdentityMat( d, fld );; + if (IsEvenInt(d)) then + y[1][1] := w; + y[2][2] := w^(-1); + y[d-1][d-1] := w^q; + y[d][d] := w^(-q); + else + y[1][1] := w^(-q); + y[d][d] := w; + y[(d+1)/2][(d+1)/2] := w^(q-1); + fi; + + return [s,t,delta,v,u,x,y]; + +end +); + + + +##### +# LGOStandardGensSUEvenChar +##### + +InstallGlobalFunction( LGOStandardGensSUEvenChar, +function( d, q ) + + local w, alpha, s, t, delta, u, v, x, y, J, fld, nu, Galois, phi, i; + + fld := GF(q^2); + w := PrimitiveElement(fld); + nu := Trace(GF(q^2),GF(q),w)^(-1) * w; + + s := IdentityMat( d, fld ); + s[1][1] := Zero(fld); + s[d][d] := Zero(fld); + s[1][d] := One(fld); + s[d][1] := One(fld); + + t := IdentityMat( d, fld ); + t[1][d] := One(fld); + + delta := IdentityMat( d, fld ); + delta[1][1] := w^(q+1); + delta[d][d] := w^((-(q+1))); + + v := 0 * IdentityMat( d, fld ); + if (IsEvenInt(d)) then + v[d/2][1] := One(fld); + v{[1..(d/2)-1]}{[2..d/2]} := IdentityMat((d/2)-1,fld); + v[d/2+1][d] := One(fld); + v{[(d/2)+2..d]}{[(d/2)+1..d-1]} := IdentityMat((d/2)-1,fld); + else + v[(d-1)/2][1] := One(fld); + v{[1..((d-1)/2)-1]}{[2..(d-1)/2]} := IdentityMat(((d-1)/2)-1,fld); + v[((d+1)/2)+1][d] := One(fld); + v[(d+1)/2][(d+1)/2] := One(fld); + v{[((d+1)/2)+2..d]}{[((d+1)/2)+1..d-1]} := IdentityMat(((d-1)/2)-1,fld); + fi; + + u := IdentityMat( d, fld );; + J := [[Zero(fld),One(fld)],[One(fld),Zero(fld)]]; + u{[1,2]}{[1,2]} := J; + u{[d-1,d]}{[d-1,d]} := J; + + x := IdentityMat( d, fld );; + if (IsEvenInt(d)) then + x[1][2] := One(fld); + x[d-1][d] := One(fld); + else + x[((d+1)/2)-1][(d+1)/2] := One(fld) ; + x[((d+1)/2)-1][((d+1)/2)+1] := nu; + x[(d+1)/2][((d+1)/2)+1] := One(fld); + fi; + + y := IdentityMat( d, fld );; + if (IsEvenInt(d)) then + y[1][1] := w; + y[2][2] := w^(-1); + y[d-1][d-1] := w^q; + y[d][d] := w^(-q); + else + y[((d+1)/2)+1][((d+1)/2)+1] := w^(-q); + y[((d+1)/2)-1][((d+1)/2)-1] := w; + y[(d+1)/2][(d+1)/2] := w^(q-1); + fi; + + return [s,t,delta,v,u,x,y]; + +end +); + + + +##### +# BruhatDecompositionSU +##### + +InstallGlobalFunction( BruhatDecompositionSU, +function(stdgens, g) + + local slp, u1, pm, u2, p_sign, diag, res1, res2, res3, lastline, line, pgr, fld; + + fld := FieldOfMatrixList( [g] ); + + if Size(fld) mod 2 = 0 then + if (Length(g) mod 2) = 0 then + + # We write an SLP into the variable slp + # The first 12 entries are the stdgens and their inverses + # s, t, del, v, u, x, s^-1, t^-1, del^-1, v^-1, u^-1, x^-1 + + Info( InfoBruhat, 1, + "returns an SLP to generate u1, u2, p_sign, diag\n" ); + + fld := FieldOfMatrixList( [g] ); + + # Compute the matrices u1,u2 of Bruhat-Decomposition and the instructions + # for an SLP that compute u1 and u2 + res1 := UnitriangularDecompositionSUEvenAndEvenChar( stdgens, g); + + slp := res1[1]; + u1 := res1[2][2]; + pm := res1[2][1]; # the monomial matrix w + u2 := res1[2][3]; + + lastline := ShallowCopy( slp[ Length(slp) ] ); # remember famous last words + # Since entries of the form [list1,list2] should only occur at the end + Remove(slp); + + # Decompose w in to a signed Permutation-Matrix generated by + # and a Diagonal-Matrix diag. + + res2 := MonomialSLPSUEvenAndEvenChar(stdgens, pm, slp ); + + slp := ShallowCopy(res2[1]); + p_sign := res2[2][1]; + diag := res2[2][2]; + + # Now w = p_sign * diag + # and p_sign is can be evaluated as word in < s, v, x > using slp. + + # Make again all entries of slp admissible for SLP + # We inverted a Monomial-Matrix in PermSLP to get the proper result. + # Thus we have to copy a little variaton at the end of our final slp + # (else we would display a twice inverted matrix where we wanted once) + line := slp[ Length(slp) ]; + Append(lastline, [ slp[ Length(slp)] ]); + + # Determine the SLP for the Diagonal-Matrix + res3 := DiagSLPSUEvenAndEvenChar(stdgens, diag, slp, res1[3]+10); + slp := res3[1]; + + # Here the last entry is of admissible form. Just add it to the end. + Append( lastline, [ slp[ Length(slp)] ] ); # remember famous last words + Remove( slp ); + Append( slp, [lastline] ); + + Info( InfoBruhat, 2, "The Total Memory Usage is: " + , res1[3]+9+14, " memory slots\n" ); + + pgr := MakeSLP(slp,7); + + # The result R of pgr satisfies: + # R[1]^-1*R[3]*R[4]*R[2]^-1 and + # R[1] = u1, R[2] = u2, R[3] = p_sign, R[4] = diag + return [pgr, [ u1, u2, p_sign^(-1), diag ]]; + + else + + # We write an SLP into the variable slp + # The first 12 entries are the stdgens and their inverses + # s, t, del, v, u, x, s^-1, t^-1, del^-1, v^-1, u^-1, x^-1 + + Info( InfoBruhat, 1, + "returns an SLP to generate u1, u2, p_sign, diag\n" ); + + # Compute the matrices u1,u2 of Bruhat-Decomposition and the instructions + # for an SLP that compute u1 and u2 + res1 := UnitriangularDecompositionSUOddAndEvenChar( stdgens, g); + + slp := res1[1]; + u1 := res1[2][2]; + pm := res1[2][1]; # the monomial matrix w + u2 := res1[2][3]; + + lastline := ShallowCopy( slp[ Length(slp) ] ); # remember famous last words + # Since entries of the form [list1,list2] should only occur at the end + Remove(slp); + + # Decompose w in to a signed Permutation-Matrix generated by + # and a Diagonal-Matrix diag. + + res2 := MonomialSLPSUOddAndEvenChar(stdgens, pm, slp ); + + slp := ShallowCopy(res2[1]); + p_sign := res2[2][1]; + diag := res2[2][2]; + + # Now w = p_sign * diag + # and p_sign is can be evaluated as word in < s, v, x > using slp. + + # Make again all entries of slp admissible for SLP + # We inverted a Monomial-Matrix in PermSLP to get the proper result. + # Thus we have to copy a little variaton at the end of our final slp + # (else we would display a twice inverted matrix where we wanted once) + line := slp[ Length(slp) ]; + Append(lastline, [ slp[ Length(slp)] ]); + + # Determine the SLP for the Diagonal-Matrix + res3 := DiagSLPSUOddAndEvenChar(stdgens, diag, slp, res1[3]+10); + slp := res3[1]; + + # Here the last entry is of admissible form. Just add it to the end. + Append( lastline, [ slp[ Length(slp)] ] ); # remember famous last words + Remove( slp ); + Append( slp, [lastline] ); + + Info( InfoBruhat, 2, "The Total Memory Usage is: " + , res1[3]+9+14, " memory slots\n" ); + + pgr := MakeSLP(slp,7); + + # The result R of pgr satisfies: + # R[1]^-1*R[3]*R[4]*R[2]^-1 and + # R[1] = u1, R[2] = u2, R[3] = p_sign, R[4] = diag + return [pgr, [ u1, u2, p_sign^(-1), diag ]]; + + fi; + fi; + + if (Length(g) mod 2) = 0 then + + # We write an SLP into the variable slp + # The first 12 entries are the stdgens and their inverses + # s, t, del, v, u, x, s^-1, t^-1, del^-1, v^-1, u^-1, x^-1 + + Info( InfoBruhat, 1, + "returns an SLP to generate u1, u2, p_sign, diag\n" ); + + # Compute the matrices u1,u2 of Bruhat-Decomposition and the instructions + # for an SLP that compute u1 and u2 + res1 := UnitriangularDecompositionSUEven( stdgens, g); + + slp := res1[1]; + u1 := res1[2][2]; + pm := res1[2][1]; # the monomial matrix w + u2 := res1[2][3]; + + lastline := ShallowCopy( slp[ Length(slp) ] ); # remember famous last words + # Since entries of the form [list1,list2] should only occur at the end + Remove(slp); + + # Decompose w in to a signed Permutation-Matrix generated by + # and a Diagonal-Matrix diag. + + res2 := MonomialSLPSUEven(stdgens, pm, slp ); + + slp := ShallowCopy(res2[1]); + p_sign := res2[2][1]; + diag := res2[2][2]; + + # Now w = p_sign * diag + # and p_sign is can be evaluated as word in < s, v, x > using slp. + + # Make again all entries of slp admissible for SLP + # We inverted a Monomial-Matrix in PermSLP to get the proper result. + # Thus we have to copy a little variaton at the end of our final slp + # (else we would display a twice inverted matrix where we wanted once) + line := slp[ Length(slp) ]; + Append(lastline, [ slp[ Length(slp)] ]); + + # Determine the SLP for the Diagonal-Matrix + res3 := DiagSLPSUEven(stdgens, diag, slp, res1[3]+10); + slp := res3[1]; + + # Here the last entry is of admissible form. Just add it to the end. + Append( lastline, [ slp[ Length(slp)] ] ); # remember famous last words + Remove( slp ); + Append( slp, [lastline] ); + + Info( InfoBruhat, 2, "The Total Memory Usage is: " + , res1[3]+9+14, " memory slots\n" ); + + pgr := MakeSLP(slp,7); + + # The result R of pgr satisfies: + # R[1]^-1*R[3]*R[4]*R[2]^-1 and + # R[1] = u1, R[2] = u2, R[3] = p_sign, R[4] = diag + return [pgr, [ u1, u2, p_sign^(-1), diag ]]; + + else + + # We write an SLP into the variable slp + # The first 12 entries are the stdgens and their inverses + # s, t, del, v, u, x, s^-1, t^-1, del^-1, v^-1, u^-1, x^-1 + + Info( InfoBruhat, 1, + "returns an SLP to generate u1, u2, p_sign, diag\n" ); + + # Compute the matrices u1,u2 of Bruhat-Decomposition and the instructions + # for an SLP that compute u1 and u2 + res1 := UnitriangularDecompositionSUOdd( stdgens, g); + + slp := res1[1]; + u1 := res1[2][2]; + pm := res1[2][1]; # the monomial matrix w + u2 := res1[2][3]; + + lastline := ShallowCopy( slp[ Length(slp) ] ); # remember famous last words + # Since entries of the form [list1,list2] should only occur at the end + Remove(slp); + + # Decompose w in to a signed Permutation-Matrix generated by + # and a Diagonal-Matrix diag. + + res2 := MonomialSLPSUOdd(stdgens, pm, slp ); + + slp := ShallowCopy(res2[1]); + p_sign := res2[2][1]; + diag := res2[2][2]; + + # Now w = p_sign * diag + # and p_sign is can be evaluated as word in < s, v, x > using slp. + + # Make again all entries of slp admissible for SLP + # We inverted a Monomial-Matrix in PermSLP to get the proper result. + # Thus we have to copy a little variaton at the end of our final slp + # (else we would display a twice inverted matrix where we wanted once) + line := slp[ Length(slp) ]; + Append(lastline, [ slp[ Length(slp)] ]); + + # Determine the SLP for the Diagonal-Matrix + res3 := DiagSLPSUOdd(stdgens, diag, slp, res1[3]+10); + slp := res3[1]; + + # Here the last entry is of admissible form. Just add it to the end. + Append( lastline, [ slp[ Length(slp)] ] ); # remember famous last words + Remove( slp ); + Append( slp, [lastline] ); + + Info( InfoBruhat, 2, "The Total Memory Usage is: " + , res1[3]+9+14, " memory slots\n" ); + + pgr := MakeSLP(slp,7); + + # The result R of pgr satisfies: + # R[1]^-1*R[3]*R[4]*R[2]^-1 and + # R[1] = u1, R[2] = u2, R[3] = p_sign, R[4] = diag + return [pgr, [ u1, u2, p_sign^(-1), diag ]]; + + fi; + +end +); + + + +##### +# MonomialSLPSUOdd +##### + +InstallGlobalFunction( MonomialSLPSUOdd, +function(arg) + + local slp, c, n, m, result, i, k, u1, u2, result2, test, g, stdgens, mat, perm, fld, p_signpos, vpos, vipos, spos, upos, unpos, tpos, left, right, cnt, v, vf, s, pot, p_signwr, instr, swr, vwr, viwr, p_sign, leftma, rightma, L, R, diag, w, alpha, tmpvalue, rowlist, L2, R2, tmpSave, perm2, perm3, q; + + # Check for correct Input + if Length(arg) >= 2 and IsList(arg[1]) and IsMatrix(arg[2]) then + + stdgens := arg[1]; # the LGO standard generators + mat := arg[2]; # the monomial matrix + n := Length(stdgens[1]); + m := (n+1)/2; + + # Compute the permutation in Sym(n) of mat + perm := PermutationMonomialMatrix( mat ); + perm := perm[2]; + p_signwr := (stdgens[1]^0); + + if Length(stdgens) < 1 or not IsMatrix( stdgens[1]) then + Error("Input: first argument must be the LGO standard generators"); + return; + fi; + + else + Error("input: LGO standard generators and a matrix"); + return; + fi; + + fld := FieldOfMatrixList( stdgens ); + + if Length(arg) = 3 then + + # The first 10 entries are the stdgens and their inverses + slp := arg[3]; + + if not IsList(slp) then + Error("Input: third argument must be a list"); + return; + fi; + + cnt := HighestSlotOfSLP(slp); + + Info( InfoBruhat, 2, " and additional: ",7," memory slots ", + "in PermSLP()\n"); + else + + # we write an SLP into the variable slp + # The first 14 entries are the stdgens and the inverses + # s, t, del, v, x, s^-1, t^-1, del^-1, v^-1, x^-1 + # The entries 11 (resAEM) and 12 (tmpAEM) are used to save AEM-values + slp := [ [1, 1], [2, 1], [3, 1], [4, 1], [5, 1], [6, 1], [7, 1], + [1,-1], [2,-1], [3,-1], [4,-1], [5,-1], [6,-1], [7,-1], + [1, 0], [1, 0] ]; + + cnt := 16; + + Info( InfoBruhat, 2, "Memory Usage is: ",19," memory slots ", + "in PermSLP()\n"); + fi; + + # Initialize the additional memory quota + Add(slp, [ [1,0], cnt + 1 ] ); p_signpos := cnt + 1; #13 or 20+3f + Add(slp, [ [4,-1], cnt + 2 ] ); vpos := cnt + 2; #14 or 21+3f + Add(slp, [ [4,-1], cnt + 3 ] ); vipos := cnt + 3; #15 or 22+3f + Add(slp, [ [1,1], cnt + 4 ] ); spos := cnt + 4; #16 or 23+3f + Add(slp, [ [5,1], cnt + 5 ] ); upos := cnt + 5; #17 or 24+3f + Add(slp, [ [5,0], cnt + 6 ] ); unpos := cnt + 6; #18 or 25+3f + Add(slp, [ [1,0], cnt + 7 ] ); tpos := cnt + 7; #19 or 26+3f + Add(slp, [ [1,0], cnt + 8 ] ); left := cnt + 8; #20 or 27+3f + Add(slp, [ [1,0], cnt + 9 ] ); right := cnt + 9; #21 or 28+3f + + if IsDiagonalMat( mat ) then + # In order to make it coincide with the other possible output. + # This is ok since it is Id + Add( slp, [ [p_signpos,-1] , p_signpos ] ); + return [ slp, [ stdgens[1]^0, mat ] ]; + fi; + + c := CycleFromPermutation(perm); + u1 := One(SymmetricGroup(n)); + u2 := One(SymmetricGroup(n)); + result := []; + result2 := []; + L2 := IdentityMat(n,fld); + R2 := IdentityMat(n,fld); + w := PrimitiveElement(fld); + q := RootInt(Size(fld)); + alpha := w^((q+1)/2); + while (CheckContinue(perm,m)) do + c := CycleFromPermutation(perm); + for i in c do + k := LargestMovedPoint(i); + if k < m then + Add(result, i); + elif SmallestMovedPoint(i) > m then + + elif (n-k+1)^i = n-k+1 then + tmpvalue := L2[k]; + L2[k] := alpha^(-1)*L2[n-k+1]; + L2[n-k+1] := alpha^(q)* tmpvalue; #Was ist das Inverse? + tmpvalue := R2{[1..n]}[k]; + R2{[1..n]}[k] := alpha*R2{[1..n]}[n-k+1]; + R2{[1..n]}[n-k+1] := alpha^(-q)*tmpvalue; + perm := perm^(k,n-k+1); + u1 := (k,n-k+1) * u1; + Add( slp, [ [vpos,-(k-1),spos,1,vpos,k-1] , tpos ] ); + Add( slp, [ [tpos,-1,left,1] , left ] ); + Add( slp, [ [right,1,tpos,1] , right] ); + u2 := u2 * (k,n-k+1); + break; + else + tmpvalue := L2[k]; + L2[k] := alpha^(-q)* L2[n-k+1]; + L2[n-k+1] := alpha*tmpvalue; + perm := (k,n-k+1)*perm; + u1 := (k,n-k+1) * u1; + Add( slp, [ [vpos,-(k-1),spos,1,vpos,k-1] , tpos ] ); + Add( slp, [ [tpos,1,left,1] , left ] ); + break; + fi; + od; + od; + + c := CycleFromPermutation(perm); + for i in c do + k := LargestMovedPoint(i); + if k <= m then + Add(result, i); + else + Add(result2, i); + fi; + od; + + Add( slp, [ [left,-1] , left ] ); + Add( slp, [ [right,-1] , right ] ); + + result := Set(result); + result2 := Set(result2); + + perm := One(SymmetricGroup(n)); + for i in [1..Size(result)] do + perm := perm * result[i]; + od; + + perm2 := One(SymmetricGroup(n)); + for i in [1..Size(result2)] do + perm2 := perm2 * result2[i]; + od; + + v := (CycleFromPermutation(PermutationMonomialMatrix(stdgens[4])[2])[1])^(-1); + vf := (CycleFromPermutation(PermutationMonomialMatrix(stdgens[4])[2])[1])^(-1); + s := CycleFromPermutation(PermutationMonomialMatrix(stdgens[5])[2])[1]; + + Add( slp, [ [4,1], vpos ] ); + Add( slp, [ [4,-1], vipos ] ); + Add( slp, [ [5,1], spos ] ); + + perm3 := perm; + + for i in [ 1 .. m-1 ] do + + pot := i^perm - i; + + # Need to update perm since pi_{i-1} may change pos of i + perm := perm * v ^pot; + + # memory slots 11 and 12 are used for resAEM and tmpAEM + instr := AEM( vipos, 15, 16, pot ); + Append( slp, instr ); + Add( slp, [ [p_signpos,1, 15,1 ], p_signpos ] ); # permpos + + #Compute v_i+1, save command in slp + v := s * v; + + Add(slp,[ [spos,1, vipos,1 ], vipos ] ); # vipos + # Don't be confused with notation in Paper + # There we used v1 (which coincides with v^-1) + + s := s ^( vf ^-1 ); + Add(slp, [ [11, 1, spos,1, 4,1 ], spos ] ); # spos + + + od; + + Add(slp,[ [ p_signpos,-1 ], p_signpos ] ); + + tmpvalue := PermutationMat(perm2^(-1),n, fld); + tmpvalue{[1..((n+1)/2)-1]}{[1..((n+1)/2)-1]} := PermutationMat(perm3^(-1),((n+1)/2)-1, fld); + + Add( slp, [ [left,1,p_signpos,1,right,1] , p_signpos ] ); + + Add( slp, [ p_signpos ,1 ] ); + + tmpvalue := R2*tmpvalue*L2; + mat := tmpvalue*mat; + + return [slp, [tmpvalue , mat ] ]; + +end +); + + + +##### +# MonomialSLPSUOddAndEvenChar +##### + +InstallGlobalFunction( MonomialSLPSUOddAndEvenChar, +function(arg) + + local slp, c, n, m, result, i, k, u1, u2, result2, test, g, stdgens, mat, perm, fld, p_signpos, vpos, vipos, spos, upos, unpos, tpos, left, right, cnt, v, vf, s, pot, p_signwr, instr, swr, vwr, viwr, p_sign, leftma, rightma, L, R, diag, w, alpha, tmpvalue, rowlist, L2, R2, tmpSave, perm2, perm3, q; + + # Check for correct Input + if Length(arg) >= 2 and IsList(arg[1]) and IsMatrix(arg[2]) then + + stdgens := arg[1]; # the LGO standard generators + mat := arg[2]; # the monomial matrix + n := Length(stdgens[1]); + m := (n+1)/2; + + # Compute the permutation in Sym(n) of mat + perm := PermutationMonomialMatrix( mat ); + perm := perm[2]; + p_signwr := (stdgens[1]^0); + + if Length(stdgens) < 1 or not IsMatrix( stdgens[1]) then + Error("Input: first argument must be the LGO standard generators"); + return; + fi; + + else + Error("input: LGO standard generators and a matrix"); + return; + fi; + + fld := FieldOfMatrixList( stdgens ); + + if Length(arg) = 3 then + + # The first 10 entries are the stdgens and their inverses + slp := arg[3]; + + if not IsList(slp) then + Error("Input: third argument must be a list"); + return; + fi; + + cnt := HighestSlotOfSLP(slp); + + Info( InfoBruhat, 2, " and additional: ",7," memory slots ", + "in PermSLP()\n"); + else + + # we write an SLP into the variable slp + # The first 14 entries are the stdgens and the inverses + # s, t, del, v, x, s^-1, t^-1, del^-1, v^-1, x^-1 + # The entries 11 (resAEM) and 12 (tmpAEM) are used to save AEM-values + slp := [ [1, 1], [2, 1], [3, 1], [4, 1], [5, 1], [6, 1], [7, 1], + [1,-1], [2,-1], [3,-1], [4,-1], [5,-1], [6,-1], [7,-1], + [1, 0], [1, 0] ]; + + cnt := 16; + + Info( InfoBruhat, 2, "Memory Usage is: ",19," memory slots ", + "in PermSLP()\n"); + fi; + + # Initialize the additional memory quota + Add(slp, [ [1,0], cnt + 1 ] ); p_signpos := cnt + 1; #13 or 20+3f + Add(slp, [ [4,-1], cnt + 2 ] ); vpos := cnt + 2; #14 or 21+3f + Add(slp, [ [4,-1], cnt + 3 ] ); vipos := cnt + 3; #15 or 22+3f + Add(slp, [ [1,1], cnt + 4 ] ); spos := cnt + 4; #16 or 23+3f + Add(slp, [ [5,1], cnt + 5 ] ); upos := cnt + 5; #17 or 24+3f + Add(slp, [ [5,0], cnt + 6 ] ); unpos := cnt + 6; #18 or 25+3f + Add(slp, [ [1,0], cnt + 7 ] ); tpos := cnt + 7; #19 or 26+3f + Add(slp, [ [1,0], cnt + 8 ] ); left := cnt + 8; #20 or 27+3f + Add(slp, [ [1,0], cnt + 9 ] ); right := cnt + 9; #21 or 28+3f + + if IsDiagonalMat( mat ) then + # In order to make it coincide with the other possible output. + # This is ok since it is Id + Add( slp, [ [p_signpos,-1] , p_signpos ] ); + return [ slp, [ stdgens[1]^0, mat ] ]; + fi; + + c := CycleFromPermutation(perm); + u1 := One(SymmetricGroup(n)); + u2 := One(SymmetricGroup(n)); + result := []; + result2 := []; + L2 := IdentityMat(n,fld); + R2 := IdentityMat(n,fld); + w := PrimitiveElement(fld); + q := RootInt(Size(fld)); + # alpha := w^((q+1)/2); # Not needed here + while (CheckContinue(perm,m)) do + c := CycleFromPermutation(perm); + for i in c do + k := LargestMovedPoint(i); + if k < m then + Add(result, i); + elif SmallestMovedPoint(i) > m then + + elif (n-k+1)^i = n-k+1 then + tmpvalue := L2[k]; + L2[k] := L2[n-k+1]; + L2[n-k+1] := tmpvalue; #Was ist das Inverse? + tmpvalue := R2{[1..n]}[k]; + R2{[1..n]}[k] := R2{[1..n]}[n-k+1]; + R2{[1..n]}[n-k+1] := tmpvalue; + perm := perm^(k,n-k+1); + u1 := (k,n-k+1) * u1; + Add( slp, [ [vpos,-(k-1),spos,1,vpos,k-1] , tpos ] ); + Add( slp, [ [tpos,-1,left,1] , left ] ); + Add( slp, [ [right,1,tpos,1] , right] ); + u2 := u2 * (k,n-k+1); + break; + else + tmpvalue := L2[k]; + L2[k] := L2[n-k+1]; + L2[n-k+1] := tmpvalue; + perm := (k,n-k+1)*perm; + u1 := (k,n-k+1) * u1; + Add( slp, [ [vpos,-(k-1),spos,1,vpos,k-1] , tpos ] ); + Add( slp, [ [tpos,1,left,1] , left ] ); + break; + fi; + od; + od; + + c := CycleFromPermutation(perm); + for i in c do + k := LargestMovedPoint(i); + if k <= m then + Add(result, i); + else + Add(result2, i); + fi; + od; + + Add( slp, [ [left,-1] , left ] ); + Add( slp, [ [right,-1] , right ] ); + + result := Set(result); + result2 := Set(result2); + + perm := One(SymmetricGroup(n)); + for i in [1..Size(result)] do + perm := perm * result[i]; + od; + + perm2 := One(SymmetricGroup(n)); + for i in [1..Size(result2)] do + perm2 := perm2 * result2[i]; + od; + + v := (CycleFromPermutation(PermutationMonomialMatrix(stdgens[4])[2])[1])^(-1); + vf := (CycleFromPermutation(PermutationMonomialMatrix(stdgens[4])[2])[1])^(-1); + s := CycleFromPermutation(PermutationMonomialMatrix(stdgens[5])[2])[1]; + + Add( slp, [ [4,1], vpos ] ); + Add( slp, [ [4,-1], vipos ] ); + Add( slp, [ [5,1], spos ] ); + + perm3 := perm; + + for i in [ 1 .. m-1 ] do + + pot := i^perm - i; + + # Need to update perm since pi_{i-1} may change pos of i + perm := perm * v ^pot; + + # memory slots 11 and 12 are used for resAEM and tmpAEM + instr := AEM( vipos, 15, 16, pot ); + Append( slp, instr ); + Add( slp, [ [p_signpos,1, 15,1 ], p_signpos ] ); # permpos + + #Compute v_i+1, save command in slp + v := s * v; + + Add(slp,[ [spos,1, vipos,1 ], vipos ] ); # vipos + # Don't be confused with notation in Paper + # There we used v1 (which coincides with v^-1) + + s := s ^( vf ^-1 ); + Add(slp, [ [11, 1, spos,1, 4,1 ], spos ] ); # spos + + + od; + + Add(slp,[ [ p_signpos,-1 ], p_signpos ] ); + + tmpvalue := PermutationMat(perm2^(-1),n, fld); + tmpvalue{[1..((n+1)/2)-1]}{[1..((n+1)/2)-1]} := PermutationMat(perm3^(-1),((n+1)/2)-1, fld); + + Add( slp, [ [left,1,p_signpos,1,right,1] , p_signpos ] ); + + Add( slp, [ p_signpos ,1 ] ); + + tmpvalue := R2*tmpvalue*L2; + mat := tmpvalue*mat; + + return [slp, [tmpvalue , mat ] ]; + +end +); + + + +##### +# MonomialSLPSUEven +##### + +InstallGlobalFunction( MonomialSLPSUEven, +function(arg) + + local slp, c, n, m, result, i, k, u1, u2, result2, test, g, stdgens, mat, perm, fld, p_signpos, vpos, vipos, spos, upos, unpos, tpos, left, right, cnt, v, vf, s, pot, p_signwr, instr, swr, vwr, viwr, p_sign, leftma, rightma, L, R, diag, w, alpha, tmpvalue, rowlist, L2, R2, tmpSave, perm2, perm3, q; + + # Check for correct Input + if Length(arg) >= 2 and IsList(arg[1]) and IsMatrix(arg[2]) then + + stdgens := arg[1]; # the LGO standard generators + mat := arg[2]; # the monomial matrix + n := Length(stdgens[1]); + m := n/2; + + # Compute the permutation in Sym(n) of mat + perm := PermutationMonomialMatrix( mat ); + perm := perm[2]; + p_signwr := (stdgens[1]^0); + + if Length(stdgens) < 1 or not IsMatrix( stdgens[1]) then + Error("Input: first argument must be the LGO standard generators"); + return; + fi; + + else + Error("input: LGO standard generators and a matrix"); + return; + fi; + + fld := FieldOfMatrixList( stdgens ); + + if Length(arg) = 3 then + + # The first 10 entries are the stdgens and their inverses + slp := arg[3]; + + if not IsList(slp) then + Error("Input: third argument must be a list"); + return; + fi; + + cnt := HighestSlotOfSLP(slp); + + Info( InfoBruhat, 2, " and additional: ",7," memory slots ", + "in PermSLP()\n"); + else + + # we write an SLP into the variable slp + # The first 14 entries are the stdgens and the inverses + # s, t, del, v, x, s^-1, t^-1, del^-1, v^-1, x^-1 + # The entries 11 (resAEM) and 12 (tmpAEM) are used to save AEM-values + slp := [ [1, 1], [2, 1], [3, 1], [4, 1], [5, 1], [6, 1], [7, 1], + [1,-1], [2,-1], [3,-1], [4,-1], [5,-1], [6,-1], [7,-1], + [1, 0], [1, 0] ]; + + cnt := 16; + + Info( InfoBruhat, 2, "Memory Usage is: ",19," memory slots ", + "in PermSLP()\n"); + fi; + + # Initialize the additional memory quota + Add(slp, [ [1,0], cnt + 1 ] ); p_signpos := cnt + 1; #13 or 20+3f + Add(slp, [ [4,-1], cnt + 2 ] ); vpos := cnt + 2; #14 or 21+3f + Add(slp, [ [4,-1], cnt + 3 ] ); vipos := cnt + 3; #15 or 22+3f + Add(slp, [ [1,1], cnt + 4 ] ); spos := cnt + 4; #16 or 23+3f + Add(slp, [ [5,1], cnt + 5 ] ); upos := cnt + 5; #17 or 24+3f + Add(slp, [ [5,0], cnt + 6 ] ); unpos := cnt + 6; #18 or 25+3f + Add(slp, [ [1,0], cnt + 7 ] ); tpos := cnt + 7; #19 or 26+3f + Add(slp, [ [1,0], cnt + 8 ] ); left := cnt + 8; #20 or 27+3f + Add(slp, [ [1,0], cnt + 9 ] ); right := cnt + 9; #21 or 28+3f + + if IsDiagonalMat( mat ) then + # In order to make it coincide with the other possible output. + # This is ok since it is Id + Add( slp, [ [p_signpos,-1] , p_signpos ] ); + return [ slp, [ stdgens[1]^0, mat ] ]; + fi; + + c := CycleFromPermutation(perm); + u1 := One(SymmetricGroup(n)); + u2 := One(SymmetricGroup(n)); + result := []; + result2 := []; + m := n/2; + L2 := IdentityMat(n,fld); + R2 := IdentityMat(n,fld); + w := PrimitiveElement(fld); + q := RootInt(Size(fld)); + alpha := w^((q+1)/2); + while (CheckContinue(perm,m)) do + c := CycleFromPermutation(perm); + for i in c do + k := LargestMovedPoint(i); + if k <= m then + Add(result, i); + elif SmallestMovedPoint(i) > m then + + elif (n-k+1)^i = n-k+1 then + tmpvalue := L2[k]; + L2[k] := alpha^(-1)*L2[n-k+1]; + L2[n-k+1] := alpha^(q)* tmpvalue; #Was ist das Inverse? + tmpvalue := R2{[1..n]}[k]; + R2{[1..n]}[k] := alpha*R2{[1..n]}[n-k+1]; + R2{[1..n]}[n-k+1] := alpha^(-q)*tmpvalue; + perm := perm^(k,n-k+1); + u1 := (k,n-k+1) * u1; + Add( slp, [ [vpos,-k,spos,1,vpos,k] , tpos ] ); + Add( slp, [ [tpos,-1,left,1] , left ] ); + Add( slp, [ [right,1,tpos,1] , right] ); + u2 := u2 * (k,n-k+1); + break; + else + tmpvalue := L2[k]; + L2[k] := alpha^(-q)* L2[n-k+1]; + L2[n-k+1] := alpha*tmpvalue; + perm := (k,n-k+1)*perm; + u1 := (k,n-k+1) * u1; + Add( slp, [ [vpos,-k,spos,1,vpos,k] , tpos ] ); + Add( slp, [ [tpos,1,left,1] , left ] ); + break; + fi; + od; + od; + + c := CycleFromPermutation(perm); + for i in c do + k := LargestMovedPoint(i); + if k <= m then + Add(result, i); + else + Add(result2, i); + fi; + od; + + Add( slp, [ [left,-1] , left ] ); + Add( slp, [ [right,-1] , right ] ); + + #Display(mat); + #Add(slp, [ [left,1,p_signpos,1,right,1] , p_signpos ] ); + #Add(slp, [[p_signpos,1],p_signpos]); + #Add(slp, [[left,1],left]); + #return slp; + + result := Set(result); + result2 := Set(result2); + + perm := One(SymmetricGroup(n)); + for i in [1..Size(result)] do + perm := perm * result[i]; + od; + + perm2 := One(SymmetricGroup(n)); + for i in [1..Size(result2)] do + perm2 := perm2 * result2[i]; + od; + + v := (CycleFromPermutation(PermutationMonomialMatrix(stdgens[4])[2])[1])^(-1); + vf := (CycleFromPermutation(PermutationMonomialMatrix(stdgens[4])[2])[1])^(-1); + s := CycleFromPermutation(PermutationMonomialMatrix(stdgens[5])[2])[1]; + + Add( slp, [ [4,1], vpos ] ); + Add( slp, [ [4,-1], vipos ] ); + Add( slp, [ [5,1], spos ] ); + + perm3 := perm; + + for i in [ 1 .. m ] do + + pot := i^perm - i; + + # Need to update perm since pi_{i-1} may change pos of i + perm := perm * v ^pot; + + # memory slots 11 and 12 are used for resAEM and tmpAEM + instr := AEM( vipos, 15, 16, pot ); + Append( slp, instr ); + Add( slp, [ [p_signpos,1, 15,1 ], p_signpos ] ); # permpos + + #Compute v_i+1, save command in slp + v := s * v; + + Add(slp,[ [spos,1, vipos,1 ], vipos ] ); # vipos + # Don't be confused with notation in Paper + # There we used v1 (which coincides with v^-1) + + s := s ^( vf ^-1 ); + Add(slp, [ [11, 1, spos,1, 4,1 ], spos ] ); # spos + + + od; + + Add(slp,[ [ p_signpos,-1 ], p_signpos ] ); + + tmpvalue := PermutationMat(perm2^(-1),n, fld); + tmpvalue{[1..n/2]}{[1..n/2]} := PermutationMat(perm3^(-1),n/2, fld); + + Add( slp, [ [left,1,p_signpos,1,right,1] , p_signpos ] ); + + Add( slp, [ p_signpos ,1 ] ); + + tmpvalue := R2*tmpvalue*L2; + mat := tmpvalue*mat; + + return [slp, [tmpvalue , mat ] ]; + +end +); + + + +##### +# MonomialSLPSUEvenAndEvenChar +##### + +InstallGlobalFunction( MonomialSLPSUEvenAndEvenChar, +function(arg) + + local slp, c, n, m, result, i, k, u1, u2, result2, test, g, stdgens, mat, perm, fld, p_signpos, vpos, vipos, spos, upos, unpos, tpos, left, right, cnt, v, vf, s, pot, p_signwr, instr, swr, vwr, viwr, p_sign, leftma, rightma, L, R, diag, w, alpha, tmpvalue, rowlist, L2, R2, tmpSave, perm2, perm3, q; + + # Check for correct Input + if Length(arg) >= 2 and IsList(arg[1]) and IsMatrix(arg[2]) then + + stdgens := arg[1]; # the LGO standard generators + mat := arg[2]; # the monomial matrix + n := Length(stdgens[1]); + m := n/2; + + # Compute the permutation in Sym(n) of mat + perm := PermutationMonomialMatrix( mat ); + perm := perm[2]; + p_signwr := (stdgens[1]^0); + + if Length(stdgens) < 1 or not IsMatrix( stdgens[1]) then + Error("Input: first argument must be the LGO standard generators"); + return; + fi; + + else + Error("input: LGO standard generators and a matrix"); + return; + fi; + + fld := FieldOfMatrixList( stdgens ); + + if Length(arg) = 3 then + + # The first 10 entries are the stdgens and their inverses + slp := arg[3]; + + if not IsList(slp) then + Error("Input: third argument must be a list"); + return; + fi; + + cnt := HighestSlotOfSLP(slp); + + Info( InfoBruhat, 2, " and additional: ",7," memory slots ", + "in PermSLP()\n"); + else + + # we write an SLP into the variable slp + # The first 14 entries are the stdgens and the inverses + # s, t, del, v, x, s^-1, t^-1, del^-1, v^-1, x^-1 + # The entries 11 (resAEM) and 12 (tmpAEM) are used to save AEM-values + slp := [ [1, 1], [2, 1], [3, 1], [4, 1], [5, 1], [6, 1], [7, 1], + [1,-1], [2,-1], [3,-1], [4,-1], [5,-1], [6,-1], [7,-1], + [1, 0], [1, 0] ]; + + cnt := 16; + + Info( InfoBruhat, 2, "Memory Usage is: ",19," memory slots ", + "in PermSLP()\n"); + fi; + + # Initialize the additional memory quota + Add(slp, [ [1,0], cnt + 1 ] ); p_signpos := cnt + 1; #13 or 20+3f + Add(slp, [ [4,-1], cnt + 2 ] ); vpos := cnt + 2; #14 or 21+3f + Add(slp, [ [4,-1], cnt + 3 ] ); vipos := cnt + 3; #15 or 22+3f + Add(slp, [ [1,1], cnt + 4 ] ); spos := cnt + 4; #16 or 23+3f + Add(slp, [ [5,1], cnt + 5 ] ); upos := cnt + 5; #17 or 24+3f + Add(slp, [ [5,0], cnt + 6 ] ); unpos := cnt + 6; #18 or 25+3f + Add(slp, [ [1,0], cnt + 7 ] ); tpos := cnt + 7; #19 or 26+3f + Add(slp, [ [1,0], cnt + 8 ] ); left := cnt + 8; #20 or 27+3f + Add(slp, [ [1,0], cnt + 9 ] ); right := cnt + 9; #21 or 28+3f + + if IsDiagonalMat( mat ) then + # In order to make it coincide with the other possible output. + # This is ok since it is Id + Add( slp, [ [p_signpos,-1] , p_signpos ] ); + return [ slp, [ stdgens[1]^0, mat ] ]; + fi; + + c := CycleFromPermutation(perm); + u1 := One(SymmetricGroup(n)); + u2 := One(SymmetricGroup(n)); + result := []; + result2 := []; + m := n/2; + L2 := IdentityMat(n,fld); + R2 := IdentityMat(n,fld); + w := PrimitiveElement(fld); + q := RootInt(Size(fld)); + alpha := One(fld); + while (CheckContinue(perm,m)) do + c := CycleFromPermutation(perm); + for i in c do + k := LargestMovedPoint(i); + if k <= m then + Add(result, i); + elif SmallestMovedPoint(i) > m then + + elif (n-k+1)^i = n-k+1 then + tmpvalue := L2[k]; + L2[k] := alpha^(-1)*L2[n-k+1]; + L2[n-k+1] := alpha^(q)* tmpvalue; #Was ist das Inverse? + tmpvalue := R2{[1..n]}[k]; + R2{[1..n]}[k] := alpha*R2{[1..n]}[n-k+1]; + R2{[1..n]}[n-k+1] := alpha^(-q)*tmpvalue; + perm := perm^(k,n-k+1); + u1 := (k,n-k+1) * u1; + Add( slp, [ [vpos,-k,spos,1,vpos,k] , tpos ] ); + Add( slp, [ [tpos,-1,left,1] , left ] ); + Add( slp, [ [right,1,tpos,1] , right] ); + u2 := u2 * (k,n-k+1); + break; + else + tmpvalue := L2[k]; + L2[k] := alpha^(-q)* L2[n-k+1]; + L2[n-k+1] := alpha*tmpvalue; + perm := (k,n-k+1)*perm; + u1 := (k,n-k+1) * u1; + Add( slp, [ [vpos,-k,spos,1,vpos,k] , tpos ] ); + Add( slp, [ [tpos,1,left,1] , left ] ); + break; + fi; + od; + od; + + c := CycleFromPermutation(perm); + for i in c do + k := LargestMovedPoint(i); + if k <= m then + Add(result, i); + else + Add(result2, i); + fi; + od; + + Add( slp, [ [left,-1] , left ] ); + Add( slp, [ [right,-1] , right ] ); + + #Display(mat); + #Add(slp, [ [left,1,p_signpos,1,right,1] , p_signpos ] ); + #Add(slp, [[p_signpos,1],p_signpos]); + #Add(slp, [[left,1],left]); + #return slp; + + result := Set(result); + result2 := Set(result2); + + perm := One(SymmetricGroup(n)); + for i in [1..Size(result)] do + perm := perm * result[i]; + od; + + perm2 := One(SymmetricGroup(n)); + for i in [1..Size(result2)] do + perm2 := perm2 * result2[i]; + od; + + v := (CycleFromPermutation(PermutationMonomialMatrix(stdgens[4])[2])[1])^(-1); + vf := (CycleFromPermutation(PermutationMonomialMatrix(stdgens[4])[2])[1])^(-1); + s := CycleFromPermutation(PermutationMonomialMatrix(stdgens[5])[2])[1]; + + Add( slp, [ [4,1], vpos ] ); + Add( slp, [ [4,-1], vipos ] ); + Add( slp, [ [5,1], spos ] ); + + perm3 := perm; + + for i in [ 1 .. m ] do + + pot := i^perm - i; + + # Need to update perm since pi_{i-1} may change pos of i + perm := perm * v ^pot; + + # memory slots 11 and 12 are used for resAEM and tmpAEM + instr := AEM( vipos, 15, 16, pot ); + Append( slp, instr ); + Add( slp, [ [p_signpos,1, 15,1 ], p_signpos ] ); # permpos + + #Compute v_i+1, save command in slp + v := s * v; + + Add(slp,[ [spos,1, vipos,1 ], vipos ] ); # vipos + # Don't be confused with notation in Paper + # There we used v1 (which coincides with v^-1) + + s := s ^( vf ^-1 ); + Add(slp, [ [11, 1, spos,1, 4,1 ], spos ] ); # spos + + + od; + + Add(slp,[ [ p_signpos,-1 ], p_signpos ] ); + + tmpvalue := PermutationMat(perm2^(-1),n, fld); + tmpvalue{[1..n/2]}{[1..n/2]} := PermutationMat(perm3^(-1),n/2, fld); + + Add( slp, [ [left,1,p_signpos,1,right,1] , p_signpos ] ); + + Add( slp, [ p_signpos ,1 ] ); + + tmpvalue := R2*tmpvalue*L2; + mat := tmpvalue*mat; + + return [slp, [tmpvalue , mat ] ]; + +end +); + + + +##### +# CheckContinue +##### + +InstallGlobalFunction( CheckContinue, +function(perm,m) + + local c, i; + + c := CycleFromPermutation(perm); + for i in c do + if not(LargestMovedPoint(i) <= m or SmallestMovedPoint(i) > m) then + return true; + fi; + od; + + return false; + +end +); + + + +##### +# CycleFromPermutation +##### + +InstallGlobalFunction( CycleFromPermutation, +function(g) + + local result, n, pl, nc, point, i, h; + + h := LargestMovedPoint(g); + n := [1..h]; + pl := ListPerm(g); + result := [One(SymmetricGroup(h))]; + + for i in n do + if not(Size(Orbit(GroupByGenerators(result),i))>= 2) then + nc := Orbit(GroupByGenerators([g]),[1..h],i); + Add(result,CycleFromListMine(nc,h)); + n := Intersection(n,nc); + fi; + od; + + result := Filtered(result, x-> not(x = One(SymmetricGroup(h)))); + + return result; + +end +); + + + +##### +# CycleFromListMine +##### + +InstallGlobalFunction( CycleFromListMine, +function(nc,h) + + local result, i; + + result := [1..h]; + for i in result do + if i in nc then + if not(i = nc[Size(nc)]) then + result[i] := nc[Position(nc,i)+1]; + else + result[i] := nc[1]; + fi; + fi; + od; + + return PermListList([1..h],result); + +end +); + + + +##### +# DiagSLPSUOdd +##### + +InstallGlobalFunction( DiagSLPSUOdd, +function(arg) + + local stdgens, diag, fld, slp, a_i, d, omega, y, v, cnt, hiposm, hipos, respos, hres, instr, i, q; + + if Length(arg) >= 2 and IsList(arg[1]) and IsMatrix(arg[2]) then + + stdgens := arg[1]; # the LGO standard generators + diag := arg[2]; + + if Length(stdgens) < 1 or not IsMatrix( stdgens[1] ) then + Error("Input: first argument must be the LGO standard generators"); + return; + fi; + + if not IsDiagonalMat( diag ) then + Error("Input: second argument must be a diagonal matrix"); + return; + fi; + else + Error("Input: LGO standard generators and a diagonal matrix"); + return; + fi; + + fld := FieldOfMatrixList( stdgens ); + q := Characteristic(fld); + + if Length(arg) >= 3 and Length(arg) <= 4 then + + # The first 14 entries are the stdgens and their inverses + slp := arg[3]; + + if not IsList(slp) then + Error("Input: third argument must be a list"); + return fail; + fi; + + # cnt := HighestSlotOfSLP( slp ); <--- Laesst sich das umgehen? Jeweils den hoechsten Slot mitzaehlen? + cnt := arg[4]; + Info( InfoBruhat, 2, " and additional: ",3," memory slots ", + "in DiagonalDecomposition()\n"); + + else + # We write an SLP into the variable slp + # The first 14 entries are the stdgens and their inverses + # s^-1 t^-1 del^-1 v^-1 x^-1 + # The entries #15 (resAEM),#16 (tmpAEM) are used to save AEM-values + slp := [ [1, 1], [2, 1], [3, 1], [4, 1], [5, 1], [6, 1], [7,1], + [1,-1], [2,-1], [3,-1], [4,-1], [5,-1], [6,-1], [7,-1], + [1, 0], [1, 0] ]; + + cnt := 16; + Info( InfoBruhat, 2, "Memory Usage is: ",3," memory slots ", + "in DiagonalDecomposition()\n"); + fi; + + # Define the LGO standard-generators given in the input + y := stdgens[7]; + v := stdgens[4]; + + # Initialize the additional memory quota + #hi-2 + Add(slp, [ [1,0], cnt + 1 ] ); hipos := cnt + 1; #17 or 28+3f + # result + Add(slp, [ [1,0], cnt + 2 ] ); respos := cnt + 2; #18 or 29+3f + + d := Length( diag ); + omega := y[1][1]; + + if diag = One(diag) then + Add( slp, [ [1,0], respos ] ); + Add( slp, [ respos, 1]); + return [slp]; + fi; + + hres := diag^0; + Add( slp, [ [7,1], hipos ] ); + + for i in [ 1..((d-1)/2) ] do + + a_i := LogFFE( diag[i][i], omega ); + + # The memory slots 15 and 16 are res and tmp-slot for AEM + instr := AEM( hipos, 15, 16, a_i ); + Append( slp, instr ); + Add( slp, [ [respos, 1, 15, 1 ], respos ] ); + Add( slp, [ [4, -1 , hipos, 1, 4,1 ], hipos ] ); + + od; + + Add( slp, [ respos ,1 ] ); + + return [slp]; + +end +); + + + +##### +# DiagSLPSUOddAndEvenChar +##### + +InstallGlobalFunction( DiagSLPSUOddAndEvenChar, +function(arg) + + local stdgens, diag, fld, slp, a_i, d, omega, y, v, cnt, hiposm, hipos, respos, hres, instr, i, q; + + if Length(arg) >= 2 and IsList(arg[1]) and IsMatrix(arg[2]) then + + stdgens := arg[1]; # the LGO standard generators + diag := arg[2]; + + if Length(stdgens) < 1 or not IsMatrix( stdgens[1] ) then + Error("Input: first argument must be the LGO standard generators"); + return; + fi; + + if not IsDiagonalMat( diag ) then + Error("Input: second argument must be a diagonal matrix"); + return; + fi; + else + Error("Input: LGO standard generators and a diagonal matrix"); + return; + fi; + + fld := FieldOfMatrixList( stdgens ); + q := Characteristic(fld); + + if Length(arg) >= 3 and Length(arg) <= 4 then + + # The first 14 entries are the stdgens and their inverses + slp := arg[3]; + + if not IsList(slp) then + Error("Input: third argument must be a list"); + return fail; + fi; + + # cnt := HighestSlotOfSLP( slp ); <--- Laesst sich das umgehen? Jeweils den hoechsten Slot mitzaehlen? + cnt := arg[4]; + Info( InfoBruhat, 2, " and additional: ",3," memory slots ", + "in DiagonalDecomposition()\n"); + + else + # We write an SLP into the variable slp + # The first 14 entries are the stdgens and their inverses + # s^-1 t^-1 del^-1 v^-1 x^-1 + # The entries #15 (resAEM),#16 (tmpAEM) are used to save AEM-values + slp := [ [1, 1], [2, 1], [3, 1], [4, 1], [5, 1], [6, 1], [7,1], + [1,-1], [2,-1], [3,-1], [4,-1], [5,-1], [6,-1], [7,-1], + [1, 0], [1, 0] ]; + + cnt := 16; + Info( InfoBruhat, 2, "Memory Usage is: ",3," memory slots ", + "in DiagonalDecomposition()\n"); + fi; + + # Define the LGO standard-generators given in the input + y := stdgens[7]; + v := stdgens[4]; + + # Initialize the additional memory quota + #hi-2 + Add(slp, [ [1,0], cnt + 1 ] ); hipos := cnt + 1; #17 or 28+3f + # result + Add(slp, [ [1,0], cnt + 2 ] ); respos := cnt + 2; #18 or 29+3f + + d := Length( diag ); + omega := y[((d+1)/2)-1][((d+1)/2)-1]; #Angepasst, hier muss omega entsprechend y gewaehlt werden. + + if diag = One(diag) then + Add( slp, [ [1,0], respos ] ); + Add( slp, [ respos, 1]); + return [slp]; + fi; + + hres := diag^0; + Add( slp, [ [7,1], hipos ] ); + + for i in [ 1..((d-1)/2) ] do + + a_i := LogFFE( diag[d-i+1][d-i+1], omega ); + + # The memory slots 15 and 16 are res and tmp-slot for AEM + instr := AEM( hipos, 15, 16, a_i ); + Append( slp, instr ); + Add( slp, [ [respos, 1, 15, 1 ], respos ] ); + Add( slp, [ [4, -1 , hipos, 1, 4,1 ], hipos ] ); + + od; + + Add( slp, [ respos ,1 ] ); + + return [slp]; + +end +); + + + +##### +# DiagSLPSU +##### + +InstallGlobalFunction( DiagSLPSU, +function(arg) + + local diag, n; + + diag := arg[2]; + n := Length(diag); + + if (n mod 2) = 0 then + return DiagSLPSUEven(arg); + else + return DiagSLPSUOdd(arg); + fi; + +end +); + + + +##### +# DiagSLPSUEven +##### + +InstallGlobalFunction( DiagSLPSUEven, +function(arg) + + local stdgens, diag, fld, slp, a_i, d, omega, y, v, cnt, hiposm, hipos, respos, hres, instr, i, q, alpha, lambdai; + + if Length(arg) >= 2 and IsList(arg[1]) and IsMatrix(arg[2]) then + + stdgens := arg[1]; # the LGO standard generators + diag := arg[2]; + + if Length(stdgens) < 1 or not IsMatrix( stdgens[1] ) then + Error("Input: first argument must be the LGO standard generators"); + return; + fi; + + if not IsDiagonalMat( diag ) then + Error("Input: second argument must be a diagonal matrix"); + return; + fi; + else + Error("Input: LGO standard generators and a diagonal matrix"); + return; + fi; + + fld := FieldOfMatrixList( stdgens ); + q := RootInt(Size(fld)); + + if Length(arg) >= 3 and Length(arg) <= 4 then + + # The first 14 entries are the stdgens and their inverses + slp := arg[3]; + + if not IsList(slp) then + Error("Input: third argument must be a list"); + return fail; + fi; + + # cnt := HighestSlotOfSLP( slp ); <--- Laesst sich das umgehen? Jeweils den hoechsten Slot mitzaehlen? + cnt := arg[4]; + Info( InfoBruhat, 2, " and additional: ",3," memory slots ", + "in DiagonalDecomposition()\n"); + + else + # We write an SLP into the variable slp + # The first 10 entries are the stdgens and their inverses + # s^-1 t^-1 del^-1 v^-1 x^-1 + # The entries #15 (resAEM),#16 (tmpAEM) are used to save AEM-values + slp := [ [1, 1], [2, 1], [3, 1], [4, 1], [5, 1], [6, 1], [7,1], + [1,-1], [2,-1], [3,-1], [4,-1], [5,-1], [6,-1], [7,-1], + [1, 0], [1, 0] ]; + + cnt := 16; + Info( InfoBruhat, 2, "Memory Usage is: ",3," memory slots ", + "in DiagonalDecomposition()\n"); + fi; + + # Define the LGO standard-generators given in the input + y := stdgens[7]; + v := stdgens[4]; + + # Initialize the additional memory quota + #hi-2 + Add(slp, [ [1,0], cnt + 1 ] ); hipos := cnt + 1; #17 or 28+3f + # result + Add(slp, [ [1,0], cnt + 2 ] ); respos := cnt + 2; #18 or 29+3f + + d := Length( diag ); + omega := y[1][1]; + + if diag = One(diag) then + Add( slp, [ [1,0], respos ] ); + Add( slp, [ respos, 1]); + return [slp]; + fi; + + hres := diag^0; + lambdai := 0; + Add( slp, [ [7,1], hipos ] ); + + for i in [ 1..(d/2)-1 ] do + + lambdai := lambdai + LogFFE( diag[i][i], omega ); + + # The memory slots 15 and 16 are res and tmp-slot for AEM + instr := AEM( hipos, 15, 16, lambdai ); + Append( slp, instr ); + Add( slp, [ [respos, 1, 15, 1 ], respos ] ); + Add( slp, [ [4, -1 , hipos, 1, 4,1 ], hipos ] ); + + od; + + alpha := omega^(q+1); + lambdai := LogFFE( diag[d/2][d/2] * omega^(lambdai), alpha ); + + Add( slp, [ [4, -((d/2)-1) , 3, 1, 4, (d/2)-1], hipos ] ); + instr := AEM( hipos, 15, 16, lambdai ); + Append( slp, instr ); + Add( slp, [ [respos, 1, 15, 1 ], respos ] ); + + Add( slp, [ respos ,1 ] ); + + return [slp]; + +end +); + + + +##### +# DiagSLPSUEvenAndEvenChar +##### + +InstallGlobalFunction( DiagSLPSUEvenAndEvenChar, +function(arg) + + local stdgens, diag, fld, slp, a_i, d, omega, y, v, cnt, hiposm, hipos, respos, hres, instr, i, q, alpha, lambdai; + + if Length(arg) >= 2 and IsList(arg[1]) and IsMatrix(arg[2]) then + + stdgens := arg[1]; # the LGO standard generators + diag := arg[2]; + + if Length(stdgens) < 1 or not IsMatrix( stdgens[1] ) then + Error("Input: first argument must be the LGO standard generators"); + return; + fi; + + if not IsDiagonalMat( diag ) then + Error("Input: second argument must be a diagonal matrix"); + return; + fi; + else + Error("Input: LGO standard generators and a diagonal matrix"); + return; + fi; + + fld := FieldOfMatrixList( stdgens ); + q := RootInt(Size(fld)); + + if Length(arg) >= 3 and Length(arg) <= 4 then + + # The first 14 entries are the stdgens and their inverses + slp := arg[3]; + + if not IsList(slp) then + Error("Input: third argument must be a list"); + return fail; + fi; + + # cnt := HighestSlotOfSLP( slp ); <--- Laesst sich das umgehen? Jeweils den hoechsten Slot mitzaehlen? + cnt := arg[4]; + Info( InfoBruhat, 2, " and additional: ",3," memory slots ", + "in DiagonalDecomposition()\n"); + + else + # We write an SLP into the variable slp + # The first 10 entries are the stdgens and their inverses + # s^-1 t^-1 del^-1 v^-1 x^-1 + # The entries #15 (resAEM),#16 (tmpAEM) are used to save AEM-values + slp := [ [1, 1], [2, 1], [3, 1], [4, 1], [5, 1], [6, 1], [7,1], + [1,-1], [2,-1], [3,-1], [4,-1], [5,-1], [6,-1], [7,-1], + [1, 0], [1, 0] ]; + + cnt := 16; + Info( InfoBruhat, 2, "Memory Usage is: ",3," memory slots ", + "in DiagonalDecomposition()\n"); + fi; + + # Define the LGO standard-generators given in the input + y := stdgens[7]; + v := stdgens[4]; + + # Initialize the additional memory quota + #hi-2 + Add(slp, [ [1,0], cnt + 1 ] ); hipos := cnt + 1; #17 or 28+3f + # result + Add(slp, [ [1,0], cnt + 2 ] ); respos := cnt + 2; #18 or 29+3f + + d := Length( diag ); + omega := y[1][1]; + + if diag = One(diag) then + Add( slp, [ [1,0], respos ] ); + Add( slp, [ respos, 1]); + return [slp]; + fi; + + hres := diag^0; + lambdai := 0; + Add( slp, [ [7,1], hipos ] ); + + for i in [ 1..(d/2)-1 ] do + + lambdai := lambdai + LogFFE( diag[i][i], omega ); + + # The memory slots 15 and 16 are res and tmp-slot for AEM + instr := AEM( hipos, 15, 16, lambdai ); + Append( slp, instr ); + Add( slp, [ [respos, 1, 15, 1 ], respos ] ); + Add( slp, [ [4, -1 , hipos, 1, 4,1 ], hipos ] ); + + od; + + alpha := omega^(q+1); + lambdai := LogFFE( diag[d/2][d/2] * omega^(lambdai), alpha ); + + Add( slp, [ [4, -((d/2)-1) , 3, 1, 4, (d/2)-1], hipos ] ); + instr := AEM( hipos, 15, 16, lambdai ); + Append( slp, instr ); + Add( slp, [ [respos, 1, 15, 1 ], respos ] ); + + Add( slp, [ respos ,1 ] ); + + return [slp]; + +end +); diff --git a/gap/matrix/wordsInNiceGens/BruhatDecompositionSp.gd b/gap/matrix/wordsInNiceGens/BruhatDecompositionSp.gd new file mode 100755 index 00000000..bdc70040 --- /dev/null +++ b/gap/matrix/wordsInNiceGens/BruhatDecompositionSp.gd @@ -0,0 +1,166 @@ +############################################################################# +# BruhatDecompositionSp.gd +############################################################################# +############################################################################# +## +## BruhatDecomposition package +## +## Daniel Rademacher, RWTH Aachen University +## Alice Niemeyer, RWTH Aachen University +## +## Licensed under the GPL 3 or later. +## +############################################################################# + +#! @Chapter Symplectic Group +#! @ChapterLabel SymplecticGroup +#! +#! This chapter deals with the symplectic group + +#! @Section Introduction and Quick Start of functions for Sp +#! @SectionLabel LabelIntroductionAndQuickStartSp +#! +#! TODO + + + + + + +#! @Section Functions for Sp +#! @SectionLabel LabelFunctionsSp + +#################### +# PART I - a) +# Originally implemented subfunctions +#################### + +InfoBruhat := NewInfoClass("InfoBruhat");; +SetInfoLevel( InfoBruhat, 2 ); + +##### +# LGOStandardGensSp +##### + +#! @Arguments d q +#! @Returns stdgens (the LGO standard-generators of Sp(d,q)) +#! @Description +#! d: The dimension of our matrix. Notice that d needs to be even for symplectic groups. \newline +#! q: A prime power q = p^f, where F_q ist the field whereover the matrices are defined \newline +#! This function computes the standard generators of Sp +#! as given by C. R. Leedham-Green and E. A. O'Brien in +#! "Constructive Recognition of Classical Groups in odd characteristic" +DeclareGlobalFunction( "LGOStandardGensSp" ); + + + +##### +# LGOStandardGensSpEvenChar +##### + +#! @Arguments d q +#! @Returns stdgens (the LGO standard-generators of Sp(d,q)) for q even +#! @Description +#! d: The dimension of our matrix. Notice that d needs to be even for symplectic groups. \newline +#! q: A 2 power q = 2^f, where F_q ist the field whereover the matrices are defined \newline +#! This function computes the standard generators of Sp +#! as given by C. R. Leedham-Green and E. A. O'Brien in +#! "Constructive Recognition of Classical Groups in even characteristic" +DeclareGlobalFunction( "LGOStandardGensSpEvenChar" ); + + + +#################### +# PART II - a) +# UnipotentDecomposition and Transvections +#################### + +##### +# UnitriangularDecompositionSp +##### + +#! @Arguments stdgens g +#! @Returns slp (A list of instructions yielding u_1,u_2 if evaluated as SLP), [u_1,g,u_2] (The matrices of the Bruhat-Decomposition) +#! @Description +#! stdgens: The LGO standard-generators \newline +#! g: A matrix in Sp(d,q) and q odd \newline +#! Computes the Unitriangular decomposition of the matrix g. +DeclareGlobalFunction( "UnitriangularDecompositionSp" ); + + + +##### +# UnitriangularDecompositionSpEvenChar +##### + +#! @Arguments stdgens g +#! @Returns slp (A list of instructions yielding u_1,u_2 if evaluated as SLP), [u_1,g,u_2] (The matrices of the Bruhat-Decomposition) +#! @Description +#! stdgens: The LGO standard-generators \newline +#! g: A matrix in Sp(d,q) and q even \newline +#! Computes the Unitriangular decomposition of the matrix g. +DeclareGlobalFunction( "UnitriangularDecompositionSpEvenChar" ); + + + +##################### +# PART III +# Decomposition of Permutation and Diagonal-Matrix +#################### + +##### +# MonomialSLPSp +##### + +#! @Arguments stdgens mat slp +#! @Returns slp (A list of instructions to evaluate tmpvalue. If slp is also given as input then this instructions are added to slp), [tmpvalue,diag] (tmpvalue is a monomial matix such that tmpvalue*mat = diag where diag is a diagonal matrix) +#! @Description +#! stdgens: The LGO standard-generators \newline +#! mat: A monomial matrix (ie w) \newline +#! slp: An already existing list of instructions *optional \newline +#! In this function we will transform a monomial matrix mat \in Sp(d,q) into +#! a diagonal matrix diag. Using only the standard-generators s,u,v this +#! will lead to a monomial matrix tmpvalue +#! and tmpvalue^{-1} \cdot diag = mat (i.e. diag = tmpvalue*mat ). +#! Furthermore we will return list slp of instructions which will +#! (when evaluated at the LGO standard-generators) yields diag. +DeclareGlobalFunction( "MonomialSLPSp" ); + + + +##### +# DiagSLPSp +##### + +#! @Arguments stdgens diag slp +#! @Returns slp (A list of instructions to evaluate diag if slp was Input then this instructions are added to slp) +#! @Description +#! stdgens: The LGO standard-generators \newline +#! diag: A diagonal matrix (eg diag) \newline +#! slp: An already existing list of instructions *optional \newline +#! Writes a list of instructions which evaluated with LGO standard-generators +#! yield the diagonal matrix of the input. +DeclareGlobalFunction( "DiagSLPSp" ); + + + +#################### +# PART IV +# Main Functions. Constructs slp for the StraightLineProgram +##################### + +##### +# BruhatDecompositionSp +##### + +#! @Arguments stdgens g +#! @Returns pgr (A SLP to compute u_1,u_2,p_{sign} and diag and the matrices u_1, u_2, p_{sign} and diag itself.) +#! @Description +#! stdgens: The LGO standard-generators \newline +#! g: A matrix in Sp(d,q) \newline +#! Uses UnitriangularDecompositionSp(), MonomialSLPSp() and DiagSLPSp() +#! to write a matrix g \in Sp(d,q) as g = u_1^{-1} \cdot p_{sign} \cdot diag \cdot u_2^{-1} +#! where u_1,u_2 are lower unitriangular matrices, p_{sign} is a monomial matrix and diag a diagonal matrix. +#! It furthermore yields an SLP that returns the above matrices if evaluated +#! with the LGO standard-generators. +DeclareGlobalFunction( "BruhatDecompositionSp" ); diff --git a/gap/matrix/wordsInNiceGens/BruhatDecompositionSp.gi b/gap/matrix/wordsInNiceGens/BruhatDecompositionSp.gi new file mode 100755 index 00000000..cf25a06d --- /dev/null +++ b/gap/matrix/wordsInNiceGens/BruhatDecompositionSp.gi @@ -0,0 +1,2024 @@ +###################################### +# BruhatDecompositionSU.gi +###################################### + +###################################### +# Concept: +# This implementation follows the ideas of +# "Bruhat Decomposition in unitary and symplectic groups over finite fields" +# by Daniel Rademacher. +# In the following all references will mean this paper +# and in case we differ from this paper (due to readability or bug-fixing) +# this will also be remarked. +# +# Let g \in SLp(d,p^f) +# Bruhat Decomposition computes g = u1 * w * u2, where +# - u1,u2 are lower triangular matrices +# - w is monomial matrix +# +# In this algorithm we want to compute the Bruhat-Decomposition of g +# and give g (respectively u1,w and u2) as word in the so called +# "LGO standard generators". +# +# 1) While computing u1 (resp u2) with some kind of Gauß-Algorithm, +# we express the matrices as product of so called Siegel transformations +# +# 2) In a further step we will decompose the monomial Matrix w in +# a monomial matrix p_sign and a diagonal Matrix diag. +# ( How to associate p_sign with a product of generators is +# further described in (PART I b) and (PART III) ) +# +# 3) The last step is the decomposition of the diagonal Matrix in 2) +# as word in the standard generators. +# +# We won't do this matrix multiplications directly, but write them +# in a list to evaluate in a StraightLineProgram. (Section 2) +# Although described differently in the paper, we sometimes will allow +# instructions to multiply more than two elements (eg during conjugating). +# This doesn't affect the optimality of an slp much, but higly increases +# the readability of our implementation. +###################################### + +#################### +# PART I - a) +# Originally implemented subfunctions +#################### + +InfoBruhat := NewInfoClass("InfoBruhat");; +SetInfoLevel( InfoBruhat, 2 ); + +##### +# UnitriangularDecompositionSp +##### + +InstallGlobalFunction( UnitriangularDecompositionSp, +function( arg ) + + local u1, u2, d, fld, f, alpha, c, r, j, a, z, i, Mul, g, ell, slp, hs, tmppos, AEMrespos, u1pos, u2pos, tvpos, T2pos, T3pos, T4pos, tmppos2, uipos, q, f2, TransvecAtAlpha2, TransvecAtAlpha3, TransvecAtAlpha4, test, ShiftTransvection3ByJ, ShiftTransvection3ByI, ShiftTransvection4, ShiftTransvection2ByJ, ShiftTransvection2ByI, stdgens; + + ##### + # TransvectionAtAlpha2() + ##### + + TransvecAtAlpha2 := function( alpha ) + + local cc, ell, instr; + + # if omega = 1 then we overwrite the position for tv with Ti(1) + if IsOne( alpha ) then + Add(slp, [ [ T2pos[1], 1 ], tvpos ] ); + return; + fi; + + cc := CoefficientsPrimitiveElement( fld, alpha ); + instr := []; + + for ell in [ 1..Length(cc) ] do + + if not IsZero( cc[ell] ) then + Append( instr, [ T2pos[ell], Int(cc[ell]) ] ); + fi; + od; + + if Length( instr ) = 0 then + Error("TransvecAtAlpha2: this should not happen"); + fi; + + Add( slp, [ instr,tvpos ] ); + + return; + + end; + + ##### + # ShiftTransvection2ByI() + ##### + + ShiftTransvection2ByI := function(i) + + local instr; + + instr := AEM( 4, AEMrespos, tmppos, i-2 ); + Append( slp, instr ); + Add( slp, [ [ AEMrespos, -1, tvpos , 1, AEMrespos, 1 ], tvpos ] ); + + end; + + ##### + # ShiftTransvection2ByJ() + ##### + + ShiftTransvection2ByJ := function(i, abnr) + + local ui; + + ui := (d/2)-2; + + while ui-i+1-(d/2-abnr) > 0 do + Add(slp, [[uipos[ui-(d/2-abnr)],1,tvpos,1,uipos[ui-(d/2-abnr)],1],tvpos]); + ui := ui-1; + od; + + end; + + ##### + # TransvectionAtAlpha3() + ##### + + TransvecAtAlpha3 := function( alpha ) + + local cc, ell, instr; + + # if omega = 1 then we overwrite the position for tv with Ti(1) + if IsOne( alpha ) then + Add(slp, [ [ T3pos[1], 1 ], tvpos ] ); + return; + fi; + + cc := CoefficientsPrimitiveElement( fld, alpha ); + instr := []; + + for ell in [ 1..Length(cc) ] do + + if not IsZero( cc[ell] ) then + Append( instr, [ T3pos[ell], Int(cc[ell]) ] ); + fi; + od; + + if Length( instr ) = 0 then + Error("TransvecAtAlpha3: this should not happen"); + fi; + + Add( slp, [ instr,tvpos ] ); + + return; + + end; + + ##### + # ShiftTransvection3ByI() + ##### + + ShiftTransvection3ByI := function(i) + + local ui; + + i := d-i+1; + ui := 1; + + while ui < i do + Add(slp, [[uipos[ui],1,tvpos,1,uipos[ui],1],tvpos]); + ui := ui+1; + od; + + end; + + ##### + # ShiftTransvection3ByJ() + ##### + + ShiftTransvection3ByJ := function(i) + + local instr; + + i := i-1; + + Add(slp,[[4,1,5,1],tmppos2]); + instr := AEM( tmppos2, AEMrespos, tmppos, i-1 ); + Append( slp, instr ); + Add( slp, [ [ AEMrespos, -1, tvpos , 1, AEMrespos, 1 ], tvpos ] ); + + end; + + ##### + # TransvectionAtAlpha4() + ##### + + TransvecAtAlpha4 := function( alpha ) + + local cc, ell, instr, w, delta, specialalpha, VS, basis; + + delta := stdgens[3]; + w := delta[1][1]; + basis := []; + for ell in [1..f] do + Add(basis,w^(2*ell)); + od; + + VS := VectorSpace(GF(Characteristic(fld)),basis); + + cc := CoefficientsPrimitiveElementS( fld, alpha, Basis(VS,basis)); + instr := []; + + for ell in [ 1..Length(cc) ] do + + if not IsZero( cc[ell] ) then + Append( instr, [ T4pos[ell], Int(cc[ell]) ] ); + fi; + od; + + if Length( instr ) = 0 then + Error("TransvecAtAlpha4: this should not happen"); + fi; + + Add( slp, [ instr,tvpos ] ); + + return; + + end; + + ##### + # ShiftTransvection4() + ##### + + ShiftTransvection4 := function(i) + local instr; + + i := d-i+1; + + if (i= 2 and IsList( arg[1] ) and IsMatrix( arg[2] ) then + + stdgens := arg[1]; # the LGO standard generators + g := arg[2]; + + if Length( stdgens ) < 1 or not IsMatrix( stdgens[1] ) then + + Error("first argument must be the LGO standard generators"); + return; + fi; + + if not IsMatrix( g ) then + Error("second argument must be a matrix"); return; + fi; + else + Error("input: LGO standard generators and a matrix"); + return; + fi; + + if Length(arg) = 3 then + + # The first 10 entries are the stdgens and their inverses + slp := arg[3]; + + if not IsList(slp) then + Error("third argument must be a list"); + return; + fi; + else + # We write an SLP into the variable slp + # The first 12 entries are the stdgens and the inverses + # s, t, del, v, x, s^-1, t^-1, del^-1, v^-1, x^-1 + slp := [ [1,1], [2,1], [3,1], [4,1], [5,1], [6,1], + [1,-1],[2,-1],[3,-1],[4,-1],[5,-1], [6,-1] ]; + fi; + + d := Length( g ); + fld := FieldOfMatrixList( stdgens ); + + # To create an MSLP, we allocate all the memory needed at the beginning. + Add( slp, [1,0] ); tmppos := Length(slp); #15 + Add( slp, [1,0] ); AEMrespos := Length(slp); #16 + Add( slp, [1,0] ); u1pos := Length(slp); #17 + Add( slp, [1,0] ); u2pos := Length(slp); #18 + Add( slp, [1,0] ); tvpos := Length(slp); #19 + Add( slp, [1,0] ); tmppos2 := Length(slp); #20 + + + u1 := MutableCopyMat( One(g) ); + u2 := MutableCopyMat( One(g) ); + + # If g is already a monomial matrix return u_1 = u_2 = I_d + if TestIfMonomial( g ) then + Add( slp, [ [1,0],[1,0] ] ); + return [ slp, [u1,g,u2] ]; + fi; + + f := LogInt(Size(fld), Characteristic(fld)); #ie q=p^f + + hs := HighestSlotOfSLP(slp); + + # We create the help variables for the block top left or bottom right + T2pos := [ hs + 1 .. hs + f ]; + + hs := hs + f; + + for ell in [ 1..f ] do + Add(slp, [1,0] ); + od; + + for ell in [0..f-1] do + + Add(slp, [ [3, -ell, 4, -2, 3, ell, 4 ,2 ], tmppos ] ); + Add(slp, [ [5,1,1,1,tmppos, 1, 6, 1, tmppos, -1,1,-1,5,-1 ], T2pos[ell+1] ] ); + + od; + + # We create the help variables for the block in the bottom left + T3pos := [ hs + 1 .. hs + f ]; + + hs := hs + f; + + for ell in [ 1..f ] do + Add(slp, [1,0] ); + od; + + for ell in [0..f-1] do + + Add(slp, [ [3, -ell, 4, -2, 3, ell, 4 ,2 ], tmppos ] ); + Add(slp, [ [tmppos, 1, 6, 1, tmppos, -1], T3pos[ell+1] ] ); + + od; + + # We create the help variables for the diagonal + T4pos := [ hs + 1 .. hs + f ]; + + hs := hs + f ; + + for ell in [ 1..f ] do + Add(slp, [1,0] ); + od; + + for ell in [1..f] do + + Add(slp, [ [1,-1,3,ell,2,-1,3,-ell,1,1], T4pos[ell] ] ); + + od; + + # We create the help variables for the shift + + uipos := [ hs + 1 .. (hs + (d/2)-2) ]; + + hs := hs + ((d/2)-2) ; + + for ell in [ 1 .. ((d/2)-2) ] do + Add(slp, [1,0] ); + od; + + Add( slp, [[5,1],uipos[1]]); + + for ell in [2..((d/2)-2) ] do + Add( slp, [ [ 4, -1, uipos[ell-1] , 1, 4, 1 ], uipos[ell] ] ); + od; + + ############ + # Tests + ############ + + #test :=PseudoRandom(fld); + + #Display(test); + + #TransvecAtAlpha2(test); + #ShiftTransvection2ByI(5); + #ShiftTransvection2ByJ(2, 5); + + #TransvecAtAlpha4(test); + #ShiftTransvection4(7); + + #TransvecAtAlpha3(test); + #ShiftTransvection3ByJ(4); + #ShiftTransvection3ByI(10); + + #Add(slp, [[tvpos,1],tvpos]); + + #return MakeSLP(slp,7); + + ############ + # Main + ############ + + g := MutableCopyMat( g ); + + for c in [ d, d-1..2 ] do + + # Find the first non-zero entry in column c + # g_{r,c} will be the pivot. + j := 1; r := 0; + + while r <= d and j <= d and r = 0 do + + if not IsZero(g[j][c]) then + r := j; + fi; + + j := j + 1; + + od; + + if r = 0 then + Error("matrix has 0 column"); + fi; + + a := g[r][c]^-1; + + if r <= d-1 then + + if not IsZero( g[r+1][c] ) then + + z := - g[r+1][c] * a; + + # add z times row r of g to row r+1 + # add z times row r of u1 to row r+1 + # g[r+1] := g[r+1] + z * g[r]; + # u1[r+1] := u1[r+1] + z * u1[r]; + # Mul := List( One(SU(d,Size(fld))), ShallowCopy ); + + if (r+r+1 <> d+1) then + + if r in [1..d/2] and r+1 in [1..d/2] then + TransvecAtAlpha2(z); + ShiftTransvection2ByI(r+1); + ShiftTransvection2ByJ(r, r+1); + else + TransvecAtAlpha2(-z); + ShiftTransvection2ByI(d-r+1); + ShiftTransvection2ByJ(d-r,d-r+1); + fi; + + #Mul[r+1][r] := z; + g[r+1] := g[r+1] + z * g[r]; + u1[r+1] := u1[r+1] + z * u1[r]; + + #Mul[d-r+1][d-r] := -z; + g[d-r+1] := g[d-r+1] + (-z) * g[d-r]; + u1[d-r+1] := u1[d-r+1] + (-z) * u1[d-r]; + else + + TransvecAtAlpha4(z); + ShiftTransvection4(r+1); + + # Mul[r+1][r] := z; + g[r+1] := g[r+1] + z * g[r]; + u1[r+1] := u1[r+1] + z * u1[r]; + fi; + + Add(slp,[[tvpos,1,u1pos,1],u1pos]); + + #g := Mul * g; + #u1 := Mul * u1; + + fi; + + + # Second: Clear the rest of column c + for i in [ r+2..d ] do + + if not IsZero(g[i][c]) then + + z := -g[i][c] * a; + + # add z times row r of g to row i + # add z times row r of u1 to row i + #g[i] := g[i] + z*g[r]; + #u1[i] := u1[i] + z*u1[r]; + #Mul := List( One(SU(d,Size(fld))), ShallowCopy ); + + if (i+r <> d+1) then + if(r <= d/2) then + if (i <= d/2) then + + if i in [1..d/2] and r in [1..d/2] then + TransvecAtAlpha2(z); + ShiftTransvection2ByI(i); + ShiftTransvection2ByJ(r, i); + elif i in [((d/2)+1)..d] and r in [((d/2)+1)..d] then + TransvecAtAlpha2(-z); + ShiftTransvection2ByJ(d-r+1); + ShiftTransvection2ByI(d-i+1,d-r+1); + elif i+r < d+1 then + TransvecAtAlpha3(z); + ShiftTransvection3ByJ(d-i+1); + ShiftTransvection3ByI(d-r+1); + else + TransvecAtAlpha3(z); + ShiftTransvection3ByJ(r); + ShiftTransvection3ByI(i); + fi; + + #Mul[i][r] := z; + g[i] := g[i] + z*g[r]; + u1[i] := u1[i] + z*u1[r]; + + #Mul[d-r+1][d-i+1] := -z; + g[d-r+1] := g[d-r+1] + (-z)*g[d-i+1]; + u1[d-r+1] := u1[d-r+1] + (-z)*u1[d-i+1]; + else + + if i in [1..d/2] and r in [1..d/2] then + TransvecAtAlpha2(z); + ShiftTransvection2ByI(i); + ShiftTransvection2ByJ(r, i); + elif i in [((d/2)+1)..d] and r in [((d/2)+1)..d] then + TransvecAtAlpha2(-z); + ShiftTransvection2ByJ(d-r+1); + ShiftTransvection2ByI(d-i+1,d-r+1); + elif i+r < d+1 then + TransvecAtAlpha3(z); + ShiftTransvection3ByJ(d-i+1); + ShiftTransvection3ByI(d-r+1); + else + TransvecAtAlpha3(z); + ShiftTransvection3ByJ(r); + ShiftTransvection3ByI(i); + fi; + + #Mul[i][r] := z; + g[i] := g[i] + z*g[r]; + u1[i] := u1[i] + z*u1[r]; + + #Mul[d-r+1][d-i+1] := z; + g[d-r+1] := g[d-r+1] + z*g[d-i+1]; + u1[d-r+1] := u1[d-r+1] + z*u1[d-i+1]; + fi; + else + + if i in [1..d/2] and r in [1..d/2] then + TransvecAtAlpha2(z); + ShiftTransvection2ByI(i); + ShiftTransvection2ByJ(r, i); + elif i in [((d/2)+1)..d] and r in [((d/2)+1)..d] then + TransvecAtAlpha2(-z); + ShiftTransvection2ByI(d-r+1); + ShiftTransvection2ByJ(d-i+1,d-r+1); + elif i+r < d+1 then + TransvecAtAlpha3(z); + ShiftTransvection3ByJ(d-i+1); + ShiftTransvection3ByI(d-r+1); + else + TransvecAtAlpha3(z); + ShiftTransvection3ByJ(r); + ShiftTransvection3ByI(i); + fi; + + #Mul[i][r] := z; + g[i] := g[i] + z*g[r]; + u1[i] := u1[i] + z*u1[r]; + + #Mul[d-r+1][d-i+1] := -z; + g[d-r+1] := g[d-r+1] + (-z)*g[d-i+1]; + u1[d-r+1] := u1[d-r+1] + (-z)*u1[d-i+1]; + + fi; + else + + TransvecAtAlpha4(z); + + if i > r then + ShiftTransvection4(i); + else + ShiftTransvection4(r); + fi; + + #Mul[i][r] := z; + g[i] := g[i] + z*g[r]; + u1[i] := u1[i] + z*u1[r]; + fi; + + Add(slp,[[tvpos,1,u1pos,1],u1pos]); + + #g := Mul * g; + #u1 := Mul * u1; + + fi; + + + od; + + fi; + + + # Step Two: Clear all entries in row r apart from g[r][c] + # This coincides with multiplying t_{c,j} from right. + if c >= 2 then + + if not IsZero( g[r][c-1] ) then + + z := -g[r][c-1] * a; + + # add z times column c of g to column c-1 + # add z times column c of u2 to column c-1 + #g{[ 1..d ]}[ c-1 ] := g{[ 1..d ]}[ c-1 ] + z * g{[1..d]}[c]; + #u2{[1..d]}[c-1] := u2{[1..d]}[c-1] + z * u2{[1..d]}[c]; + + #Mul := List( One(G), ShallowCopy ); + + if (c+c-1 <> d+1) then + if (c-1 > d/2) then + #Mul[c][c-1] := z; + if c in [1..d/2] and c-1 in [1..d/2] then + TransvecAtAlpha2(z); + ShiftTransvection2ByI(c); + ShiftTransvection2ByJ(c-1, c); + else + TransvecAtAlpha2(-z); + ShiftTransvection2ByI(d-c+2); + ShiftTransvection2ByJ(d-c+1,d-c+2); + fi; + + g{[ 1..d ]}[ c-1 ] := g{[ 1..d ]}[ c-1 ] + z * g{[1..d]}[c]; + u2{[1..d]}[c-1] := u2{[1..d]}[c-1] + z * u2{[1..d]}[c]; + + #Mul[d-c+2][d-c+1] := -z; + g{[ 1..d ]}[ d-c+1 ] := g{[ 1..d ]}[ d-c+1 ] + (-z) * g{[1..d]}[d-c+2]; + u2{[1..d]}[d-c+1] := u2{[1..d]}[d-c+1] + (-z) * u2{[1..d]}[d-c+2]; + else + #Mul[c][c-1] := z; + g{[ 1..d ]}[ c-1 ] := g{[ 1..d ]}[ c-1 ] + z * g{[1..d]}[c]; + u2{[1..d]}[c-1] := u2{[1..d]}[c-1] + z * u2{[1..d]}[c]; + + #Mul[d-c+2][d-c+1] := z; + g{[ 1..d ]}[ d-c+1 ] := g{[ 1..d ]}[ d-c+1 ] + z * g{[1..d]}[d-c+2]; + u2{[1..d]}[d-c+1] := u2{[1..d]}[d-c+1] + z * u2{[1..d]}[d-c+2]; + fi; + else + TransvecAtAlpha4(z); + ShiftTransvection4(c); + + #Mul[c][c-1] := z; + g{[ 1..d ]}[ c-1 ] := g{[ 1..d ]}[ c-1 ] + z * g{[1..d]}[c]; + u2{[1..d]}[c-1] := u2{[1..d]}[c-1] + z * u2{[1..d]}[c]; + fi; + + Add(slp,[[u2pos,1,tvpos,1],u2pos]); + + #g := g * Mul; + #u2 := u2 * Mul; + + fi; + + + # Now clear the rest of row r + for j in [ c-2, c-3..1 ] do + + if not IsZero( g[r][j] ) then + + z := - g[r][j] * a; + + # add z times column c of g to column j + # add z times column c of u2 to column j + # g{[1..d]}[j] := g{[1..d]}[j] + z * g{[1..d]}[c]; + #u2{[1..d]}[j] := u2{[1..d]}[j] + z * u2{[1..d]}[c]; + + #Mul := List( One(G), ShallowCopy ); + + if (c+j <> d+1) then + if (j > d/2) then + + if c in [1..d/2] and j in [1..d/2] then + TransvecAtAlpha2(z); + ShiftTransvection2ByI(c); + ShiftTransvection2ByJ(j, c); + elif c in [((d/2)+1)..d] and j in [((d/2)+1)..d] then + TransvecAtAlpha2(-z); + ShiftTransvection2ByI(d-j+1); + ShiftTransvection2ByJ(d-c+1,d-j+1); + elif c+j < d+1 then + TransvecAtAlpha3(z); + ShiftTransvection3ByJ(d-c+1); + ShiftTransvection3ByI(d-j+1); + else + TransvecAtAlpha3(z); + ShiftTransvection3ByJ(j); + ShiftTransvection3ByI(c); + fi; + + #Mul[c][j] := z; + g{[1..d]}[j] := g{[1..d]}[j] + z * g{[1..d]}[c]; + u2{[1..d]}[j] := u2{[1..d]}[j] + z * u2{[1..d]}[c]; + + #Mul[d-j+1][d-c+1] := -z; + g{[1..d]}[d-c+1] := g{[1..d]}[d-c+1] + (-z) * g{[1..d]}[d-j+1]; + u2{[1..d]}[d-c+1] := u2{[1..d]}[d-c+1] + (-z) * u2{[1..d]}[d-j+1]; + else + + if c in [1..d/2] and j in [1..d/2] then + TransvecAtAlpha2(z); + ShiftTransvection2ByI(c); + ShiftTransvection2ByJ(j, c); + elif c in [((d/2)+1)..d] and j in [((d/2)+1)..d] then + TransvecAtAlpha2(-z); + ShiftTransvection2ByI(d-j+1); + ShiftTransvection2ByJ(d-c+1,d-j+1); + elif c+j < d+1 then + TransvecAtAlpha3(z); + ShiftTransvection3ByJ(d-c+1); + ShiftTransvection3ByI(d-j+1); + else + TransvecAtAlpha3(z); + ShiftTransvection3ByJ(j); + ShiftTransvection3ByI(c); + fi; + + #Mul[c][j] := z; + g{[1..d]}[j] := g{[1..d]}[j] + z * g{[1..d]}[c]; + u2{[1..d]}[j] := u2{[1..d]}[j] + z * u2{[1..d]}[c]; + + #Mul[d-j+1][d-c+1] := z; + g{[1..d]}[d-c+1] := g{[1..d]}[d-c+1] + z * g{[1..d]}[d-j+1]; + u2{[1..d]}[d-c+1] := u2{[1..d]}[d-c+1] + z * u2{[1..d]}[d-j+1]; + fi; + else + + TransvecAtAlpha4(z); + + if c > j then + ShiftTransvection4(c); + else + ShiftTransvection4(j); + fi; + + #Mul[c][j] := z; + g{[1..d]}[j] := g{[1..d]}[j] + z * g{[1..d]}[c]; + u2{[1..d]}[j] := u2{[1..d]}[j] + z * u2{[1..d]}[c]; + fi; + + Add(slp,[[u2pos,1,tvpos,1],u2pos]); + + #g := g * Mul; + #u2 := u2 * Mul; + + fi; + + od; + + fi; + od; + + #Add(slp,[[u2pos,1],u2pos]); + #test := MakeSLP(slp,6); + #Display(ResultOfStraightLineProgram(slp,stdgens)); + # if not (ResultOfStraightLineProgram(test,stdgens)= u2) then + # Error("U2"); + # fi; + #Add(slp,[[u1pos,1],u1pos]); + #test := MakeSLP(slp,6); + #if not (ResultOfStraightLineProgram(test,stdgens)= u1) then + # Error("U1"); + #fi; + #return slp; + #Display(g); + #Display(g); + + Add( slp, [ [u1pos,1], [u2pos,1] ]); + + # Now u1^-1 * g * u2^-1 is the input matrix + return [slp,[g, u1, u2], hs]; + +end +); + + + +InstallGlobalFunction( UnitriangularDecompositionSpEvenChar, +function( arg ) + + local u1, u2, d, fld, f, alpha, c, r, j, a, z, i, Mul, g, ell, slp, hs, tmppos, AEMrespos, u1pos, u2pos, tvpos, T2pos, T3pos, T4pos, tmppos2, uipos, q, f2, TransvecAtAlpha2, TransvecAtAlpha3, TransvecAtAlpha4, test, ShiftTransvection3ByJ, ShiftTransvection3ByI, ShiftTransvection4, ShiftTransvection2ByJ, ShiftTransvection2ByI, stdgens; + + # ############### + # Local Functions + # ############### + + # The following five functions are local as they have side effects. + # In particular, they modify the global variables T_i and Ti_1 + + # Let alpha in GF(p^f), alpha = Sum a_l omega^l, omega a primitive element + # Let slp be the list of instructions in UnipotentDecomposition and Tipos + # denote the slots where transvections t_{i,j}(omega^ell) 0 <= ell < f + # are saved. This function computes + # t_{i,j}(alpha) = product t_{i,j}(omega^ell)^{a_ell} (see Theorem 5.22) + # where the exponents a_ell are given by CoefficientsPrimitiveElement. + + ##### + # TransvectionAtAlpha2() + ##### + + TransvecAtAlpha2 := function( alpha ) + + local cc, ell, instr; + + # if omega = 1 then we overwrite the position for tv with Ti(1) + if IsOne( alpha ) then + Add(slp, [ [ T2pos[1], 1 ], tvpos ] ); + return; + fi; + + cc := CoefficientsPrimitiveElement( fld, alpha ); + instr := []; + + for ell in [ 1..Length(cc) ] do + + if not IsZero( cc[ell] ) then + Append( instr, [ T2pos[ell], Int(cc[ell]) ] ); + fi; + od; + + if Length( instr ) = 0 then + Error("TransvecAtAlpha2: this should not happen"); + fi; + + Add( slp, [ instr,tvpos ] ); + + return; + + end; + + ##### + # ShiftTransvection2ByI() + ##### + + ShiftTransvection2ByI := function(i) + + local instr; + + instr := AEM( 4, AEMrespos, tmppos, i-2 ); + Append( slp, instr ); + Add( slp, [ [ AEMrespos, -1, tvpos , 1, AEMrespos, 1 ], tvpos ] ); + + end; + + ##### + # ShiftTransvection2ByJ() + ##### + + ShiftTransvection2ByJ := function(i, abnr) + + local ui; + + ui := (d/2)-2; + + while ui-i+1-(d/2-abnr) > 0 do + Add(slp, [[uipos[ui-(d/2-abnr)],1,tvpos,1,uipos[ui-(d/2-abnr)],1],tvpos]); + ui := ui-1; + od; + + end; + + ##### + # TransvectionAtAlpha3() + ##### + + TransvecAtAlpha3 := function( alpha ) + + local cc, ell, instr; + + # if omega = 1 then we overwrite the position for tv with Ti(1) + if IsOne( alpha ) then + Add(slp, [ [ T3pos[1], 1 ], tvpos ] ); + return; + fi; + + cc := CoefficientsPrimitiveElement( fld, alpha ); + instr := []; + + for ell in [ 1..Length(cc) ] do + + if not IsZero( cc[ell] ) then + Append( instr, [ T3pos[ell], Int(cc[ell]) ] ); + fi; + od; + + if Length( instr ) = 0 then + Error("TransvecAtAlpha3: this should not happen"); + fi; + + Add( slp, [ instr,tvpos ] ); + + return; + + end; + + ##### + # ShiftTransvection3ByI() + ##### + + ShiftTransvection3ByI := function(i) + + local ui; + + i := d-i+1; + ui := 1; + + while ui < i do + Add(slp, [[uipos[ui],1,tvpos,1,uipos[ui],1],tvpos]); + ui := ui+1; + od; + + end; + + ##### + # ShiftTransvection3ByJ() + ##### + + ShiftTransvection3ByJ := function(i) + + local instr; + + i := i-1; + + Add(slp,[[4,1,5,1],tmppos2]); + instr := AEM( tmppos2, AEMrespos, tmppos, i-1 ); + Append( slp, instr ); + Add( slp, [ [ AEMrespos, -1, tvpos , 1, AEMrespos, 1 ], tvpos ] ); + + end; + + ##### + # TransvectionAtAlpha4() + ##### + + TransvecAtAlpha4 := function( alpha ) + + local cc, ell, instr, w, delta, specialalpha, VS, basis; + + delta := stdgens[3]; + w := delta[1][1]; + basis := []; + for ell in [1..f] do + Add(basis,w^(2*ell)); + od; + + VS := VectorSpace(GF(Characteristic(fld)),basis); + + cc := CoefficientsPrimitiveElementS( fld, alpha, Basis(VS,basis)); + instr := []; + + for ell in [ 1..Length(cc) ] do + + if not IsZero( cc[ell] ) then + Append( instr, [ T4pos[ell], Int(cc[ell]) ] ); + fi; + od; + + if Length( instr ) = 0 then + Error("TransvecAtAlpha4: this should not happen"); + fi; + + Add( slp, [ instr,tvpos ] ); + + return; + + end; + + ##### + # ShiftTransvection4() + ##### + + ShiftTransvection4 := function(i) + local instr; + + i := d-i+1; + + if (i= 2 and IsList( arg[1] ) and IsMatrix( arg[2] ) then + + stdgens := arg[1]; # the LGO standard generators + g := arg[2]; + + if Length( stdgens ) < 1 or not IsMatrix( stdgens[1] ) then + + Error("first argument must be the LGO standard generators"); + return; + fi; + + if not IsMatrix( g ) then + Error("second argument must be a matrix"); return; + fi; + else + Error("input: LGO standard generators and a matrix"); + return; + fi; + + if Length(arg) = 3 then + + # The first 10 entries are the stdgens and their inverses + slp := arg[3]; + + if not IsList(slp) then + Error("third argument must be a list"); + return; + fi; + else + # We write an SLP into the variable slp + # The first 12 entries are the stdgens and the inverses + # s, t, del, v, x, s^-1, t^-1, del^-1, v^-1, x^-1 + slp := [ [1,1], [2,1], [3,1], [4,1], [5,1], [6,1], + [1,-1],[2,-1],[3,-1],[4,-1],[5,-1], [6,-1] ]; + fi; + + d := Length( g ); + fld := FieldOfMatrixList( stdgens ); + + # To create an MSLP, we allocate all the memory needed at the beginning. + Add( slp, [1,0] ); tmppos := Length(slp); #15 + Add( slp, [1,0] ); AEMrespos := Length(slp); #16 + Add( slp, [1,0] ); u1pos := Length(slp); #17 + Add( slp, [1,0] ); u2pos := Length(slp); #18 + Add( slp, [1,0] ); tvpos := Length(slp); #19 + Add( slp, [1,0] ); tmppos2 := Length(slp); #20 + + + u1 := MutableCopyMat( One(g) ); + u2 := MutableCopyMat( One(g) ); + + # If g is already a monomial matrix return u_1 = u_2 = I_d + if TestIfMonomial( g ) then + Add( slp, [ [1,0],[1,0] ] ); + return [ slp, [u1,g,u2] ]; + fi; + + f := LogInt(Size(fld), Characteristic(fld)); #ie q=p^f + + hs := HighestSlotOfSLP(slp); + + # We create the help variables for the block top left or bottom right + T2pos := [ hs + 1 .. hs + f ]; + + hs := hs + f; + + for ell in [ 1..f ] do + Add(slp, [1,0] ); + od; + + for ell in [0..f-1] do + + Add(slp, [ [3, -ell, 4, -2, 3, ell, 4 ,2 ], tmppos ] ); + Add(slp, [ [5,1,1,1,tmppos, 1, 6, 1, tmppos, -1,1,-1,5,-1 ], T2pos[ell+1] ] ); + + od; + + # We create the help variables for the block in the bottom left + T3pos := [ hs + 1 .. hs + f ]; + + hs := hs + f; + + for ell in [ 1..f ] do + Add(slp, [1,0] ); + od; + + for ell in [0..f-1] do + + Add(slp, [ [3, -ell, 4, -2, 3, ell, 4 ,2 ], tmppos ] ); + Add(slp, [ [tmppos, 1, 6, 1, tmppos, -1], T3pos[ell+1] ] ); + + od; + + # We create the help variables for the diagonal + T4pos := [ hs + 1 .. hs + f ]; + + hs := hs + f ; + + for ell in [ 1..f ] do + Add(slp, [1,0] ); + od; + + for ell in [1..f] do + + Add(slp, [ [1,-1,3,ell,2,-1,3,-ell,1,1], T4pos[ell] ] ); + + od; + + # We create the help variables for the shift + + uipos := [ hs + 1 .. (hs + (d/2)-2) ]; + + hs := hs + ((d/2)-2) ; + + for ell in [ 1 .. ((d/2)-2) ] do + Add(slp, [1,0] ); + od; + + Add( slp, [[5,1],uipos[1]]); + + for ell in [2..((d/2)-2) ] do + Add( slp, [ [ 4, -1, uipos[ell-1] , 1, 4, 1 ], uipos[ell] ] ); + od; + + ############ + # Tests + ############ + + #test :=PseudoRandom(fld); + + #Display(test); + + #TransvecAtAlpha2(test); + #ShiftTransvection2ByI(5); + #ShiftTransvection2ByJ(2, 5); + + #TransvecAtAlpha4(test); + #ShiftTransvection4(7); + + #TransvecAtAlpha3(test); + #ShiftTransvection3ByJ(4); + #ShiftTransvection3ByI(10); + + #Add(slp, [[tvpos,1],tvpos]); + + #return MakeSLP(slp,7); + + ############ + # Main + ############ + + g := MutableCopyMat( g ); + + for c in [ d, d-1..2 ] do + + # Find the first non-zero entry in column c + # g_{r,c} will be the pivot. + j := 1; r := 0; + + while r <= d and j <= d and r = 0 do + + if not IsZero(g[j][c]) then + r := j; + fi; + + j := j + 1; + + od; + + if r = 0 then + Error("matrix has 0 column"); + fi; + + a := g[r][c]^-1; + + if r <= d-1 then + + if not IsZero( g[r+1][c] ) then + + z := - g[r+1][c] * a; + + # add z times row r of g to row r+1 + # add z times row r of u1 to row r+1 + # g[r+1] := g[r+1] + z * g[r]; + # u1[r+1] := u1[r+1] + z * u1[r]; + # Mul := List( One(SU(d,Size(fld))), ShallowCopy ); + + if (r+r+1 <> d+1) then + + if r in [1..d/2] and r+1 in [1..d/2] then + TransvecAtAlpha2(z); + ShiftTransvection2ByI(r+1); + ShiftTransvection2ByJ(r, r+1); + else + TransvecAtAlpha2(-z); + ShiftTransvection2ByI(d-r+1); + ShiftTransvection2ByJ(d-r,d-r+1); + fi; + + #Mul[r+1][r] := z; + g[r+1] := g[r+1] + z * g[r]; + u1[r+1] := u1[r+1] + z * u1[r]; + + #Mul[d-r+1][d-r] := -z; + g[d-r+1] := g[d-r+1] + (-z) * g[d-r]; + u1[d-r+1] := u1[d-r+1] + (-z) * u1[d-r]; + else + + TransvecAtAlpha4(z); + ShiftTransvection4(r+1); + + # Mul[r+1][r] := z; + g[r+1] := g[r+1] + z * g[r]; + u1[r+1] := u1[r+1] + z * u1[r]; + fi; + + Add(slp,[[tvpos,1,u1pos,1],u1pos]); + + #g := Mul * g; + #u1 := Mul * u1; + + fi; + + + # Second: Clear the rest of column c + for i in [ r+2..d ] do + + if not IsZero(g[i][c]) then + + z := -g[i][c] * a; + + # add z times row r of g to row i + # add z times row r of u1 to row i + #g[i] := g[i] + z*g[r]; + #u1[i] := u1[i] + z*u1[r]; + #Mul := List( One(SU(d,Size(fld))), ShallowCopy ); + + if (i+r <> d+1) then + if(r <= d/2) then + if (i <= d/2) then + + if i in [1..d/2] and r in [1..d/2] then + TransvecAtAlpha2(z); + ShiftTransvection2ByI(i); + ShiftTransvection2ByJ(r, i); + elif i in [((d/2)+1)..d] and r in [((d/2)+1)..d] then + TransvecAtAlpha2(-z); + ShiftTransvection2ByJ(d-r+1); + ShiftTransvection2ByI(d-i+1,d-r+1); + elif i+r < d+1 then + TransvecAtAlpha3(z); + ShiftTransvection3ByJ(d-i+1); + ShiftTransvection3ByI(d-r+1); + else + TransvecAtAlpha3(z); + ShiftTransvection3ByJ(r); + ShiftTransvection3ByI(i); + fi; + + #Mul[i][r] := z; + g[i] := g[i] + z*g[r]; + u1[i] := u1[i] + z*u1[r]; + + #Mul[d-r+1][d-i+1] := -z; + g[d-r+1] := g[d-r+1] + (-z)*g[d-i+1]; + u1[d-r+1] := u1[d-r+1] + (-z)*u1[d-i+1]; + else + + if i in [1..d/2] and r in [1..d/2] then + TransvecAtAlpha2(z); + ShiftTransvection2ByI(i); + ShiftTransvection2ByJ(r, i); + elif i in [((d/2)+1)..d] and r in [((d/2)+1)..d] then + TransvecAtAlpha2(-z); + ShiftTransvection2ByJ(d-r+1); + ShiftTransvection2ByI(d-i+1,d-r+1); + elif i+r < d+1 then + TransvecAtAlpha3(z); + ShiftTransvection3ByJ(d-i+1); + ShiftTransvection3ByI(d-r+1); + else + TransvecAtAlpha3(z); + ShiftTransvection3ByJ(r); + ShiftTransvection3ByI(i); + fi; + + #Mul[i][r] := z; + g[i] := g[i] + z*g[r]; + u1[i] := u1[i] + z*u1[r]; + + #Mul[d-r+1][d-i+1] := z; + g[d-r+1] := g[d-r+1] + z*g[d-i+1]; + u1[d-r+1] := u1[d-r+1] + z*u1[d-i+1]; + fi; + else + + if i in [1..d/2] and r in [1..d/2] then + TransvecAtAlpha2(z); + ShiftTransvection2ByI(i); + ShiftTransvection2ByJ(r, i); + elif i in [((d/2)+1)..d] and r in [((d/2)+1)..d] then + TransvecAtAlpha2(-z); + ShiftTransvection2ByI(d-r+1); + ShiftTransvection2ByJ(d-i+1,d-r+1); + elif i+r < d+1 then + TransvecAtAlpha3(z); + ShiftTransvection3ByJ(d-i+1); + ShiftTransvection3ByI(d-r+1); + else + TransvecAtAlpha3(z); + ShiftTransvection3ByJ(r); + ShiftTransvection3ByI(i); + fi; + + #Mul[i][r] := z; + g[i] := g[i] + z*g[r]; + u1[i] := u1[i] + z*u1[r]; + + #Mul[d-r+1][d-i+1] := -z; + g[d-r+1] := g[d-r+1] + (-z)*g[d-i+1]; + u1[d-r+1] := u1[d-r+1] + (-z)*u1[d-i+1]; + + fi; + else + + TransvecAtAlpha4(z); + + if i > r then + ShiftTransvection4(i); + else + ShiftTransvection4(r); + fi; + + #Mul[i][r] := z; + g[i] := g[i] + z*g[r]; + u1[i] := u1[i] + z*u1[r]; + fi; + + Add(slp,[[tvpos,1,u1pos,1],u1pos]); + + #g := Mul * g; + #u1 := Mul * u1; + + fi; + + + od; + + fi; + + + # Step Two: Clear all entries in row r apart from g[r][c] + # This coincides with multiplying t_{c,j} from right. + if c >= 2 then + + if not IsZero( g[r][c-1] ) then + + z := -g[r][c-1] * a; + + # add z times column c of g to column c-1 + # add z times column c of u2 to column c-1 + #g{[ 1..d ]}[ c-1 ] := g{[ 1..d ]}[ c-1 ] + z * g{[1..d]}[c]; + #u2{[1..d]}[c-1] := u2{[1..d]}[c-1] + z * u2{[1..d]}[c]; + + #Mul := List( One(G), ShallowCopy ); + + if (c+c-1 <> d+1) then + if (c-1 > d/2) then + #Mul[c][c-1] := z; + if c in [1..d/2] and c-1 in [1..d/2] then + TransvecAtAlpha2(z); + ShiftTransvection2ByI(c); + ShiftTransvection2ByJ(c-1, c); + else + TransvecAtAlpha2(-z); + ShiftTransvection2ByI(d-c+2); + ShiftTransvection2ByJ(d-c+1,d-c+2); + fi; + + g{[ 1..d ]}[ c-1 ] := g{[ 1..d ]}[ c-1 ] + z * g{[1..d]}[c]; + u2{[1..d]}[c-1] := u2{[1..d]}[c-1] + z * u2{[1..d]}[c]; + + #Mul[d-c+2][d-c+1] := -z; + g{[ 1..d ]}[ d-c+1 ] := g{[ 1..d ]}[ d-c+1 ] + (-z) * g{[1..d]}[d-c+2]; + u2{[1..d]}[d-c+1] := u2{[1..d]}[d-c+1] + (-z) * u2{[1..d]}[d-c+2]; + else + #Mul[c][c-1] := z; + g{[ 1..d ]}[ c-1 ] := g{[ 1..d ]}[ c-1 ] + z * g{[1..d]}[c]; + u2{[1..d]}[c-1] := u2{[1..d]}[c-1] + z * u2{[1..d]}[c]; + + #Mul[d-c+2][d-c+1] := z; + g{[ 1..d ]}[ d-c+1 ] := g{[ 1..d ]}[ d-c+1 ] + z * g{[1..d]}[d-c+2]; + u2{[1..d]}[d-c+1] := u2{[1..d]}[d-c+1] + z * u2{[1..d]}[d-c+2]; + fi; + else + TransvecAtAlpha4(z); + ShiftTransvection4(c); + + #Mul[c][c-1] := z; + g{[ 1..d ]}[ c-1 ] := g{[ 1..d ]}[ c-1 ] + z * g{[1..d]}[c]; + u2{[1..d]}[c-1] := u2{[1..d]}[c-1] + z * u2{[1..d]}[c]; + fi; + + Add(slp,[[u2pos,1,tvpos,1],u2pos]); + + #g := g * Mul; + #u2 := u2 * Mul; + + fi; + + + # Now clear the rest of row r + for j in [ c-2, c-3..1 ] do + + if not IsZero( g[r][j] ) then + + z := - g[r][j] * a; + + # add z times column c of g to column j + # add z times column c of u2 to column j + # g{[1..d]}[j] := g{[1..d]}[j] + z * g{[1..d]}[c]; + #u2{[1..d]}[j] := u2{[1..d]}[j] + z * u2{[1..d]}[c]; + + #Mul := List( One(G), ShallowCopy ); + + if (c+j <> d+1) then + if (j > d/2) then + + if c in [1..d/2] and j in [1..d/2] then + TransvecAtAlpha2(z); + ShiftTransvection2ByI(c); + ShiftTransvection2ByJ(j, c); + elif c in [((d/2)+1)..d] and j in [((d/2)+1)..d] then + TransvecAtAlpha2(-z); + ShiftTransvection2ByI(d-j+1); + ShiftTransvection2ByJ(d-c+1,d-j+1); + elif c+j < d+1 then + TransvecAtAlpha3(z); + ShiftTransvection3ByJ(d-c+1); + ShiftTransvection3ByI(d-j+1); + else + TransvecAtAlpha3(z); + ShiftTransvection3ByJ(j); + ShiftTransvection3ByI(c); + fi; + + #Mul[c][j] := z; + g{[1..d]}[j] := g{[1..d]}[j] + z * g{[1..d]}[c]; + u2{[1..d]}[j] := u2{[1..d]}[j] + z * u2{[1..d]}[c]; + + #Mul[d-j+1][d-c+1] := -z; + g{[1..d]}[d-c+1] := g{[1..d]}[d-c+1] + (-z) * g{[1..d]}[d-j+1]; + u2{[1..d]}[d-c+1] := u2{[1..d]}[d-c+1] + (-z) * u2{[1..d]}[d-j+1]; + else + + if c in [1..d/2] and j in [1..d/2] then + TransvecAtAlpha2(z); + ShiftTransvection2ByI(c); + ShiftTransvection2ByJ(j, c); + elif c in [((d/2)+1)..d] and j in [((d/2)+1)..d] then + TransvecAtAlpha2(-z); + ShiftTransvection2ByI(d-j+1); + ShiftTransvection2ByJ(d-c+1,d-j+1); + elif c+j < d+1 then + TransvecAtAlpha3(z); + ShiftTransvection3ByJ(d-c+1); + ShiftTransvection3ByI(d-j+1); + else + TransvecAtAlpha3(z); + ShiftTransvection3ByJ(j); + ShiftTransvection3ByI(c); + fi; + + #Mul[c][j] := z; + g{[1..d]}[j] := g{[1..d]}[j] + z * g{[1..d]}[c]; + u2{[1..d]}[j] := u2{[1..d]}[j] + z * u2{[1..d]}[c]; + + #Mul[d-j+1][d-c+1] := z; + g{[1..d]}[d-c+1] := g{[1..d]}[d-c+1] + z * g{[1..d]}[d-j+1]; + u2{[1..d]}[d-c+1] := u2{[1..d]}[d-c+1] + z * u2{[1..d]}[d-j+1]; + fi; + else + + TransvecAtAlpha4(z); + + if c > j then + ShiftTransvection4(c); + else + ShiftTransvection4(j); + fi; + + #Mul[c][j] := z; + g{[1..d]}[j] := g{[1..d]}[j] + z * g{[1..d]}[c]; + u2{[1..d]}[j] := u2{[1..d]}[j] + z * u2{[1..d]}[c]; + fi; + + Add(slp,[[u2pos,1,tvpos,1],u2pos]); + + #g := g * Mul; + #u2 := u2 * Mul; + + fi; + + od; + + fi; + od; + + #Add(slp,[[u2pos,1],u2pos]); + #test := MakeSLP(slp,6); + #Display(ResultOfStraightLineProgram(slp,stdgens)); + # if not (ResultOfStraightLineProgram(test,stdgens)= u2) then + # Error("U2"); + # fi; + #Add(slp,[[u1pos,1],u1pos]); + #test := MakeSLP(slp,6); + #if not (ResultOfStraightLineProgram(test,stdgens)= u1) then + # Error("U1"); + #fi; + #return slp; + #Display(g); + #Display(g); + + Add( slp, [ [u1pos,1], [u2pos,1] ]); + + # Now u1^-1 * g * u2^-1 is the input matrix + return [slp,[g, u1, u2], hs]; + +end +); + + + +##### +# LGOStandardGensSp +##### + +InstallGlobalFunction( LGOStandardGensSp, +function( d, q ) + + local w,s, t, delta, u, v, x, J, fld; + + if d < 6 then + Error("LGOStandardGens: d has to be at least 6\n"); + return; + fi; + + if (q mod 2 = 0) then + return LGOStandardGensSpEvenChar(d,q); + fi; + + fld := GF(q); + w := PrimitiveElement(fld); + + s := IdentityMat( d, fld ); + s[1][1] := Zero(fld); + s[d][d] := Zero(fld); + s[1][d] := One(fld); + s[d][1] := -One(fld); + + t := IdentityMat( d, fld ); + t[1][d] := One(fld); + + delta := IdentityMat( d, fld ); + delta[1][1] := w; + delta[d][d] := w^(-1); + + v := 0 * IdentityMat( d, fld ); + v[d/2][1] := One(fld); + v{[1..(d/2)-1]}{[2..d/2]} := IdentityMat((d/2)-1, fld); + v[d/2+1][d] := One(fld); + v{[(d/2)+2..d]}{[(d/2)+1..d-1]} := IdentityMat((d/2)-1, fld); + + u := IdentityMat( d, fld ); + J := [[Zero(fld),One(fld)],[One(fld),Zero(fld)]]; + u{[1,2]}{[1,2]} := J; + u{[d-1,d]}{[d-1,d]} := J; + + x := IdentityMat( d, fld ); + x[d-1][1] := One(fld); + x[d][2] := One(fld); + + return [s,t,delta,v,u,x]; + +end +); + + + +##### +# LGOStandardGensSpEvenChar +##### + +InstallGlobalFunction( LGOStandardGensSpEvenChar, +function( d, q ) + + local w,s, t, delta, u, v, x, J, fld; + + fld := GF(q); + w := PrimitiveElement(fld); + + s := IdentityMat( d, fld ); + s[1][1] := Zero(fld); + s[d][d] := Zero(fld); + s[1][d] := One(fld); + s[d][1] := One(fld); + + t := IdentityMat( d, fld ); + t[1][d] := One(fld); + + delta := IdentityMat( d, fld ); + delta[1][1] := w; + delta[d][d] := w^(-1); + + v := 0 * IdentityMat( d, fld ); + v[d/2][1] := One(fld); + v{[1..(d/2)-1]}{[2..d/2]} := IdentityMat((d/2)-1, fld); + v[d/2+1][d] := One(fld); + v{[(d/2)+2..d]}{[(d/2)+1..d-1]} := IdentityMat((d/2)-1, fld); + + u := IdentityMat( d, fld ); + J := [[Zero(fld),One(fld)],[One(fld),Zero(fld)]]; + u{[1,2]}{[1,2]} := J; + u{[d-1,d]}{[d-1,d]} := J; + + x := IdentityMat( d, fld ); + x[d-1][1] := One(fld); + x[d][2] := One(fld); + + return [s,t,delta,v,u,x]; + +end +); + + + +##### +# MonomialSLPSp +##### + +InstallGlobalFunction( MonomialSLPSp, +function( arg ) + + local slp, c, n, m, result, i, k, u1, u2, result2, test, g, stdgens, mat, perm, fld, p_signpos, vpos, vipos, spos, upos, unpos, tpos, left, right, cnt, v, vf, s, pot, p_signwr, instr, p_sign, leftma, rightma, L, R, diag, w, alpha, tmpvalue, rowlist, L2, R2, tmpSave, perm2, perm3; + + # Check for correct Input + if Length(arg) >= 2 and IsList(arg[1]) and IsMatrix(arg[2]) then + + stdgens := arg[1]; # the LGO standard generators + mat := arg[2]; # the monomial matrix + n := Length(stdgens[1]); + m := n/2; + + # Compute the permutation in Sym(n) of mat + perm := PermutationMonomialMatrix( mat ); + diag := perm[1]; + perm := perm[2]; + p_signwr := (stdgens[1]^0); + + if Length(stdgens) < 1 or not IsMatrix( stdgens[1]) then + Error("Input: first argument must be the LGO standard generators"); + return; + fi; + + else + Error("input: LGO standard generators and a matrix"); + return; + fi; + + fld := FieldOfMatrixList( stdgens ); + + if Length(arg) = 3 then + + # The first 10 entries are the stdgens and their inverses + slp := arg[3]; + + if not IsList(slp) then + Error("Input: third argument must be a list"); + return; + fi; + + cnt := HighestSlotOfSLP(slp); + + Info( InfoBruhat, 2, " and additional: ",7," memory slots ", + "in PermSLP()\n"); + else + + # we write an SLP into the variable slp + # The first 12 entries are the stdgens and the inverses + # s, t, del, v, x, s^-1, t^-1, del^-1, v^-1, x^-1 + # The entries 13 (resAEM) and 14 (tmpAEM) are used to save AEM-values + slp := [ [1, 1], [2, 1], [3, 1], [4, 1], [5, 1], [6, 1], + [1,-1], [2,-1], [3,-1], [4,-1], [5,-1], [6,-1], + [1, 0], [1, 0] ]; + + cnt := 14; + + Info( InfoBruhat, 2, "Memory Usage is: ",19," memory slots ", + "in PermSLP()\n"); + fi; + + # Initialize the additional memory quota + Add(slp, [ [1,0], cnt + 1 ] ); p_signpos := cnt + 1; #13 or 20+3f + Add(slp, [ [4,-1], cnt + 2 ] ); vpos := cnt + 2; #14 or 21+3f + Add(slp, [ [4,-1], cnt + 3 ] ); vipos := cnt + 3; #15 or 22+3f + Add(slp, [ [1,1], cnt + 4 ] ); spos := cnt + 4; #16 or 23+3f + Add(slp, [ [5,1], cnt + 5 ] ); upos := cnt + 5; #17 or 24+3f + Add(slp, [ [5,0], cnt + 6 ] ); unpos := cnt + 6; #18 or 25+3f + Add(slp, [ [1,0], cnt + 7 ] ); tpos := cnt + 7; #19 or 26+3f + Add(slp, [ [1,0], cnt + 8 ] ); left := cnt + 8; #20 or 27+3f + Add(slp, [ [1,0], cnt + 9 ] ); right := cnt + 9; #21 or 28+3f + + if IsDiagonalMat( mat ) then + # In order to make it coincide with the other possible output. + # This is ok since it is Id + Add( slp, [ [p_signpos,-1] , p_signpos ] ); + return [ slp, [ stdgens[1]^0, mat ] ]; + fi; + + c := CycleFromPermutation(perm); + u1 := One(SymmetricGroup(n)); + u2 := One(SymmetricGroup(n)); + result := []; + result2 := []; + m := n/2; + L2 := IdentityMat(n,fld); + R2 := IdentityMat(n,fld); + w := PrimitiveElement(fld); + # set alpha in SU + while (CheckContinue(perm,m)) do + c := CycleFromPermutation(perm); + for i in c do + k := LargestMovedPoint(i); + if k <= m then + Add(result, i); + elif SmallestMovedPoint(i) > m then + + elif (n-k+1)^i = n-k+1 then + tmpvalue := L2[k]; + L2[k] := L2[n-k+1]; + L2[n-k+1] := (-1)* tmpvalue; + tmpvalue := R2{[1..n]}[k]; + R2{[1..n]}[k] := R2{[1..n]}[n-k+1]; + R2{[1..n]}[n-k+1] := (-1)*tmpvalue; + perm := perm^(k,n-k+1); + u1 := (k,n-k+1) * u1; + Add( slp, [ [vpos,-k,spos,1,vpos,k] , tpos ] ); + Add( slp, [ [tpos,-1,left,1] , left ] ); + Add( slp, [ [right,1,tpos,1] , right] ); + u2 := u2 * (k,n-k+1); + + break; + else + tmpvalue := L2[k]; + L2[k] := (-1)* L2[n-k+1]; + L2[n-k+1] := tmpvalue; + perm := (k,n-k+1)*perm; + u1 := (k,n-k+1) * u1; + Add( slp, [ [vpos,-k,spos,1,vpos,k] , tpos ] ); + Add( slp, [ [tpos,1,left,1] , left ] ); + + break; + fi; + od; + od; + + c := CycleFromPermutation(perm); + for i in c do + k := LargestMovedPoint(i); + if k <= m then + Add(result, i); + else + Add(result2, i); + fi; + od; + + result := Set(result); + result2 := Set(result2); + + Add( slp, [ [left,-1] , left ] ); + Add( slp, [ [right,-1] , right ] ); + + perm := One(SymmetricGroup(n)); + for i in [1..Size(result)] do + perm := perm * result[i]; + od; + + perm2 := One(SymmetricGroup(n)); + for i in [1..Size(result2)] do + perm2 := perm2 * result2[i]; + od; + + v := (CycleFromPermutation(PermutationMonomialMatrix(stdgens[4])[2])[1])^(-1); + vf := (CycleFromPermutation(PermutationMonomialMatrix(stdgens[4])[2])[1])^(-1); + s := CycleFromPermutation(PermutationMonomialMatrix(stdgens[5])[2])[1]; + + Add( slp, [ [4,1], vpos ] ); + Add( slp, [ [4,-1], vipos ] ); + Add( slp, [ [5,1], spos ] ); + + perm3 := perm; + + for i in [ 1 .. m ] do + + pot := i^perm - i; + + # Need to update perm since pi_{i-1} may change pos of i + perm := perm * v ^pot; + + # memory slots 13 and 14 are used for resAEM and tmpAEM + instr := AEM( vipos, 13, 14, pot ); + Append( slp, instr ); + Add( slp, [ [p_signpos,1, 13,1 ], p_signpos ] ); # permpos + + #Compute v_i+1, save command in slp + v := s * v; + + Add(slp,[ [spos,1, vipos,1 ], vipos ] ); # vipos + # Don't be confused with notation in Paper + # There we used v1 (which coincides with v^-1) + + s := s ^( vf ^-1 ); + Add(slp, [ [10, 1, spos,1, 4,1 ], spos ] ); # spos + + + od; + + Add(slp,[ [ p_signpos,-1 ], p_signpos ] ); + + tmpvalue := PermutationMat(perm2^(-1),n, fld); + tmpvalue{[1..n/2]}{[1..n/2]} := PermutationMat(perm3^(-1),n/2, fld); + + Add( slp, [ [left,1,p_signpos,1,right,1] , p_signpos ] ); + + Add( slp, [ p_signpos ,1 ] ); + + tmpvalue :=R2*tmpvalue*L2; + mat := tmpvalue*mat; + + return [slp, [ tmpvalue, mat ] ]; + +end +); + + + +##### +# DiagSLPSp +##### + +InstallGlobalFunction( DiagSLPSp, +function( arg ) + + local stdgens, diag, fld, slp, a_i, d, omega, delta, u, v, cnt, hiposm, hipos, respos, hres, instr, i; + + if Length(arg) >= 2 and IsList(arg[1]) and IsMatrix(arg[2]) then + + stdgens := arg[1]; # the LGO standard generators + diag := arg[2]; + + if Length(stdgens) < 1 or not IsMatrix( stdgens[1] ) then + Error("Input: first argument must be the LGO standard generators"); + return; + fi; + + if not IsDiagonalMat( diag ) then + Error("Input: second argument must be a diagonal matrix"); + return; + fi; + else + Error("Input: LGO standard generators and a diagonal matrix"); + return; + fi; + + fld := FieldOfMatrixList( stdgens ); + + if Length(arg) >= 3 and Length(arg) <= 4 then + + # The first 12 entries are the stdgens and their inverses + slp := arg[3]; + + if not IsList(slp) then + Error("Input: third argument must be a list"); + return fail; + fi; + + cnt := arg[4]; + # <--- Laesst sich das umgehen? Jeweils den hoechsten Slot mitzaehlen? + Info( InfoBruhat, 2, " and additional: ",3," memory slots ", + "in DiagonalDecomposition()\n"); + + else + # We write an SLP into the variable slp + # The first 10 entries are the stdgens and their inverses + # s^-1 t^-1 del^-1 v^-1 x^-1 + # The entries #13 (resAEM),#14 (tmpAEM) are used to save AEM-values + slp := [ [1, 1], [2, 1], [3, 1], [4, 1], [5, 1], [6, 1], + [1,-1], [2,-1], [3,-1], [4,-1], [5,-1], [6,-1], + [1, 0], [1, 0] ]; + + cnt := 14; + Info( InfoBruhat, 2, "Memory Usage is: ",4," memory slots ", + "in DiagonalDecomposition()\n"); + fi; + + # Define the LGO standard-generators given in the input + delta := stdgens[3]; + v := stdgens[4]; + u := stdgens[5]; + + # Initialize the additional memory quota + #hi-2 + Add(slp, [ [1,0], cnt + 1 ] ); hiposm := cnt + 1; #15 or 27+3f + #hi-1 + Add(slp, [ [1,0], cnt + 2 ] ); hipos := cnt + 2; #16 or 28+3f + # result + Add(slp, [ [1,0], cnt + 3 ] ); respos := cnt + 3; #17 or 29+3f + + d := Length( diag ); + omega := delta[1][1]; + + if diag = One(diag) then + Add( slp, [ [1,0], respos ] ); + Add( slp, [ respos, 1]); + return [ slp, diag ]; + fi; + + hres := diag^0; + Add( slp, [ [5,1], hiposm ] ); + Add( slp, [ [3,1], hipos ] ); + + for i in [ 1..(d/2) ] do + + a_i := LogFFE( diag[i][i], omega ); + # The memory slots 13 and 14 are res and tmp-slot for AEM + instr := AEM( hipos, 13, 14, a_i ); + Append( slp, instr ); + Add( slp, [ [respos, 1, 13, 1 ], respos ] ); + Add( slp, [ [hiposm, -1 , hipos, 1, hiposm,1 ], hipos ] ); + Add( slp, [ [4, -1 , hiposm, 1, 4, 1], hiposm ] ); + + od; + + Add( slp, [ respos ,1 ] ); + + return [slp]; + +end +); + + + +##### +# BruhatDecompositionSp +##### + +InstallGlobalFunction( BruhatDecompositionSp, +function( stdgens, g ) + + local slp, u1, pm, u2, p_sign, diag, res1, res2, res3, lastline, line, pgr, fld, q; + + # We write an SLP into the variable slp + # The first 12 entries are the stdgens and their inverses + # s, t, del, v, u, x, s^-1, t^-1, del^-1, v^-1, u^-1, x^-1 + + Info( InfoBruhat, 1, + "returns an SLP to generate u1, u2, p_sign, diag\n" ); + + fld := FieldOfMatrixList( [g] ); + q := Size(fld); + + # Compute the matrices u1,u2 of Bruhat-Decomposition and the instructions + # for an SLP that compute u1 and u2 + if q mod 2 = 0 then + res1 := UnitriangularDecompositionSpEvenChar( stdgens, g); + else + res1 := UnitriangularDecompositionSp( stdgens, g); + fi; + + slp := res1[1]; + u1 := res1[2][2]; + pm := res1[2][1]; # the monomial matrix w + u2 := res1[2][3]; + + lastline := ShallowCopy( slp[ Length(slp) ] ); # remember famous last words + # Since entries of the form [list1,list2] should only occur at the end + Remove(slp); + + # Decompose w in to a signed Permutation-Matrix generated by + # and a Diagonal-Matrix diag. + + res2 := MonomialSLPSp(stdgens, pm, slp ); + + slp := ShallowCopy(res2[1]); + p_sign := res2[2][1]; + diag := res2[2][2]; + + # Now w = p_sign * diag + # and p_sign is can be evaluated as word in < s, v, x > using slp. + + # Make again all entries of slp admissible for SLP + # We inverted a Monomial-Matrix in PermSLP to get the proper result. + # Thus we have to copy a little variaton at the end of our final slp + # (else we would display a twice inverted matrix where we wanted once) + line := slp[ Length(slp) ]; + Append(lastline, [ slp[ Length(slp)] ]); + + # Determine the SLP for the Diagonal-Matrix + res3 := DiagSLPSp(stdgens, diag, slp, res1[3]+10); + slp := res3[1]; + + # Here the last entry is of admissible form. Just add it to the end. + Append( lastline, [ slp[ Length(slp)] ] ); # remember famous last words + Remove( slp ); + Append( slp, [lastline] ); + + Info( InfoBruhat, 2, "The Total Memory Usage is: " + , res1[3]+9+14, " memory slots\n" ); + + pgr := MakeSLP(slp,6); + + # The result R of pgr satisfies: + # R[1]^-1*R[3]*R[4]*R[2]^-1 and + # R[1] = u1, R[2] = u2, R[3] = p_sign, R[4] = diag + return [pgr, [ u1, u2, p_sign^(-1), diag ]]; + +end +); diff --git a/init.g b/init.g index 5e1077cd..2c95e07c 100644 --- a/init.g +++ b/init.g @@ -26,6 +26,11 @@ ReadPackage("recog","gap/matrix.gd"); ReadPackage("recog","gap/matrix/ppd.gd"); ReadPackage("recog","gap/matrix/classical.gd"); +ReadPackage("recog","gap/matrix/wordsInNiceGens/BruhatDecomposition.gd"); +ReadPackage("recog","gap/matrix/wordsInNiceGens/BruhatDecompositionSL.gd"); +ReadPackage("recog","gap/matrix/wordsInNiceGens/BruhatDecompositionSU.gd"); +ReadPackage("recog","gap/matrix/wordsInNiceGens/BruhatDecompositionSp.gd"); +ReadPackage("recog","gap/matrix/wordsInNiceGens/BruhatDecompositionO.gd"); ReadPackage("recog","gap/projective/almostsimple.gd"); ReadPackage("recog","gap/projective/findnormal.gd"); ReadPackage("recog","gap/projective/AnSnOnFDPM.gd"); diff --git a/makedoc.g b/makedoc.g index 1647cd9a..ac5135fb 100644 --- a/makedoc.g +++ b/makedoc.g @@ -29,6 +29,7 @@ scan_dirs := [ "gap/base", "gap/generic", "gap/matrix", + "gap/matrix/wordsInNiceGens", "gap/perm", "gap/projective", "gap/projective/almostsimple", diff --git a/read.g b/read.g index 92b90e73..203f85ce 100644 --- a/read.g +++ b/read.g @@ -48,6 +48,11 @@ ReadPackage("recog","gap/projective/tensor.gi"); ReadPackage("recog","gap/matrix/ppd.gi"); ReadPackage("recog","gap/matrix/classical.gi"); ReadPackage("recog","gap/matrix/slconstr.gi"); +ReadPackage("recog","gap/matrix/wordsInNiceGens/BruhatDecomposition.gi"); +ReadPackage("recog","gap/matrix/wordsInNiceGens/BruhatDecompositionSL.gi"); +ReadPackage("recog","gap/matrix/wordsInNiceGens/BruhatDecompositionSU.gi"); +ReadPackage("recog","gap/matrix/wordsInNiceGens/BruhatDecompositionSp.gi"); +ReadPackage("recog","gap/matrix/wordsInNiceGens/BruhatDecompositionO.gi"); ReadPackage("recog","gap/projective/c3c5.gi"); ReadPackage("recog","gap/projective/d247.gi"); ReadPackage("recog","gap/projective/almostsimple/threeelorders.gi"); diff --git a/tst/working/slow/TestWordsInNiceGens.tst b/tst/working/slow/TestWordsInNiceGens.tst new file mode 100644 index 00000000..a1f3a358 --- /dev/null +++ b/tst/working/slow/TestWordsInNiceGens.tst @@ -0,0 +1,376 @@ +# +# BruhatDecomposition: Computes the Bruhat Decomposition of matrices of the classical groups. +# + +gap> TestBruhatDecompositionSLPSL := function() +> local counter, g, G, res, d, GG, stdgens, diag, slp, tmpvalue, c, P, u1, u2, mon; +> P := [2,4,8,16,32,3,9,27,5,5^2,7,7^2]; +> +> for d in [6..13] do +> for c in P do +> stdgens := LGOStandardGensSL(d,c); +> G := GroupByGenerators(stdgens); +> Print("Dimension: "); +> Print(d); +> Print(",Ordnung: "); +> Print(c); +> Print("\n"); +> counter := 1; +> while counter < 100 do +> g := PseudoRandom(G); +> res := BruhatDecompositionSL(stdgens,g); +> slp := res[1]; +> slp := ResultOfStraightLineProgram(slp,stdgens); +> res := res[2]; +> u1 := res[1]; +> u2 := res[2]; +> mon := res[3]; +> diag := res[4]; +> if (slp[1]^(-1)*slp[3]*slp[4]*slp[2]^(-1) <> g) then +> Error("Wrong matrix."); +> fi; +> Display(counter); +> counter := counter +1; +> od; +> od; +> od; +> +> end;; + + +gap> TestBruhatDecompositionSLPSLNC := function() +> local counter, g, G, res, d, GG, stdgens, diag, slp, tmpvalue, c, P, u1, u2, mon; +> P := [2,4,8,16,32,3,9,27,5,5^2,7,7^2]; +> +> for d in [6..13] do +> for c in P do +> stdgens := LGOStandardGensSL(d,c); +> G := GroupByGenerators(stdgens); +> Print("Dimension: "); +> Print(d); +> Print(",Ordnung: "); +> Print(c); +> Print("\n"); +> counter := 1; +> while counter < 100 do +> g := PseudoRandom(G); +> res := BruhatDecompositionSLNC(stdgens,g); +> slp := res[1]; +> slp := ResultOfStraightLineProgram(slp,stdgens); +> res := res[2]; +> u1 := res[1]; +> u2 := res[2]; +> mon := res[3]; +> diag := res[4]; +> if (slp[1]^(-1)*slp[3]*slp[4]*slp[2]^(-1) <> g) then +> Error("Wrong matrix."); +> fi; +> Display(counter); +> counter := counter +1; +> od; +> od; +> od; +> +> end;; + + +gap> TestBruhatDecompositionSLPSp := function() +> local counter, g, G, res, d, GG, stdgens, diag, slp, tmpvalue, c, P, u1, u2, mon; +> P := [2,4,8,16,32,3,9,27,5,5^2,7,7^2]; +> +> for d in Filtered([6..13], x-> x mod 2 = 0) do +> for c in P do +> if c mod 2 = 0 then +> stdgens := LGOStandardGensSpEvenChar(d,c); +> else +> stdgens := LGOStandardGensSp(d,c); +> fi; +> G := GroupByGenerators(stdgens); +> Print("Dimension: "); +> Print(d); +> Print(",Ordnung: "); +> Print(c); +> Print("\n"); +> counter := 1; +> while counter < 100 do +> g := PseudoRandom(G); +> res := BruhatDecompositionSp(stdgens,g); +> slp := res[1]; +> slp := ResultOfStraightLineProgram(slp,stdgens); +> res := res[2]; +> u1 := res[1]; +> u2 := res[2]; +> mon := res[3]; +> diag := res[4]; +> if (slp[1]^(-1)*slp[3]*slp[4]*slp[2]^(-1) <> g) then +> Error("Wrong matrix."); +> fi; +> Display(counter); +> counter := counter +1; +> od; +> od; +> od; +> +> end;; + + + +gap> TestBruhatDecompositionSLPSU := function() +> local counter, g, G, res, d, GG, stdgens, diag, slp, tmpvalue, c, P, u1, u2, mon; +> P := [2,4,8,16,32,3,9,27,5,5^2,7,7^2]; +> +> for d in [6..13] do +> for c in P do +> if c mod 2 = 0 then +> stdgens := LGOStandardGensSUEvenChar(d,c); +> else +> stdgens := LGOStandardGensSU(d,c); +> fi; +> G := GroupByGenerators(stdgens); +> Print("Dimension: "); +> Print(d); +> Print(",Ordnung: "); +> Print(c); +> Print("\n"); +> counter := 1; +> while counter < 100 do +> g := PseudoRandom(G); +> res := BruhatDecompositionSU(stdgens,g); +> slp := res[1]; +> slp := ResultOfStraightLineProgram(slp,stdgens); +> res := res[2]; +> u1 := res[1]; +> u2 := res[2]; +> mon := res[3]; +> diag := res[4]; +> if (slp[1]^(-1)*slp[3]*slp[4]*slp[2]^(-1) <> g) then +> Error("Wrong matrix."); +> fi; +> Display(counter); +> counter := counter +1; +> od; +> od; +> od; +> +> end; + + + +gap> TestBruhatDecompositionSLPSO := function() +> local counter, g, G, res, d, GG, stdgens, diag, slp, tmpvalue, c, P, u1, u2, mon; +> P := [3,9,27,5,5^2,7,7^2,11,13,11^2,17]; +> +> Display("Plus case."); +> for d in Filtered([6..13], x-> x mod 2 = 0) do +> for c in P do +> if c mod 2 = 0 then +> stdgens := LGOStandardGensOmega(1,d,c); +> else +> stdgens := LGOStandardGensSO(1,d,c); +> fi; +> G := GroupByGenerators(stdgens); +> Print("Dimension: "); +> Print(d); +> Print(",Ordnung: "); +> Print(c); +> Print("\n"); +> counter := 1; +> while counter < 100 do +> g := PseudoRandom(G); +> res := BruhatDecompositionSO(stdgens,g); +> slp := res[1]; +> slp := ResultOfStraightLineProgram(slp,stdgens); +> res := res[2]; +> u1 := res[1]; +> u2 := res[2]; +> mon := res[3]; +> diag := res[4]; +> if (slp[1]^(-1)*slp[3]*slp[4]*slp[2]^(-1) <> g) then +> Error("Wrong matrix."); +> fi; +> Display(counter); +> counter := counter +1; +> od; +> od; +> od; +> +> Display("Circle case."); +> for d in Filtered([6..13], x-> x mod 2 = 1) do +> for c in P do +> if c mod 2 = 0 then +> stdgens := LGOStandardGensOmega(0,d,c); +> else +> stdgens := LGOStandardGensSO(0,d,c); +> fi; +> G := GroupByGenerators(stdgens); +> Print("Dimension: "); +> Print(d); +> Print(",Ordnung: "); +> Print(c); +> Print("\n"); +> counter := 1; +> while counter < 100 do +> g := PseudoRandom(G); +> res := BruhatDecompositionSO(stdgens,g); +> slp := res[1]; +> slp := ResultOfStraightLineProgram(slp,stdgens); +> res := res[2]; +> u1 := res[1]; +> u2 := res[2]; +> mon := res[3]; +> diag := res[4]; +> if (slp[1]^(-1)*slp[3]*slp[4]*slp[2]^(-1) <> g) then +> Error("Wrong matrix."); +> fi; +> Display(counter); +> counter := counter +1; +> od; +> od; +> od; +> +> Display("Minus case."); +> for d in Filtered([8..15], x-> x mod 2 = 0) do +> for c in P do +> if c mod 2 = 0 then +> stdgens := LGOStandardGensOmega(-1,d,c); +> else +> stdgens := LGOStandardGensSO(-1,d,c); +> fi; +> G := GroupByGenerators(stdgens); +> Print("Dimension: "); +> Print(d); +> Print(",Ordnung: "); +> Print(c); +> Print("\n"); +> counter := 1; +> while counter < 100 do +> g := PseudoRandom(G); +> res := BruhatDecompositionSOMinus(stdgens,g); +> slp := res[1]; +> slp := ResultOfStraightLineProgram(slp,stdgens); +> res := res[2]; +> u1 := res[1]; +> u2 := res[2]; +> mon := res[3]; +> diag := res[4]; +> if (slp[1]^(-1)*slp[3]*slp[4]*slp[2]^(-1) <> g) then +> Error("Wrong matrix."); +> fi; +> Display(counter); +> counter := counter +1; +> od; +> od; +> od; +> +> end;; + + + +gap> TestBruhatDecompositionSLPOmega := function() +> local counter, g, G, res, d, GG, stdgens, diag, slp, tmpvalue, c, P, u1, u2, mon; +> P := [2,4,8,16,32,3,9,27,5,5^2,7,7^2]; +> +> for d in Filtered([6..20], x-> x mod 2 = 0) do +> for c in P do +> stdgens := LGOStandardGensOmega(1,d,c); +> G := GroupByGenerators(stdgens); +> Print("Dimension: "); +> Print(d); +> Print(",Ordnung: "); +> Print(c); +> Print("\n"); +> counter := 1; +> while counter < 100 do +> g := PseudoRandom(G); +> # BruhatDecompositionOmega +> res := BruhatDecompositionSO(stdgens,g); +> slp := res[1]; +> slp := ResultOfStraightLineProgram(slp,stdgens); +> res := res[2]; +> u1 := res[1]; +> u2 := res[2]; +> mon := res[3]; +> diag := res[4]; +> if (slp[1]^(-1)*slp[3]*slp[4]*slp[2]^(-1) <> g) then +> Error("Wrong matrix."); +> fi; +> Display(counter); +> counter := counter +1; +> od; +> od; +> od; +> +> for d in Filtered([6..20], x-> x mod 2 = 1) do +> for c in P do +> stdgens := LGOStandardGensOmega(0,d,c); +> G := GroupByGenerators(stdgens); +> Print("Dimension: "); +> Print(d); +> Print(",Ordnung: "); +> Print(c); +> Print("\n"); +> counter := 1; +> while counter < 100 do +> g := PseudoRandom(G); +> # BruhatDecompositionOmega +> res := BruhatDecompositionSO(stdgens,g); +> slp := res[1]; +> slp := ResultOfStraightLineProgram(slp,stdgens); +> res := res[2]; +> u1 := res[1]; +> u2 := res[2]; +> mon := res[3]; +> diag := res[4]; +> if (slp[1]^(-1)*slp[3]*slp[4]*slp[2]^(-1) <> g) then +> Error("Wrong matrix."); +> fi; +> Display(counter); +> counter := counter +1; +> od; +> od; +> od; +> +> for d in Filtered([6..20], x-> x mod 2 = 0) do +> for c in P do +> stdgens := LGOStandardGensOmega(-1,d,c); +> G := GroupByGenerators(stdgens); +> Print("Dimension: "); +> Print(d); +> Print(",Ordnung: "); +> Print(c); +> Print("\n"); +> counter := 1; +> while counter < 100 do +> g := PseudoRandom(G); +> # BruhatDecompositionOmega +> res := BruhatDecompositionSO(stdgens,g); +> slp := res[1]; +> slp := ResultOfStraightLineProgram(slp,stdgens); +> res := res[2]; +> u1 := res[1]; +> u2 := res[2]; +> mon := res[3]; +> diag := res[4]; +> if (slp[1]^(-1)*slp[3]*slp[4]*slp[2]^(-1) <> g) then +> Error("Wrong matrix."); +> fi; +> counter := counter +1; +> od; +> od; +> od; +> +> end;; + +gap> Display("Test SL\n");; +gap> TestBruhatDecompositionSLPSL();; +gap> Display("Test SLNC\n");; +gap> TestBruhatDecompositionSLPSLNC();; +gap> Display("Test Sp\n");; +gap> TestBruhatDecompositionSLPSp();; +gap> Display("Test SU\n");; +gap> TestBruhatDecompositionSLPSU();; +gap> Display("Test SO\n");; +gap> TestBruhatDecompositionSLPSO();; +# TestBruhatDecompositionSLPOmega();; +gap> Print("Everything worked! Congrats!\n");; +