+\documentclass{article}

+\usepackage{axiom}

+\begin{document}

+\title{\$SPAD/src/algebra polset.spad}

+\author{Marc Moreno Maza}

+\maketitle

+\begin{abstract}

+\end{abstract}

+\eject

+\tableofcontents

+\eject

+\section{category PSETCAT PolynomialSetCategory}

+<<category PSETCAT PolynomialSetCategory>>=

+)abbrev category PSETCAT PolynomialSetCategory

+++ Author: Marc Moreno Maza

+++ Date Created: 04/26/1994

+++ Date Last Updated: 12/15/1998

+++ Basic Functions:

+++ Related Constructors:

+++ Also See:

+++ AMS Classifications:

+++ Keywords: polynomial, multivariate, ordered variables set

+++ References:

+++ Description: A category for finite subsets of a polynomial ring.

+++ Such a set is only regarded as a set of polynomials and not

+++ identified to the ideal it generates. So two distinct sets may

+++ generate the same the ideal. Furthermore, for \spad{R} being an

+++ integral domain, a set of polynomials may be viewed as a representation

+++ of the ideal it generates in the polynomial ring \spad{(R)^(-1) P},

+++ or the set of its zeros (described for instance by the radical of the

+++ previous ideal, or a split of the associated affine variety) and so on.

+++ So this category provides operations about those different notions.

+++ Version: 2

+

+PolynomialSetCategory(R:Ring, E:OrderedAbelianMonoidSup,_

+ VarSet:OrderedSet, P:RecursivePolynomialCategory(R,E,VarSet)): Category ==

+ Join(SetCategory,Collection(P),CoercibleTo(List(P))) with

+ finiteAggregate

+ retractIfCan : List(P) -> Union($,"failed")

+ ++ \axiom{retractIfCan(lp)} returns an element of the domain whose elements

+ ++ are the members of \axiom{lp} if such an element exists, otherwise

+ ++ \axiom{"failed"} is returned.

+ retract : List(P) -> $

+ ++ \axiom{retract(lp)} returns an element of the domain whose elements

+ ++ are the members of \axiom{lp} if such an element exists, otherwise

+ ++ an error is produced.

+ mvar : $ -> VarSet

+ ++ \axiom{mvar(ps)} returns the main variable of the non constant polynomial

+ ++ with the greatest main variable, if any, else an error is returned.

+ variables : $ -> List VarSet

+ ++ \axiom{variables(ps)} returns the decreasingly sorted list of the

+ ++ variables which are variables of some polynomial in \axiom{ps}.

+ mainVariables : $ -> List VarSet

+ ++ \axiom{mainVariables(ps)} returns the decreasingly sorted list of the

+ ++ variables which are main variables of some polynomial in \axiom{ps}.

+ mainVariable? : (VarSet,$) -> Boolean

+ ++ \axiom{mainVariable?(v,ps)} returns true iff \axiom{v} is the main variable

+ ++ of some polynomial in \axiom{ps}.

+ collectUnder : ($,VarSet) -> $

+ ++ \axiom{collectUnder(ps,v)} returns the set consisting of the

+ ++ polynomials of \axiom{ps} with main variable less than \axiom{v}.

+ collect : ($,VarSet) -> $

+ ++ \axiom{collect(ps,v)} returns the set consisting of the

+ ++ polynomials of \axiom{ps} with \axiom{v} as main variable.

+ collectUpper : ($,VarSet) -> $

+ ++ \axiom{collectUpper(ps,v)} returns the set consisting of the

+ ++ polynomials of \axiom{ps} with main variable greater than \axiom{v}.

+ sort : ($,VarSet) -> Record(under:$,floor:$,upper:$)

+ ++ \axiom{sort(v,ps)} returns \axiom{us,vs,ws} such that \axiom{us}

+ ++ is \axiom{collectUnder(ps,v)}, \axiom{vs} is \axiom{collect(ps,v)}

+ ++ and \axiom{ws} is \axiom{collectUpper(ps,v)}.

+ trivialIdeal?: $ -> Boolean

+ ++ \axiom{trivialIdeal?(ps)} returns true iff \axiom{ps} does

+ ++ not contain non-zero elements.

+ if R has IntegralDomain

+ then

+ roughBase? : $ -> Boolean

+ ++ \axiom{roughBase?(ps)} returns true iff for every pair \axiom{{p,q}}

+ ++ of polynomials in \axiom{ps} their leading monomials are

+ ++ relatively prime.

+ roughSubIdeal? : ($,$) -> Boolean

+ ++ \axiom{roughSubIdeal?(ps1,ps2)} returns true iff it can proved

+ ++ that all polynomials in \axiom{ps1} lie in the ideal generated by

+ ++ \axiom{ps2} in \axiom{\axiom{(R)^(-1) P}} without computing Groebner bases.

+ roughEqualIdeals? : ($,$) -> Boolean

+ ++ \axiom{roughEqualIdeals?(ps1,ps2)} returns true iff it can

+ ++ proved that \axiom{ps1} and \axiom{ps2} generate the same ideal

+ ++ in \axiom{(R)^(-1) P} without computing Groebner bases.

+ roughUnitIdeal? : $ -> Boolean

+ ++ \axiom{roughUnitIdeal?(ps)} returns true iff \axiom{ps} contains some

+ ++ non null element lying in the base ring \axiom{R}.

+ headRemainder : (P,$) -> Record(num:P,den:R)

+ ++ \axiom{headRemainder(a,ps)} returns \axiom{[b,r]} such that the leading

+ ++ monomial of \axiom{b} is reduced in the sense of Groebner bases w.r.t.

+ ++ \axiom{ps} and \axiom{r*a - b} lies in the ideal generated by \axiom{ps}.

+ remainder : (P,$) -> Record(rnum:R,polnum:P,den:R)

+ ++ \axiom{remainder(a,ps)} returns \axiom{[c,b,r]} such that \axiom{b} is fully

+ ++ reduced in the sense of Groebner bases w.r.t. \axiom{ps},

+ ++ \axiom{r*a - c*b} lies in the ideal generated by \axiom{ps}.

+ ++ Furthermore, if \axiom{R} is a gcd-domain, \axiom{b} is primitive.

+ rewriteIdealWithHeadRemainder : (List(P),$) -> List(P)

+ ++ \axiom{rewriteIdealWithHeadRemainder(lp,cs)} returns \axiom{lr} such that

+ ++ the leading monomial of every polynomial in \axiom{lr} is reduced

+ ++ in the sense of Groebner bases w.r.t. \axiom{cs} and \axiom{(lp,cs)}

+ ++ and \axiom{(lr,cs)} generate the same ideal in \axiom{(R)^(-1) P}.

+ rewriteIdealWithRemainder : (List(P),$) -> List(P)

+ ++ \axiom{rewriteIdealWithRemainder(lp,cs)} returns \axiom{lr} such that

+ ++ every polynomial in \axiom{lr} is fully reduced in the sense

+ ++ of Groebner bases w.r.t. \axiom{cs} and \axiom{(lp,cs)} and

+ ++ \axiom{(lr,cs)} generate the same ideal in \axiom{(R)^(-1) P}.

+ triangular? : $ -> Boolean

+ ++ \axiom{triangular?(ps)} returns true iff \axiom{ps} is a triangular set,

+ ++ i.e. two distinct polynomials have distinct main variables

+ ++ and no constant lies in \axiom{ps}.

+

+ add

+

+ NNI ==> NonNegativeInteger

+ B ==> Boolean

+

+ elements: $ -> List(P)

+

+ elements(ps:$):List(P) ==

+ lp : List(P) := members(ps)$$

+

+ variables1(lp:List(P)):(List VarSet) ==

+ lvars : List(List(VarSet)) := [variables(p)$P for p in lp]

+ sort(#1 > #2, removeDuplicates(concat(lvars)$List(VarSet)))

+

+ variables2(lp:List(P)):(List VarSet) ==

+ lvars : List(VarSet) := [mvar(p)$P for p in lp]

+ sort(#1 > #2, removeDuplicates(lvars)$List(VarSet))

+

+ variables (ps:$) ==

+ variables1(elements(ps))

+

+ mainVariables (ps:$) ==

+ variables2(remove(ground?,elements(ps)))

+

+ mainVariable? (v,ps) ==

+ lp : List(P) := remove(ground?,elements(ps))

+ while (not empty? lp) and (not (mvar(first(lp)) = v)) repeat

+ lp := rest lp

+ (not empty? lp)

+

+ collectUnder (ps,v) ==

+ lp : List P := elements(ps)

+ lq : List P := []

+ while (not empty? lp) repeat

+ p := first lp

+ lp := rest lp

+ if (ground?(p)) or (mvar(p) < v)

+ then

+ lq := cons(p,lq)

+ construct(lq)$$

+

+ collectUpper (ps,v) ==

+ lp : List P := elements(ps)

+ lq : List P := []

+ while (not empty? lp) repeat

+ p := first lp

+ lp := rest lp

+ if (not ground?(p)) and (mvar(p) > v)

+ then

+ lq := cons(p,lq)

+ construct(lq)$$

+

+ collect (ps,v) ==

+ lp : List P := elements(ps)

+ lq : List P := []

+ while (not empty? lp) repeat

+ p := first lp

+ lp := rest lp

+ if (not ground?(p)) and (mvar(p) = v)

+ then

+ lq := cons(p,lq)

+ construct(lq)$$

+

+ sort (ps,v) ==

+ lp : List P := elements(ps)

+ us : List P := []

+ vs : List P := []

+ ws : List P := []

+ while (not empty? lp) repeat

+ p := first lp

+ lp := rest lp

+ if (ground?(p)) or (mvar(p) < v)

+ then

+ us := cons(p,us)

+ else

+ if (mvar(p) = v)

+ then

+ vs := cons(p,vs)

+ else

+ ws := cons(p,ws)

+ [construct(us)$$,construct(vs)$$,construct(ws)$$]$Record(under:$,floor:$,upper:$)

+

+ ps1 = ps2 ==

+ {p for p in elements(ps1)} =$(Set P) {p for p in elements(ps2)}

+

+ exactQuo : (R,R) -> R

+

+ localInf? (p:P,q:P):B ==

+ degree(p) <$E degree(q)

+

+ localTriangular? (lp:List(P)):B ==

+ lp := remove(zero?, lp)

+ empty? lp => true

+ any? (ground?, lp) => false

+ lp := sort(mvar(#1)$P > mvar(#2)$P, lp)

+ p,q : P

+ p := first lp

+ lp := rest lp

+ while (not empty? lp) and (mvar(p) > mvar((q := first(lp)))) repeat

+ p := q

+ lp := rest lp

+ empty? lp

+

+ triangular? ps ==

+ localTriangular? elements ps

+

+ trivialIdeal? ps ==

+ empty?(remove(zero?,elements(ps))$(List(P)))$(List(P))

+

+ if R has IntegralDomain

+ then

+

+ roughUnitIdeal? ps ==

+ any?(ground?,remove(zero?,elements(ps))$(List(P)))$(List P)

+

+ relativelyPrimeLeadingMonomials? (p:P,q:P):B ==

+ dp : E := degree(p)

+ dq : E := degree(q)

+ (sup(dp,dq)$E =$E dp +$E dq)@B

+

+ roughBase? ps ==

+ lp := remove(zero?,elements(ps))$(List(P))

+ empty? lp => true

+ rB? : B := true

+ while (not empty? lp) and rB? repeat

+ p := first lp

+ lp := rest lp

+ copylp := lp

+ while (not empty? copylp) and rB? repeat

+ rB? := relativelyPrimeLeadingMonomials?(p,first(copylp))

+ copylp := rest copylp

+ rB?

+

+ roughSubIdeal?(ps1,ps2) ==

+ lp: List(P) := rewriteIdealWithRemainder(elements(ps1),ps2)

+ empty? (remove(zero?,lp))

+

+ roughEqualIdeals? (ps1,ps2) ==

+ ps1 =$$ ps2 => true

+ roughSubIdeal?(ps1,ps2) and roughSubIdeal?(ps2,ps1)

+

+ if (R has GcdDomain) and (VarSet has ConvertibleTo (Symbol))

+ then

+

+ LPR ==> List Polynomial R

+ LS ==> List Symbol

+

+ if R has EuclideanDomain

+ then

+ exactQuo(r:R,s:R):R ==

+ r quo$R s

+ else

+ exactQuo(r:R,s:R):R ==

+ (r exquo$R s)::R

+

+ headRemainder (a,ps) ==

+ lp1 : List(P) := remove(zero?, elements(ps))$(List(P))

+ empty? lp1 => [a,1$R]

+ any?(ground?,lp1) => [reductum(a),1$R]

+ r : R := 1$R

+ lp1 := sort(localInf?, reverse elements(ps))

+ lp2 := lp1

+ e : Union(E, "failed")

+ while (not zero? a) and (not empty? lp2) repeat

+ p := first lp2

+ if ((e:= subtractIfCan(degree(a),degree(p))) case E)

+ then

+ g := gcd((lca := leadingCoefficient(a)),(lcp := leadingCoefficient(p)))$R

+ (lca,lcp) := (exactQuo(lca,g),exactQuo(lcp,g))

+ a := lcp * reductum(a) - monomial(lca, e::E)$P * reductum(p)

+ r := r * lcp

+ lp2 := lp1

+ else

+ lp2 := rest lp2

+ [a,r]

+

+ makeIrreducible! (frac:Record(num:P,den:R)):Record(num:P,den:R) ==

+ g := gcd(frac.den,frac.num)$P

+-- one? g => frac

+ (g = 1) => frac

+ frac.num := exactQuotient!(frac.num,g)

+ frac.den := exactQuo(frac.den,g)

+ frac

+

+ remainder (a,ps) ==

+ hRa := makeIrreducible! headRemainder (a,ps)

+ a := hRa.num

+ r : R := hRa.den

+ zero? a => [1$R,a,r]

+ b : P := monomial(1$R,degree(a))$P

+ c : R := leadingCoefficient(a)

+ while not zero?(a := reductum a) repeat

+ hRa := makeIrreducible! headRemainder (a,ps)

+ a := hRa.num

+ r := r * hRa.den

+ g := gcd(c,(lca := leadingCoefficient(a)))$R

+ b := ((hRa.den) * exactQuo(c,g)) * b + monomial(exactQuo(lca,g),degree(a))$P

+ c := g

+ [c,b,r]

+

+ rewriteIdealWithHeadRemainder(ps,cs) ==

+ trivialIdeal? cs => ps

+ roughUnitIdeal? cs => [0$P]

+ ps := remove(zero?,ps)

+ empty? ps => ps

+ any?(ground?,ps) => [1$P]

+ rs : List P := []

+ while not empty? ps repeat

+ p := first ps

+ ps := rest ps

+ p := (headRemainder(p,cs)).num

+ if not zero? p

+ then

+ if ground? p

+ then

+ ps := []

+ rs := [1$P]

+ else

+ primitivePart! p

+ rs := cons(p,rs)

+ removeDuplicates rs

+

+ rewriteIdealWithRemainder(ps,cs) ==

+ trivialIdeal? cs => ps

+ roughUnitIdeal? cs => [0$P]

+ ps := remove(zero?,ps)

+ empty? ps => ps

+ any?(ground?,ps) => [1$P]

+ rs : List P := []

+ while not empty? ps repeat

+ p := first ps

+ ps := rest ps

+ p := (remainder(p,cs)).polnum

+ if not zero? p

+ then

+ if ground? p

+ then

+ ps := []

+ rs := [1$P]

+ else

+ rs := cons(unitCanonical(p),rs)

+ removeDuplicates rs

+

+@

+\section{PSETCAT.lsp BOOTSTRAP}

+{\bf PSETCAT} depends on a chain of files. We need to break this cycle to build

+the algebra. So we keep a cached copy of the translated {\bf PSETCAT}

+category which we can write into the {\bf MID} directory. We compile

+the lisp code and copy the {\bf PSETCAT.o} file to the {\bf OUT} directory.

+This is eventually forcibly replaced by a recompiled version.

+

+Note that this code is not included in the generated catdef.spad file.

+

+<<PSETCAT.lsp BOOTSTRAP>>=

+

+(|/VERSIONCHECK| 2)

+

+(SETQ |PolynomialSetCategory;CAT| (QUOTE NIL))

+

+(SETQ |PolynomialSetCategory;AL| (QUOTE NIL))

+

+(DEFUN |PolynomialSetCategory| (|&REST| #1=#:G82375 |&AUX| #2=#:G82373) (DSETQ #2# #1#) (LET (#3=#:G82374) (COND ((SETQ #3# (|assoc| (|devaluateList| #2#) |PolynomialSetCategory;AL|)) (CDR #3#)) (T (SETQ |PolynomialSetCategory;AL| (|cons5| (CONS (|devaluateList| #2#) (SETQ #3# (APPLY (FUNCTION |PolynomialSetCategory;|) #2#))) |PolynomialSetCategory;AL|)) #3#))))

+

+(DEFUN |PolynomialSetCategory;| (|t#1| |t#2| |t#3| |t#4|) (PROG (#1=#:G82372) (RETURN (PROG1 (LETT #1# (|sublisV| (PAIR (QUOTE (|t#1| |t#2| |t#3| |t#4|)) (LIST (|devaluate| |t#1|) (|devaluate| |t#2|) (|devaluate| |t#3|) (|devaluate| |t#4|))) (|sublisV| (PAIR (QUOTE (#2=#:G82371)) (LIST (QUOTE (|List| |t#4|)))) (COND (|PolynomialSetCategory;CAT|) ((QUOTE T) (LETT |PolynomialSetCategory;CAT| (|Join| (|SetCategory|) (|Collection| (QUOTE |t#4|)) (|CoercibleTo| (QUOTE #2#)) (|mkCategory| (QUOTE |domain|) (QUOTE (((|retractIfCan| ((|Union| |$| "failed") (|List| |t#4|))) T) ((|retract| (|$| (|List| |t#4|))) T) ((|mvar| (|t#3| |$|)) T) ((|variables| ((|List| |t#3|) |$|)) T) ((|mainVariables| ((|List| |t#3|) |$|)) T) ((|mainVariable?| ((|Boolean|) |t#3| |$|)) T) ((|collectUnder| (|$| |$| |t#3|)) T) ((|collect| (|$| |$| |t#3|)) T) ((|collectUpper| (|$| |$| |t#3|)) T) ((|sort| ((|Record| (|:| |under| |$|) (|:| |floor| |$|) (|:| |upper| |$|)) |$| |t#3|)) T) ((|trivialIdeal?| ((|Boolean|) |$|)) T) ((|roughBase?| ((|Boolean|) |$|)) (|has| |t#1| (|IntegralDomain|))) ((|roughSubIdeal?| ((|Boolean|) |$| |$|)) (|has| |t#1| (|IntegralDomain|))) ((|roughEqualIdeals?| ((|Boolean|) |$| |$|)) (|has| |t#1| (|IntegralDomain|))) ((|roughUnitIdeal?| ((|Boolean|) |$|)) (|has| |t#1| (|IntegralDomain|))) ((|headRemainder| ((|Record| (|:| |num| |t#4|) (|:| |den| |t#1|)) |t#4| |$|)) (|has| |t#1| (|IntegralDomain|))) ((|remainder| ((|Record| (|:| |rnum| |t#1|) (|:| |polnum| |t#4|) (|:| |den| |t#1|)) |t#4| |$|)) (|has| |t#1| (|IntegralDomain|))) ((|rewriteIdealWithHeadRemainder| ((|List| |t#4|) (|List| |t#4|) |$|)) (|has| |t#1| (|IntegralDomain|))) ((|rewriteIdealWithRemainder| ((|List| |t#4|) (|List| |t#4|) |$|)) (|has| |t#1| (|IntegralDomain|))) ((|triangular?| ((|Boolean|) |$|)) (|has| |t#1| (|IntegralDomain|))))) (QUOTE ((|finiteAggregate| T))) (QUOTE ((|Boolean|) (|List| |t#4|) (|List| |t#3|))) NIL)) . #3=(|PolynomialSetCategory|)))))) . #3#) (SETELT #1# 0 (LIST (QUOTE |PolynomialSetCategory|) (|devaluate| |t#1|) (|devaluate| |t#2|) (|devaluate| |t#3|) (|devaluate| |t#4|)))))))

+@

+\section{PSETCAT-.lsp BOOTSTRAP}

+{\bf PSETCAT-} depends on {\bf PSETCAT}. We need to break this cycle to build

+the algebra. So we keep a cached copy of the translated {\bf PSETCAT-}

+category which we can write into the {\bf MID} directory. We compile

+the lisp code and copy the {\bf PSETCAT-.o} file to the {\bf OUT} directory.

+This is eventually forcibly replaced by a recompiled version.

+

+Note that this code is not included in the generated catdef.spad file.

+

+<<PSETCAT-.lsp BOOTSTRAP>>=

+

+(|/VERSIONCHECK| 2)

+

+(DEFUN |PSETCAT-;elements| (|ps| |$|) (PROG (|lp|) (RETURN (LETT |lp| (SPADCALL |ps| (QREFELT |$| 12)) |PSETCAT-;elements|))))

+

+(DEFUN |PSETCAT-;variables1| (|lp| |$|) (PROG (#1=#:G82392 |p| #2=#:G82393 |lvars|) (RETURN (SEQ (LETT |lvars| (PROGN (LETT #1# NIL |PSETCAT-;variables1|) (SEQ (LETT |p| NIL |PSETCAT-;variables1|) (LETT #2# |lp| |PSETCAT-;variables1|) G190 (COND ((OR (ATOM #2#) (PROGN (LETT |p| (CAR #2#) |PSETCAT-;variables1|) NIL)) (GO G191))) (SEQ (EXIT (LETT #1# (CONS (SPADCALL |p| (QREFELT |$| 14)) #1#) |PSETCAT-;variables1|))) (LETT #2# (CDR #2#) |PSETCAT-;variables1|) (GO G190) G191 (EXIT (NREVERSE0 #1#)))) |PSETCAT-;variables1|) (EXIT (SPADCALL (CONS (FUNCTION |PSETCAT-;variables1!0|) |$|) (SPADCALL (SPADCALL |lvars| (QREFELT |$| 18)) (QREFELT |$| 19)) (QREFELT |$| 21)))))))

+

+(DEFUN |PSETCAT-;variables1!0| (|#1| |#2| |$|) (SPADCALL |#2| |#1| (QREFELT |$| 16)))

+

+(DEFUN |PSETCAT-;variables2| (|lp| |$|) (PROG (#1=#:G82397 |p| #2=#:G82398 |lvars|) (RETURN (SEQ (LETT |lvars| (PROGN (LETT #1# NIL |PSETCAT-;variables2|) (SEQ (LETT |p| NIL |PSETCAT-;variables2|) (LETT #2# |lp| |PSETCAT-;variables2|) G190 (COND ((OR (ATOM #2#) (PROGN (LETT |p| (CAR #2#) |PSETCAT-;variables2|) NIL)) (GO G191))) (SEQ (EXIT (LETT #1# (CONS (SPADCALL |p| (QREFELT |$| 22)) #1#) |PSETCAT-;variables2|))) (LETT #2# (CDR #2#) |PSETCAT-;variables2|) (GO G190) G191 (EXIT (NREVERSE0 #1#)))) |PSETCAT-;variables2|) (EXIT (SPADCALL (CONS (FUNCTION |PSETCAT-;variables2!0|) |$|) (SPADCALL |lvars| (QREFELT |$| 19)) (QREFELT |$| 21)))))))

+

+(DEFUN |PSETCAT-;variables2!0| (|#1| |#2| |$|) (SPADCALL |#2| |#1| (QREFELT |$| 16)))

+

+(DEFUN |PSETCAT-;variables;SL;4| (|ps| |$|) (|PSETCAT-;variables1| (|PSETCAT-;elements| |ps| |$|) |$|))

+

+(DEFUN |PSETCAT-;mainVariables;SL;5| (|ps| |$|) (|PSETCAT-;variables2| (SPADCALL (ELT |$| 24) (|PSETCAT-;elements| |ps| |$|) (QREFELT |$| 26)) |$|))

+

+(DEFUN |PSETCAT-;mainVariable?;VarSetSB;6| (|v| |ps| |$|) (PROG (|lp|) (RETURN (SEQ (LETT |lp| (SPADCALL (ELT |$| 24) (|PSETCAT-;elements| |ps| |$|) (QREFELT |$| 26)) |PSETCAT-;mainVariable?;VarSetSB;6|) (SEQ G190 (COND ((NULL (COND ((OR (NULL |lp|) (SPADCALL (SPADCALL (|SPADfirst| |lp|) (QREFELT |$| 22)) |v| (QREFELT |$| 28))) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) (GO G191))) (SEQ (EXIT (LETT |lp| (CDR |lp|) |PSETCAT-;mainVariable?;VarSetSB;6|))) NIL (GO G190) G191 (EXIT NIL)) (EXIT (COND ((NULL |lp|) (QUOTE NIL)) ((QUOTE T) (QUOTE T))))))))

+

+(DEFUN |PSETCAT-;collectUnder;SVarSetS;7| (|ps| |v| |$|) (PROG (|p| |lp| |lq|) (RETURN (SEQ (LETT |lp| (|PSETCAT-;elements| |ps| |$|) |PSETCAT-;collectUnder;SVarSetS;7|) (LETT |lq| NIL |PSETCAT-;collectUnder;SVarSetS;7|) (SEQ G190 (COND ((NULL (COND ((NULL |lp|) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) (GO G191))) (SEQ (LETT |p| (|SPADfirst| |lp|) |PSETCAT-;collectUnder;SVarSetS;7|) (LETT |lp| (CDR |lp|) |PSETCAT-;collectUnder;SVarSetS;7|) (EXIT (COND ((OR (SPADCALL |p| (QREFELT |$| 24)) (SPADCALL (SPADCALL |p| (QREFELT |$| 22)) |v| (QREFELT |$| 16))) (LETT |lq| (CONS |p| |lq|) |PSETCAT-;collectUnder;SVarSetS;7|))))) NIL (GO G190) G191 (EXIT NIL)) (EXIT (SPADCALL |lq| (QREFELT |$| 30)))))))

+

+(DEFUN |PSETCAT-;collectUpper;SVarSetS;8| (|ps| |v| |$|) (PROG (|p| |lp| |lq|) (RETURN (SEQ (LETT |lp| (|PSETCAT-;elements| |ps| |$|) |PSETCAT-;collectUpper;SVarSetS;8|) (LETT |lq| NIL |PSETCAT-;collectUpper;SVarSetS;8|) (SEQ G190 (COND ((NULL (COND ((NULL |lp|) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) (GO G191))) (SEQ (LETT |p| (|SPADfirst| |lp|) |PSETCAT-;collectUpper;SVarSetS;8|) (LETT |lp| (CDR |lp|) |PSETCAT-;collectUpper;SVarSetS;8|) (EXIT (COND ((NULL (SPADCALL |p| (QREFELT |$| 24))) (COND ((SPADCALL |v| (SPADCALL |p| (QREFELT |$| 22)) (QREFELT |$| 16)) (LETT |lq| (CONS |p| |lq|) |PSETCAT-;collectUpper;SVarSetS;8|))))))) NIL (GO G190) G191 (EXIT NIL)) (EXIT (SPADCALL |lq| (QREFELT |$| 30)))))))

+

+(DEFUN |PSETCAT-;collect;SVarSetS;9| (|ps| |v| |$|) (PROG (|p| |lp| |lq|) (RETURN (SEQ (LETT |lp| (|PSETCAT-;elements| |ps| |$|) |PSETCAT-;collect;SVarSetS;9|) (LETT |lq| NIL |PSETCAT-;collect;SVarSetS;9|) (SEQ G190 (COND ((NULL (COND ((NULL |lp|) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) (GO G191))) (SEQ (LETT |p| (|SPADfirst| |lp|) |PSETCAT-;collect;SVarSetS;9|) (LETT |lp| (CDR |lp|) |PSETCAT-;collect;SVarSetS;9|) (EXIT (COND ((NULL (SPADCALL |p| (QREFELT |$| 24))) (COND ((SPADCALL (SPADCALL |p| (QREFELT |$| 22)) |v| (QREFELT |$| 28)) (LETT |lq| (CONS |p| |lq|) |PSETCAT-;collect;SVarSetS;9|))))))) NIL (GO G190) G191 (EXIT NIL)) (EXIT (SPADCALL |lq| (QREFELT |$| 30)))))))

+

+(DEFUN |PSETCAT-;sort;SVarSetR;10| (|ps| |v| |$|) (PROG (|p| |lp| |us| |vs| |ws|) (RETURN (SEQ (LETT |lp| (|PSETCAT-;elements| |ps| |$|) |PSETCAT-;sort;SVarSetR;10|) (LETT |us| NIL |PSETCAT-;sort;SVarSetR;10|) (LETT |vs| NIL |PSETCAT-;sort;SVarSetR;10|) (LETT |ws| NIL |PSETCAT-;sort;SVarSetR;10|) (SEQ G190 (COND ((NULL (COND ((NULL |lp|) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) (GO G191))) (SEQ (LETT |p| (|SPADfirst| |lp|) |PSETCAT-;sort;SVarSetR;10|) (LETT |lp| (CDR |lp|) |PSETCAT-;sort;SVarSetR;10|) (EXIT (COND ((OR (SPADCALL |p| (QREFELT |$| 24)) (SPADCALL (SPADCALL |p| (QREFELT |$| 22)) |v| (QREFELT |$| 16))) (LETT |us| (CONS |p| |us|) |PSETCAT-;sort;SVarSetR;10|)) ((SPADCALL (SPADCALL |p| (QREFELT |$| 22)) |v| (QREFELT |$| 28)) (LETT |vs| (CONS |p| |vs|) |PSETCAT-;sort;SVarSetR;10|)) ((QUOTE T) (LETT |ws| (CONS |p| |ws|) |PSETCAT-;sort;SVarSetR;10|))))) NIL (GO G190) G191 (EXIT NIL)) (EXIT (VECTOR (SPADCALL |us| (QREFELT |$| 30)) (SPADCALL |vs| (QREFELT |$| 30)) (SPADCALL |ws| (QREFELT |$| 30))))))))

+

+(DEFUN |PSETCAT-;=;2SB;11| (|ps1| |ps2| |$|) (PROG (#1=#:G82439 #2=#:G82440 #3=#:G82437 |p| #4=#:G82438) (RETURN (SEQ (SPADCALL (SPADCALL (PROGN (LETT #1# NIL |PSETCAT-;=;2SB;11|) (SEQ (LETT |p| NIL |PSETCAT-;=;2SB;11|) (LETT #2# (|PSETCAT-;elements| |ps1| |$|) |PSETCAT-;=;2SB;11|) G190 (COND ((OR (ATOM #2#) (PROGN (LETT |p| (CAR #2#) |PSETCAT-;=;2SB;11|) NIL)) (GO G191))) (SEQ (EXIT (LETT #1# (CONS |p| #1#) |PSETCAT-;=;2SB;11|))) (LETT #2# (CDR #2#) |PSETCAT-;=;2SB;11|) (GO G190) G191 (EXIT (NREVERSE0 #1#)))) (QREFELT |$| 37)) (SPADCALL (PROGN (LETT #3# NIL |PSETCAT-;=;2SB;11|) (SEQ (LETT |p| NIL |PSETCAT-;=;2SB;11|) (LETT #4# (|PSETCAT-;elements| |ps2| |$|) |PSETCAT-;=;2SB;11|) G190 (COND ((OR (ATOM #4#) (PROGN (LETT |p| (CAR #4#) |PSETCAT-;=;2SB;11|) NIL)) (GO G191))) (SEQ (EXIT (LETT #3# (CONS |p| #3#) |PSETCAT-;=;2SB;11|))) (LETT #4# (CDR #4#) |PSETCAT-;=;2SB;11|) (GO G190) G191 (EXIT (NREVERSE0 #3#)))) (QREFELT |$| 37)) (QREFELT |$| 38))))))

+

+(DEFUN |PSETCAT-;localInf?| (|p| |q| |$|) (SPADCALL (SPADCALL |p| (QREFELT |$| 40)) (SPADCALL |q| (QREFELT |$| 40)) (QREFELT |$| 41)))

+

+(DEFUN |PSETCAT-;localTriangular?| (|lp| |$|) (PROG (|q| |p|) (RETURN (SEQ (LETT |lp| (SPADCALL (ELT |$| 42) |lp| (QREFELT |$| 26)) |PSETCAT-;localTriangular?|) (EXIT (COND ((NULL |lp|) (QUOTE T)) ((SPADCALL (ELT |$| 24) |lp| (QREFELT |$| 43)) (QUOTE NIL)) ((QUOTE T) (SEQ (LETT |lp| (SPADCALL (CONS (FUNCTION |PSETCAT-;localTriangular?!0|) |$|) |lp| (QREFELT |$| 45)) |PSETCAT-;localTriangular?|) (LETT |p| (|SPADfirst| |lp|) |PSETCAT-;localTriangular?|) (LETT |lp| (CDR |lp|) |PSETCAT-;localTriangular?|) (SEQ G190 (COND ((NULL (COND ((NULL |lp|) (QUOTE NIL)) ((QUOTE T) (SPADCALL (SPADCALL (LETT |q| (|SPADfirst| |lp|) |PSETCAT-;localTriangular?|) (QREFELT |$| 22)) (SPADCALL |p| (QREFELT |$| 22)) (QREFELT |$| 16))))) (GO G191))) (SEQ (LETT |p| |q| |PSETCAT-;localTriangular?|) (EXIT (LETT |lp| (CDR |lp|) |PSETCAT-;localTriangular?|))) NIL (GO G190) G191 (EXIT NIL)) (EXIT (NULL |lp|))))))))))

+

+(DEFUN |PSETCAT-;localTriangular?!0| (|#1| |#2| |$|) (SPADCALL (SPADCALL |#2| (QREFELT |$| 22)) (SPADCALL |#1| (QREFELT |$| 22)) (QREFELT |$| 16)))

+

+(DEFUN |PSETCAT-;triangular?;SB;14| (|ps| |$|) (|PSETCAT-;localTriangular?| (|PSETCAT-;elements| |ps| |$|) |$|))

+

+(DEFUN |PSETCAT-;trivialIdeal?;SB;15| (|ps| |$|) (NULL (SPADCALL (ELT |$| 42) (|PSETCAT-;elements| |ps| |$|) (QREFELT |$| 26))))

+

+(DEFUN |PSETCAT-;roughUnitIdeal?;SB;16| (|ps| |$|) (SPADCALL (ELT |$| 24) (SPADCALL (ELT |$| 42) (|PSETCAT-;elements| |ps| |$|) (QREFELT |$| 26)) (QREFELT |$| 43)))

+

+(DEFUN |PSETCAT-;relativelyPrimeLeadingMonomials?| (|p| |q| |$|) (PROG (|dp| |dq|) (RETURN (SEQ (LETT |dp| (SPADCALL |p| (QREFELT |$| 40)) |PSETCAT-;relativelyPrimeLeadingMonomials?|) (LETT |dq| (SPADCALL |q| (QREFELT |$| 40)) |PSETCAT-;relativelyPrimeLeadingMonomials?|) (EXIT (SPADCALL (SPADCALL |dp| |dq| (QREFELT |$| 49)) (SPADCALL |dp| |dq| (QREFELT |$| 50)) (QREFELT |$| 51)))))))

+

+(DEFUN |PSETCAT-;roughBase?;SB;18| (|ps| |$|) (PROG (|p| |lp| |rB?| |copylp|) (RETURN (SEQ (LETT |lp| (SPADCALL (ELT |$| 42) (|PSETCAT-;elements| |ps| |$|) (QREFELT |$| 26)) |PSETCAT-;roughBase?;SB;18|) (EXIT (COND ((NULL |lp|) (QUOTE T)) ((QUOTE T) (SEQ (LETT |rB?| (QUOTE T) |PSETCAT-;roughBase?;SB;18|) (SEQ G190 (COND ((NULL (COND ((NULL |lp|) (QUOTE NIL)) ((QUOTE T) |rB?|))) (GO G191))) (SEQ (LETT |p| (|SPADfirst| |lp|) |PSETCAT-;roughBase?;SB;18|) (LETT |lp| (CDR |lp|) |PSETCAT-;roughBase?;SB;18|) (LETT |copylp| |lp| |PSETCAT-;roughBase?;SB;18|) (EXIT (SEQ G190 (COND ((NULL (COND ((NULL |copylp|) (QUOTE NIL)) ((QUOTE T) |rB?|))) (GO G191))) (SEQ (LETT |rB?| (|PSETCAT-;relativelyPrimeLeadingMonomials?| |p| (|SPADfirst| |copylp|) |$|) |PSETCAT-;roughBase?;SB;18|) (EXIT (LETT |copylp| (CDR |copylp|) |PSETCAT-;roughBase?;SB;18|))) NIL (GO G190) G191 (EXIT NIL)))) NIL (GO G190) G191 (EXIT NIL)) (EXIT |rB?|)))))))))

+

+(DEFUN |PSETCAT-;roughSubIdeal?;2SB;19| (|ps1| |ps2| |$|) (PROG (|lp|) (RETURN (SEQ (LETT |lp| (SPADCALL (|PSETCAT-;elements| |ps1| |$|) |ps2| (QREFELT |$| 53)) |PSETCAT-;roughSubIdeal?;2SB;19|) (EXIT (NULL (SPADCALL (ELT |$| 42) |lp| (QREFELT |$| 26))))))))

+

+(DEFUN |PSETCAT-;roughEqualIdeals?;2SB;20| (|ps1| |ps2| |$|) (COND ((SPADCALL |ps1| |ps2| (QREFELT |$| 55)) (QUOTE T)) ((SPADCALL |ps1| |ps2| (QREFELT |$| 56)) (SPADCALL |ps2| |ps1| (QREFELT |$| 56))) ((QUOTE T) (QUOTE NIL))))

+

+(DEFUN |PSETCAT-;exactQuo| (|r| |s| |$|) (SPADCALL |r| |s| (QREFELT |$| 58)))

+

+(DEFUN |PSETCAT-;exactQuo| (|r| |s| |$|) (PROG (#1=#:G82473) (RETURN (PROG2 (LETT #1# (SPADCALL |r| |s| (QREFELT |$| 60)) |PSETCAT-;exactQuo|) (QCDR #1#) (|check-union| (QEQCAR #1# 0) (QREFELT |$| 7) #1#)))))

+

+(DEFUN |PSETCAT-;headRemainder;PSR;23| (|a| |ps| |$|) (PROG (|lp1| |p| |e| |g| |#G47| |#G48| |lca| |lcp| |r| |lp2|) (RETURN (SEQ (LETT |lp1| (SPADCALL (ELT |$| 42) (|PSETCAT-;elements| |ps| |$|) (QREFELT |$| 26)) |PSETCAT-;headRemainder;PSR;23|) (EXIT (COND ((NULL |lp1|) (CONS |a| (|spadConstant| |$| 61))) ((SPADCALL (ELT |$| 24) |lp1| (QREFELT |$| 43)) (CONS (SPADCALL |a| (QREFELT |$| 62)) (|spadConstant| |$| 61))) ((QUOTE T) (SEQ (LETT |r| (|spadConstant| |$| 61) |PSETCAT-;headRemainder;PSR;23|) (LETT |lp1| (SPADCALL (CONS (|function| |PSETCAT-;localInf?|) |$|) (REVERSE (|PSETCAT-;elements| |ps| |$|)) (QREFELT |$| 45)) |PSETCAT-;headRemainder;PSR;23|) (LETT |lp2| |lp1| |PSETCAT-;headRemainder;PSR;23|) (SEQ G190 (COND ((NULL (COND ((OR (SPADCALL |a| (QREFELT |$| 42)) (NULL |lp2|)) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) (GO G191))) (SEQ (LETT |p| (|SPADfirst| |lp2|) |PSETCAT-;headRemainder;PSR;23|) (LETT |e| (SPADCALL (SPADCALL |a| (QREFELT |$| 40)) (SPADCALL |p| (QREFELT |$| 40)) (QREFELT |$| 63)) |PSETCAT-;headRemainder;PSR;23|) (EXIT (COND ((QEQCAR |e| 0) (SEQ (LETT |g| (SPADCALL (LETT |lca| (SPADCALL |a| (QREFELT |$| 64)) |PSETCAT-;headRemainder;PSR;23|) (LETT |lcp| (SPADCALL |p| (QREFELT |$| 64)) |PSETCAT-;headRemainder;PSR;23|) (QREFELT |$| 65)) |PSETCAT-;headRemainder;PSR;23|) (PROGN (LETT |#G47| (|PSETCAT-;exactQuo| |lca| |g| |$|) |PSETCAT-;headRemainder;PSR;23|) (LETT |#G48| (|PSETCAT-;exactQuo| |lcp| |g| |$|) |PSETCAT-;headRemainder;PSR;23|) (LETT |lca| |#G47| |PSETCAT-;headRemainder;PSR;23|) (LETT |lcp| |#G48| |PSETCAT-;headRemainder;PSR;23|)) (LETT |a| (SPADCALL (SPADCALL |lcp| (SPADCALL |a| (QREFELT |$| 62)) (QREFELT |$| 66)) (SPADCALL (SPADCALL |lca| (QCDR |e|) (QREFELT |$| 67)) (SPADCALL |p| (QREFELT |$| 62)) (QREFELT |$| 68)) (QREFELT |$| 69)) |PSETCAT-;headRemainder;PSR;23|) (LETT |r| (SPADCALL |r| |lcp| (QREFELT |$| 70)) |PSETCAT-;headRemainder;PSR;23|) (EXIT (LETT |lp2| |lp1| |PSETCAT-;headRemainder;PSR;23|)))) ((QUOTE T) (LETT |lp2| (CDR |lp2|) |PSETCAT-;headRemainder;PSR;23|))))) NIL (GO G190) G191 (EXIT NIL)) (EXIT (CONS |a| |r|))))))))))

+

+(DEFUN |PSETCAT-;makeIrreducible!| (|frac| |$|) (PROG (|g|) (RETURN (SEQ (LETT |g| (SPADCALL (QCDR |frac|) (QCAR |frac|) (QREFELT |$| 73)) |PSETCAT-;makeIrreducible!|) (EXIT (COND ((SPADCALL |g| (QREFELT |$| 74)) |frac|) ((QUOTE T) (SEQ (PROGN (RPLACA |frac| (SPADCALL (QCAR |frac|) |g| (QREFELT |$| 75))) (QCAR |frac|)) (PROGN (RPLACD |frac| (|PSETCAT-;exactQuo| (QCDR |frac|) |g| |$|)) (QCDR |frac|)) (EXIT |frac|)))))))))

+

+(DEFUN |PSETCAT-;remainder;PSR;25| (|a| |ps| |$|) (PROG (|hRa| |r| |lca| |g| |b| |c|) (RETURN (SEQ (LETT |hRa| (|PSETCAT-;makeIrreducible!| (SPADCALL |a| |ps| (QREFELT |$| 76)) |$|) |PSETCAT-;remainder;PSR;25|) (LETT |a| (QCAR |hRa|) |PSETCAT-;remainder;PSR;25|) (LETT |r| (QCDR |hRa|) |PSETCAT-;remainder;PSR;25|) (EXIT (COND ((SPADCALL |a| (QREFELT |$| 42)) (VECTOR (|spadConstant| |$| 61) |a| |r|)) ((QUOTE T) (SEQ (LETT |b| (SPADCALL (|spadConstant| |$| 61) (SPADCALL |a| (QREFELT |$| 40)) (QREFELT |$| 67)) |PSETCAT-;remainder;PSR;25|) (LETT |c| (SPADCALL |a| (QREFELT |$| 64)) |PSETCAT-;remainder;PSR;25|) (SEQ G190 (COND ((NULL (COND ((SPADCALL (LETT |a| (SPADCALL |a| (QREFELT |$| 62)) |PSETCAT-;remainder;PSR;25|) (QREFELT |$| 42)) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) (GO G191))) (SEQ (LETT |hRa| (|PSETCAT-;makeIrreducible!| (SPADCALL |a| |ps| (QREFELT |$| 76)) |$|) |PSETCAT-;remainder;PSR;25|) (LETT |a| (QCAR |hRa|) |PSETCAT-;remainder;PSR;25|) (LETT |r| (SPADCALL |r| (QCDR |hRa|) (QREFELT |$| 70)) |PSETCAT-;remainder;PSR;25|) (LETT |g| (SPADCALL |c| (LETT |lca| (SPADCALL |a| (QREFELT |$| 64)) |PSETCAT-;remainder;PSR;25|) (QREFELT |$| 65)) |PSETCAT-;remainder;PSR;25|) (LETT |b| (SPADCALL (SPADCALL (SPADCALL (QCDR |hRa|) (|PSETCAT-;exactQuo| |c| |g| |$|) (QREFELT |$| 70)) |b| (QREFELT |$| 66)) (SPADCALL (|PSETCAT-;exactQuo| |lca| |g| |$|) (SPADCALL |a| (QREFELT |$| 40)) (QREFELT |$| 67)) (QREFELT |$| 77)) |PSETCAT-;remainder;PSR;25|) (EXIT (LETT |c| |g| |PSETCAT-;remainder;PSR;25|))) NIL (GO G190) G191 (EXIT NIL)) (EXIT (VECTOR |c| |b| |r|))))))))))

+

+(DEFUN |PSETCAT-;rewriteIdealWithHeadRemainder;LSL;26| (|ps| |cs| |$|) (PROG (|p| |rs|) (RETURN (SEQ (COND ((SPADCALL |cs| (QREFELT |$| 80)) |ps|) ((SPADCALL |cs| (QREFELT |$| 81)) (LIST (|spadConstant| |$| 82))) ((QUOTE T) (SEQ (LETT |ps| (SPADCALL (ELT |$| 42) |ps| (QREFELT |$| 26)) |PSETCAT-;rewriteIdealWithHeadRemainder;LSL;26|) (EXIT (COND ((NULL |ps|) |ps|) ((SPADCALL (ELT |$| 24) |ps| (QREFELT |$| 43)) (LIST (|spadConstant| |$| 83))) ((QUOTE T) (SEQ (LETT |rs| NIL |PSETCAT-;rewriteIdealWithHeadRemainder;LSL;26|) (SEQ G190 (COND ((NULL (COND ((NULL |ps|) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) (GO G191))) (SEQ (LETT |p| (|SPADfirst| |ps|) |PSETCAT-;rewriteIdealWithHeadRemainder;LSL;26|) (LETT |ps| (CDR |ps|) |PSETCAT-;rewriteIdealWithHeadRemainder;LSL;26|) (LETT |p| (QCAR (SPADCALL |p| |cs| (QREFELT |$| 76))) |PSETCAT-;rewriteIdealWithHeadRemainder;LSL;26|) (EXIT (COND ((NULL (SPADCALL |p| (QREFELT |$| 42))) (COND ((SPADCALL |p| (QREFELT |$| 24)) (SEQ (LETT |ps| NIL |PSETCAT-;rewriteIdealWithHeadRemainder;LSL;26|) (EXIT (LETT |rs| (LIST (|spadConstant| |$| 83)) |PSETCAT-;rewriteIdealWithHeadRemainder;LSL;26|)))) ((QUOTE T) (SEQ (SPADCALL |p| (QREFELT |$| 84)) (EXIT (LETT |rs| (CONS |p| |rs|) |PSETCAT-;rewriteIdealWithHeadRemainder;LSL;26|))))))))) NIL (GO G190) G191 (EXIT NIL)) (EXIT (SPADCALL |rs| (QREFELT |$| 85))))))))))))))

+

+(DEFUN |PSETCAT-;rewriteIdealWithRemainder;LSL;27| (|ps| |cs| |$|) (PROG (|p| |rs|) (RETURN (SEQ (COND ((SPADCALL |cs| (QREFELT |$| 80)) |ps|) ((SPADCALL |cs| (QREFELT |$| 81)) (LIST (|spadConstant| |$| 82))) ((QUOTE T) (SEQ (LETT |ps| (SPADCALL (ELT |$| 42) |ps| (QREFELT |$| 26)) |PSETCAT-;rewriteIdealWithRemainder;LSL;27|) (EXIT (COND ((NULL |ps|) |ps|) ((SPADCALL (ELT |$| 24) |ps| (QREFELT |$| 43)) (LIST (|spadConstant| |$| 83))) ((QUOTE T) (SEQ (LETT |rs| NIL |PSETCAT-;rewriteIdealWithRemainder;LSL;27|) (SEQ G190 (COND ((NULL (COND ((NULL |ps|) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) (GO G191))) (SEQ (LETT |p| (|SPADfirst| |ps|) |PSETCAT-;rewriteIdealWithRemainder;LSL;27|) (LETT |ps| (CDR |ps|) |PSETCAT-;rewriteIdealWithRemainder;LSL;27|) (LETT |p| (QVELT (SPADCALL |p| |cs| (QREFELT |$| 87)) 1) |PSETCAT-;rewriteIdealWithRemainder;LSL;27|) (EXIT (COND ((NULL (SPADCALL |p| (QREFELT |$| 42))) (COND ((SPADCALL |p| (QREFELT |$| 24)) (SEQ (LETT |ps| NIL |PSETCAT-;rewriteIdealWithRemainder;LSL;27|) (EXIT (LETT |rs| (LIST (|spadConstant| |$| 83)) |PSETCAT-;rewriteIdealWithRemainder;LSL;27|)))) ((QUOTE T) (LETT |rs| (CONS (SPADCALL |p| (QREFELT |$| 88)) |rs|) |PSETCAT-;rewriteIdealWithRemainder;LSL;27|))))))) NIL (GO G190) G191 (EXIT NIL)) (EXIT (SPADCALL |rs| (QREFELT |$| 85))))))))))))))

+

+(DEFUN |PolynomialSetCategory&| (|#1| |#2| |#3| |#4| |#5|) (PROG (|DV$1| |DV$2| |DV$3| |DV$4| |DV$5| |dv$| |$| |pv$|) (RETURN (PROGN (LETT |DV$1| (|devaluate| |#1|) . #1=(|PolynomialSetCategory&|)) (LETT |DV$2| (|devaluate| |#2|) . #1#) (LETT |DV$3| (|devaluate| |#3|) . #1#) (LETT |DV$4| (|devaluate| |#4|) . #1#) (LETT |DV$5| (|devaluate| |#5|) . #1#) (LETT |dv$| (LIST (QUOTE |PolynomialSetCategory&|) |DV$1| |DV$2| |DV$3| |DV$4| |DV$5|) . #1#) (LETT |$| (GETREFV 90) . #1#) (QSETREFV |$| 0 |dv$|) (QSETREFV |$| 3 (LETT |pv$| (|buildPredVector| 0 0 (LIST (|HasCategory| |#2| (QUOTE (|IntegralDomain|))))) . #1#)) (|stuffDomainSlots| |$|) (QSETREFV |$| 6 |#1|) (QSETREFV |$| 7 |#2|) (QSETREFV |$| 8 |#3|) (QSETREFV |$| 9 |#4|) (QSETREFV |$| 10 |#5|) (COND ((|testBitVector| |pv$| 1) (PROGN (QSETREFV |$| 48 (CONS (|dispatchFunction| |PSETCAT-;roughUnitIdeal?;SB;16|) |$|)) (QSETREFV |$| 52 (CONS (|dispatchFunction| |PSETCAT-;roughBase?;SB;18|) |$|)) (QSETREFV |$| 54 (CONS (|dispatchFunction| |PSETCAT-;roughSubIdeal?;2SB;19|) |$|)) (QSETREFV |$| 57 (CONS (|dispatchFunction| |PSETCAT-;roughEqualIdeals?;2SB;20|) |$|))))) (COND ((|HasCategory| |#2| (QUOTE (|GcdDomain|))) (COND ((|HasCategory| |#4| (QUOTE (|ConvertibleTo| (|Symbol|)))) (PROGN (QSETREFV |$| 72 (CONS (|dispatchFunction| |PSETCAT-;headRemainder;PSR;23|) |$|)) (QSETREFV |$| 79 (CONS (|dispatchFunction| |PSETCAT-;remainder;PSR;25|) |$|)) (QSETREFV |$| 86 (CONS (|dispatchFunction| |PSETCAT-;rewriteIdealWithHeadRemainder;LSL;26|) |$|)) (QSETREFV |$| 89 (CONS (|dispatchFunction| |PSETCAT-;rewriteIdealWithRemainder;LSL;27|) |$|))))))) |$|))))

+

+(MAKEPROP (QUOTE |PolynomialSetCategory&|) (QUOTE |infovec|) (LIST (QUOTE #(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|) (|local| |#3|) (|local| |#4|) (|local| |#5|) (|List| 10) (0 . |members|) (|List| 9) (5 . |variables|) (|Boolean|) (10 . |<|) (|List| |$|) (16 . |concat|) (21 . |removeDuplicates|) (|Mapping| 15 9 9) (26 . |sort|) (32 . |mvar|) |PSETCAT-;variables;SL;4| (37 . |ground?|) (|Mapping| 15 10) (42 . |remove|) |PSETCAT-;mainVariables;SL;5| (48 . |=|) |PSETCAT-;mainVariable?;VarSetSB;6| (54 . |construct|) |PSETCAT-;collectUnder;SVarSetS;7| |PSETCAT-;collectUpper;SVarSetS;8| |PSETCAT-;collect;SVarSetS;9| (|Record| (|:| |under| |$|) (|:| |floor| |$|) (|:| |upper| |$|)) |PSETCAT-;sort;SVarSetR;10| (|Set| 10) (59 . |brace|) (64 . |=|) |PSETCAT-;=;2SB;11| (70 . |degree|) (75 . |<|) (81 . |zero?|) (86 . |any?|) (|Mapping| 15 10 10) (92 . |sort|) |PSETCAT-;triangular?;SB;14| |PSETCAT-;trivialIdeal?;SB;15| (98 . |roughUnitIdeal?|) (103 . |sup|) (109 . |+|) (115 . |=|) (121 . |roughBase?|) (126 . |rewriteIdealWithRemainder|) (132 . |roughSubIdeal?|) (138 . |=|) (144 . |roughSubIdeal?|) (150 . |roughEqualIdeals?|) (156 . |quo|) (|Union| |$| (QUOTE "failed")) (162 . |exquo|) (168 . |One|) (172 . |reductum|) (177 . |subtractIfCan|) (183 . |leadingCoefficient|) (188 . |gcd|) (194 . |*|) (200 . |monomial|) (206 . |*|) (212 . |-|) (218 . |*|) (|Record| (|:| |num| 10) (|:| |den| 7)) (224 . |headRemainder|) (230 . |gcd|) (236 . |one?|) (241 . |exactQuotient!|) (247 . |headRemainder|) (253 . |+|) (|Record| (|:| |rnum| 7) (|:| |polnum| 10) (|:| |den| 7)) (259 . |remainder|) (265 . |trivialIdeal?|) (270 . |roughUnitIdeal?|) (275 . |Zero|) (279 . |One|) (283 . |primitivePart!|) (288 . |removeDuplicates|) (293 . |rewriteIdealWithHeadRemainder|) (299 . |remainder|) (305 . |unitCanonical|) (310 . |rewriteIdealWithRemainder|))) (QUOTE #(|variables| 316 |trivialIdeal?| 321 |triangular?| 326 |sort| 331 |roughUnitIdeal?| 337 |roughSubIdeal?| 342 |roughEqualIdeals?| 348 |roughBase?| 354 |rewriteIdealWithRemainder| 359 |rewriteIdealWithHeadRemainder| 365 |remainder| 371 |mainVariables| 377 |mainVariable?| 382 |headRemainder| 388 |collectUpper| 394 |collectUnder| 400 |collect| 406 |=| 412)) (QUOTE NIL) (CONS (|makeByteWordVec2| 1 (QUOTE NIL)) (CONS (QUOTE #()) (CONS (QUOTE #()) (|makeByteWordVec2| 89 (QUOTE (1 6 11 0 12 1 10 13 0 14 2 9 15 0 0 16 1 13 0 17 18 1 13 0 0 19 2 13 0 20 0 21 1 10 9 0 22 1 10 15 0 24 2 11 0 25 0 26 2 9 15 0 0 28 1 6 0 11 30 1 36 0 11 37 2 36 15 0 0 38 1 10 8 0 40 2 8 15 0 0 41 1 10 15 0 42 2 11 15 25 0 43 2 11 0 44 0 45 1 0 15 0 48 2 8 0 0 0 49 2 8 0 0 0 50 2 8 15 0 0 51 1 0 15 0 52 2 6 11 11 0 53 2 0 15 0 0 54 2 6 15 0 0 55 2 6 15 0 0 56 2 0 15 0 0 57 2 7 0 0 0 58 2 7 59 0 0 60 0 7 0 61 1 10 0 0 62 2 8 59 0 0 63 1 10 7 0 64 2 7 0 0 0 65 2 10 0 7 0 66 2 10 0 7 8 67 2 10 0 0 0 68 2 10 0 0 0 69 2 7 0 0 0 70 2 0 71 10 0 72 2 10 7 7 0 73 1 7 15 0 74 2 10 0 0 7 75 2 6 71 10 0 76 2 10 0 0 0 77 2 0 78 10 0 79 1 6 15 0 80 1 6 15 0 81 0 10 0 82 0 10 0 83 1 10 0 0 84 1 11 0 0 85 2 0 11 11 0 86 2 6 78 10 0 87 1 10 0 0 88 2 0 11 11 0 89 1 0 13 0 23 1 0 15 0 47 1 0 15 0 46 2 0 34 0 9 35 1 0 15 0 48 2 0 15 0 0 54 2 0 15 0 0 57 1 0 15 0 52 2 0 11 11 0 89 2 0 11 11 0 86 2 0 78 10 0 79 1 0 13 0 27 2 0 15 9 0 29 2 0 71 10 0 72 2 0 0 0 9 32 2 0 0 0 9 31 2 0 0 0 9 33 2 0 15 0 0 39)))))) (QUOTE |lookupComplete|)))

+@

+\section{domain GPOLSET GeneralPolynomialSet}

+<<domain GPOLSET GeneralPolynomialSet>>=

+)abbrev domain GPOLSET GeneralPolynomialSet

+++ Author: Marc Moreno Maza

+++ Date Created: 04/26/1994

+++ Date Last Updated: 12/15/1998

+++ Basic Functions:

+++ Related Constructors:

+++ Also See:

+++ AMS Classifications:

+++ Keywords: polynomial, multivariate, ordered variables set

+++ References:

+++ Description: A domain for polynomial sets.

+++ Version: 1

+

+GeneralPolynomialSet(R,E,VarSet,P) : Exports == Implementation where

+

+ R:Ring

+ VarSet:OrderedSet

+ E:OrderedAbelianMonoidSup

+ P:RecursivePolynomialCategory(R,E,VarSet)

+ LP ==> List P

+ PtoP ==> P -> P

+

+ Exports == PolynomialSetCategory(R,E,VarSet,P) with

+

+ convert : LP -> $

+ ++ \axiom{convert(lp)} returns the polynomial set whose members

+ ++ are the polynomials of \axiom{lp}.

+

+ finiteAggregate

+ shallowlyMutable

+

+ Implementation == add

+

+ Rep := List P

+

+ construct lp ==

+ (removeDuplicates(lp)$List(P))::$

+

+ copy ps ==

+ construct(copy(members(ps)$$)$LP)$$

+

+ empty() ==

+ []

+

+ parts ps ==

+ ps pretend LP

+

+ map (f : PtoP, ps : $) : $ ==

+ construct(map(f,members(ps))$LP)$$

+

+ map! (f : PtoP, ps : $) : $ ==

+ construct(map!(f,members(ps))$LP)$$

+

+ member? (p,ps) ==

+ member?(p,members(ps))$LP

+

+ ps1 = ps2 ==

+ {p for p in parts(ps1)} =$(Set P) {p for p in parts(ps2)}

+

+ coerce(ps:$) : OutputForm ==

+ lp : List(P) := sort(infRittWu?,members(ps))$(List P)

+ brace([p::OutputForm for p in lp]$List(OutputForm))$OutputForm

+

+ mvar ps ==

+ empty? ps => error"Error from GPOLSET in mvar : #1 is empty"

+ lv : List VarSet := variables(ps)

+ empty? lv => error"Error from GPOLSET in mvar : every polynomial in #1 is constant"

+ reduce(max,lv)$(List VarSet)

+

+ retractIfCan(lp) ==

+ (construct(lp))::Union($,"failed")

+

+ coerce(ps:$) : (List P) ==

+ ps pretend (List P)

+

+ convert(lp:LP) : $ ==

+ construct lp

+

+@

+\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>>

+

+<<category PSETCAT PolynomialSetCategory>>

+<<domain GPOLSET GeneralPolynomialSet>>

+@

+\eject

+\begin{thebibliography}{99}

+\bibitem{1} nothing

+\end{thebibliography}

+\end{document}