Merge pull request #19 from kalmarek/enh/mcg

Add broader support for automorphism groups

Project.toml

@@ -1,10 +1,9 @@
 name = "Groups"
 uuid = "5d8bd718-bd84-11e8-3b40-ad14f4a32557"
 authors = ["Marek Kaluba <kalmar@amu.edu.pl>"]
-version = "0.6.0"
+version = "0.7.0"
 
 [deps]
-AbstractAlgebra = "c3fe647b-3220-5bb0-a1ea-a7954cac585d"
 GroupsCore = "d5909c97-4eac-4ecc-a3dc-fdd0858a4120"
 KnuthBendix = "c2604015-7b3d-4a30-8a26-9074551ec60a"
 OrderedCollections = "bac558e1-5e72-5ebc-8fee-abe8a469f55d"
@@ -12,17 +11,19 @@ Random = "9a3f8284-a2c9-5f02-9a11-845980a1fd5c"
 ThreadsX = "ac1d9e8a-700a-412c-b207-f0111f4b6c0d"
 
 [compat]
-AbstractAlgebra = "0.15, 0.16"
+AbstractAlgebra = "0.22"
-GroupsCore = "^0.3"
+GroupsCore = "0.4"
-KnuthBendix = "^0.2.1"
+KnuthBendix = "0.3"
 OrderedCollections = "1"
-ThreadsX = "^0.1.0"
+PermutationGroups = "0.3"
-julia = "1.3, 1.4, 1.5, 1.6"
+ThreadsX = "0.1"
+julia = "1.3"
 
 [extras]
 AbstractAlgebra = "c3fe647b-3220-5bb0-a1ea-a7954cac585d"
 BenchmarkTools = "6e4b80f9-dd63-53aa-95a3-0cdb28fa8baf"
+PermutationGroups = "8bc5a954-2dfc-11e9-10e6-cd969bffa420"
 Test = "8dfed614-e22c-5e08-85e1-65c5234f0b40"
 
 [targets]
-test = ["Test", "BenchmarkTools", "AbstractAlgebra"]
+test = ["Test", "BenchmarkTools", "AbstractAlgebra", "PermutationGroups"]

src/Groups.jl

@@ -10,7 +10,7 @@ import Random
 import OrderedCollections: OrderedSet
 
 export Alphabet, AutomorphismGroup, FreeGroup, FreeGroup, FPGroup, FPGroupElement, SpecialAutomorphismGroup
-export alphabet, evaluate, word
+export alphabet, evaluate, word, gens
 
 include("types.jl")
 include("hashing.jl")
@@ -18,6 +18,7 @@ include("normalform.jl")
 include("autgroups.jl")
 
 include("groups/sautFn.jl")
+include("groups/mcg.jl")
 
 include("wl_ball.jl")
 end # of module Groups

src/autgroups.jl

@@ -14,7 +14,7 @@ end
 object(G::AutomorphismGroup) = G.group
 rewriting(G::AutomorphismGroup) = G.rws
 
-function equality_data(f::FPGroupElement{<:AutomorphismGroup})
+function equality_data(f::AbstractFPGroupElement{<:AutomorphismGroup})
     imf = evaluate(f)
     # return normalform!.(imf)
 
@@ -26,7 +26,7 @@ function equality_data(f::FPGroupElement{<:AutomorphismGroup})
     return imf
 end
 
-function Base.:(==)(g::A, h::A) where {A<:FPGroupElement{<:AutomorphismGroup}}
+function Base.:(==)(g::A, h::A) where {A<:AbstractFPGroupElement{<:AutomorphismGroup}}
     @assert parent(g) === parent(h)
 
     if _isvalidhash(g) && _isvalidhash(h)
@@ -70,7 +70,7 @@ function Base.:(==)(g::A, h::A) where {A<:FPGroupElement{<:AutomorphismGroup}}
     return equal
 end
 
-function Base.isone(g::FPGroupElement{<:AutomorphismGroup})
+function Base.isone(g::AbstractFPGroupElement{<:AutomorphismGroup})
     if length(word(g)) > 8
         normalform!(g)
     end
@@ -79,29 +79,157 @@ end
 
 # eye-candy
 
-Base.show(io::IO, ::Type{<:FPGroupElement{<:AutomorphismGroup{T}}}) where {T} =
+Base.show(io::IO, ::Type{<:AbstractFPGroupElement{<:AutomorphismGroup{T}}}) where {T} =
     print(io, "Automorphism{$T,…}")
 
 Base.show(io::IO, A::AutomorphismGroup) = print(io, "automorphism group of ", object(A))
 
+function Base.show(io::IO, ::MIME"text/plain", a::AbstractFPGroupElement{<:AutomorphismGroup})
+    println(io, " ┌ $(a):")
+    d = domain(a)
+    im = evaluate(a)
+    for (x, imx) in zip(d, im[1:end-1])
+        println(io, " │   $x ↦ $imx")
+    end
+    println(io, " └   $(last(d)) ↦ $(last(im))")
+end
+
 ## Automorphism Evaluation
 
-domain(f::FPGroupElement{<:AutomorphismGroup}) = deepcopy(parent(f).domain)
+domain(f::AbstractFPGroupElement{<:AutomorphismGroup}) = deepcopy(parent(f).domain)
 # tuple(gens(object(parent(f)))...)
 
-evaluate(f::FPGroupElement{<:AutomorphismGroup}) = evaluate!(domain(f), f)
+evaluate(f::AbstractFPGroupElement{<:AutomorphismGroup}) = evaluate!(domain(f), f)
 
 function evaluate!(
     t::NTuple{N,T},
-    f::FPGroupElement{<:AutomorphismGroup{<:Group}},
+    f::AbstractFPGroupElement{<:AutomorphismGroup{<:Group}},
     tmp = one(first(t)),
-) where {N, T}
+) where {N, T<:FPGroupElement}
     A = alphabet(f)
-    AF = alphabet(object(parent(f)))
     for idx in word(f)
-        t = @inbounds evaluate!(t, A[idx], AF, tmp)::NTuple{N,T}
+        t = @inbounds evaluate!(t, A[idx], tmp)::NTuple{N,T}
     end
     return t
 end
 
-evaluate!(t::NTuple{N, T}, s::GSymbol, A, tmp=one(first(t))) where {N, T} = throw("you need to implement `evaluate!(::$(typeof(t)), ::$(typeof(s)), ::Alphabet, tmp=one(first(t)))`")
+evaluate!(t::NTuple{N, T}, s::GSymbol, tmp=nothing) where {N, T} = throw("you need to implement `evaluate!(::$(typeof(t)), ::$(typeof(s)), ::Alphabet, tmp=one(first(t)))`")
+
+# forward evaluate by substitution
+
+struct LettersMap{T, A}
+    indices_map::Dict{Int, T}
+    A::A
+end
+
+function LettersMap(a::FPGroupElement{<:AutomorphismGroup})
+    dom = domain(a)
+    @assert all(isone ∘ length ∘ word, dom)
+    A = alphabet(first(dom))
+    first_letters = first.(word.(dom))
+    img = evaluate!(dom, a)
+
+    # (dom[i] → img[i] is a map from domain to images)
+    # we need a map from alphabet indices → (gens, gens⁻¹) → images
+    # here we do it for elements of the domain
+    # (trusting it's a set of generators that define a)
+    @assert length(dom) == length(img)
+
+    indices_map = Dict(A[A[fl]] => word(im) for (fl, im) in zip(first_letters, img))
+    # inverses of generators are dealt lazily in getindex
+
+    return LettersMap(indices_map, A)
+end
+
+
+function Base.getindex(lm::LettersMap, i::Integer)
+    # here i is an index of an alphabet
+    @boundscheck 1 ≤ i ≤ length(KnuthBendix.letters(lm.A))
+
+    if !haskey(lm.indices_map, i)
+        img = if haskey(lm.indices_map, inv(lm.A, i))
+            inv(lm.A, lm.indices_map[inv(lm.A, i)])
+        else
+            @warn "LetterMap: neither $i nor its inverse has assigned value"
+            one(valtype(lm.indices_map))
+        end
+        lm.indices_map[i] = img
+    end
+    return lm.indices_map[i]
+end
+
+function (a::FPGroupElement{<:AutomorphismGroup})(g::FPGroupElement)
+    @assert object(parent(a)) === parent(g)
+    img_w = evaluate(word(g), LettersMap(a))
+    return parent(g)(img_w)
+end
+
+evaluate(w::AbstractWord, lm::LettersMap) = evaluate!(one(w), w, lm)
+
+function evaluate!(res::AbstractWord, w::AbstractWord, lm::LettersMap)
+    for i in w
+        append!(res, lm[i])
+    end
+    return res
+end
+
+# compile automorphisms
+
+compiled(a) = eval(generated_evaluate(a))
+
+function generated_evaluate(a::FPGroupElement{<:AutomorphismGroup})
+    lm = Groups.LettersMap(a)
+    d = Groups.domain(a)
+    @assert all(length.(word.(d)) .== 1)
+    A = alphabet(first(d))
+    first_ltrs = first.(word.(d))
+
+    args = [Expr(:call, :*) for _ in first_ltrs]
+
+    for (idx, letter) in enumerate(first_ltrs)
+        for l in lm[letter]
+            k = findfirst(==(l), first_ltrs)
+            if k !== nothing
+                push!(args[idx].args, :(d[$k]))
+                continue
+            end
+            k = findfirst(==(inv(A, l)), first_ltrs)
+            if k !== nothing
+                push!(args[idx].args, :(inv(d[$k])))
+                continue
+            end
+            throw("Letter $l doesn't seem to be mapped anywhere!")
+        end
+    end
+    locals = Dict{Expr, Symbol}()
+    locals_counter = 0
+    for (i,v) in enumerate(args)
+        @assert length(v.args) >= 2
+        if length(v.args) > 2
+            for (j, a) in pairs(v.args)
+                if a isa Expr &&  a.head == :call "$a"
+                    @assert a.args[1] == :inv
+                    if !(a in keys(locals))
+                        locals[a] = Symbol("var_#$locals_counter")
+                        locals_counter += 1
+                    end
+                    v.args[j] = locals[a]
+                end
+            end
+        else
+            args[i] = v.args[2]
+        end
+    end
+
+    q = quote
+        $([:(local $v = $k) for (k,v) in locals]...)
+    end
+
+    # return args, locals
+
+    return :(d -> begin
+        @boundscheck @assert length(d) == $(length(d))
+        $q
+        @inbounds tuple($(args...))
+    end)
+end

src/groups/mcg.jl

@@ -0,0 +1,103 @@
+struct SurfaceGroup{T, S, R} <: AbstractFPGroup
+    genus::Int
+    boundaries::Int
+    gens::Vector{T}
+    relations::Vector{<:Pair{S,S}}
+    rws::R
+end
+
+include("symplectic_twists.jl")
+
+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
+
+    # The (confluent) rewriting systems comes from
+    # S. Hermiller, Rewriting systems for Coxeter groups
+    # Journal of Pure and Applied Algebra
+    # Volume 92, Issue 2, 7 March 1994, Pages 137-148
+    # https://doi.org/10.1016/0022-4049(94)90019-1
+    # Note: the notation is "inverted":
+    # a_g of the article becomes A_g here.
+
+    ltrs = String[]
+    for i in 1:genus
+        subscript = join('₀'+d for d in reverse(digits(i)))
+        append!(ltrs, ["A" * subscript, "a" * subscript, "B" * subscript, "b" * subscript])
+    end
+    Al = Alphabet(reverse!(ltrs))
+
+    for i in 1:genus
+        subscript = join('₀'+d for d in reverse(digits(i)))
+        KnuthBendix.set_inversion!(Al, "a" * subscript, "A" * subscript)
+        KnuthBendix.set_inversion!(Al, "b" * subscript, "B" * subscript)
+    end
+
+    if boundaries == 0
+        word = Int[]
+
+        for i in reverse(1:genus)
+            x = 4 * i
+            append!(word, [x, x-2, x-1, x-3])
+        end
+        comms = Word(word)
+        word_rels = [ comms => one(comms) ]
+
+        rws = KnuthBendix.RewritingSystem(word_rels, KnuthBendix.RecursivePathOrder(Al))
+        KnuthBendix.knuthbendix!(rws)
+    elseif boundaries == 1
+        S = typeof(one(Word(Int[])))
+        word_rels = Pair{S, S}[]
+        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(S::SurfaceGroup) = S.rws
+KnuthBendix.alphabet(S::SurfaceGroup) = alphabet(rewriting(S))
+relations(S::SurfaceGroup) = S.relations
+
+function symplectic_twists(π₁Σ::SurfaceGroup)
+    g = genus(π₁Σ)
+
+    saut = SpecialAutomorphismGroup(FreeGroup(2g), maxrules=100)
+
+    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 1:g if i≠j]
+
+    mBij = [SymplecticMappingClass(saut, :B, i, j, minus=true) for i in 1:g for j in 1:g if i≠j]
+
+    Bii  = [SymplecticMappingClass(saut, :B, i, i) for i in 1:g]
+
+    mBii = [SymplecticMappingClass(saut, :B, i, i, minus=true) for i in 1:g]
+
+    return [Aij; Bij; mBij; Bii; mBii]
+end
+
+KnuthBendix.alphabet(G::AutomorphismGroup{<:SurfaceGroup}) = rewriting(G)
+
+function AutomorphismGroup(π₁Σ::SurfaceGroup; kwargs...)
+    S = vcat(symplectic_twists(π₁Σ)...)
+    A = Alphabet(S)
+
+    # this is to fix the definitions of symplectic twists:
+    # with i->gens(π₁Σ, i) the corresponding automorphisms return
+    # reversed words
+    domain = ntuple(i->inv(gens(π₁Σ, i)), 2genus(π₁Σ))
+    return AutomorphismGroup(π₁Σ, S, A, domain)
+end

src/groups/sautFn.jl

@@ -7,8 +7,10 @@ function SpecialAutomorphismGroup(F::FreeGroup; ordering = KnuthBendix.LenLex, k
     A, rels = gersten_relations(n, commutative = false)
     S = KnuthBendix.letters(A)[1:2(n^2-n)]
 
+    maxrules = 1000*n
+
     rws = KnuthBendix.RewritingSystem(rels, ordering(A))
-    KnuthBendix.knuthbendix!(rws; kwargs...)
+    KnuthBendix.knuthbendix!(rws; maxrules=maxrules, kwargs...)
     return AutomorphismGroup(F, S, rws, ntuple(i -> gens(F, i), n))
 end
 

src/groups/symplectic_twists.jl

@@ -0,0 +1,269 @@
+struct ΡΛ
+    id::Symbol
+    A::Alphabet
+    N::Int
+end
+
+function Base.getindex(rl::ΡΛ, i::Integer, j::Integer)
+    @assert 1 ≤ i ≤ rl.N "Got $i > $(rl.N)"
+    @assert 1 ≤ j ≤ rl.N "Got $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(λ::Groups.ΡΛ, ϱ::Groups.ΡΛ, i::Integer)
+    @assert λ.N == ϱ.N
+    @assert λ.id == :λ && ϱ.id == :ϱ
+
+    N = λ.N
+    @assert iseven(N)
+    A = λ.A
+    n = N ÷ 2
+    j = i + 1
+
+    if i == n
+        τ = rotation_element(λ, ϱ)
+        return inv(A, τ) * Te_diagonal(λ, ϱ, 1) * τ
+    end
+
+    @assert 1 <= i < n
+
+    NI = (2n - 2i) + 1
+    NJ = (2n - 2j) + 1
+    I = (2n - 2i) + 2
+    J = (2n - 2j) + 2
+
+    g = one(Word(Int[]))
+    g *= λ[NJ, NI]                    # β ↦ α*β
+    g *= λ[NI, I] * inv(A, ϱ[NI, J])  # α ↦ a*α*b^-1
+    g *= inv(A, λ[NJ, NI])            # β ↦ b*α^-1*a^-1*α*β
+    g *= λ[J, NI] * inv(A, λ[J, I])   # b ↦ α
+    g *= inv(A, λ[J, NI])             # b ↦ b*α^-1*a^-1*α
+    g *= inv(A, ϱ[J, NI]) * ϱ[J, I]   # b ↦ b*α^-1*a^-1*α*b*α^-1
+    g *= ϱ[J, NI]                     # 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₄ # from Primer
+    b₁ = inv(A, X) * a₀ * X # from Primer
+    Y = a₂ * a₃ * a₁ * a₂
+    return inv(A, Y) * b₁ * Y # b₂ from Primer
+end
+
+function Ta(λ::Groups.ΡΛ, i::Integer)
+    @assert λ.id == :λ;
+    return λ[mod1(λ.N-2i+1, λ.N), mod1(λ.N-2i+2, λ.N)]
+end
+
+function Tα(λ::Groups.ΡΛ, i::Integer)
+    @assert λ.id == :λ;
+    return inv(λ.A, λ[mod1(λ.N-2i+2, λ.N), mod1(λ.N-2i+1, λ.N)])
+end
+
+function Te(λ::ΡΛ, ϱ::ΡΛ, i, j)
+    @assert i ≠ j
+
+    @assert λ.N == ϱ.N
+    @assert λ.A == ϱ.A
+    @assert λ.id == :λ && ϱ.id == :ϱ
+
+    @assert iseven(λ.N)
+    genus = λ.N÷2
+    i = mod1(i, genus)
+    j = mod1(j, genus)
+
+    @assert 1 ≤ i ≤ λ.N
+    @assert 1 ≤ j ≤ λ.N
+
+    A = λ.A
+
+    if mod(j - (i + 1), genus) == 0
+        return Te_diagonal(λ, ϱ, i)
+    else
+        return inv(A, Te_lantern(
+            A,
+            # Our notation:               # Primer notation:
+            inv(A, Ta(λ, i + 1)),         # b₀
+            inv(A, Ta(λ, i)),             # a₁
+            inv(A, Tα(λ, i)),             # a₂
+            inv(A, Te_diagonal(λ, ϱ, i)), # a₃
+            inv(A, Tα(λ, i + 1)),         # a₄
+            inv(A, Te(λ, ϱ, i + 1, j)),   # a₅
+        ))
+    end
+end
+
+"""
+    rotation_element(G::AutomorphismGroup{<:FreeGroup})
+Return the element of `G` which corresponds to shifting generators of the free group.
+
+In the corresponding mapping class group this element acts by rotation of the surface anti-clockwise.
+"""
+function rotation_element(G::AutomorphismGroup{<:FreeGroup})
+
+    A = alphabet(G)
+    @assert iseven(ngens(object(G)))
+    genus = ngens(object(G)) ÷ 2
+
+    λ = ΡΛ(:λ, A, 2genus)
+    ϱ = ΡΛ(:ϱ, A, 2genus)
+
+    return G(rotation_element(λ, ϱ))
+end
+
+function rotation_element(λ::ΡΛ, ϱ::ΡΛ)
+    @assert iseven(λ.N)
+    genus = λ.N÷2
+    A = λ.A
+
+    halftwists = map(1:genus-1) do i
+        j = i + 1
+        x = Ta(λ, j) * inv(A, Ta(λ, i)) * Tα(λ, j) * Te_diagonal(λ, ϱ, i)
+        δ = x * Tα(λ, i) * inv(A, x)
+        c =
+            inv(A, Ta(λ, j)) *
+            Te(λ, ϱ, i, j) *
+            Tα(λ, i)^2 *
+            inv(A, δ) *
+            inv(A, Ta(λ, j)) *
+            Ta(λ, i) *
+            δ
+        z =
+            Te_diagonal(λ, ϱ, i) *
+            inv(A, Ta(λ, i)) *
+            Tα(λ, i) *
+            Ta(λ, i) *
+            inv(A, Te_diagonal(λ, ϱ, i))
+
+        Ta(λ, i) * inv(A, Ta(λ, j) * Tα(λ, j))^6 * (Ta(λ, j) * Tα(λ, j) * z)^4 * c
+    end
+
+    τ = (Ta(λ, 1) * Tα(λ, 1))^6 * prod(halftwists)
+    return τ
+end
+
+function mcg_twists(G::AutomorphismGroup{<:FreeGroup})
+
+    @assert iseven(ngens(object(G)))
+    genus = ngens(object(G)) ÷ 2
+
+    genus < 3 && throw("Not Implemented: genus = $genus < 3")
+
+    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{T, F} <: GSymbol
+    id::Symbol # :A, :B
+    i::UInt
+    j::UInt
+    minus::Bool
+    inv::Bool
+    autFn_word::T
+    f::F
+end
+
+Base.:(==)(a::SymplecticMappingClass, b::SymplecticMappingClass) = a.autFn_word == b.autFn_word
+
+Base.hash(a::SymplecticMappingClass, h::UInt) = hash(a.autFn_word, h)
+
+function SymplecticMappingClass(
+    sautFn::AutomorphismGroup{<:FreeGroup},
+    id::Symbol,
+    i::Integer,
+    j::Integer;
+    minus = false,
+    inverse = false,
+)
+    @assert i > 0 && j > 0
+    id === :A && @assert i ≠ j
+    @assert iseven(ngens(object(sautFn)))
+    genus = ngens(object(sautFn))÷2
+
+    A = alphabet(sautFn)
+    λ = ΡΛ(:λ, A, 2genus)
+    ϱ = ΡΛ(:ϱ, A, 2genus)
+
+    w = if id === :A
+        Te(λ, ϱ, i, j) *
+        inv(A, Ta(λ, i)) *
+        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(λ, j) * inv(A, Ta(λ, i)) * Tα(λ, j) * Te(λ, ϱ, i, j)
+                δ = x * Tα(λ, i) * inv(A, x)
+                Tα(λ, i) * Tα(λ, j) * inv(A, δ)
+            else
+                inv(A, Tα(λ, i))
+            end
+        else
+            if i ≠ j
+                Ta(λ, i) * Ta(λ, j) * inv(A, Te(λ, ϱ, i, j))
+            else
+                Ta(λ, i)
+            end
+        end
+    else
+        throw("Type not recognized: $id")
+    end
+
+    # w is a word defined in the context of A (= alphabet(sautFn))
+    # so this "coercion" is correct
+    a = sautFn(w)
+
+    f = compiled(a)
+    # f = t -> evaluate!(t, a)
+
+    res = SymplecticMappingClass(id, UInt(i), UInt(j), minus, inverse, a, f)
+
+    return res
+end
+
+function Base.show(io::IO, smc::SymplecticMappingClass)
+    smc.minus && print(io, 'm')
+    if  smc.i < 10 && smc.j < 10
+        print(io, smc.id, subscriptify(smc.i), subscriptify(smc.j))
+    else
+        print(io, smc.id, subscriptify(smc.i), ".", subscriptify(smc.j))
+    end
+    smc.inv && print(io, "^-1")
+end
+
+function Base.inv(m::SymplecticMappingClass)
+    inv_w = inv(m.autFn_word)
+    # f(t) = evaluate!(t, inv_w)
+    f = compiled(inv_w)
+    return SymplecticMappingClass(m.id, m.i, m.j, m.minus, !m.inv, inv_w, f)
+end
+
+function evaluate!(
+    t::NTuple{N,T},
+    smc::SymplecticMappingClass,
+    tmp=nothing,
+) where {N,T}
+    t = smc.f(t)
+    for i in 1:N
+        normalform!(t[i])
+    end
+    return t
+end

src/groups/transvections.jl

@@ -1,28 +1,18 @@
 struct Transvection <: GSymbol
     id::Symbol
-    ij::UInt8
+    i::UInt16
+    j::UInt16
     inv::Bool
 
     function Transvection(id::Symbol, i::Integer, j::Integer, inv = false)
         @assert id in (:ϱ, :λ)
-        @boundscheck @assert 0 < i <= (typemax(UInt8) >> 4)
+        return new(id, i, j, inv)
-        @boundscheck @assert 0 < j <= (typemax(UInt8) >> 4)
-        return new(id, (convert(UInt8, i) << 4) + convert(UInt8, j), inv)
     end
 end
 
 ϱ(i, j) = Transvection(:ϱ, i, j)
 λ(i, j) = Transvection(:λ, i, j)
 
-_tophalf(ij::UInt8) = (ij & 0xf0) >> 4
-_bothalf(ij::UInt8) = (ij & 0x0f)
-
-function Base.getproperty(t::Transvection, s::Symbol)
-    s === :i && return _tophalf(t.ij)
-    s === :j && return _bothalf(t.ij)
-    return Core.getfield(t, s)
-end
-
 function Base.show(io::IO, t::Transvection)
     id = if t.id === :ϱ
         'ϱ'
@@ -33,16 +23,22 @@ function Base.show(io::IO, t::Transvection)
     t.inv && print(io, "^-1")
 end
 
-Base.inv(t::Transvection) =
+Base.inv(t::Transvection) = Transvection(t.id, t.i, t.j, !t.inv)
-    Transvection(t.id, _tophalf(t.ij), _bothalf(t.ij), !t.inv)
 
 Base.:(==)(t::Transvection, s::Transvection) =
-    t.id === s.id && t.ij == s.ij && t.inv == s.inv
+    t.id === s.id && t.i == s.i && t.j == s.j && t.inv == s.inv
-Base.hash(t::Transvection, h::UInt) = hash(t.id, hash(t.ij, hash(t.inv, h)))
 
-Base.@propagate_inbounds function evaluate!(v::NTuple{T, N}, t::Transvection, A::Alphabet, tmp=one(first(v))) where {T, N}
+Base.hash(t::Transvection, h::UInt) = hash(hash(t.id, hash(t.i)), hash(t.j, hash(t.inv, h)))
+
+Base.@propagate_inbounds @inline function evaluate!(
+    v::NTuple{T,N},
+    t::Transvection,
+    tmp = one(first(v)),
+) where {T,N}
     i, j = t.i, t.j
-    @assert i ≤ length(v) && j ≤ length(v)
+    @assert 1 ≤ i ≤ length(v) && 1 ≤ j ≤ length(v)
+
+    A = alphabet(parent(first(v)))
 
     @inbounds begin
         if t.id === :ϱ
@@ -76,3 +72,24 @@ Base.@propagate_inbounds function evaluate!(v::NTuple{T, N}, t::Transvection, A:
 
     return v
 end
+
+struct PermRightAut <: GSymbol
+    perm::Vector{UInt8}
+
+    function PermRightAut(p::AbstractVector{<:Integer})
+        @assert sort(p) == 1:length(p)
+        return new(p)
+    end
+end
+
+function Base.show(io::IO, p::PermRightAut)
+    print(io, 'σ')
+    join(io, (subscriptify(Int(i)) for i in p.perm))
+end
+
+Base.inv(p::PermRightAut) = PermRightAut(invperm(p.perm))
+
+Base.:(==)(p::PermRightAut, q::PermRightAut) = p.perm == q.perm
+Base.hash(p::PermRightAut, h::UInt) = hash(p.perm, hash(PermRightAut, h))
+
+evaluate!(v::NTuple{T,N}, p::PermRightAut, tmp = nothing) where {T,N} = v[p.perm]

src/hashing.jl

@@ -1,6 +1,6 @@
 ## Hashing
 
-equality_data(g::FPGroupElement) = (normalform!(g); word(g))
+equality_data(g::AbstractFPGroupElement) = (normalform!(g); word(g))
 
 bitget(h::UInt, n::Int) = Bool((h & (1 << n)) >> n)
 bitclear(h::UInt, n::Int) = h & ~(1 << n)
@@ -14,30 +14,30 @@ bitset(h::UInt, v::Bool, n::Int) = v ? bitset(h, n) : bitclear(h, n)
 # * `savedhash & 2` (the second bit): is the hash valid?
 const __BITFLAGS_MASK = ~(~(UInt(0)) << 2)
 
-isnormalform(g::FPGroupElement) = bitget(g.savedhash, 0)
+isnormalform(g::AbstractFPGroupElement) = bitget(g.savedhash, 0)
-_isvalidhash(g::FPGroupElement) = bitget(g.savedhash, 1)
+_isvalidhash(g::AbstractFPGroupElement) = bitget(g.savedhash, 1)
 
 _setnormalform(h::UInt, v::Bool) = bitset(h, v, 0)
 _setvalidhash(h::UInt, v::Bool) = bitset(h, v, 1)
 
-_setnormalform!(g::FPGroupElement, v::Bool) = g.savedhash = _setnormalform(g.savedhash, v)
+_setnormalform!(g::AbstractFPGroupElement, v::Bool) = g.savedhash = _setnormalform(g.savedhash, v)
-_setvalidhash!(g::FPGroupElement, v::Bool) = g.savedhash = _setvalidhash(g.savedhash, v)
+_setvalidhash!(g::AbstractFPGroupElement, v::Bool) = g.savedhash = _setvalidhash(g.savedhash, v)
 
 # To update hash use this internal method, possibly only after computing the
 # normal form of `g`:
-function _update_savedhash!(g::FPGroupElement, data)
+function _update_savedhash!(g::AbstractFPGroupElement, data)
     h = hash(data, hash(parent(g)))
     h = (h << count_ones(__BITFLAGS_MASK)) | (__BITFLAGS_MASK & g.savedhash)
     g.savedhash = _setvalidhash(h, true)
     return g
 end
 
-function Base.hash(g::FPGroupElement, h::UInt)
+function Base.hash(g::AbstractFPGroupElement, h::UInt)
     _isvalidhash(g) || _update_savedhash!(g, equality_data(g))
     return hash(g.savedhash >> count_ones(__BITFLAGS_MASK), h)
 end
 
-function Base.copyto!(res::FPGroupElement, g::FPGroupElement)
+function Base.copyto!(res::AbstractFPGroupElement, g::AbstractFPGroupElement)
     @assert parent(res) === parent(g)
     resize!(word(res), length(word(g)))
     copyto!(word(res), word(g))

src/normalform.jl

@@ -2,7 +2,7 @@
     normalform!(g::FPGroupElement)
 Compute the normal form of `g`, possibly modifying `g` in-place.
 """
-@inline function normalform!(g::FPGroupElement)
+@inline function normalform!(g::AbstractFPGroupElement)
     isnormalform(g) && return g
 
     let w = one(word(g))
@@ -21,7 +21,7 @@ end
     normalform!(res::GEl, g::GEl) where GEl<:FPGroupElement
 Compute the normal fom of `g`, storing it in `res`.
 """
-function normalform!(res::GEl, g::GEl) where {GEl<:FPGroupElement}
+function normalform!(res::GEl, g::GEl) where {GEl<:AbstractFPGroupElement}
     @boundscheck @assert parent(res) === parent(g)
     if isnormalform(g)
         copyto!(res, g)
@@ -40,7 +40,7 @@ Append the normal form of `g` to word `res`, modifying `res` in place.
 
 Defaults to the rewriting in the free group.
 """
-@inline function normalform!(res::AbstractWord, g::FPGroupElement)
+@inline function normalform!(res::AbstractWord, g::AbstractFPGroupElement)
     isone(res) && isnormalform(g) && return append!(res, word(g))
     return KnuthBendix.rewrite_from_left!(res, word(g), rewriting(parent(g)))
 end

src/types.jl

@@ -57,34 +57,35 @@ Base.isfinite(::AbstractFPGroup) = (@warn "using generic isfinite(::AbstractFPGr
 
 ## FPGroupElement
 
-mutable struct FPGroupElement{G<:AbstractFPGroup,W<:AbstractWord} <: GroupElement
+abstract type AbstractFPGroupElement{Gr} <: GroupElement end
+
+mutable struct FPGroupElement{Gr<:AbstractFPGroup,W<:AbstractWord} <: AbstractFPGroupElement{Gr}
     word::W
     savedhash::UInt
-    parent::G
+    parent::Gr
 
-    FPGroupElement(word::W, G::AbstractFPGroup) where {W<:AbstractWord} =
+    FPGroupElement(word::W, G::AbstractFPGroup, hash::UInt=UInt(0)) where {W<:AbstractWord} =
-        new{typeof(G),W}(word, UInt(0), G)
-
-    FPGroupElement(word::W, hash::UInt, G::AbstractFPGroup) where {W<:AbstractWord} =
         new{typeof(G),W}(word, hash, G)
+
+    FPGroupElement{Gr, W}(word::AbstractWord, G::Gr) where {Gr, W} =
+        new{Gr, W}(word, UInt(0), G)
 end
 
-word(f::FPGroupElement) = f.word
+word(f::AbstractFPGroupElement) = f.word
 
 #convenience
-KnuthBendix.alphabet(g::FPGroupElement) = alphabet(parent(g))
+KnuthBendix.alphabet(g::AbstractFPGroupElement) = alphabet(parent(g))
 
-function Base.show(io::IO, f::FPGroupElement)
+function Base.show(io::IO, f::AbstractFPGroupElement)
     f = normalform!(f)
     KnuthBendix.print_repr(io, word(f), alphabet(f))
 end
 
 ## GroupElement Interface for FPGroupElement
 
-Base.parent(f::FPGroupElement) = f.parent
+Base.parent(f::AbstractFPGroupElement) = f.parent
-GroupsCore.parent_type(::Type{<:FPGroupElement{G}}) where {G} = G
 
-function Base.:(==)(g::FPGroupElement, h::FPGroupElement)
+function Base.:(==)(g::AbstractFPGroupElement, h::AbstractFPGroupElement)
     @boundscheck @assert parent(g) === parent(h)
     normalform!(g)
     normalform!(h)
@@ -93,20 +94,23 @@ function Base.:(==)(g::FPGroupElement, h::FPGroupElement)
 end
 
 function Base.deepcopy_internal(g::FPGroupElement, stackdict::IdDict)
-    return FPGroupElement(copy(word(g)), g.savedhash, parent(g))
+    return FPGroupElement(copy(word(g)), parent(g), g.savedhash)
 end
 
-Base.inv(g::FPGroupElement) = (G = parent(g); FPGroupElement(inv(alphabet(G), word(g)), G))
+function Base.inv(g::GEl) where GEl <: AbstractFPGroupElement
+    G = parent(g)
+    return GEl(inv(alphabet(G), word(g)), G)
+end
 
-function Base.:(*)(g::FPGroupElement, h::FPGroupElement)
+function Base.:(*)(g::GEl, h::GEl) where GEl<:AbstractFPGroupElement
     @boundscheck @assert parent(g) === parent(h)
-    return FPGroupElement(word(g) * word(h), parent(g))
+    return GEl(word(g) * word(h), parent(g))
 end
 
-GroupsCore.isfiniteorder(g::FPGroupElement) = isone(g) ? true : (@warn "using generic isfiniteorder(::FPGroupElement): the returned `false` might be wrong"; false)
+GroupsCore.isfiniteorder(g::AbstractFPGroupElement) = isone(g) ? true : (@warn "using generic isfiniteorder(::AbstractFPGroupElement): the returned `false` might be wrong"; false)
 
 # additional methods:
-Base.isone(g::FPGroupElement) = (normalform!(g); isempty(word(g)))
+Base.isone(g::AbstractFPGroupElement) = (normalform!(g); isempty(word(g)))
 
 ## Free Groups
 
@@ -157,7 +161,7 @@ relations(F::FreeGroup) = Pair{eltype(F)}[]
 # these are mathematically correct
 Base.isfinite(::FreeGroup) = false
 
-GroupsCore.isfiniteorder(g::FPGroupElement{<:FreeGroup}) = isone(g) ? true : false
+GroupsCore.isfiniteorder(g::AbstractFPGroupElement{<:FreeGroup}) = isone(g) ? true : false
 
 ## FP Groups
 

src/wl_ball.jl

@@ -6,50 +6,34 @@ word-length metric on the group generated by `S`. The ball is centered at `cente
 (by default: the identity element). `radius` and `op` keywords specify the
 radius and multiplication operation to be used.
 """
-function wlmetric_ball_serial(S::AbstractVector{T}; radius = 2, op = *) where {T}
+function wlmetric_ball_serial(S::AbstractVector{T}, center::T=one(first(S)); radius = 2, op = *) where {T}
-    @assert radius > 0
+    @assert radius >= 1
-    old = unique!([one(first(S)), S...])
+    old = unique!([center, [center*s for s in S]...])
-    sizes = [1, length(old)]
+    return _wlmetric_ball(S, old, radius, op, collect, unique!)
-    for i in 2:radius
-        new = collect(op(o, s) for o in @view(old[sizes[end-1]:end]) for s in S)
-        append!(old, new)
-        resize!(new, 0)
-        old = unique!(old)
-        push!(sizes, length(old))
-    end
-    return old, sizes[2:end]
 end
 
-function wlmetric_ball_thr(S::AbstractVector{T}; radius = 2, op = *) where {T}
+function wlmetric_ball_thr(S::AbstractVector{T}, center::T=one(first(S)); radius = 2, op = *) where {T}
-    @assert radius > 0
+    @assert radius >= 1
-    old = unique!([one(first(S)), S...])
+    old = unique!([center, [center*s for s in S]...])
+    return _wlmetric_ball(S, old, radius, op, ThreadsX.collect, ThreadsX.unique)
+end
+
+function _wlmetric_ball(S, old, radius, op, collect, unique)
     sizes = [1, length(old)]
     for r in 2:radius
-        begin
+        old = let old = old, S = S,
-            new =
+            new = collect(
-                ThreadsX.collect(op(o, s) for o in @view(old[sizes[end-1]:end]) for s in S)
+                (g = op(o, s); hash(g); g)
-            ThreadsX.foreach(hash, new)
+                for o in @view(old[sizes[end-1]:end]) for s in S
+            )
+            append!(old, new)
+            unique(old)
         end
-        append!(old, new)
-        resize!(new, 0)
-        old = ThreadsX.unique(old)
         push!(sizes, length(old))
     end
     return old, sizes[2:end]
 end
 
-function wlmetric_ball_serial(S::AbstractVector{T}, center::T; radius = 2, op = *) where {T}
-    E, sizes = wlmetric_ball_serial(S, radius = radius, op = op)
-    isone(center) && return E, sizes
-    return c .* E, sizes
-end
-
-function wlmetric_ball_thr(S::AbstractVector{T}, center::T; radius = 2, op = *) where {T}
-    E, sizes = wlmetric_ball_thr(S, radius = radius, op = op)
-    isone(center) && return E, sizes
-    return c .* E, sizes
-end
-
 function wlmetric_ball(
     S::AbstractVector{T},
     center::T = one(first(S));

test/AutFn.jl

@@ -47,7 +47,7 @@
         r = Groups.Transvection(:ϱ,i,j)
         l = Groups.Transvection(:λ,i,j)
 
-        (t::Groups.Transvection)(v::Tuple) = Groups.evaluate!(v, t, A4)
+        (t::Groups.Transvection)(v::Tuple) = Groups.evaluate!(v, t)
 
         @test      r(deepcopy(D)) == (a*b,   b, c, d)
         @test inv(r)(deepcopy(D)) == (a*b^-1,b, c, d)
@@ -144,6 +144,36 @@
         @test all(g->isone(g*inv(g)), B_2)
     end
 
+    @testset "Forward evaluate" begin
+        N = 3
+        F = FreeGroup(N)
+        G = SpecialAutomorphismGroup(F)
+
+        a = gens(G, 1) # ϱ₁₂
+
+        f = gens(F)
+
+        @test a(f[1]) == f[1]*f[2]
+        @test all(a(f[i]) == f[i] for i in 2:length(f))
+
+        S = let s = gens(G)
+            [s; inv.(s)]
+        end
+
+        @test all(
+            map(first(Groups.wlmetric_ball(S, radius=2))) do g
+                lm = Groups.LettersMap(g)
+                img = evaluate(g)
+
+                fimg = [F(lm[first(word(s))]) for s in gens(F)]
+
+                succeeded = all(img .== fimg)
+                @assert succeeded "forward evaluation of $(word(g)) failed: \n img=$img\n fimg=$(tuple(fimg...))"
+                succeeded
+            end
+        )
+    end
+
     @testset "GroupsCore conformance" begin
         test_Group_interface(A)
         g = A(rand(1:length(alphabet(A)), 10))
@@ -153,37 +183,3 @@
     end
 
 end
-
-# using Random
-# using GroupsCore
-#
-# A = New.SpecialAutomorphismGroup(FreeGroup(4), maxrules=2000, ordering=KnuthBendix.RecursivePathOrder)
-#
-# # for seed in 1:1000
-# let seed = 68
-#     N = 14
-#     Random.seed!(seed)
-#     g = A(rand(1:length(KnuthBendix.alphabet(A)), N))
-#     h = A(rand(1:length(KnuthBendix.alphabet(A)), N))
-#     @info "seed=$seed" g h
-#     @time isone(g*inv(g))
-#     @time isone(inv(g)*g)
-#     @info "" length(word(New.normalform!(g*inv(g)))) length(word(New.normalform!(inv(g)*g)))
-#     a = commutator(g, h, g)
-#     b = conj(inv(g), h) * conj(conj(g, h), g)
-#
-#     @info length(word(a))
-#     @info length(word(b))
-#
-#     w = a*inv(b)
-#     @info length(word(w))
-#     New.normalform!(w)
-#     @info length(word(w))
-#
-#
-#     #
-#     # @time ima = evaluate(a)
-#     # @time imb = evaluate(b)
-#     # @info "" a b ima imb
-#     # @time a == b
-# end

test/AutSigma3.jl

@@ -0,0 +1,75 @@
+@testset "Aut(Σ₃.₀)" begin
+    genus = 3
+
+    π₁Σ = Groups.SurfaceGroup(genus, 0)
+
+    Groups.PermRightAut(p::Perm) = Groups.PermRightAut(p.d)
+    # Groups.PermLeftAut(p::Perm) = Groups.PermLeftAut(p.d)
+    autπ₁Σ = let autπ₁Σ = AutomorphismGroup(π₁Σ)
+        pauts = let p = perm"(1,3,5)(2,4,6)"
+            [Groups.PermRightAut(p^i) for i in 0:2]
+        end
+        T = eltype(KnuthBendix.letters(alphabet(autπ₁Σ)))
+        S = eltype(pauts)
+
+        A = Alphabet(Union{T,S}[KnuthBendix.letters(alphabet(autπ₁Σ)); pauts])
+
+        autG = AutomorphismGroup(
+            π₁Σ,
+            autπ₁Σ.gens,
+            A,
+            ntuple(i->inv(gens(π₁Σ, i)), 2Groups.genus(π₁Σ))
+        )
+
+        autG
+    end
+
+    Al = alphabet(autπ₁Σ)
+    S = [gens(autπ₁Σ); inv.(gens(autπ₁Σ))]
+
+    sautFn = let ltrs = KnuthBendix.letters(Al)
+        parent(first(ltrs).autFn_word)
+    end
+
+    τ = Groups.rotation_element(sautFn)
+
+    @testset "Twists" begin
+        A = KnuthBendix.alphabet(sautFn)
+        λ = Groups.ΡΛ(:λ, A, 2genus)
+        ϱ = Groups.ΡΛ(:ϱ, A, 2genus)
+        @test sautFn(Groups.Te_diagonal(λ, ϱ, 1)) ==
+            conj(sautFn(Groups.Te_diagonal(λ, ϱ, 2)), τ)
+
+        @test sautFn(Groups.Te_diagonal(λ, ϱ, 3)) == sautFn(Groups.Te(λ, ϱ, 3, 1))
+    end
+
+    z = let d = Groups.domain(τ)
+        Groups.evaluate(τ^genus)
+    end
+
+    @test π₁Σ.(word.(z)) == Groups.domain(first(S))
+    d = Groups.domain(first(S))
+    p = perm"(1,3,5)(2,4,6)"
+    @test Groups.evaluate!(deepcopy(d), τ) == d^inv(p)
+    @test Groups.evaluate!(deepcopy(d), τ^2) == d^p
+
+    E, sizes = Groups.wlmetric_ball(S, radius=3)
+    @test sizes == [49, 1813, 62971]
+    B2 = @view E[1:sizes[2]]
+
+    σ = autπ₁Σ(Word([Al[Groups.PermRightAut(p)]]))
+
+    @test conj(S[7], σ) == S[10]
+    @test conj(S[7], σ^2) == S[11]
+    @test conj(S[9], σ) == S[12]
+    @test conj(S[9], σ^2) == S[8]
+
+    @test conj(S[1], σ) == S[4]
+    @test conj(S[1], σ^2) == S[5]
+    @test conj(S[3], σ) == S[6]
+    @test conj(S[3], σ^2) == S[2]
+
+    B2ᶜ = [conj(b, σ) for b in B2]
+    @test B2ᶜ != B2
+    @test Set(B2ᶜ) == Set(B2)
+end

test/AutSigma_41.jl

@@ -0,0 +1,189 @@
+using PermutationGroups
+using Groups.KnuthBendix
+
+@testset "Wajnryb presentation for Σ₄₁" begin
+
+    genus = 4
+
+    Fn = FreeGroup(2genus)
+    G = SpecialAutomorphismGroup(Fn)
+
+    T = Groups.mcg_twists(G)
+
+    # symplectic pairing in the free Group goes like this:
+    # f1 ↔ f5
+    # f2 ↔ f6
+    # f3 ↔ f7
+    # f4 ↔ f8
+
+    T = let G = G
+        (Tas, Tαs, Tes) = Groups.mcg_twists(G)
+        Ta = G.(Tas)
+        Tα = G.(Tαs)
+        Tes = G.(Tes)
+
+        [Ta; Tα; Tes]
+    end
+
+    a1 = T[1]^-1 # Ta₁
+    a2 = T[5]^-1 # Tα₁
+    a3 = T[9]^-1 # Te₁₂
+    a4 = T[6]^-1 # Tα₂
+    a5 = T[12]^-1 # Te₂₃
+    a6 = T[7]^-1 # Tα₃
+    a7 = T[14]^-1 # Te₃₄
+    a8 = T[8]^-1 # Tα₄
+
+    b0 = T[2]^-1 # Ta₂
+    a0 = (a1 * a2 * a3)^4 * b0^-1 # from the 3-chain relation
+    X = a4 * a5 * a3 * a4 # auxillary, not present in the Primer
+    b1 = X^-1 * a0 * X
+    b2 = T[10]^-1 # Te₁₃
+
+    As = T[[1, 5, 9, 6, 12, 7, 14, 8]] # the inverses of the elements a
+
+    @testset "preserving relator" begin
+        F = Groups.object(G)
+
+        R = prod(commutator(gens(F,2i+1), gens(F,2i+2)) for i in 0:genus-1)
+
+        for g in T
+            @test g(R) == R
+        end
+    end
+
+    @testset "commutation relations" begin
+        for (i, ai) in enumerate(As) #the element ai here is actually the inverse of ai before. It does not matter for commutativity. Also, a0 is as defined before.
+            for (j, aj) in enumerate(As)
+                if abs(i - j) > 1
+                    @test ai * aj == aj * ai
+                elseif i ≠ j
+                    @test ai * aj != aj * ai
+                end
+            end
+            if i != 4
+                @test a0 * ai == ai * a0
+            end
+        end
+    end
+
+    @testset "braid relations" begin
+        for (i, ai) in enumerate(As) #the element ai here is actually the inverse of ai before. It does not matter for braid relations.
+            for (j, aj) in enumerate(As)
+                if abs(i - j) == 1
+                    @test ai * aj * ai == aj * ai * aj
+                end
+            end
+        end
+        @test a0 * a4 * a0 == a4 * a0 * a4 # here, a0 and a4 are as before
+    end
+
+    @testset "3-chain relation" begin
+        x = a4*a3*a2*a1*a1*a2*a3*a4 # auxillary; does not have a name in the Primer
+        @test b0 == x*a0*x^-1
+    end
+
+    @testset "Lantern relation" begin
+
+        @testset "b2 definition" begin
+            @test b2 == (a2 * a3 * a1 * a2)^-1 * b1 * (a2 * a3 * a1 * a2)
+
+            # some additional tests, checking what explicitly happens to the generators of the π₁ under b2
+            d = Groups.domain(b2)
+            img = evaluate(b2)
+            z = img[3] * d[3]^-1
+
+            @test img[1] == d[1]
+            @test img[2] == d[2]
+            @test img[3] == z * d[3]
+            @test img[4] == z * d[4] * z^-1
+            @test img[5] == z * d[5] * z^-1
+            @test img[6] == z * d[6] * z^-1
+            @test img[7] == d[7] * z^-1
+            @test img[8] == d[8]
+        end
+
+        @testset "b2: commutation relations" begin
+            @test b2 * a1 == a1 * b2
+            @test b2 * a2 != a2 * b2
+            @test b2 * a3 == a3 * b2
+            @test b2 * a4 == a4 * b2
+            @test b2 * a5 == a5 * b2
+            @test b2 * a6 != a6 * b2
+        end
+
+        @testset "b2: braid relations" begin
+            @test a2 * b2 * a2 == b2 * a2 * b2
+            @test a6 * b2 * a6 == b2 * a6 * b2
+        end
+
+        @testset "lantern" begin
+            u = (a6 * a5)^-1 * b1 * (a6 * a5)
+            x = (a6 * a5 * a4 * a3 * a2 * u * a1^-1 * a2^-1 * a3^-1 * a4^-1) # yet another auxillary
+            # x = (a4^-1*a3^-1*a2^-1*a1^-1*u*a2*a3*a4*a5*a6)
+            @time evaluate(x)
+            b3 = x * a0 * x^-1
+            b3im = @time evaluate(b3)
+            b3cim = @time let g = b3
+                f = Groups.compiled(g)
+                f(Groups.domain(g))
+            end
+            @test b3im == b3cim
+            @test a0 * b2 * b1 == a1 * a3 * a5 * b3
+        end
+    end
+
+    Base.conj(t::Groups.Transvection, p::Perm) =
+        Groups.Transvection(t.id, t.i^p, t.j^p, t.inv)
+
+    function Base.conj(elt::FPGroupElement, p::Perm)
+        G = parent(elt)
+        A = alphabet(elt)
+        return G([A[conj(A[idx], p)] for idx in word(elt)])
+    end
+
+    @testset "Te₂₃ definition" begin
+        Te₁₂, Te₂₃ = T[9], T[12]
+        G = parent(Te₁₂)
+        F₈ = Groups.object(G)
+        (δ, d, γ, c, β, b, α, a) = Groups.gens(F₈)
+
+        Groups.domain(Te₁₂)
+
+        img_Te₂₃ = evaluate(Te₂₃)
+        y = c * β^-1 * b^-1 * β
+        @test img_Te₂₃ == (δ, d, y * γ, y * c * y^-1, β * y^-1, b, α, a)
+
+        σ = perm"(7,5,3)(8,6,4)"
+        Te₂₃_σ = conj(Te₁₂, σ)
+        # @test word(Te₂₃_σ) == word(Te₂₃)
+
+        @test evaluate(Te₂₃_σ) == evaluate(Te₂₃)
+        @test Te₂₃ == Te₂₃_σ
+    end
+
+    @testset "Te₃₄ definition" begin
+        Te₁₂, Te₃₄ = T[9], T[14]
+        G = parent(Te₁₂)
+        F₈ = Groups.object(G)
+        (δ, d, γ, c, β, b, α, a) = Groups.gens(F₈)
+
+        σ = perm"(7,3)(8,4)(5,1)(6,2)"
+        Te₃₄_σ = conj(Te₁₂, σ)
+        @test Te₃₄ == Te₃₄_σ
+    end
+
+    @testset "hyperelliptic τ is central" begin
+
+        τ = Groups.rotation_element(G)
+        τᵍ = τ^genus
+
+        symplectic_gens = let genus = genus, G = G
+            π₁Σ = Groups.SurfaceGroup(genus, 0)
+            s_twists = Groups.symplectic_twists(π₁Σ)
+            G.(word(t.autFn_word) for t in s_twists)
+        end
+
+        @test all(sg * τᵍ == τᵍ * sg for sg in symplectic_gens)
+    end
+end

test/fp_groups.jl

@@ -46,7 +46,10 @@
 
     @test h isa FPGroupElement
     @test_throws AssertionError h == g
-    @test_throws AssertionError h*g
+    @test_throws MethodError h*g
+
+    H′ = FPGroup(G, [aG^2=>cG, bG*cG=>aG], maxrules=200)
+    @test_throws AssertionError one(H) == one(H′)
 
     Groups.normalform!(h)
     @test h == H([5])

test/runtests.jl

@@ -26,6 +26,8 @@ include(joinpath(pathof(GroupsCore), "..", "..", "test", "conformance_test.jl"))
     include("fp_groups.jl")
 
     include("AutFn.jl")
+    include("AutSigma_41.jl")
+    include("AutSigma3.jl")
 
     # if !haskey(ENV, "CI")
     #    include("benchmarks.jl")