Initial population.

1 files changed, 357 insertions, 0 deletions

diff --git a/src/algebra/cont.spad.pamphlet b/src/algebra/cont.spad.pamphlet
new file mode 100644
index 00000000..5183d276
--- /dev/null
+++ b/src/algebra/cont.spad.pamphlet
@@ -0,0 +1,357 @@
+\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}