)abbrev package DFSFUN DoubleFloatSpecialFunctions
++ Author: Bruce W. Char, Stephen M. Watt
++ Date Created:  1990
++ Basic Operations:
++ Related Domains:
++ Also See:
++ AMS Classifications:
++ Keywords:
++ Examples:
++ References:
++ Description:
++   This package provides special functions for double precision
++   real and complex floating point.

DoubleFloatSpecialFunctions() : Exports == Impl where
    NNI ==> NonNegativeInteger
    R   ==> DoubleFloat
    C   ==> Complex DoubleFloat

    Exports ==> with
        Gamma : R -> R
            ++ Gamma(x) is the Euler gamma function, \spad{Gamma(x)}, defined by
            ++   \spad{Gamma(x) = integrate(t^(x-1)*exp(-t), t=0..%infinity)}.
        Gamma : C -> C
            ++ Gamma(x) is the Euler gamma function, \spad{Gamma(x)}, defined by
            ++   \spad{Gamma(x) = integrate(t^(x-1)*exp(-t), t=0..%infinity)}.

        Beta : (R, R) -> R
            ++ Beta(x, y) is the Euler beta function, \spad{B(x, y)}, defined by
            ++   \spad{Beta(x, y) = integrate(t^(x-1)*(1-t)^(y-1), t=0..1)}.
            ++ This is related to \spad{Gamma(x)} by
            ++   \spad{Beta(x, y) = Gamma(x)*Gamma(y) / Gamma(x + y)}.
        Beta : (C, C) -> C
            ++ Beta(x, y) is the Euler beta function, \spad{B(x, y)}, defined by
            ++   \spad{Beta(x, y) = integrate(t^(x-1)*(1-t)^(y-1), t=0..1)}.
            ++ This is related to \spad{Gamma(x)} by
            ++   \spad{Beta(x, y) = Gamma(x)*Gamma(y) / Gamma(x + y)}.

        logGamma : R -> R
            ++ logGamma(x) is the natural log of \spad{Gamma(x)}.
            ++ This can often be computed even if \spad{Gamma(x)} cannot.
        logGamma : C -> C
            ++ logGamma(x) is the natural log of \spad{Gamma(x)}.
            ++ This can often be computed even if \spad{Gamma(x)} cannot.

        digamma : R -> R
            ++ digamma(x) is the function, \spad{psi(x)}, defined by
            ++   \spad{psi(x) = Gamma'(x)/Gamma(x)}.
        digamma : C -> C
            ++ digamma(x) is the function, \spad{psi(x)}, defined by
            ++   \spad{psi(x) = Gamma'(x)/Gamma(x)}.

        polygamma : (NNI, R) -> R
            ++ polygamma(n, x) is the n-th derivative of \spad{digamma(x)}.
        polygamma : (NNI, C) -> C
            ++ polygamma(n, x) is the n-th derivative of \spad{digamma(x)}.


        besselJ : (R, R) -> R
            ++ besselJ(v, x) is the Bessel function of the first kind,
            ++ \spad{J(v, x)}.
            ++ This function satisfies the differential equation:
            ++   \spad{x^2 w''(x) + x w'(x) + (x^2-v^2)w(x) = 0}.
        besselJ : (C, C) -> C
            ++ besselJ(v, x) is the Bessel function of the first kind,
            ++ \spad{J(v, x)}.
            ++ This function satisfies the differential equation:
            ++   \spad{x^2 w''(x) + x w'(x) + (x^2-v^2)w(x) = 0}.

        besselY : (R, R) -> R
            ++ besselY(v, x) is the Bessel function of the second kind,
            ++ \spad{Y(v, x)}.
            ++ This function satisfies the differential equation:
            ++   \spad{x^2 w''(x) + x w'(x) + (x^2-v^2)w(x) = 0}.
            ++ Note: The default implementation uses the relation
            ++   \spad{Y(v, x) = (J(v, x) cos(v*%pi) - J(-v, x))/sin(v*%pi)}
            ++ so is not valid for integer values of v.
        besselY : (C, C) -> C
            ++ besselY(v, x) is the Bessel function of the second kind,
            ++ \spad{Y(v, x)}.
            ++ This function satisfies the differential equation:
            ++   \spad{x^2 w''(x) + x w'(x) + (x^2-v^2)w(x) = 0}.
            ++ Note: The default implementation uses the relation
            ++   \spad{Y(v, x) = (J(v, x) cos(v*%pi) - J(-v, x))/sin(v*%pi)}
            ++ so is not valid for integer values of v.

        besselI : (R, R) -> R
            ++ besselI(v, x) is the modified Bessel function of the first kind,
            ++ \spad{I(v, x)}.
            ++ This function satisfies the differential equation:
            ++   \spad{x^2 w''(x) + x w'(x) - (x^2+v^2)w(x) = 0}.
        besselI : (C, C) -> C
            ++ besselI(v, x) is the modified Bessel function of the first kind,
            ++ \spad{I(v, x)}.
            ++ This function satisfies the differential equation:
            ++   \spad{x^2 w''(x) + x w'(x) - (x^2+v^2)w(x) = 0}.

        besselK : (R, R) -> R
            ++ besselK(v, x) is the modified Bessel function of the second kind,
            ++ \spad{K(v, x)}.
            ++ This function satisfies the differential equation:
            ++   \spad{x^2 w''(x) + x w'(x) - (x^2+v^2)w(x) = 0}.
            ++ Note: The default implementation uses the relation
            ++   \spad{K(v, x) = %pi/2*(I(-v, x) - I(v, x))/sin(v*%pi)}.
            ++ so is not valid for integer values of v.
        besselK : (C, C) -> C
            ++ besselK(v, x) is the modified Bessel function of the second kind,
            ++ \spad{K(v, x)}.
            ++ This function satisfies the differential equation:
            ++   \spad{x^2 w''(x) + x w'(x) - (x^2+v^2)w(x) = 0}.
            ++ Note: The default implementation uses the relation
            ++   \spad{K(v, x) = %pi/2*(I(-v, x) - I(v, x))/sin(v*%pi)}
            ++ so is not valid for integer values of v.

        airyAi :   C -> C
            ++ airyAi(x) is the Airy function \spad{Ai(x)}.
            ++ This function satisfies the differential equation:
            ++   \spad{Ai''(x) - x * Ai(x) = 0}.
        airyAi :   R -> R
            ++ airyAi(x) is the Airy function \spad{Ai(x)}.
            ++ This function satisfies the differential equation:
            ++   \spad{Ai''(x) - x * Ai(x) = 0}.

        airyBi :   R -> R
            ++ airyBi(x) is the Airy function \spad{Bi(x)}.
            ++ This function satisfies the differential equation:
            ++   \spad{Bi''(x) - x * Bi(x) = 0}.
        airyBi :   C -> C
            ++ airyBi(x) is the Airy function \spad{Bi(x)}.
            ++ This function satisfies the differential equation:
            ++   \spad{Bi''(x) - x * Bi(x) = 0}.

        hypergeometric0F1 : (R, R) -> R
            ++ hypergeometric0F1(c, z) is the hypergeometric function
            ++ \spad{0F1(; c; z)}.
        hypergeometric0F1 : (C, C) -> C
            ++ hypergeometric0F1(c, z) is the hypergeometric function
            ++ \spad{0F1(; c; z)}.


    Impl ==> add
        a, v, w, z : C
        n, x, y : R

        -- These are hooks to Bruce's boot code.
        Gamma z         == c_gamma(z)$Lisp
        Gamma x         == r_gamma(x)$Lisp

        polygamma(k, z) == c_psi(k, z)$Lisp
        polygamma(k, x) == r_psi(k, x)$Lisp

        logGamma z      == c_lngamma(z)$Lisp
        logGamma x      == r_lngamma(x)$Lisp

        besselJ(v, z)   == c_besselj(v, z)$Lisp
        besselJ(n, x)   == r_besselj(n, x)$Lisp

        besselI(v, z)   == c_besseli(v, z)$Lisp
        besselI(n, x)   == r_besseli(n, x)$Lisp

        hypergeometric0F1(a, z) == c_hyper0f1(a, z)$Lisp
        hypergeometric0F1(n, x) == retract hypergeometric0F1(n::C, x::C)


        -- All others are defined in terms of these.
        digamma x == polygamma(0, x)
        digamma z == polygamma(0, z)

        Beta(x, y) == Gamma(x)*Gamma(y)/Gamma(x+y)
        Beta(w, z) == Gamma(w)*Gamma(z)/Gamma(w+z)

        fuzz := (10::R)^(-7)

        import from IntegerRetractions(R)
        import from IntegerRetractions(C)

        besselY(n, x) ==
            if integer? n then n := n + fuzz
            vp := n * pi()$R
            (cos(vp) * besselJ(n, x) - besselJ(-n, x) )/sin(vp)
        besselY(v, z) ==
            if integer? v then v := v + fuzz::C
            vp := v * pi()$C
            (cos(vp) * besselJ(v, z) - besselJ(-v, z) )/sin(vp)

        besselK(n, x) ==
            if integer? n then n := n + fuzz
            p    := pi()$R
            vp   := n*p
            ahalf:= 1/(2::R)
            p * ahalf * ( besselI(-n, x) - besselI(n, x) )/sin(vp)
        besselK(v, z) ==
            if integer? v then v := v + fuzz::C
            p    := pi()$C
            vp   := v*p
            ahalf:= 1/(2::C)
            p * ahalf * ( besselI(-v, z) - besselI(v, z) )/sin(vp)

        airyAi x ==
            ahalf  := recip(2::R)::R
            athird := recip(3::R)::R
            eta := 2 * athird * (-x) ^ (3*ahalf)
            (-x)^ahalf * athird * (besselJ(-athird, eta) + besselJ(athird, eta))
        airyAi z ==
            ahalf  := recip(2::C)::C
            athird := recip(3::C)::C
            eta := 2 * athird * (-z) ^ (3*ahalf)
            (-z)^ahalf * athird * (besselJ(-athird, eta) + besselJ(athird, eta))

        airyBi x ==
            ahalf  := recip(2::R)::R
            athird := recip(3::R)::R
            eta := 2 * athird * (-x) ^ (3*ahalf)
            (-x*athird)^ahalf * ( besselJ(-athird, eta) - besselJ(athird, eta) )

        airyBi z ==
            ahalf  := recip(2::C)::C
            athird := recip(3::C)::C
            eta := 2 * athird * (-z) ^ (3*ahalf)
            (-z*athird)^ahalf * ( besselJ(-athird, eta) - besselJ(athird, eta) )

)abbrev package ORTHPOL OrthogonalPolynomialFunctions
++ Author: Stephen M. Watt
++ Date Created:  1990
++ Basic Operations:
++ Related Domains:
++ Also See:
++ AMS Classifications:
++ Keywords:
++ Examples:
++ References:
++ Description:
++   This package provides orthogonal polynomials as functions on a ring.

OrthogonalPolynomialFunctions(R : CommutativeRing) : Exports == Impl where
    NNI ==> NonNegativeInteger
    RN  ==> Fraction Integer

    Exports ==> with

        chebyshevT : (NNI, R) -> R
           ++ chebyshevT(n, x) is the n-th Chebyshev polynomial of the first
           ++ kind, \spad{T[n](x)}.  These are defined by
           ++ \spad{(1-t*x)/(1-2*t*x+t^2) = sum(T[n](x) *t^n, n = 0..)}.

        chebyshevU : (NNI, R) -> R
           ++ chebyshevU(n, x) is the n-th Chebyshev polynomial of the second
           ++ kind, \spad{U[n](x)}. These are defined by
           ++ \spad{1/(1-2*t*x+t^2) = sum(T[n](x) *t^n, n = 0..)}.

        hermiteH :   (NNI, R) -> R
           ++ hermiteH(n, x) is the n-th Hermite polynomial, \spad{H[n](x)}.
           ++ These are defined by
           ++ \spad{exp(2*t*x-t^2) = sum(H[n](x)*t^n/n!, n = 0..)}.

        laguerreL :  (NNI, R) -> R
           ++ laguerreL(n, x) is the n-th Laguerre polynomial, \spad{L[n](x)}.
           ++ These are defined by
           ++ \spad{exp(-t*x/(1-t))/(1-t) = sum(L[n](x)*t^n/n!, n = 0..)}.

        laguerreL :  (NNI, NNI, R) -> R
           ++ laguerreL(m, n, x) is the associated Laguerre polynomial,
           ++ \spad{L<m>[n](x)}.  This is the m-th derivative of \spad{L[n](x)}.

        if R has Algebra RN then
            legendreP :  (NNI, R) -> R
                ++ legendreP(n, x) is the n-th Legendre polynomial,
                ++ \spad{P[n](x)}.  These are defined by
                ++ \spad{1/sqrt(1-2*x*t+t^2) = sum(P[n](x)*t^n, n = 0..)}.

    Impl ==> add
        p0, p1 : R
        cx :     Integer

        import from IntegerCombinatoricFunctions()

        laguerreL(n, x) ==
            n = 0 => 1
            (p1, p0) := (-x + 1, 1)
            for i in 1..n-1 repeat
                (p1, p0) := ((2*i::R + 1 - x)*p1 - i^2*p0, p1)
            p1
        laguerreL(m, n, x) ==
            ni := n::Integer
            mi := m::Integer
            cx := (-1)^m * binomial(ni, ni-mi) * factorial(ni)
            p0 := 1
            p1 := cx::R
            for j in 1..ni-mi repeat
                cx := -cx*(ni-mi-j+1)
                cx := (cx exquo ((mi+j)*j))::Integer
                p0 := p0 * x
                p1 := p1 + cx*p0
            p1
        chebyshevT(n, x) ==
            n = 0 => 1
            (p1, p0) := (x, 1)
            for i in 1..n-1 repeat
                (p1, p0) := (2*x*p1 - p0, p1)
            p1
        chebyshevU(n, x) ==
            n = 0 => 1
            (p1, p0) := (2*x, 1)
            for i in 1..n-1 repeat
                (p1, p0) := (2*x*p1 - p0, p1)
            p1
        hermiteH(n, x) ==
            n = 0 => 1
            (p1, p0) := (2*x, 1)
            for i in 1..n-1 repeat
                (p1, p0) := (2*x*p1 - 2*i*p0, p1)
            p1
        if R has Algebra RN then
            legendreP(n, x) ==
                n = 0 => 1
                p0 := 1
                p1 := x
                for i in 1..n-1 repeat
                    c : RN := 1/(i+1)
                    (p1, p0) := (c*((2*i+1)*x*p1 - i*p0), p1)
                p1

)abbrev package NTPOLFN NumberTheoreticPolynomialFunctions
++ Author: Stephen M. Watt
++ Date Created:  1990
++ Basic Operations:
++ Related Domains:
++ Also See:
++ AMS Classifications:
++ Keywords:
++ Examples:
++ References:
++ Description:
++   This package provides polynomials as functions on a ring.

NumberTheoreticPolynomialFunctions(R : CommutativeRing) : Exports == Impl where
    NNI ==> NonNegativeInteger
    RN  ==> Fraction Integer

    Exports ==> with

        cyclotomic : (NNI, R) -> R
                ++ cyclotomic(n, r) returns value of the nth cyclotomic
                ++ polynomial at r.

        if R has Algebra RN then
            bernoulliB : (NNI, R) -> R
                ++ bernoulliB(n, r) returns value of the nth Bernoulli
                ++ polynomial at r.
            eulerE :     (NNI, R) -> R
                ++ eulerE(n, r) returns value of the nth Euler polynomial
                ++ at r.

    Impl ==> add

        import from PolynomialNumberTheoryFunctions()

        I   ==> Integer
        SUP ==> SparseUnivariatePolynomial

        -- This is the wrong way to evaluate the polynomial.
        cyclotomic(k, x) ==
            p : SUP(I) := cyclotomic(k)
            r : R      := 0
            while p ~= 0 repeat
                d := degree p
                c := leadingCoefficient p
                p := reductum p
                r := c*x^d + r
            r

        if R has Algebra RN then
            eulerE(k, x) ==
                p : SUP(RN) := euler(k)
                r : R       := 0
                while p ~= 0 repeat
                    d := degree p
                    c := leadingCoefficient p
                    p := reductum p
                    r := c*x^d + r
                r
            bernoulliB(k, x) ==
                p : SUP(RN) := bernoulli(k)
                r : R       := 0
                while p ~= 0 repeat
                    d := degree p
                    c := leadingCoefficient p
                    p := reductum p
                    r := c*x^d + r
                r

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