Initial population.

1 files changed, 846 insertions, 0 deletions

diff --git a/src/algebra/fraction.spad.pamphlet b/src/algebra/fraction.spad.pamphlet
new file mode 100644
index 00000000..51cbb0d4
--- /dev/null
+++ b/src/algebra/fraction.spad.pamphlet
@@ -0,0 +1,846 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/algebra fraction.spad}
+\author{Dave Barton, Barry Trager, James Davenport}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{domain LO Localize}
+<<domain LO Localize>>=
+)abbrev domain LO Localize
+++ Author: Dave Barton, Barry Trager
+++ Date Created:
+++ Date Last Updated:
+++ Basic Functions: + - / numer denom
+++ Related Constructors:
+++ Also See:
+++ AMS Classifications:
+++ Keywords: localization
+++ References:
+++ Description: Localize(M,R,S) produces fractions with numerators
+++ from an R module M and denominators from some multiplicative subset
+++ D of R.
+Localize(M:Module R,
+         R:CommutativeRing,
+         S:SubsetCategory(Monoid, R)): Module R with
+      if M has OrderedAbelianGroup then OrderedAbelianGroup
+      _/ :(%,S) -> %
+         ++ x / d divides the element x by d.
+      _/ :(M,S) -> %
+         ++ m / d divides the element m by d.
+      numer: % -> M
+         ++ numer x returns the numerator of x.
+      denom: % -> S
+         ++ denom x returns the denominator of x.
+ ==
+  add
+    --representation
+      Rep:= Record(num:M,den:S)
+    --declarations
+      x,y: %
+      n: Integer
+      m: M
+      r: R
+      d: S
+    --definitions
+      0 == [0,1]
+      zero? x == zero? (x.num)
+      -x== [-x.num,x.den]
+      x=y == y.den*x.num = x.den*y.num
+      numer x == x.num
+      denom x == x.den
+      if M has OrderedAbelianGroup then
+        x < y == 
+--             if y.den::R < 0 then (x,y):=(y,x)
+--             if x.den::R < 0 then (x,y):=(y,x)
+             y.den*x.num < x.den*y.num
+      x+y == [y.den*x.num+x.den*y.num, x.den*y.den]
+      n*x == [n*x.num,x.den]
+      r*x == if r=x.den then [x.num,1] else [r*x.num,x.den]
+      x/d ==
+        zero?(u:S:=d*x.den) => error "division by zero"
+        [x.num,u]
+      m/d == if zero? d then error "division by zero" else [m,d]
+      coerce(x:%):OutputForm ==
+--        one?(xd:=x.den) => (x.num)::OutputForm
+        ((xd:=x.den) = 1) => (x.num)::OutputForm
+        (x.num)::OutputForm / (xd::OutputForm)
+      latex(x:%): String ==
+--        one?(xd:=x.den) => latex(x.num)
+        ((xd:=x.den) = 1) => latex(x.num)
+        nl : String := concat("{", concat(latex(x.num), "}")$String)$String
+        dl : String := concat("{", concat(latex(x.den), "}")$String)$String
+        concat("{ ", concat(nl, concat(" \over ", concat(dl, " }")$String)$String)$String)$String
+
+@
+\section{domain LA LocalAlgebra}
+<<domain LA LocalAlgebra>>=
+)abbrev domain LA LocalAlgebra
+++ Author: Dave Barton, Barry Trager
+++ Date Created:
+++ Date Last Updated:
+++ Basic Functions:
+++ Related Constructors:
+++ Also See:
+++ AMS Classifications:
+++ Keywords:
+++ References:
+++ Description: LocalAlgebra produces the localization of an algebra, i.e.
+++ fractions whose numerators come from some R algebra.
+LocalAlgebra(A: Algebra R,
+             R: CommutativeRing,
+             S: SubsetCategory(Monoid, R)): Algebra R with
+          if A has OrderedRing then OrderedRing
+          _/ : (%,S) -> %
+            ++ x / d divides the element x by d.
+          _/ : (A,S) -> %
+            ++ a / d divides the element \spad{a} by d.
+          numer: % -> A
+            ++ numer x returns the numerator of x.
+          denom: % -> S
+            ++ denom x returns the denominator of x.
+ == Localize(A, R, S) add
+        1 == 1$A / 1$S
+        x:% * y:% == (numer(x) * numer(y)) / (denom(x) * denom(y))
+        characteristic() == characteristic()$A
+
+@
+\section{category QFCAT QuotientFieldCategory}
+<<category QFCAT QuotientFieldCategory>>=
+)abbrev category QFCAT QuotientFieldCategory
+++ Author:
+++ Date Created:
+++ Date Last Updated: 5th March 1996 
+++ Basic Functions: + - * / numer denom
+++ Related Constructors:
+++ Also See:
+++ AMS Classifications:
+++ Keywords:
+++ References:
+++ Description: QuotientField(S) is the
+++ category of fractions of an Integral Domain S.
+QuotientFieldCategory(S: IntegralDomain): Category ==
+  Join(Field, Algebra S, RetractableTo S, FullyEvalableOver S,
+         DifferentialExtension S, FullyLinearlyExplicitRingOver S,
+           Patternable S, FullyPatternMatchable S) with
+    _/     : (S, S) -> %
+       ++ d1 / d2 returns the fraction d1 divided by d2.
+    numer  : % -> S
+       ++ numer(x) returns the numerator of the fraction x.
+    denom  : % -> S
+       ++ denom(x) returns the denominator of the fraction x.
+    numerator : % -> %
+       ++ numerator(x) is the numerator of the fraction x converted to %.
+    denominator : % -> %
+       ++ denominator(x) is the denominator of the fraction x converted to %.
+    if S has StepThrough then StepThrough
+    if S has RetractableTo Integer then
+             RetractableTo Integer
+             RetractableTo Fraction Integer
+    if S has OrderedSet then OrderedSet
+    if S has OrderedIntegralDomain then OrderedIntegralDomain
+    if S has RealConstant then RealConstant
+    if S has ConvertibleTo InputForm then ConvertibleTo InputForm
+    if S has CharacteristicZero then CharacteristicZero
+    if S has CharacteristicNonZero then CharacteristicNonZero
+    if S has RetractableTo Symbol then RetractableTo Symbol
+    if S has EuclideanDomain then
+      wholePart: % -> S
+        ++ wholePart(x) returns the whole part of the fraction x
+        ++ i.e. the truncated quotient of the numerator by the denominator.
+      fractionPart: % -> %
+        ++ fractionPart(x) returns the fractional part of x.
+        ++ x = wholePart(x) + fractionPart(x)
+    if S has IntegerNumberSystem then
+      random: () -> %
+        ++ random() returns a random fraction.
+      ceiling : % -> S
+        ++ ceiling(x) returns the smallest integral element above x.
+      floor: % -> S
+        ++ floor(x) returns the largest integral element below x.
+    if S has PolynomialFactorizationExplicit then
+      PolynomialFactorizationExplicit
+
+ add
+    import MatrixCommonDenominator(S, %)
+    numerator(x) == numer(x)::%
+    denominator(x) == denom(x) ::%
+
+    if S has StepThrough then
+       init() == init()$S / 1$S
+
+       nextItem(n) ==
+         m:= nextItem(numer(n))
+         m case "failed" =>
+           error "We seem to have a Fraction of a finite object"
+         m / 1
+
+    map(fn, x)                         == (fn numer x) / (fn denom x)
+    reducedSystem(m:Matrix %):Matrix S == clearDenominator m
+    characteristic()                   == characteristic()$S
+
+    differentiate(x:%, deriv:S -> S) ==
+        n := numer x
+        d := denom x
+        (deriv n * d - n * deriv d) / (d**2)
+
+    if S has ConvertibleTo InputForm then
+      convert(x:%):InputForm == (convert numer x) / (convert denom x)
+
+    if S has RealConstant then
+      convert(x:%):Float == (convert numer x) / (convert denom x)
+      convert(x:%):DoubleFloat == (convert numer x) / (convert denom x)
+
+    -- Note that being a Join(OrderedSet,IntegralDomain) is not the same 
+    -- as being an OrderedIntegralDomain.
+    if S has OrderedIntegralDomain then
+       if S has canonicalUnitNormal then
+           x:% < y:% ==
+             (numer x  * denom y) < (numer y * denom x)
+         else
+           x:% < y:% ==
+             if denom(x) < 0 then (x,y):=(y,x)
+             if denom(y) < 0 then (x,y):=(y,x)
+             (numer x  * denom y) < (numer y * denom x)
+    else if S has OrderedSet then
+       x:% < y:% ==
+         (numer x  * denom y) < (numer y * denom x)
+
+    if (S has EuclideanDomain) then
+      fractionPart x == x - (wholePart(x)::%)
+
+    if S has RetractableTo Symbol then
+      coerce(s:Symbol):%  == s::S::%
+      retract(x:%):Symbol == retract(retract(x)@S)
+
+      retractIfCan(x:%):Union(Symbol, "failed") ==
+        (r := retractIfCan(x)@Union(S,"failed")) case "failed" =>"failed"
+        retractIfCan(r::S)
+
+    if (S has ConvertibleTo Pattern Integer) then
+      convert(x:%):Pattern(Integer)==(convert numer x)/(convert denom x)
+
+      if (S has PatternMatchable Integer) then
+        patternMatch(x:%, p:Pattern Integer,
+         l:PatternMatchResult(Integer, %)) ==
+           patternMatch(x, p,
+                     l)$PatternMatchQuotientFieldCategory(Integer, S, %)
+
+    if (S has ConvertibleTo Pattern Float) then
+      convert(x:%):Pattern(Float) == (convert numer x)/(convert denom x)
+
+      if (S has PatternMatchable Float) then
+        patternMatch(x:%, p:Pattern Float,
+         l:PatternMatchResult(Float, %)) ==
+           patternMatch(x, p,
+                       l)$PatternMatchQuotientFieldCategory(Float, S, %)
+
+    if S has RetractableTo Integer then
+      coerce(x:Fraction Integer):% == numer(x)::% / denom(x)::%
+
+      if not(S is Integer) then
+        retract(x:%):Integer == retract(retract(x)@S)
+
+        retractIfCan(x:%):Union(Integer, "failed") ==
+          (u := retractIfCan(x)@Union(S, "failed")) case "failed" =>
+            "failed"
+          retractIfCan(u::S)
+
+    if S has IntegerNumberSystem then
+      random():% ==
+        while zero?(d:=random()$S) repeat d
+        random()$S / d
+
+    reducedSystem(m:Matrix %, v:Vector %):
+      Record(mat:Matrix S, vec:Vector S) ==
+        n := reducedSystem(horizConcat(v::Matrix(%), m))@Matrix(S)
+        [subMatrix(n, minRowIndex n, maxRowIndex n, 1 + minColIndex n,
+                                maxColIndex n), column(n, minColIndex n)]
+
+@
+\section{QFCAT.lsp BOOTSTRAP}
+{\bf QFCAT} 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 QFCAT}
+category which we can write into the {\bf MID} directory. We compile 
+the lisp code and copy the {\bf QFCAT.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.
+
+<<QFCAT.lsp BOOTSTRAP>>=
+
+(|/VERSIONCHECK| 2) 
+
+(SETQ |QuotientFieldCategory;CAT| (QUOTE NIL)) 
+
+(SETQ |QuotientFieldCategory;AL| (QUOTE NIL)) 
+
+(DEFUN |QuotientFieldCategory| (#1=#:G103631) (LET (#2=#:G103632) (COND ((SETQ #2# (|assoc| (|devaluate| #1#) |QuotientFieldCategory;AL|)) (CDR #2#)) (T (SETQ |QuotientFieldCategory;AL| (|cons5| (CONS (|devaluate| #1#) (SETQ #2# (|QuotientFieldCategory;| #1#))) |QuotientFieldCategory;AL|)) #2#)))) 
+
+(DEFUN |QuotientFieldCategory;| (|t#1|) (PROG (#1=#:G103630) (RETURN (PROG1 (LETT #1# (|sublisV| (PAIR (QUOTE (|t#1|)) (LIST (|devaluate| |t#1|))) (COND (|QuotientFieldCategory;CAT|) ((QUOTE T) (LETT |QuotientFieldCategory;CAT| (|Join| (|Field|) (|Algebra| (QUOTE |t#1|)) (|RetractableTo| (QUOTE |t#1|)) (|FullyEvalableOver| (QUOTE |t#1|)) (|DifferentialExtension| (QUOTE |t#1|)) (|FullyLinearlyExplicitRingOver| (QUOTE |t#1|)) (|Patternable| (QUOTE |t#1|)) (|FullyPatternMatchable| (QUOTE |t#1|)) (|mkCategory| (QUOTE |domain|) (QUOTE (((|/| (|$| |t#1| |t#1|)) T) ((|numer| (|t#1| |$|)) T) ((|denom| (|t#1| |$|)) T) ((|numerator| (|$| |$|)) T) ((|denominator| (|$| |$|)) T) ((|wholePart| (|t#1| |$|)) (|has| |t#1| (|EuclideanDomain|))) ((|fractionPart| (|$| |$|)) (|has| |t#1| (|EuclideanDomain|))) ((|random| (|$|)) (|has| |t#1| (|IntegerNumberSystem|))) ((|ceiling| (|t#1| |$|)) (|has| |t#1| (|IntegerNumberSystem|))) ((|floor| (|t#1| |$|)) (|has| |t#1| (|IntegerNumberSystem|))))) (QUOTE (((|StepThrough|) (|has| |t#1| (|StepThrough|))) ((|RetractableTo| (|Integer|)) (|has| |t#1| (|RetractableTo| (|Integer|)))) ((|RetractableTo| (|Fraction| (|Integer|))) (|has| |t#1| (|RetractableTo| (|Integer|)))) ((|OrderedSet|) (|has| |t#1| (|OrderedSet|))) ((|OrderedIntegralDomain|) (|has| |t#1| (|OrderedIntegralDomain|))) ((|RealConstant|) (|has| |t#1| (|RealConstant|))) ((|ConvertibleTo| (|InputForm|)) (|has| |t#1| (|ConvertibleTo| (|InputForm|)))) ((|CharacteristicZero|) (|has| |t#1| (|CharacteristicZero|))) ((|CharacteristicNonZero|) (|has| |t#1| (|CharacteristicNonZero|))) ((|RetractableTo| (|Symbol|)) (|has| |t#1| (|RetractableTo| (|Symbol|)))) ((|PolynomialFactorizationExplicit|) (|has| |t#1| (|PolynomialFactorizationExplicit|))))) (QUOTE NIL) NIL)) . #2=(|QuotientFieldCategory|))))) . #2#) (SETELT #1# 0 (LIST (QUOTE |QuotientFieldCategory|) (|devaluate| |t#1|))))))) 
+@
+\section{QFCAT-.lsp BOOTSTRAP}
+{\bf QFCAT-} depends on {\bf QFCAT}. We need to break this cycle to build
+the algebra. So we keep a cached copy of the translated {\bf QFCAT-}
+category which we can write into the {\bf MID} directory. We compile 
+the lisp code and copy the {\bf QFCAT-.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.
+
+<<QFCAT-.lsp BOOTSTRAP>>=
+
+(|/VERSIONCHECK| 2) 
+
+(DEFUN |QFCAT-;numerator;2A;1| (|x| |$|) (SPADCALL (SPADCALL |x| (QREFELT |$| 8)) (QREFELT |$| 9))) 
+
+(DEFUN |QFCAT-;denominator;2A;2| (|x| |$|) (SPADCALL (SPADCALL |x| (QREFELT |$| 11)) (QREFELT |$| 9))) 
+
+(DEFUN |QFCAT-;init;A;3| (|$|) (SPADCALL (|spadConstant| |$| 13) (|spadConstant| |$| 14) (QREFELT |$| 15))) 
+
+(DEFUN |QFCAT-;nextItem;AU;4| (|n| |$|) (PROG (|m|) (RETURN (SEQ (LETT |m| (SPADCALL (SPADCALL |n| (QREFELT |$| 8)) (QREFELT |$| 18)) |QFCAT-;nextItem;AU;4|) (EXIT (COND ((QEQCAR |m| 1) (|error| "We seem to have a Fraction of a finite object")) ((QUOTE T) (CONS 0 (SPADCALL (QCDR |m|) (|spadConstant| |$| 14) (QREFELT |$| 15)))))))))) 
+
+(DEFUN |QFCAT-;map;M2A;5| (|fn| |x| |$|) (SPADCALL (SPADCALL (SPADCALL |x| (QREFELT |$| 8)) |fn|) (SPADCALL (SPADCALL |x| (QREFELT |$| 11)) |fn|) (QREFELT |$| 15))) 
+
+(DEFUN |QFCAT-;reducedSystem;MM;6| (|m| |$|) (SPADCALL |m| (QREFELT |$| 26))) 
+
+(DEFUN |QFCAT-;characteristic;Nni;7| (|$|) (SPADCALL (QREFELT |$| 30))) 
+
+(DEFUN |QFCAT-;differentiate;AMA;8| (|x| |deriv| |$|) (PROG (|n| |d|) (RETURN (SEQ (LETT |n| (SPADCALL |x| (QREFELT |$| 8)) |QFCAT-;differentiate;AMA;8|) (LETT |d| (SPADCALL |x| (QREFELT |$| 11)) |QFCAT-;differentiate;AMA;8|) (EXIT (SPADCALL (SPADCALL (SPADCALL (SPADCALL |n| |deriv|) |d| (QREFELT |$| 32)) (SPADCALL |n| (SPADCALL |d| |deriv|) (QREFELT |$| 32)) (QREFELT |$| 33)) (SPADCALL |d| 2 (QREFELT |$| 35)) (QREFELT |$| 15))))))) 
+
+(DEFUN |QFCAT-;convert;AIf;9| (|x| |$|) (SPADCALL (SPADCALL (SPADCALL |x| (QREFELT |$| 8)) (QREFELT |$| 38)) (SPADCALL (SPADCALL |x| (QREFELT |$| 11)) (QREFELT |$| 38)) (QREFELT |$| 39))) 
+
+(DEFUN |QFCAT-;convert;AF;10| (|x| |$|) (SPADCALL (SPADCALL (SPADCALL |x| (QREFELT |$| 8)) (QREFELT |$| 42)) (SPADCALL (SPADCALL |x| (QREFELT |$| 11)) (QREFELT |$| 42)) (QREFELT |$| 43))) 
+
+(DEFUN |QFCAT-;convert;ADf;11| (|x| |$|) (|/| (SPADCALL (SPADCALL |x| (QREFELT |$| 8)) (QREFELT |$| 46)) (SPADCALL (SPADCALL |x| (QREFELT |$| 11)) (QREFELT |$| 46)))) 
+
+(DEFUN |QFCAT-;<;2AB;12| (|x| |y| |$|) (SPADCALL (SPADCALL (SPADCALL |x| (QREFELT |$| 8)) (SPADCALL |y| (QREFELT |$| 11)) (QREFELT |$| 32)) (SPADCALL (SPADCALL |y| (QREFELT |$| 8)) (SPADCALL |x| (QREFELT |$| 11)) (QREFELT |$| 32)) (QREFELT |$| 49))) 
+
+(DEFUN |QFCAT-;<;2AB;13| (|x| |y| |$|) (PROG (|#G19| |#G20| |#G21| |#G22|) (RETURN (SEQ (COND ((SPADCALL (SPADCALL |x| (QREFELT |$| 11)) (|spadConstant| |$| 51) (QREFELT |$| 49)) (PROGN (LETT |#G19| |y| |QFCAT-;<;2AB;13|) (LETT |#G20| |x| |QFCAT-;<;2AB;13|) (LETT |x| |#G19| |QFCAT-;<;2AB;13|) (LETT |y| |#G20| |QFCAT-;<;2AB;13|)))) (COND ((SPADCALL (SPADCALL |y| (QREFELT |$| 11)) (|spadConstant| |$| 51) (QREFELT |$| 49)) (PROGN (LETT |#G21| |y| |QFCAT-;<;2AB;13|) (LETT |#G22| |x| |QFCAT-;<;2AB;13|) (LETT |x| |#G21| |QFCAT-;<;2AB;13|) (LETT |y| |#G22| |QFCAT-;<;2AB;13|)))) (EXIT (SPADCALL (SPADCALL (SPADCALL |x| (QREFELT |$| 8)) (SPADCALL |y| (QREFELT |$| 11)) (QREFELT |$| 32)) (SPADCALL (SPADCALL |y| (QREFELT |$| 8)) (SPADCALL |x| (QREFELT |$| 11)) (QREFELT |$| 32)) (QREFELT |$| 49))))))) 
+
+(DEFUN |QFCAT-;<;2AB;14| (|x| |y| |$|) (SPADCALL (SPADCALL (SPADCALL |x| (QREFELT |$| 8)) (SPADCALL |y| (QREFELT |$| 11)) (QREFELT |$| 32)) (SPADCALL (SPADCALL |y| (QREFELT |$| 8)) (SPADCALL |x| (QREFELT |$| 11)) (QREFELT |$| 32)) (QREFELT |$| 49))) 
+
+(DEFUN |QFCAT-;fractionPart;2A;15| (|x| |$|) (SPADCALL |x| (SPADCALL (SPADCALL |x| (QREFELT |$| 52)) (QREFELT |$| 9)) (QREFELT |$| 53))) 
+
+(DEFUN |QFCAT-;coerce;SA;16| (|s| |$|) (SPADCALL (SPADCALL |s| (QREFELT |$| 56)) (QREFELT |$| 9))) 
+
+(DEFUN |QFCAT-;retract;AS;17| (|x| |$|) (SPADCALL (SPADCALL |x| (QREFELT |$| 58)) (QREFELT |$| 59))) 
+
+(DEFUN |QFCAT-;retractIfCan;AU;18| (|x| |$|) (PROG (|r|) (RETURN (SEQ (LETT |r| (SPADCALL |x| (QREFELT |$| 62)) |QFCAT-;retractIfCan;AU;18|) (EXIT (COND ((QEQCAR |r| 1) (CONS 1 "failed")) ((QUOTE T) (SPADCALL (QCDR |r|) (QREFELT |$| 64))))))))) 
+
+(DEFUN |QFCAT-;convert;AP;19| (|x| |$|) (SPADCALL (SPADCALL (SPADCALL |x| (QREFELT |$| 8)) (QREFELT |$| 67)) (SPADCALL (SPADCALL |x| (QREFELT |$| 11)) (QREFELT |$| 67)) (QREFELT |$| 68))) 
+
+(DEFUN |QFCAT-;patternMatch;AP2Pmr;20| (|x| |p| |l| |$|) (SPADCALL |x| |p| |l| (QREFELT |$| 72))) 
+
+(DEFUN |QFCAT-;convert;AP;21| (|x| |$|) (SPADCALL (SPADCALL (SPADCALL |x| (QREFELT |$| 8)) (QREFELT |$| 76)) (SPADCALL (SPADCALL |x| (QREFELT |$| 11)) (QREFELT |$| 76)) (QREFELT |$| 77))) 
+
+(DEFUN |QFCAT-;patternMatch;AP2Pmr;22| (|x| |p| |l| |$|) (SPADCALL |x| |p| |l| (QREFELT |$| 81))) 
+
+(DEFUN |QFCAT-;coerce;FA;23| (|x| |$|) (SPADCALL (SPADCALL (SPADCALL |x| (QREFELT |$| 86)) (QREFELT |$| 87)) (SPADCALL (SPADCALL |x| (QREFELT |$| 88)) (QREFELT |$| 87)) (QREFELT |$| 89))) 
+
+(DEFUN |QFCAT-;retract;AI;24| (|x| |$|) (SPADCALL (SPADCALL |x| (QREFELT |$| 58)) (QREFELT |$| 91))) 
+
+(DEFUN |QFCAT-;retractIfCan;AU;25| (|x| |$|) (PROG (|u|) (RETURN (SEQ (LETT |u| (SPADCALL |x| (QREFELT |$| 62)) |QFCAT-;retractIfCan;AU;25|) (EXIT (COND ((QEQCAR |u| 1) (CONS 1 "failed")) ((QUOTE T) (SPADCALL (QCDR |u|) (QREFELT |$| 94))))))))) 
+
+(DEFUN |QFCAT-;random;A;26| (|$|) (PROG (|d|) (RETURN (SEQ (SEQ G190 (COND ((NULL (SPADCALL (LETT |d| (SPADCALL (QREFELT |$| 96)) |QFCAT-;random;A;26|) (QREFELT |$| 97))) (GO G191))) (SEQ (EXIT |d|)) NIL (GO G190) G191 (EXIT NIL)) (EXIT (SPADCALL (SPADCALL (QREFELT |$| 96)) |d| (QREFELT |$| 15))))))) 
+
+(DEFUN |QFCAT-;reducedSystem;MVR;27| (|m| |v| |$|) (PROG (|n|) (RETURN (SEQ (LETT |n| (SPADCALL (SPADCALL (SPADCALL |v| (QREFELT |$| 100)) |m| (QREFELT |$| 101)) (QREFELT |$| 102)) |QFCAT-;reducedSystem;MVR;27|) (EXIT (CONS (SPADCALL |n| (SPADCALL |n| (QREFELT |$| 103)) (SPADCALL |n| (QREFELT |$| 104)) (|+| 1 (SPADCALL |n| (QREFELT |$| 105))) (SPADCALL |n| (QREFELT |$| 106)) (QREFELT |$| 107)) (SPADCALL |n| (SPADCALL |n| (QREFELT |$| 105)) (QREFELT |$| 109)))))))) 
+
+(DEFUN |QuotientFieldCategory&| (|#1| |#2|) (PROG (|DV$1| |DV$2| |dv$| |$| |pv$|) (RETURN (PROGN (LETT |DV$1| (|devaluate| |#1|) . #1=(|QuotientFieldCategory&|)) (LETT |DV$2| (|devaluate| |#2|) . #1#) (LETT |dv$| (LIST (QUOTE |QuotientFieldCategory&|) |DV$1| |DV$2|) . #1#) (LETT |$| (GETREFV 119) . #1#) (QSETREFV |$| 0 |dv$|) (QSETREFV |$| 3 (LETT |pv$| (|buildPredVector| 0 0 (LIST (|HasCategory| |#2| (QUOTE (|PolynomialFactorizationExplicit|))) (|HasCategory| |#2| (QUOTE (|IntegerNumberSystem|))) (|HasCategory| |#2| (QUOTE (|EuclideanDomain|))) (|HasCategory| |#2| (QUOTE (|RetractableTo| (|Symbol|)))) (|HasCategory| |#2| (QUOTE (|CharacteristicNonZero|))) (|HasCategory| |#2| (QUOTE (|CharacteristicZero|))) (|HasCategory| |#2| (QUOTE (|ConvertibleTo| (|InputForm|)))) (|HasCategory| |#2| (QUOTE (|RealConstant|))) (|HasCategory| |#2| (QUOTE (|OrderedIntegralDomain|))) (|HasCategory| |#2| (QUOTE (|OrderedSet|))) (|HasCategory| |#2| (QUOTE (|RetractableTo| (|Integer|)))) (|HasCategory| |#2| (QUOTE (|StepThrough|))))) . #1#)) (|stuffDomainSlots| |$|) (QSETREFV |$| 6 |#1|) (QSETREFV |$| 7 |#2|) (COND ((|testBitVector| |pv$| 12) (PROGN (QSETREFV |$| 16 (CONS (|dispatchFunction| |QFCAT-;init;A;3|) |$|)) (QSETREFV |$| 20 (CONS (|dispatchFunction| |QFCAT-;nextItem;AU;4|) |$|))))) (COND ((|testBitVector| |pv$| 7) (QSETREFV |$| 40 (CONS (|dispatchFunction| |QFCAT-;convert;AIf;9|) |$|)))) (COND ((|testBitVector| |pv$| 8) (PROGN (QSETREFV |$| 44 (CONS (|dispatchFunction| |QFCAT-;convert;AF;10|) |$|)) (QSETREFV |$| 47 (CONS (|dispatchFunction| |QFCAT-;convert;ADf;11|) |$|))))) (COND ((|testBitVector| |pv$| 9) (COND ((|HasAttribute| |#2| (QUOTE |canonicalUnitNormal|)) (QSETREFV |$| 50 (CONS (|dispatchFunction| |QFCAT-;<;2AB;12|) |$|))) ((QUOTE T) (QSETREFV |$| 50 (CONS (|dispatchFunction| |QFCAT-;<;2AB;13|) |$|))))) ((|testBitVector| |pv$| 10) (QSETREFV |$| 50 (CONS (|dispatchFunction| |QFCAT-;<;2AB;14|) |$|)))) (COND ((|testBitVector| |pv$| 3) (QSETREFV |$| 54 (CONS (|dispatchFunction| |QFCAT-;fractionPart;2A;15|) |$|)))) (COND ((|testBitVector| |pv$| 4) (PROGN (QSETREFV |$| 57 (CONS (|dispatchFunction| |QFCAT-;coerce;SA;16|) |$|)) (QSETREFV |$| 60 (CONS (|dispatchFunction| |QFCAT-;retract;AS;17|) |$|)) (QSETREFV |$| 65 (CONS (|dispatchFunction| |QFCAT-;retractIfCan;AU;18|) |$|))))) (COND ((|HasCategory| |#2| (QUOTE (|ConvertibleTo| (|Pattern| (|Integer|))))) (PROGN (QSETREFV |$| 69 (CONS (|dispatchFunction| |QFCAT-;convert;AP;19|) |$|)) (COND ((|HasCategory| |#2| (QUOTE (|PatternMatchable| (|Integer|)))) (QSETREFV |$| 74 (CONS (|dispatchFunction| |QFCAT-;patternMatch;AP2Pmr;20|) |$|))))))) (COND ((|HasCategory| |#2| (QUOTE (|ConvertibleTo| (|Pattern| (|Float|))))) (PROGN (QSETREFV |$| 78 (CONS (|dispatchFunction| |QFCAT-;convert;AP;21|) |$|)) (COND ((|HasCategory| |#2| (QUOTE (|PatternMatchable| (|Float|)))) (QSETREFV |$| 83 (CONS (|dispatchFunction| |QFCAT-;patternMatch;AP2Pmr;22|) |$|))))))) (COND ((|testBitVector| |pv$| 11) (PROGN (QSETREFV |$| 90 (CONS (|dispatchFunction| |QFCAT-;coerce;FA;23|) |$|)) (COND ((|domainEqual| |#2| (|Integer|))) ((QUOTE T) (PROGN (QSETREFV |$| 92 (CONS (|dispatchFunction| |QFCAT-;retract;AI;24|) |$|)) (QSETREFV |$| 95 (CONS (|dispatchFunction| |QFCAT-;retractIfCan;AU;25|) |$|)))))))) (COND ((|testBitVector| |pv$| 2) (QSETREFV |$| 98 (CONS (|dispatchFunction| |QFCAT-;random;A;26|) |$|)))) |$|)))) 
+
+(MAKEPROP (QUOTE |QuotientFieldCategory&|) (QUOTE |infovec|) (LIST (QUOTE #(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|) (0 . |numer|) (5 . |coerce|) |QFCAT-;numerator;2A;1| (10 . |denom|) |QFCAT-;denominator;2A;2| (15 . |init|) (19 . |One|) (23 . |/|) (29 . |init|) (|Union| |$| (QUOTE "failed")) (33 . |nextItem|) (38 . |One|) (42 . |nextItem|) (|Mapping| 7 7) |QFCAT-;map;M2A;5| (|Matrix| 7) (|Matrix| 6) (|MatrixCommonDenominator| 7 6) (47 . |clearDenominator|) (|Matrix| |$|) |QFCAT-;reducedSystem;MM;6| (|NonNegativeInteger|) (52 . |characteristic|) |QFCAT-;characteristic;Nni;7| (56 . |*|) (62 . |-|) (|PositiveInteger|) (68 . |**|) |QFCAT-;differentiate;AMA;8| (|InputForm|) (74 . |convert|) (79 . |/|) (85 . |convert|) (|Float|) (90 . |convert|) (95 . |/|) (101 . |convert|) (|DoubleFloat|) (106 . |convert|) (111 . |convert|) (|Boolean|) (116 . |<|) (122 . |<|) (128 . |Zero|) (132 . |wholePart|) (137 . |-|) (143 . |fractionPart|) (|Symbol|) (148 . |coerce|) (153 . |coerce|) (158 . |retract|) (163 . |retract|) (168 . |retract|) (|Union| 7 (QUOTE "failed")) (173 . |retractIfCan|) (|Union| 55 (QUOTE "failed")) (178 . |retractIfCan|) (183 . |retractIfCan|) (|Pattern| 84) (188 . |convert|) (193 . |/|) (199 . |convert|) (|PatternMatchResult| 84 6) (|PatternMatchQuotientFieldCategory| 84 7 6) (204 . |patternMatch|) (|PatternMatchResult| 84 |$|) (211 . |patternMatch|) (|Pattern| 41) (218 . |convert|) (223 . |/|) (229 . |convert|) (|PatternMatchResult| 41 6) (|PatternMatchQuotientFieldCategory| 41 7 6) (234 . |patternMatch|) (|PatternMatchResult| 41 |$|) (241 . |patternMatch|) (|Integer|) (|Fraction| 84) (248 . |numer|) (253 . |coerce|) (258 . |denom|) (263 . |/|) (269 . |coerce|) (274 . |retract|) (279 . |retract|) (|Union| 84 (QUOTE "failed")) (284 . |retractIfCan|) (289 . |retractIfCan|) (294 . |random|) (298 . |zero?|) (303 . |random|) (|Vector| 6) (307 . |coerce|) (312 . |horizConcat|) (318 . |reducedSystem|) (323 . |minRowIndex|) (328 . |maxRowIndex|) (333 . |minColIndex|) (338 . |maxColIndex|) (343 . |subMatrix|) (|Vector| 7) (352 . |column|) (|Record| (|:| |mat| 23) (|:| |vec| 108)) (|Vector| |$|) |QFCAT-;reducedSystem;MVR;27| (|Union| 85 (QUOTE "failed")) (|Record| (|:| |mat| 115) (|:| |vec| (|Vector| 84))) (|Matrix| 84) (|List| 55) (|List| 29) (|OutputForm|))) (QUOTE #(|retractIfCan| 358 |retract| 368 |reducedSystem| 378 |random| 389 |patternMatch| 393 |numerator| 407 |nextItem| 412 |map| 417 |init| 423 |fractionPart| 427 |differentiate| 432 |denominator| 438 |convert| 443 |coerce| 468 |characteristic| 478 |<| 482)) (QUOTE NIL) (CONS (|makeByteWordVec2| 1 (QUOTE NIL)) (CONS (QUOTE #()) (CONS (QUOTE #()) (|makeByteWordVec2| 112 (QUOTE (1 6 7 0 8 1 6 0 7 9 1 6 7 0 11 0 7 0 13 0 7 0 14 2 6 0 7 7 15 0 0 0 16 1 7 17 0 18 0 6 0 19 1 0 17 0 20 1 25 23 24 26 0 7 29 30 2 7 0 0 0 32 2 7 0 0 0 33 2 7 0 0 34 35 1 7 37 0 38 2 37 0 0 0 39 1 0 37 0 40 1 7 41 0 42 2 41 0 0 0 43 1 0 41 0 44 1 7 45 0 46 1 0 45 0 47 2 7 48 0 0 49 2 0 48 0 0 50 0 7 0 51 1 6 7 0 52 2 6 0 0 0 53 1 0 0 0 54 1 7 0 55 56 1 0 0 55 57 1 6 7 0 58 1 7 55 0 59 1 0 55 0 60 1 6 61 0 62 1 7 63 0 64 1 0 63 0 65 1 7 66 0 67 2 66 0 0 0 68 1 0 66 0 69 3 71 70 6 66 70 72 3 0 73 0 66 73 74 1 7 75 0 76 2 75 0 0 0 77 1 0 75 0 78 3 80 79 6 75 79 81 3 0 82 0 75 82 83 1 85 84 0 86 1 6 0 84 87 1 85 84 0 88 2 6 0 0 0 89 1 0 0 85 90 1 7 84 0 91 1 0 84 0 92 1 7 93 0 94 1 0 93 0 95 0 7 0 96 1 7 48 0 97 0 0 0 98 1 24 0 99 100 2 24 0 0 0 101 1 6 23 27 102 1 23 84 0 103 1 23 84 0 104 1 23 84 0 105 1 23 84 0 106 5 23 0 0 84 84 84 84 107 2 23 108 0 84 109 1 0 93 0 95 1 0 63 0 65 1 0 84 0 92 1 0 55 0 60 2 0 110 27 111 112 1 0 23 27 28 0 0 0 98 3 0 82 0 75 82 83 3 0 73 0 66 73 74 1 0 0 0 10 1 0 17 0 20 2 0 0 21 0 22 0 0 0 16 1 0 0 0 54 2 0 0 0 21 36 1 0 0 0 12 1 0 45 0 47 1 0 37 0 40 1 0 41 0 44 1 0 66 0 69 1 0 75 0 78 1 0 0 55 57 1 0 0 85 90 0 0 29 31 2 0 48 0 0 50)))))) (QUOTE |lookupComplete|))) 
+@
+\section{package QFCAT2 QuotientFieldCategoryFunctions2}
+<<package QFCAT2 QuotientFieldCategoryFunctions2>>=
+)abbrev package QFCAT2 QuotientFieldCategoryFunctions2
+++ Author:
+++ Date Created:
+++ Date Last Updated:
+++ Basic Functions:
+++ Related Constructors:
+++ Also See:
+++ AMS Classifications:
+++ Keywords:
+++ References:
+++ Description:
+++ This package extends a function between integral domains
+++ to a mapping between their quotient fields.
+QuotientFieldCategoryFunctions2(A, B, R, S): Exports == Impl where
+  A, B: IntegralDomain
+  R   : QuotientFieldCategory(A)
+  S   : QuotientFieldCategory(B)
+
+  Exports ==> with
+    map: (A -> B, R) -> S
+      ++ map(func,frac) applies the function func to the numerator
+      ++ and denominator of frac.
+
+  Impl ==> add
+    map(f, r) == f(numer r) / f(denom r)
+
+@
+\section{domain FRAC Fraction}
+<<domain FRAC Fraction>>=
+)abbrev domain FRAC Fraction
+++ Author:
+++ Date Created:
+++ Date Last Updated: 12 February 1992
+++ Basic Functions: Field, numer, denom
+++ Related Constructors:
+++ Also See:
+++ AMS Classifications:
+++ Keywords: fraction, localization
+++ References:
+++ Description: Fraction takes an IntegralDomain S and produces
+++ the domain of Fractions with numerators and denominators from S.
+++ If S is also a GcdDomain, then gcd's between numerator and
+++ denominator will be cancelled during all operations.
+Fraction(S: IntegralDomain): QuotientFieldCategory S with 
+       if S has IntegerNumberSystem and S has OpenMath then OpenMath
+       if S has canonical and S has GcdDomain and S has canonicalUnitNormal
+           then canonical
+            ++ \spad{canonical} means that equal elements are in fact identical.
+  == LocalAlgebra(S, S, S) add
+    Rep:= Record(num:S, den:S)
+    coerce(d:S):% == [d,1]
+    zero?(x:%) == zero? x.num
+
+
+    if S has GcdDomain and S has canonicalUnitNormal then
+      retract(x:%):S ==
+--        one?(x.den) => x.num
+        ((x.den) = 1) => x.num
+        error "Denominator not equal to 1"
+
+      retractIfCan(x:%):Union(S, "failed") ==
+--        one?(x.den) => x.num
+        ((x.den) = 1) => x.num
+        "failed"
+    else
+      retract(x:%):S ==
+        (a:= x.num exquo x.den) case "failed" =>
+           error "Denominator not equal to 1"
+        a
+      retractIfCan(x:%):Union(S,"failed") == x.num exquo x.den
+
+    if S has EuclideanDomain then
+      wholePart x ==
+--        one?(x.den) => x.num
+        ((x.den) = 1) => x.num
+        x.num quo x.den
+
+    if S has IntegerNumberSystem then
+
+      floor x ==
+--        one?(x.den) => x.num
+        ((x.den) = 1) => x.num
+        x < 0 => -ceiling(-x)
+        wholePart x
+
+      ceiling x ==
+--        one?(x.den) => x.num
+        ((x.den) = 1) => x.num
+        x < 0 => -floor(-x)
+        1 + wholePart x
+
+      if S has OpenMath then
+        -- TODO: somwhere this file does something which redefines the division
+        -- operator. Doh!
+
+        writeOMFrac(dev: OpenMathDevice, x: %): Void ==
+          OMputApp(dev)
+          OMputSymbol(dev, "nums1", "rational")
+          OMwrite(dev, x.num, false)
+          OMwrite(dev, x.den, false)
+          OMputEndApp(dev)
+
+        OMwrite(x: %): String ==
+          s: String := ""
+          sp := OM_-STRINGTOSTRINGPTR(s)$Lisp
+          dev: OpenMathDevice := _
+		  	OMopenString(sp pretend String, OMencodingXML)
+          OMputObject(dev)
+          writeOMFrac(dev, x)
+          OMputEndObject(dev)
+          OMclose(dev)
+          s := OM_-STRINGPTRTOSTRING(sp)$Lisp pretend String
+          s
+
+        OMwrite(x: %, wholeObj: Boolean): String ==
+          s: String := ""
+          sp := OM_-STRINGTOSTRINGPTR(s)$Lisp
+          dev: OpenMathDevice := _
+		  	OMopenString(sp pretend String, OMencodingXML)
+          if wholeObj then
+            OMputObject(dev)
+          writeOMFrac(dev, x)
+          if wholeObj then
+            OMputEndObject(dev)
+          OMclose(dev)
+          s := OM_-STRINGPTRTOSTRING(sp)$Lisp pretend String
+          s
+
+        OMwrite(dev: OpenMathDevice, x: %): Void ==
+          OMputObject(dev)
+          writeOMFrac(dev, x)
+          OMputEndObject(dev)
+
+        OMwrite(dev: OpenMathDevice, x: %, wholeObj: Boolean): Void ==
+          if wholeObj then
+            OMputObject(dev)
+          writeOMFrac(dev, x)
+          if wholeObj then
+            OMputEndObject(dev)
+
+    if S has GcdDomain then
+      cancelGcd: % -> S
+      normalize: % -> %
+
+      normalize x ==
+        zero?(x.num) => 0
+--        one?(x.den) => x
+        ((x.den) = 1) => x
+        uca := unitNormal(x.den)
+        zero?(x.den := uca.canonical) => error "division by zero"
+        x.num := x.num * uca.associate
+        x
+
+      recip x ==
+        zero?(x.num) => "failed"
+        normalize [x.den, x.num]
+
+      cancelGcd x ==
+--        one?(x.den) => x.den
+        ((x.den) = 1) => x.den
+        d := gcd(x.num, x.den)
+        xn := x.num exquo d
+        xn case "failed" =>
+          error "gcd not gcd in QF cancelGcd (numerator)"
+        xd := x.den exquo d
+        xd case "failed" =>
+          error "gcd not gcd in QF cancelGcd (denominator)"
+        x.num := xn :: S
+        x.den := xd :: S
+        d
+
+      nn:S / dd:S ==
+        zero? dd => error "division by zero"
+        cancelGcd(z := [nn, dd])
+        normalize z
+
+      x + y  ==
+        zero? y => x
+        zero? x => y
+        z := [x.den,y.den]
+        d := cancelGcd z
+        g := [z.den * x.num + z.num * y.num, d]
+        cancelGcd g
+        g.den := g.den * z.num * z.den
+        normalize g
+
+      -- We can not rely on the defaulting mechanism
+      -- to supply a definition for -, even though this
+      -- definition would do, for thefollowing reasons:
+      --  1) The user could have defined a subtraction
+      --     in Localize, which would not work for
+      --     QuotientField;
+      --  2) even if he doesn't, the system currently
+      --     places a default definition in Localize,
+      --     which uses Localize's +, which does not
+      --     cancel gcds
+      x - y  ==
+        zero? y => x
+        z := [x.den, y.den]
+        d := cancelGcd z
+        g := [z.den * x.num - z.num * y.num, d]
+        cancelGcd g
+        g.den := g.den * z.num * z.den
+        normalize g
+
+      x:% * y:%  ==
+        zero? x or zero? y => 0
+--        one? x => y
+        (x = 1) => y
+--        one? y => x
+        (y = 1) => x
+        (x, y) := ([x.num, y.den], [y.num, x.den])
+        cancelGcd x; cancelGcd y;
+        normalize [x.num * y.num, x.den * y.den]
+
+      n:Integer * x:% ==
+        y := [n::S, x.den]
+        cancelGcd y
+        normalize [x.num * y.num, y.den]
+
+      nn:S * x:% ==
+        y := [nn, x.den]
+        cancelGcd y
+        normalize [x.num * y.num, y.den]
+
+      differentiate(x:%, deriv:S -> S) ==
+        y := [deriv(x.den), x.den]
+        d := cancelGcd(y)
+        y.num := deriv(x.num) * y.den - x.num * y.num
+        (d, y.den) := (y.den, d)
+        cancelGcd y
+        y.den := y.den * d * d
+        normalize y
+
+      if S has canonicalUnitNormal then
+        x = y == (x.num = y.num) and (x.den = y.den)
+    --x / dd == (cancelGcd (z:=[x.num,dd*x.den]); normalize z)
+
+--        one? x == one? (x.num) and one? (x.den)
+        one? x == ((x.num) = 1) and ((x.den) = 1)
+                  -- again assuming canonical nature of representation
+
+    else
+      nn:S/dd:S == if zero? dd then error "division by zero" else [nn,dd]
+
+      recip x ==
+        zero?(x.num) => "failed"
+        [x.den, x.num]
+
+    if (S has RetractableTo Fraction Integer) then
+      retract(x:%):Fraction(Integer) == retract(retract(x)@S)
+
+      retractIfCan(x:%):Union(Fraction Integer, "failed") ==
+        (u := retractIfCan(x)@Union(S, "failed")) case "failed" => "failed"
+        retractIfCan(u::S)
+
+    else if (S has RetractableTo Integer) then
+      retract(x:%):Fraction(Integer) ==
+        retract(numer x) / retract(denom x)
+
+      retractIfCan(x:%):Union(Fraction Integer, "failed") ==
+        (n := retractIfCan numer x) case "failed" => "failed"
+        (d := retractIfCan denom x) case "failed" => "failed"
+        (n::Integer) / (d::Integer)
+
+    QFP ==> SparseUnivariatePolynomial %
+    DP ==> SparseUnivariatePolynomial S
+    import UnivariatePolynomialCategoryFunctions2(%,QFP,S,DP)
+    import UnivariatePolynomialCategoryFunctions2(S,DP,%,QFP)
+
+    if S has GcdDomain then
+       gcdPolynomial(pp,qq) ==
+          zero? pp => qq
+          zero? qq => pp
+          zero? degree pp or zero? degree qq => 1
+          denpp:="lcm"/[denom u for u in coefficients pp]
+          ppD:DP:=map(retract(#1*denpp),pp)
+          denqq:="lcm"/[denom u for u in coefficients qq]
+          qqD:DP:=map(retract(#1*denqq),qq)
+          g:=gcdPolynomial(ppD,qqD)
+          zero? degree g => 1
+--          one? (lc:=leadingCoefficient g) => map(#1::%,g)
+          ((lc:=leadingCoefficient g) = 1) => map(#1::%,g)
+          map(#1 / lc,g)
+
+    if (S has PolynomialFactorizationExplicit) then
+       -- we'll let the solveLinearPolynomialEquations operator
+       -- default from Field
+       pp,qq: QFP
+       lpp: List QFP
+       import Factored SparseUnivariatePolynomial %
+       if S has CharacteristicNonZero then
+          if S has canonicalUnitNormal and S has GcdDomain then
+             charthRoot x ==
+               n:= charthRoot x.num
+               n case "failed" => "failed"
+               d:=charthRoot x.den
+               d case "failed" => "failed"
+               n/d
+          else
+             charthRoot x ==
+               -- to find x = p-th root of n/d
+               -- observe that xd is p-th root of n*d**(p-1)
+               ans:=charthRoot(x.num *
+                      (x.den)**(characteristic()$%-1)::NonNegativeInteger)
+               ans case "failed" => "failed"
+               ans / x.den
+          clear: List % -> List S
+          clear l ==
+             d:="lcm"/[x.den for x in l]
+             [ x.num * (d exquo x.den)::S for x in l]
+          mat: Matrix %
+          conditionP mat ==
+            matD: Matrix S
+            matD:= matrix [ clear l for l in listOfLists mat ]
+            ansD := conditionP matD
+            ansD case "failed" => "failed"
+            ansDD:=ansD :: Vector(S)
+            [ ansDD(i)::% for i in 1..#ansDD]$Vector(%)
+
+       factorPolynomial(pp) ==
+          zero? pp => 0
+          denpp:="lcm"/[denom u for u in coefficients pp]
+          ppD:DP:=map(retract(#1*denpp),pp)
+          ff:=factorPolynomial ppD
+          den1:%:=denpp::%
+          lfact:List Record(flg:Union("nil", "sqfr", "irred", "prime"),
+                             fctr:QFP, xpnt:Integer)
+          lfact:= [[w.flg,
+                    if leadingCoefficient w.fctr =1 then map(#1::%,w.fctr)
+                    else (lc:=(leadingCoefficient w.fctr)::%;
+                           den1:=den1/lc**w.xpnt;
+                            map(#1::%/lc,w.fctr)),
+                   w.xpnt] for w in factorList ff]
+          makeFR(map(#1::%/den1,unit(ff)),lfact)
+       factorSquareFreePolynomial(pp) ==
+          zero? pp => 0
+          degree pp = 0 => makeFR(pp,empty())
+          lcpp:=leadingCoefficient pp
+          pp:=pp/lcpp
+          denpp:="lcm"/[denom u for u in coefficients pp]
+          ppD:DP:=map(retract(#1*denpp),pp)
+          ff:=factorSquareFreePolynomial ppD
+          den1:%:=denpp::%/lcpp
+          lfact:List Record(flg:Union("nil", "sqfr", "irred", "prime"),
+                             fctr:QFP, xpnt:Integer)
+          lfact:= [[w.flg,
+                    if leadingCoefficient w.fctr =1 then map(#1::%,w.fctr)
+                    else (lc:=(leadingCoefficient w.fctr)::%;
+                           den1:=den1/lc**w.xpnt;
+                            map(#1::%/lc,w.fctr)),
+                   w.xpnt] for w in factorList ff]
+          makeFR(map(#1::%/den1,unit(ff)),lfact)
+
+@
+\section{package LPEFRAC LinearPolynomialEquationByFractions}
+<<package LPEFRAC LinearPolynomialEquationByFractions>>=
+)abbrev package LPEFRAC LinearPolynomialEquationByFractions
+++ Author: James Davenport
+++ Date Created:
+++ Date Last Updated:
+++ Basic Functions:
+++ Related Constructors:
+++ Also See:
+++ AMS Classifications:
+++ Keywords:
+++ References:
+++ Description:
+++ Given a PolynomialFactorizationExplicit ring, this package
+++ provides a defaulting rule for the \spad{solveLinearPolynomialEquation}
+++ operation, by moving into the field of fractions, and solving it there
+++ via the \spad{multiEuclidean} operation.
+LinearPolynomialEquationByFractions(R:PolynomialFactorizationExplicit): with
+  solveLinearPolynomialEquationByFractions: ( _
+           List SparseUnivariatePolynomial R, _
+           SparseUnivariatePolynomial R) ->   _
+           Union(List SparseUnivariatePolynomial R, "failed")
+        ++ solveLinearPolynomialEquationByFractions([f1, ..., fn], g)
+        ++ (where the fi are relatively prime to each other)
+        ++ returns a list of ai such that
+        ++ \spad{g/prod fi = sum ai/fi}
+        ++ or returns "failed" if no such exists.
+ == add
+  SupR ==> SparseUnivariatePolynomial R
+  F ==> Fraction R
+  SupF ==> SparseUnivariatePolynomial F
+  import UnivariatePolynomialCategoryFunctions2(R,SupR,F,SupF)
+  lp : List SupR
+  pp: SupR
+  pF: SupF
+  pullback : SupF -> Union(SupR,"failed")
+  pullback(pF) ==
+    pF = 0 => 0
+    c:=retractIfCan leadingCoefficient pF
+    c case "failed" => "failed"
+    r:=pullback reductum pF
+    r case "failed" => "failed"
+    monomial(c,degree pF) + r
+  solveLinearPolynomialEquationByFractions(lp,pp) ==
+    lpF:List SupF:=[map(#1@R::F,u) for u in lp]
+    pF:SupF:=map(#1@R::F,pp)
+    ans:= solveLinearPolynomialEquation(lpF,pF)$F
+    ans case "failed" => "failed"
+    [(vv:= pullback v;
+      vv case "failed" => return "failed";
+       vv)
+        for v in ans]
+
+@
+\section{package FRAC2 FractionFunctions2}
+<<package FRAC2 FractionFunctions2>>=
+)abbrev package FRAC2 FractionFunctions2
+++ Author:
+++ Date Created:
+++ Date Last Updated:
+++ Basic Functions:
+++ Related Constructors:
+++ Also See:
+++ AMS Classifications:
+++ Keywords:
+++ References:
+++ Description: This package extends a map between integral domains to
+++ a map between Fractions over those domains by applying the map to the
+++ numerators and denominators.
+FractionFunctions2(A, B): Exports == Impl where
+  A, B: IntegralDomain
+
+  R ==> Fraction A
+  S ==> Fraction B
+
+  Exports ==> with
+    map: (A -> B, R) -> S
+      ++ map(func,frac) applies the function func to the numerator
+      ++ and denominator of the fraction frac.
+
+  Impl ==> add
+    map(f, r) == map(f, r)$QuotientFieldCategoryFunctions2(A, B, R, S)
+
+@
+\section{License}
+<<license>>=
+--Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+--All rights reserved.
+--
+--Redistribution and use in source and binary forms, with or without
+--modification, are permitted provided that the following conditions are
+--met:
+--
+--    - Redistributions of source code must retain the above copyright
+--      notice, this list of conditions and the following disclaimer.
+--
+--    - Redistributions in binary form must reproduce the above copyright
+--      notice, this list of conditions and the following disclaimer in
+--      the documentation and/or other materials provided with the
+--      distribution.
+--
+--    - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--      names of its contributors may be used to endorse or promote products
+--      derived from this software without specific prior written permission.
+--
+--THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+--IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+--TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+--PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+--OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+--EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+--PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+--PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+--LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+--NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+--SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+@
+<<*>>=
+<<license>>
+
+<<domain LO Localize>>
+<<domain LA LocalAlgebra>>
+<<category QFCAT QuotientFieldCategory>>
+<<package QFCAT2 QuotientFieldCategoryFunctions2>>
+<<domain FRAC Fraction>>
+<<package LPEFRAC LinearPolynomialEquationByFractions>>
+<<package FRAC2 FractionFunctions2>>
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}