)abbrev domain LMOPS ListMonoidOps
++ Internal representation for monoids
++ Author: Manuel Bronstein
++ Date Created: November 1989
++ 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.
    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)


)abbrev domain FMONOID FreeMonoid
++ Free monoid on any set of generators
++ Author: Stephen M. Watt, Michel Petitot
++ 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.
++  When S is an OrderedSet, then FreeMonoid(S) has order: for two
++  elements \spad{x} and \spad{y} the relation \spad{x < y}
++  holds if either \spad{length(x) < length(y)} holds or if these lengths
++  are equal and if \spad{x} is smaller than \spad{y} w.r.t. the
++  lexicographical ordering induced by \spad{S}.
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.
        first : % -> S
          ++ \spad{first(x)} returns the first letter of \spad{x}.
        rest :  % -> %
          ++ \spad{rest(x)} returns \spad{x} except the first letter.
        mirror : % -> %
          ++ \spad{mirror(x)} returns the reversed word of \spad{x}.
        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}.
        lquo :   (%, S) -> Union(%, "failed")
          ++ \spad{lquo(x, s)} returns the exact left quotient of \spad{x}
          ++ by \spad{s}.
        rquo :   (%, S) -> Union(%, "failed")
          ++ \spad{rquo(x, s)} returns the exact right quotient
          ++ of \spad{x} by \spad{s}.
        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.
        length : % -> NNI
          ++ \spad{length(x)} returns the length of \spad{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 BasicType then
            varList : % -> List S
              ++ \spad{varList(x)} returns the list of variables of \spad{x}.
        if S has Comparable then Comparable
        if S has OrderedSet then
            OrderedMonoid
            lexico : (%, %) -> Boolean
              ++ \spad{lexico(x, y)} returns \spad{true} iff \spad{x} is
              ++ smaller than \spad{y} w.r.t. the pure lexicographical
              ++ ordering induced by \spad{S}.

    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 : % ==
            (f = 1) => g
            (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) ==
            (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) ==
            (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@%)

        lquo(w : %, l : S) ==
            x : List REC := listOfMonoms(w)$Rep
            empty?(x) => "failed"
            fx : REC := first x
            fx.gen ~= l  => "failed"
            fx.exp = 1   => makeMulti rest(x)
            makeMulti [[fx.gen, (fx.exp - 1)::NNI ]$REC, : rest x]

        rquo(w : %, l : S) ==
            u : % := reverse w
            (r := lquo (u,l)) case "failed" => "failed"
            reverse!(r@%)

        length x == reduce("+",[f.exp for f in listOfMonoms x], 0)

        if S has BasicType then

            varList1(x : %) : List(S) ==
                le : List S := [t.gen for t in listOfMonoms x]
                removeDuplicates(le)

            if S has OrderedSet then

                varList(x) == sort! varList1(x)

            else

                varList(x) == varList1(x)

        first w ==
            x : List REC := listOfMonoms w
            empty?(x) => error "empty word !!!"
            x.first.gen

        rest w ==
            x : List REC := listOfMonoms w
            empty?(x) => error "empty word !!!"
            fx : REC := first x
            fx.exp = 1 => makeMulti rest x
            makeMulti [[fx.gen, (fx.exp - 1)::NNI ]$REC, : rest x]

        mirror x == reverse(x)$Rep

        if S has Comparable then
          if S has OrderedSet then

            lexico(a, b) ==
              la := listOfMonoms a
              lb := listOfMonoms b
              while not(empty?(la)) and not(empty?(lb)) 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
                  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
                  else
                      lb := concat([lb.first.gen,
                               (lb.first.exp-la.first.exp)::NNI], rest la)
                      la := rest la
              empty? la and not empty? lb

            a < b ==               --  length, then lexicographic
                la : NNI := length a; lb : NNI := length b
                la = lb =>  lexico(a, b)
                la < lb

          else

            smaller?(a, b) ==
              la := listOfMonoms a
              lb := listOfMonoms b
              na : Integer := #la
              nb : Integer := #lb
              while na > 0 and nb > 0 repeat
                  smaller?(lb.first.gen, la.first.gen) => return false
                  smaller?(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
++ 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]]}.
        if S has Comparable then Comparable

    == 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 =>
              -- read 'r.first.exp' before the destructive 'reverse! r'
              newexp := q.first.exp + r.first.exp
              setlast!(h := reverse! r, [q.first.gen, newexp])
              makeMulti concat!(h, rest q)
            makeMulti concat!(reverse! r, q)

        -- deglex order (with respect to block length)
        if S has Comparable then
          smaller?(a, b) ==
            la := listOfMonoms a
            lb := listOfMonoms b
            na : Integer := #la
            nb : Integer := #lb
            na < nb => return true
            nb < na => return false
            -- case of equal length
            while not empty? la repeat
                smaller?(la.first.gen, lb.first.gen) => return true
                smaller?(lb.first.gen, la.first.gen) => return false
                la.first.exp < lb.first.exp => return true
                lb.first.exp < la.first.exp => return false
                la:= rest la
                lb:= rest lb
            false


--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.
