diff options
Diffstat (limited to 'src/algebra/tools.spad.pamphlet')
-rw-r--r-- | src/algebra/tools.spad.pamphlet | 470 |
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} |