path: root/src/algebra/cont.spad.pamphlet

\documentclass{article}
\usepackage{axiom}
\begin{document}
\title{\$SPAD/src/algebra cont.spad}
\author{Brian Dupee}
\maketitle
\begin{abstract}
\end{abstract}
\eject
\tableofcontents
\eject
\section{package ESCONT ExpertSystemContinuityPackage}
<<package ESCONT ExpertSystemContinuityPackage>>=
)abbrev package ESCONT ExpertSystemContinuityPackage
++ Author: Brian Dupee
++ Date Created: May 1994
++ Date Last Updated: June 1995
++ Basic Operations: problemPoints, singularitiesOf, zerosOf
++ Related Constructors:
++ Description:
++ ExpertSystemContinuityPackage is a package of functions for the use of domains
++ belonging to the category \axiomType{NumericalIntegration}.

ExpertSystemContinuityPackage(): E == I where
  EF2   ==> ExpressionFunctions2
  FI    ==> Fraction Integer
  EFI   ==> Expression Fraction Integer
  PFI   ==> Polynomial Fraction Integer
  DF    ==> DoubleFloat
  LDF   ==> List DoubleFloat
  EDF   ==> Expression DoubleFloat
  VEDF  ==> Vector Expression DoubleFloat
  SDF   ==> Stream DoubleFloat
  SS    ==> Stream String
  EEDF  ==> Equation Expression DoubleFloat
  LEDF  ==> List Expression DoubleFloat
  KEDF  ==> Kernel Expression DoubleFloat
  LKEDF ==> List Kernel Expression DoubleFloat
  PDF   ==> Polynomial DoubleFloat
  FPDF  ==> Fraction Polynomial DoubleFloat
  OCDF  ==> OrderedCompletion DoubleFloat
  SOCDF ==> Segment OrderedCompletion DoubleFloat
  NIA   ==> Record(var:Symbol,fn:EDF,range:SOCDF,abserr:DF,relerr:DF)
  UP    ==> UnivariatePolynomial
  BO    ==> BasicOperator
  RS    ==> Record(zeros: SDF,ones: SDF,singularities: SDF)

  E ==> with

    getlo : SOCDF -> DF
      ++ getlo(u) gets the \axiomType{DoubleFloat} equivalent of
      ++ the first endpoint of the range \axiom{u}
    gethi : SOCDF -> DF
      ++ gethi(u) gets the \axiomType{DoubleFloat} equivalent of
      ++ the second endpoint of the range \axiom{u}
    functionIsFracPolynomial?: NIA -> Boolean
      ++ functionIsFracPolynomial?(args) tests whether the function
      ++ can be retracted to \axiomType{Fraction(Polynomial(DoubleFloat))}
    problemPoints:(EDF,Symbol,SOCDF) -> List DF
      ++ problemPoints(f,var,range) returns a list of possible problem points
      ++ by looking at the zeros of the denominator of the function \spad{f}
      ++ if it can be retracted to \axiomType{Polynomial(DoubleFloat)}.
    zerosOf:(EDF,List Symbol,SOCDF) -> SDF
      ++ zerosOf(e,vars,range) returns a list of points  
      ++ (\axiomType{Doublefloat}) at which a NAG fortran version of \spad{e}
      ++ will most likely produce an error.
    singularitiesOf: (EDF,List Symbol,SOCDF) -> SDF
      ++ singularitiesOf(e,vars,range) returns a list of points 
      ++ (\axiomType{Doublefloat}) at which a NAG fortran 
      ++ version of \spad{e} will most likely produce
      ++ an error.  This includes those points which evaluate to 0/0.
    singularitiesOf: (Vector EDF,List Symbol,SOCDF) -> SDF
      ++ singularitiesOf(v,vars,range) returns a list of points 
      ++ (\axiomType{Doublefloat}) at which a NAG fortran 
      ++ version of \spad{v} will most likely produce
      ++ an error.  This includes those points which evaluate to 0/0.
    polynomialZeros:(PFI,Symbol,SOCDF) -> LDF
      ++ polynomialZeros(fn,var,range) calculates the real zeros of the 
      ++ polynomial which are contained in the given interval. It returns 
      ++ a list of points (\axiomType{Doublefloat}) for which the univariate 
      ++ polynomial \spad{fn} is zero.
    df2st:DF -> String 
      ++ df2st(n) coerces a \axiomType{DoubleFloat} to \axiomType{String}
    ldf2lst:LDF -> List String
      ++ ldf2lst(ln) coerces a List of \axiomType{DoubleFloat} to 
      ++ \axiomType{List}(\axiomType{String})
    sdf2lst:SDF -> List String
      ++ sdf2lst(ln) coerces a Stream of \axiomType{DoubleFloat} to 
      ++ \axiomType{List}(\axiomType{String})

  I ==> ExpertSystemToolsPackage add

    import ExpertSystemToolsPackage

    functionIsPolynomial?(args:NIA):Boolean ==
      -- tests whether the function can be retracted to a polynomial
      (retractIfCan(args.fn)@Union(PDF,"failed"))$EDF case PDF

    isPolynomial?(f:EDF):Boolean ==
      -- tests whether the function can be retracted to a polynomial
      (retractIfCan(f)@Union(PDF,"failed"))$EDF case PDF

    isConstant?(f:EDF):Boolean ==
      -- tests whether the function can be retracted to a constant (DoubleFloat)
      (retractIfCan(f)@Union(DF,"failed"))$EDF case DF

    denominatorIsPolynomial?(args:NIA):Boolean ==
      -- tests if the denominator can be retracted to polynomial
      a:= copy args
      a.fn:=denominator(args.fn)
      (functionIsPolynomial?(a))@Boolean

    denIsPolynomial?(f:EDF):Boolean ==
      -- tests if the denominator can be retracted to polynomial
      (isPolynomial?(denominator f))@Boolean

    listInRange(l:LDF,range:SOCDF):LDF ==
      -- returns a list with only those elements internal to the range range
      [t for t in l | in?(t,range)]

    loseUntil(l:SDF,a:DF):SDF ==
      empty?(l)$SDF => l
      f := first(l)$SDF
      (abs(f) <= abs(a)) => loseUntil(rest(l)$SDF,a)
      l

    retainUntil(l:SDF,a:DF,b:DF,flag:Boolean):SDF ==
      empty?(l)$SDF => l
      f := first(l)$SDF
      (in?(f)$ExpertSystemContinuityPackage1(a,b)) =>
        concat(f,retainUntil(rest(l),a,b,false)) 
      flag => empty()$SDF
      retainUntil(rest(l),a,b,true)

    streamInRange(l:SDF,range:SOCDF):SDF ==
      -- returns a stream with only those elements internal to the range range
      a := getlo(range := dfRange(range))
      b := gethi(range)
      explicitlyFinite?(l) =>
        select(in?$ExpertSystemContinuityPackage1(a,b),l)$SDF
      negative?(a*b) => retainUntil(l,a,b,false)                
      negative?(a) => 
        l := loseUntil(l,b)
        retainUntil(l,a,b,false)
      l := loseUntil(l,a)
      retainUntil(l,a,b,false)

    getStream(n:Symbol,s:String):SDF ==
      import RS
      entry?(n,bfKeys()$BasicFunctions)$(List(Symbol)) =>
        c := bfEntry(n)$BasicFunctions
        (s = "zeros")@Boolean => c.zeros
        (s = "singularities")@Boolean => c.singularities
        (s = "ones")@Boolean => c.ones
      empty()$SDF

    polynomialZeros(fn:PFI,var:Symbol,range:SOCDF):LDF ==
      up := unmakeSUP(univariate(fn)$PFI)$UP(var,FI)
      range := dfRange(range)
      r:Record(left:FI,right:FI) := [df2fi(getlo(range)), df2fi(gethi(range))]
      ans:List(Record(left:FI,right:FI)) := 
          realZeros(up,r,1/1000000000000000000)$RealZeroPackageQ(UP(var,FI))
      listInRange(dflist(ans),range)

    functionIsFracPolynomial?(args:NIA):Boolean ==
      -- tests whether the function can be retracted to a fraction
      -- where both numerator and denominator are polynomial
      (retractIfCan(args.fn)@Union(FPDF,"failed"))$EDF case FPDF

    problemPoints(f:EDF,var:Symbol,range:SOCDF):LDF ==
      (denIsPolynomial?(f))@Boolean =>
        c := retract(edf2efi(denominator(f)))@PFI
        polynomialZeros(c,var,range)
      empty()$LDF

    zerosOf(e:EDF,vars:List Symbol,range:SOCDF):SDF ==
      (u := isQuotient(e)) case EDF =>
        singularitiesOf(u,vars,range)
      k := kernels(e)$EDF
      ((nk := # k) = 0)@Boolean => empty()$SDF -- constant found.
      (nk = 1)@Boolean =>                      -- single expression found.
        ker := first(k)$LKEDF
        n := name(operator(ker)$KEDF)$BO
        entry?(n,vars) =>                   -- polynomial found.
          c := retract(edf2efi(e))@PFI
          coerce(polynomialZeros(c,n,range))$SDF
        a := first(argument(ker)$KEDF)$LEDF
        (not (n = log :: Symbol)@Boolean) and ((w := isPlus a) case LEDF) =>
          var:Symbol := first(variables(a))
          c:EDF := w.2
          c1:EDF := w.1
--          entry?(c1,[b::EDF for b in vars]) and (one?(# vars)) =>
          entry?(c1,[b::EDF for b in vars]) and ((# vars) = 1) =>
            c2:DF := edf2df c
            c3 := c2 :: OCDF
            varEdf := var :: EDF
            varEqn := equation(varEdf,c1-c)$EEDF
            range2 := (lo(range)+c3)..(hi(range)+c3)
            s := zerosOf(subst(e,varEqn)$EDF,vars,range2)
            st := map(#1-c2,s)$StreamFunctions2(DF,DF)
            streamInRange(st,range)
          zerosOf(a,vars,range)
        (t := isPlus(e)$EDF) case LEDF =>    -- constant + expression
          # t > 2 => empty()$SDF
          entry?(a,[b::EDF for b in vars]) =>   -- finds entries like sqrt(x)
            st := getStream(n,"ones")
            o := edf2df(second(t)$LEDF)
--            one?(o) or one?(-o) =>           -- is it like (f(x) -/+ 1)
            (o = 1) or (-o = 1) =>           -- is it like (f(x) -/+ 1)
              st := map(-#1/o,st)$StreamFunctions2(DF,DF)
              streamInRange(st,range)
            empty()$SDF
          empty()$SDF
        entry?(a,[b::EDF for b in vars]) =>     -- finds entries like sqrt(x)
          st := getStream(n,"zeros")
          streamInRange(st,range)
        (n = tan :: Symbol)@Boolean => 
          concat([zerosOf(a,vars,range),singularitiesOf(a,vars,range)])
        (n = sin :: Symbol)@Boolean => 
          concat([zerosOf(a,vars,range),singularitiesOf(a,vars,range)])
        empty()$SDF
      (t := isPlus(e)$EDF) case LEDF => empty()$SDF  -- INCOMPLETE!!!
      (v := isTimes(e)$EDF) case LEDF =>
        concat([zerosOf(u,vars,range) for u in v])
      empty()$SDF

    singularitiesOf(e:EDF,vars:List Symbol,range:SOCDF):SDF ==
      (u := isQuotient(e)) case EDF =>
        zerosOf(u,vars,range)
      (t := isPlus e) case LEDF =>
        concat([singularitiesOf(u,vars,range) for u in t])
      (v := isTimes e) case LEDF =>
        concat([singularitiesOf(u,vars,range) for u in v])
      (k := mainKernel e) case KEDF => 
        n := name(operator k)
        entry?(n,vars) => coerce(problemPoints(e,n,range))$SDF
        a:EDF := (argument k).1
        (not (n = log :: Symbol)@Boolean) and ((w := isPlus a) case LEDF) =>
          var:Symbol := first(variables(a))
          c:EDF := w.2
          c1:EDF := w.1
--          entry?(c1,[b::EDF for b in vars]) and (one?(# vars)) =>
          entry?(c1,[b::EDF for b in vars]) and ((# vars) = 1) =>
            c2:DF := edf2df c
            c3 := c2 :: OCDF
            varEdf := var :: EDF
            varEqn := equation(varEdf,c1-c)$EEDF
            range2 := (lo(range)+c3)..(hi(range)+c3)
            s := singularitiesOf(subst(e,varEqn)$EDF,vars,range2)
            st := map(#1-c2,s)$StreamFunctions2(DF,DF)
            streamInRange(st,range)
          singularitiesOf(a,vars,range)
        entry?(a,[b::EDF for b in vars]) =>
          st := getStream(n,"singularities")
          streamInRange(st,range)
        (n = log :: Symbol)@Boolean =>
          concat([zerosOf(a,vars,range),singularitiesOf(a,vars,range)])
        singularitiesOf(a,vars,range)
      empty()$SDF

    singularitiesOf(v:VEDF,vars:List Symbol,range:SOCDF):SDF ==
      ls := [singularitiesOf(u,vars,range) for u in entries(v)$VEDF]
      concat(ls)$SDF

@
\section{package ESCONT1 ExpertSystemContinuityPackage1}
<<package ESCONT1 ExpertSystemContinuityPackage1>>=
)abbrev package ESCONT1 ExpertSystemContinuityPackage1
++ Author: Brian Dupee
++ Date Created: May 1994
++ Date Last Updated: June 1995
++ Basic Operations: problemPoints, singularitiesOf, zerosOf
++ Related Constructors:
++ Description:
++ ExpertSystemContinuityPackage1 exports a function to check range inclusion

ExpertSystemContinuityPackage1(A:DF,B:DF): E == I where
  EF2   ==> ExpressionFunctions2
  FI    ==> Fraction Integer
  EFI   ==> Expression Fraction Integer
  PFI   ==> Polynomial Fraction Integer
  DF    ==> DoubleFloat
  LDF   ==> List DoubleFloat
  EDF   ==> Expression DoubleFloat
  VEDF  ==> Vector Expression DoubleFloat
  SDF   ==> Stream DoubleFloat
  SS    ==> Stream String
  EEDF  ==> Equation Expression DoubleFloat
  LEDF  ==> List Expression DoubleFloat
  KEDF  ==> Kernel Expression DoubleFloat
  LKEDF ==> List Kernel Expression DoubleFloat
  PDF   ==> Polynomial DoubleFloat
  FPDF  ==> Fraction Polynomial DoubleFloat
  OCDF  ==> OrderedCompletion DoubleFloat
  SOCDF ==> Segment OrderedCompletion DoubleFloat
  NIA   ==> Record(var:Symbol,fn:EDF,range:SOCDF,abserr:DF,relerr:DF)
  UP    ==> UnivariatePolynomial
  BO    ==> BasicOperator
  RS    ==> Record(zeros: SDF,ones: SDF,singularities: SDF)

  E ==> with

    in?:DF -> Boolean
      ++ in?(p) tests whether point p is internal to the range [\spad{A..B}]

  I ==> add 

    in?(p:DF):Boolean ==
      a:Boolean := (p < B)$DF
      b:Boolean := (A < p)$DF
      (a and b)@Boolean

@
\section{License}
<<license>>=
--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.
@
<<*>>=
<<license>>

<<package ESCONT ExpertSystemContinuityPackage>>
<<package ESCONT1 ExpertSystemContinuityPackage1>>
@
\eject
\begin{thebibliography}{99}
\bibitem{1} nothing
\end{thebibliography}
\end{document}