Initial population.

1 files changed, 601 insertions, 0 deletions

diff --git a/src/algebra/free.spad.pamphlet b/src/algebra/free.spad.pamphlet
new file mode 100644
index 00000000..95e17711
--- /dev/null
+++ b/src/algebra/free.spad.pamphlet
@@ -0,0 +1,601 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/algebra free.spad}
+\author{Manuel Bronstein, Stephen M. Watt}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{domain LMOPS ListMonoidOps}
+<<domain LMOPS ListMonoidOps>>=
+)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
+
+@
+\section{domain FMONOID FreeMonoid}
+<<domain FMONOID FreeMonoid>>=
+)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): FMcategory == FMdefinition where
+    NNI ==> NonNegativeInteger
+    REC ==> Record(gen: S, exp: NonNegativeInteger)
+    Ex  ==> OutputForm
+
+    FMcategory ==> Join(Monoid, 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, NonNegativeInteger) -> $
+          ++ s ** n returns the product of s by itself n times.
+        hclf:   ($, $) -> $
+          ++ hclf(x, y) returns the highest common left factor of x and 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
+
+    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
+            (f = 1) => g
+--            one? g => f
+            (g = 1) => 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]
+            (la = 1) or (ar = 1) => [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]
+            (a = 1) => [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 na > 0 and nb > 0 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
+
+@
+\section{domain FGROUP FreeGroup}
+<<domain FGROUP FreeGroup>>=
+)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)
+
+@
+\section{category FAMONC FreeAbelianMonoidCategory}
+<<category FAMONC FreeAbelianMonoidCategory>>=
+)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}}.
+
+@
+\section{domain IFAMON InnerFreeAbelianMonoid}
+<<domain IFAMON InnerFreeAbelianMonoid>>=
+)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 |
+                                       (n := coefficient(x.gen, g)) > 0]
+
+@
+\section{domain FAMONOID FreeAbelianMonoid}
+<<domain FAMONOID FreeAbelianMonoid>>=
+)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)
+
+@
+\section{domain FAGROUP FreeAbelianGroup}
+<<domain FAGROUP FreeAbelianGroup>>=
+)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
+          (inmax terms b).exp > 0
+        ta := inmax terms a
+        zero? b => ta.exp < 0
+        ta := inmax terms a
+        tb := inmax terms b
+        ta.gen < tb.gen => true
+        ta.gen > tb.gen => false
+        ta.exp < tb.exp => true
+        ta.exp > tb.exp => false
+        lc := ta.exp * ta.gen
+        (a - lc) < (b - lc)
+
+@
+\section{License}
+<<license>>=
+--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.
+@
+<<*>>=
+<<license>>
+
+<<domain LMOPS ListMonoidOps>>
+<<domain FMONOID FreeMonoid>>
+<<domain FGROUP FreeGroup>>
+<<category FAMONC FreeAbelianMonoidCategory>>
+<<domain IFAMON InnerFreeAbelianMonoid>>
+<<domain FAMONOID FreeAbelianMonoid>>
+<<domain FAGROUP FreeAbelianGroup>>
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}