Merge pull request #19 from kalmarek/enh/mcg

Add broader support for automorphism groups

Project.toml

@@ -1,28 +1,29 @@
 name = "Groups"
 uuid = "5d8bd718-bd84-11e8-3b40-ad14f4a32557"
 authors = ["Marek Kaluba <[email protected]>"]
-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"
 Random = "9a3f8284-a2c9-5f02-9a11-845980a1fd5c"
 ThreadsX = "ac1d9e8a-700a-412c-b207-f0111f4b6c0d"
 
 [compat]
-AbstractAlgebra = "0.15, 0.16"
-GroupsCore = "^0.3"
-KnuthBendix = "^0.2.1"
+AbstractAlgebra = "0.22"
+GroupsCore = "0.4"
+KnuthBendix = "0.3"
 OrderedCollections = "1"
-ThreadsX = "^0.1.0"
-julia = "1.3, 1.4, 1.5, 1.6"
+PermutationGroups = "0.3"
+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,14 +10,15 @@ 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")
 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