Initial population.

1 files changed, 470 insertions, 0 deletions

diff --git a/src/algebra/tools.spad.pamphlet b/src/algebra/tools.spad.pamphlet
new file mode 100644
index 00000000..fb0ed1fe
--- /dev/null
+++ b/src/algebra/tools.spad.pamphlet
@@ -0,0 +1,470 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/algebra tools.spad}
+\author{Brian Dupee}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{package ESTOOLS ExpertSystemToolsPackage}
+<<package ESTOOLS ExpertSystemToolsPackage>>=
+)abbrev package ESTOOLS ExpertSystemToolsPackage
+++ Author: Brian Dupee
+++ Date Created: May 1994
+++ Date Last Updated: July 1996
+++ Basic Operations:
+++ Description:
+++ \axiom{ExpertSystemToolsPackage} contains some useful functions for use
+++ by the computational agents of numerical solvers.
+ExpertSystemToolsPackage():E == I where
+  LEDF	==> List Expression DoubleFloat
+  KEDF	==> Kernel Expression DoubleFloat
+  LKEDF	==> List Kernel Expression DoubleFloat
+  VEDF	==> Vector Expression DoubleFloat
+  VEF	==> Vector Expression Float
+  VMF	==> Vector MachineFloat
+  EF2	==> ExpressionFunctions2
+  EFI	==> Expression Fraction Integer
+  MDF	==> Matrix DoubleFloat
+  LDF	==> List DoubleFloat
+  PDF	==> Polynomial DoubleFloat
+  EDF	==> Expression DoubleFloat
+  EF	==> Expression Float
+  SDF	==> Stream DoubleFloat
+  DF	==> DoubleFloat
+  F	==> Float
+  MF	==> MachineFloat
+  INT	==> Integer
+  NNI	==> NonNegativeInteger
+  LS	==> List Symbol
+  ST	==> String
+  LST	==> List String
+  SS	==> Stream String
+  FI	==> Fraction Integer
+  R	==> Ring
+  OR	==> OrderedRing
+  ON	==> Record(additions:INT,multiplications:INT,exponentiations:INT,functionCalls:INT)
+  RVE 	==> Record(val:EDF,exponent:INT)
+  BO	==> BasicOperator
+  OCF	==> OrderedCompletion Float
+  OCDF	==> OrderedCompletion DoubleFloat
+  SOCF	==> Segment OrderedCompletion Float
+  SOCDF	==> Segment OrderedCompletion DoubleFloat
+  Measure	==> Record(measure:F, name:String, explanations:List String)
+  Measure2	==> Record(measure:F, name:String, explanations:List String, extra:Result)
+  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)
+  IFV	==> Record(stiffness:F,stability:F,expense:F,accuracy:F,intermediateResults:F)
+
+  E ==> with
+
+    f2df:F -> DF
+      ++ f2df(f) is a function to convert a \axiomType{Float} to a
+      ++ \axiomType{DoubleFloat}
+    ef2edf:EF -> EDF
+      ++ ef2edf(f) is a function to convert an \axiomType{Expression Float} 
+      ++ to an \axiomType{Expression DoubleFloat}
+    ocf2ocdf: OCF -> OCDF
+      ++ ocf2ocdf(a) is a function to convert an \axiomType{OrderedCompletion 
+      ++ Float} to an \axiomType{OrderedCompletion DoubleFloat}
+    socf2socdf: SOCF -> SOCDF
+      ++ socf2socdf(a) is a function to convert a \axiomType{Segment OrderedCompletion Float}
+      ++ to a \axiomType{Segment OrderedCompletion DoubleFloat}
+    convert: List SOCF -> List SOCDF
+      ++ convert(l) is a function to convert a \axiomType{Segment OrderedCompletion Float}
+      ++ to a \axiomType{Segment OrderedCompletion DoubleFloat}
+    df2fi :DF -> FI
+      ++ df2fi(n) is a function to convert a \axiomType{DoubleFloat} to a
+      ++ \axiomType{Fraction Integer}
+    edf2fi :EDF -> FI
+      ++ edf2fi(n) maps \axiomType{Expression DoubleFloat} to 
+      ++ \axiomType{Fraction Integer}
+      ++ It is an error if n is not coercible to Fraction Integer
+    edf2df :EDF -> DF
+      ++ edf2df(n) maps \axiomType{Expression DoubleFloat} to 
+      ++ \axiomType{DoubleFloat}
+      ++ It is an error if \spad{n} is not coercible to DoubleFloat
+    isQuotient:EDF -> Union(EDF,"failed")
+      ++ isQuotient(expr) returns the quotient part of the input
+      ++ expression or \spad{"failed"} if the expression is not of that form.
+    expenseOfEvaluation:VEDF -> F
+      ++ expenseOfEvaluation(o) gives an approximation of the cost of
+      ++ evaluating a list of expressions in terms of the number of basic
+      ++ operations.
+      ++ < 0.3 inexpensive ; 0.5 neutral ; > 0.7 very expensive
+      ++ 400 `operation units' -> 0.75 
+      ++ 200 `operation units' -> 0.5 
+      ++ 83 `operation units' -> 0.25
+      ++ ** = 4 units , function calls = 10 units.
+    numberOfOperations:VEDF -> ON
+      ++ numberOfOperations(ode) counts additions, multiplications, 
+      ++ exponentiations and function calls in the input set of expressions.
+    edf2efi:EDF -> EFI
+      ++ edf2efi(e) coerces \axiomType{Expression DoubleFloat} into 
+      ++ \axiomType{Expression Fraction Integer}
+    dfRange:SOCDF -> SOCDF
+      ++ dfRange(r) converts a range including 
+      ++ \inputbitmap{\htbmdir{}/plusminus.bitmap} \infty 
+      ++ to \axiomType{DoubleFloat} equavalents.
+    dflist:List(Record(left:FI,right:FI)) -> LDF
+      ++ dflist(l) returns a list of \axiomType{DoubleFloat} equivalents of list l
+    df2mf:DF -> MF
+      ++ df2mf(n) coerces a \axiomType{DoubleFloat} to \axiomType{MachineFloat}
+    ldf2vmf:LDF -> VMF
+      ++ ldf2vmf(l) coerces a \axiomType{List DoubleFloat} to
+      ++ \axiomType{List MachineFloat}
+    edf2ef:EDF -> EF
+      ++ edf2ef(e) maps \axiomType{Expression DoubleFloat} to 
+      ++ \axiomType{Expression Float}
+    vedf2vef:VEDF -> VEF
+      ++ vedf2vef(v) maps \axiomType{Vector Expression DoubleFloat} to 
+      ++ \axiomType{Vector Expression Float}
+    in?:(DF,SOCDF) -> Boolean
+      ++ in?(p,range) tests whether point p is internal to the 
+      ++ range range
+    df2st:DF -> ST
+      ++ df2st(n) coerces a \axiomType{DoubleFloat} to \axiomType{String}
+    f2st:F -> ST
+      ++ f2st(n) coerces a \axiomType{Float} to \axiomType{String}
+    ldf2lst:LDF -> LST
+      ++ ldf2lst(ln) coerces a \axiomType{List DoubleFloat} to \axiomType{List String}
+    sdf2lst:SDF -> LST
+      ++ sdf2lst(ln) coerces a \axiomType{Stream DoubleFloat} to \axiomType{String}
+    getlo : SOCDF -> DF
+      ++ getlo(u) gets the \axiomType{DoubleFloat} equivalent of
+      ++ the first endpoint of the range \spad{u}
+    gethi : SOCDF -> DF
+      ++ gethi(u) gets the \axiomType{DoubleFloat} equivalent of
+      ++ the second endpoint of the range \spad{u}
+    concat:(Result,Result) -> Result
+      ++ concat(a,b) adds two aggregates of type \axiomType{Result}.
+    concat:(List Result) -> Result
+      ++ concat(l) concatenates a list of aggregates of type \axiomType{Result}
+    outputMeasure:F -> ST
+      ++ outputMeasure(n) rounds \spad{n} to 3 decimal places and outputs
+      ++ it as a string
+    measure2Result:Measure -> Result
+      ++ measure2Result(m) converts a measure record into a \axiomType{Result}
+    measure2Result:Measure2 -> Result
+      ++ measure2Result(m) converts a measure record into a \axiomType{Result}
+    att2Result:ATT -> Result
+      ++ att2Result(m) converts a attributes record into a \axiomType{Result}
+    iflist2Result:IFV -> Result
+      ++ iflist2Result(m) converts a attributes record into a \axiomType{Result}
+    pdf2ef:PDF -> EF
+      ++ pdf2ef(p) coerces a \axiomType{Polynomial DoubleFloat} to 
+      ++ \axiomType{Expression Float}
+    pdf2df:PDF -> DF
+      ++ pdf2df(p) coerces a \axiomType{Polynomial DoubleFloat} to 
+      ++ \axiomType{DoubleFloat}. It is an error if \axiom{p} is not
+      ++ retractable to DoubleFloat.
+    df2ef:DF -> EF
+      ++ df2ef(a) coerces a \axiomType{DoubleFloat} to \axiomType{Expression Float}
+    fi2df:FI -> DF
+      ++ fi2df(f) coerces a \axiomType{Fraction Integer} to \axiomType{DoubleFloat}
+    mat:(LDF,NNI) -> MDF
+      ++ mat(a,n) constructs a one-dimensional matrix of a.
+
+  I ==> add
+
+    mat(a:LDF,n:NNI):MDF ==
+      empty?(a)$LDF => zero(1,n)$MDF
+      matrix(list([i for i in a for j in 1..n])$(List LDF))$MDF
+
+    f2df(f:F):DF == (convert(f)@DF)$F
+
+    ef2edf(f:EF):EDF == map(f2df,f)$EF2(F,DF)
+
+    fi2df(f:FI):DF == coerce(f)$DF
+
+    ocf2ocdf(a:OCF):OCDF ==
+      finite? a => (f2df(retract(a)@F))::OCDF
+      a pretend OCDF
+
+    socf2socdf(a:SOCF):SOCDF ==
+      segment(ocf2ocdf(lo a),ocf2ocdf(hi a))
+
+    convert(l:List SOCF):List SOCDF == [socf2socdf a for a in l]
+
+    pdf2df(p:PDF):DF == retract(p)@DF
+
+    df2ef(a:DF):EF ==
+      b := convert(a)@Float
+      coerce(b)$EF
+
+    pdf2ef(p:PDF):EF == df2ef(pdf2df(p))
+
+    edf2fi(m:EDF):FI == retract(retract(m)@DF)@FI
+
+    edf2df(m:EDF):DF == retract(m)@DF
+
+    df2fi(r:DF):FI == (retract(r)@FI)$DF
+
+    dfRange(r:SOCDF):SOCDF ==
+      if infinite?(lo(r))$OCDF then r := -(max()$DF :: OCDF)..hi(r)$SOCDF
+      if infinite?(hi(r))$OCDF then r := lo(r)$SOCDF..(max()$DF :: OCDF)
+      r
+
+    dflist(l:List(Record(left:FI,right:FI))):LDF == [u.left :: DF for u in l]
+
+    edf2efi(f:EDF):EFI == map(df2fi,f)$EF2(DF,FI)
+
+    df2st(n:DF):String == (convert((convert(n)@Float)$DF)@ST)$Float
+
+    f2st(n:F):String == (convert(n)@ST)$Float
+
+    ldf2lst(ln:LDF):LST == [df2st f for f in ln]
+
+    sdf2lst(ln:SDF):LST ==
+      explicitlyFinite? ln => 
+        m := map(df2st,ln)$StreamFunctions2(DF,ST)
+        if index?(20,m)$SS then
+          split!(m,20)
+          m := concat(m,".......")
+        m := complete(m)$SS 
+        entries(m)$SS
+      empty()$LST
+
+    df2mf(n:DF):MF == (df2fi(n))::MF
+
+    ldf2vmf(l:LDF):VMF ==
+      m := [df2mf(n) for n in l]
+      vector(m)$VMF
+
+    edf2ef(e:EDF):EF == map(convert$DF,e)$EF2(DF,Float)
+
+    vedf2vef(vedf:VEDF):VEF == vector([edf2ef e for e in members(vedf)])
+
+    getlo(u:SOCDF):DF == retract(lo(u))@DF
+
+    gethi(u:SOCDF):DF == retract(hi(u))@DF
+  
+    in?(p:DF,range:SOCDF):Boolean ==
+      top := gethi(range)
+      bottom := getlo(range)
+      a:Boolean := (p < top)$DF
+      b:Boolean := (p > bottom)$DF
+      (a and b)@Boolean
+
+    isQuotient(expr:EDF):Union(EDF,"failed") ==
+      (k := mainKernel expr) case KEDF =>
+        (expr = inv(f := k :: KEDF :: EDF)$EDF)$EDF => f
+--        one?(numerator expr) => denominator expr
+        (numerator expr) = 1 => denominator expr
+        "failed"
+      "failed"
+
+    numberOfOperations1(fn:EDF,numbersSoFar:ON):ON ==
+      (u := isQuotient(fn)) case EDF =>
+        numbersSoFar := numberOfOperations1(u,numbersSoFar)
+      (p := isPlus(fn)) case LEDF =>
+        p := coerce(p)@LEDF
+        np := #p
+        numbersSoFar.additions := (numbersSoFar.additions)+np-1
+        for i in 1..np repeat
+          numbersSoFar := numberOfOperations1(p.i,numbersSoFar)
+        numbersSoFar
+      (t:=isTimes(fn)) case LEDF => 
+        t := coerce(t)@LEDF
+        nt := #t
+        numbersSoFar.multiplications := (numbersSoFar.multiplications)+nt-1
+        for i in 1..nt repeat
+          numbersSoFar := numberOfOperations1(t.i,numbersSoFar)
+        numbersSoFar
+      if (e:=isPower(fn)) case RVE then
+        e := coerce(e)@RVE
+        e.exponent>1 =>  
+          numbersSoFar.exponentiations := inc(numbersSoFar.exponentiations)
+          numbersSoFar := numberOfOperations1(e.val,numbersSoFar)
+      lk := kernels(fn)
+      #lk = 1 =>        -- #lk = 0 => constant found (no further action)
+        k := first(lk)$LKEDF
+        n := name(operator(k)$KEDF)$BO
+        entry?(n,variables(fn)$EDF)$LS => numbersSoFar  -- solo variable found
+        a := first(argument(k)$KEDF)$LEDF
+        numbersSoFar.functionCalls := inc(numbersSoFar.functionCalls)$INT
+        numbersSoFar := numberOfOperations1(a,numbersSoFar)
+      numbersSoFar
+      
+    numberOfOperations(ode:VEDF):ON ==
+      n:ON := [0,0,0,0]
+      for i in 1..#ode repeat
+        n:ON := numberOfOperations1(ode.i,n)
+      n
+
+    expenseOfEvaluation(o:VEDF):F ==
+      ln:ON := numberOfOperations(o)
+      a := ln.additions
+      m := ln.multiplications
+      e := ln.exponentiations
+      f := 10*ln.functionCalls
+      n := (a + m + 4*e + 10*e)
+      (1.0-exp((-n::F/288.0))$F)
+
+    concat(a:Result,b:Result):Result ==
+      membersOfa := (members(a)@List(Record(key:Symbol,entry:Any)))
+      membersOfb := (members(b)@List(Record(key:Symbol,entry:Any)))
+      allMembers:=
+        concat(membersOfa,membersOfb)$List(Record(key:Symbol,entry:Any))
+      construct(allMembers)
+
+    concat(l:List Result):Result ==
+      import List Result
+      empty? l => empty()$Result
+      f := first l
+      if empty?(r := rest l) then
+        f
+      else
+        concat(f,concat r)
+
+    outputMeasure(m:F):ST ==
+      fl:Float := round(m*(f:= 1000.0))/f
+      convert(fl)@ST
+
+    measure2Result(m:Measure):Result ==
+      mm := coerce(m.measure)$AnyFunctions1(Float)
+      mmr:Record(key:Symbol,entry:Any) := [bestMeasure@Symbol,mm]
+      mn := coerce(m.name)$AnyFunctions1(ST)
+      mnr:Record(key:Symbol,entry:Any) := [nameOfRoutine@Symbol,mn]
+      me := coerce(m.explanations)$AnyFunctions1(List String)
+      mer:Record(key:Symbol,entry:Any) := [allMeasures@Symbol,me]
+      mr := construct([mmr,mnr,mer])$Result
+      met := coerce(mr)$AnyFunctions1(Result)
+      meth:Record(key:Symbol,entry:Any):=[method@Symbol,met]
+      construct([meth])$Result
+
+    measure2Result(m:Measure2):Result ==
+      mm := coerce(m.measure)$AnyFunctions1(Float)
+      mmr:Record(key:Symbol,entry:Any) := [bestMeasure@Symbol,mm]
+      mn := coerce(m.name)$AnyFunctions1(ST)
+      mnr:Record(key:Symbol,entry:Any) := [nameOfRoutine@Symbol,mn]
+      me := coerce(m.explanations)$AnyFunctions1(List String)
+      mer:Record(key:Symbol,entry:Any) := [allMeasures@Symbol,me]
+      mx := coerce(m.extra)$AnyFunctions1(Result)
+      mxr:Record(key:Symbol,entry:Any) := [other@Symbol,mx]
+      mr := construct([mmr,mnr,mer,mxr])$Result
+      met := coerce(mr)$AnyFunctions1(Result)
+      meth:Record(key:Symbol,entry:Any):=[method@Symbol,met]
+      construct([meth])$Result
+
+    att2Result(att:ATT):Result ==
+      aepc := coerce(att.endPointContinuity)$AnyFunctions1(CTYPE)
+      ar := coerce(att.range)$AnyFunctions1(RTYPE)
+      as := coerce(att.singularitiesStream)$AnyFunctions1(STYPE)
+      aa:List Any := [aepc,ar,as]
+      aaa := coerce(aa)$AnyFunctions1(List Any)
+      aar:Record(key:Symbol,entry:Any) := [attributes@Symbol,aaa]
+      construct([aar])$Result
+
+    iflist2Result(ifv:IFV):Result ==
+      ifvs:List String := 
+        [concat(["stiffness: ",outputMeasure(ifv.stiffness)]),
+          concat(["stability: ",outputMeasure(ifv.stability)]),
+           concat(["expense: ",outputMeasure(ifv.expense)]),
+            concat(["accuracy: ",outputMeasure(ifv.accuracy)]),
+             concat(["intermediateResults: ",outputMeasure(ifv.intermediateResults)])]
+      ifa:= coerce(ifvs)$AnyFunctions1(List String)
+      ifr:Record(key:Symbol,entry:Any) := [intensityFunctions@Symbol,ifa]
+      construct([ifr])$Result
+
+@
+\section{package ESTOOLS1 ExpertSystemToolsPackage1}
+<<package ESTOOLS1 ExpertSystemToolsPackage1>>=
+)abbrev package ESTOOLS1 ExpertSystemToolsPackage1
+++ Author: Brian Dupee
+++ Date Created: February 1995
+++ Date Last Updated: February 1995
+++ Basic Operations: neglist
+++ Description:
+++ \axiom{ExpertSystemToolsPackage1} contains some useful functions for use
+++ by the computational agents of Ordinary Differential Equation solvers.
+ExpertSystemToolsPackage1(R1:OR): E == I where
+  OR	==> OrderedRing
+  E ==>  with
+    neglist:List R1 -> List R1
+      ++ neglist(l) returns only the negative elements of the list \spad{l}
+  I ==> add
+    neglist(l:List R1):List R1 == [u for u in l | negative?(u)$R1]
+
+@
+\section{package ESTOOLS2 ExpertSystemToolsPackage2}
+<<package ESTOOLS2 ExpertSystemToolsPackage2>>=
+)abbrev package ESTOOLS2 ExpertSystemToolsPackage2
+++ Author: Brian Dupee
+++ Date Created: February 1995
+++ Date Last Updated: July 1996
+++ Basic Operations: map
+++ Related Constructors: Matrix
+++ Description:
+++ \axiom{ExpertSystemToolsPackage2} contains some useful functions for use
+++ by the computational agents of Ordinary Differential Equation solvers.
+ExpertSystemToolsPackage2(R1:R,R2:R): E == I where
+  R	==> Ring
+  E ==>  with
+    map:(R1->R2,Matrix R1) -> Matrix R2
+      ++ map(f,m) applies a mapping f:R1 -> R2 onto a matrix
+      ++ \spad{m} in R1 returning a matrix in R2
+  I ==> add
+    map(f:R1->R2,m:Matrix R1):Matrix R2 ==
+      matrix([[f u for u in v] for v in listOfLists(m)$(Matrix R1)])$(Matrix R2)
+
+@
+\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 ESTOOLS ExpertSystemToolsPackage>>
+<<package ESTOOLS1 ExpertSystemToolsPackage1>>
+<<package ESTOOLS2 ExpertSystemToolsPackage2>>
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}