)abbrev package LF LiouvillianFunction
++ Author: Manuel Bronstein
++ Date Created: 1987
++ Keywords: liouvillian, function, primitive, exponential.
++ Examples:  )r LF INPUT
++ Description:
++   This package provides liouvillian functions over an integral domain.
LiouvillianFunction(R, F) : Exports == Implementation where
  R : Join(Comparable, IntegralDomain)
  F : Join(FunctionSpace R, RadicalCategory, TranscendentalFunctionCategory)

  OP  ==> BasicOperator
  PR  ==> Polynomial R
  K   ==> Kernel F
  SE  ==> Symbol
  O   ==> OutputForm
  INP ==> InputForm
  INV ==> error "Invalid argument"

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

  Exports ==> with
    belong? : OP -> Boolean
      ++ belong?(op) checks if op is Liouvillian
    operator : OP -> OP
      ++ operator(op) returns the Liouvillian operator based on op
    Ei      : F  -> F
      ++ Ei(f) denotes the exponential integral
    Si      : F  -> F
      ++ Si(f) denotes the sine integral
    Ci      : F  -> F
      ++ Ci(f) denotes the cosine integral
    Shi      : F  -> F
      ++ Shi(f) denotes the hyperbolic sine integral
    Chi      : F  -> F
      ++ Chi(f) denotes the hyperbolic cosine integral
    li      : F  -> F
      ++ li(f) denotes the logarithmic integral
    erf     : F  -> F
      ++ erf(f) denotes the error function
    erfi    : F  -> F
      ++ erfi(f) denotes \spad{-%i*erf(%i*z)}
    dilog   : F  -> F
      ++ dilog(f) denotes the dilogarithm
    fresnelS : F  -> F
      ++ fresnelS(f) denotes the Fresnel integral \spad{S}
    fresnelC : F  -> F
      ++ fresnelC(f) denotes the Fresnel integral \spad{C}
    integral : (F, SE) -> F
      ++ integral(f, x) indefinite integral of f with respect to x.
    integral : (F, SegmentBinding F) -> F
      ++ integral(f, x = a..b) denotes the definite integral of f with
      ++ respect to x from \spad{a} to b.

  Implementation ==> add

    PRIM := 'prim

    iei        : F  -> F
    isi        : F  -> F
    ici        : F  -> F
    ishi       : F  -> F
    ichi       : F  -> F
    ierf       : F  -> F
    ierfi      : F  -> F
    ili        : F  -> F
    ili2       : F  -> F
    iint       : List F -> F
    eqint      : (K, K) -> Boolean
    dvint      : (List F, SE) -> F
    dviint      : (List F, SE) -> F
    dvdint     : (List F, SE) -> F
    ddint      : List F -> O
    integrand  : List F -> F

    dummy := new()$SE :: F

    opint  := operator('integral)$CommonOperators
    opiint := operator('%iint)$CommonOperators
    opdint := operator('%defint)$CommonOperators
    opei   := operator('Ei)$CommonOperators
    opli   := operator('li)$CommonOperators
    opsi   := operator('Si)$CommonOperators
    opci   := operator('Ci)$CommonOperators
    opshi  := operator('Shi)$CommonOperators
    opchi  := operator('Chi)$CommonOperators
    opli2  := operator('dilog)$CommonOperators
    operf  := operator('erf)$CommonOperators
    operfi := operator('erfi)$CommonOperators
    opfis  := operator('fresnelS)$CommonOperators
    opfic  := operator('fresnelC)$CommonOperators

    Si x                == opsi x
    Ci x                == opci x
    Shi x               == opshi x
    Chi x               == opchi x
    Ei x                == opei x
    erf x               == operf x
    erfi x               == operfi x
    li  x               == opli x
    dilog x             == opli2 x
    fresnelS x          == opfis x
    fresnelC x          == opfic x

    belong? op     == has?(op, PRIM)
    isi x          == (zero? x => 0; kernel(opsi, x))
    ici x          == kernel(opci, x)
    ishi x         == (zero? x => 0; kernel(opshi, x))
    ichi x         == kernel(opchi, x)
    ierf x         == (zero? x => 0; kernel(operf, x))
    ierfi x         == (zero? x => 0; kernel(operfi, x))
    ili2 x         == ((x = 1) => 0; kernel(opli2, x))
    ifis(x : F) : F == (zero? x => 0; kernel(opfis, x))
    ific(x : F) : F == (zero? x => 0; kernel(opfic, x))
    integrand l    == eval(first l, retract(second l)@K, third l)
    integral(f : F, x : SE) == opint [eval(f, k := kernel(x)$K, dummy), dummy, k::F]

    iint l ==
      zero? first l => 0
      kernel(opint, l)

    ddint l ==
      int(integrand(l)::O * hconcat('d::O, third(l)::O),
                                    third(rest l)::O, third(rest rest l)::O)

    eqint(k1, k2) ==
      a1 := argument k1
      a2 := argument k2
      res := operator k1 = operator k2
      if not res then return res
      res := a1 = a2
      if res then return res
      res := (a1.3 = a2.3) and (subst(a1.1, [retract(a1.2)@K], [a2.2]) = a2.1)

    dvint(l, x) ==
      k  := retract(second l)@K
      differentiate(third l, x) * integrand l
          + opint [differentiate(first l, x), second l, third l]

    iiint(l : List F) : F ==
        nu := #l exquo 2
        nu case "failed" => error "impossible"
        n := nu :: NonNegativeInteger
        lval := rest(l, n)
        every?(zero?, lval) => 0
        kernel(opiint, l)

    dviint(l : List F, v : SE) : F ==
        nu := #l exquo 2
        nu case "failed" => error "impossible"
        n := nu :: NonNegativeInteger
        lvf := first(l, n)
        lv := [retract(vf)@Symbol for vf in lvf]
        m := position(v, lv)
        m = 0 => 0
        l(n+m)

    dvdint(l, x) ==
      x = retract(y := third l)@SE => 0
      k := retract(d := second l)@K
      differentiate(h := third rest rest l, x) * eval(f := first l, k, h)
        - differentiate(g := third rest l, x) * eval(f, k, g)
             + opdint [differentiate(f, x), d, y, g, h]

    integral(f : F, s : SegmentBinding F) ==
      x := kernel(variable s)$K
      opdint [eval(f, x, dummy), dummy, x::F, low(segment(s)),
               high(segment(s))]

    ili x ==
      x = 1 => INV
      is?(x, 'exp) => Ei first argument(retract(x)@K)
      kernel(opli, x)

    iei x ==
      x = 0 => INV
      is?(x, 'log) => li first argument(retract(x)@K)
      kernel(opei, x)

    operator op ==
      is?(op, 'integral)   => opint
      is?(op, '%iint)      => opiint
      is?(op, '%defint)    => opdint
      is?(op, 'Ei)         => opei
      is?(op, 'Si)         => opsi
      is?(op, 'Ci)         => opci
      is?(op, 'Shi)        => opshi
      is?(op, 'Chi)        => opchi
      is?(op, 'li)         => opli
      is?(op, 'erf)        => operf
      is?(op, 'erfi)        => operfi
      is?(op, 'dilog)      => opli2
      is?(op, 'fresnelC)   => opfic
      is?(op, 'fresnelS)   => opfis
      error "Not a Liouvillian operator"

    evaluate(opei,   iei)$BasicOperatorFunctions1(F)
    evaluate(opli,   ili)
    evaluate(opsi,   isi)
    evaluate(opci,   ici)
    evaluate(opshi,  ishi)
    evaluate(opchi,  ichi)
    evaluate(operf,  ierf)
    evaluate(operfi, ierfi)
    evaluate(opli2,  ili2)
    evaluate(opfis,  ifis)
    evaluate(opfic,  ific)
    evaluate(opint,  iint)
    evaluate(opiint,  iiint)
    derivative(opsi, (z1 : F) : F +-> sin(z1) / z1)
    derivative(opci, (z1 : F) : F +-> cos(z1) / z1)
    derivative(opshi, (z1 : F) : F +-> sinh(z1) / z1)
    derivative(opchi, (z1 : F) : F +-> cosh(z1) / z1)
    derivative(opei, (z1 : F) : F +-> exp(z1) / z1)
    derivative(opli, (z1 : F) : F +-> inv log(z1))
    derivative(operf, (z1 : F) : F +-> 2 * exp(-(z1^2)) / sqrt(pi()))
    derivative(operfi, (z1 : F) : F +-> 2*exp(z1^2) / sqrt(pi()))
    derivative(opli2, (z1 : F) : F +-> log(z1) / (1 - z1))
    derivative(opfis, (z1 : F) : F +-> sin(pi()*z1^2/(2::F)))
    derivative(opfic, (z1 : F) : F +-> cos(pi()*z1^2/(2::F)))
    setProperty(opint, SPECIALEQUAL, eqint@((K, K) -> Boolean) pretend None)
    setProperty(opint, SPECIALDIFF, dvint@((List F, SE) -> F) pretend None)
    setProperty(opiint, SPECIALDIFF, dviint@((List F, SE) -> F) pretend None)
    setProperty(opdint, SPECIALDIFF, dvdint@((List F, SE)->F) pretend None)
    setProperty(opdint, SPECIALDISP, ddint@(List F -> O) pretend None)

    if R has ConvertibleTo INP then
      inint : List F -> INP
      indint : List F -> INP
      pint  : List INP -> INP


      pint l  == convert concat(convert('integral)@INP, l)
      inint l ==
        r2 := convert([convert("::"::SE)@INP,convert(third l)@INP,convert('Symbol)@INP]@List INP)@INP
        pint [convert(integrand l)@INP, r2]

      indint l ==
        pint [convert(integrand l)@INP,
              convert concat(convert("="::SE)@INP,
                            [convert(third l)@INP,
                             convert concat(convert('SEGMENT)@INP,
                                            [convert(third rest l)@INP,
                                             convert(third rest rest l)@INP])])]

      setProperty(opint, SPECIALINPUT, inint@(List F -> INP) pretend None)
      setProperty(opdint, SPECIALINPUT, indint@(List F -> INP) 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 elemntry LIOUV expr
