Initial population.

1 files changed, 430 insertions, 0 deletions

diff --git a/src/algebra/d01agents.spad.pamphlet b/src/algebra/d01agents.spad.pamphlet
new file mode 100644
index 00000000..60aec7a2
--- /dev/null
+++ b/src/algebra/d01agents.spad.pamphlet
@@ -0,0 +1,430 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/algebra d01agents.spad}
+\author{Brian Dupee}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{domain INTFTBL IntegrationFunctionsTable}
+<<domain INTFTBL IntegrationFunctionsTable>>=
+)abbrev domain INTFTBL IntegrationFunctionsTable
+++ Author: Brian Dupee
+++ Date Created: March 1995
+++ Date Last Updated: June 1995
+++ Description:
+++
+IntegrationFunctionsTable(): E == I where
+  EF2	==> ExpressionFunctions2
+  EFI	==> Expression Fraction Integer
+  FI	==> Fraction Integer
+  LEDF	==> List Expression DoubleFloat
+  KEDF	==> Kernel Expression DoubleFloat
+  EEDF	==> Equation Expression DoubleFloat
+  EDF	==> Expression DoubleFloat
+  PDF	==> Polynomial DoubleFloat
+  LDF	==> List DoubleFloat
+  SDF	==> Stream DoubleFloat
+  DF	==> DoubleFloat
+  F	==> Float
+  ST	==> String
+  LST	==> List String
+  SI	==> SingleInteger
+  SOCDF	==> Segment OrderedCompletion DoubleFloat
+  OCDF	==> OrderedCompletion DoubleFloat
+  OCEDF	==> OrderedCompletion Expression DoubleFloat
+  EOCEFI  ==> Equation OrderedCompletion Expression Fraction Integer
+  OCEFI   ==> OrderedCompletion Expression Fraction Integer
+  OCFI    ==> OrderedCompletion Fraction Integer
+  NIA	==> Record(var:Symbol,fn:EDF,range:SOCDF,abserr:DF,relerr:DF)
+  INT	==> Integer
+  CTYPE	==> Union(continuous: "Continuous at the end points",
+             lowerSingular: "There is a singularity at the lower end point",
+              upperSingular: "There is a singularity at the upper end point",
+               bothSingular: "There are singularities at both end points",
+                notEvaluated: "End point continuity not yet evaluated")
+  RTYPE	==> Union(finite: "The range is finite",
+              lowerInfinite: "The bottom of range is infinite",
+                upperInfinite: "The top of range is infinite",
+                  bothInfinite: "Both top and bottom points are infinite",
+                    notEvaluated: "Range not yet evaluated")
+  STYPE	==> Union(str:SDF,
+                   notEvaluated:"Internal singularities not yet evaluated")
+  ATT	==> Record(endPointContinuity:CTYPE,
+                    singularitiesStream:STYPE,range:RTYPE)
+  ROA	==> Record(key:NIA,entry:ATT)
+
+  E ==> with
+
+    showTheFTable:() -> $
+      ++ showTheFTable() returns the current table of functions.
+    clearTheFTable : () -> Void
+      ++ clearTheFTable() clears the current table of functions.
+    keys : $ -> List(NIA)
+      ++ keys(f) returns the list of keys of f
+    fTable: List Record(key:NIA,entry:ATT) -> $
+      ++ fTable(l) creates a functions table from the elements of l.
+    insert!:Record(key:NIA,entry:ATT) -> $
+      ++ insert!(r) inserts an entry r into theIFTable
+    showAttributes:NIA -> Union(ATT,"failed")
+      ++ showAttributes(x) \undocumented{}
+    entries : $ -> List Record(key:NIA,entry:ATT)
+      ++ entries(x) \undocumented{}
+    entry:NIA -> ATT
+      ++ entry(n) \undocumented{}
+  I ==> add
+
+    Rep := Table(NIA,ATT)
+    import Rep
+
+    theFTable:$ := empty()$Rep
+
+    showTheFTable():$ ==
+      theFTable
+
+    clearTheFTable():Void ==
+      theFTable := empty()$Rep
+      void()$Void
+
+    fTable(l:List Record(key:NIA,entry:ATT)):$ ==
+      theFTable := table(l)$Rep
+
+    insert!(r:Record(key:NIA,entry:ATT)):$ ==
+      insert!(r,theFTable)$Rep
+
+    keys(t:$):List NIA ==
+      keys(t)$Rep
+
+    showAttributes(k:NIA):Union(ATT,"failed") ==
+      search(k,theFTable)$Rep
+
+    entries(t:$):List Record(key:NIA,entry:ATT) ==
+      members(t)$Rep
+
+    entry(k:NIA):ATT ==
+      qelt(theFTable,k)$Rep
+
+@
+\section{package D01AGNT d01AgentsPackage}
+<<package D01AGNT d01AgentsPackage>>=
+)abbrev package D01AGNT d01AgentsPackage
+++ Author: Brian Dupee
+++ Date Created: March 1994
+++ Date Last Updated: December 1997
+++ Basic Operations: rangeIsFinite, functionIsContinuousAtEndPoints,
+++ functionIsOscillatory
+++ Description:
+++ \axiomType{d01AgentsPackage} is a package of numerical agents to be used
+++ to investigate attributes of an input function so as to decide the
+++ \axiomFun{measure} of an appropriate numerical integration routine.
+++ It contains functions \axiomFun{rangeIsFinite} to test the input range and
+++ \axiomFun{functionIsContinuousAtEndPoints} to check for continuity at 
+++ the end points of the range.
+
+
+d01AgentsPackage(): E == I where
+  EF2	==> ExpressionFunctions2
+  EFI	==> Expression Fraction Integer
+  FI	==> Fraction Integer
+  LEDF	==> List Expression DoubleFloat
+  KEDF	==> Kernel Expression DoubleFloat
+  EEDF	==> Equation Expression DoubleFloat
+  EDF	==> Expression DoubleFloat
+  PDF	==> Polynomial DoubleFloat
+  LDF	==> List DoubleFloat
+  SDF	==> Stream DoubleFloat
+  DF	==> DoubleFloat
+  F	==> Float
+  ST	==> String
+  LST	==> List String
+  SI	==> SingleInteger
+  SOCDF	==> Segment OrderedCompletion DoubleFloat
+  OCDF	==> OrderedCompletion DoubleFloat
+  OCEDF	==> OrderedCompletion Expression DoubleFloat
+  EOCEFI  ==> Equation OrderedCompletion Expression Fraction Integer
+  OCEFI   ==> OrderedCompletion Expression Fraction Integer
+  OCFI    ==> OrderedCompletion Fraction Integer
+  NIA	==> Record(var:Symbol,fn:EDF,range:SOCDF,abserr:DF,relerr:DF)
+  INT	==> Integer
+  CTYPE	==> Union(continuous: "Continuous at the end points",
+             lowerSingular: "There is a singularity at the lower end point",
+              upperSingular: "There is a singularity at the upper end point",
+               bothSingular: "There are singularities at both end points",
+                notEvaluated: "End point continuity not yet evaluated")
+  RTYPE	==> Union(finite: "The range is finite",
+              lowerInfinite: "The bottom of range is infinite",
+                upperInfinite: "The top of range is infinite",
+                  bothInfinite: "Both top and bottom points are infinite",
+                    notEvaluated: "Range not yet evaluated")
+  STYPE	==> Union(str:SDF,
+                   notEvaluated:"Internal singularities not yet evaluated")
+  ATT	==> Record(endPointContinuity:CTYPE,
+                    singularitiesStream:STYPE,range:RTYPE)
+  ROA	==> Record(key:NIA,entry:ATT)
+
+  E ==> with
+    
+    rangeIsFinite : NIA -> RTYPE
+      ++ rangeIsFinite(args) tests the endpoints of \spad{args.range} for 
+      ++ infinite end points. 
+    functionIsContinuousAtEndPoints: NIA -> CTYPE
+      ++ functionIsContinuousAtEndPoints(args) uses power series limits
+      ++ to check for problems at the end points of the range of \spad{args}.
+    getlo : SOCDF -> DF
+      ++ getlo(x) gets the \axiomType{DoubleFloat} equivalent of
+      ++ the first endpoint of the range \axiom{x}
+    gethi : SOCDF -> DF
+      ++ gethi(x) gets the \axiomType{DoubleFloat} equivalent of
+      ++ the second endpoint of the range \axiom{x}
+    functionIsOscillatory:NIA -> F
+      ++ functionIsOscillatory(a) tests whether the function \spad{a.fn}
+      ++ has many zeros of its derivative.
+    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 if it
+      ++ can be retracted to \axiomType{Polynomial DoubleFloat}.
+    singularitiesOf:NIA -> SDF
+      ++ singularitiesOf(args) returns a list of potential 
+      ++ singularities of the function within the given range
+    df2st:DF -> String 
+      ++ df2st(n) coerces a \axiomType{DoubleFloat} to \axiomType{String}
+    ldf2lst:LDF -> LST
+      ++ ldf2lst(ln) coerces a List of \axiomType{DoubleFloat} to \axiomType{List String}
+    sdf2lst:SDF -> LST
+      ++ sdf2lst(ln) coerces a Stream of \axiomType{DoubleFloat} to \axiomType{List String}
+    commaSeparate:LST -> ST
+      ++ commaSeparate(l) produces a comma separated string from a 
+      ++ list of strings.
+    changeName:(Symbol,Symbol,Result) -> Result
+      ++ changeName(s,t,r) changes the name of item \axiom{s} in \axiom{r}
+      ++ to \axiom{t}.
+
+  I ==> ExpertSystemContinuityPackage add
+
+    import ExpertSystemToolsPackage
+    import ExpertSystemContinuityPackage
+
+    -- local functions
+    ocdf2ocefi : OCDF -> OCEFI
+    rangeOfArgument : (KEDF, NIA) -> DF
+    continuousAtPoint? : (EFI,EOCEFI) -> Boolean
+    rand:(SOCDF,INT) -> LDF 
+    eval:(EDF,Symbol,LDF) -> LDF
+    numberOfSignChanges:LDF -> INT
+    rangeIsFiniteFunction:NIA -> RTYPE
+    functionIsContinuousAtEndPointsFunction:NIA -> CTYPE
+ 
+    changeName(s:Symbol,t:Symbol,r:Result):Result ==
+      a := remove!(s,r)$Result
+      a case Any =>
+        insert!([t,a],r)$Result
+        r
+      r
+
+    commaSeparate(l:LST):ST ==
+      empty?(l)$LST => ""
+--      one?(#(l)) => concat(l)$ST
+      (#(l) = 1) => concat(l)$ST
+      f := first(l)$LST
+      t := [concat([", ",l.i])$ST for i in 2..#(l)]
+      concat(f,concat(t)$ST)$ST
+
+    rand(seg:SOCDF,n:INT):LDF ==
+      -- produced a sorted list of random numbers in the given range
+      l:DF := getlo seg
+      s:DF := (gethi seg) - l
+      seed:INT := random()$INT
+      dseed:DF := seed :: DF
+      r:LDF := [(((random(seed)$INT) :: DF)*s/dseed + l) for i in 1..n]
+      sort(r)$LDF
+
+    eval(f:EDF,var:Symbol,l:LDF):LDF ==
+      empty?(l)$LDF => [0$DF]
+      ve := var::EDF
+      [retract(eval(f,equation(ve,u::EDF)$EEDF)$EDF)@DF for u in l]
+
+    numberOfSignChanges(l:LDF):INT ==
+      -- calculates the number of sign changes in a list
+      a := 0$INT
+      empty?(l)$LDF => 0
+      for i in 2..# l repeat
+        if negative?(l.i*l.(i-1))  then
+          a := a + 1
+      a
+
+    rangeOfArgument(k: KEDF, args:NIA): DF ==
+      Args := copy args
+      Args.fn := arg := first(argument(k)$KEDF)$LEDF
+      functionIsContinuousAtEndPoints(Args) case continuous =>
+        r:SOCDF := args.range
+        low:EDF := (getlo r) :: EDF
+        high:EDF := (gethi r) :: EDF
+        eql := equation(a := args.var :: EDF, low)$EEDF
+        eqh := equation(a, high)$EEDF
+        e1 := (numeric(eval(arg,eql)$EDF)$Numeric(DF)) :: DF
+        e2 := (numeric(eval(arg,eqh)$EDF)$Numeric(DF)) :: DF
+        e2-e1
+      0$DF
+
+    ocdf2ocefi(r:OCDF):OCEFI ==
+      finite?(r)$OCDF => (edf2efi(((retract(r)@DF)$OCDF)::EDF))::OCEFI
+      r pretend OCEFI
+
+    continuousAtPoint?(f:EFI,e:EOCEFI):Boolean ==
+      (l := limit(f,e)$PowerSeriesLimitPackage(FI,EFI)) case OCEFI =>
+                       finite?(l :: OCEFI)
+      -- if the left hand limit equals the right hand limit, or if neither
+      -- side has a limit at this point, the return type of  limit() is
+      -- Union(Ordered Completion Expression Fraction Integer,"failed")
+      false
+
+    -- exported functions
+    
+    rangeIsFiniteFunction(args:NIA): RTYPE ==
+      -- rangeIsFinite(x) tests the endpoints of x.range for infinite
+      -- end points. 
+      --             [-inf,  inf]  =>  4
+      --             [ x  ,  inf]  =>  3
+      --             [-inf,  x  ]  =>  1
+      --             [ x  ,  y  ]  =>  0
+      fr:SI := (3::SI * whatInfinity(hi(args.range))$OCDF 
+                      - whatInfinity(lo(args.range))$OCDF)
+      fr = 0 => ["The range is finite"]
+      fr = 1 => ["The bottom of range is infinite"]
+      fr = 3 => ["The top of range is infinite"]
+      fr = 4 => ["Both top and bottom points are infinite"]
+      error("rangeIsFinite",["this is not a valid range"])$ErrorFunctions
+
+    rangeIsFinite(args:NIA): RTYPE ==
+      nia := copy args
+      (t := showAttributes(nia)$IntegrationFunctionsTable) case ATT =>
+        s := coerce(t)@ATT
+        s.range case notEvaluated => 
+          s.range := rangeIsFiniteFunction(nia)
+          r:ROA := [nia,s]
+          insert!(r)$IntegrationFunctionsTable
+          s.range
+        s.range
+      a:ATT := [["End point continuity not yet evaluated"],
+                  ["Internal singularities not yet evaluated"],
+                      e:=rangeIsFiniteFunction(nia)]
+      r:ROA := [nia,a]
+      insert!(r)$IntegrationFunctionsTable
+      e
+
+    functionIsContinuousAtEndPointsFunction(args:NIA):CTYPE ==
+
+      v := args.var :: EFI :: OCEFI
+      high:OCEFI := ocdf2ocefi(hi(args.range))
+      low:OCEFI := ocdf2ocefi(lo(args.range))
+      f := edf2efi(args.fn)
+      l:Boolean := continuousAtPoint?(f,equation(v,low)$EOCEFI)
+      h:Boolean := continuousAtPoint?(f,equation(v,high)$EOCEFI)
+      l and h => ["Continuous at the end points"]
+      l => ["There is a singularity at the upper end point"]
+      h => ["There is a singularity at the lower end point"]
+      ["There are singularities at both end points"]
+
+    functionIsContinuousAtEndPoints(args:NIA): CTYPE ==
+      nia := copy args
+      (t := showAttributes(nia)$IntegrationFunctionsTable) case ATT =>
+        s := coerce(t)@ATT
+        s.endPointContinuity case notEvaluated => 
+          s.endPointContinuity := functionIsContinuousAtEndPointsFunction(nia)
+          r:ROA := [nia,s]
+          insert!(r)$IntegrationFunctionsTable
+          s.endPointContinuity
+        s.endPointContinuity
+      a:ATT := [e:=functionIsContinuousAtEndPointsFunction(nia),
+                 ["Internal singularities not yet evaluated"],
+                   ["Range not yet evaluated"]]
+      r:ROA := [nia,a]
+      insert!(r)$IntegrationFunctionsTable
+      e
+
+    functionIsOscillatory(a:NIA):F ==
+
+      args := copy a
+      k := tower(numerator args.fn)$EDF
+      p:F := pi()$F
+      for i in 1..# k repeat
+        is?(ker := k.i, sin :: Symbol) => 
+          ra := convert(rangeOfArgument(ker,args))@F
+          ra > 2*p => return (ra/p)
+        is?(ker, cos :: Symbol) => 
+          ra := convert(rangeOfArgument(ker,args))@F
+          ra > 2*p => return (ra/p)
+      l:LDF := rand(args.range,30)
+      l := eval(args.fn,args.var,l)
+      numberOfSignChanges(l) :: F   
+
+    singularitiesOf(args:NIA):SDF ==
+      nia := copy args
+      (t := showAttributes(nia)$IntegrationFunctionsTable) case ATT =>
+        s:ATT := coerce(t)@ATT
+        p:STYPE := s.singularitiesStream
+        p case str => p.str
+        e:SDF := singularitiesOf(nia.fn,[nia.var],nia.range)
+        if not empty?(e) then
+          if less?(e,10)$SDF then extend(e,10)$SDF
+        s.singularitiesStream := [e]
+        r:ROA := [nia,s]
+        insert!(r)$IntegrationFunctionsTable
+        e
+      e:=singularitiesOf(nia.fn,[nia.var],nia.range)
+      if not empty?(e) then
+        if less?(e,10)$SDF then extend(e,10)$SDF
+      a:ATT := [["End point continuity not yet evaluated"],[e],
+                          ["Range not yet evaluated"]]
+      r:ROA := [nia,a]
+      insert!(r)$IntegrationFunctionsTable
+      e
+
+@
+\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>>
+
+<<domain INTFTBL IntegrationFunctionsTable>>
+<<package D01AGNT d01AgentsPackage>>
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}