add implementation of MatrixGroups as fp groups

src/Groups.jl

@@ -10,6 +10,8 @@ import Random
 import OrderedCollections: OrderedSet
 
 export Alphabet, AutomorphismGroup, FreeGroup, FreeGroup, FPGroup, FPGroupElement, SpecialAutomorphismGroup
+export MatrixGroups
+
 export alphabet, evaluate, word, gens
 
 include("types.jl")
@@ -20,6 +22,8 @@ include("autgroups.jl")
 include("aut_groups/sautFn.jl")
 include("aut_groups/mcg.jl")
 
+include("matrix_groups/MatrixGroups.jl")
+using .MatrixGroups
 
 include("wl_ball.jl")
 end # of module Groups

src/matrix_groups/MatrixGroups.jl

@@ -0,0 +1,17 @@
+module MatrixGroups
+
+using GroupsCore
+using Groups
+using KnuthBendix
+
+using LinearAlgebra # Identity matrix
+using Random # GroupsCore rand
+
+export SpecialLinearGroup, SymplecticGroup
+
+include("abstract.jl")
+
+include("SLn.jl")
+include("Spn.jl")
+
+end # module

src/matrix_groups/SLn.jl

@@ -0,0 +1,42 @@
+include("eltary_matrices.jl")
+
+struct SpecialLinearGroup{N, T, R, A, S} <: MatrixGroup{N,T}
+    base_ring::R
+    alphabet::A
+    gens::S
+
+    function SpecialLinearGroup{N}(base_ring) where N
+        S = [ElementaryMatrix{N}(i,j, one(base_ring)) for i in 1:N for j in 1:N if i≠j]
+        alphabet = Alphabet(S)
+
+        return new{
+            N,
+            eltype(base_ring),
+            typeof(base_ring),
+            typeof(alphabet),
+            typeof(S)
+        }(base_ring, alphabet, S)
+    end
+end
+
+GroupsCore.ngens(SL::SpecialLinearGroup{N}) where N = N^2 - N
+
+Base.show(io::IO, SL::SpecialLinearGroup{N, T}) where {N, T} =
+    print(io, "special linear group of $N×$N matrices over $T")
+
+function Base.show(
+    io::IO,
+    ::MIME"text/plain",
+    sl::Groups.AbstractFPGroupElement{<:SpecialLinearGroup{N}}
+) where N
+
+    Groups.normalform!(sl)
+
+    print(io, "SL{$N,$(eltype(sl))} matrix: ")
+    KnuthBendix.print_repr(io, word(sl), alphabet(sl))
+    println(io)
+    Base.print_array(io, matrix_repr(sl))
+end
+
+Base.show(io::IO, sl::Groups.AbstractFPGroupElement{<:SpecialLinearGroup}) =
+    KnuthBendix.print_repr(io, word(sl), alphabet(sl))

src/matrix_groups/Spn.jl

@@ -0,0 +1,68 @@
+include("eltary_symplectic.jl")
+
+struct SymplecticGroup{N, T, R, A, S} <: MatrixGroup{N,T}
+    base_ring::R
+    alphabet::A
+    gens::S
+
+    function SymplecticGroup{N}(base_ring) where N
+        S = symplectic_gens(N, eltype(base_ring))
+        alphabet = Alphabet(S)
+
+        return new{
+            N,
+            eltype(base_ring),
+            typeof(base_ring),
+            typeof(alphabet),
+            typeof(S)
+        }(base_ring, alphabet, S)
+    end
+end
+
+GroupsCore.ngens(Sp::SymplecticGroup) = length(Sp.gens)
+
+Base.show(io::IO, ::SymplecticGroup{N}) where N = print(io, "group of $N×$N symplectic matrices")
+
+function Base.show(
+    io::IO,
+    ::MIME"text/plain",
+    sp::Groups.AbstractFPGroupElement{<:SymplecticGroup{N}}
+) where {N}
+    print(io, "$N×$N Symplectic matrix: ")
+    KnuthBendix.print_repr(io, word(sp), alphabet(sp))
+    println(io)
+    Base.print_array(io, matrix_repr(sp))
+end
+
+function symplectic_gens(N, T=Int8)
+    iseven(N) || throw(ArgumentError("N needs to be even!"))
+    n = N÷2
+
+    a_ijs = [ElementarySymplectic{N}(:A, i,j, one(T)) for (i,j) in offdiagonal_indexing(n)]
+    b_is =  [ElementarySymplectic{N}(:B, n+i,i, one(T)) for i in 1:n]
+    c_ijs = [ElementarySymplectic{N}(:B, n+i,j, one(T)) for (i,j) in offdiagonal_indexing(n)]
+
+    S = [a_ijs; b_is; c_ijs]
+
+    S = [S; transpose.(S)]
+
+    return unique(S)
+end
+
+function _std_symplectic_form(m::AbstractMatrix)
+    r,c = size(m)
+    r == c || return false
+    iseven(r) || return false
+
+    n = r÷2
+    Ω = zero(m)
+    for i in 1:n
+        Ω[2i-1:2i, 2i-1:2i] .= [0 -1; 1 0]
+    end
+    return Ω
+end
+
+function issymplectic(mat::M, Ω = _std_symplectic_form(mat)) where M <: AbstractMatrix
+    r, c = size(mat)
+    return Ω == transpose(mat) * Ω * mat
+end

src/matrix_groups/abstract.jl

@@ -0,0 +1,41 @@
+abstract type MatrixGroup{N, T} <: Groups.AbstractFPGroup end
+const MatrixGroupElement{N, T} = Groups.AbstractFPGroupElement{<:MatrixGroup{N, T}}
+
+Base.isone(g::MatrixGroupElement{N, T}) where {N, T} = matrix_repr(g) == I
+
+function Base.:(==)(m1::M1, m2::M2) where {M1<:MatrixGroupElement, M2<:MatrixGroupElement}
+    parent(m1) === parent(m2) || return false
+    word(m1) == word(m2) && return true
+    return matrix_repr(m1) == matrix_repr(m2)
+end
+
+Base.size(m::MatrixGroupElement{N}) where N = (N, N)
+Base.eltype(m::MatrixGroupElement{N, T}) where {N, T} = T
+
+# three structural assumptions about matrix groups
+Groups.word(sl::MatrixGroupElement) = sl.word
+Base.parent(sl::MatrixGroupElement) = sl.parent
+Groups.alphabet(M::MatrixGroup) = M.alphabet
+Groups.rewriting(M::MatrixGroup) = alphabet(M)
+
+Base.hash(sl::MatrixGroupElement, h::UInt) =
+    hash(matrix_repr(sl), hash(parent(sl), h))
+
+Base.getindex(sl::MatrixGroupElement, i, j) = matrix_repr(sl)[i,j]
+# Base.iterate(sl::MatrixGroupElement) = iterate(sl.elts)
+# Base.iterate(sl::MatrixGroupElement, state) = iterate(sl.elts, state)
+
+function matrix_repr(m::MatrixGroupElement{N, T}) where {N, T}
+    isempty(word(m)) && return StaticArrays.SMatrix{N, N, T}(I)
+    A = alphabet(parent(m))
+    return prod(matrix_repr(A[l]) for l in word(m))
+end
+
+function Base.rand(
+    rng::Random.AbstractRNG,
+    rs::Random.SamplerTrivial{<:MatrixGroup},
+    )
+    Mgroup = rs[]
+    S = gens(Mgroup)
+    return prod(g -> rand(Bool) ? g : inv(g), rand(S, rand(1:30)))
+end

src/matrix_groups/eltary_matrices.jl

@@ -0,0 +1,31 @@
+using Groups
+using StaticArrays
+
+struct ElementaryMatrix{N, T} <: Groups.GSymbol
+    i::Int
+    j::Int
+    val::T
+    ElementaryMatrix{N}(i, j, val=1) where N =
+        (@assert i≠j; new{N, typeof(val)}(i, j, val))
+end
+
+function Base.show(io::IO, e::ElementaryMatrix)
+    print(io, 'E', Groups.subscriptify(e.i), Groups.subscriptify(e.j))
+    !isone(e.val) && print(io, "^$(e.val)")
+end
+
+Base.:(==)(e::ElementaryMatrix{N}, f::ElementaryMatrix{N}) where N =
+    e.i == f.i && e.j == f.j && e.val == f.val
+
+Base.hash(e::ElementaryMatrix, h::UInt) =
+    hash(typeof(e), hash((e.i, e.j, e.val), h))
+
+Base.inv(e::ElementaryMatrix{N}) where N =
+    ElementaryMatrix{N}(e.i, e.j, -e.val)
+
+function matrix_repr(e::ElementaryMatrix{N, T}) where {N, T}
+    m = StaticArrays.MMatrix{N, N, T}(I)
+    m[e.i, e.j] = e.val
+    x = StaticArrays.SMatrix{N, N}(m)
+    return x
+end

src/matrix_groups/eltary_symplectic.jl

@@ -0,0 +1,85 @@
+using Groups
+using StaticArrays
+
+struct ElementarySymplectic{N, T} <: Groups.GSymbol
+    symbol::Symbol
+    i::Int
+    j::Int
+    val::T
+    function ElementarySymplectic{N}(s::Symbol, i::Integer, j::Integer, val=1) where N
+        @assert s ∈ (:A, :B)
+        @assert iseven(N)
+        n = N÷2
+        if s === :A
+            @assert 1 ≤ i ≤ n && 1 ≤ j ≤ n && i ≠ j
+        elseif s === :B
+            @assert xor(1 ≤ i ≤ n, 1 ≤ j ≤ n) && xor(n < i ≤ N, n < j ≤ N)
+        end
+        return new{N, typeof(val)}(s, i, j, val)
+    end
+end
+
+function Base.show(io::IO, s::ElementarySymplectic)
+    i, j = Groups.subscriptify(s.i), Groups.subscriptify(s.j)
+    print(io, s.symbol, i, j)
+    !isone(s.val) && print(io, "^$(s.val)")
+end
+
+function Base.show(io::IO, ::MIME"text/plain", s::ElementarySymplectic)
+    print(io, s)
+    print(io, " →  corresponding root: ")
+    print(io, Roots.Root(s))
+end
+
+_ind(s::ElementarySymplectic{N}) where N = (s.i, s.j)
+_local_ind(N_half::Integer, i::Integer) = ifelse(i<=N_half, i, i-N_half)
+function _dual_ind(s::ElementarySymplectic{N}) where N
+    if s.symbol === :A && return _ind(s)
+    else#if s.symbol === :B
+        return _dual_ind(N÷2, s.i, s.j)
+    end
+end
+
+function _dual_ind(N_half, i, j)
+    @assert i <= N_half < j || j <= N_half < i
+    if i <= N_half # && j > N_half
+        i, j = j - N_half, i + N_half
+    else
+        i, j = j + N_half, i - N_half
+    end
+    return i, j
+end
+
+function Base.:(==)(s::ElementarySymplectic{N}, t::ElementarySymplectic{M}) where {N, M}
+    N == M || return false
+    s.symbol == t.symbol || return false
+    s.val == t.val || return false
+    return _ind(t) == _ind(s) || _ind(t) == _dual_ind(s)
+end
+
+Base.hash(s::ElementarySymplectic, h::UInt) =
+    hash(Set([_ind(s); _dual_ind(s)]), hash(s.symbol, hash(s.val, h)))
+
+LinearAlgebra.transpose(s::ElementarySymplectic{N}) where N =
+    ElementarySymplectic{N}(s.symbol, s.j, s.i, s.val)
+
+Base.inv(s::ElementarySymplectic{N}) where N =
+    ElementarySymplectic{N}(s.symbol, s.i, s.j, -s.val)
+
+function matrix_repr(s::ElementarySymplectic{N, T}) where {N, T}
+    @assert iseven(N)
+    n = div(N, 2)
+    m = StaticArrays.MMatrix{N, N, T}(I)
+    i,j = _ind(s)
+    m[i,j] = s.val
+    if s.symbol === :A
+        m[n+j, n+i] = -s.val
+    else#if s.symbol === :B
+        if i > n
+            m[j+n, i-n] = s.val
+        else
+            m[j-n, i+n] = s.val
+        end
+    end
+    return StaticArrays.SMatrix{N, N}(m)
+end

test/matrix_groups.jl

@@ -0,0 +1,24 @@
+using Groups.MatrixGroups
+
+@testset "Matrix Groups" begin
+
+    @testset "SL(n, ℤ)" begin
+        SL3Z = SpecialLinearGroup{3}(Int8)
+
+        S = gens(SL3Z); union!(S, inv.(S))
+
+        E, sizes = Groups.wlmetric_ball(S, radius=4)
+
+        @test sizes = [13, 121, 883, 5455]
+
+        @testset "GroupsCore conformance" begin
+            test_Group_interface(SL3Z)
+            g = A(rand(1:length(alphabet(SL3Z)), 10))
+            h = A(rand(1:length(alphabet(SL3Z)), 10))
+
+            test_GroupElement_interface(g, h)
+        end
+
+    end
+
+end

test/runtests.jl

@@ -25,6 +25,8 @@ include(joinpath(pathof(GroupsCore), "..", "..", "test", "conformance_test.jl"))
     include("free_groups.jl")
     include("fp_groups.jl")
 
+    include("matrix_groups.jl")
+
     include("AutFn.jl")
     include("AutSigma_41.jl")
     include("AutSigma3.jl")