)abbrev category MRCAT MonoidRingCategory
++ Authors: Stephan M. Watt; revised by Johannes Grabmeier
++ Date Created: January 1986
++ Basic Operations: *, +, monomials, coefficients
++ Related Constructors: Polynomial
++ Also See:
++ AMS Classifications:
++ Keywords: monoid ring, group ring, polynomials in non-commuting
++  indeterminates
++ References:
++ Description:
++  \spadtype{MonoidRingCategory}(R, M) defines the algebra
++  of all maps from the monoid M to the commutative ring R with
++  finite support.
MonoidRingCategory(R : Ring, M : Monoid) : Category == MRCdefinition where
    Term ==> Record(k : M, c : R)

    MRCdefinition == Join(Ring, RetractableTo M, RetractableTo R) with
        monomial         : (R, M) -> %
          ++ monomial(r, m) creates a scalar multiple of the basis element m.
        coefficient : (%, M) -> R
          ++ coefficient(f, m) extracts the coefficient of m in f with respect
          ++ to the canonical basis M.
        coerce :   List Term -> %
          ++ coerce(lt) converts a list of terms and coefficients to a member of the domain.
        terms       : % -> List Term
          ++ terms(f) gives the list of non-zero coefficients combined
          ++ with their corresponding basis element as records.
          ++ This is the internal representation.
        map         : (R -> R, %) -> %
          ++ map(fn, u) maps function fn onto the coefficients
          ++ of the non-zero monomials of u.
        monomial?   : % -> Boolean
          ++ monomial?(f) tests if f is a single monomial.
        coefficients : % -> List R
          ++ coefficients(f) lists all non-zero coefficients.
        monomials : % -> List %
           ++ monomials(f) gives the list of all monomials whose
           ++ sum is f.
        numberOfMonomials : % -> NonNegativeInteger
           ++ numberOfMonomials(f) is the number of non-zero coefficients
           ++ with respect to the canonical basis.
        if R has CharacteristicZero then CharacteristicZero
        if R has CharacteristicNonZero then CharacteristicNonZero
        if R has CommutativeRing then Algebra(R)
        if R has CommutativeRing and M has CommutativeStar then
            CommutativeRing
        if (R has Finite and M has Finite) then Finite
        if M has Comparable then
          FreeModuleCategory(R, M)

)abbrev domain MRING MonoidRing
++ Authors: Stephan M. Watt; revised by Johannes Grabmeier
++ Date Created: January 1986
++ Basic Operations: *, +, monomials, coefficients
++ Related Constructors: Polynomial
++ Also See:
++ AMS Classifications:
++ Keywords: monoid ring, group ring, polynomials in non-commuting
++  indeterminates
++ References:
++ Description:
++  \spadtype{MonoidRing}(R, M), implements the algebra
++  of all maps from the monoid M to the commutative ring R with
++  finite support.
++  Multiplication of two maps f and g is defined
++  to map an element c of M to the (convolution) sum over {\em f(a)g(b)}
++  such that {\em ab = c}. Thus M can be identified with a canonical
++  basis and the maps can also be considered as formal linear combinations
++  of the elements in M. Scalar multiples of a basis element are called
++  monomials. A prominent example is the class of polynomials
++  where the monoid is a direct product of the natural numbers
++  with pointwise addition. When M is
++  \spadtype{FreeMonoid Symbol}, one gets polynomials
++  in infinitely many non-commuting variables. Another application
++  area is representation theory of finite groups G, where modules
++  over \spadtype{MonoidRing}(R, G) are studied.
MonoidRing(R : Ring, M : Monoid) : MonoidRingCategory(R, M) == MRdefinition where
    Term ==> Record(k : M, c : R)

    MRdefinition ==> add
        Ex ==> OutputForm
        Cf ==> c
        Mn ==> k

        Rep := List Term

        rep(x:%):Rep == x :: Rep
        per(r:Rep):% == r :: %

        characteristic() == characteristic()$R

        coerce(x : List Term) : % == per x

        monomial(r : R, m : M)  ==
          r = 0 => empty()
          [[m, r]]

        monomial?(x) ==
            #(rep(x)) <= 1

        if (R has Finite and M has Finite) then
          size() == size()$R ^ size()$M

          index i0 ==
            -- use p-adic decomposition of k
            -- coefficient of p^j determines coefficient of index(i+p)$M
            i : Integer := i0 rem size()
            p : Integer := size()$R
            n : Integer := size()$M
            ans : % := 0
            for j in 0.. while i > 0 repeat
              h := i rem p
              -- we use index(p) = 0$R
              if h ~= 0 then
                cf : R := index(h :: PositiveInteger)$R
                m : M := index((j+n) :: PositiveInteger)$M
                --ans := ans + c *$% m
                ans := ans + monomial(cf, m)$%
              i := i quo p
            ans

          lookup(z : %) : PositiveInteger ==
            -- could be improved, if M has OrderedSet
            -- z = index lookup z, n = lookup index n
            -- use p-adic decomposition of k
            -- coefficient of p^j determines coefficient of index(i+p)$M
            zero?(z) => qcoerce(size()$%)@PositiveInteger
            liTe : List Term := terms z  -- all non-zero coefficients
            p  : Integer := size()$R
            n  : Integer := size()$M
            res : Integer := 0
            for te in liTe repeat
              -- assume that lookup(p)$R = 0
              l : NonNegativeInteger := lookup(te.Mn)$M
              ex : NonNegativeInteger := (n = l => 0;l)
              co : Integer := lookup(te.Cf)$R
              res := res + co * p ^ ex
            qcoerce(res)@PositiveInteger

        0                   == empty()
        1                   == [[1, 1]]
--        terms a             == (copy a) pretend List(Term)
        terms a             == copy rep a
        monomials a         == [[t] for t in a]
        coefficients a      == [t.Cf for t in a]
        coerce(m : M) : %       == [[m, 1]]
        coerce(r : R) : % ==
        -- coerce of ring
          r = 0 => 0
          [[1, r]]
        coerce(n : Integer) : % ==
        -- coerce of integers
          n = 0 => 0
          [[1, n::R]]
        - a                 == [[t.Mn, -t.Cf] for t in a]
        if R has noZeroDivisors
           then
            (r : R) * (a : %) ==
              r = 0 => 0
              [[t.Mn, r*t.Cf] for t in a]
           else
            (r : R) * (a : %) ==
              r = 0 => 0
              [[t.Mn, rt] for t in a | (rt := r*t.Cf) ~= 0]
        if R has noZeroDivisors
           then
            (n : Integer) * (a : %) ==
              n = 0 => 0
              [[t.Mn, n*t.Cf] for t in a]
           else
            (n : Integer) * (a : %) ==
              n = 0 => 0
              [[t.Mn, nt] for t in a | (nt := n*t.Cf) ~= 0]
        map(f, a)           == [[t.Mn, ft] for t in a | (ft := f(t.Cf)) ~= 0]
        numberOfMonomials a == #a

        retractIfCan(a:%):Union(M, "failed") ==
          ((#a) = 1) and ((a.first.Cf) = 1) => a.first.Mn
          "failed"

        retractIfCan(a:%):Union(R, "failed") ==
          ((#a) = 1) and ((a.first.Mn) = 1) => a.first.Cf
          "failed"

        if R has noZeroDivisors then
          if M has Group then
            recip a ==
              lt := terms a
              #lt ~= 1 => "failed"
              (u := recip lt.first.Cf) case "failed" => "failed"
              --(u::R) * inv lt.first.Mn
              monomial((u::R), inv lt.first.Mn)$%
          else
            recip a ==
              #a ~= 1 or a.first.Mn ~= 1 => "failed"
              (u := recip a.first.Cf) case "failed" => "failed"
              u::R::%

        mkTerm(r : R, m : M) : Ex ==
            r = 1 => m::Ex
            r = 0 or m = 1 => r::Ex
            r::Ex * m::Ex

        coerce(a : %) : Ex ==
            empty? a => (0$Integer)::Ex
            empty? rest a => mkTerm(a.first.Cf, a.first.Mn)
            reduce(_+, [mkTerm(t.Cf, t.Mn) for t in a])$List(Ex)

        if M has Comparable then
            -- Terms are stored in descending order.
            leadingCoefficient a == (empty? a => 0; a.first.Cf)
            leadingSupport a    == (empty? a => 1; a.first.Mn)
            leadingMonomial a    ==
                empty? rep a => error "empty support"
                monomial((first rep a).Cf, (first rep a).Mn)

            leadingTerm a    ==
                empty? a => error "empty support"
                a.first

            reductum a           == (empty? a => a; rest a)

            listOfTerms a == rep a

            support a == [t.k for t in rep a]

            constructOrdered(x : List Term) : % == per x

            termless(t1:Term, t2:Term):Boolean == smaller?(t1.k, t2.k)

            construct(x : List Term) : % ==
                xs : List Term := sort(termless, x)
                res : List Term := empty()
                -- find duplicates
                while not empty? xs repeat
                    t1:= first xs
                    xs := rest xs
                    while not empty? xs repeat
                        t2:= first xs
                        if t1.k = t2.k then
                           t1.c:= t1.c+t2.c
                           xs:= rest xs
                        else break
                    if not zero? t1.c then
                        res := cons (t1, res)
                res

            if R has CommutativeRing then
                f : M -> R
                x : %
                t : Term
                linearExtend(f, x) ==
                    zero? x => 0
                    res : R := 0
                    for t in rep x repeat
                        res := res + (t.Cf)*f(t.Mn)
                    res

            a = b ==
                #rep a ~= #rep b => false
                for ta in rep a for tb in rep b repeat
                    ta.Cf ~= tb.Cf or ta.Mn ~= tb.Mn => return false
                true

            a + b ==
                repa:Rep := rep a
                repb:Rep := rep b
                res : Rep := empty()
                while not empty? repa and not empty? repb repeat
                  ta:Term := first repa; tb:Term := first repb
                  ra:Rep := rest repa;  rb:Rep := rest repb
                  res :=
                    smaller?(tb.Mn, ta.Mn)  => (repa := ra; concat!(res, ta))
                    smaller?(ta.Mn, tb.Mn) => (repb := rb; concat!(res, tb))
                    repa := ra; repb := rb
                    not zero?(r := ta.Cf + tb.Cf) =>
                                        concat!(res, [ta.Mn, r])
                    res
                per concat!(res, concat(repa, repb))

            coefficient(a, m) ==
                for t in a repeat
                    if t.Mn = m then return t.Cf
                    if smaller?(t.Mn, m) then return 0
                0


            if M has OrderedMonoid then

            -- we use that multiplying an ordered list of monoid elements
            -- by a single element respects the ordering

              if R has noZeroDivisors then
                a : % * b : % ==
                  +/[[[ta.Mn*tb.Mn, ta.Cf*tb.Cf]$Term
                    for tb in b ] for ta in reverse a]
              else
                a : % * b : % ==
                  +/[[[ta.Mn*tb.Mn, r]$Term
                    for tb in b | not zero?(r := ta.Cf*tb.Cf)]
                      for ta in reverse a]
            else -- M hasn't OrderedMonoid

            -- we cannot assume that mutiplying an ordered list of
            -- monoid elements by a single element respects the ordering:
            -- we have to order and to collect equal terms
              ge : (Term, Term) -> Boolean
              ge(s, t) == not smaller? (s.Mn, t.Mn)

              sortAndAdd : List Term -> List Term
              sortAndAdd(liTe) ==  -- assume liTe not empty
                liTe := sort(ge, liTe)
                m : M :=  (first liTe).Mn
                cf : R := (first liTe).Cf
                res : List Term := []
                for te in rest liTe repeat
                  if m = te.Mn then
                    cf := cf + te.Cf
                  else
                    if not zero? cf then res := cons([m, cf]$Term, res)
                    m := te.Mn
                    cf := te.Cf
                if not zero? cf then res := cons([m, cf]$Term, res)
                reverse res


              if R has noZeroDivisors then
                a : % * b : % ==
                  zero? a => a
                  zero? b => b  -- avoid calling sortAndAdd with []
                  +/[sortAndAdd [[ta.Mn*tb.Mn, ta.Cf*tb.Cf]$Term
                    for tb in b ] for ta in reverse a]
              else
                a : % * b : % ==
                  zero? a => a
                  zero? b => b  -- avoid calling sortAndAdd with []
                  +/[sortAndAdd [[ta.Mn*tb.Mn, r]$Term
                    for tb in b | not zero?(r := ta.Cf*tb.Cf)]
                      for ta in reverse a]


        else -- M hasn't OrderedSet
            -- Terms are stored in random order.
          a = b ==
            #a ~= #b => false
            set(a pretend List(Term)) =$Set(Term) set(b pretend List(Term))

          coefficient(a, m) ==
            for t in a repeat
              t.Mn = m => return t.Cf
            0

          addterm(Tabl : AssociationList(M, R), r : R, m : M) : R ==
              (u := search(m, Tabl)) case "failed" => Tabl.m := r
              zero?(r := r + u::R) => (remove!(m, Tabl); 0)
              Tabl.m := r

          a + b ==
              Tabl := table()$AssociationList(M, R)
              for t in rep a repeat
                  Tabl t.Mn := t.Cf
              for t in rep b repeat
                  addterm(Tabl, t.Cf, t.Mn)
              [[m, Tabl m]$Term for m in keys Tabl]

          a : % * b : % ==
              Tabl := table()$AssociationList(M, R)
              for ta in a repeat
                  for tb in (b pretend List(Term)) repeat
                      addterm(Tabl, ta.Cf*tb.Cf, ta.Mn*tb.Mn)
              [[m, Tabl.m]$Term for m in keys Tabl]

)abbrev package MRF2 MonoidRingFunctions2
++ Author: Johannes Grabmeier
++ Date Created: 14 May 1991
++ Basic Operations: map
++ Related Constructors:
++ Also See:
++ AMS Classifications:
++ Keywords: monoid ring, group ring, change of coefficient domain
++ References:
++ Description:
++  MonoidRingFunctions2 implements functions between
++  two monoid rings defined with the same monoid over different rings.
MonoidRingFunctions2(R, S, M) : Exports == Implementation where
    R  : Ring
    S  : Ring
    M  : Monoid
    Exports ==> with
      map : (R -> S, MonoidRing(R, M)) -> MonoidRing(S, M)
        ++ map(f, u) maps f onto the coefficients f the element
        ++ u of the monoid ring to create an element of a monoid
        ++ ring with the same monoid b.
    Implementation ==> add
      map(fn, u) ==
        res : MonoidRing(S, M) := 0
        for te in terms u repeat
          res := res + monomial(fn(te.c), te.k)
        res

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