--Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
--All rights reserved.
--
--Redistribution and use in source and binary forms, with or without
--modification, are permitted provided that the following conditions are
--met:
--
--    - Redistributions of source code must retain the above copyright
--      notice, this list of conditions and the following disclaimer.
--
--    - Redistributions in binary form must reproduce the above copyright
--      notice, this list of conditions and the following disclaimer in
--      the documentation and/or other materials provided with the
--      distribution.
--
--    - Neither the name of The Numerical ALgorithms Group Ltd. nor the
--      names of its contributors may be used to endorse or promote products
--      derived from this software without specific prior written permission.
--
--THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
--IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
--TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
--PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
--OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
--EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
--PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
--PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
--LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
--NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
--SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

)abbrev domain LMOPS ListMonoidOps
++ Internal representation for monoids
++ Author: Manuel Bronstein
++ Date Created: November 1989
++ Date Last Updated: 6 June 1991
++ Description:
++ This internal package represents monoid (abelian or not, with or
++ without inverses) as lists and provides some common operations
++ to the various flavors of monoids.
ListMonoidOps(S, E, un): Exports == Implementation where
  S : SetCategory
  E : AbelianMonoid
  un: E

  REC ==> Record(gen:S, exp: E)
  O   ==> OutputForm

  Exports ==> Join(SetCategory, RetractableTo S) with
    outputForm    : ($, (O, O) -> O, (O, O) -> O, Integer) -> O
      ++ outputForm(l, fop, fexp, unit) converts the monoid element
      ++ represented by l to an \spadtype{OutputForm}.
      ++ Argument unit is the output form
      ++ for the \spadignore{unit} of the monoid (e.g. 0 or 1),
      ++ \spad{fop(a, b)} is the
      ++ output form for the monoid operation applied to \spad{a} and b
      ++ (e.g. \spad{a + b}, \spad{a * b}, \spad{ab}),
      ++ and \spad{fexp(a, n)} is the output form
      ++ for the exponentiation operation applied to \spad{a} and n
      ++ (e.g. \spad{n a}, \spad{n * a}, \spad{a ** n}, \spad{a\^n}).
    listOfMonoms  : $ -> List REC
      ++ listOfMonoms(l) returns the list of the monomials forming l.
    makeTerm      : (S, E) -> $
      ++ makeTerm(s, e) returns the monomial s exponentiated by e
      ++ (e.g. s^e or e * s).
    makeMulti     : List REC -> $
      ++ makeMulti(l) returns the element whose list of monomials is l.
    nthExpon      : ($, Integer) -> E
      ++ nthExpon(l, n) returns the exponent of the n^th monomial of l.
    nthFactor     : ($, Integer) -> S
      ++ nthFactor(l, n) returns the factor of the n^th monomial of l.
    reverse       : $ -> $
      ++ reverse(l) reverses the list of monomials forming l. This
      ++ has some effect if the monoid is non-abelian, i.e.
      ++ \spad{reverse(a1\^e1 ... an\^en) = an\^en ... a1\^e1} which is different.
    reverse!     : $ -> $
      ++ reverse!(l) reverses the list of monomials forming l, destroying
      ++ the element l.
    size          : $ -> NonNegativeInteger
      ++ size(l) returns the number of monomials forming l.
    makeUnit      : () -> $
      ++ makeUnit() returns the unit element of the monomial.
    rightMult     : ($, S) -> $
      ++ rightMult(a, s) returns \spad{a * s} where \spad{*}
      ++ is the monoid operation,
      ++ which is assumed non-commutative.
    leftMult      : (S, $) -> $
      ++ leftMult(s, a) returns \spad{s * a} where
      ++ \spad{*} is the monoid operation,
      ++ which is assumed non-commutative.
    plus          : (S, E, $) -> $
      ++ plus(s, e, x) returns \spad{e * s + x} where \spad{+}
      ++ is the monoid operation,
      ++ which is assumed commutative.
    plus          : ($, $) -> $
      ++ plus(x, y) returns \spad{x + y} where \spad{+}
      ++ is the monoid operation,
      ++ which is assumed commutative.
    commutativeEquality: ($, $) -> Boolean
      ++ commutativeEquality(x,y) returns true if x and y are equal
      ++ assuming commutativity
    mapExpon      : (E -> E, $) -> $
      ++ mapExpon(f, a1\^e1 ... an\^en) returns \spad{a1\^f(e1) ... an\^f(en)}.
    mapGen        : (S -> S, $) -> $
      ++ mapGen(f, a1\^e1 ... an\^en) returns \spad{f(a1)\^e1 ... f(an)\^en}.

  Implementation ==> add
    Rep := List REC

    localplus: ($, $) -> $

    makeUnit()       == empty()$Rep
    size l           == # listOfMonoms l
    coerce(s:S):$    == [[s, un]]
    coerce(l:$):O    == coerce(l)$Rep
    makeTerm(s, e)   == (zero? e => makeUnit(); [[s, e]])
    makeMulti l      == l
    f = g            == f =$Rep g
    listOfMonoms l   == l pretend List(REC)
    nthExpon(f, i)   == f.(i-1+minIndex f).exp
    nthFactor(f, i)  == f.(i-1+minIndex f).gen
    reverse l        == reverse(l)$Rep
    reverse! l      == reverse!(l)$Rep
    mapGen(f, l)     == [[f(x.gen), x.exp] for x in l]

    mapExpon(f, l) ==
      ans:List(REC) := empty()
      for x in l repeat
        if (a := f(x.exp)) ~= 0 then ans := concat([x.gen, a], ans)
      reverse! ans

    outputForm(l, op, opexp, id) ==
      empty? l => id::OutputForm
      l:List(O) :=
         [(p.exp = un => p.gen::O; opexp(p.gen::O, p.exp::O)) for p in l]
      reduce(op, l)

    retractIfCan(l:$):Union(S, "failed") ==
      not empty? l and empty? rest l and l.first.exp = un => l.first.gen
      "failed"

    rightMult(f, s) ==
      empty? f => s::$
      s = f.last.gen => (setlast!(h := copy f, [s, f.last.exp + un]); h)
      concat(f, [s, un])

    leftMult(s, f) ==
      empty? f => s::$
      s = f.first.gen => concat([s, f.first.exp + un], rest f)
      concat([s, un], f)

    commutativeEquality(s1:$, s2:$):Boolean ==
      #s1 ~= #s2 => false
      for t1 in s1 repeat
          if not member?(t1,s2) then return false
      true

    plus!(s:S, n:E, f:$):$ ==
      h := g := concat([s, n], f)
      h1 := rest h
      while not empty? h1 repeat
        s = h1.first.gen =>
          l :=
            zero?(m := n + h1.first.exp) => rest h1
            concat([s, m], rest h1)
          setrest!(h, l)
          return rest g
        h := h1
        h1 := rest h1
      g

    plus(s, n, f) == plus!(s,n,copy f)

    plus(f, g) ==
      #f < #g => localplus(f, g)
      localplus(g, f)

    localplus(f, g) ==
      g := copy g
      for x in f repeat
        g := plus(x.gen, x.exp, g)
      g

)abbrev category FMONCAT FreeMonoidCategory
++ Free monoid on any set of generators
++ Author: Stephen M. Watt, Gabriel Dos Reis
++ Date Created: September 26, 2009
++ Date Last Updated: September 26, 2009
++ Description:
++   A free monoid on a set S is the monoid of finite products of
++   the form \spad{reduce(*,[si ** ni])} where the si's are in S, and the ni's
++   are nonnegative integers. The multiplication is not commutative.
FreeMonoidCategory(S: SetCategory): Category == Exports where
  macro NNI == NonNegativeInteger
  macro REC == Record(gen: S, exp: NonNegativeInteger)
  macro Ex  == OutputForm

  Exports == Join(Monoid, RetractableTo S) with
    *:    (S, %) -> %
      ++ \spad{s * x} returns the product of \spad{x} by \spad{s} on the left.
    *:    (%, S) -> %
      ++ \spad{x * s} returns the product of \spad{x} by \spad{s} on the right.
    **:   (S, NonNegativeInteger) -> %
      ++ \spad{s ** n} returns the product of \spad{s} by itself \spad{n} times.
    hclf:   (%, %) -> %
      ++ \spad{hclf(x, y)} returns the highest common left factor of
      ++ \spad{x} and \spad{y},
      ++ i.e. the largest d such that \spad{x = d a} and \spad{y = d b}.
    hcrf:   (%, %) -> %
      ++ hcrf(x, y) returns the highest common right factor of x and y,
      ++ i.e. the largest d such that \spad{x = a d} and \spad{y = b d}.
    lquo:   (%, %) -> Union(%, "failed")
      ++ lquo(x, y) returns the exact left quotient of x by y i.e.
      ++ q such that \spad{x = y * q},
      ++ "failed" if x is not of the form \spad{y * q}.
    rquo:   (%, %) -> Union(%, "failed")
      ++ rquo(x, y) returns the exact right quotient of x by y i.e.
      ++ q such that \spad{x = q * y},
      ++ "failed" if x is not of the form \spad{q * y}.
    divide:   (%, %) -> Union(Record(lm: %, rm: %), "failed")
      ++ divide(x, y) returns the left and right exact quotients of
      ++ x by y, i.e. \spad{[l, r]} such that \spad{x = l * y * r},
      ++ "failed" if x is not of the form \spad{l * y * r}.
    overlap: (%, %) -> Record(lm: %, mm: %, rm: %)
      ++ overlap(x, y) returns \spad{[l, m, r]} such that
      ++ \spad{x = l * m}, \spad{y = m * r} and l and r have no overlap,
      ++ i.e. \spad{overlap(l, r) = [l, 1, r]}.
    size         :   % -> NNI
      ++ size(x) returns the number of monomials in x.
    factors      : % -> List Record(gen: S, exp: NonNegativeInteger)
      ++ factors(a1\^e1,...,an\^en) returns \spad{[[a1, e1],...,[an, en]]}.
    nthExpon     : (%, Integer) -> NonNegativeInteger
      ++ nthExpon(x, n) returns the exponent of the n^th monomial of x.
    nthFactor    : (%, Integer) -> S
      ++ nthFactor(x, n) returns the factor of the n^th monomial of x.
    mapExpon     : (NNI -> NNI, %) -> %
      ++ mapExpon(f, a1\^e1 ... an\^en) returns \spad{a1\^f(e1) ... an\^f(en)}.
    mapGen       : (S -> S, %) -> %
      ++ mapGen(f, a1\^e1 ... an\^en) returns \spad{f(a1)\^e1 ... f(an)\^en}.
    if S has OrderedSet then OrderedSet

)abbrev domain FMONOID FreeMonoid
++ Free monoid on any set of generators
++ Author: Stephen M. Watt
++ Date Created: ???
++ Date Last Updated: 6 June 1991
++ Description:
++ The free monoid on a set S is the monoid of finite products of
++ the form \spad{reduce(*,[si ** ni])} where the si's are in S, and the ni's
++ are nonnegative integers. The multiplication is not commutative.
FreeMonoid(S: SetCategory): FreeMonoidCategory(S) == FMdefinition where
    macro NNI == NonNegativeInteger
    macro REC == Record(gen: S, exp: NonNegativeInteger)
    macro Ex  == OutputForm
    FMdefinition == ListMonoidOps(S, NonNegativeInteger, 1) add
        Rep := ListMonoidOps(S, NonNegativeInteger, 1)

        1               == makeUnit()
        one? f          == empty? listOfMonoms f
        coerce(f:$): Ex == outputForm(f, "*", "**", 1)
        hcrf(f, g)      == reverse! hclf(reverse f, reverse g)
        f:$ * s:S       == rightMult(f, s)
        s:S * f:$       == leftMult(s, f)
        factors f       == copy listOfMonoms f
        mapExpon(f, x)  == mapExpon(f, x)$Rep
        mapGen(f, x)    == mapGen(f, x)$Rep
        s:S ** n:NonNegativeInteger == makeTerm(s, n)

        f:$ * g:$ ==
            one? f => g
            one? g => f
            lg := listOfMonoms g
            ls := last(lf := listOfMonoms f)
            ls.gen = lg.first.gen =>
                setlast!(h := copy lf,[lg.first.gen,lg.first.exp+ls.exp])
                makeMulti concat(h, rest lg)
            makeMulti concat(lf, lg)

        overlap(la, ar) ==
            one? la or one? ar => [la, 1, ar]
            lla := la0 := listOfMonoms la
            lar := listOfMonoms ar
            l:List(REC) := empty()
            while not empty? lla repeat
              if lla.first.gen = lar.first.gen then
                if lla.first.exp < lar.first.exp and empty? rest lla then
                      return [makeMulti l,
                               makeTerm(lla.first.gen, lla.first.exp),
                                 makeMulti concat([lar.first.gen,
                                  (lar.first.exp - lla.first.exp)::NNI],
                                                              rest lar)]
                if lla.first.exp >= lar.first.exp then
                  if (ru:= lquo(makeMulti rest lar,
                    makeMulti rest lla)) case $ then
                      if lla.first.exp > lar.first.exp then
                        l := concat!(l, [lla.first.gen,
                                  (lla.first.exp - lar.first.exp)::NNI])
                        m := concat([lla.first.gen, lar.first.exp],
                                                               rest lla)
                      else m := lla
                      return [makeMulti l, makeMulti m, ru::$]
              l  := concat!(l, lla.first)
              lla := rest lla
            [makeMulti la0, 1, makeMulti lar]

        divide(lar, a) ==
            one? a => [lar, 1]
            Na   : Integer := #(la := listOfMonoms a)
            Nlar : Integer := #(llar := listOfMonoms lar)
            l:List(REC) := empty()
            while Na <= Nlar repeat
              if llar.first.gen = la.first.gen and
                 llar.first.exp >= la.first.exp then
                -- Can match a portion of this lar factor.
                -- Now match tail.
                (q:=lquo(makeMulti rest llar,makeMulti rest la))case $ =>
                   if llar.first.exp > la.first.exp then
                       l := concat!(l, [la.first.gen,
                                  (llar.first.exp - la.first.exp)::NNI])
                   return [makeMulti l, q::$]
              l    := concat!(l, first llar)
              llar  := rest llar
              Nlar := Nlar - 1
            "failed"

        hclf(f, g) ==
            h:List(REC) := empty()
            for f0 in listOfMonoms f for g0 in listOfMonoms g repeat
                f0.gen ~= g0.gen => return makeMulti h
                h := concat!(h, [f0.gen, min(f0.exp, g0.exp)])
                f0.exp ~= g0.exp => return makeMulti h
            makeMulti h

        lquo(aq, a) ==
            size a > #(laq := copy listOfMonoms aq) => "failed"
            for a0 in listOfMonoms a repeat
                a0.gen ~= laq.first.gen or a0.exp > laq.first.exp =>
                                                          return "failed"
                if a0.exp = laq.first.exp then laq := rest laq
                else setfirst!(laq, [laq.first.gen,
                                         (laq.first.exp - a0.exp)::NNI])
            makeMulti laq

        rquo(qa, a) ==
            (u := lquo(reverse qa, reverse a)) case "failed" => "failed"
            reverse!(u::$)

        if S has OrderedSet then
          a < b ==
            la := listOfMonoms a
            lb := listOfMonoms b
            na: Integer := #la
            nb: Integer := #lb
            while positive? na and positive? nb repeat
                la.first.gen > lb.first.gen => return false
                la.first.gen < lb.first.gen => return true
                if la.first.exp = lb.first.exp then
                    la:=rest la
                    lb:=rest lb
                    na:=na - 1
                    nb:=nb - 1
                else if la.first.exp > lb.first.exp then
                    la:=concat([la.first.gen,
                           (la.first.exp - lb.first.exp)::NNI], rest lb)
                    lb:=rest lb
                    nb:=nb - 1
                else
                    lb:=concat([lb.first.gen,
                             (lb.first.exp-la.first.exp)::NNI], rest la)
                    la:=rest la
                    na:=na-1
            empty? la and not empty? lb

)abbrev domain FGROUP FreeGroup
++ Free group on any set of generators
++ Author: Stephen M. Watt
++ Date Created: ???
++ Date Last Updated: 6 June 1991
++ Description:
++ The free group on a set S is the group of finite products of
++ the form \spad{reduce(*,[si ** ni])} where the si's are in S, and the ni's
++ are integers. The multiplication is not commutative.
FreeGroup(S: SetCategory): Join(Group, RetractableTo S) with
        *:    (S, $) -> $
          ++ s * x returns the product of x by s on the left.
        *:    ($, S) -> $
          ++ x * s returns the product of x by s on the right.
        **         : (S, Integer) -> $
          ++ s ** n returns the product of s by itself n times.
        size         : $ -> NonNegativeInteger
          ++ size(x) returns the number of monomials in x.
        nthExpon     : ($, Integer) -> Integer
          ++ nthExpon(x, n) returns the exponent of the n^th monomial of x.
        nthFactor    : ($, Integer) -> S
          ++ nthFactor(x, n) returns the factor of the n^th monomial of x.
        mapExpon     : (Integer -> Integer, $) -> $
          ++ mapExpon(f, a1\^e1 ... an\^en) returns \spad{a1\^f(e1) ... an\^f(en)}.
        mapGen       : (S -> S, $) -> $
          ++ mapGen(f, a1\^e1 ... an\^en) returns \spad{f(a1)\^e1 ... f(an)\^en}.
        factors      : $ -> List Record(gen: S, exp: Integer)
          ++ factors(a1\^e1,...,an\^en) returns \spad{[[a1, e1],...,[an, en]]}.
    == ListMonoidOps(S, Integer, 1) add
        Rep := ListMonoidOps(S, Integer, 1)

        1                       == makeUnit()
        one? f                  == empty? listOfMonoms f
        s:S ** n:Integer        == makeTerm(s, n)
        f:$ * s:S               == rightMult(f, s)
        s:S * f:$               == leftMult(s, f)
        inv f                   == reverse! mapExpon("-", f)
        factors f               == copy listOfMonoms f
        mapExpon(f, x)          == mapExpon(f, x)$Rep
        mapGen(f, x)            == mapGen(f, x)$Rep
        coerce(f:$):OutputForm  == outputForm(f, "*", "**", 1)

        f:$ * g:$ ==
            one? f => g
            one? g => f
            r := reverse listOfMonoms f
            q := copy listOfMonoms g
            while not empty? r and not empty? q and r.first.gen = q.first.gen
                and r.first.exp = -q.first.exp repeat
                     r := rest r
                     q := rest q
            empty? r => makeMulti q
            empty? q => makeMulti reverse! r
            r.first.gen = q.first.gen =>
              setlast!(h := reverse! r,
                                [q.first.gen, q.first.exp + r.first.exp])
              makeMulti concat!(h, rest q)
            makeMulti concat!(reverse! r, q)

)abbrev category FAMONC FreeAbelianMonoidCategory
++ Category for free abelian monoid on any set of generators
++ Author: Manuel Bronstein
++ Date Created: November 1989
++ Date Last Updated: 6 June 1991
++ Description:
++ A free abelian monoid on a set S is the monoid of finite sums of
++ the form \spad{reduce(+,[ni * si])} where the si's are in S, and the ni's
++ are in a given abelian monoid. The operation is commutative.
FreeAbelianMonoidCategory(S: SetCategory, E:CancellationAbelianMonoid): Category ==
  Join(CancellationAbelianMonoid, RetractableTo S) with
        +        : (S, $) -> $
          ++ s + x returns the sum of s and x.
        *        : (E, S) -> $
          ++ e * s returns e times s.
        size       : $ -> NonNegativeInteger
          ++ size(x) returns the number of terms in x.
          ++ mapGen(f, a1\^e1 ... an\^en) returns \spad{f(a1)\^e1 ... f(an)\^en}.
        terms      : $ -> List Record(gen: S, exp: E)
          ++ terms(e1 a1 + ... + en an) returns \spad{[[a1, e1],...,[an, en]]}.
        nthCoef    : ($, Integer) -> E
          ++ nthCoef(x, n) returns the coefficient of the n^th term of x.
        nthFactor  : ($, Integer) -> S
          ++ nthFactor(x, n) returns the factor of the n^th term of x.
        coefficient: (S, $) -> E
          ++ coefficient(s, e1 a1 + ... + en an) returns ei such that
          ++ ai = s, or 0 if s is not one of the ai's.
        mapCoef    : (E -> E, $) -> $
          ++ mapCoef(f, e1 a1 +...+ en an) returns
          ++ \spad{f(e1) a1 +...+ f(en) an}.
        mapGen     : (S -> S, $) -> $
          ++ mapGen(f, e1 a1 +...+ en an) returns
          ++ \spad{e1 f(a1) +...+ en f(an)}.
        if E has OrderedAbelianMonoid then
          highCommonTerms: ($, $) -> $
            ++ highCommonTerms(e1 a1 + ... + en an, f1 b1 + ... + fm bm) returns
            ++   \spad{reduce(+,[max(ei, fi) ci])}
            ++ where ci ranges in the intersection
            ++ of \spad{{a1,...,an}} and \spad{{b1,...,bm}}.

)abbrev domain IFAMON InnerFreeAbelianMonoid
++ Internal free abelian monoid on any set of generators
++ Author: Manuel Bronstein
++ Date Created: November 1989
++ Date Last Updated: 6 June 1991
++ Description:
++ Internal implementation of a free abelian monoid.
InnerFreeAbelianMonoid(S: SetCategory, E:CancellationAbelianMonoid, un:E):
  FreeAbelianMonoidCategory(S, E) == ListMonoidOps(S, E, un) add
        Rep := ListMonoidOps(S, E, un)

        0                          == makeUnit()
        zero? f                    == empty? listOfMonoms f
        terms f                    == copy listOfMonoms f
        nthCoef(f, i)              == nthExpon(f, i)
        nthFactor(f, i)            == nthFactor(f, i)$Rep
        s:S + f:$                  == plus(s, un, f)
        f:$ + g:$                  == plus(f, g)
        (f:$ = g:$):Boolean        == commutativeEquality(f,g)
        n:E * s:S                  == makeTerm(s, n)
        n:NonNegativeInteger * f:$ == mapExpon(n * #1, f)
        coerce(f:$):OutputForm     == outputForm(f, "+", #2 * #1, 0)
        mapCoef(f, x)              == mapExpon(f, x)
        mapGen(f, x)               == mapGen(f, x)$Rep

        coefficient(s, f) ==
          for x in terms f repeat
            x.gen = s => return(x.exp)
          0

        if E has OrderedAbelianMonoid then
          highCommonTerms(f, g) ==
            makeMulti [[x.gen, min(x.exp, n)] for x in listOfMonoms f
                          | positive?(n := coefficient(x.gen, g))]

)abbrev domain FAMONOID FreeAbelianMonoid
++ Free abelian monoid on any set of generators
++ Author: Manuel Bronstein
++ Date Created: November 1989
++ Date Last Updated: 6 June 1991
++ Description:
++ The free abelian monoid on a set S is the monoid of finite sums of
++ the form \spad{reduce(+,[ni * si])} where the si's are in S, and the ni's
++ are non-negative integers. The operation is commutative.
FreeAbelianMonoid(S: SetCategory):
  FreeAbelianMonoidCategory(S, NonNegativeInteger)
    == InnerFreeAbelianMonoid(S, NonNegativeInteger, 1)

)abbrev domain FAGROUP FreeAbelianGroup
++ Free abelian group on any set of generators
++ Author: Manuel Bronstein
++ Date Created: November 1989
++ Date Last Updated: 6 June 1991
++ Description:
++ The free abelian group on a set S is the monoid of finite sums of
++ the form \spad{reduce(+,[ni * si])} where the si's are in S, and the ni's
++ are integers. The operation is commutative.
FreeAbelianGroup(S:SetCategory): Exports == Implementation where
  Exports ==> Join(AbelianGroup, Module Integer,
                   FreeAbelianMonoidCategory(S, Integer)) with
    if S has OrderedSet then OrderedSet

  Implementation ==> InnerFreeAbelianMonoid(S, Integer, 1) add
    - f == mapCoef("-", f)

    if S has OrderedSet then
      inmax: List Record(gen: S, exp: Integer) -> Record(gen: S, exp:Integer)

      inmax l ==
        mx := first l
        for t in rest l repeat
          if t.gen > mx.gen then mx := t
        mx

      a < b ==
        zero? a  =>
          zero? b => false
          positive?((inmax terms b).exp)
        ta := inmax terms a
        zero? b => negative? ta.exp
        ta := inmax terms a
        tb := inmax terms b
        ta.gen < tb.gen => positive? tb.exp
        ta.gen > tb.gen => negative? ta.exp
        ta.exp < tb.exp => true
        ta.exp > tb.exp => false
        lc := ta.exp * ta.gen
        (a - lc) < (b - lc)

