first working version of Automorphisms of surface groups

src/groups/mcg.jl

@@ -8,6 +8,15 @@ struct SurfaceGroup{T, S, R} <: AbstractFPGroup
     rws::R
 end
 
+genus(S::SurfaceGroup) = S.genus
+
+function Base.show(io::IO, S::SurfaceGroup)
+    print(io, "π₁ of the orientable surface of genus $(genus(S))")
+    if S.boundaries > 0
+        print(io, " with $(S.boundaries) boundary components")
+    end
+end
+
 function SurfaceGroup(genus::Integer, boundaries::Integer)
     @assert genus > 1
 
@@ -32,36 +41,50 @@ function SurfaceGroup(genus::Integer, boundaries::Integer)
             append!(word, [x, x-2, x-1, x-3])
         end
         comms = Word(word)
-        rels = [ comms => one(comms) ]
+        word_rels = [ comms => one(comms) ]
 
-        rws = RewritingSystem(rels, KnuthBendix.RecursivePathOrder(Al))
+        rws = RewritingSystem(word_rels, KnuthBendix.RecursivePathOrder(Al))
         KnuthBendix.knuthbendix!(rws)
     elseif boundaries == 1
         S = typeof(one(Word(Int[])))
-        rels = Pair{S, S}[]
+        word_rels = Pair{S, S}[]
-        rws = RewritingSystem(rels, KnuthBendix.LenLex(Al))
+        rws = RewritingSystem(word_rels, KnuthBendix.LenLex(Al))
     else
         throw("Not Implemented")
     end
 
+    F = FreeGroup(alphabet(rws))
+    rels = [F(lhs)=>F(rhs) for (lhs,rhs) in word_rels]
+
     return SurfaceGroup(genus, boundaries, KnuthBendix.letters(Al)[2:2:end], rels, rws)
 end
 
-rewriting(G::SurfaceGroup) = G.rws
+rewriting(S::SurfaceGroup) = S.rws
-KnuthBendix.alphabet(G::SurfaceGroup) = alphabet(rewriting(G))
+KnuthBendix.alphabet(S::SurfaceGroup) = alphabet(rewriting(S))
-relations(G::SurfaceGroup) = G.relations
+relations(S::SurfaceGroup) = S.relations
 
+function symplectic_twists(π₁Σ::SurfaceGroup)
+    g = genus(π₁Σ)
 
+    saut = SpecialAutomorphismGroup(FreeGroup(2g))
 
+    Aij  = [SymplecticMappingClass(π₁Σ, saut, :A, i, j) for i in 1:g for j in 1:g if i≠j]
 
+    Bij  = [SymplecticMappingClass(π₁Σ, saut, :B, i, j) for i in 1:g for j in i+1:g]
 
+    mBij = [SymplecticMappingClass(π₁Σ, saut, :B, i, j, minus=true) for i in 1:g for j in i+1:g]
 
-function mapping_class_group(genus::Integer, punctures::Integer)
+    Bii  = [SymplecticMappingClass(π₁Σ, saut, :B, i, i) for i in 1:g]
-    Σ = surface_group(genus, punctures)
 
+    mBii = [SymplecticMappingClass(π₁Σ, saut, :B, i, i, minus=true) for i in 1:g]
 
-
+    return [Aij; Bij; mBij; Bii; mBii]
-    return New.AutomorphismGroup(Σ, S, rws, ntuple(i -> gens(F, i), n))
 end
 
-KnuthBendix.alphabet(G::AutomorphismGroup{<:SurfaceGroup}) = alphabet(rewriting(G))
+KnuthBendix.alphabet(G::AutomorphismGroup{<:SurfaceGroup}) = rewriting(G)
+
+function AutomorphismGroup(π₁Σ::SurfaceGroup; kwargs...)
+    S = vcat(symplectic_twists(π₁Σ)...)
+    A = Alphabet(S)
+    return AutomorphismGroup(π₁Σ, S, A, ntuple(i->gens(π₁Σ, i), 2genus(π₁Σ)))
+end

src/groups/symplectic_twists.jl

@@ -1,3 +1,99 @@
+struct ΡΛ
+    id::Symbol
+    A::Alphabet
+    N::Int
+end
+
+function Base.getindex(rl::ΡΛ, i::Integer, j::Integer)
+    @assert 1 ≤ i ≤ rl.N
+    @assert 1 ≤ j ≤ rl.N
+    @assert i ≠ j
+    @assert rl.id ∈ (:λ, :ϱ)
+    rl.id == :λ && return Word([rl.A[λ(i, j)]])
+    rl.id == :ϱ && return Word([rl.A[ϱ(i, j)]])
+end
+
+function Te_diagonal(λ::ΡΛ, ϱ::ΡΛ, i::Integer)
+    @assert λ.N == ϱ.N
+    @assert λ.id == :λ && ϱ.id == :ϱ
+
+    N = λ.N
+    @assert iseven(N)
+    n = N ÷ 2
+    j = i + 1
+    @assert 1 <= i < n
+
+    A = λ.A
+
+    # comments are for i,j = 1,2
+    g = one(Word(Int[]))
+    g *= λ[n+j, n+i]                   # β ↦ α*β
+    g *= λ[n+i, i] * inv(A, ϱ[n+i, j]) # α ↦ a*α*b^-1
+    g *= inv(A, λ[n+j, n+i])           # β ↦ b*α^-1*a^-1*α*β
+    g *= λ[j, n+i] * inv(A, λ[j, i])   # b ↦ α
+    g *= inv(A, λ[j, n+i])             # b ↦ b*α^-1*a^-1*α
+    g *= inv(A, ϱ[j, n+i]) * ϱ[j, i]   # b ↦ b*α^-1*a^-1*α*b*α^-1
+    g *= ϱ[j, n+i]                     # b ↦ b*α^-1*a^-1*α*b*α^-1*a*α*b^-1
+    return g
+end
+
+function Te_lantern(A::Alphabet, b₀::T, a₁::T, a₂::T, a₃::T, a₄::T, a₅::T) where {T}
+    a₀ = (a₁ * a₂ * a₃)^4 * inv(A, b₀)
+    X = a₄ * a₅ * a₃ * a₄
+    b₁ = inv(A, X) * a₀ * X
+    Y = a₂ * a₃ * a₁ * a₂
+    return inv(A, Y) * b₁ * Y # b₂
+end
+
+Ta(λ::ΡΛ, i::Integer) = (@assert λ.id == :λ;
+λ[λ.N÷2+i, i])
+Tα(λ::ΡΛ, i::Integer) = (@assert λ.id == :λ;
+inv(λ.A, λ[i, λ.N÷2+i]))
+
+function Te(λ::ΡΛ, ϱ::ΡΛ, i, j)
+    @assert i ≠ j
+    i, j = i < j ? (i, j) : (j, i)
+
+    @assert λ.N == ϱ.N
+    @assert λ.A == ϱ.A
+    @assert λ.id == :λ && ϱ.id == :ϱ
+
+    @assert 1 ≤ i ≤ λ.N
+    @assert 1 ≤ j ≤ λ.N
+
+    if j == i + 1
+        return Te_diagonal(λ, ϱ, i)
+    else
+        return Te_lantern(
+            λ.A,
+            Ta(λ, i + 1),
+            Ta(λ, i),
+            Tα(λ, i),
+            Te(λ, ϱ, i, i + 1),
+            Tα(λ, i + 1),
+            Te(λ, ϱ, i + 1, j),
+        )
+    end
+end
+
+function mcg_twists(genus::Integer)
+    genus < 3 && throw("Not Implemented: genus = $genus < 3")
+
+    G = SpecialAutomorphismGroup(FreeGroup(2genus), maxrules = 1000)
+    A = KnuthBendix.alphabet(G)
+
+    λ = ΡΛ(:λ, A, 2genus)
+    ϱ = ΡΛ(:ϱ, A, 2genus)
+
+    Tas = [Ta(λ, i) for i in 1:genus]
+    Tαs = [Tα(λ, i) for i in 1:genus]
+
+    idcs = ((i, j) for i in 1:genus for j in i+1:genus)
+    Tes = [Te(λ, ϱ, i, j) for (i, j) in idcs]
+
+    return Tas, Tαs, Tes
+end
+
 struct SymplecticMappingClass{N,T} <: GSymbol
     id::Symbol # :A, :B
     i::UInt
@@ -6,126 +102,113 @@ struct SymplecticMappingClass{N, T} <: GSymbol
     inv::Bool
     images::NTuple{N,T}
     invimages::NTuple{N,T}
+end
 
-    function SymplecticMappingClass{N}(G, id, i, j, minus=false, inv=false) where N
+function SymplecticMappingClass(
+    Σ::SurfaceGroup,
+    sautFn,
+    id::Symbol,
+    i::Integer,
+    j::Integer;
+    minus = false,
+    inverse = false,
+)
     @assert i > 0 && j > 0
     id === :A && @assert i ≠ j
+    @assert 2genus(Σ) == ngens(object(sautFn))
 
-        g = if id === :A
+    A = KnuthBendix.alphabet(sautFn)
-            Te(G, i, j) *
+    λ = ΡΛ(:λ, A, 2genus(Σ))
-            Ta(N, i)^-1 *
+    ϱ = ΡΛ(:ϱ, A, 2genus(Σ))
-            Tα(N, i) *
+
-            Ta(N, i) *
+    w = if id === :A
-            Te(G, i, j)^-1 *
+        Te(λ, ϱ, i, j) *
-            Tα(N,i)^-1 *
+        inv(A, Ta(λ, i)) *
-            Ta(N, j)^-1
+        Tα(λ, i) *
+        Ta(λ, i) *
+        inv(A, Te(λ, ϱ, i, j)) *
+        inv(A, Tα(λ, i)) *
+        inv(A, Ta(λ, j))
     elseif id === :B
         if !minus
             if i ≠ j
-                    x = Ta(N, j) * Ta(N, i)^-1 * Tα(N, j) * Te(G,i,j)
+                x = Ta(λ, j) * inv(A, Ta(λ, i)) * Tα(λ, j) * Te(λ, ϱ, i, j)
-                    δ = x * Tα(N, i) * x^-1
+                δ = x * Tα(λ, i) * inv(A, x)
-                    Tα(N, i) * Tα(N, j) * inv(δ)
+                Tα(λ, i) * Tα(λ, j) * inv(A, δ)
             else
-                    Tα(N, i)^-1
+                inv(A, Tα(λ, i))
             end
         else
             if i ≠ j
-                    Ta(N, i) * Ta(N, j) * Te(G, i, j)^-1
+                Ta(λ, i) * Ta(λ, j) * inv(A, Te(λ, ϱ, i, j))
             else
-                    Ta(N, i)
+                Ta(λ, i)
             end
         end
     else
         throw("Type not recognized: $id")
     end
 
-        res = new(id, i, j, minus, inv,
+    g = sautFn(w)
 
+    d = ntuple(i->gens(Σ, i), ngens(Σ))
 
-        )
+    img = evaluate!(deepcopy(d), g)
+    invim = evaluate!(d, inv(g))
+
+    img, invim = inverse ? (invim, img) : (img, invim)
+
+    res = SymplecticMappingClass(id, UInt(i), UInt(j), minus, inverse, img, invim)
 
     return res
 end
-end
 
-_indexing(n) = [(i, j) for i = 1:n for j in 1:n if i ≠ j]
+function Base.show(io::IO, smc::SymplecticMappingClass)
-_indexing_increasing(n) = [(i, j) for i = 1:n for j = i+1:n]
+    smc.minus && print(io, 'm')
-
+    if  smc.i < 10 && smc.j < 10
-_λs(N, A) = [ (i == j ? "aaaarggh..." : Word([A[λ(i, j)]])) for i = 1:N, j = 1:N]
+        print(io, smc.id, subscriptify(smc.i), subscriptify(smc.j))
-_ϱs(N, A) = [ (i == j ? "aaaarggh..." : Word([A[ϱ(i, j)]])) for i = 1:N, j = 1:N]
-
-function Te_diagonal(G, i::Integer)
-    N = ngens(object(G))
-    # @assert N == size(λ, 1) == size(ϱ, 1)
-    @assert iseven(N)
-    n = N ÷ 2
-    j = i + 1
-    @assert 1 <= i < n
-
-    A = KnuthBendix.alphabet(G)
-    λ = _λs(N, A)
-    ϱ = _ϱs(N, A)
-
-    # comments are for i,j = 1,2
-    g = one(word_type(G))
-    g *= λ[n+j, n+i]                   # β ↦ α*β
-    g *= λ[n+i, i] * inv(A, ϱ[n+i, j]) # α ↦ a*α*b^-1
-    g *= inv(A, λ[n+j, n+i])           # β ↦ b*α^-1*a^-1*α*β
-    g *= λ[j, n+i] * inv(A, λ[j, i])   # b ↦ α
-    g *= inv(A, λ[j, n+i])             # b ↦ b*α^-1*a^-1*α
-    g *= inv(A, ϱ[j, n+i]) * ϱ[j, i]   # b ↦ b*α^-1*a^-1*α*b*α^-1
-    g *= ϱ[j, n+i]                     # b ↦ b*α^-1*a^-1*α*b*α^-1*a*α*b^-1
-    return G(g)
-end
-
-function Te_lantern(b₀::T, a₁::T, a₂::T, a₃::T, a₄::T, a₅::T) where {T}
-    a₀ = (a₁ * a₂ * a₃)^4 * b₀^-1
-    X = a₄ * a₅ * a₃ * a₄
-    b₁ = X^-1 * a₀ * X
-    Y = a₂ * a₃ * a₁ * a₂
-    return Y^-1 * b₁ * Y # b₂
-end
-
-Ta(N, i::Integer) = λ[N÷2+i, i]
-Tα(N, i::Integer, λ, A) = inv(A, λ[i, N÷2+i])
-
-function Te(G, i, j)
-    @assert i ≠ j
-    i, j = i < j ? (i, j) : (j, i)
-
-    N = ngens(object(G))
-
-    A = KnuthBendix.alphabet(G)
-    λ = _λs(N, A)
-    ϱ = _ϱs(N, A)
-
-    if j == i + 1
-        return Te_diagonal(G, i)
     else
-        return Te_lantern(
+        print(io, smc.id, subscriptify(smc.i), ".", subscriptify(smc.j))
-            Ta(N, i + 1, λ),
-            Ta(N, i, λ),
-            Tα(N, i, λ, A),
-            Te(N, i, i + 1),
-            Tα(N, i + 1, λ, A),
-            Te(N, i + 1, j),
-        )
     end
+    smc.inv && print(io, "^-1")
 end
 
-function mcg_twists(genus::Integer)
+function Base.inv(m::SymplecticMappingClass)
-    genus < 3 && throw("Not Implemented: genus = $genus < 3")
+    return SymplecticMappingClass(m.id, m.i, m.j, m.minus, !m.inv, m.invimages, m.images)
-
+end
-    G = SpecialAutomorphismGroup(FreeGroup(2genus))
+
-    A = KnuthBendix.alphabet(G)
+function evaluate!(
-
+    t::NTuple{N,T},
-    λ = _λs(G)
+    smc::SymplecticMappingClass,
-    ϱ = _ϱs(G)
+    A::Alphabet,
-
+    tmp = one(first(t)),
-    Tas = [Ta(G, i, λ) for i in 1:genus]
+) where {N,T}
-    Tαs = [Tα(G, i, λ, A) for i in 1:genus]
+    img = smc.inv ? smc.invimages : smc.images
-
+
-    Tes = [Te(G, i, j, λ, ϱ) for (i,j) in _indexing_increasing(genus)]
+    # need a map from generators to letters of the alphabet!
-
+    # TODO: move to SymplecticMappingClass
-    return Tas, Tαs, Tes
+    gens_idcs = let G = parent(first(t))
+        Dict(A[G.gens[i]] => i for i in 1:ngens(G))
+    end
+
+    for elt in t
+        copyto!(tmp, elt)
+        resize!(word(elt), 0)
+        for idx in word(tmp)
+            # @show idx
+            k = if haskey(gens_idcs, idx)
+                img[gens_idcs[idx]]
+            else
+                inv(img[gens_idcs[inv(A, idx)]])
+            end
+            append!(word(elt), word(k))
+        end
+        _setnormalform!(elt, false)
+        _setvalidhash!(elt, false)
+
+        normalform!(tmp, elt)
+        copyto!(elt, tmp)
+    end
+
+    return t
 end