\documentclass{article} \usepackage{open-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} <>= )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{A Category for Free Monoids} <>= )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 @ \section{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): 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 @ \section{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} <>= )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} <>= )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))] @ \section{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} <>= )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) @ \section{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. @ <<*>>= <> <> <> <> <> <> <> <> <> @ \eject \begin{thebibliography}{99} \bibitem{1} nothing \end{thebibliography} \end{document}