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

)abbrev domain EFUPXS ElementaryFunctionsUnivariatePuiseuxSeries
++ Author: Clifton J. Williamson
++ Date Created: 20 February 1990
++ Date Last Updated: 20 February 1990
++ Description:
++ This package provides elementary functions on any Laurent series
++ domain over a field which was constructed from a Taylor series
++ domain.  These functions are implemented by calling the
++ corresponding functions on the Taylor series domain.  We also
++ provide 'partial functions' which compute transcendental
++ functions of Laurent series when possible and return "failed"
++ when this is not possible.

ElementaryFunctionsUnivariatePuiseuxSeries(Coef,ULS,UPXS,EFULS) : 
 SIG == CODE where
  Coef   : Algebra Fraction Integer
  ULS    : UnivariateLaurentSeriesCategory Coef
  UPXS   : UnivariatePuiseuxSeriesConstructorCategory(Coef,ULS)
  EFULS  : PartialTranscendentalFunctions(ULS)

  I    ==> Integer
  NNI  ==> NonNegativeInteger
  RN   ==> Fraction Integer
 
  SIG ==> PartialTranscendentalFunctions(UPXS) with
 
    if Coef has Field then

      "**" : (UPXS,RN) -> UPXS
        ++ z ** r raises a Puiseaux series z to a rational power r
 
    --% Exponentials and Logarithms
 
    exp : UPXS -> UPXS
      ++ exp(z) returns the exponential of a Puiseux series z.

    log : UPXS -> UPXS
      ++ log(z) returns the logarithm of a Puiseux series z.
 
    --% TrigonometricFunctionCategory
 
    sin : UPXS -> UPXS
      ++ sin(z) returns the sine of a Puiseux series z.

    cos : UPXS -> UPXS
      ++ cos(z) returns the cosine of a Puiseux series z.

    tan : UPXS -> UPXS
      ++ tan(z) returns the tangent of a Puiseux series z.

    cot : UPXS -> UPXS
      ++ cot(z) returns the cotangent of a Puiseux series z.

    sec : UPXS -> UPXS
      ++ sec(z) returns the secant of a Puiseux series z.

    csc : UPXS -> UPXS
      ++ csc(z) returns the cosecant of a Puiseux series z.
 
    --% ArcTrigonometricFunctionCategory
 
    asin : UPXS -> UPXS
      ++ asin(z) returns the arc-sine of a Puiseux series z.

    acos : UPXS -> UPXS
      ++ acos(z) returns the arc-cosine of a Puiseux series z.

    atan : UPXS -> UPXS
      ++ atan(z) returns the arc-tangent of a Puiseux series z.

    acot : UPXS -> UPXS
      ++ acot(z) returns the arc-cotangent of a Puiseux series z.

    asec : UPXS -> UPXS
      ++ asec(z) returns the arc-secant of a Puiseux series z.

    acsc : UPXS -> UPXS
      ++ acsc(z) returns the arc-cosecant of a Puiseux series z.
 
    --% HyperbolicFunctionCategory
 
    sinh : UPXS -> UPXS
      ++ sinh(z) returns the hyperbolic sine of a Puiseux series z.

    cosh : UPXS -> UPXS
      ++ cosh(z) returns the hyperbolic cosine of a Puiseux series z.

    tanh : UPXS -> UPXS
      ++ tanh(z) returns the hyperbolic tangent of a Puiseux series z.

    coth : UPXS -> UPXS
      ++ coth(z) returns the hyperbolic cotangent of a Puiseux series z.

    sech : UPXS -> UPXS
      ++ sech(z) returns the hyperbolic secant of a Puiseux series z.

    csch : UPXS -> UPXS
      ++ csch(z) returns the hyperbolic cosecant of a Puiseux series z.
 
    --% ArcHyperbolicFunctionCategory
 
    asinh : UPXS -> UPXS
      ++ asinh(z) returns the inverse hyperbolic sine of a Puiseux series z.

    acosh : UPXS -> UPXS
      ++ acosh(z) returns the inverse hyperbolic cosine of a Puiseux series z.

    atanh : UPXS -> UPXS
      ++ atanh(z) returns the inverse hyperbolic tangent of a Puiseux series z.

    acoth : UPXS -> UPXS
      ++ acoth(z) returns the inverse hyperbolic cotangent 
      ++ of a Puiseux series z.

    asech : UPXS -> UPXS
      ++ asech(z) returns the inverse hyperbolic secant of a Puiseux series z.

    acsch : UPXS -> UPXS
      ++ acsch(z) returns the inverse hyperbolic cosecant 
      ++ of a Puiseux series z.
 
  CODE ==> add

    TRANSFCN : Boolean := Coef has TranscendentalFunctionCategory
 
    --% roots
 
    nthRootIfCan(upxs,n) ==
      n = 1 => upxs
      r := rationalPower upxs; uls := laurentRep upxs
      deg := degree uls
      if zero?(coef := coefficient(uls,deg)) then
        deg := order(uls,deg + 1000)
        zero?(coef := coefficient(uls,deg)) =>
          error "root of series with many leading zero coefficients"
      uls := uls * monomial(1,-deg)$ULS
      (ulsRoot := nthRootIfCan(uls,n)) case "failed" => "failed"
      puiseux(r,ulsRoot :: ULS) * monomial(1,deg * r * inv(n :: RN))
 
    if Coef has Field then
       (upxs:UPXS) ** (q:RN) ==
         num := numer q; den := denom q
         den = 1 => upxs ** num
         r := rationalPower upxs; uls := laurentRep upxs
         deg := degree uls
         if zero?(coef := coefficient(uls,deg)) then
           deg := order(uls,deg + 1000)
           zero?(coef := coefficient(uls,deg)) =>
             error "power of series with many leading zero coefficients"
         ulsPow := (uls * monomial(1,-deg)$ULS) ** q
         puiseux(r,ulsPow) * monomial(1,deg*q*r)
 
    --% transcendental functions
 
    applyIfCan: (ULS -> Union(ULS,"failed"),UPXS) -> Union(UPXS,"failed")
    applyIfCan(fcn,upxs) ==
      uls := fcn laurentRep upxs
      uls case "failed" => "failed"
      puiseux(rationalPower upxs,uls :: ULS)
 
    expIfCan   upxs == applyIfCan(expIfCan,upxs)

    logIfCan   upxs == applyIfCan(logIfCan,upxs)

    sinIfCan   upxs == applyIfCan(sinIfCan,upxs)

    cosIfCan   upxs == applyIfCan(cosIfCan,upxs)

    tanIfCan   upxs == applyIfCan(tanIfCan,upxs)

    cotIfCan   upxs == applyIfCan(cotIfCan,upxs)

    secIfCan   upxs == applyIfCan(secIfCan,upxs)

    cscIfCan   upxs == applyIfCan(cscIfCan,upxs)

    atanIfCan  upxs == applyIfCan(atanIfCan,upxs)

    acotIfCan  upxs == applyIfCan(acotIfCan,upxs)

    sinhIfCan  upxs == applyIfCan(sinhIfCan,upxs)

    coshIfCan  upxs == applyIfCan(coshIfCan,upxs)

    tanhIfCan  upxs == applyIfCan(tanhIfCan,upxs)

    cothIfCan  upxs == applyIfCan(cothIfCan,upxs)

    sechIfCan  upxs == applyIfCan(sechIfCan,upxs)

    cschIfCan  upxs == applyIfCan(cschIfCan,upxs)

    asinhIfCan upxs == applyIfCan(asinhIfCan,upxs)

    acoshIfCan upxs == applyIfCan(acoshIfCan,upxs)

    atanhIfCan upxs == applyIfCan(atanhIfCan,upxs)

    acothIfCan upxs == applyIfCan(acothIfCan,upxs)

    asechIfCan upxs == applyIfCan(asechIfCan,upxs)

    acschIfCan upxs == applyIfCan(acschIfCan,upxs)

    asinIfCan upxs ==
      order(upxs,0) < 0 => "failed"
      (coef := coefficient(upxs,0)) = 0 =>
        integrate((1 - upxs*upxs)**(-1/2) * (differentiate upxs))
      TRANSFCN =>
        cc := asin(coef) :: UPXS
        cc + integrate((1 - upxs*upxs)**(-1/2) * (differentiate upxs))
      "failed"

    acosIfCan upxs ==
      order(upxs,0) < 0 => "failed"
      TRANSFCN =>
        cc := acos(coefficient(upxs,0)) :: UPXS
        cc + integrate(-(1 - upxs*upxs)**(-1/2) * (differentiate upxs))
      "failed"

    asecIfCan upxs ==
      order(upxs,0) < 0 => "failed"
      TRANSFCN =>
        cc := asec(coefficient(upxs,0)) :: UPXS
        f := (upxs*upxs - 1)**(-1/2) * (differentiate upxs)
        (rec := recip upxs) case "failed" => "failed"
        cc + integrate(f * (rec :: UPXS))
      "failed"

    acscIfCan upxs ==
      order(upxs,0) < 0 => "failed"
      TRANSFCN =>
        cc := acsc(coefficient(upxs,0)) :: UPXS
        f := -(upxs*upxs - 1)**(-1/2) * (differentiate upxs)
        (rec := recip upxs) case "failed" => "failed"
        cc + integrate(f * (rec :: UPXS))
      "failed"

    asinhIfCan upxs ==
      order(upxs,0) < 0 => "failed"
      TRANSFCN or (coefficient(upxs,0) = 0) =>
        log(upxs + (1 + upxs*upxs)**(1/2))
      "failed"

    acoshIfCan upxs ==
      TRANSFCN =>
        order(upxs,0) < 0 => "failed"
        log(upxs + (upxs*upxs - 1)**(1/2))
      "failed"

    asechIfCan upxs ==
      TRANSFCN =>
        order(upxs,0) < 0 => "failed"
        (rec := recip upxs) case "failed" => "failed"
        log((1 + (1 - upxs*upxs)*(1/2)) * (rec :: UPXS))
      "failed"

    acschIfCan upxs ==
      TRANSFCN =>
        order(upxs,0) < 0 => "failed"
        (rec := recip upxs) case "failed" => "failed"
        log((1 + (1 + upxs*upxs)*(1/2)) * (rec :: UPXS))
      "failed"
 
    applyOrError:(UPXS -> Union(UPXS,"failed"),String,UPXS) -> UPXS
    applyOrError(fcn,name,upxs) ==
      ans := fcn upxs
      ans case "failed" =>
        error concat(name," of function with singularity")
      ans :: UPXS
 
    exp upxs   == applyOrError(expIfCan,"exp",upxs)

    log upxs   == applyOrError(logIfCan,"log",upxs)

    sin upxs   == applyOrError(sinIfCan,"sin",upxs)

    cos upxs   == applyOrError(cosIfCan,"cos",upxs)

    tan upxs   == applyOrError(tanIfCan,"tan",upxs)

    cot upxs   == applyOrError(cotIfCan,"cot",upxs)

    sec upxs   == applyOrError(secIfCan,"sec",upxs)

    csc upxs   == applyOrError(cscIfCan,"csc",upxs)

    asin upxs  == applyOrError(asinIfCan,"asin",upxs)

    acos upxs  == applyOrError(acosIfCan,"acos",upxs)

    atan upxs  == applyOrError(atanIfCan,"atan",upxs)

    acot upxs  == applyOrError(acotIfCan,"acot",upxs)

    asec upxs  == applyOrError(asecIfCan,"asec",upxs)

    acsc upxs  == applyOrError(acscIfCan,"acsc",upxs)

    sinh upxs  == applyOrError(sinhIfCan,"sinh",upxs)

    cosh upxs  == applyOrError(coshIfCan,"cosh",upxs)

    tanh upxs  == applyOrError(tanhIfCan,"tanh",upxs)

    coth upxs  == applyOrError(cothIfCan,"coth",upxs)

    sech upxs  == applyOrError(sechIfCan,"sech",upxs)

    csch upxs  == applyOrError(cschIfCan,"csch",upxs)

    asinh upxs == applyOrError(asinhIfCan,"asinh",upxs)

    acosh upxs == applyOrError(acoshIfCan,"acosh",upxs)

    atanh upxs == applyOrError(atanhIfCan,"atanh",upxs)

    acoth upxs == applyOrError(acothIfCan,"acoth",upxs)

    asech upxs == applyOrError(asechIfCan,"asech",upxs)

    acsch upxs == applyOrError(acschIfCan,"acsch",upxs)