Monoids.jl

module Monoids

using KnuthBendix
import KnuthBendix: Alphabet, AbstractWord, LenLex, alphabet

export Alphabet, FreeMonoid, gens

# this should go to KnuthBendix.jl
Base.convert(::Type{Word{I}}, v::AbstractVector{<:Integer}) where I = Word{I}(v)


abstract type AbstractMonoid{I} end

# types and constructors

struct FreeMonoid{I, A} <: AbstractMonoid{I}
    alphabet::A
    function FreeMonoid{I}(a::Alphabet) where I<:Integer
        length(a) < typemax(UInt16) || throw("Too many letters in alphabet. Try with $(widen(I))")
        return new{I, typeof(a)}(a)
    end
end

FreeMonoid(a::Alphabet) = FreeMonoid{UInt16}(a)
FreeMonoid(n::Integer)  = FreeMonoid(Alphabet([Symbol('a', i) for i in 1:n]))

const Relation{I} = Pair{Word{I}, Word{I}}

struct Monoid{I, A, R} <: AbstractMonoid{I}
    alphabet::A
    relations::Vector{Relation{I}} # in case you need them later
    rws::R
end

mutable struct MonoidElement{I, M}
    word::Word{I}
    parent::M
    reduced::Bool

    MonoidElement{I}(w::AbstractVector, M::AbstractMonoid, reduced=false) where I =
        new{I, typeof(M)}(convert(Word{I}, w), M, reduced)
end

# coercing to monoid
(M::AbstractMonoid{I})(w::AbstractVector{<:Integer}, reduced=false) where I =
    MonoidElement{I}(w, M, reduced)

# Accessors and basic manipulation
KnuthBendix.alphabet(M::FreeMonoid) = M.alphabet
KnuthBendix.alphabet(M::Monoid) = M.alphabet
rewriting(M::Monoid) = M.rws
Base.parent(m::MonoidElement) = m.parent

Base.one(M::AbstractMonoid{I}) where I = M(one(Word{I}), true)
Base.one(m::MonoidElement) = one(parent(m))

gens(M::AbstractMonoid) = [M([i], true) for i in 1:length(alphabet(M))]

word(m::MonoidElement) where I = m.word


# actual user-constructors for Monoid:

Base.:(/)(m::FreeMonoid{I}, rels::AbstractArray{<:MonoidElement}) where I =
    m/[r=>one(m) for r in rels]

function Base.:(/)(
    m::FreeMonoid{I},
    rels::AbstractArray{<:Pair{<:MonoidElement, <:MonoidElement}},
    ordering=LenLex;
    kwargs...) where {I}
    A = m.alphabet
    new_rels = Relation{I}[word(first(r))=>word(last(r)) for r in rels]

    rws = RewritingSystem(
        new_rels,
        ordering(alphabet(m))
    )

    rws = KnuthBendix.knuthbendix!(rws; kwargs...)

    return Monoid(A, new_rels, rws)
end

Base.show(io::IO, M::FreeMonoid) =
    print(io, "free monoid over $(alphabet(M))");
Base.show(io::IO, M::Monoid) =
    print(io, "monoid with $(length(M.relations)) relations over $(alphabet(M))");

function Base.:(*)(m1::MonoidElement, m2::MonoidElement)
    parent(m1) === parent(m2) || throw("cannot multiply elements from different monoids")
    return parent(m1)(word(m1)*word(m2))
end

Base.:(^)(m::MonoidElement, n::Integer) = Base.power_by_squaring(m, n)

"""
    normalform!(m::MonoidElement)
Reduce `m` to its normalform, as defined by the rewriting of `parent(m)`.
"""
normalform!(m::MonoidElement{I, <:FreeMonoid}) where I = m

function normalform!(m::MonoidElement)
    m.reduced && return m
    w = copy(m.word)
    resize!(m.word, 0)
    www = KnuthBendix.rewrite_from_left!(m.word, w, rewriting(parent(m)))
    m.reduced = true
    return m
end
function normalform!(m::MonoidElement)
    m.reduced && return m
    w = copy(m.word)
    resize!(m.word, 0)
    www = KnuthBendix.rewrite_from_left!(m.word, w, rewriting(parent(m)))
    m.reduced = true
    return m
end

Base.show(io::IO, m::MonoidElement{I, <:FreeMonoid}) where I =
    print(io, KnuthBendix.string_repr(word(m), alphabet(parent(m))))

function Base.show(io::IO, m::MonoidElement)
    m = normalform!(m)
    print(io, KnuthBendix.string_repr(word(m), alphabet(parent(m))))
end


end # of module Monoids