)abbrev category ACF AlgebraicallyClosedField
++ Author: Manuel Bronstein
++ Date Created: 22 Mar 1988
++ Description:
++   Model for algebraically closed fields.
++ Keywords: algebraic, closure, field.

AlgebraicallyClosedField() : Category == Join(Field, RadicalCategory) with
    rootOf : Polynomial % -> %
      ++ rootOf(p) returns y such that \spad{p(y) = 0}.
      ++ Error: if p has more than one variable y.
    rootOf : SparseUnivariatePolynomial % -> %
      ++ rootOf(p) returns y such that \spad{p(y) = 0}.
    rootOf : (SparseUnivariatePolynomial %, Symbol) -> %
      ++ rootOf(p, y) returns y such that \spad{p(y) = 0}.
      ++ The object returned displays as \spad{'y}.
    rootsOf : Polynomial % -> List %
      ++ rootsOf(p) returns \spad{[y1, ..., yn]} such that \spad{p(yi) = 0}.
      ++ Note: the returned values y1, ..., yn contain new symbols which
      ++ are bound in the interpreter to the respective values.
      ++ Error: if p has more than one variable y.
    rootsOf : SparseUnivariatePolynomial % -> List %
      ++ rootsOf(p) returns \spad{[y1, ..., yn]} such that \spad{p(yi) = 0}.
      ++ Note: the returned values y1, ..., yn contain new symbols which
      ++ are bound in the interpreter to the respective values.
    rootsOf : (SparseUnivariatePolynomial %, Symbol) -> List %
      ++ rootsOf(p, z) returns \spad{[y1, ..., yn]} such that \spad{p(yi) = 0};
      ++ The returned roots contain new symbols \spad{'%z0}, \spad{'%z1} ...;
      ++ Note: the new symbols are bound in the interpreter to the
      ++ respective values.
    zeroOf : Polynomial % -> %
      ++ zeroOf(p) returns y such that \spad{p(y) = 0}.
      ++ If possible, y is expressed in terms of radicals.
      ++ Otherwise it is an implicit algebraic quantity.
      ++ Error: if p has more than one variable y.
    zeroOf : SparseUnivariatePolynomial % -> %
      ++ zeroOf(p) returns y such that \spad{p(y) = 0};
      ++ if possible, y is expressed in terms of radicals.
      ++ Otherwise it is an implicit algebraic quantity.
    zeroOf : (SparseUnivariatePolynomial %, Symbol) -> %
      ++ zeroOf(p, y) returns y such that \spad{p(y) = 0};
      ++ if possible, y is expressed in terms of radicals.
      ++ Otherwise it is an implicit algebraic quantity which
      ++ displays as \spad{'y}.
    zerosOf : Polynomial % -> List %
      ++ zerosOf(p) returns \spad{[y1, ..., yn]} such that \spad{p(yi) = 0}.
      ++ The yi's are expressed in radicals if possible.
      ++ Otherwise they are implicit algebraic quantities containing
      ++ new symbols.  The new symbols are bound in the interpreter to the
      ++ respective values.
      ++ Error: if p has more than one variable y.
    zerosOf : SparseUnivariatePolynomial % -> List %
      ++ zerosOf(p) returns \spad{[y1, ..., yn]} such that \spad{p(yi) = 0}.
      ++ The yi's are expressed in radicals if possible.
      ++ Otherwise they are implicit algebraic quantities containing
      ++ new symbols.  The new symbols are bound in the interpreter to the
      ++ respective values.
    zerosOf : (SparseUnivariatePolynomial %, Symbol) -> List %
      ++ zerosOf(p, y) returns \spad{[y1, ..., yn]} such that \spad{p(yi) = 0}.
      ++ The yi's are expressed in radicals if possible, and otherwise
      ++ as implicit algebraic quantities containing
      ++ new symbols which display as \spad{'%z0}, \spad{'%z1}, ...;
      ++ The new symbols are bound in the interpreter
      ++ to respective values.
 add
    SUP ==> SparseUnivariatePolynomial %

    import from List(Symbol)

    assign  : (Symbol, %) -> %
    allroots : (SUP, Symbol, (SUP, Symbol) -> %) -> List %
    binomialRoots : (SUP, Symbol, (SUP, Symbol) -> %) -> List %

    zeroOf(p : SUP)            == assign(x := new(), zeroOf(p, x))
    rootOf(p : SUP)            == assign(x := new(), rootOf(p, x))
    zerosOf(p : SUP)           == zerosOf(p, new())
    rootsOf(p : SUP)           == rootsOf(p, new())
    rootsOf(p : SUP, y : Symbol) == allroots(p, y, rootOf)
    zerosOf(p : SUP, y : Symbol) == allroots(p, y, zeroOf)
    assign(x, f)             == (assignSymbol(x, f, %)$Lisp; f)

    zeroOf(p : Polynomial %) ==
      empty?(l := variables p) => error "zeroOf: constant polynomial"
      zeroOf(univariate p, first l)

    rootOf(p : Polynomial %) ==
      empty?(l := variables p) => error "rootOf: constant polynomial"
      rootOf(univariate p, first l)

    zerosOf(p : Polynomial %) ==
      empty?(l := variables p) => error "zerosOf: constant polynomial"
      zerosOf(univariate p, first l)

    rootsOf(p : Polynomial %) ==
      empty?(l := variables p) => error "rootsOf: constant polynomial"
      rootsOf(univariate p, first l)

    zeroOf(p : SUP, y : Symbol) ==
      zero?(d := degree p) => error "zeroOf: constant polynomial"
      zero? coefficient(p, 0) => 0
      a := leadingCoefficient p
      d = 2 =>
        b := coefficient(p, 1)
        (sqrt(b^2 - 4 * a * coefficient(p, 0)) - b) / (2 * a)
      (r := retractIfCan(reductum p)@Union(%,"failed")) case "failed" =>
        rootOf(p, y)
      nthRoot(- (r@% / a), d)

    binomialRoots(p, y, fn) ==
     -- p = a * x^n + b
      alpha := assign(x := new(y)$Symbol, fn(p, x))
      ((n := degree p) = 1) =>  [ alpha ]
      cyclo := map((c : Integer) : % +-> c::%,
                   cyclotomic(n)$PolynomialNumberTheoryFunctions()
               )$UnivariatePolynomialCategoryFunctions2(
                   Integer, SparseUnivariatePolynomial(Integer),
                   %, SUP)
      beta := assign(x := new(y)$Symbol, fn(cyclo, x))
      [alpha*beta^i for i in 0..(n-1)::NonNegativeInteger]

    import from UnivariatePolynomialDecompositionPackage(%, SUP)

    allroots(p, y, fn) ==
      zero? p => error "allroots: polynomial must be nonzero"
      zero? coefficient(p, 0) =>
         concat(0, allroots(p quo monomial(1, 1), y, fn))
      zero?(p1 := reductum p) => []$List(%)
      zero? reductum p1 => binomialRoots(p, y, fn)
      decompList := completeDecompose(p)
      # decompList > 1 =>
          h := last decompList
          g := leftFactorIfCan(p, h) :: SUP
          groots := allroots(g, y, fn)
          "append"/[allroots(h-r::SUP, y, fn) for r in groots]
      ans := []$List(%)
      while not ground? p repeat
        alpha := assign(x := new(y)$Symbol, fn(p, x))
        q     := monomial(1, 1)$SUP - alpha::SUP
        if not zero?(p alpha) then
          p   := p quo q
          ans := concat(alpha, ans)
        else while zero?(p alpha) repeat
          p   := (p exquo q)::SUP
          ans := concat(alpha, ans)
      reverse! ans

)abbrev category ACFS AlgebraicallyClosedFunctionSpace
++ Author: Manuel Bronstein
++ Date Created: 31 October 1988
++ Description:
++   Model for algebraically closed function spaces.
++ Keywords: algebraic, closure, field.
AlgebraicallyClosedFunctionSpace(R : Join(Comparable, IntegralDomain)):
 Category == Join(AlgebraicallyClosedField, FunctionSpace R) with
    rootOf : % -> %
      ++ rootOf(p) returns y such that \spad{p(y) = 0}.
      ++ Error: if p has more than one variable y.
    rootsOf : % -> List %
      ++ rootsOf(p, y) returns \spad{[y1, ..., yn]} such that \spad{p(yi) = 0};
      ++ Note: the returned values y1, ..., yn contain new symbols which
      ++ are bound in the interpreter to the respective values.
      ++ Error: if p has more than one variable y.
    rootOf : (%, Symbol) -> %
      ++ rootOf(p, y) returns y such that \spad{p(y) = 0}.
      ++ The object returned displays as \spad{'y}.
    rootsOf : (%, Symbol) -> List %
      ++ rootsOf(p, y) returns \spad{[y1, ..., yn]} such that \spad{p(yi) = 0};
      ++ The returned roots contain new symbols \spad{'%z0}, \spad{'%z1} ...;
      ++ Note: the new symbols are bound in the interpreter to the
      ++ respective values.
    zeroOf : % -> %
      ++ zeroOf(p) returns y such that \spad{p(y) = 0}.
      ++ The value y is expressed in terms of radicals if possible, and otherwise
      ++ as an implicit algebraic quantity.
      ++ Error: if p has more than one variable.
    zerosOf : % -> List %
      ++ zerosOf(p) returns \spad{[y1, ..., yn]} such that \spad{p(yi) = 0}.
      ++ The yi's are expressed in radicals if possible.
      ++ Note: the returned values y1, ..., yn contain new symbols which
      ++ are bound in the interpreter to the respective values.
      ++ Error: if p has more than one variable.
    zeroOf : (%, Symbol) -> %
      ++ zeroOf(p, y) returns y such that \spad{p(y) = 0}.
      ++ The value y is expressed in terms of radicals if possible, and otherwise
      ++ as an implicit algebraic quantity
      ++ which displays as \spad{'y}.
    zerosOf : (%, Symbol) -> List %
      ++ zerosOf(p, y) returns \spad{[y1, ..., yn]} such that \spad{p(yi) = 0}.
      ++ The yi's are expressed in radicals if possible, and otherwise
      ++ as implicit algebraic quantities containing
      ++ new symbols which display as \spad{'%z0}, \spad{'%z1}, ...;
      ++ The new symbols are bound in the interpreter
      ++ to the respective values.
    rootSum : (%, SparseUnivariatePolynomial %, Symbol) -> %
    if R has RetractableTo Integer then RetractableTo AlgebraicNumber
  add

    import from Integer
    import from List(Symbol)
    import from SparseUnivariatePolynomial(%)
    import from Fraction(SparseUnivariatePolynomial(%))

    rootOf(p : %) ==
      empty?(l := variables p) => error "rootOf: constant expression"
      rootOf(p, first l)

    rootsOf(p : %) ==
      empty?(l := variables p) => error "rootsOf: constant expression"
      rootsOf(p, first l)

    zeroOf(p : %) ==
      empty?(l := variables p) => error "zeroOf: constant expression"
      zeroOf(p, first l)

    zerosOf(p : %) ==
      empty?(l := variables p) => error "zerosOf: constant expression"
      zerosOf(p, first l)

    zeroOf(p : %, x : Symbol) ==
      n := numer(f := univariate(p, kernel(x)$Kernel(%)))
      degree denom f > 0 => error "zeroOf: variable appears in denom"
      degree n = 0 => error "zeroOf: constant expression"
      zeroOf(n, x)

    rootOf(p : %, x : Symbol) ==
      n := numer(f := univariate(p, kernel(x)$Kernel(%)))
      degree denom f > 0 => error "roofOf: variable appears in denom"
      degree n = 0 => error "rootOf: constant expression"
      rootOf(n, x)

    zerosOf(p : %, x : Symbol) ==
      n := numer(f := univariate(p, kernel(x)$Kernel(%)))
      degree denom f > 0 => error "zerosOf: variable appears in denom"
      degree n = 0 => empty()
      zerosOf(n, x)

    rootsOf(p : %, x : Symbol) ==
      n := numer(f := univariate(p, kernel(x)$Kernel(%)))
      degree denom f > 0 => error "roofsOf: variable appears in denom"
      degree n = 0 => empty()
      rootsOf(n, x)

    rootsOf(p : SparseUnivariatePolynomial %, y : Symbol) ==
      (r := retractIfCan(p)@Union(%,"failed")) case % => rootsOf(r@%, y)
      rootsOf(p, y)$AlgebraicallyClosedField_&(%)

    zerosOf(p : SparseUnivariatePolynomial %, y : Symbol) ==
      (r := retractIfCan(p)@Union(%,"failed")) case % => zerosOf(r@%,y)
      zerosOf(p, y)$AlgebraicallyClosedField_&(%)

    zeroOf(p : SparseUnivariatePolynomial %, y : Symbol) ==
      (r := retractIfCan(p)@Union(%,"failed")) case % => zeroOf(r@%, y)
      zeroOf(p, y)$AlgebraicallyClosedField_&(%)



)abbrev package AF AlgebraicFunction
++ Author: Manuel Bronstein
++ Date Created: 21 March 1988
++ Description:
++   This package provides algebraic functions over an integral domain.
++ Keywords: algebraic, function.

AlgebraicFunction(R, F) : Exports == Implementation where
  R : Join(Comparable, IntegralDomain)
  F : FunctionSpace R

  SY  ==> Symbol
  Z   ==> Integer
  Q   ==> Fraction Z
  OP  ==> BasicOperator
  K   ==> Kernel F
  P   ==> SparseMultivariatePolynomial(R, K)
  UP  ==> SparseUnivariatePolynomial F
  UPR ==> SparseUnivariatePolynomial R
  SPECIALDISP ==> '%specialDisp
  SPECIALDIFF ==> '%specialDiff
  SPECIALEQUAL ==> '%specialEqual

  Exports ==> with
    rootOf  : (UP, SY) -> F
      ++ rootOf(p, y) returns y such that \spad{p(y) = 0}.
      ++ The object returned displays as \spad{'y}.
    rootSum : (F, UP, SY) -> F
      ++ rootSum(expr, p, s)
    operator : OP -> OP
      ++ operator(op) returns a copy of \spad{op} with the domain-dependent
      ++ properties appropriate for \spad{F}.
      ++ Error: if op is not an algebraic operator, that is,
      ++ an nth root or implicit algebraic operator.
    belong? : OP -> Boolean
      ++ belong?(op) is true if \spad{op} is an algebraic operator, that is,
      ++ an nth root or implicit algebraic operator.
    inrootof : (UP, F) -> F
      ++ inrootof(p, x) should be a non-exported function.
      -- un-export when the compiler accepts conditional local functions!
    droot : List F -> OutputForm
      ++ droot(l) should be a non-exported function.
      -- un-export when the compiler accepts conditional local functions!
    if R has RetractableTo Integer then
      "^"   : (F, Q) -> F
        ++ x ^ q is \spad{x} raised to the rational power \spad{q}.
      minPoly : K  -> UP
        ++ minPoly(k) returns the defining polynomial of \spad{k}.
      definingPolynomial : F -> F
        ++ definingPolynomial(f) returns the defining polynomial of \spad{f}
        ++ as an element of \spad{F}.
        ++ Error: if f is not a kernel.
      iroot : (R, Z) -> F
        ++ iroot(p, n) should be a non-exported function.
        -- un-export when the compiler accepts conditional local functions!

  Implementation ==> add

    ALGOP       := '%alg

    ialg : List F -> F
    dvalg : (List F, SY) -> F
    dalg : List F -> OutputForm

    opalg  := operator('rootOf)$CommonOperators
    oproot := operator('nthRoot)$CommonOperators
    oprootsum := operator('%root_sum)$CommonOperators

    belong? op == has?(op, ALGOP) or is?(op, '%root_sum)
    dalg l     == second(l)::OutputForm

    import from UP
    import from Fraction(UP)
    import from Integer
    import from SparseMultivariatePolynomial(R, Kernel(F))
    import from List(F)

    rootOf(p, x) ==
      k := kernel(x)$K
      (r := retractIfCan(p)@Union(F, "failed")) case "failed" =>
        inrootof(p, k::F)
      n := numer(f := univariate(r@F, k))
      degree denom f > 0 => error "roofOf: variable appears in denom"
      inrootof(n, k::F)

    dvalg(l, x) ==
      p := numer univariate(first l, retract(second l)@K)
      alpha := kernel(opalg, l)
      - (map((s : F) : F +-> differentiate(s, x), p) alpha) _
          / ((differentiate p) alpha)

    ialg l ==
      f := univariate(p := first l, retract(x := second l)@K)
      degree denom f > 0 => error "roofOf: variable appears in denom"
      inrootof(numer f, x)

    operator op ==
      is?(op,  'rootOf) => opalg
      is?(op, 'nthRoot) => oproot
      is?(op, '%root_sum) => oprootsum
      error "Unknown operator"

    if R has AlgebraicallyClosedField then
      UP2R : UP -> Union(UPR, "failed")

      inrootof(q, x) ==
        monomial? q => 0

        (d := degree q) <= 0 => error "rootOf: constant polynomial"
        (d = 1) => - leadingCoefficient(reductum q) / leadingCoefficient q
        ((rx := retractIfCan(x)@Union(SY, "failed")) case SY) and
          ((r := UP2R q) case UPR) => rootOf(r::UPR, rx@SY)::F
        kernel(opalg, [q x, x])

      UP2R p ==
        ans : UPR := 0
        while p ~= 0 repeat
          (r := retractIfCan(leadingCoefficient p)@Union(R, "failed"))
            case "failed" => return "failed"
          ans := ans + monomial(r@R, degree p)
          p   := reductum p
        ans

    else
      inrootof(q, x) ==
        monomial? q => 0
        (d := degree q) <= 0 => error "rootOf: constant polynomial"
        (d = 1) => - leadingCoefficient(reductum q) /leadingCoefficient q
        kernel(opalg, [q x, x])

    eqopalg(k1 : K, k2 : K) : Boolean ==
        al1 := argument(k1)
        al2 := argument(k2)
        dv1 := retract(al1.2)@K
        dv2 := retract(al2.2)@K
        pe1 := al1.1
        pe2 := al2.1
        dv1 = dv2 => pe1 = pe2
        p1 := univariate(numer(pe1), dv1)
        p2 := univariate(numer(pe2), dv2)
        lc1 := leadingCoefficient(p1)
        lc2 := leadingCoefficient(p2)
        lc1 = lc2 => p1 = p2
        lc2*p1 = lc1*p2

    evaluate(opalg, ialg)$BasicOperatorFunctions1(F)
    setProperty(opalg, SPECIALDIFF,
                              dvalg@((List F, SY) -> F) pretend None)
    setProperty(opalg, SPECIALDISP,
                              dalg@(List F -> OutputForm) pretend None)
    setProperty(opalg, SPECIALEQUAL, eqopalg@((K, K) -> Boolean) pretend None)

    POLYCATQ ==> PolynomialCategoryQuotientFunctions(IndexedExponents(K),
                                                     K, R, P, F)

    root_sum1(expr : F, p : UP, x : F) : F ==
        expr = 0 => 0
        k := retract(x)@K
        degree(p) = 1 =>
            a := -coefficient(p, 0)/coefficient(p, 1)
            eval(expr, k, a)
        nexpr := univariate(expr, k, p)$POLYCATQ
        xs := retract(x)@SY
        every?((c : F) : Boolean +-> D(c, xs) = 0, coefficients(nexpr)) =>
            res : F := 0
            for i in 0..(degree(p) - 1) repeat
                nexpr := nexpr rem p
                res := res + coefficient(nexpr, i)
                nexpr := monomial(1, 1)$UP*nexpr
            res
        kernel(oprootsum, [nexpr(x), x, p(x)])

    rootSum(expr : F, p : UP, s : SY) : F ==
        k := kernel(s)$K
        root_sum1(expr, p, k::F)

    irootsum(l : List F) : F ==
        p := univariate(p := l.3, retract(x := l.2)@K)
        degree denom p > 0 => error "roofSum: variable appears in denom of p"
        root_sum1(l.1, numer(p), x)

    drootsum(l : List F) : OutputForm ==
        dv := retract(l.2)@K
        p := univariate(numer(l.3), dv)
        sum((l.1)::OutputForm,
            outputForm(p, dv::OutputForm) = (0$Z)::OutputForm)

    dvrootsum(l : List F, x : SY) : F ==
        -- print("dvrootsum"::OutputForm)
        -- print(l::OutputForm)
        dv := retract(alpha := l.2)@K
        dvs := retract(alpha)@SY
        p : UP := numer(univariate(l.3, dv))
        -- print(p::OutputForm)
        dalpha := - (map((s : F) : F +-> differentiate(s, x), p) alpha)
            / ((differentiate p) alpha)
        expr := l.1
        nexpr := dalpha*differentiate(expr, dvs) +
                 differentiate(expr, x)
        -- print(nexpr::OutputForm)
        nexpr = 0 => 0
        root_sum1(nexpr, p, alpha)

    evaluate(oprootsum, irootsum)$BasicOperatorFunctions1(F)

    setProperty(oprootsum, SPECIALDIFF,
                        dvrootsum@((List F, SY) -> F) pretend None)
    setProperty(oprootsum, SPECIALDISP,
                        drootsum@(List F -> OutputForm) pretend None)

    if R has RetractableTo Integer then
      import from PolynomialRoots(IndexedExponents K, K, R, P, F)

      dumvar := '%%var::F

      lzero   : List F -> F
      dvroot  : List F -> F
      inroot  : List F -> F
      hackroot : (F, Z) -> F
      inroot0 : (F, Z, Boolean, Boolean) -> F

      lzero l == 0

      droot l ==
        x := first(l)::OutputForm
        (n := retract(second l)@Z) = 2 => root x
        root(x, n::OutputForm)

      dvroot l ==
        n := retract(second l)@Z
        kf := kernel(oproot, l)
        (kf^(1 - n)) / (n::F)

      x ^ q ==
        qr := divide(numer q, denom q)
        x ^ qr.quotient * inroot([x, (denom q)::F]) ^ qr.remainder

      hackroot(x, n) ==
        (n = 1) or (x = 1) => x
        (((dx := denom x) ~= 1) and (numer(x) = 1) and
           ((rx := retractIfCan(dx)@Union(Integer,"failed")) case Integer) and
               positive?(rx)) =>
                   inv hackroot(rx@Integer::F, n)
        (x = -1) and n = 4 =>
          ((-1::F) ^ (1::Q / 2::Q) + 1) / ((2::F) ^ (1::Q / 2::Q))
        kernel(oproot, [x, n::F])

      inroot l ==
        zero?(n := retract(second l)@Z) => error "root: exponent = 0"
        ((x := first l) = 1) or (n = 1) => x
        (r := retractIfCan(x)@Union(R,"failed")) case R => iroot(r@R,n)
        inroot0(x, n, false, false)

-- removes powers of positive integers from numer and denom
-- num? or den? is true if numer or denom already processed
      inroot0(x, n, num?, den?) ==
        rn:Union(Z, "failed") := (num? => "failed"; retractIfCan numer x)
        rd:Union(Z, "failed") := (den? => "failed"; retractIfCan denom x)
        (rn case Z) and (rd case Z) =>
          rec := qroot(rn@Z / rd@Z, n::NonNegativeInteger)
          rec.coef * hackroot(rec.radicand, rec.exponent)
        rn case Z =>
          rec := qroot(rn@Z::Fraction(Z), n::NonNegativeInteger)
          rec.coef * inroot0((rec.radicand^(n exquo rec.exponent)::Z)
                                / (denom(x)::F), n, true, den?)
        rd case Z =>
          rec := qroot(rd@Z::Fraction(Z), n::NonNegativeInteger)
          inroot0((numer(x)::F) /
                  (rec.radicand ^ (n exquo rec.exponent)::Z),
                   n, num?, true) / rec.coef
        hackroot(x, n)

      if R has AlgebraicallyClosedField then iroot(r, n) == nthRoot(r, n)::F
      else
        iroot0 : (R, Z) -> F

        if R has RadicalCategory then
          if R has imaginary : () -> R then iroot(r, n) == nthRoot(r, n)::F
          else
              if R has FloatingPointSystem then
                  iroot(r, n) ==
                      odd? n or not(smaller?(r, 0)) => nthRoot(r, n)::F
                      hackroot(r::F, n)
              else
                  iroot(r, n) ==
                      odd? n or not(smaller?(r, 0)) => nthRoot(r, n)::F
                      iroot0(r, n)

        else iroot(r, n) == iroot0(r, n)

        iroot0(r, n) ==
          rec := rroot(r, n::NonNegativeInteger)
          rec.coef * hackroot(rec.radicand, rec.exponent)

      definingPolynomial x ==
        (r := retractIfCan(x)@Union(K, "failed")) case K =>
          is?(k := r@K, opalg) => first argument k
          is?(k, oproot) =>
            dumvar ^ retract(second argument k)@Z - first argument k
          dumvar - x
        dumvar - x

      minPoly k ==
        is?(k, opalg)  =>
           numer univariate(first argument k,
                                           retract(second argument k)@K)
        is?(k, oproot) =>
           monomial(1, retract(second argument k)@Z :: NonNegativeInteger)
             - first(argument k)::UP
        monomial(1, 1) - k::F::UP

      evaluate(oproot, inroot)$BasicOperatorFunctions1(F)
      derivative(oproot, [dvroot, lzero])

    else   -- R is not retractable to Integer
      droot l ==
        x := first(l)::OutputForm
        (n := second l) = 2::F => root x
        root(x, n::OutputForm)

      minPoly k ==
        is?(k, opalg)  =>
           numer univariate(first argument k,
                                           retract(second argument k)@K)
        monomial(1, 1) - k::F::UP

    setProperty(oproot, SPECIALDISP,
                              droot@(List F -> OutputForm) pretend None)

--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.

-- SPAD files for the functional world should be compiled in the
-- following order:
--
--   op  kl  fspace ALGFUNC expr
