axiom-source 20170501-3 / usr / share / axiom-20170501 / src / algebra / FS.spad

)abbrev category FS FunctionSpace
++ Author: Manuel Bronstein
++ Date Created: 22 March 1988
++ Date Last Updated: 14 February 1994
++ Description:
++ Category for formal functions
++ A space of formal functions with arguments in an arbitrary ordered set.

FunctionSpace(R): Category == SIG where
  R : OrderedSet

  OP ==> BasicOperator
  O  ==> OutputForm
  SY ==> Symbol
  N  ==> NonNegativeInteger
  Z  ==> Integer
  K  ==> Kernel %
  Q  ==> Fraction R
  PR ==> Polynomial R
  MP ==> SparseMultivariatePolynomial(R, K)
  QF==> PolynomialCategoryQuotientFunctions(IndexedExponents K,K,R,MP,%)

  ODD  ==> "odd"
  EVEN ==> "even"

  SPECIALDIFF  ==> "%specialDiff"
  SPECIALDISP  ==> "%specialDisp"
  SPECIALEQUAL ==> "%specialEqual"
  SPECIALINPUT ==> "%specialInput"

  ES  ==> ExpressionSpace
  RT  ==> RetractableTo(SY)
  P   ==> Patternable(R)
  FPM ==> FullyPatternMatchable(R)
  FRT ==> FullyRetractableTo(R)

  SIG ==> Join(ES,RT,P,FPM,FRT) with

    ground? : % -> Boolean
      ++ ground?(f) tests if f is an element of R.

    ground : % -> R
      ++ ground(f) returns f as an element of R.
      ++ An error occurs if f is not an element of R.

    variables : %  -> List SY
      ++ variables(f) returns the list of all the variables of f.

    applyQuote : (SY, %) -> %
      ++ applyQuote(foo, x) returns \spad{'foo(x)}.

    applyQuote : (SY, %, %) -> %
      ++ applyQuote(foo, x, y) returns \spad{'foo(x,y)}.

    applyQuote : (SY, %, %, %) -> %
      ++ applyQuote(foo, x, y, z) returns \spad{'foo(x,y,z)}.

    applyQuote : (SY, %, %, %, %) -> %
      ++ applyQuote(foo, x, y, z, t) returns \spad{'foo(x,y,z,t)}.

    applyQuote : (SY, List %) -> %
      ++ applyQuote(foo, [x1,...,xn]) returns \spad{'foo(x1,...,xn)}.

    if R has ConvertibleTo InputForm then

      ConvertibleTo InputForm

      eval : (%, SY) -> %
        ++ eval(f, foo) unquotes all the foo's in f.

      eval : (%, List SY) -> %
        ++ eval(f, [foo1,...,foon]) unquotes all the \spad{fooi}'s in f.

      eval : % -> %
        ++ eval(f) unquotes all the quoted operators in f.

      eval : (%, OP, %, SY) -> %
        ++ eval(x, s, f, y) replaces every \spad{s(a)} in x by \spad{f(y)}
        ++ with \spad{y} replaced by \spad{a} for any \spad{a}.

      eval : (%, List OP, List %, SY) -> %
        ++ eval(x, [s1,...,sm], [f1,...,fm], y) replaces every
        ++ \spad{si(a)} in x by \spad{fi(y)}
        ++ with \spad{y} replaced by \spad{a} for any \spad{a}.

    if R has SemiGroup then

      Monoid
      -- the following line is necessary because of a compiler bug

      "**" : (%, N) -> %
        ++ x**n returns x * x * x * ... * x (n times).

      isTimes: % -> Union(List %, "failed")
        ++ isTimes(p) returns \spad{[a1,...,an]}
        ++ if \spad{p = a1*...*an} and \spad{n > 1}.

      isExpt : % -> Union(Record(var:K,exponent:Z),"failed")
        ++ isExpt(p) returns \spad{[x, n]} if \spad{p = x**n}
        ++ and \spad{n <> 0}.

    if R has Group then Group

    if R has AbelianSemiGroup then

      AbelianMonoid

      isPlus: % -> Union(List %, "failed")
        ++ isPlus(p) returns \spad{[m1,...,mn]}
        ++ if \spad{p = m1 +...+ mn} and \spad{n > 1}.

      isMult: % -> Union(Record(coef:Z, var:K),"failed")
        ++ isMult(p) returns \spad{[n, x]} if \spad{p = n * x}
        ++ and \spad{n <> 0}.

    if R has AbelianGroup then AbelianGroup

    if R has Ring then

      Ring

      RetractableTo PR

      PartialDifferentialRing SY

      FullyLinearlyExplicitRingOver R

      coerce : MP -> %
        ++ coerce(p) returns p as an element of %.

      numer : %  -> MP
        ++ numer(f) returns the
        ++ numerator of f viewed as a polynomial in the kernels over R
        ++ if R is an integral domain. If not, then numer(f) = f viewed
        ++ as a polynomial in the kernels over R.
        -- DO NOT change this meaning of numer!  MB 1/90

      numerator : % -> %
        ++ numerator(f) returns the numerator of \spad{f} converted to %.

      isExpt:(%,OP) -> Union(Record(var:K,exponent:Z),"failed")
        ++ isExpt(p,op) returns \spad{[x, n]} if \spad{p = x**n}
        ++ and \spad{n <> 0} and \spad{x = op(a)}.

      isExpt:(%,SY) -> Union(Record(var:K,exponent:Z),"failed")
        ++ isExpt(p,f) returns \spad{[x, n]} if \spad{p = x**n}
        ++ and \spad{n <> 0} and \spad{x = f(a)}.

      isPower : % -> Union(Record(val:%,exponent:Z),"failed")
        ++ isPower(p) returns \spad{[x, n]} if \spad{p = x**n}
        ++ and \spad{n <> 0}.

      eval: (%, List SY, List N, List(% -> %)) -> %
        ++ eval(x, [s1,...,sm], [n1,...,nm], [f1,...,fm]) replaces
        ++ every \spad{si(a)**ni} in x by \spad{fi(a)} for any \spad{a}.

      eval: (%, List SY, List N, List(List % -> %)) -> %
        ++ eval(x, [s1,...,sm], [n1,...,nm], [f1,...,fm]) replaces
        ++ every \spad{si(a1,...,an)**ni} in x by \spad{fi(a1,...,an)}
        ++ for any a1,...,am.

      eval: (%, SY, N, List % -> %) -> %
        ++ eval(x, s, n, f) replaces every \spad{s(a1,...,am)**n} in x
        ++ by \spad{f(a1,...,am)} for any a1,...,am.

      eval: (%, SY, N, % -> %) -> %
        ++ eval(x, s, n, f) replaces every \spad{s(a)**n} in x
        ++ by \spad{f(a)} for any \spad{a}.

    if R has CharacteristicZero then CharacteristicZero

    if R has CharacteristicNonZero then CharacteristicNonZero

    if R has CommutativeRing then
      Algebra R

    if R has IntegralDomain then

      Field

      RetractableTo Fraction PR

      convert : Factored % -> %
        ++ convert(f1\^e1 ... fm\^em) returns \spad{(f1)\^e1 ... (fm)\^em}
        ++ as an element of %, using formal kernels
        ++ created using a \spadfunFrom{paren}{ExpressionSpace}.

      denom : %  -> MP
        ++ denom(f) returns the denominator of f viewed as a
        ++ polynomial in the kernels over R.

      denominator : % -> %
        ++ denominator(f) returns the denominator of \spad{f} 
        ++ converted to %.

      "/" : (MP, MP) -> %
        ++ p1/p2 returns the quotient of p1 and p2 as an element of %.

      coerce : Q  -> %
        ++ coerce(q) returns q as an element of %.

      coerce : Polynomial Q -> %
        ++ coerce(p) returns p as an element of %.

      coerce : Fraction Polynomial Q -> %
        ++ coerce(f) returns f as an element of %.

      univariate: (%, K) -> Fraction SparseUnivariatePolynomial %
        ++ univariate(f, k) returns f viewed as a univariate fraction in k.

      if R has RetractableTo Z then RetractableTo Fraction Z

   add

     import BasicOperatorFunctions1(%)
 
     -- these are needed in Ring only, but need to be declared here
     -- because of compiler bug: if they are declared inside the Ring
     -- case, then they are not visible inside the IntegralDomain case.
     smpIsMult : MP -> Union(Record(coef:Z, var:K),"failed")
     smpret    : MP -> Union(PR, "failed")
     smpeval   : (MP, List K, List %) -> %
     smpsubst  : (MP, List K, List %) -> %
     smpderiv  : (MP, SY) -> %
     smpunq    : (MP, List SY, Boolean) -> %
     kerderiv  : (K, SY)  -> %
     kderiv    : K -> List %
     opderiv   : (OP, N) -> List(List % -> %)
     smp2O     : MP -> O
     bestKernel: List K -> K
     worse?    : (K, K) -> Boolean
     diffArg   : (List %, OP, N) -> List %
     substArg  : (OP, List %, Z, %) -> %
     dispdiff  : List % -> Record(name:O, sub:O, arg:List O, level:N)
     ddiff     : List % -> O
     diffEval  : List % -> %
     dfeval    : (List %, K) -> %
     smprep    : (List SY, List N, List(List % -> %), MP) -> %
     diffdiff  : (List %, SY) -> %
     diffdiff0 : (List %, SY, %, K, List %) -> %
     subs      : (% -> %, K) -> %
     symsub    : (SY, Z) -> SY
     kunq      : (K, List SY, Boolean) -> %
     pushunq   : (List SY, List %) -> List %
     notfound  : (K -> %, List K, K) -> %
 
     equaldiff : (K,K)->Boolean

     debugA: (List % ,List %,Boolean) -> Boolean

     opdiff := operator("%diff"::SY)$CommonOperators()

     opquote := operator("applyQuote"::SY)$CommonOperators
 
     ground? x == retractIfCan(x)@Union(R,"failed") case R
 
     ground  x == retract x
 
     coerce(x:SY):% == kernel(x)@K :: %
 
     retract(x:%):SY == symbolIfCan(retract(x)@K)::SY
 
     applyQuote(s:SY, x:%) == applyQuote(s, [x])
 
     applyQuote(s, x, y) == applyQuote(s, [x, y])
 
     applyQuote(s, x, y, z) == applyQuote(s, [x, y, z])
 
     applyQuote(s, x, y, z, t) == applyQuote(s, [x, y, z, t])
 
     applyQuote(s:SY, l:List %) == opquote concat(s::%, l)
 
     belong? op == op = opdiff or op = opquote
 
     subs(fn, k) == kernel(operator k,[fn x for x in argument k]$List(%))
 
     operator op ==
       is?(op, "%diff"::SY) => opdiff
       is?(op, "%quote"::SY) => opquote
       error "Unknown operator"
 
     if R has ConvertibleTo InputForm then

       INP==>InputForm

       import MakeUnaryCompiledFunction(%, %, %)

       indiff: List % -> INP

       pint  : List INP-> INP

       differentiand: List % -> %
 
       differentiand l    == eval(first l, retract(second l)@K, third l)
 
       pint l  == convert concat(convert("D"::SY)@INP, l)
 
       indiff l ==
          r2:= convert([convert("::"::SY)@INP,_
                        convert(third l)@INP,_
                        convert("Symbol"::SY)@INP]@List INP)@INP
          pint [convert(differentiand l)@INP, r2] 
 
       eval(f:%, s:SY)            == eval(f, [s])
 
       eval(f:%, s:OP, g:%, x:SY) == eval(f, [s], [g], x)
 
       eval(f:%, ls:List OP, lg:List %, x:SY) ==
         eval(f, ls, [compiledFunction(g, x) for g in lg])
 
       setProperty(opdiff,SPECIALINPUT,_
                    indiff@(List % -> InputForm) pretend None)
 
     variables x ==
       l := empty()$List(SY)
       for k in tower x repeat
         if ((s := symbolIfCan k) case SY) then l := concat(s::SY, l)
       reverse_! l
 
     retractIfCan(x:%):Union(SY, "failed") ==
       (k := retractIfCan(x)@Union(K,"failed")) case "failed" => "failed"
       symbolIfCan(k::K)
 
     if R has Ring then

       import UserDefinedPartialOrdering(SY)
 
       -- cannot use new()$Symbol because of possible re-instantiation
       gendiff := "%%0"::SY
 
       characteristic() == characteristic()$R
 
       coerce(k:K):% == k::MP::%
 
       symsub(sy, i) == concat(string sy, convert(i)@String)::SY
 
       numerator x == numer(x)::%
 
       eval(x:%, s:SY, n:N, f:% -> %) == 
         eval(x,[s],[n],[(y:List %):% +-> f(first(y))])
 
       eval(x:%, s:SY, n:N, f:List % -> %) == eval(x, [s], [n], [f])
 
       eval(x:%, l:List SY, f:List(List % -> %)) == eval(x, l, new(#l, 1), f)
 
       elt(op:OP, args:List %) ==
         unary? op and ((od? := has?(op, ODD)) or has?(op, EVEN)) and
           leadingCoefficient(numer first args) < 0 =>
             x := op(- first args)
             od? => -x
             x
         elt(op, args)$ExpressionSpace_&(%)
 
       eval(x:%, s:List SY, n:List N, l:List(% -> %)) ==
         eval(x, s, n, [y+-> f(first(y)) for f in l]$List(List % -> %))
 
       -- op(arg)**m ==> func(arg)**(m quo n) * op(arg)**(m rem n)
       smprep(lop, lexp, lfunc, p) ==
         (v := mainVariable p) case "failed" => p::%
         symbolIfCan(k := v::K) case SY => p::%
         g := (op := operator k)
            (arg := [eval(a,lop,lexp,lfunc) for a in argument k]$List(%))
         q := map(y+->eval(y::%, lop, lexp, lfunc),
                  univariate(p, k))$SparseUnivariatePolynomialFunctions2(MP, %)
         (n := position(name op, lop)) < minIndex lop => q g
         a:%  := 0
         f    := eval((lfunc.n) arg, lop, lexp, lfunc)
         e    := lexp.n
         while q ^= 0 repeat
           m  := degree q
           qr := divide(m, e)
           t1 := f ** (qr.quotient)::N
           t2 := g ** (qr.remainder)::N
           a  := a + leadingCoefficient(q) * t1 * t2
           q  := reductum q
         a
 
       dispdiff l ==
         s := second(l)::O
         t := third(l)::O
         a := argument(k := retract(first l)@K)
         is?(k, opdiff) =>
           rec := dispdiff a
           i   := position(s, rec.arg)
           rec.arg.i := t
           [rec.name,
              hconcat(rec.sub, hconcat(","::SY::O, (i+1-minIndex a)::O)),
                         rec.arg, (zero?(rec.level) => 0; rec.level + 1)]
         i   := position(second l, a)
         m   := [x::O for x in a]$List(O)
         m.i := t
         [name(operator k)::O, hconcat(","::SY::O, (i+1-minIndex a)::O),
                                              m, (empty? rest a => 1; 0)]
 
       ddiff l ==
         rec := dispdiff l
         opname :=
           zero?(rec.level) => sub(rec.name, rec.sub)
           differentiate(rec.name, rec.level)
         prefix(opname, rec.arg)
 
       substArg(op, l, i, g) ==
         z := copy l
         z.i := g
         kernel(op, z)
 
 
       diffdiff(l, x) ==
         f := kernel(opdiff, l)
         diffdiff0(l, x, f, retract(f)@K, empty())
 
       diffdiff0(l, x, expr, kd, done) ==
         op  := operator(k := retract(first l)@K)
         gg  := second l
         u   := third l
         arg := argument k
         ans:% := 0
         if (not member?(u,done)) and (ans := differentiate(u,x))^=0 then
           ans := ans * kernel(opdiff,
                [subst(expr, [kd], [kernel(opdiff, [first l, gg, gg])]),
                              gg, u])
         done := concat(gg, done)
         is?(k, opdiff) => ans + diffdiff0(arg, x, expr, k, done)
         for i in minIndex arg .. maxIndex arg for b in arg repeat
           if (not member?(b,done)) and (bp:=differentiate(b,x))^=0 then
             g   := symsub(gendiff, i)::%
             ans := ans + bp * kernel(opdiff, [subst(expr, [kd],
              [kernel(opdiff, [substArg(op, arg, i, g), gg, u])]), g, b])
         ans
 
       dfeval(l, g) ==
         eval(differentiate(first l, symbolIfCan(g)::SY), g, third l)
 
       diffEval l ==
         k:K
         g := retract(second l)@K
         ((u := retractIfCan(first l)@Union(K, "failed")) case "failed")
           or (u case K and symbolIfCan(k := u::K) case SY) => dfeval(l, g)
         op := operator k
         (ud := derivative op) case "failed" => 
              -- possible trouble 
              -- make sure it is a dummy var  
              dumm:%:=symsub(gendiff,1)::%
              ss:=subst(l.1,l.2=dumm)
              -- output(nl::OutputForm)$OutputPackage
              -- output("fixed"::OutputForm)$OutputPackage
              nl:=[ss,dumm,l.3]
              kernel(opdiff, nl)
         (n := position(second l,argument k)) < minIndex l => 
               dfeval(l,g)
         d := ud::List(List % -> %)
         eval((d.n)(argument k), g, third l)
 
       diffArg(l, op, i) ==
         n := i - 1 + minIndex l
         z := copy l
         z.n := g := symsub(gendiff, n)::%
         [kernel(op, z), g, l.n]
 
       opderiv(op, n) ==
         (n = 1) =>
           g := symsub(gendiff, n)::%
           [x +-> kernel(opdiff,[kernel(op, g), g, first x])]
         [y +-> kernel(opdiff, diffArg(y, op, i)) for i in 1..n]
 
       kderiv k ==
         zero?(n := #(args := argument k)) => empty()
         op := operator k
         grad :=
           (u := derivative op) case "failed" => opderiv(op, n)
           u::List(List % -> %)
         if #grad ^= n then grad := opderiv(op, n)
         [g args for g in grad]
 
     -- SPECIALDIFF contains a map (List %, Symbol) -> %
     -- it is used when the usual chain rule does not apply,
     -- for instance with implicit algebraics.
       kerderiv(k, x) ==
         (v := symbolIfCan(k)) case SY =>
           v::SY = x => 1
           0
         (fn := property(operator k, SPECIALDIFF)) case None =>
            ((fn::None) pretend ((List %, SY) -> %)) (argument k, x)
         +/[g * differentiate(y,x) for g in kderiv k for y in argument k]
 
       smpderiv(p, x) ==
         map((s:R):R +-> retract differentiate(s::PR, x), p)::% +
          +/[differentiate(p,k)::% * kerderiv(k, x) for k in variables p]
 
       coerce(p:PR):% ==
         map(s +-> s::%, r +-> r::%, p)$PolynomialCategoryLifting(
                                       IndexedExponents SY, SY, R, PR, %)
 
       worse?(k1, k2) ==
         (u := less?(name operator k1,name operator k2)) case "failed" =>
           k1 < k2
         u::Boolean
 
       bestKernel l ==
         empty? rest l => first l
         a := bestKernel rest l
         worse?(first l, a) => a
         first l
 
       smp2O p ==
         (r:=retractIfCan(p)@Union(R,"failed")) case R =>r::R::OutputForm
         a :=
           userOrdered?() => bestKernel variables p
           mainVariable(p)::K
         outputForm(map((x:MP):% +-> x::%, univariate(p, a))_
             $SparseUnivariatePolynomialFunctions2(MP, %), a::OutputForm)
 
       smpsubst(p, lk, lv) ==
         map(x +-> match(lk, lv, x,
             notfound((z:K):%+->subs(s+->subst(s, lk, lv), z), lk, x))_
              $ListToMap(K,%),y+->y::%,p)_
               $PolynomialCategoryLifting(IndexedExponents K,K,R,MP,%)
 
       smpeval(p, lk, lv) ==
         map(x +-> match(lk, lv, x,
             notfound((z:K):%+->map(s+->eval(s,lk,lv),z),lk,x))_
              $ListToMap(K,%),y+->y::%,p)_
               $PolynomialCategoryLifting(IndexedExponents K,K,R,MP,%)
 
       -- this is called on k when k is not a member of lk
       notfound(fn, lk, k) ==
         empty? setIntersection(tower(f := k::%), lk) => f
         fn k
 
       if R has ConvertibleTo InputForm then

         pushunq(l, arg) ==
            empty? l => [eval a for a in arg]
            [eval(a, l) for a in arg]
 
         kunq(k, l, givenlist?) ==
           givenlist? and empty? l => k::%
           is?(k, opquote) and
             (member?(s:=retract(first argument k)@SY, l) or empty? l) =>
               interpret(convert(concat(convert(s)@InputForm,
                 [convert a for a in pushunq(l, rest argument k)
                    ]@List(InputForm)))@InputForm)$InputFormFunctions1(%)
           (operator k) pushunq(l, argument k)
 
         smpunq(p, l, givenlist?) ==
           givenlist? and empty? l => p::%
           map(x +-> kunq(x, l, givenlist?), y+->y::%, p)_
             $PolynomialCategoryLifting(IndexedExponents K,K,R,MP,%)
 
       smpret p ==
         "or"/[symbolIfCan(k) case "failed" for k in variables p] =>
           "failed"
         map(x+->symbolIfCan(x)::SY::PR, y+->y::PR,p)_
           $PolynomialCategoryLifting(IndexedExponents K, K, R, MP, PR)
 
       isExpt(x:%, op:OP) ==
         (u := isExpt x) case "failed" => "failed"
         is?((u::Record(var:K, exponent:Z)).var, op) => u
         "failed"
 
       isExpt(x:%, sy:SY) ==
         (u := isExpt x) case "failed" => "failed"
         is?((u::Record(var:K, exponent:Z)).var, sy) => u
         "failed"
 
       if R has RetractableTo Z then

           smpIsMult p ==
             (u := mainVariable p) case K and (degree(q:=univariate(p,u::K))=1)
               and zero?(leadingCoefficient reductum q)
                 and ((r:=retractIfCan(leadingCoefficient q)@Union(R,"failed"))
                    case R)
                     and (n := retractIfCan(r::R)@Union(Z, "failed")) case Z =>
                        [n::Z, u::K]
             "failed"
 
       evaluate(opdiff, diffEval)
 
       debugA(a1,a2,t) == 
          -- uncomment for debugging
          -- output(hconcat [a1::OutputForm,_
          --                 a2::OutputForm,t::OutputForm])$OutputPackage
          t
 
       equaldiff(k1,k2) ==
         a1:=argument k1
         a2:=argument k2
         -- check the operator
         res:=operator k1 = operator k2 
         not res => debugA(a1,a2,res) 
         -- check the evaluation point
         res:= (a1.3 = a2.3)
         not res => debugA(a1,a2,res)
         -- check all the arguments
         res:= (a1.1 = a2.1) and (a1.2 = a2.2)
         res => debugA(a1,a2,res)
         -- check the substituted arguments
         (subst(a1.1,[retract(a1.2)@K],[a2.2]) = a2.1) => debugA(a1,a2,true)
         debugA(a1,a2,false)
 
       setProperty(opdiff,SPECIALEQUAL,
                           equaldiff@((K,K) -> Boolean) pretend None)
 
       setProperty(opdiff, SPECIALDIFF,
                           diffdiff@((List %, SY) -> %) pretend None)
 
       setProperty(opdiff, SPECIALDISP,
                               ddiff@(List % -> OutputForm) pretend None)
 
       if not(R has IntegralDomain) then

         mainKernel x == mainVariable numer x
 
         kernels x == variables numer x
 
         retract(x:%):R == retract numer x
 
         retract(x:%):PR == smpret(numer x)::PR
 
         retractIfCan(x:%):Union(R,  "failed") == retract numer x
 
         retractIfCan(x:%):Union(PR, "failed") == smpret numer x
 
         eval(x:%, lk:List K, lv:List %)  == smpeval(numer x, lk, lv)
 
         subst(x:%, lk:List K, lv:List %) == smpsubst(numer x, lk, lv)
 
         differentiate(x:%, s:SY) == smpderiv(numer x, s)
 
         coerce(x:%):OutputForm == smp2O numer x
 
         if R has ConvertibleTo InputForm then
           eval(f:%, l:List SY) == smpunq(numer f, l, true)
 
           eval f == smpunq(numer f, empty(), false)
 
         eval(x:%, s:List SY, n:List N, f:List(List % -> %)) ==
           smprep(s, n, f, numer x)
 
         isPlus x ==
           (u := isPlus numer x) case "failed" => "failed"
           [p::% for p in u::List(MP)]
 
         isTimes x ==
           (u := isTimes numer x) case "failed" => "failed"
           [p::% for p in u::List(MP)]
 
         isExpt x ==
           (u := isExpt numer x) case "failed" => "failed"
           r := u::Record(var:K, exponent:NonNegativeInteger)
           [r.var, r.exponent::Z]
 
         isPower x ==
           (u := isExpt numer x) case "failed" => "failed"
           r := u::Record(var:K, exponent:NonNegativeInteger)
           [r.var::%, r.exponent::Z]
 
         if R has ConvertibleTo Pattern Z then
           convert(x:%):Pattern(Z) == convert numer x
 
         if R has ConvertibleTo Pattern Float then
           convert(x:%):Pattern(Float) == convert numer x
 
         if R has RetractableTo Z then
           isMult x == smpIsMult numer x
 
     if R has CommutativeRing then

       r:R * x:% == r::MP::% * x
 
     if R has IntegralDomain then

       par : % -> %
 
       mainKernel x == mainVariable(x)$QF
 
       kernels x == variables(x)$QF
 
       univariate(x:%, k:K) == univariate(x, k)$QF
 
       isPlus x == isPlus(x)$QF
 
       isTimes x == isTimes(x)$QF
 
       isExpt x == isExpt(x)$QF
 
       isPower x == isPower(x)$QF
 
       denominator x == denom(x)::%
 
       coerce(q:Q):% == (numer q)::MP / (denom q)::MP
 
       coerce(q:Fraction PR):% == (numer q)::% / (denom q)::%
 
       coerce(q:Fraction Polynomial Q) == (numer q)::% / (denom q)::%
 
       retract(x:%):PR == retract(retract(x)@Fraction(PR))
 
       retract(x:%):Fraction(PR) == smpret(numer x)::PR / smpret(denom x)::PR
 
       retract(x:%):R == (retract(numer x)@R exquo retract(denom x)@R)::R
 
       coerce(x:%):OutputForm ==
         ((denom x) = 1) => smp2O numer x
         smp2O(numer x) / smp2O(denom x)
 
       retractIfCan(x:%):Union(R, "failed") ==
         (n := retractIfCan(numer x)@Union(R, "failed")) case "failed" or
           (d := retractIfCan(denom x)@Union(R, "failed")) case "failed"
             or (r := n::R exquo d::R) case "failed" => "failed"
         r::R
 
       eval(f:%, l:List SY) ==
         smpunq(numer f, l, true) / smpunq(denom f, l, true)
 
       if R has ConvertibleTo InputForm then

         eval f ==
           smpunq(numer f, empty(), false) / smpunq(denom f, empty(), false)
 
         eval(x:%, s:List SY, n:List N, f:List(List % -> %)) ==
           smprep(s, n, f, numer x) / smprep(s, n, f, denom x)
 
       differentiate(f:%, x:SY) ==
         (smpderiv(numer f, x) * denom(f)::% -
           numer(f)::% * smpderiv(denom f, x))
             / (denom(f)::% ** 2)
 
       eval(x:%, lk:List K, lv:List %) ==
         smpeval(numer x, lk, lv) / smpeval(denom x, lk, lv)
 
       subst(x:%, lk:List K, lv:List %) ==
         smpsubst(numer x, lk, lv) / smpsubst(denom x, lk, lv)
 
       par x ==
         (r := retractIfCan(x)@Union(R, "failed")) case R => x
         paren x
 
       convert(x:Factored %):% ==
         par(unit x) * */[par(f.factor) ** f.exponent for f in factors x]
 
       retractIfCan(x:%):Union(PR, "failed") ==
         (u := retractIfCan(x)@Union(Fraction PR,"failed")) case "failed"
           => "failed"
         retractIfCan(u::Fraction(PR))
 
       retractIfCan(x:%):Union(Fraction PR, "failed") ==
         (n := smpret numer x) case "failed" => "failed"
         (d := smpret denom x) case "failed" => "failed"
         n::PR / d::PR
 
       coerce(p:Polynomial Q):% ==
         map(x+->x::%, y+->y::%,p)_
          $PolynomialCategoryLifting(IndexedExponents SY, SY,
                                                      Q, Polynomial Q, %)
 
       if R has RetractableTo Z then

         coerce(x:Fraction Z):% == numer(x)::MP / denom(x)::MP
 
         isMult x ==
            (u := smpIsMult numer x) case "failed"
               or (v := retractIfCan(denom x)@Union(R, "failed")) case "failed"
                  or (w := retractIfCan(v::R)@Union(Z, "failed")) case "failed"
                      => "failed"
            r := u::Record(coef:Z, var:K)
            (q := r.coef exquo w::Z) case "failed" => "failed"
            [q::Z, r.var]
 
       if R has ConvertibleTo Pattern Z then

         convert(x:%):Pattern(Z) == convert(numer x) / convert(denom x)
 
       if R has ConvertibleTo Pattern Float then

         convert(x:%):Pattern(Float) ==
           convert(numer x) / convert(denom x)