path: root/src/algebra/fraction.spad.pamphlet

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

(DEFPARAMETER |QuotientFieldCategory;CAT| 'NIL) 

(DEFPARAMETER |QuotientFieldCategory;AL| 'NIL) 

(DEFUN |QuotientFieldCategory| (#0=#:G1388)
  (LET (#1=#:G1389)
    (COND
      ((SETQ #1#
             (|assoc| (|devaluate| #0#) |QuotientFieldCategory;AL|))
       (CDR #1#))
      (T (SETQ |QuotientFieldCategory;AL|
               (|cons5| (CONS (|devaluate| #0#)
                              (SETQ #1# (|QuotientFieldCategory;| #0#)))
                        |QuotientFieldCategory;AL|))
         #1#)))) 

(DEFUN |QuotientFieldCategory;| (|t#1|)
  (PROG (#0=#:G1387)
    (RETURN
      (PROG1 (LETT #0#
                   (|sublisV|
                       (PAIR '(|t#1|) (LIST (|devaluate| |t#1|)))
                       (COND
                         (|QuotientFieldCategory;CAT|)
                         ('T
                          (LETT |QuotientFieldCategory;CAT|
                                (|Join| (|Field|) (|Algebra| '|t#1|)
                                        (|RetractableTo| '|t#1|)
                                        (|FullyEvalableOver| '|t#1|)
                                        (|DifferentialExtension|
                                         '|t#1|)
                                        (|FullyLinearlyExplicitRingOver|
                                         '|t#1|)
                                        (|Patternable| '|t#1|)
                                        (|FullyPatternMatchable|
                                         '|t#1|)
                                        (|mkCategory| '|domain|
                                         '(((/ ($ |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|))))
                                         '(((|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|))))
                                         'NIL NIL))
                                . #1=(|QuotientFieldCategory|))))) . #1#)
        (SETELT #0# 0
                (LIST '|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"))
                   ('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"))
                   ('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"))
                   ('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|)
              . #0=(|QuotientFieldCategory&|))
        (LETT |dv$2| (|devaluate| |#2|) . #0#)
        (LETT |dv$|
              (LIST '|QuotientFieldCategory&| |dv$1| |dv$2|) . #0#)
        (LETT $ (GETREFV 119) . #0#)
        (QSETREFV $ 0 |dv$|)
        (QSETREFV $ 3
            (LETT |pv$|
                  (|buildPredVector| 0 0
                      (LIST (|HasCategory| |#2|
                                '(|PolynomialFactorizationExplicit|))
                            (|HasCategory| |#2|
                                '(|IntegerNumberSystem|))
                            (|HasCategory| |#2| '(|EuclideanDomain|))
                            (|HasCategory| |#2|
                                '(|RetractableTo| (|Symbol|)))
                            (|HasCategory| |#2|
                                '(|CharacteristicNonZero|))
                            (|HasCategory| |#2|
                                '(|CharacteristicZero|))
                            (|HasCategory| |#2|
                                '(|ConvertibleTo| (|InputForm|)))
                            (|HasCategory| |#2| '(|RealConstant|))
                            (|HasCategory| |#2|
                                '(|OrderedIntegralDomain|))
                            (|HasCategory| |#2| '(|OrderedSet|))
                            (|HasCategory| |#2|
                                '(|RetractableTo| (|Integer|)))
                            (|HasCategory| |#2| '(|StepThrough|)))) . #0#))
        (|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| '|canonicalUnitNormal|)
              (QSETREFV $ 50
                  (CONS (|dispatchFunction| |QFCAT-;<;2AB;12|) $)))
             ('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|
               '(|ConvertibleTo| (|Pattern| (|Integer|))))
           (PROGN
             (QSETREFV $ 69
                 (CONS (|dispatchFunction| |QFCAT-;convert;AP;19|) $))
             (COND
               ((|HasCategory| |#2| '(|PatternMatchable| (|Integer|)))
                (QSETREFV $ 74
                    (CONS (|dispatchFunction|
                              |QFCAT-;patternMatch;AP2Pmr;20|)
                          $)))))))
        (COND
          ((|HasCategory| |#2|
               '(|ConvertibleTo| (|Pattern| (|Float|))))
           (PROGN
             (QSETREFV $ 78
                 (CONS (|dispatchFunction| |QFCAT-;convert;AP;21|) $))
             (COND
               ((|HasCategory| |#2| '(|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|)))
               ('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 '|QuotientFieldCategory&| '|infovec|
    (LIST '#(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| $ '"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 '"failed") (173 . |retractIfCan|)
             (|Union| 55 '"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 '"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 '"failed")
             (|Record| (|:| |mat| 115) (|:| |vec| (|Vector| 84)))
             (|Matrix| 84) (|List| 55) (|List| 29) (|OutputForm|))
          '#(|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)
          'NIL
          (CONS (|makeByteWordVec2| 1 'NIL)
                (CONS '#()
                      (CONS '#()
                            (|makeByteWordVec2| 112
                                '(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)))))
          '|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}