diff --git a/src/Groups.jl b/src/Groups.jl index e91e8eb..431e580 100644 --- a/src/Groups.jl +++ b/src/Groups.jl @@ -5,6 +5,7 @@ using LinearAlgebra using ThreadsX import AbstractAlgebra +import KnuthBendix export gens, FreeGroup, Aut, SAut @@ -22,12 +23,16 @@ include("arithmetic.jl") include("findreplace.jl") module New +import Groups: AutSymbol, GSymbol, λ, ϱ, RTransvect, LTransvect using DataStructures include("new_types.jl") include("new_hashing.jl") include("normalform.jl") +include("gersten_relations.jl") +include("new_autgroups.jl") + end # module New ############################################################################### diff --git a/src/gersten_relations.jl b/src/gersten_relations.jl new file mode 100644 index 0000000..ea86e6d --- /dev/null +++ b/src/gersten_relations.jl @@ -0,0 +1,108 @@ +function gersten_alphabet(n::Integer; commutative::Bool = true) + indexing = [[i, j] for i in 1:n for j in 1:n if i ≠ j] + rmuls = [ϱ(i, j) for (i, j) in indexing] + + S = if commutative + Vector{AutSymbol}(rmuls) + else + lmuls = [λ(i, j) for (i, j) in indexing] + AutSymbol[rmuls; lmuls] + end + + return Alphabet(S) +end + +function _commutation_rule( + ::Type{W}, + A::Alphabet, + x::S, + y::S, +) where {S,T,W<:AbstractWord{T}} + return W(T[A[x], A[y]]) => W(T[A[y], A[x]]) +end + +function _pentagonal_rule( + ::Type{W}, + A::Alphabet, + x::S, + y::S, + z::S, +) where {S,T,W<:AbstractWord{T}} + # x·y·x⁻¹·y⁻¹ => z, i.e. z·y·x => x·y + return W(T[A[z], A[y], A[x]]) => W(T[A[x], A[y]]) +end +function _hexagonal_rule( + ::Type{W}, + A::Alphabet, + x::S, + y::S, + z::S, + w::S, +) where {S,T,W<:AbstractWord{T}} + # x·y⁻¹·z => z·w⁻¹·x + return W(T[A[x], A[inv(y)], A[z]]) => W(T[A[z], A[w^-1], A[x]]) +end + +gersten_relations(n::Integer; commutative) = + gersten_relations(Word{UInt8}, n, commutative = commutative) + +function gersten_relations(::Type{W}, n::Integer; commutative) where {W<:AbstractWord} + @assert n > 1 "Gersten relations are defined only for n>1, got n=$n" + A = gersten_alphabet(n, commutative = commutative) + @assert length(A) <= KnuthBendix._max_alphabet_length(W) "Type $W can not represent words over alphabet with $(length(A)) letters." + + rels = Pair{W,W}[] + + for (i, j, k, l) in Iterators.product(1:n, 1:n, 1:n, 1:n) + if i ≠ j && k ≠ l && k ≠ i && k ≠ j && l ≠ i + push!(rels, _commutation_rule(W, A, ϱ(i, j), ϱ(k, l))) + + commutative && continue + + push!(rels, _commutation_rule(W, A, λ(i, j), λ(k, l))) + end + end + + if !commutative + for (i, j, k, l) in Iterators.product(1:n, 1:n, 1:n, 1:n) + if (i ≠ j && k ≠ l && k ≠ j && l ≠ i) + push!(rels, _commutation_rule(W, A, ϱ(i, j), λ(k, l))) + push!(rels, _commutation_rule(W, A, λ(i, j), ϱ(k, l))) + end + end + end + + # pentagonal rule: + # x*y*inv(x)*inv(y)=>z + + for (i, j, k) in Iterators.product(1:n, 1:n, 1:n) + if (i ≠ j && k ≠ i && k ≠ j) + push!(rels, _pentagonal_rule(W, A, ϱ(i, j)^-1, ϱ(j, k)^-1, ϱ(i, k)^-1)) + push!(rels, _pentagonal_rule(W, A, ϱ(i, j)^-1, ϱ(j, k), ϱ(i, k))) + + commutative && continue + + push!(rels, _pentagonal_rule(W, A, ϱ(i, j), λ(j, k), ϱ(i, k)^-1)) + push!(rels, _pentagonal_rule(W, A, ϱ(i, j), λ(j, k)^-1, ϱ(i, k))) + + # the same as above, but with ϱ ↔ λ: + push!(rels, _pentagonal_rule(W, A, λ(i, j)^-1, λ(j, k)^-1, λ(i, k)^-1)) + push!(rels, _pentagonal_rule(W, A, λ(i, j)^-1, λ(j, k), λ(i, k))) + + push!(rels, _pentagonal_rule(W, A, λ(i, j), ϱ(j, k), λ(i, k)^-1)) + push!(rels, _pentagonal_rule(W, A, λ(i, j), ϱ(j, k)^-1, λ(i, k))) + end + end + + if !commutative + for (i, j) in Iterators.product(1:n, 1:n) + if i ≠ j + push!(rels, _hexagonal_rule(W, A, ϱ(i, j), ϱ(j, i), λ(i, j), λ(j, i))) + w = W([A[ϱ(i, j)], A[ϱ(j, i)^-1], A[λ(i, j)]]) + push!(rels, w^2 => inv(A, w)^2) + end + end + end + + return A, rels +end diff --git a/src/new_autgroups.jl b/src/new_autgroups.jl new file mode 100644 index 0000000..4c628a0 --- /dev/null +++ b/src/new_autgroups.jl @@ -0,0 +1,129 @@ +function KnuthBendix.Alphabet(S::AbstractVector{<:GSymbol}) + S = unique!([S; inv.(S)]) + inversions = [findfirst(==(inv(s)), S) for s in S] + return Alphabet(S, inversions) +end + +struct AutomorphismGroup{G<:Group, T, R, S} <: AbstractFPGroup + group::G + gens::Vector{T} + rws::R + domain::S +end + +object(G::AutomorphismGroup) = G.group + +function SpecialAutomorphismGroup(F::FreeGroup; + ordering=KnuthBendix.LenLex, kwargs...) + + n = length(KnuthBendix.alphabet(F))÷2 + A, rels = gersten_relations(n, commutative=false) + S = KnuthBendix.letters(A)[1:2(n^2 - n)] + + rws = KnuthBendix.RewritingSystem(rels, ordering(A)) + KnuthBendix.knuthbendix!(rws; kwargs...) + return AutomorphismGroup(F, S, rws, ntuple(i->gens(F, i), n)) +end + +KnuthBendix.alphabet(G::AutomorphismGroup{<:FreeGroup}) = alphabet(rewriting(G)) +rewriting(G::AutomorphismGroup) = G.rws + +function relations(G::AutomorphismGroup) + n = length(KnuthBendix.alphabet(object(G)))÷2 + return last(gersten_relations(n, commutative=false)) +end + +_hashing_data(f::FPGroupElement{<:AutomorphismGroup}) = normalform!.(evaluate(f)) + +function Base.:(==)(g::A, h::A) where A<:FPGroupElement{<:AutomorphismGroup} + @assert parent(g) === parent(h) + + if _isvalidhash(g) && _isvalidhash(h) + hash(g) != hash(h) && return false + end + + normalform!(g) + normalform!(h) + word(g) == word(h) && return true + + @assert isnormalform(g) + @assert isnormalform(h) + + img_computed, imh_computed = false, false + + if !_isvalidhash(g) + img = _hashing_data(g) + _update_savedhash!(g, img) + img_computed = true + end + if !_isvalidhash(h) + imh = _hashing_data(h) + _update_savedhash!(h, imh) + imh_computed = true + end + + @assert _isvalidhash(g) + @assert _isvalidhash(h) + + hash(g) != hash(h) && return false + + # words are different, but hashes agree + if !img_computed + img = _hashing_data(g) + end + if !imh_computed + imh = _hashing_data(h) + end + + res = img == imh + !res && @warn "hash collision in == :" g h + + return res +end + +# eye-candy + +Base.show(io::IO, ::Type{<:FPGroupElement{<:AutomorphismGroup{T}}}) where T <: FreeGroup = print(io, "Automorphism{$T}") + +## Automorphism Evaluation + +domain(f::FPGroupElement{<:AutomorphismGroup}) = deepcopy(parent(f).domain) +# tuple(gens(object(parent(f)))...) + +evaluate(f::FPGroupElement{<:AutomorphismGroup{<:FreeGroup}}) = + evaluate!(domain(f), f) + +function evaluate!(t::NTuple{N, T}, f::FPGroupElement{<:AutomorphismGroup{<:FreeGroup}}) where {T<:FPGroupElement, N} + A = alphabet(f) + for idx in word(f) + t = evaluate!(t, A[idx])::NTuple{N, T} + end + return t +end + +function evaluate!(v::NTuple{N, T}, s::AutSymbol) where {N, T} + @assert s.pow in (-1, 1) + return evaluate!(v, s.fn, isone(s.pow))::NTuple{N, T} +end + +function evaluate!(v, ϱ::RTransvect, flag) + if flag + append!(New.word(v[ϱ.i]), New.word(v[ϱ.j] )) + else + append!(New.word(v[ϱ.i]), New.word(v[ϱ.j]^-1)) + end + _setnormalform!(v[ϱ.i], false) + _setvalidhash!(v[ϱ.i], false) + return v +end + +function evaluate!(v, λ::LTransvect, flag) + if flag + prepend!(New.word(v[λ.i]), New.word(v[λ.j] )) + else + prepend!(New.word(v[λ.i]), New.word(v[λ.j]^-1)) + end + _setnormalform!(v[λ.i], false) + _setvalidhash!(v[λ.i], false) + return v +end