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

\documentclass{article}
\usepackage{open-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
      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}