diff --git a/books/bookvol10.3.pamphlet b/books/bookvol10.3.pamphlet index 2297061..f128686 100644 --- a/books/bookvol10.3.pamphlet +++ b/books/bookvol10.3.pamphlet @@ -280,8 +280,4472 @@ November 10, 2003 ((iHy)) %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %\pagehead{Domain}{ABB} %\pagepic{ps/v103domain.ps}{ABB}{1.00} +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\chapter{Chapter A} +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain ANY Any} +<>= +"ANY" -> "SETCAT" +"Any()" -> "SetCategory()" +@ +\pagehead{Any}{ANY} +\pagepic{ps/v103any.ps}{ANY}{1.00} +<>= +)abbrev domain ANY Any +++ Author: Robert S. Sutor +++ Date Created: +++ Change History: +++ Basic Functions: any, domainOf, objectOf, dom, obj, showTypeInOutput +++ Related Constructors: AnyFunctions1 +++ Also See: None +++ AMS Classification: +++ Keywords: +++ Description: +++ \spadtype{Any} implements a type that packages up objects and their +++ types in objects of \spadtype{Any}. Roughly speaking that means +++ that if \spad{s : S} then when converted to \spadtype{Any}, the new +++ object will include both the original object and its type. This is +++ a way of converting arbitrary objects into a single type without +++ losing any of the original information. Any object can be converted +++ to one of \spadtype{Any}. + +Any(): SetCategory with + any : (SExpression, None) -> % + ++ any(type,object) is a technical function for creating + ++ an object of \spadtype{Any}. Arugment \spad{type} is a + ++ \spadgloss{LISP} form for the type of \spad{object}. + domainOf : % -> OutputForm + ++ domainOf(a) returns a printable form of the type of the + ++ original object that was converted to \spadtype{Any}. + objectOf : % -> OutputForm + ++ objectOf(a) returns a printable form of the + ++ original object that was converted to \spadtype{Any}. + dom : % -> SExpression + ++ dom(a) returns a \spadgloss{LISP} form of the type of the + ++ original object that was converted to \spadtype{Any}. + obj : % -> None + ++ obj(a) essentially returns the original object that was + ++ converted to \spadtype{Any} except that the type is forced + ++ to be \spadtype{None}. + showTypeInOutput: Boolean -> String + ++ showTypeInOutput(bool) affects the way objects of + ++ \spadtype{Any} are displayed. If \spad{bool} is true + ++ then the type of the original object that was converted + ++ to \spadtype{Any} will be printed. If \spad{bool} is + ++ false, it will not be printed. + + == add + Rep := Record(dm: SExpression, ob: None) + + printTypeInOutputP:Reference(Boolean) := ref false + + obj x == x.ob + dom x == x.dm + domainOf x == x.dm pretend OutputForm + x = y == (x.dm = y.dm) and EQ(x.ob, y.ob)$Lisp + + objectOf(x : %) : OutputForm == + spad2BootCoerce(x.ob, x.dm, + list("OutputForm"::Symbol)$List(Symbol))$Lisp + + showTypeInOutput(b : Boolean) : String == + printTypeInOutputP := ref b + b=> "Type of object will be displayed in output of a member of Any" + "Type of object will not be displayed in output of a member of Any" + + coerce(x):OutputForm == + obj1 : OutputForm := objectOf x + not deref printTypeInOutputP => obj1 + dom1 := + p:Symbol := prefix2String(devaluate(x.dm)$Lisp)$Lisp + atom?(p pretend SExpression) => list(p)$List(Symbol) + list(p)$Symbol + hconcat cons(obj1, + cons(":"::OutputForm, [a::OutputForm for a in dom1])) + + any(domain, object) == + (isValidType(domain)$Lisp)@Boolean => [domain, object] + domain := devaluate(domain)$Lisp + (isValidType(domain)$Lisp)@Boolean => [domain, object] + error "function any must have a domain as first argument" + +@ +\section{domain ASP1 Asp1} +\pagehead{Asp1}{ASP1} +\pagepic{ps/v103asp1.ps}{ASP1}{1.00} +<>= +)abbrev domain ASP1 Asp1 +++ Author: Mike Dewar, Grant Keady, Godfrey Nolan +++ Date Created: Mar 1993 +++ Date Last Updated: 18 March 1994 +++ 6 October 1994 +++ Related Constructors: FortranFunctionCategory, FortranProgramCategory. +++ Description: +++ \spadtype{Asp1} produces Fortran for Type 1 ASPs, needed for various +++ NAG routines. Type 1 ASPs take a univariate expression (in the symbol +++ X) and turn it into a Fortran Function like the following: +++\begin{verbatim} +++ DOUBLE PRECISION FUNCTION F(X) +++ DOUBLE PRECISION X +++ F=DSIN(X) +++ RETURN +++ END +++\end{verbatim} + + +Asp1(name): Exports == Implementation where + name : Symbol + + FEXPR ==> FortranExpression + FST ==> FortranScalarType + FT ==> FortranType + SYMTAB ==> SymbolTable + RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode)) + FRAC ==> Fraction + POLY ==> Polynomial + EXPR ==> Expression + INT ==> Integer + FLOAT ==> Float + + Exports ==> FortranFunctionCategory with + coerce : FEXPR(['X],[],MachineFloat) -> $ + ++coerce(f) takes an object from the appropriate instantiation of + ++\spadtype{FortranExpression} and turns it into an ASP. + + Implementation ==> add + + -- Build Symbol Table for Rep + syms : SYMTAB := empty()$SYMTAB + declare!(X,fortranReal()$FT,syms)$SYMTAB + real : FST := "real"::FST + + Rep := FortranProgram(name,[real]$Union(fst:FST,void:"void"),[X],syms) + + retract(u:FRAC POLY INT):$ == (retract(u)@FEXPR(['X],[],MachineFloat))::$ + retractIfCan(u:FRAC POLY INT):Union($,"failed") == + foo : Union(FEXPR(['X],[],MachineFloat),"failed") + foo := retractIfCan(u)$FEXPR(['X],[],MachineFloat) + foo case "failed" => "failed" + foo::FEXPR(['X],[],MachineFloat)::$ + + retract(u:FRAC POLY FLOAT):$ == (retract(u)@FEXPR(['X],[],MachineFloat))::$ + retractIfCan(u:FRAC POLY FLOAT):Union($,"failed") == + foo : Union(FEXPR(['X],[],MachineFloat),"failed") + foo := retractIfCan(u)$FEXPR(['X],[],MachineFloat) + foo case "failed" => "failed" + foo::FEXPR(['X],[],MachineFloat)::$ + + retract(u:EXPR FLOAT):$ == (retract(u)@FEXPR(['X],[],MachineFloat))::$ + retractIfCan(u:EXPR FLOAT):Union($,"failed") == + foo : Union(FEXPR(['X],[],MachineFloat),"failed") + foo := retractIfCan(u)$FEXPR(['X],[],MachineFloat) + foo case "failed" => "failed" + foo::FEXPR(['X],[],MachineFloat)::$ + + retract(u:EXPR INT):$ == (retract(u)@FEXPR(['X],[],MachineFloat))::$ + retractIfCan(u:EXPR INT):Union($,"failed") == + foo : Union(FEXPR(['X],[],MachineFloat),"failed") + foo := retractIfCan(u)$FEXPR(['X],[],MachineFloat) + foo case "failed" => "failed" + foo::FEXPR(['X],[],MachineFloat)::$ + + retract(u:POLY FLOAT):$ == (retract(u)@FEXPR(['X],[],MachineFloat))::$ + retractIfCan(u:POLY FLOAT):Union($,"failed") == + foo : Union(FEXPR(['X],[],MachineFloat),"failed") + foo := retractIfCan(u)$FEXPR(['X],[],MachineFloat) + foo case "failed" => "failed" + foo::FEXPR(['X],[],MachineFloat)::$ + + retract(u:POLY INT):$ == (retract(u)@FEXPR(['X],[],MachineFloat))::$ + retractIfCan(u:POLY INT):Union($,"failed") == + foo : Union(FEXPR(['X],[],MachineFloat),"failed") + foo := retractIfCan(u)$FEXPR(['X],[],MachineFloat) + foo case "failed" => "failed" + foo::FEXPR(['X],[],MachineFloat)::$ + + coerce(u:FEXPR(['X],[],MachineFloat)):$ == + coerce((u::Expression(MachineFloat))$FEXPR(['X],[],MachineFloat))$Rep + + coerce(c:List FortranCode):$ == coerce(c)$Rep + + coerce(r:RSFC):$ == coerce(r)$Rep + + coerce(c:FortranCode):$ == coerce(c)$Rep + + coerce(u:$):OutputForm == coerce(u)$Rep + + outputAsFortran(u):Void == + p := checkPrecision()$NAGLinkSupportPackage + outputAsFortran(u)$Rep + p => restorePrecision()$NAGLinkSupportPackage + +@ +\section{domain ASP10 Asp10} +\pagehead{Asp10}{ASP10} +\pagepic{ps/v103asp10.ps}{ASP10}{1.00} +<>= +)abbrev domain ASP10 Asp10 +++ Author: Mike Dewar and Godfrey Nolan +++ Date Created: Mar 1993 +++ Date Last Updated: 18 March 1994 +++ 6 October 1994 +++ Related Constructors: FortranVectorFunctionCategory, FortranProgramCategory +++ Description: +++\spadtype{ASP10} produces Fortran for Type 10 ASPs, needed for NAG routine +++\axiomOpFrom{d02kef}{d02Package}. This ASP computes the values of a set of functions, for example: +++\begin{verbatim} +++ SUBROUTINE COEFFN(P,Q,DQDL,X,ELAM,JINT) +++ DOUBLE PRECISION ELAM,P,Q,X,DQDL +++ INTEGER JINT +++ P=1.0D0 +++ Q=((-1.0D0*X**3)+ELAM*X*X-2.0D0)/(X*X) +++ DQDL=1.0D0 +++ RETURN +++ END +++\end{verbatim} + +Asp10(name): Exports == Implementation where + name : Symbol + + FST ==> FortranScalarType + FT ==> FortranType + SYMTAB ==> SymbolTable + EXF ==> Expression Float + RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode)) + FEXPR ==> FortranExpression(['JINT,'X,'ELAM],[],MFLOAT) + MFLOAT ==> MachineFloat + FRAC ==> Fraction + POLY ==> Polynomial + EXPR ==> Expression + INT ==> Integer + FLOAT ==> Float + VEC ==> Vector + VF2 ==> VectorFunctions2 + + Exports ==> FortranVectorFunctionCategory with + coerce : Vector FEXPR -> % + ++coerce(f) takes objects from the appropriate instantiation of + ++\spadtype{FortranExpression} and turns them into an ASP. + + Implementation ==> add + + real : FST := "real"::FST + syms : SYMTAB := empty()$SYMTAB + declare!(P,fortranReal()$FT,syms)$SYMTAB + declare!(Q,fortranReal()$FT,syms)$SYMTAB + declare!(DQDL,fortranReal()$FT,syms)$SYMTAB + declare!(X,fortranReal()$FT,syms)$SYMTAB + declare!(ELAM,fortranReal()$FT,syms)$SYMTAB + declare!(JINT,fortranInteger()$FT,syms)$SYMTAB + Rep := FortranProgram(name,["void"]$Union(fst:FST,void:"void"), + [P,Q,DQDL,X,ELAM,JINT],syms) + + retract(u:VEC FRAC POLY INT):$ == + v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY INT,FEXPR) + v::$ + + retractIfCan(u:VEC FRAC POLY INT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY INT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + retract(u:VEC FRAC POLY FLOAT):$ == + v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY FLOAT,FEXPR) + v::$ + + retractIfCan(u:VEC FRAC POLY FLOAT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + retract(u:VEC EXPR INT):$ == + v : VEC FEXPR := map(retract,u)$VF2(EXPR INT,FEXPR) + v::$ + + retractIfCan(u:VEC EXPR INT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR INT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + retract(u:VEC EXPR FLOAT):$ == + v : VEC FEXPR := map(retract,u)$VF2(EXPR FLOAT,FEXPR) + v::$ + + retractIfCan(u:VEC EXPR FLOAT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR FLOAT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + retract(u:VEC POLY INT):$ == + v : VEC FEXPR := map(retract,u)$VF2(POLY INT,FEXPR) + v::$ + + retractIfCan(u:VEC POLY INT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY INT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + retract(u:VEC POLY FLOAT):$ == + v : VEC FEXPR := map(retract,u)$VF2(POLY FLOAT,FEXPR) + v::$ + + retractIfCan(u:VEC POLY FLOAT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY FLOAT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + coerce(c:FortranCode):% == coerce(c)$Rep + + coerce(r:RSFC):% == coerce(r)$Rep + + coerce(c:List FortranCode):% == coerce(c)$Rep + + -- To help the poor old compiler! + localAssign(s:Symbol,u:Expression MFLOAT):FortranCode == + assign(s,u)$FortranCode + + coerce(u:Vector FEXPR):% == + import Vector FEXPR + not (#u = 3) => error "Incorrect Dimension For Vector" + ([localAssign(P,elt(u,1)::Expression MFLOAT),_ + localAssign(Q,elt(u,2)::Expression MFLOAT),_ + localAssign(DQDL,elt(u,3)::Expression MFLOAT),_ + returns()$FortranCode ]$List(FortranCode))::Rep + + coerce(u:%):OutputForm == coerce(u)$Rep + + outputAsFortran(u):Void == + p := checkPrecision()$NAGLinkSupportPackage + outputAsFortran(u)$Rep + p => restorePrecision()$NAGLinkSupportPackage + +@ +\section{domain ASP12 Asp12} +\pagehead{Asp12}{ASP12} +\pagepic{ps/v103asp12.ps}{ASP12}{1.00} +<>= +)abbrev domain ASP12 Asp12 +++ Author: Mike Dewar and Godfrey Nolan +++ Date Created: Oct 1993 +++ Date Last Updated: 18 March 1994 +++ 21 June 1994 Changed print to printStatement +++ Related Constructors: +++ Description: +++\spadtype{Asp12} produces Fortran for Type 12 ASPs, needed for NAG routine +++\axiomOpFrom{d02kef}{d02Package} etc., for example: +++\begin{verbatim} +++ SUBROUTINE MONIT (MAXIT,IFLAG,ELAM,FINFO) +++ DOUBLE PRECISION ELAM,FINFO(15) +++ INTEGER MAXIT,IFLAG +++ IF(MAXIT.EQ.-1)THEN +++ PRINT*,"Output from Monit" +++ ENDIF +++ PRINT*,MAXIT,IFLAG,ELAM,(FINFO(I),I=1,4) +++ RETURN +++ END +++\end{verbatim} +Asp12(name): Exports == Implementation where + name : Symbol + + O ==> OutputForm + S ==> Symbol + FST ==> FortranScalarType + FT ==> FortranType + FC ==> FortranCode + SYMTAB ==> SymbolTable + EXI ==> Expression Integer + RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode)) + U ==> Union(I: Expression Integer,F: Expression Float,_ + CF: Expression Complex Float,switch:Switch) + UFST ==> Union(fst:FST,void:"void") + + Exports ==> FortranProgramCategory with + outputAsFortran:() -> Void + ++outputAsFortran() generates the default code for \spadtype{ASP12}. + + Implementation ==> add + + import FC + import Switch + + real : FST := "real"::FST + syms : SYMTAB := empty()$SYMTAB + declare!(MAXIT,fortranInteger()$FT,syms)$SYMTAB + declare!(IFLAG,fortranInteger()$FT,syms)$SYMTAB + declare!(ELAM,fortranReal()$FT,syms)$SYMTAB + fType : FT := construct([real]$UFST,["15"::Symbol],false)$FT + declare!(FINFO,fType,syms)$SYMTAB + Rep := FortranProgram(name,["void"]$UFST,[MAXIT,IFLAG,ELAM,FINFO],syms) + + -- eqn : O := (I::O)=(1@Integer::EXI::O) + code:=([cond(EQ([MAXIT@S::EXI]$U,[-1::EXI]$U), + printStatement(["_"Output from Monit_""::O])), + printStatement([MAXIT::O,IFLAG::O,ELAM::O,subscript("(FINFO"::S,[I::O])::O,"I=1"::S::O,"4)"::S::O]), -- YUCK! + returns()]$List(FortranCode))::Rep + + coerce(u:%):OutputForm == coerce(u)$Rep + + outputAsFortran(u:%):Void == outputAsFortran(u)$Rep + outputAsFortran():Void == outputAsFortran(code)$Rep + +@ +\section{domain ASP19 Asp19} +\pagehead{Asp19}{ASP19} +\pagepic{ps/v103asp19.ps}{ASP19}{1.00} +<>= +)abbrev domain ASP19 Asp19 +++ Author: Mike Dewar, Godfrey Nolan, Grant Keady +++ Date Created: Mar 1993 +++ Date Last Updated: 18 March 1994 +++ 6 October 1994 +++ Related Constructors: FortranVectorFunctionCategory, FortranProgramCategory +++ Description: +++\spadtype{Asp19} produces Fortran for Type 19 ASPs, evaluating a set of +++functions and their jacobian at a given point, for example: +++\begin{verbatim} +++ SUBROUTINE LSFUN2(M,N,XC,FVECC,FJACC,LJC) +++ DOUBLE PRECISION FVECC(M),FJACC(LJC,N),XC(N) +++ INTEGER M,N,LJC +++ INTEGER I,J +++ DO 25003 I=1,LJC +++ DO 25004 J=1,N +++ FJACC(I,J)=0.0D0 +++25004 CONTINUE +++25003 CONTINUE +++ FVECC(1)=((XC(1)-0.14D0)*XC(3)+(15.0D0*XC(1)-2.1D0)*XC(2)+1.0D0)/( +++ &XC(3)+15.0D0*XC(2)) +++ FVECC(2)=((XC(1)-0.18D0)*XC(3)+(7.0D0*XC(1)-1.26D0)*XC(2)+1.0D0)/( +++ &XC(3)+7.0D0*XC(2)) +++ FVECC(3)=((XC(1)-0.22D0)*XC(3)+(4.333333333333333D0*XC(1)-0.953333 +++ &3333333333D0)*XC(2)+1.0D0)/(XC(3)+4.333333333333333D0*XC(2)) +++ FVECC(4)=((XC(1)-0.25D0)*XC(3)+(3.0D0*XC(1)-0.75D0)*XC(2)+1.0D0)/( +++ &XC(3)+3.0D0*XC(2)) +++ FVECC(5)=((XC(1)-0.29D0)*XC(3)+(2.2D0*XC(1)-0.6379999999999999D0)* +++ &XC(2)+1.0D0)/(XC(3)+2.2D0*XC(2)) +++ FVECC(6)=((XC(1)-0.32D0)*XC(3)+(1.666666666666667D0*XC(1)-0.533333 +++ &3333333333D0)*XC(2)+1.0D0)/(XC(3)+1.666666666666667D0*XC(2)) +++ FVECC(7)=((XC(1)-0.35D0)*XC(3)+(1.285714285714286D0*XC(1)-0.45D0)* +++ &XC(2)+1.0D0)/(XC(3)+1.285714285714286D0*XC(2)) +++ FVECC(8)=((XC(1)-0.39D0)*XC(3)+(XC(1)-0.39D0)*XC(2)+1.0D0)/(XC(3)+ +++ &XC(2)) +++ FVECC(9)=((XC(1)-0.37D0)*XC(3)+(XC(1)-0.37D0)*XC(2)+1.285714285714 +++ &286D0)/(XC(3)+XC(2)) +++ FVECC(10)=((XC(1)-0.58D0)*XC(3)+(XC(1)-0.58D0)*XC(2)+1.66666666666 +++ &6667D0)/(XC(3)+XC(2)) +++ FVECC(11)=((XC(1)-0.73D0)*XC(3)+(XC(1)-0.73D0)*XC(2)+2.2D0)/(XC(3) +++ &+XC(2)) +++ FVECC(12)=((XC(1)-0.96D0)*XC(3)+(XC(1)-0.96D0)*XC(2)+3.0D0)/(XC(3) +++ &+XC(2)) +++ FVECC(13)=((XC(1)-1.34D0)*XC(3)+(XC(1)-1.34D0)*XC(2)+4.33333333333 +++ &3333D0)/(XC(3)+XC(2)) +++ FVECC(14)=((XC(1)-2.1D0)*XC(3)+(XC(1)-2.1D0)*XC(2)+7.0D0)/(XC(3)+X +++ &C(2)) +++ FVECC(15)=((XC(1)-4.39D0)*XC(3)+(XC(1)-4.39D0)*XC(2)+15.0D0)/(XC(3 +++ &)+XC(2)) +++ FJACC(1,1)=1.0D0 +++ FJACC(1,2)=-15.0D0/(XC(3)**2+30.0D0*XC(2)*XC(3)+225.0D0*XC(2)**2) +++ FJACC(1,3)=-1.0D0/(XC(3)**2+30.0D0*XC(2)*XC(3)+225.0D0*XC(2)**2) +++ FJACC(2,1)=1.0D0 +++ FJACC(2,2)=-7.0D0/(XC(3)**2+14.0D0*XC(2)*XC(3)+49.0D0*XC(2)**2) +++ FJACC(2,3)=-1.0D0/(XC(3)**2+14.0D0*XC(2)*XC(3)+49.0D0*XC(2)**2) +++ FJACC(3,1)=1.0D0 +++ FJACC(3,2)=((-0.1110223024625157D-15*XC(3))-4.333333333333333D0)/( +++ &XC(3)**2+8.666666666666666D0*XC(2)*XC(3)+18.77777777777778D0*XC(2) +++ &**2) +++ FJACC(3,3)=(0.1110223024625157D-15*XC(2)-1.0D0)/(XC(3)**2+8.666666 +++ &666666666D0*XC(2)*XC(3)+18.77777777777778D0*XC(2)**2) +++ FJACC(4,1)=1.0D0 +++ FJACC(4,2)=-3.0D0/(XC(3)**2+6.0D0*XC(2)*XC(3)+9.0D0*XC(2)**2) +++ FJACC(4,3)=-1.0D0/(XC(3)**2+6.0D0*XC(2)*XC(3)+9.0D0*XC(2)**2) +++ FJACC(5,1)=1.0D0 +++ FJACC(5,2)=((-0.1110223024625157D-15*XC(3))-2.2D0)/(XC(3)**2+4.399 +++ &999999999999D0*XC(2)*XC(3)+4.839999999999998D0*XC(2)**2) +++ FJACC(5,3)=(0.1110223024625157D-15*XC(2)-1.0D0)/(XC(3)**2+4.399999 +++ &999999999D0*XC(2)*XC(3)+4.839999999999998D0*XC(2)**2) +++ FJACC(6,1)=1.0D0 +++ FJACC(6,2)=((-0.2220446049250313D-15*XC(3))-1.666666666666667D0)/( +++ &XC(3)**2+3.333333333333333D0*XC(2)*XC(3)+2.777777777777777D0*XC(2) +++ &**2) +++ FJACC(6,3)=(0.2220446049250313D-15*XC(2)-1.0D0)/(XC(3)**2+3.333333 +++ &333333333D0*XC(2)*XC(3)+2.777777777777777D0*XC(2)**2) +++ FJACC(7,1)=1.0D0 +++ FJACC(7,2)=((-0.5551115123125783D-16*XC(3))-1.285714285714286D0)/( +++ &XC(3)**2+2.571428571428571D0*XC(2)*XC(3)+1.653061224489796D0*XC(2) +++ &**2) +++ FJACC(7,3)=(0.5551115123125783D-16*XC(2)-1.0D0)/(XC(3)**2+2.571428 +++ &571428571D0*XC(2)*XC(3)+1.653061224489796D0*XC(2)**2) +++ FJACC(8,1)=1.0D0 +++ FJACC(8,2)=-1.0D0/(XC(3)**2+2.0D0*XC(2)*XC(3)+XC(2)**2) +++ FJACC(8,3)=-1.0D0/(XC(3)**2+2.0D0*XC(2)*XC(3)+XC(2)**2) +++ FJACC(9,1)=1.0D0 +++ FJACC(9,2)=-1.285714285714286D0/(XC(3)**2+2.0D0*XC(2)*XC(3)+XC(2)* +++ &*2) +++ FJACC(9,3)=-1.285714285714286D0/(XC(3)**2+2.0D0*XC(2)*XC(3)+XC(2)* +++ &*2) +++ FJACC(10,1)=1.0D0 +++ FJACC(10,2)=-1.666666666666667D0/(XC(3)**2+2.0D0*XC(2)*XC(3)+XC(2) +++ &**2) +++ FJACC(10,3)=-1.666666666666667D0/(XC(3)**2+2.0D0*XC(2)*XC(3)+XC(2) +++ &**2) +++ FJACC(11,1)=1.0D0 +++ FJACC(11,2)=-2.2D0/(XC(3)**2+2.0D0*XC(2)*XC(3)+XC(2)**2) +++ FJACC(11,3)=-2.2D0/(XC(3)**2+2.0D0*XC(2)*XC(3)+XC(2)**2) +++ FJACC(12,1)=1.0D0 +++ FJACC(12,2)=-3.0D0/(XC(3)**2+2.0D0*XC(2)*XC(3)+XC(2)**2) +++ FJACC(12,3)=-3.0D0/(XC(3)**2+2.0D0*XC(2)*XC(3)+XC(2)**2) +++ FJACC(13,1)=1.0D0 +++ FJACC(13,2)=-4.333333333333333D0/(XC(3)**2+2.0D0*XC(2)*XC(3)+XC(2) +++ &**2) +++ FJACC(13,3)=-4.333333333333333D0/(XC(3)**2+2.0D0*XC(2)*XC(3)+XC(2) +++ &**2) +++ FJACC(14,1)=1.0D0 +++ FJACC(14,2)=-7.0D0/(XC(3)**2+2.0D0*XC(2)*XC(3)+XC(2)**2) +++ FJACC(14,3)=-7.0D0/(XC(3)**2+2.0D0*XC(2)*XC(3)+XC(2)**2) +++ FJACC(15,1)=1.0D0 +++ FJACC(15,2)=-15.0D0/(XC(3)**2+2.0D0*XC(2)*XC(3)+XC(2)**2) +++ FJACC(15,3)=-15.0D0/(XC(3)**2+2.0D0*XC(2)*XC(3)+XC(2)**2) +++ RETURN +++ END +++\end{verbatim} + +Asp19(name): Exports == Implementation where + name : Symbol + + FST ==> FortranScalarType + FT ==> FortranType + FC ==> FortranCode + SYMTAB ==> SymbolTable + RSFC ==> Record(localSymbols:SymbolTable,code:List(FC)) + FSTU ==> Union(fst:FST,void:"void") + FRAC ==> Fraction + POLY ==> Polynomial + EXPR ==> Expression + INT ==> Integer + FLOAT ==> Float + MFLOAT ==> MachineFloat + VEC ==> Vector + VF2 ==> VectorFunctions2 + MF2 ==> MatrixCategoryFunctions2(FEXPR,VEC FEXPR,VEC FEXPR,Matrix FEXPR,EXPR MFLOAT,VEC EXPR MFLOAT,VEC EXPR MFLOAT,Matrix EXPR MFLOAT) + FEXPR ==> FortranExpression([],['XC],MFLOAT) + S ==> Symbol + + Exports ==> FortranVectorFunctionCategory with + coerce : VEC FEXPR -> $ + ++coerce(f) takes objects from the appropriate instantiation of + ++\spadtype{FortranExpression} and turns them into an ASP. + + Implementation ==> add + + real : FSTU := ["real"::FST]$FSTU + syms : SYMTAB := empty()$SYMTAB + declare!(M,fortranInteger()$FT,syms)$SYMTAB + declare!(N,fortranInteger()$FT,syms)$SYMTAB + declare!(LJC,fortranInteger()$FT,syms)$SYMTAB + xcType : FT := construct(real,[N],false)$FT + declare!(XC,xcType,syms)$SYMTAB + fveccType : FT := construct(real,[M],false)$FT + declare!(FVECC,fveccType,syms)$SYMTAB + fjaccType : FT := construct(real,[LJC,N],false)$FT + declare!(FJACC,fjaccType,syms)$SYMTAB + Rep := FortranProgram(name,["void"]$FSTU,[M,N,XC,FVECC,FJACC,LJC],syms) + + coerce(c:List FC):$ == coerce(c)$Rep + + coerce(r:RSFC):$ == coerce(r)$Rep + + coerce(c:FC):$ == coerce(c)$Rep + + -- Take a symbol, pull of the script and turn it into an integer!! + o2int(u:S):Integer == + o : OutputForm := first elt(scripts(u)$S,sub) + o pretend Integer + + -- To help the poor old compiler! + fexpr2expr(u:FEXPR):EXPR MFLOAT == coerce(u)$FEXPR + + localAssign1(s:S,j:Matrix FEXPR):FC == + j' : Matrix EXPR MFLOAT := map(fexpr2expr,j)$MF2 + assign(s,j')$FC + + localAssign2(s:S,j:VEC FEXPR):FC == + j' : VEC EXPR MFLOAT := map(fexpr2expr,j)$VF2(FEXPR,EXPR MFLOAT) + assign(s,j')$FC + + coerce(u:VEC FEXPR):$ == + -- First zero the Jacobian matrix in case we miss some derivatives which + -- are zero. + import POLY INT + seg1 : Segment (POLY INT) := segment(1::(POLY INT),LJC@S::(POLY INT)) + seg2 : Segment (POLY INT) := segment(1::(POLY INT),N@S::(POLY INT)) + s1 : SegmentBinding POLY INT := equation(I@S,seg1) + s2 : SegmentBinding POLY INT := equation(J@S,seg2) + as : FC := assign(FJACC,[I@S::(POLY INT),J@S::(POLY INT)],0.0::EXPR FLOAT) + clear : FC := forLoop(s1,forLoop(s2,as)) + j:Integer + x:S := XC::S + pu:List(S) := [] + -- Work out which variables appear in the expressions + for e in entries(u) repeat + pu := setUnion(pu,variables(e)$FEXPR) + scriptList : List Integer := map(o2int,pu)$ListFunctions2(S,Integer) + -- This should be the maximum XC_n which occurs (there may be others + -- which don't): + n:Integer := reduce(max,scriptList)$List(Integer) + p:List(S) := [] + for j in 1..n repeat p:= cons(subscript(x,[j::OutputForm])$S,p) + p:= reverse(p) + jac:Matrix(FEXPR) := _ + jacobian(u,p)$MultiVariableCalculusFunctions(S,FEXPR,VEC FEXPR,List(S)) + c1:FC := localAssign2(FVECC,u) + c2:FC := localAssign1(FJACC,jac) + [clear,c1,c2,returns()]$List(FC)::$ + + coerce(u:$):OutputForm == coerce(u)$Rep + + outputAsFortran(u):Void == + p := checkPrecision()$NAGLinkSupportPackage + outputAsFortran(u)$Rep + p => restorePrecision()$NAGLinkSupportPackage + + + retract(u:VEC FRAC POLY INT):$ == + v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY INT,FEXPR) + v::$ + + retractIfCan(u:VEC FRAC POLY INT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY INT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + retract(u:VEC FRAC POLY FLOAT):$ == + v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY FLOAT,FEXPR) + v::$ + + retractIfCan(u:VEC FRAC POLY FLOAT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + retract(u:VEC EXPR INT):$ == + v : VEC FEXPR := map(retract,u)$VF2(EXPR INT,FEXPR) + v::$ + + retractIfCan(u:VEC EXPR INT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR INT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + retract(u:VEC EXPR FLOAT):$ == + v : VEC FEXPR := map(retract,u)$VF2(EXPR FLOAT,FEXPR) + v::$ + + retractIfCan(u:VEC EXPR FLOAT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR FLOAT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + retract(u:VEC POLY INT):$ == + v : VEC FEXPR := map(retract,u)$VF2(POLY INT,FEXPR) + v::$ + + retractIfCan(u:VEC POLY INT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY INT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + retract(u:VEC POLY FLOAT):$ == + v : VEC FEXPR := map(retract,u)$VF2(POLY FLOAT,FEXPR) + v::$ + + retractIfCan(u:VEC POLY FLOAT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY FLOAT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + +@ +\section{domain ASP20 Asp20} +\pagehead{Asp20}{ASP20} +\pagepic{ps/v103asp20.ps}{ASP20}{1.00} +<>= +)abbrev domain ASP20 Asp20 +++ Author: Mike Dewar and Godfrey Nolan and Grant Keady +++ Date Created: Dec 1993 +++ Date Last Updated: 21 March 1994 +++ 6 October 1994 +++ Related Constructors: FortranVectorFunctionCategory, FortranProgramCategory +++ Description: +++\spadtype{Asp20} produces Fortran for Type 20 ASPs, for example: +++\begin{verbatim} +++ SUBROUTINE QPHESS(N,NROWH,NCOLH,JTHCOL,HESS,X,HX) +++ DOUBLE PRECISION HX(N),X(N),HESS(NROWH,NCOLH) +++ INTEGER JTHCOL,N,NROWH,NCOLH +++ HX(1)=2.0D0*X(1) +++ HX(2)=2.0D0*X(2) +++ HX(3)=2.0D0*X(4)+2.0D0*X(3) +++ HX(4)=2.0D0*X(4)+2.0D0*X(3) +++ HX(5)=2.0D0*X(5) +++ HX(6)=(-2.0D0*X(7))+(-2.0D0*X(6)) +++ HX(7)=(-2.0D0*X(7))+(-2.0D0*X(6)) +++ RETURN +++ END +++\end{verbatim} + +Asp20(name): Exports == Implementation where + name : Symbol + + FST ==> FortranScalarType + FT ==> FortranType + SYMTAB ==> SymbolTable + PI ==> PositiveInteger + UFST ==> Union(fst:FST,void:"void") + RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode)) + FRAC ==> Fraction + POLY ==> Polynomial + EXPR ==> Expression + INT ==> Integer + FLOAT ==> Float + VEC ==> Vector + MAT ==> Matrix + VF2 ==> VectorFunctions2 + MFLOAT ==> MachineFloat + FEXPR ==> FortranExpression([],['X,'HESS],MFLOAT) + O ==> OutputForm + M2 ==> MatrixCategoryFunctions2 + MF2a ==> M2(FRAC POLY INT,VEC FRAC POLY INT,VEC FRAC POLY INT, + MAT FRAC POLY INT,FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR) + MF2b ==> M2(FRAC POLY FLOAT,VEC FRAC POLY FLOAT,VEC FRAC POLY FLOAT, + MAT FRAC POLY FLOAT, FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR) + MF2c ==> M2(POLY INT,VEC POLY INT,VEC POLY INT,MAT POLY INT, + FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR) + MF2d ==> M2(POLY FLOAT,VEC POLY FLOAT,VEC POLY FLOAT, + MAT POLY FLOAT, FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR) + MF2e ==> M2(EXPR INT,VEC EXPR INT,VEC EXPR INT,MAT EXPR INT, + FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR) + MF2f ==> M2(EXPR FLOAT,VEC EXPR FLOAT,VEC EXPR FLOAT, + MAT EXPR FLOAT, FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR) + + + Exports ==> FortranMatrixFunctionCategory with + coerce: MAT FEXPR -> $ + ++coerce(f) takes objects from the appropriate instantiation of + ++\spadtype{FortranExpression} and turns them into an ASP. + + Implementation ==> add + + real : UFST := ["real"::FST]$UFST + syms : SYMTAB := empty() + declare!(N,fortranInteger(),syms)$SYMTAB + declare!(NROWH,fortranInteger(),syms)$SYMTAB + declare!(NCOLH,fortranInteger(),syms)$SYMTAB + declare!(JTHCOL,fortranInteger(),syms)$SYMTAB + hessType : FT := construct(real,[NROWH,NCOLH],false)$FT + declare!(HESS,hessType,syms)$SYMTAB + xType : FT := construct(real,[N],false)$FT + declare!(X,xType,syms)$SYMTAB + declare!(HX,xType,syms)$SYMTAB + Rep := FortranProgram(name,["void"]$UFST, + [N,NROWH,NCOLH,JTHCOL,HESS,X,HX],syms) + + coerce(c:List FortranCode):$ == coerce(c)$Rep + + coerce(r:RSFC):$ == coerce(r)$Rep + + coerce(c:FortranCode):$ == coerce(c)$Rep + + -- To help the poor old compiler! + fexpr2expr(u:FEXPR):EXPR MFLOAT == coerce(u)$FEXPR + + localAssign(s:Symbol,j:VEC FEXPR):FortranCode == + j' : VEC EXPR MFLOAT := map(fexpr2expr,j)$VF2(FEXPR,EXPR MFLOAT) + assign(s,j')$FortranCode + + coerce(u:MAT FEXPR):$ == + j:Integer + x:Symbol := X::Symbol + n := nrows(u)::PI + p:VEC FEXPR := [retract(subscript(x,[j::O])$Symbol)@FEXPR for j in 1..n] + prod:VEC FEXPR := u*p + ([localAssign(HX,prod),returns()$FortranCode]$List(FortranCode))::$ + + retract(u:MAT FRAC POLY INT):$ == + v : MAT FEXPR := map(retract,u)$MF2a + v::$ + + retractIfCan(u:MAT FRAC POLY INT):Union($,"failed") == + v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2a + v case "failed" => "failed" + (v::MAT FEXPR)::$ + + retract(u:MAT FRAC POLY FLOAT):$ == + v : MAT FEXPR := map(retract,u)$MF2b + v::$ + + retractIfCan(u:MAT FRAC POLY FLOAT):Union($,"failed") == + v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2b + v case "failed" => "failed" + (v::MAT FEXPR)::$ + + retract(u:MAT EXPR INT):$ == + v : MAT FEXPR := map(retract,u)$MF2e + v::$ + + retractIfCan(u:MAT EXPR INT):Union($,"failed") == + v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2e + v case "failed" => "failed" + (v::MAT FEXPR)::$ + + retract(u:MAT EXPR FLOAT):$ == + v : MAT FEXPR := map(retract,u)$MF2f + v::$ + + retractIfCan(u:MAT EXPR FLOAT):Union($,"failed") == + v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2f + v case "failed" => "failed" + (v::MAT FEXPR)::$ + + retract(u:MAT POLY INT):$ == + v : MAT FEXPR := map(retract,u)$MF2c + v::$ + + retractIfCan(u:MAT POLY INT):Union($,"failed") == + v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2c + v case "failed" => "failed" + (v::MAT FEXPR)::$ + + retract(u:MAT POLY FLOAT):$ == + v : MAT FEXPR := map(retract,u)$MF2d + v::$ + + retractIfCan(u:MAT POLY FLOAT):Union($,"failed") == + v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2d + v case "failed" => "failed" + (v::MAT FEXPR)::$ + + coerce(u:$):O == coerce(u)$Rep + + outputAsFortran(u):Void == + p := checkPrecision()$NAGLinkSupportPackage + outputAsFortran(u)$Rep + p => restorePrecision()$NAGLinkSupportPackage + +@ +\section{domain ASP24 Asp24} +\pagehead{Asp24}{ASP24} +\pagepic{ps/v103asp24.ps}{ASP24}{1.00} +<>= +)abbrev domain ASP24 Asp24 +++ Author: Mike Dewar, Grant Keady and Godfrey Nolan +++ Date Created: Mar 1993 +++ Date Last Updated: 21 March 1994 +++ 6 October 1994 +++ Related Constructors: FortranScalarFunctionCategory, FortranProgramCategory +++ Description: +++\spadtype{Asp24} produces Fortran for Type 24 ASPs which evaluate a +++multivariate function at a point (needed for NAG routine \axiomOpFrom{e04jaf}{e04Package}), for example: +++\begin{verbatim} +++ SUBROUTINE FUNCT1(N,XC,FC) +++ DOUBLE PRECISION FC,XC(N) +++ INTEGER N +++ FC=10.0D0*XC(4)**4+(-40.0D0*XC(1)*XC(4)**3)+(60.0D0*XC(1)**2+5 +++ &.0D0)*XC(4)**2+((-10.0D0*XC(3))+(-40.0D0*XC(1)**3))*XC(4)+16.0D0*X +++ &C(3)**4+(-32.0D0*XC(2)*XC(3)**3)+(24.0D0*XC(2)**2+5.0D0)*XC(3)**2+ +++ &(-8.0D0*XC(2)**3*XC(3))+XC(2)**4+100.0D0*XC(2)**2+20.0D0*XC(1)*XC( +++ &2)+10.0D0*XC(1)**4+XC(1)**2 +++ RETURN +++ END +++\end{verbatim} + +Asp24(name): Exports == Implementation where + name : Symbol + + FST ==> FortranScalarType + FT ==> FortranType + SYMTAB ==> SymbolTable + RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode)) + FSTU ==> Union(fst:FST,void:"void") + FEXPR ==> FortranExpression([],['XC],MachineFloat) + FRAC ==> Fraction + POLY ==> Polynomial + EXPR ==> Expression + INT ==> Integer + FLOAT ==> Float + + Exports ==> FortranFunctionCategory with + coerce : FEXPR -> $ + ++ coerce(f) takes an object from the appropriate instantiation of + ++ \spadtype{FortranExpression} and turns it into an ASP. + + + Implementation ==> add + + + real : FSTU := ["real"::FST]$FSTU + syms : SYMTAB := empty() + declare!(N,fortranInteger(),syms)$SYMTAB + xcType : FT := construct(real,[N::Symbol],false)$FT + declare!(XC,xcType,syms)$SYMTAB + declare!(FC,fortranReal(),syms)$SYMTAB + Rep := FortranProgram(name,["void"]$FSTU,[N,XC,FC],syms) + + coerce(c:List FortranCode):$ == coerce(c)$Rep + + coerce(r:RSFC):$ == coerce(r)$Rep + + coerce(c:FortranCode):$ == coerce(c)$Rep + + coerce(u:FEXPR):$ == + coerce(assign(FC,u::Expression(MachineFloat))$FortranCode)$Rep + + retract(u:FRAC POLY INT):$ == (retract(u)@FEXPR)::$ + retractIfCan(u:FRAC POLY INT):Union($,"failed") == + foo : Union(FEXPR,"failed") + foo := retractIfCan(u)$FEXPR + foo case "failed" => "failed" + (foo::FEXPR)::$ + + retract(u:FRAC POLY FLOAT):$ == (retract(u)@FEXPR)::$ + retractIfCan(u:FRAC POLY FLOAT):Union($,"failed") == + foo : Union(FEXPR,"failed") + foo := retractIfCan(u)$FEXPR + foo case "failed" => "failed" + (foo::FEXPR)::$ + + retract(u:EXPR FLOAT):$ == (retract(u)@FEXPR)::$ + retractIfCan(u:EXPR FLOAT):Union($,"failed") == + foo : Union(FEXPR,"failed") + foo := retractIfCan(u)$FEXPR + foo case "failed" => "failed" + (foo::FEXPR)::$ + + retract(u:EXPR INT):$ == (retract(u)@FEXPR)::$ + retractIfCan(u:EXPR INT):Union($,"failed") == + foo : Union(FEXPR,"failed") + foo := retractIfCan(u)$FEXPR + foo case "failed" => "failed" + (foo::FEXPR)::$ + + retract(u:POLY FLOAT):$ == (retract(u)@FEXPR)::$ + retractIfCan(u:POLY FLOAT):Union($,"failed") == + foo : Union(FEXPR,"failed") + foo := retractIfCan(u)$FEXPR + foo case "failed" => "failed" + (foo::FEXPR)::$ + + retract(u:POLY INT):$ == (retract(u)@FEXPR)::$ + retractIfCan(u:POLY INT):Union($,"failed") == + foo : Union(FEXPR,"failed") + foo := retractIfCan(u)$FEXPR + foo case "failed" => "failed" + (foo::FEXPR)::$ + + coerce(u:$):OutputForm == coerce(u)$Rep + + outputAsFortran(u):Void == + p := checkPrecision()$NAGLinkSupportPackage + outputAsFortran(u)$Rep + p => restorePrecision()$NAGLinkSupportPackage + +@ +\section{domain ASP27 Asp27} +\pagehead{Asp27}{ASP27} +\pagepic{ps/v103asp27.ps}{ASP27}{1.00} +<>= +)abbrev domain ASP27 Asp27 +++ Author: Mike Dewar and Godfrey Nolan +++ Date Created: Nov 1993 +++ Date Last Updated: 27 April 1994 +++ 6 October 1994 +++ Related Constructors: FortranScalarFunctionCategory, FortranProgramCategory +++ Description: +++\spadtype{Asp27} produces Fortran for Type 27 ASPs, needed for NAG routine +++\axiomOpFrom{f02fjf}{f02Package} ,for example: +++\begin{verbatim} +++ FUNCTION DOT(IFLAG,N,Z,W,RWORK,LRWORK,IWORK,LIWORK) +++ DOUBLE PRECISION W(N),Z(N),RWORK(LRWORK) +++ INTEGER N,LIWORK,IFLAG,LRWORK,IWORK(LIWORK) +++ DOT=(W(16)+(-0.5D0*W(15)))*Z(16)+((-0.5D0*W(16))+W(15)+(-0.5D0*W(1 +++ &4)))*Z(15)+((-0.5D0*W(15))+W(14)+(-0.5D0*W(13)))*Z(14)+((-0.5D0*W( +++ &14))+W(13)+(-0.5D0*W(12)))*Z(13)+((-0.5D0*W(13))+W(12)+(-0.5D0*W(1 +++ &1)))*Z(12)+((-0.5D0*W(12))+W(11)+(-0.5D0*W(10)))*Z(11)+((-0.5D0*W( +++ &11))+W(10)+(-0.5D0*W(9)))*Z(10)+((-0.5D0*W(10))+W(9)+(-0.5D0*W(8)) +++ &)*Z(9)+((-0.5D0*W(9))+W(8)+(-0.5D0*W(7)))*Z(8)+((-0.5D0*W(8))+W(7) +++ &+(-0.5D0*W(6)))*Z(7)+((-0.5D0*W(7))+W(6)+(-0.5D0*W(5)))*Z(6)+((-0. +++ &5D0*W(6))+W(5)+(-0.5D0*W(4)))*Z(5)+((-0.5D0*W(5))+W(4)+(-0.5D0*W(3 +++ &)))*Z(4)+((-0.5D0*W(4))+W(3)+(-0.5D0*W(2)))*Z(3)+((-0.5D0*W(3))+W( +++ &2)+(-0.5D0*W(1)))*Z(2)+((-0.5D0*W(2))+W(1))*Z(1) +++ RETURN +++ END +++\end{verbatim} + +Asp27(name): Exports == Implementation where + name : Symbol + + O ==> OutputForm + FST ==> FortranScalarType + FT ==> FortranType + SYMTAB ==> SymbolTable + UFST ==> Union(fst:FST,void:"void") + FC ==> FortranCode + PI ==> PositiveInteger + RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode)) + EXPR ==> Expression + MAT ==> Matrix + MFLOAT ==> MachineFloat + + + + Exports == FortranMatrixCategory + + Implementation == add + + + real : UFST := ["real"::FST]$UFST + integer : UFST := ["integer"::FST]$UFST + syms : SYMTAB := empty()$SYMTAB + declare!(IFLAG,fortranInteger(),syms)$SYMTAB + declare!(N,fortranInteger(),syms)$SYMTAB + declare!(LRWORK,fortranInteger(),syms)$SYMTAB + declare!(LIWORK,fortranInteger(),syms)$SYMTAB + zType : FT := construct(real,[N],false)$FT + declare!(Z,zType,syms)$SYMTAB + declare!(W,zType,syms)$SYMTAB + rType : FT := construct(real,[LRWORK],false)$FT + declare!(RWORK,rType,syms)$SYMTAB + iType : FT := construct(integer,[LIWORK],false)$FT + declare!(IWORK,iType,syms)$SYMTAB + Rep := FortranProgram(name,real, + [IFLAG,N,Z,W,RWORK,LRWORK,IWORK,LIWORK],syms) + + -- To help the poor old compiler! + localCoerce(u:Symbol):EXPR(MFLOAT) == coerce(u)$EXPR(MFLOAT) + + coerce (u:MAT MFLOAT):$ == + Ws: Symbol := W + Zs: Symbol := Z + code : List FC + l:EXPR MFLOAT := "+"/ _ + [("+"/[localCoerce(elt(Ws,[j::O])$Symbol) * u(j,i)_ + for j in 1..nrows(u)::PI])_ + *localCoerce(elt(Zs,[i::O])$Symbol) for i in 1..ncols(u)::PI] + c := assign(name,l)$FC + code := [c,returns()]$List(FC) + code::$ + + coerce(c:List FortranCode):$ == coerce(c)$Rep + + coerce(r:RSFC):$ == coerce(r)$Rep + + coerce(c:FortranCode):$ == coerce(c)$Rep + + coerce(u:$):OutputForm == coerce(u)$Rep + + outputAsFortran(u):Void == + p := checkPrecision()$NAGLinkSupportPackage + outputAsFortran(u)$Rep + p => restorePrecision()$NAGLinkSupportPackage + +@ +\section{domain ASP28 Asp28} +\pagehead{Asp28}{ASP28} +\pagepic{ps/v103asp28.ps}{ASP28}{1.00} +<>= +)abbrev domain ASP28 Asp28 +++ Author: Mike Dewar +++ Date Created: 21 March 1994 +++ Date Last Updated: 28 April 1994 +++ 6 October 1994 +++ Related Constructors: FortranVectorFunctionCategory, FortranProgramCategory +++ Description: +++\spadtype{Asp28} produces Fortran for Type 28 ASPs, used in NAG routine +++\axiomOpFrom{f02fjf}{f02Package}, for example: +++\begin{verbatim} +++ SUBROUTINE IMAGE(IFLAG,N,Z,W,RWORK,LRWORK,IWORK,LIWORK) +++ DOUBLE PRECISION Z(N),W(N),IWORK(LRWORK),RWORK(LRWORK) +++ INTEGER N,LIWORK,IFLAG,LRWORK +++ W(1)=0.01707454969713436D0*Z(16)+0.001747395874954051D0*Z(15)+0.00 +++ &2106973900813502D0*Z(14)+0.002957434991769087D0*Z(13)+(-0.00700554 +++ &0882865317D0*Z(12))+(-0.01219194009813166D0*Z(11))+0.0037230647365 +++ &3087D0*Z(10)+0.04932374658377151D0*Z(9)+(-0.03586220812223305D0*Z( +++ &8))+(-0.04723268012114625D0*Z(7))+(-0.02434652144032987D0*Z(6))+0. +++ &2264766947290192D0*Z(5)+(-0.1385343580686922D0*Z(4))+(-0.116530050 +++ &8238904D0*Z(3))+(-0.2803531651057233D0*Z(2))+1.019463911841327D0*Z +++ &(1) +++ W(2)=0.0227345011107737D0*Z(16)+0.008812321197398072D0*Z(15)+0.010 +++ &94012210519586D0*Z(14)+(-0.01764072463999744D0*Z(13))+(-0.01357136 +++ &72105995D0*Z(12))+0.00157466157362272D0*Z(11)+0.05258889186338282D +++ &0*Z(10)+(-0.01981532388243379D0*Z(9))+(-0.06095390688679697D0*Z(8) +++ &)+(-0.04153119955569051D0*Z(7))+0.2176561076571465D0*Z(6)+(-0.0532 +++ &5555586632358D0*Z(5))+(-0.1688977368984641D0*Z(4))+(-0.32440166056 +++ &67343D0*Z(3))+0.9128222941872173D0*Z(2)+(-0.2419652703415429D0*Z(1 +++ &)) +++ W(3)=0.03371198197190302D0*Z(16)+0.02021603150122265D0*Z(15)+(-0.0 +++ &06607305534689702D0*Z(14))+(-0.03032392238968179D0*Z(13))+0.002033 +++ &305231024948D0*Z(12)+0.05375944956767728D0*Z(11)+(-0.0163213312502 +++ &9967D0*Z(10))+(-0.05483186562035512D0*Z(9))+(-0.04901428822579872D +++ &0*Z(8))+0.2091097927887612D0*Z(7)+(-0.05760560341383113D0*Z(6))+(- +++ &0.1236679206156403D0*Z(5))+(-0.3523683853026259D0*Z(4))+0.88929961 +++ &32269974D0*Z(3)+(-0.2995429545781457D0*Z(2))+(-0.02986582812574917 +++ &D0*Z(1)) +++ W(4)=0.05141563713660119D0*Z(16)+0.005239165960779299D0*Z(15)+(-0. +++ &01623427735779699D0*Z(14))+(-0.01965809746040371D0*Z(13))+0.054688 +++ &97337339577D0*Z(12)+(-0.014224695935687D0*Z(11))+(-0.0505181779315 +++ &6355D0*Z(10))+(-0.04353074206076491D0*Z(9))+0.2012230497530726D0*Z +++ &(8)+(-0.06630874514535952D0*Z(7))+(-0.1280829963720053D0*Z(6))+(-0 +++ &.305169742604165D0*Z(5))+0.8600427128450191D0*Z(4)+(-0.32415033802 +++ &68184D0*Z(3))+(-0.09033531980693314D0*Z(2))+0.09089205517109111D0* +++ &Z(1) +++ W(5)=0.04556369767776375D0*Z(16)+(-0.001822737697581869D0*Z(15))+( +++ &-0.002512226501941856D0*Z(14))+0.02947046460707379D0*Z(13)+(-0.014 +++ &45079632086177D0*Z(12))+(-0.05034242196614937D0*Z(11))+(-0.0376966 +++ &3291725935D0*Z(10))+0.2171103102175198D0*Z(9)+(-0.0824949256021352 +++ &4D0*Z(8))+(-0.1473995209288945D0*Z(7))+(-0.315042193418466D0*Z(6)) +++ &+0.9591623347824002D0*Z(5)+(-0.3852396953763045D0*Z(4))+(-0.141718 +++ &5427288274D0*Z(3))+(-0.03423495461011043D0*Z(2))+0.319820917706851 +++ &6D0*Z(1) +++ W(6)=0.04015147277405744D0*Z(16)+0.01328585741341559D0*Z(15)+0.048 +++ &26082005465965D0*Z(14)+(-0.04319641116207706D0*Z(13))+(-0.04931323 +++ &319055762D0*Z(12))+(-0.03526886317505474D0*Z(11))+0.22295383396730 +++ &01D0*Z(10)+(-0.07375317649315155D0*Z(9))+(-0.1589391311991561D0*Z( +++ &8))+(-0.328001910890377D0*Z(7))+0.952576555482747D0*Z(6)+(-0.31583 +++ &09975786731D0*Z(5))+(-0.1846882042225383D0*Z(4))+(-0.0703762046700 +++ &4427D0*Z(3))+0.2311852964327382D0*Z(2)+0.04254083491825025D0*Z(1) +++ W(7)=0.06069778964023718D0*Z(16)+0.06681263884671322D0*Z(15)+(-0.0 +++ &2113506688615768D0*Z(14))+(-0.083996867458326D0*Z(13))+(-0.0329843 +++ &8523869648D0*Z(12))+0.2276878326327734D0*Z(11)+(-0.067356038933017 +++ &95D0*Z(10))+(-0.1559813965382218D0*Z(9))+(-0.3363262957694705D0*Z( +++ &8))+0.9442791158560948D0*Z(7)+(-0.3199955249404657D0*Z(6))+(-0.136 +++ &2463839920727D0*Z(5))+(-0.1006185171570586D0*Z(4))+0.2057504515015 +++ &423D0*Z(3)+(-0.02065879269286707D0*Z(2))+0.03160990266745513D0*Z(1 +++ &) +++ W(8)=0.126386868896738D0*Z(16)+0.002563370039476418D0*Z(15)+(-0.05 +++ &581757739455641D0*Z(14))+(-0.07777893205900685D0*Z(13))+0.23117338 +++ &45834199D0*Z(12)+(-0.06031581134427592D0*Z(11))+(-0.14805474755869 +++ &52D0*Z(10))+(-0.3364014128402243D0*Z(9))+0.9364014128402244D0*Z(8) +++ &+(-0.3269452524413048D0*Z(7))+(-0.1396841886557241D0*Z(6))+(-0.056 +++ &1733845834199D0*Z(5))+0.1777789320590069D0*Z(4)+(-0.04418242260544 +++ &359D0*Z(3))+(-0.02756337003947642D0*Z(2))+0.07361313110326199D0*Z( +++ &1) +++ W(9)=0.07361313110326199D0*Z(16)+(-0.02756337003947642D0*Z(15))+(- +++ &0.04418242260544359D0*Z(14))+0.1777789320590069D0*Z(13)+(-0.056173 +++ &3845834199D0*Z(12))+(-0.1396841886557241D0*Z(11))+(-0.326945252441 +++ &3048D0*Z(10))+0.9364014128402244D0*Z(9)+(-0.3364014128402243D0*Z(8 +++ &))+(-0.1480547475586952D0*Z(7))+(-0.06031581134427592D0*Z(6))+0.23 +++ &11733845834199D0*Z(5)+(-0.07777893205900685D0*Z(4))+(-0.0558175773 +++ &9455641D0*Z(3))+0.002563370039476418D0*Z(2)+0.126386868896738D0*Z( +++ &1) +++ W(10)=0.03160990266745513D0*Z(16)+(-0.02065879269286707D0*Z(15))+0 +++ &.2057504515015423D0*Z(14)+(-0.1006185171570586D0*Z(13))+(-0.136246 +++ &3839920727D0*Z(12))+(-0.3199955249404657D0*Z(11))+0.94427911585609 +++ &48D0*Z(10)+(-0.3363262957694705D0*Z(9))+(-0.1559813965382218D0*Z(8 +++ &))+(-0.06735603893301795D0*Z(7))+0.2276878326327734D0*Z(6)+(-0.032 +++ &98438523869648D0*Z(5))+(-0.083996867458326D0*Z(4))+(-0.02113506688 +++ &615768D0*Z(3))+0.06681263884671322D0*Z(2)+0.06069778964023718D0*Z( +++ &1) +++ W(11)=0.04254083491825025D0*Z(16)+0.2311852964327382D0*Z(15)+(-0.0 +++ &7037620467004427D0*Z(14))+(-0.1846882042225383D0*Z(13))+(-0.315830 +++ &9975786731D0*Z(12))+0.952576555482747D0*Z(11)+(-0.328001910890377D +++ &0*Z(10))+(-0.1589391311991561D0*Z(9))+(-0.07375317649315155D0*Z(8) +++ &)+0.2229538339673001D0*Z(7)+(-0.03526886317505474D0*Z(6))+(-0.0493 +++ &1323319055762D0*Z(5))+(-0.04319641116207706D0*Z(4))+0.048260820054 +++ &65965D0*Z(3)+0.01328585741341559D0*Z(2)+0.04015147277405744D0*Z(1) +++ W(12)=0.3198209177068516D0*Z(16)+(-0.03423495461011043D0*Z(15))+(- +++ &0.1417185427288274D0*Z(14))+(-0.3852396953763045D0*Z(13))+0.959162 +++ &3347824002D0*Z(12)+(-0.315042193418466D0*Z(11))+(-0.14739952092889 +++ &45D0*Z(10))+(-0.08249492560213524D0*Z(9))+0.2171103102175198D0*Z(8 +++ &)+(-0.03769663291725935D0*Z(7))+(-0.05034242196614937D0*Z(6))+(-0. +++ &01445079632086177D0*Z(5))+0.02947046460707379D0*Z(4)+(-0.002512226 +++ &501941856D0*Z(3))+(-0.001822737697581869D0*Z(2))+0.045563697677763 +++ &75D0*Z(1) +++ W(13)=0.09089205517109111D0*Z(16)+(-0.09033531980693314D0*Z(15))+( +++ &-0.3241503380268184D0*Z(14))+0.8600427128450191D0*Z(13)+(-0.305169 +++ &742604165D0*Z(12))+(-0.1280829963720053D0*Z(11))+(-0.0663087451453 +++ &5952D0*Z(10))+0.2012230497530726D0*Z(9)+(-0.04353074206076491D0*Z( +++ &8))+(-0.05051817793156355D0*Z(7))+(-0.014224695935687D0*Z(6))+0.05 +++ &468897337339577D0*Z(5)+(-0.01965809746040371D0*Z(4))+(-0.016234277 +++ &35779699D0*Z(3))+0.005239165960779299D0*Z(2)+0.05141563713660119D0 +++ &*Z(1) +++ W(14)=(-0.02986582812574917D0*Z(16))+(-0.2995429545781457D0*Z(15)) +++ &+0.8892996132269974D0*Z(14)+(-0.3523683853026259D0*Z(13))+(-0.1236 +++ &679206156403D0*Z(12))+(-0.05760560341383113D0*Z(11))+0.20910979278 +++ &87612D0*Z(10)+(-0.04901428822579872D0*Z(9))+(-0.05483186562035512D +++ &0*Z(8))+(-0.01632133125029967D0*Z(7))+0.05375944956767728D0*Z(6)+0 +++ &.002033305231024948D0*Z(5)+(-0.03032392238968179D0*Z(4))+(-0.00660 +++ &7305534689702D0*Z(3))+0.02021603150122265D0*Z(2)+0.033711981971903 +++ &02D0*Z(1) +++ W(15)=(-0.2419652703415429D0*Z(16))+0.9128222941872173D0*Z(15)+(-0 +++ &.3244016605667343D0*Z(14))+(-0.1688977368984641D0*Z(13))+(-0.05325 +++ &555586632358D0*Z(12))+0.2176561076571465D0*Z(11)+(-0.0415311995556 +++ &9051D0*Z(10))+(-0.06095390688679697D0*Z(9))+(-0.01981532388243379D +++ &0*Z(8))+0.05258889186338282D0*Z(7)+0.00157466157362272D0*Z(6)+(-0. +++ &0135713672105995D0*Z(5))+(-0.01764072463999744D0*Z(4))+0.010940122 +++ &10519586D0*Z(3)+0.008812321197398072D0*Z(2)+0.0227345011107737D0*Z +++ &(1) +++ W(16)=1.019463911841327D0*Z(16)+(-0.2803531651057233D0*Z(15))+(-0. +++ &1165300508238904D0*Z(14))+(-0.1385343580686922D0*Z(13))+0.22647669 +++ &47290192D0*Z(12)+(-0.02434652144032987D0*Z(11))+(-0.04723268012114 +++ &625D0*Z(10))+(-0.03586220812223305D0*Z(9))+0.04932374658377151D0*Z +++ &(8)+0.00372306473653087D0*Z(7)+(-0.01219194009813166D0*Z(6))+(-0.0 +++ &07005540882865317D0*Z(5))+0.002957434991769087D0*Z(4)+0.0021069739 +++ &00813502D0*Z(3)+0.001747395874954051D0*Z(2)+0.01707454969713436D0* +++ &Z(1) +++ RETURN +++ END +++\end{verbatim} + +Asp28(name): Exports == Implementation where + name : Symbol + + FST ==> FortranScalarType + FT ==> FortranType + SYMTAB ==> SymbolTable + FC ==> FortranCode + PI ==> PositiveInteger + RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode)) + EXPR ==> Expression + MFLOAT ==> MachineFloat + VEC ==> Vector + UFST ==> Union(fst:FST,void:"void") + MAT ==> Matrix + + Exports == FortranMatrixCategory + + Implementation == add + + + real : UFST := ["real"::FST]$UFST + syms : SYMTAB := empty() + declare!(IFLAG,fortranInteger(),syms)$SYMTAB + declare!(N,fortranInteger(),syms)$SYMTAB + declare!(LRWORK,fortranInteger(),syms)$SYMTAB + declare!(LIWORK,fortranInteger(),syms)$SYMTAB + xType : FT := construct(real,[N],false)$FT + declare!(Z,xType,syms)$SYMTAB + declare!(W,xType,syms)$SYMTAB + rType : FT := construct(real,[LRWORK],false)$FT + declare!(RWORK,rType,syms)$SYMTAB + iType : FT := construct(real,[LIWORK],false)$FT + declare!(IWORK,rType,syms)$SYMTAB + Rep := FortranProgram(name,["void"]$UFST, + [IFLAG,N,Z,W,RWORK,LRWORK,IWORK,LIWORK],syms) + + -- To help the poor old compiler! + localCoerce(u:Symbol):EXPR(MFLOAT) == coerce(u)$EXPR(MFLOAT) + + coerce (u:MAT MFLOAT):$ == + Zs: Symbol := Z + code : List FC + r: List EXPR MFLOAT + r := ["+"/[u(j,i)*localCoerce(elt(Zs,[i::OutputForm])$Symbol)_ + for i in 1..ncols(u)$MAT(MFLOAT)::PI]_ + for j in 1..nrows(u)$MAT(MFLOAT)::PI] + code := [assign(W@Symbol,vector(r)$VEC(EXPR MFLOAT)),returns()]$List(FC) + code::$ + + coerce(c:FortranCode):$ == coerce(c)$Rep + + coerce(r:RSFC):$ == coerce(r)$Rep + + coerce(c:List FortranCode):$ == coerce(c)$Rep + + coerce(u:$):OutputForm == coerce(u)$Rep + + outputAsFortran(u):Void == + p := checkPrecision()$NAGLinkSupportPackage + outputAsFortran(u)$Rep + p => restorePrecision()$NAGLinkSupportPackage + +@ +\section{domain ASP29 Asp29} +\pagehead{Asp29}{ASP29} +\pagepic{ps/v103asp29.ps}{ASP29}{1.00} +<>= +)abbrev domain ASP29 Asp29 +++ Author: Mike Dewar and Godfrey Nolan +++ Date Created: Nov 1993 +++ Date Last Updated: 18 March 1994 +++ Related Constructors: FortranScalarFunctionCategory, FortranProgramCategory +++ Description: +++\spadtype{Asp29} produces Fortran for Type 29 ASPs, needed for NAG routine +++\axiomOpFrom{f02fjf}{f02Package}, for example: +++\begin{verbatim} +++ SUBROUTINE MONIT(ISTATE,NEXTIT,NEVALS,NEVECS,K,F,D) +++ DOUBLE PRECISION D(K),F(K) +++ INTEGER K,NEXTIT,NEVALS,NVECS,ISTATE +++ CALL F02FJZ(ISTATE,NEXTIT,NEVALS,NEVECS,K,F,D) +++ RETURN +++ END +++\end{verbatim} + +Asp29(name): Exports == Implementation where + name : Symbol + + FST ==> FortranScalarType + FT ==> FortranType + FSTU ==> Union(fst:FST,void:"void") + SYMTAB ==> SymbolTable + FC ==> FortranCode + PI ==> PositiveInteger + EXF ==> Expression Float + EXI ==> Expression Integer + VEF ==> Vector Expression Float + VEI ==> Vector Expression Integer + MEI ==> Matrix Expression Integer + MEF ==> Matrix Expression Float + UEXPR ==> Union(I: Expression Integer,F: Expression Float,_ + CF: Expression Complex Float) + RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode)) + + Exports == FortranProgramCategory with + outputAsFortran:() -> Void + ++outputAsFortran() generates the default code for \spadtype{ASP29}. + + + Implementation == add + + import FST + import FT + import FC + import SYMTAB + + real : FSTU := ["real"::FST]$FSTU + integer : FSTU := ["integer"::FST]$FSTU + syms : SYMTAB := empty() + declare!(ISTATE,fortranInteger(),syms) + declare!(NEXTIT,fortranInteger(),syms) + declare!(NEVALS,fortranInteger(),syms) + declare!(NVECS,fortranInteger(),syms) + declare!(K,fortranInteger(),syms) + kType : FT := construct(real,[K],false)$FT + declare!(F,kType,syms) + declare!(D,kType,syms) + Rep := FortranProgram(name,["void"]$FSTU, + [ISTATE,NEXTIT,NEVALS,NEVECS,K,F,D],syms) + + + outputAsFortran():Void == + callOne := call("F02FJZ(ISTATE,NEXTIT,NEVALS,NEVECS,K,F,D)") + code : List FC := [callOne,returns()]$List(FC) + outputAsFortran(coerce(code)@Rep)$Rep + +@ +\section{domain ASP30 Asp30} +\pagehead{Asp30}{ASP30} +\pagepic{ps/v103asp30.ps}{ASP30}{1.00} +<>= +)abbrev domain ASP30 Asp30 +++ Author: Mike Dewar and Godfrey Nolan +++ Date Created: Nov 1993 +++ Date Last Updated: 28 March 1994 +++ 6 October 1994 +++ Related Constructors: FortranScalarFunctionCategory, FortranProgramCategory +++ Description: +++\spadtype{Asp30} produces Fortran for Type 30 ASPs, needed for NAG routine +++\axiomOpFrom{f04qaf}{f04Package}, for example: +++\begin{verbatim} +++ SUBROUTINE APROD(MODE,M,N,X,Y,RWORK,LRWORK,IWORK,LIWORK) +++ DOUBLE PRECISION X(N),Y(M),RWORK(LRWORK) +++ INTEGER M,N,LIWORK,IFAIL,LRWORK,IWORK(LIWORK),MODE +++ DOUBLE PRECISION A(5,5) +++ EXTERNAL F06PAF +++ A(1,1)=1.0D0 +++ A(1,2)=0.0D0 +++ A(1,3)=0.0D0 +++ A(1,4)=-1.0D0 +++ A(1,5)=0.0D0 +++ A(2,1)=0.0D0 +++ A(2,2)=1.0D0 +++ A(2,3)=0.0D0 +++ A(2,4)=0.0D0 +++ A(2,5)=-1.0D0 +++ A(3,1)=0.0D0 +++ A(3,2)=0.0D0 +++ A(3,3)=1.0D0 +++ A(3,4)=-1.0D0 +++ A(3,5)=0.0D0 +++ A(4,1)=-1.0D0 +++ A(4,2)=0.0D0 +++ A(4,3)=-1.0D0 +++ A(4,4)=4.0D0 +++ A(4,5)=-1.0D0 +++ A(5,1)=0.0D0 +++ A(5,2)=-1.0D0 +++ A(5,3)=0.0D0 +++ A(5,4)=-1.0D0 +++ A(5,5)=4.0D0 +++ IF(MODE.EQ.1)THEN +++ CALL F06PAF('N',M,N,1.0D0,A,M,X,1,1.0D0,Y,1) +++ ELSEIF(MODE.EQ.2)THEN +++ CALL F06PAF('T',M,N,1.0D0,A,M,Y,1,1.0D0,X,1) +++ ENDIF +++ RETURN +++ END +++\end{verbatim} + +Asp30(name): Exports == Implementation where + name : Symbol + + FST ==> FortranScalarType + FT ==> FortranType + SYMTAB ==> SymbolTable + FC ==> FortranCode + PI ==> PositiveInteger + RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode)) + UFST ==> Union(fst:FST,void:"void") + MAT ==> Matrix + MFLOAT ==> MachineFloat + EXI ==> Expression Integer + UEXPR ==> Union(I:Expression Integer,F:Expression Float,_ + CF:Expression Complex Float,switch:Switch) + S ==> Symbol + + Exports == FortranMatrixCategory + + Implementation == add + + import FC + import FT + import Switch + + real : UFST := ["real"::FST]$UFST + integer : UFST := ["integer"::FST]$UFST + syms : SYMTAB := empty()$SYMTAB + declare!(MODE,fortranInteger()$FT,syms)$SYMTAB + declare!(M,fortranInteger()$FT,syms)$SYMTAB + declare!(N,fortranInteger()$FT,syms)$SYMTAB + declare!(LRWORK,fortranInteger()$FT,syms)$SYMTAB + declare!(LIWORK,fortranInteger()$FT,syms)$SYMTAB + xType : FT := construct(real,[N],false)$FT + declare!(X,xType,syms)$SYMTAB + yType : FT := construct(real,[M],false)$FT + declare!(Y,yType,syms)$SYMTAB + rType : FT := construct(real,[LRWORK],false)$FT + declare!(RWORK,rType,syms)$SYMTAB + iType : FT := construct(integer,[LIWORK],false)$FT + declare!(IWORK,iType,syms)$SYMTAB + declare!(IFAIL,fortranInteger()$FT,syms)$SYMTAB + Rep := FortranProgram(name,["void"]$UFST, + [MODE,M,N,X,Y,RWORK,LRWORK,IWORK,LIWORK],syms) + + coerce(a:MAT MFLOAT):$ == + locals : SYMTAB := empty() + numRows := nrows(a) :: Polynomial Integer + numCols := ncols(a) :: Polynomial Integer + declare!(A,[real,[numRows,numCols],false]$FT,locals) + declare!(F06PAF@S,construct(["void"]$UFST,[]@List(S),true)$FT,locals) + ptA:UEXPR := [("MODE"::S)::EXI] + ptB:UEXPR := [1::EXI] + ptC:UEXPR := [2::EXI] + sw1 : Switch := EQ(ptA,ptB)$Switch + sw2 : Switch := EQ(ptA,ptC)$Switch + callOne := call("F06PAF('N',M,N,1.0D0,A,M,X,1,1.0D0,Y,1)") + callTwo := call("F06PAF('T',M,N,1.0D0,A,M,Y,1,1.0D0,X,1)") + c : FC := cond(sw1,callOne,cond(sw2,callTwo)) + code : List FC := [assign(A,a),c,returns()] + ([locals,code]$RSFC)::$ + + coerce(c:List FortranCode):$ == coerce(c)$Rep + + coerce(r:RSFC):$ == coerce(r)$Rep + + coerce(c:FortranCode):$ == coerce(c)$Rep + + coerce(u:$):OutputForm == coerce(u)$Rep + + outputAsFortran(u):Void == + p := checkPrecision()$NAGLinkSupportPackage + outputAsFortran(u)$Rep + p => restorePrecision()$NAGLinkSupportPackage + +@ +\section{domain ASP31 Asp31} +\pagehead{Asp31}{ASP31} +\pagepic{ps/v103asp31.ps}{ASP31}{1.00} +<>= +)abbrev domain ASP31 Asp31 +++ Author: Mike Dewar, Grant Keady and Godfrey Nolan +++ Date Created: Mar 1993 +++ Date Last Updated: 22 March 1994 +++ 6 October 1994 +++ Related Constructors: FortranMatrixFunctionCategory, FortranProgramCategory +++ Description: +++\spadtype{Asp31} produces Fortran for Type 31 ASPs, needed for NAG routine +++\axiomOpFrom{d02ejf}{d02Package}, for example: +++\begin{verbatim} +++ SUBROUTINE PEDERV(X,Y,PW) +++ DOUBLE PRECISION X,Y(*) +++ DOUBLE PRECISION PW(3,3) +++ PW(1,1)=-0.03999999999999999D0 +++ PW(1,2)=10000.0D0*Y(3) +++ PW(1,3)=10000.0D0*Y(2) +++ PW(2,1)=0.03999999999999999D0 +++ PW(2,2)=(-10000.0D0*Y(3))+(-60000000.0D0*Y(2)) +++ PW(2,3)=-10000.0D0*Y(2) +++ PW(3,1)=0.0D0 +++ PW(3,2)=60000000.0D0*Y(2) +++ PW(3,3)=0.0D0 +++ RETURN +++ END +++\end{verbatim} + +Asp31(name): Exports == Implementation where + name : Symbol + + O ==> OutputForm + FST ==> FortranScalarType + UFST ==> Union(fst:FST,void:"void") + MFLOAT ==> MachineFloat + FEXPR ==> FortranExpression(['X],['Y],MFLOAT) + FT ==> FortranType + FC ==> FortranCode + SYMTAB ==> SymbolTable + RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode)) + FRAC ==> Fraction + POLY ==> Polynomial + EXPR ==> Expression + INT ==> Integer + FLOAT ==> Float + VEC ==> Vector + MAT ==> Matrix + VF2 ==> VectorFunctions2 + MF2 ==> MatrixCategoryFunctions2(FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR, + EXPR MFLOAT,VEC EXPR MFLOAT,VEC EXPR MFLOAT,MAT EXPR MFLOAT) + + + + Exports ==> FortranVectorFunctionCategory with + coerce : VEC FEXPR -> $ + ++coerce(f) takes objects from the appropriate instantiation of + ++\spadtype{FortranExpression} and turns them into an ASP. + + Implementation ==> add + + + real : UFST := ["real"::FST]$UFST + syms : SYMTAB := empty() + declare!(X,fortranReal(),syms)$SYMTAB + yType : FT := construct(real,["*"::Symbol],false)$FT + declare!(Y,yType,syms)$SYMTAB + Rep := FortranProgram(name,["void"]$UFST,[X,Y,PW],syms) + + -- To help the poor old compiler! + fexpr2expr(u:FEXPR):EXPR MFLOAT == coerce(u)$FEXPR + + localAssign(s:Symbol,j:MAT FEXPR):FC == + j' : MAT EXPR MFLOAT := map(fexpr2expr,j)$MF2 + assign(s,j')$FC + + makeXList(n:Integer):List(Symbol) == + j:Integer + y:Symbol := Y::Symbol + p:List(Symbol) := [] + for j in 1 .. n repeat p:= cons(subscript(y,[j::OutputForm])$Symbol,p) + p:= reverse(p) + + coerce(u:VEC FEXPR):$ == + dimension := #u::Polynomial Integer + locals : SYMTAB := empty() + declare!(PW,[real,[dimension,dimension],false]$FT,locals)$SYMTAB + n:Integer := maxIndex(u)$VEC(FEXPR) + p:List(Symbol) := makeXList(n) + jac: MAT FEXPR := jacobian(u,p)$MultiVariableCalculusFunctions(_ + Symbol,FEXPR ,VEC FEXPR,List(Symbol)) + code : List FC := [localAssign(PW,jac),returns()$FC]$List(FC) + ([locals,code]$RSFC)::$ + + retract(u:VEC FRAC POLY INT):$ == + v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY INT,FEXPR) + v::$ + + retractIfCan(u:VEC FRAC POLY INT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY INT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + retract(u:VEC FRAC POLY FLOAT):$ == + v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY FLOAT,FEXPR) + v::$ + + retractIfCan(u:VEC FRAC POLY FLOAT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + retract(u:VEC EXPR INT):$ == + v : VEC FEXPR := map(retract,u)$VF2(EXPR INT,FEXPR) + v::$ + + retractIfCan(u:VEC EXPR INT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR INT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + retract(u:VEC EXPR FLOAT):$ == + v : VEC FEXPR := map(retract,u)$VF2(EXPR FLOAT,FEXPR) + v::$ + + retractIfCan(u:VEC EXPR FLOAT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR FLOAT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + retract(u:VEC POLY INT):$ == + v : VEC FEXPR := map(retract,u)$VF2(POLY INT,FEXPR) + v::$ + + retractIfCan(u:VEC POLY INT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY INT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + retract(u:VEC POLY FLOAT):$ == + v : VEC FEXPR := map(retract,u)$VF2(POLY FLOAT,FEXPR) + v::$ + + retractIfCan(u:VEC POLY FLOAT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY FLOAT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + coerce(c:List FC):$ == coerce(c)$Rep + + coerce(r:RSFC):$ == coerce(r)$Rep + + coerce(c:FC):$ == coerce(c)$Rep + + coerce(u:$):O == coerce(u)$Rep + + outputAsFortran(u):Void == + p := checkPrecision()$NAGLinkSupportPackage + outputAsFortran(u)$Rep + p => restorePrecision()$NAGLinkSupportPackage + +@ +\section{domain ASP33 Asp33} +\pagehead{Asp33}{ASP33} +\pagepic{ps/v103asp33.ps}{ASP33}{1.00} +<>= +)abbrev domain ASP33 Asp33 +++ Author: Mike Dewar and Godfrey Nolan +++ Date Created: Nov 1993 +++ Date Last Updated: 30 March 1994 +++ Related Constructors: FortranScalarFunctionCategory, FortranProgramCategory. +++ Description: +++\spadtype{Asp33} produces Fortran for Type 33 ASPs, needed for NAG routine +++\axiomOpFrom{d02kef}{d02Package}. The code is a dummy ASP: +++\begin{verbatim} +++ SUBROUTINE REPORT(X,V,JINT) +++ DOUBLE PRECISION V(3),X +++ INTEGER JINT +++ RETURN +++ END +++\end{verbatim} + +Asp33(name): Exports == Implementation where + name : Symbol + + FST ==> FortranScalarType + UFST ==> Union(fst:FST,void:"void") + FT ==> FortranType + SYMTAB ==> SymbolTable + FC ==> FortranCode + RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode)) + + Exports ==> FortranProgramCategory with + outputAsFortran:() -> Void + ++outputAsFortran() generates the default code for \spadtype{ASP33}. + + + Implementation ==> add + + real : UFST := ["real"::FST]$UFST + syms : SYMTAB := empty() + declare!(JINT,fortranInteger(),syms)$SYMTAB + declare!(X,fortranReal(),syms)$SYMTAB + vType : FT := construct(real,["3"::Symbol],false)$FT + declare!(V,vType,syms)$SYMTAB + Rep := FortranProgram(name,["void"]$UFST,[X,V,JINT],syms) + + outputAsFortran():Void == + outputAsFortran( (returns()$FortranCode)::Rep )$Rep + + outputAsFortran(u):Void == outputAsFortran(u)$Rep + + coerce(u:$):OutputForm == coerce(u)$Rep + +@ +\section{domain ASP34 Asp34} +\pagehead{Asp34}{ASP34} +\pagepic{ps/v103asp34.ps}{ASP34}{1.00} +<>= +)abbrev domain ASP34 Asp34 +++ Author: Mike Dewar and Godfrey Nolan +++ Date Created: Nov 1993 +++ Date Last Updated: 14 June 1994 (Themos Tsikas) +++ 6 October 1994 +++ Related Constructors: FortranScalarFunctionCategory, FortranProgramCategory +++ Description: +++\spadtype{Asp34} produces Fortran for Type 34 ASPs, needed for NAG routine +++\axiomOpFrom{f04mbf}{f04Package}, for example: +++\begin{verbatim} +++ SUBROUTINE MSOLVE(IFLAG,N,X,Y,RWORK,LRWORK,IWORK,LIWORK) +++ DOUBLE PRECISION RWORK(LRWORK),X(N),Y(N) +++ INTEGER I,J,N,LIWORK,IFLAG,LRWORK,IWORK(LIWORK) +++ DOUBLE PRECISION W1(3),W2(3),MS(3,3) +++ IFLAG=-1 +++ MS(1,1)=2.0D0 +++ MS(1,2)=1.0D0 +++ MS(1,3)=0.0D0 +++ MS(2,1)=1.0D0 +++ MS(2,2)=2.0D0 +++ MS(2,3)=1.0D0 +++ MS(3,1)=0.0D0 +++ MS(3,2)=1.0D0 +++ MS(3,3)=2.0D0 +++ CALL F04ASF(MS,N,X,N,Y,W1,W2,IFLAG) +++ IFLAG=-IFLAG +++ RETURN +++ END +++\end{verbatim} + +Asp34(name): Exports == Implementation where + name : Symbol + + FST ==> FortranScalarType + FT ==> FortranType + UFST ==> Union(fst:FST,void:"void") + SYMTAB ==> SymbolTable + FC ==> FortranCode + PI ==> PositiveInteger + EXI ==> Expression Integer + RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode)) + + Exports == FortranMatrixCategory + + Implementation == add + + real : UFST := ["real"::FST]$UFST + integer : UFST := ["integer"::FST]$UFST + syms : SYMTAB := empty()$SYMTAB + declare!(IFLAG,fortranInteger(),syms)$SYMTAB + declare!(N,fortranInteger(),syms)$SYMTAB + xType : FT := construct(real,[N],false)$FT + declare!(X,xType,syms)$SYMTAB + declare!(Y,xType,syms)$SYMTAB + declare!(LRWORK,fortranInteger(),syms)$SYMTAB + declare!(LIWORK,fortranInteger(),syms)$SYMTAB + rType : FT := construct(real,[LRWORK],false)$FT + declare!(RWORK,rType,syms)$SYMTAB + iType : FT := construct(integer,[LIWORK],false)$FT + declare!(IWORK,iType,syms)$SYMTAB + Rep := FortranProgram(name,["void"]$UFST, + [IFLAG,N,X,Y,RWORK,LRWORK,IWORK,LIWORK],syms) + + -- To help the poor old compiler + localAssign(s:Symbol,u:EXI):FC == assign(s,u)$FC + + coerce(u:Matrix MachineFloat):$ == + dimension := nrows(u) ::Polynomial Integer + locals : SYMTAB := empty()$SYMTAB + declare!(I,fortranInteger(),syms)$SYMTAB + declare!(J,fortranInteger(),syms)$SYMTAB + declare!(W1,[real,[dimension],false]$FT,locals)$SYMTAB + declare!(W2,[real,[dimension],false]$FT,locals)$SYMTAB + declare!(MS,[real,[dimension,dimension],false]$FT,locals)$SYMTAB + assign1 : FC := localAssign(IFLAG@Symbol,(-1)@EXI) + call : FC := call("F04ASF(MS,N,X,N,Y,W1,W2,IFLAG)")$FC + assign2 : FC := localAssign(IFLAG::Symbol,-(IFLAG@Symbol::EXI)) + assign3 : FC := assign(MS,u)$FC + code : List FC := [assign1,assign3,call,assign2,returns()]$List(FC) + ([locals,code]$RSFC)::$ + + coerce(c:List FortranCode):$ == coerce(c)$Rep + + coerce(r:RSFC):$ == coerce(r)$Rep + + coerce(c:FortranCode):$ == coerce(c)$Rep + + coerce(u:$):OutputForm == coerce(u)$Rep + + outputAsFortran(u):Void == + p := checkPrecision()$NAGLinkSupportPackage + outputAsFortran(u)$Rep + p => restorePrecision()$NAGLinkSupportPackage + +@ +\section{domain ASP35 Asp35} +\pagehead{Asp35}{ASP35} +\pagepic{ps/v103asp35.ps}{ASP35}{1.00} +<>= +)abbrev domain ASP35 Asp35 +++ Author: Mike Dewar, Godfrey Nolan, Grant Keady +++ Date Created: Mar 1993 +++ Date Last Updated: 22 March 1994 +++ 6 October 1994 +++ Related Constructors: FortranVectorFunctionCategory, FortranProgramCategory +++ Description: +++\spadtype{Asp35} produces Fortran for Type 35 ASPs, needed for NAG routines +++\axiomOpFrom{c05pbf}{c05Package}, \axiomOpFrom{c05pcf}{c05Package}, for example: +++\begin{verbatim} +++ SUBROUTINE FCN(N,X,FVEC,FJAC,LDFJAC,IFLAG) +++ DOUBLE PRECISION X(N),FVEC(N),FJAC(LDFJAC,N) +++ INTEGER LDFJAC,N,IFLAG +++ IF(IFLAG.EQ.1)THEN +++ FVEC(1)=(-1.0D0*X(2))+X(1) +++ FVEC(2)=(-1.0D0*X(3))+2.0D0*X(2) +++ FVEC(3)=3.0D0*X(3) +++ ELSEIF(IFLAG.EQ.2)THEN +++ FJAC(1,1)=1.0D0 +++ FJAC(1,2)=-1.0D0 +++ FJAC(1,3)=0.0D0 +++ FJAC(2,1)=0.0D0 +++ FJAC(2,2)=2.0D0 +++ FJAC(2,3)=-1.0D0 +++ FJAC(3,1)=0.0D0 +++ FJAC(3,2)=0.0D0 +++ FJAC(3,3)=3.0D0 +++ ENDIF +++ END +++\end{verbatim} + +Asp35(name): Exports == Implementation where + name : Symbol + + FST ==> FortranScalarType + FT ==> FortranType + UFST ==> Union(fst:FST,void:"void") + SYMTAB ==> SymbolTable + FC ==> FortranCode + PI ==> PositiveInteger + RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode)) + FRAC ==> Fraction + POLY ==> Polynomial + EXPR ==> Expression + INT ==> Integer + FLOAT ==> Float + VEC ==> Vector + MAT ==> Matrix + VF2 ==> VectorFunctions2 + MFLOAT ==> MachineFloat + FEXPR ==> FortranExpression([],['X],MFLOAT) + MF2 ==> MatrixCategoryFunctions2(FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR, + EXPR MFLOAT,VEC EXPR MFLOAT,VEC EXPR MFLOAT,MAT EXPR MFLOAT) + SWU ==> Union(I:Expression Integer,F:Expression Float, + CF:Expression Complex Float,switch:Switch) + + Exports ==> FortranVectorFunctionCategory with + coerce : VEC FEXPR -> $ + ++coerce(f) takes objects from the appropriate instantiation of + ++\spadtype{FortranExpression} and turns them into an ASP. + + Implementation ==> add + + real : UFST := ["real"::FST]$UFST + syms : SYMTAB := empty()$SYMTAB + declare!(N,fortranInteger(),syms)$SYMTAB + xType : FT := construct(real,[N],false)$FT + declare!(X,xType,syms)$SYMTAB + declare!(FVEC,xType,syms)$SYMTAB + declare!(LDFJAC,fortranInteger(),syms)$SYMTAB + jType : FT := construct(real,[LDFJAC,N],false)$FT + declare!(FJAC,jType,syms)$SYMTAB + declare!(IFLAG,fortranInteger(),syms)$SYMTAB + Rep := FortranProgram(name,["void"]$UFST,[N,X,FVEC,FJAC,LDFJAC,IFLAG],syms) + + coerce(u:$):OutputForm == coerce(u)$Rep + + makeXList(n:Integer):List(Symbol) == + x:Symbol := X::Symbol + [subscript(x,[j::OutputForm])$Symbol for j in 1..n] + + fexpr2expr(u:FEXPR):EXPR MFLOAT == coerce(u)$FEXPR + + localAssign1(s:Symbol,j:MAT FEXPR):FC == + j' : MAT EXPR MFLOAT := map(fexpr2expr,j)$MF2 + assign(s,j')$FC + + localAssign2(s:Symbol,j:VEC FEXPR):FC == + j' : VEC EXPR MFLOAT := map(fexpr2expr,j)$VF2(FEXPR,EXPR MFLOAT) + assign(s,j')$FC + + coerce(u:VEC FEXPR):$ == + n:Integer := maxIndex(u) + p:List(Symbol) := makeXList(n) + jac: MAT FEXPR := jacobian(u,p)$MultiVariableCalculusFunctions(_ + Symbol,FEXPR,VEC FEXPR,List(Symbol)) + assf:FC := localAssign2(FVEC,u) + assj:FC := localAssign1(FJAC,jac) + iflag:SWU := [IFLAG@Symbol::EXPR(INT)]$SWU + sw1:Switch := EQ(iflag,[1::EXPR(INT)]$SWU) + sw2:Switch := EQ(iflag,[2::EXPR(INT)]$SWU) + cond(sw1,assf,cond(sw2,assj)$FC)$FC::$ + + coerce(c:List FC):$ == coerce(c)$Rep + + coerce(r:RSFC):$ == coerce(r)$Rep + + coerce(c:FC):$ == coerce(c)$Rep + + outputAsFortran(u):Void == + p := checkPrecision()$NAGLinkSupportPackage + outputAsFortran(u)$Rep + p => restorePrecision()$NAGLinkSupportPackage + + retract(u:VEC FRAC POLY INT):$ == + v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY INT,FEXPR) + v::$ + + retractIfCan(u:VEC FRAC POLY INT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY INT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + retract(u:VEC FRAC POLY FLOAT):$ == + v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY FLOAT,FEXPR) + v::$ + + retractIfCan(u:VEC FRAC POLY FLOAT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + retract(u:VEC EXPR INT):$ == + v : VEC FEXPR := map(retract,u)$VF2(EXPR INT,FEXPR) + v::$ + + retractIfCan(u:VEC EXPR INT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR INT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + retract(u:VEC EXPR FLOAT):$ == + v : VEC FEXPR := map(retract,u)$VF2(EXPR FLOAT,FEXPR) + v::$ + + retractIfCan(u:VEC EXPR FLOAT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR FLOAT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + retract(u:VEC POLY INT):$ == + v : VEC FEXPR := map(retract,u)$VF2(POLY INT,FEXPR) + v::$ + + retractIfCan(u:VEC POLY INT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY INT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + retract(u:VEC POLY FLOAT):$ == + v : VEC FEXPR := map(retract,u)$VF2(POLY FLOAT,FEXPR) + v::$ + + retractIfCan(u:VEC POLY FLOAT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY FLOAT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + +@ +\section{domain ASP4 Asp4} +\pagehead{Asp4}{ASP4} +\pagepic{ps/v103asp4.ps}{ASP4}{1.00} +<>= +)abbrev domain ASP4 Asp4 +++ Author: Mike Dewar, Grant Keady and Godfrey Nolan +++ Date Created: Mar 1993 +++ Date Last Updated: 18 March 1994 +++ 6 October 1994 +++ Related Constructors: FortranScalarFunctionCategory, FortranProgramCategory +++ Description: +++\spadtype{Asp4} produces Fortran for Type 4 ASPs, which take an expression +++in X(1) .. X(NDIM) and produce a real function of the form: +++\begin{verbatim} +++ DOUBLE PRECISION FUNCTION FUNCTN(NDIM,X) +++ DOUBLE PRECISION X(NDIM) +++ INTEGER NDIM +++ FUNCTN=(4.0D0*X(1)*X(3)**2*DEXP(2.0D0*X(1)*X(3)))/(X(4)**2+(2.0D0* +++ &X(2)+2.0D0)*X(4)+X(2)**2+2.0D0*X(2)+1.0D0) +++ RETURN +++ END +++\end{verbatim} + +Asp4(name): Exports == Implementation where + name : Symbol + + FEXPR ==> FortranExpression([],['X],MachineFloat) + FST ==> FortranScalarType + FT ==> FortranType + SYMTAB ==> SymbolTable + RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode)) + FSTU ==> Union(fst:FST,void:"void") + FRAC ==> Fraction + POLY ==> Polynomial + EXPR ==> Expression + INT ==> Integer + FLOAT ==> Float + + Exports ==> FortranFunctionCategory with + coerce : FEXPR -> $ + ++coerce(f) takes an object from the appropriate instantiation of + ++\spadtype{FortranExpression} and turns it into an ASP. + + Implementation ==> add + + real : FSTU := ["real"::FST]$FSTU + syms : SYMTAB := empty()$SYMTAB + declare!(NDIM,fortranInteger(),syms)$SYMTAB + xType : FT := construct(real,[NDIM],false)$FT + declare!(X,xType,syms)$SYMTAB + Rep := FortranProgram(name,real,[NDIM,X],syms) + + retract(u:FRAC POLY INT):$ == (retract(u)@FEXPR)::$ + retractIfCan(u:FRAC POLY INT):Union($,"failed") == + foo : Union(FEXPR,"failed") + foo := retractIfCan(u)$FEXPR + foo case "failed" => "failed" + foo::FEXPR::$ + + retract(u:FRAC POLY FLOAT):$ == (retract(u)@FEXPR)::$ + retractIfCan(u:FRAC POLY FLOAT):Union($,"failed") == + foo : Union(FEXPR,"failed") + foo := retractIfCan(u)$FEXPR + foo case "failed" => "failed" + foo::FEXPR::$ + + retract(u:EXPR FLOAT):$ == (retract(u)@FEXPR)::$ + retractIfCan(u:EXPR FLOAT):Union($,"failed") == + foo : Union(FEXPR,"failed") + foo := retractIfCan(u)$FEXPR + foo case "failed" => "failed" + foo::FEXPR::$ + + retract(u:EXPR INT):$ == (retract(u)@FEXPR)::$ + retractIfCan(u:EXPR INT):Union($,"failed") == + foo : Union(FEXPR,"failed") + foo := retractIfCan(u)$FEXPR + foo case "failed" => "failed" + foo::FEXPR::$ + + retract(u:POLY FLOAT):$ == (retract(u)@FEXPR)::$ + retractIfCan(u:POLY FLOAT):Union($,"failed") == + foo : Union(FEXPR,"failed") + foo := retractIfCan(u)$FEXPR + foo case "failed" => "failed" + foo::FEXPR::$ + + retract(u:POLY INT):$ == (retract(u)@FEXPR)::$ + retractIfCan(u:POLY INT):Union($,"failed") == + foo : Union(FEXPR,"failed") + foo := retractIfCan(u)$FEXPR + foo case "failed" => "failed" + foo::FEXPR::$ + + coerce(u:FEXPR):$ == + coerce((u::Expression(MachineFloat))$FEXPR)$Rep + + coerce(c:List FortranCode):$ == coerce(c)$Rep + + coerce(r:RSFC):$ == coerce(r)$Rep + + coerce(c:FortranCode):$ == coerce(c)$Rep + + coerce(u:$):OutputForm == coerce(u)$Rep + + outputAsFortran(u):Void == + p := checkPrecision()$NAGLinkSupportPackage + outputAsFortran(u)$Rep + p => restorePrecision()$NAGLinkSupportPackage + +@ +\section{domain ASP41 Asp41} +\pagehead{Asp41}{ASP41} +\pagepic{ps/v103asp41.ps}{ASP41}{1.00} +<>= +)abbrev domain ASP41 Asp41 +++ Author: Mike Dewar, Godfrey Nolan +++ Date Created: +++ Date Last Updated: 29 March 1994 +++ 6 October 1994 +++ Related Constructors: FortranFunctionCategory, FortranProgramCategory. +++ Description: +++\spadtype{Asp41} produces Fortran for Type 41 ASPs, needed for NAG +++routines \axiomOpFrom{d02raf}{d02Package} and \axiomOpFrom{d02saf}{d02Package} +++in particular. These ASPs are in fact +++three Fortran routines which return a vector of functions, and their +++derivatives wrt Y(i) and also a continuation parameter EPS, for example: +++\begin{verbatim} +++ SUBROUTINE FCN(X,EPS,Y,F,N) +++ DOUBLE PRECISION EPS,F(N),X,Y(N) +++ INTEGER N +++ F(1)=Y(2) +++ F(2)=Y(3) +++ F(3)=(-1.0D0*Y(1)*Y(3))+2.0D0*EPS*Y(2)**2+(-2.0D0*EPS) +++ RETURN +++ END +++ SUBROUTINE JACOBF(X,EPS,Y,F,N) +++ DOUBLE PRECISION EPS,F(N,N),X,Y(N) +++ INTEGER N +++ F(1,1)=0.0D0 +++ F(1,2)=1.0D0 +++ F(1,3)=0.0D0 +++ F(2,1)=0.0D0 +++ F(2,2)=0.0D0 +++ F(2,3)=1.0D0 +++ F(3,1)=-1.0D0*Y(3) +++ F(3,2)=4.0D0*EPS*Y(2) +++ F(3,3)=-1.0D0*Y(1) +++ RETURN +++ END +++ SUBROUTINE JACEPS(X,EPS,Y,F,N) +++ DOUBLE PRECISION EPS,F(N),X,Y(N) +++ INTEGER N +++ F(1)=0.0D0 +++ F(2)=0.0D0 +++ F(3)=2.0D0*Y(2)**2-2.0D0 +++ RETURN +++ END +++\end{verbatim} + +Asp41(nameOne,nameTwo,nameThree): Exports == Implementation where + nameOne : Symbol + nameTwo : Symbol + nameThree : Symbol + + D ==> differentiate + FST ==> FortranScalarType + UFST ==> Union(fst:FST,void:"void") + FT ==> FortranType + FC ==> FortranCode + SYMTAB ==> SymbolTable + RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode)) + FRAC ==> Fraction + POLY ==> Polynomial + EXPR ==> Expression + INT ==> Integer + FLOAT ==> Float + VEC ==> Vector + VF2 ==> VectorFunctions2 + MFLOAT ==> MachineFloat + FEXPR ==> FortranExpression(['X,'EPS],['Y],MFLOAT) + S ==> Symbol + MF2 ==> MatrixCategoryFunctions2(FEXPR,VEC FEXPR,VEC FEXPR,Matrix FEXPR, + EXPR MFLOAT,VEC EXPR MFLOAT,VEC EXPR MFLOAT,Matrix EXPR MFLOAT) + + Exports ==> FortranVectorFunctionCategory with + coerce : VEC FEXPR -> $ + ++coerce(f) takes objects from the appropriate instantiation of + ++\spadtype{FortranExpression} and turns them into an ASP. + + Implementation ==> add + real : UFST := ["real"::FST]$UFST + + symOne : SYMTAB := empty()$SYMTAB + declare!(N,fortranInteger(),symOne)$SYMTAB + declare!(X,fortranReal(),symOne)$SYMTAB + declare!(EPS,fortranReal(),symOne)$SYMTAB + yType : FT := construct(real,[N],false)$FT + declare!(Y,yType,symOne)$SYMTAB + declare!(F,yType,symOne)$SYMTAB + + symTwo : SYMTAB := empty()$SYMTAB + declare!(N,fortranInteger(),symTwo)$SYMTAB + declare!(X,fortranReal(),symTwo)$SYMTAB + declare!(EPS,fortranReal(),symTwo)$SYMTAB + declare!(Y,yType,symTwo)$SYMTAB + fType : FT := construct(real,[N,N],false)$FT + declare!(F,fType,symTwo)$SYMTAB + + symThree : SYMTAB := empty()$SYMTAB + declare!(N,fortranInteger(),symThree)$SYMTAB + declare!(X,fortranReal(),symThree)$SYMTAB + declare!(EPS,fortranReal(),symThree)$SYMTAB + declare!(Y,yType,symThree)$SYMTAB + declare!(F,yType,symThree)$SYMTAB + + R1:=FortranProgram(nameOne,["void"]$UFST,[X,EPS,Y,F,N],symOne) + R2:=FortranProgram(nameTwo,["void"]$UFST,[X,EPS,Y,F,N],symTwo) + R3:=FortranProgram(nameThree,["void"]$UFST,[X,EPS,Y,F,N],symThree) + Rep := Record(f:R1,fJacob:R2,eJacob:R3) + Fsym:Symbol:=coerce "F" + + fexpr2expr(u:FEXPR):EXPR MFLOAT == coerce(u)$FEXPR + + localAssign1(s:S,j:Matrix FEXPR):FC == + j' : Matrix EXPR MFLOAT := map(fexpr2expr,j)$MF2 + assign(s,j')$FC + + localAssign2(s:S,j:VEC FEXPR):FC == + j' : VEC EXPR MFLOAT := map(fexpr2expr,j)$VF2(FEXPR,EXPR MFLOAT) + assign(s,j')$FC + + makeCodeOne(u:VEC FEXPR):FortranCode == + -- simple assign + localAssign2(Fsym,u) + + makeCodeThree(u:VEC FEXPR):FortranCode == + -- compute jacobian wrt to eps + jacEps:VEC FEXPR := [D(v,EPS) for v in entries(u)]$VEC(FEXPR) + makeCodeOne(jacEps) + + makeYList(n:Integer):List(Symbol) == + j:Integer + y:Symbol := Y::Symbol + p:List(Symbol) := [] + [subscript(y,[j::OutputForm])$Symbol for j in 1..n] + + makeCodeTwo(u:VEC FEXPR):FortranCode == + -- compute jacobian wrt to f + n:Integer := maxIndex(u)$VEC(FEXPR) + p:List(Symbol) := makeYList(n) + jac:Matrix(FEXPR) := _ + jacobian(u,p)$MultiVariableCalculusFunctions(S,FEXPR,VEC FEXPR,List(S)) + localAssign1(Fsym,jac) + + coerce(u:VEC FEXPR):$ == + aF:FortranCode := makeCodeOne(u) + bF:FortranCode := makeCodeTwo(u) + cF:FortranCode := makeCodeThree(u) + -- add returns() to complete subroutines + aLF:List(FortranCode) := [aF,returns()$FortranCode]$List(FortranCode) + bLF:List(FortranCode) := [bF,returns()$FortranCode]$List(FortranCode) + cLF:List(FortranCode) := [cF,returns()$FortranCode]$List(FortranCode) + [coerce(aLF)$R1,coerce(bLF)$R2,coerce(cLF)$R3] + + coerce(u:$):OutputForm == + bracket commaSeparate + [nameOne::OutputForm,nameTwo::OutputForm,nameThree::OutputForm] + + outputAsFortran(u:$):Void == + p := checkPrecision()$NAGLinkSupportPackage + outputAsFortran elt(u,f)$Rep + outputAsFortran elt(u,fJacob)$Rep + outputAsFortran elt(u,eJacob)$Rep + p => restorePrecision()$NAGLinkSupportPackage + + retract(u:VEC FRAC POLY INT):$ == + v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY INT,FEXPR) + v::$ + + retractIfCan(u:VEC FRAC POLY INT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY INT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + retract(u:VEC FRAC POLY FLOAT):$ == + v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY FLOAT,FEXPR) + v::$ + + retractIfCan(u:VEC FRAC POLY FLOAT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + retract(u:VEC EXPR INT):$ == + v : VEC FEXPR := map(retract,u)$VF2(EXPR INT,FEXPR) + v::$ + + retractIfCan(u:VEC EXPR INT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR INT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + retract(u:VEC EXPR FLOAT):$ == + v : VEC FEXPR := map(retract,u)$VF2(EXPR FLOAT,FEXPR) + v::$ + + retractIfCan(u:VEC EXPR FLOAT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR FLOAT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + retract(u:VEC POLY INT):$ == + v : VEC FEXPR := map(retract,u)$VF2(POLY INT,FEXPR) + v::$ + + retractIfCan(u:VEC POLY INT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY INT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + retract(u:VEC POLY FLOAT):$ == + v : VEC FEXPR := map(retract,u)$VF2(POLY FLOAT,FEXPR) + v::$ + + retractIfCan(u:VEC POLY FLOAT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY FLOAT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + +@ +\section{domain ASP42 Asp42} +\pagehead{Asp42}{ASP42} +\pagepic{ps/v103asp42.ps}{ASP42}{1.00} +<>= +)abbrev domain ASP42 Asp42 +++ Author: Mike Dewar, Godfrey Nolan +++ Date Created: +++ Date Last Updated: 29 March 1994 +++ 6 October 1994 +++ Related Constructors: FortranFunctionCategory, FortranProgramCategory. +++ Description: +++\spadtype{Asp42} produces Fortran for Type 42 ASPs, needed for NAG +++routines \axiomOpFrom{d02raf}{d02Package} and \axiomOpFrom{d02saf}{d02Package} +++in particular. These ASPs are in fact +++three Fortran routines which return a vector of functions, and their +++derivatives wrt Y(i) and also a continuation parameter EPS, for example: +++\begin{verbatim} +++ SUBROUTINE G(EPS,YA,YB,BC,N) +++ DOUBLE PRECISION EPS,YA(N),YB(N),BC(N) +++ INTEGER N +++ BC(1)=YA(1) +++ BC(2)=YA(2) +++ BC(3)=YB(2)-1.0D0 +++ RETURN +++ END +++ SUBROUTINE JACOBG(EPS,YA,YB,AJ,BJ,N) +++ DOUBLE PRECISION EPS,YA(N),AJ(N,N),BJ(N,N),YB(N) +++ INTEGER N +++ AJ(1,1)=1.0D0 +++ AJ(1,2)=0.0D0 +++ AJ(1,3)=0.0D0 +++ AJ(2,1)=0.0D0 +++ AJ(2,2)=1.0D0 +++ AJ(2,3)=0.0D0 +++ AJ(3,1)=0.0D0 +++ AJ(3,2)=0.0D0 +++ AJ(3,3)=0.0D0 +++ BJ(1,1)=0.0D0 +++ BJ(1,2)=0.0D0 +++ BJ(1,3)=0.0D0 +++ BJ(2,1)=0.0D0 +++ BJ(2,2)=0.0D0 +++ BJ(2,3)=0.0D0 +++ BJ(3,1)=0.0D0 +++ BJ(3,2)=1.0D0 +++ BJ(3,3)=0.0D0 +++ RETURN +++ END +++ SUBROUTINE JACGEP(EPS,YA,YB,BCEP,N) +++ DOUBLE PRECISION EPS,YA(N),YB(N),BCEP(N) +++ INTEGER N +++ BCEP(1)=0.0D0 +++ BCEP(2)=0.0D0 +++ BCEP(3)=0.0D0 +++ RETURN +++ END +++\end{verbatim} + +Asp42(nameOne,nameTwo,nameThree): Exports == Implementation where + nameOne : Symbol + nameTwo : Symbol + nameThree : Symbol + + D ==> differentiate + FST ==> FortranScalarType + FT ==> FortranType + FP ==> FortranProgram + FC ==> FortranCode + PI ==> PositiveInteger + NNI ==> NonNegativeInteger + SYMTAB ==> SymbolTable + RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode)) + UFST ==> Union(fst:FST,void:"void") + FRAC ==> Fraction + POLY ==> Polynomial + EXPR ==> Expression + INT ==> Integer + FLOAT ==> Float + VEC ==> Vector + VF2 ==> VectorFunctions2 + MFLOAT ==> MachineFloat + FEXPR ==> FortranExpression(['EPS],['YA,'YB],MFLOAT) + S ==> Symbol + MF2 ==> MatrixCategoryFunctions2(FEXPR,VEC FEXPR,VEC FEXPR,Matrix FEXPR, + EXPR MFLOAT,VEC EXPR MFLOAT,VEC EXPR MFLOAT,Matrix EXPR MFLOAT) + + Exports ==> FortranVectorFunctionCategory with + coerce : VEC FEXPR -> $ + ++coerce(f) takes objects from the appropriate instantiation of + ++\spadtype{FortranExpression} and turns them into an ASP. + + Implementation ==> add + real : UFST := ["real"::FST]$UFST + + symOne : SYMTAB := empty()$SYMTAB + declare!(EPS,fortranReal(),symOne)$SYMTAB + declare!(N,fortranInteger(),symOne)$SYMTAB + yType : FT := construct(real,[N],false)$FT + declare!(YA,yType,symOne)$SYMTAB + declare!(YB,yType,symOne)$SYMTAB + declare!(BC,yType,symOne)$SYMTAB + + symTwo : SYMTAB := empty()$SYMTAB + declare!(EPS,fortranReal(),symTwo)$SYMTAB + declare!(N,fortranInteger(),symTwo)$SYMTAB + declare!(YA,yType,symTwo)$SYMTAB + declare!(YB,yType,symTwo)$SYMTAB + ajType : FT := construct(real,[N,N],false)$FT + declare!(AJ,ajType,symTwo)$SYMTAB + declare!(BJ,ajType,symTwo)$SYMTAB + + symThree : SYMTAB := empty()$SYMTAB + declare!(EPS,fortranReal(),symThree)$SYMTAB + declare!(N,fortranInteger(),symThree)$SYMTAB + declare!(YA,yType,symThree)$SYMTAB + declare!(YB,yType,symThree)$SYMTAB + declare!(BCEP,yType,symThree)$SYMTAB + + rt := ["void"]$UFST + R1:=FortranProgram(nameOne,rt,[EPS,YA,YB,BC,N],symOne) + R2:=FortranProgram(nameTwo,rt,[EPS,YA,YB,AJ,BJ,N],symTwo) + R3:=FortranProgram(nameThree,rt,[EPS,YA,YB,BCEP,N],symThree) + Rep := Record(g:R1,gJacob:R2,geJacob:R3) + BCsym:Symbol:=coerce "BC" + AJsym:Symbol:=coerce "AJ" + BJsym:Symbol:=coerce "BJ" + BCEPsym:Symbol:=coerce "BCEP" + + makeList(n:Integer,s:Symbol):List(Symbol) == + j:Integer + p:List(Symbol) := [] + for j in 1 .. n repeat p:= cons(subscript(s,[j::OutputForm])$Symbol,p) + reverse(p) + + fexpr2expr(u:FEXPR):EXPR MFLOAT == coerce(u)$FEXPR + + localAssign1(s:S,j:Matrix FEXPR):FC == + j' : Matrix EXPR MFLOAT := map(fexpr2expr,j)$MF2 + assign(s,j')$FC + + localAssign2(s:S,j:VEC FEXPR):FC == + j' : VEC EXPR MFLOAT := map(fexpr2expr,j)$VF2(FEXPR,EXPR MFLOAT) + assign(s,j')$FC + + makeCodeOne(u:VEC FEXPR):FortranCode == + -- simple assign + localAssign2(BCsym,u) + + makeCodeTwo(u:VEC FEXPR):List(FortranCode) == + -- compute jacobian wrt to ya + n:Integer := maxIndex(u) + p:List(Symbol) := makeList(n,YA::Symbol) + jacYA:Matrix(FEXPR) := _ + jacobian(u,p)$MultiVariableCalculusFunctions(S,FEXPR,VEC FEXPR,List(S)) + -- compute jacobian wrt to yb + p:List(Symbol) := makeList(n,YB::Symbol) + jacYB: Matrix(FEXPR) := _ + jacobian(u,p)$MultiVariableCalculusFunctions(S,FEXPR,VEC FEXPR,List(S)) + -- assign jacobians to AJ & BJ + [localAssign1(AJsym,jacYA),localAssign1(BJsym,jacYB),returns()$FC]$List(FC) + + makeCodeThree(u:VEC FEXPR):FortranCode == + -- compute jacobian wrt to eps + jacEps:VEC FEXPR := [D(v,EPS) for v in entries u]$VEC(FEXPR) + localAssign2(BCEPsym,jacEps) + + coerce(u:VEC FEXPR):$ == + aF:FortranCode := makeCodeOne(u) + bF:List(FortranCode) := makeCodeTwo(u) + cF:FortranCode := makeCodeThree(u) + -- add returns() to complete subroutines + aLF:List(FortranCode) := [aF,returns()$FC]$List(FortranCode) + cLF:List(FortranCode) := [cF,returns()$FC]$List(FortranCode) + [coerce(aLF)$R1,coerce(bF)$R2,coerce(cLF)$R3] + + coerce(u:$) : OutputForm == + bracket commaSeparate + [nameOne::OutputForm,nameTwo::OutputForm,nameThree::OutputForm] + + outputAsFortran(u:$):Void == + p := checkPrecision()$NAGLinkSupportPackage + outputAsFortran elt(u,g)$Rep + outputAsFortran elt(u,gJacob)$Rep + outputAsFortran elt(u,geJacob)$Rep + p => restorePrecision()$NAGLinkSupportPackage + + retract(u:VEC FRAC POLY INT):$ == + v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY INT,FEXPR) + v::$ + + retractIfCan(u:VEC FRAC POLY INT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY INT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + retract(u:VEC FRAC POLY FLOAT):$ == + v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY FLOAT,FEXPR) + v::$ + + retractIfCan(u:VEC FRAC POLY FLOAT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + retract(u:VEC EXPR INT):$ == + v : VEC FEXPR := map(retract,u)$VF2(EXPR INT,FEXPR) + v::$ + + retractIfCan(u:VEC EXPR INT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR INT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + retract(u:VEC EXPR FLOAT):$ == + v : VEC FEXPR := map(retract,u)$VF2(EXPR FLOAT,FEXPR) + v::$ + + retractIfCan(u:VEC EXPR FLOAT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR FLOAT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + retract(u:VEC POLY INT):$ == + v : VEC FEXPR := map(retract,u)$VF2(POLY INT,FEXPR) + v::$ + + retractIfCan(u:VEC POLY INT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY INT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + retract(u:VEC POLY FLOAT):$ == + v : VEC FEXPR := map(retract,u)$VF2(POLY FLOAT,FEXPR) + v::$ + + retractIfCan(u:VEC POLY FLOAT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY FLOAT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + +@ +\section{domain ASP49 Asp49} +\pagehead{Asp49}{ASP49} +\pagepic{ps/v103asp49.ps}{ASP49}{1.00} +<>= +)abbrev domain ASP49 Asp49 +++ Author: Mike Dewar, Grant Keady and Godfrey Nolan +++ Date Created: Mar 1993 +++ Date Last Updated: 23 March 1994 +++ 6 October 1994 +++ Related Constructors: FortranScalarFunctionCategory, FortranProgramCategory +++ Description: +++\spadtype{Asp49} produces Fortran for Type 49 ASPs, needed for NAG routines +++\axiomOpFrom{e04dgf}{e04Package}, \axiomOpFrom{e04ucf}{e04Package}, for example: +++\begin{verbatim} +++ SUBROUTINE OBJFUN(MODE,N,X,OBJF,OBJGRD,NSTATE,IUSER,USER) +++ DOUBLE PRECISION X(N),OBJF,OBJGRD(N),USER(*) +++ INTEGER N,IUSER(*),MODE,NSTATE +++ OBJF=X(4)*X(9)+((-1.0D0*X(5))+X(3))*X(8)+((-1.0D0*X(3))+X(1))*X(7) +++ &+(-1.0D0*X(2)*X(6)) +++ OBJGRD(1)=X(7) +++ OBJGRD(2)=-1.0D0*X(6) +++ OBJGRD(3)=X(8)+(-1.0D0*X(7)) +++ OBJGRD(4)=X(9) +++ OBJGRD(5)=-1.0D0*X(8) +++ OBJGRD(6)=-1.0D0*X(2) +++ OBJGRD(7)=(-1.0D0*X(3))+X(1) +++ OBJGRD(8)=(-1.0D0*X(5))+X(3) +++ OBJGRD(9)=X(4) +++ RETURN +++ END +++\end{verbatim} + +Asp49(name): Exports == Implementation where + name : Symbol + + FST ==> FortranScalarType + UFST ==> Union(fst:FST,void:"void") + FT ==> FortranType + FC ==> FortranCode + SYMTAB ==> SymbolTable + RSFC ==> Record(localSymbols:SymbolTable,code:List(FC)) + MFLOAT ==> MachineFloat + FEXPR ==> FortranExpression([],['X],MFLOAT) + FRAC ==> Fraction + POLY ==> Polynomial + EXPR ==> Expression + INT ==> Integer + FLOAT ==> Float + VEC ==> Vector + VF2 ==> VectorFunctions2 + S ==> Symbol + + Exports ==> FortranFunctionCategory with + coerce : FEXPR -> $ + ++coerce(f) takes an object from the appropriate instantiation of + ++\spadtype{FortranExpression} and turns it into an ASP. + + Implementation ==> add + + real : UFST := ["real"::FST]$UFST + integer : UFST := ["integer"::FST]$UFST + syms : SYMTAB := empty()$SYMTAB + declare!(MODE,fortranInteger(),syms)$SYMTAB + declare!(N,fortranInteger(),syms)$SYMTAB + xType : FT := construct(real,[N::S],false)$FT + declare!(X,xType,syms)$SYMTAB + declare!(OBJF,fortranReal(),syms)$SYMTAB + declare!(OBJGRD,xType,syms)$SYMTAB + declare!(NSTATE,fortranInteger(),syms)$SYMTAB + iuType : FT := construct(integer,["*"::S],false)$FT + declare!(IUSER,iuType,syms)$SYMTAB + uType : FT := construct(real,["*"::S],false)$FT + declare!(USER,uType,syms)$SYMTAB + Rep := FortranProgram(name,["void"]$UFST, + [MODE,N,X,OBJF,OBJGRD,NSTATE,IUSER,USER],syms) + + fexpr2expr(u:FEXPR):EXPR MFLOAT == coerce(u)$FEXPR + + localAssign(s:S,j:VEC FEXPR):FC == + j' : VEC EXPR MFLOAT := map(fexpr2expr,j)$VF2(FEXPR,EXPR MFLOAT) + assign(s,j')$FC + + coerce(u:FEXPR):$ == + vars:List(S) := variables(u) + grd:VEC FEXPR := gradient(u,vars)$MultiVariableCalculusFunctions(_ + S,FEXPR,VEC FEXPR,List(S)) + code : List(FC) := [assign(OBJF@S,fexpr2expr u)$FC,_ + localAssign(OBJGRD@S,grd),_ + returns()$FC] + code::$ + + coerce(u:$):OutputForm == coerce(u)$Rep + + coerce(c:List FC):$ == coerce(c)$Rep + + coerce(r:RSFC):$ == coerce(r)$Rep + + coerce(c:FC):$ == coerce(c)$Rep + + outputAsFortran(u):Void == + p := checkPrecision()$NAGLinkSupportPackage + outputAsFortran(u)$Rep + p => restorePrecision()$NAGLinkSupportPackage + + retract(u:FRAC POLY INT):$ == (retract(u)@FEXPR)::$ + retractIfCan(u:FRAC POLY INT):Union($,"failed") == + foo : Union(FEXPR,"failed") + foo := retractIfCan(u)$FEXPR + foo case "failed" => "failed" + (foo::FEXPR)::$ + + retract(u:FRAC POLY FLOAT):$ == (retract(u)@FEXPR)::$ + retractIfCan(u:FRAC POLY FLOAT):Union($,"failed") == + foo : Union(FEXPR,"failed") + foo := retractIfCan(u)$FEXPR + foo case "failed" => "failed" + (foo::FEXPR)::$ + + retract(u:EXPR FLOAT):$ == (retract(u)@FEXPR)::$ + retractIfCan(u:EXPR FLOAT):Union($,"failed") == + foo : Union(FEXPR,"failed") + foo := retractIfCan(u)$FEXPR + foo case "failed" => "failed" + (foo::FEXPR)::$ + + retract(u:EXPR INT):$ == (retract(u)@FEXPR)::$ + retractIfCan(u:EXPR INT):Union($,"failed") == + foo : Union(FEXPR,"failed") + foo := retractIfCan(u)$FEXPR + foo case "failed" => "failed" + (foo::FEXPR)::$ + + retract(u:POLY FLOAT):$ == (retract(u)@FEXPR)::$ + retractIfCan(u:POLY FLOAT):Union($,"failed") == + foo : Union(FEXPR,"failed") + foo := retractIfCan(u)$FEXPR + foo case "failed" => "failed" + (foo::FEXPR)::$ + + retract(u:POLY INT):$ == (retract(u)@FEXPR)::$ + retractIfCan(u:POLY INT):Union($,"failed") == + foo : Union(FEXPR,"failed") + foo := retractIfCan(u)$FEXPR + foo case "failed" => "failed" + (foo::FEXPR)::$ + +@ +\section{domain ASP50 Asp50} +\pagehead{Asp50}{ASP50} +\pagepic{ps/v103asp50.ps}{ASP50}{1.00} +<>= +)abbrev domain ASP50 Asp50 +++ Author: Mike Dewar, Grant Keady and Godfrey Nolan +++ Date Created: Mar 1993 +++ Date Last Updated: 23 March 1994 +++ 6 October 1994 +++ Related Constructors: FortranVectorFunctionCategory, FortranProgramCategory +++ Description: +++\spadtype{Asp50} produces Fortran for Type 50 ASPs, needed for NAG routine +++\axiomOpFrom{e04fdf}{e04Package}, for example: +++\begin{verbatim} +++ SUBROUTINE LSFUN1(M,N,XC,FVECC) +++ DOUBLE PRECISION FVECC(M),XC(N) +++ INTEGER I,M,N +++ FVECC(1)=((XC(1)-2.4D0)*XC(3)+(15.0D0*XC(1)-36.0D0)*XC(2)+1.0D0)/( +++ &XC(3)+15.0D0*XC(2)) +++ FVECC(2)=((XC(1)-2.8D0)*XC(3)+(7.0D0*XC(1)-19.6D0)*XC(2)+1.0D0)/(X +++ &C(3)+7.0D0*XC(2)) +++ FVECC(3)=((XC(1)-3.2D0)*XC(3)+(4.333333333333333D0*XC(1)-13.866666 +++ &66666667D0)*XC(2)+1.0D0)/(XC(3)+4.333333333333333D0*XC(2)) +++ FVECC(4)=((XC(1)-3.5D0)*XC(3)+(3.0D0*XC(1)-10.5D0)*XC(2)+1.0D0)/(X +++ &C(3)+3.0D0*XC(2)) +++ FVECC(5)=((XC(1)-3.9D0)*XC(3)+(2.2D0*XC(1)-8.579999999999998D0)*XC +++ &(2)+1.0D0)/(XC(3)+2.2D0*XC(2)) +++ FVECC(6)=((XC(1)-4.199999999999999D0)*XC(3)+(1.666666666666667D0*X +++ &C(1)-7.0D0)*XC(2)+1.0D0)/(XC(3)+1.666666666666667D0*XC(2)) +++ FVECC(7)=((XC(1)-4.5D0)*XC(3)+(1.285714285714286D0*XC(1)-5.7857142 +++ &85714286D0)*XC(2)+1.0D0)/(XC(3)+1.285714285714286D0*XC(2)) +++ FVECC(8)=((XC(1)-4.899999999999999D0)*XC(3)+(XC(1)-4.8999999999999 +++ &99D0)*XC(2)+1.0D0)/(XC(3)+XC(2)) +++ FVECC(9)=((XC(1)-4.699999999999999D0)*XC(3)+(XC(1)-4.6999999999999 +++ &99D0)*XC(2)+1.285714285714286D0)/(XC(3)+XC(2)) +++ FVECC(10)=((XC(1)-6.8D0)*XC(3)+(XC(1)-6.8D0)*XC(2)+1.6666666666666 +++ &67D0)/(XC(3)+XC(2)) +++ FVECC(11)=((XC(1)-8.299999999999999D0)*XC(3)+(XC(1)-8.299999999999 +++ &999D0)*XC(2)+2.2D0)/(XC(3)+XC(2)) +++ FVECC(12)=((XC(1)-10.6D0)*XC(3)+(XC(1)-10.6D0)*XC(2)+3.0D0)/(XC(3) +++ &+XC(2)) +++ FVECC(13)=((XC(1)-1.34D0)*XC(3)+(XC(1)-1.34D0)*XC(2)+4.33333333333 +++ &3333D0)/(XC(3)+XC(2)) +++ FVECC(14)=((XC(1)-2.1D0)*XC(3)+(XC(1)-2.1D0)*XC(2)+7.0D0)/(XC(3)+X +++ &C(2)) +++ FVECC(15)=((XC(1)-4.39D0)*XC(3)+(XC(1)-4.39D0)*XC(2)+15.0D0)/(XC(3 +++ &)+XC(2)) +++ END +++\end{verbatim} + +Asp50(name): Exports == Implementation where + name : Symbol + + FST ==> FortranScalarType + FT ==> FortranType + UFST ==> Union(fst:FST,void:"void") + SYMTAB ==> SymbolTable + RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode)) + FRAC ==> Fraction + POLY ==> Polynomial + EXPR ==> Expression + INT ==> Integer + FLOAT ==> Float + VEC ==> Vector + VF2 ==> VectorFunctions2 + FEXPR ==> FortranExpression([],['XC],MFLOAT) + MFLOAT ==> MachineFloat + + Exports ==> FortranVectorFunctionCategory with + coerce : VEC FEXPR -> $ + ++coerce(f) takes objects from the appropriate instantiation of + ++\spadtype{FortranExpression} and turns them into an ASP. + + Implementation ==> add + + real : UFST := ["real"::FST]$UFST + syms : SYMTAB := empty()$SYMTAB + declare!(M,fortranInteger(),syms)$SYMTAB + declare!(N,fortranInteger(),syms)$SYMTAB + xcType : FT := construct(real,[N],false)$FT + declare!(XC,xcType,syms)$SYMTAB + fveccType : FT := construct(real,[M],false)$FT + declare!(FVECC,fveccType,syms)$SYMTAB + declare!(I,fortranInteger(),syms)$SYMTAB + tType : FT := construct(real,[M,N],false)$FT +-- declare!(TC,tType,syms)$SYMTAB +-- declare!(Y,fveccType,syms)$SYMTAB + Rep := FortranProgram(name,["void"]$UFST, [M,N,XC,FVECC],syms) + + fexpr2expr(u:FEXPR):EXPR MFLOAT == coerce(u)$FEXPR + + coerce(u:VEC FEXPR):$ == + u' : VEC EXPR MFLOAT := map(fexpr2expr,u)$VF2(FEXPR,EXPR MFLOAT) + assign(FVECC,u')$FortranCode::$ + + retract(u:VEC FRAC POLY INT):$ == + v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY INT,FEXPR) + v::$ + + retractIfCan(u:VEC FRAC POLY INT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY INT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + retract(u:VEC FRAC POLY FLOAT):$ == + v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY FLOAT,FEXPR) + v::$ + + retractIfCan(u:VEC FRAC POLY FLOAT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + retract(u:VEC EXPR INT):$ == + v : VEC FEXPR := map(retract,u)$VF2(EXPR INT,FEXPR) + v::$ + + retractIfCan(u:VEC EXPR INT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR INT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + retract(u:VEC EXPR FLOAT):$ == + v : VEC FEXPR := map(retract,u)$VF2(EXPR FLOAT,FEXPR) + v::$ + + retractIfCan(u:VEC EXPR FLOAT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR FLOAT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + retract(u:VEC POLY INT):$ == + v : VEC FEXPR := map(retract,u)$VF2(POLY INT,FEXPR) + v::$ + + retractIfCan(u:VEC POLY INT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY INT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + retract(u:VEC POLY FLOAT):$ == + v : VEC FEXPR := map(retract,u)$VF2(POLY FLOAT,FEXPR) + v::$ + + retractIfCan(u:VEC POLY FLOAT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY FLOAT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + coerce(c:List FortranCode):$ == coerce(c)$Rep + + coerce(r:RSFC):$ == coerce(r)$Rep + + coerce(c:FortranCode):$ == coerce(c)$Rep + + coerce(u:$):OutputForm == coerce(u)$Rep + + outputAsFortran(u):Void == + p := checkPrecision()$NAGLinkSupportPackage + outputAsFortran(u)$Rep + p => restorePrecision()$NAGLinkSupportPackage + +@ +\section{domain ASP55 Asp55} +\pagehead{Asp55}{ASP55} +\pagepic{ps/v103asp55.ps}{ASP55}{1.00} +<>= +)abbrev domain ASP55 Asp55 +++ Author: Mike Dewar, Grant Keady and Godfrey Nolan +++ Date Created: June 1993 +++ Date Last Updated: 23 March 1994 +++ 6 October 1994 +++ Related Constructors: FortranScalarFunctionCategory, FortranProgramCategory +++ Description: +++\spadtype{Asp55} produces Fortran for Type 55 ASPs, needed for NAG routines +++\axiomOpFrom{e04dgf}{e04Package} and \axiomOpFrom{e04ucf}{e04Package}, for example: +++\begin{verbatim} +++ SUBROUTINE CONFUN(MODE,NCNLN,N,NROWJ,NEEDC,X,C,CJAC,NSTATE,IUSER +++ &,USER) +++ DOUBLE PRECISION C(NCNLN),X(N),CJAC(NROWJ,N),USER(*) +++ INTEGER N,IUSER(*),NEEDC(NCNLN),NROWJ,MODE,NCNLN,NSTATE +++ IF(NEEDC(1).GT.0)THEN +++ C(1)=X(6)**2+X(1)**2 +++ CJAC(1,1)=2.0D0*X(1) +++ CJAC(1,2)=0.0D0 +++ CJAC(1,3)=0.0D0 +++ CJAC(1,4)=0.0D0 +++ CJAC(1,5)=0.0D0 +++ CJAC(1,6)=2.0D0*X(6) +++ ENDIF +++ IF(NEEDC(2).GT.0)THEN +++ C(2)=X(2)**2+(-2.0D0*X(1)*X(2))+X(1)**2 +++ CJAC(2,1)=(-2.0D0*X(2))+2.0D0*X(1) +++ CJAC(2,2)=2.0D0*X(2)+(-2.0D0*X(1)) +++ CJAC(2,3)=0.0D0 +++ CJAC(2,4)=0.0D0 +++ CJAC(2,5)=0.0D0 +++ CJAC(2,6)=0.0D0 +++ ENDIF +++ IF(NEEDC(3).GT.0)THEN +++ C(3)=X(3)**2+(-2.0D0*X(1)*X(3))+X(2)**2+X(1)**2 +++ CJAC(3,1)=(-2.0D0*X(3))+2.0D0*X(1) +++ CJAC(3,2)=2.0D0*X(2) +++ CJAC(3,3)=2.0D0*X(3)+(-2.0D0*X(1)) +++ CJAC(3,4)=0.0D0 +++ CJAC(3,5)=0.0D0 +++ CJAC(3,6)=0.0D0 +++ ENDIF +++ RETURN +++ END +++\end{verbatim} + +Asp55(name): Exports == Implementation where + name : Symbol + + FST ==> FortranScalarType + FT ==> FortranType + FSTU ==> Union(fst:FST,void:"void") + SYMTAB ==> SymbolTable + FC ==> FortranCode + RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode)) + FRAC ==> Fraction + POLY ==> Polynomial + EXPR ==> Expression + INT ==> Integer + S ==> Symbol + FLOAT ==> Float + VEC ==> Vector + VF2 ==> VectorFunctions2 + MAT ==> Matrix + MFLOAT ==> MachineFloat + FEXPR ==> FortranExpression([],['X],MFLOAT) + MF2 ==> MatrixCategoryFunctions2(FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR, + EXPR MFLOAT,VEC EXPR MFLOAT,VEC EXPR MFLOAT,MAT EXPR MFLOAT) + SWU ==> Union(I:Expression Integer,F:Expression Float, + CF:Expression Complex Float,switch:Switch) + + Exports ==> FortranVectorFunctionCategory with + coerce : VEC FEXPR -> $ + ++coerce(f) takes objects from the appropriate instantiation of + ++\spadtype{FortranExpression} and turns them into an ASP. + + Implementation ==> add + + real : FSTU := ["real"::FST]$FSTU + integer : FSTU := ["integer"::FST]$FSTU + syms : SYMTAB := empty()$SYMTAB + declare!(MODE,fortranInteger(),syms)$SYMTAB + declare!(NCNLN,fortranInteger(),syms)$SYMTAB + declare!(N,fortranInteger(),syms)$SYMTAB + declare!(NROWJ,fortranInteger(),syms)$SYMTAB + needcType : FT := construct(integer,[NCNLN::Symbol],false)$FT + declare!(NEEDC,needcType,syms)$SYMTAB + xType : FT := construct(real,[N::Symbol],false)$FT + declare!(X,xType,syms)$SYMTAB + cType : FT := construct(real,[NCNLN::Symbol],false)$FT + declare!(C,cType,syms)$SYMTAB + cjacType : FT := construct(real,[NROWJ::Symbol,N::Symbol],false)$FT + declare!(CJAC,cjacType,syms)$SYMTAB + declare!(NSTATE,fortranInteger(),syms)$SYMTAB + iuType : FT := construct(integer,["*"::Symbol],false)$FT + declare!(IUSER,iuType,syms)$SYMTAB + uType : FT := construct(real,["*"::Symbol],false)$FT + declare!(USER,uType,syms)$SYMTAB + Rep := FortranProgram(name,["void"]$FSTU, + [MODE,NCNLN,N,NROWJ,NEEDC,X,C,CJAC,NSTATE,IUSER,USER],syms) + + -- Take a symbol, pull of the script and turn it into an integer!! + o2int(u:S):Integer == + o : OutputForm := first elt(scripts(u)$S,sub) + o pretend Integer + + localAssign(s:Symbol,dim:List POLY INT,u:FEXPR):FC == + assign(s,dim,(u::EXPR MFLOAT)$FEXPR)$FC + + makeCond(index:INT,fun:FEXPR,jac:VEC FEXPR):FC == + needc : EXPR INT := (subscript(NEEDC,[index::OutputForm])$S)::EXPR(INT) + sw : Switch := GT([needc]$SWU,[0::EXPR(INT)]$SWU)$Switch + ass : List FC := [localAssign(CJAC,[index::POLY INT,i::POLY INT],jac.i)_ + for i in 1..maxIndex(jac)] + cond(sw,block([localAssign(C,[index::POLY INT],fun),:ass])$FC)$FC + + coerce(u:VEC FEXPR):$ == + ncnln:Integer := maxIndex(u) + x:S := X::S + pu:List(S) := [] + -- Work out which variables appear in the expressions + for e in entries(u) repeat + pu := setUnion(pu,variables(e)$FEXPR) + scriptList : List Integer := map(o2int,pu)$ListFunctions2(S,Integer) + -- This should be the maximum X_n which occurs (there may be others + -- which don't): + n:Integer := reduce(max,scriptList)$List(Integer) + p:List(S) := [] + for j in 1..n repeat p:= cons(subscript(x,[j::OutputForm])$S,p) + p:= reverse(p) + jac:MAT FEXPR := _ + jacobian(u,p)$MultiVariableCalculusFunctions(S,FEXPR,VEC FEXPR,List(S)) + code : List FC := [makeCond(j,u.j,row(jac,j)) for j in 1..ncnln] + [:code,returns()$FC]::$ + + coerce(c:List FC):$ == coerce(c)$Rep + + coerce(r:RSFC):$ == coerce(r)$Rep + + coerce(c:FC):$ == coerce(c)$Rep + + coerce(u:$):OutputForm == coerce(u)$Rep + + outputAsFortran(u):Void == + p := checkPrecision()$NAGLinkSupportPackage + outputAsFortran(u)$Rep + p => restorePrecision()$NAGLinkSupportPackage + + retract(u:VEC FRAC POLY INT):$ == + v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY INT,FEXPR) + v::$ + + retractIfCan(u:VEC FRAC POLY INT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY INT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + retract(u:VEC FRAC POLY FLOAT):$ == + v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY FLOAT,FEXPR) + v::$ + + retractIfCan(u:VEC FRAC POLY FLOAT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + retract(u:VEC EXPR INT):$ == + v : VEC FEXPR := map(retract,u)$VF2(EXPR INT,FEXPR) + v::$ + + retractIfCan(u:VEC EXPR INT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR INT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + retract(u:VEC EXPR FLOAT):$ == + v : VEC FEXPR := map(retract,u)$VF2(EXPR FLOAT,FEXPR) + v::$ + + retractIfCan(u:VEC EXPR FLOAT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR FLOAT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + retract(u:VEC POLY INT):$ == + v : VEC FEXPR := map(retract,u)$VF2(POLY INT,FEXPR) + v::$ + + retractIfCan(u:VEC POLY INT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY INT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + retract(u:VEC POLY FLOAT):$ == + v : VEC FEXPR := map(retract,u)$VF2(POLY FLOAT,FEXPR) + v::$ + + retractIfCan(u:VEC POLY FLOAT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY FLOAT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + +@ +\section{domain ASP6 Asp6} +\pagehead{Asp6}{ASP6} +\pagepic{ps/v103asp6.ps}{ASP6}{1.00} +<>= +)abbrev domain ASP6 Asp6 +++ Author: Mike Dewar and Godfrey Nolan and Grant Keady +++ Date Created: Mar 1993 +++ Date Last Updated: 18 March 1994 +++ 6 October 1994 +++ Related Constructors: FortranVectorFunctionCategory, FortranProgramCategory +++ Description: +++ \spadtype{Asp6} produces Fortran for Type 6 ASPs, needed for NAG routines +++ \axiomOpFrom{c05nbf}{c05Package}, \axiomOpFrom{c05ncf}{c05Package}. +++ These represent vectors of functions of X(i) and look like: +++ \begin{verbatim} +++ SUBROUTINE FCN(N,X,FVEC,IFLAG) +++ DOUBLE PRECISION X(N),FVEC(N) +++ INTEGER N,IFLAG +++ FVEC(1)=(-2.0D0*X(2))+(-2.0D0*X(1)**2)+3.0D0*X(1)+1.0D0 +++ FVEC(2)=(-2.0D0*X(3))+(-2.0D0*X(2)**2)+3.0D0*X(2)+(-1.0D0*X(1))+1. +++ &0D0 +++ FVEC(3)=(-2.0D0*X(4))+(-2.0D0*X(3)**2)+3.0D0*X(3)+(-1.0D0*X(2))+1. +++ &0D0 +++ FVEC(4)=(-2.0D0*X(5))+(-2.0D0*X(4)**2)+3.0D0*X(4)+(-1.0D0*X(3))+1. +++ &0D0 +++ FVEC(5)=(-2.0D0*X(6))+(-2.0D0*X(5)**2)+3.0D0*X(5)+(-1.0D0*X(4))+1. +++ &0D0 +++ FVEC(6)=(-2.0D0*X(7))+(-2.0D0*X(6)**2)+3.0D0*X(6)+(-1.0D0*X(5))+1. +++ &0D0 +++ FVEC(7)=(-2.0D0*X(8))+(-2.0D0*X(7)**2)+3.0D0*X(7)+(-1.0D0*X(6))+1. +++ &0D0 +++ FVEC(8)=(-2.0D0*X(9))+(-2.0D0*X(8)**2)+3.0D0*X(8)+(-1.0D0*X(7))+1. +++ &0D0 +++ FVEC(9)=(-2.0D0*X(9)**2)+3.0D0*X(9)+(-1.0D0*X(8))+1.0D0 +++ RETURN +++ END +++ \end{verbatim} + +Asp6(name): Exports == Implementation where + name : Symbol + + FEXPR ==> FortranExpression([],['X],MFLOAT) + MFLOAT ==> MachineFloat + FST ==> FortranScalarType + FT ==> FortranType + SYMTAB ==> SymbolTable + RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode)) + UFST ==> Union(fst:FST,void:"void") + FRAC ==> Fraction + POLY ==> Polynomial + EXPR ==> Expression + INT ==> Integer + FLOAT ==> Float + VEC ==> Vector + VF2 ==> VectorFunctions2 + + Exports == FortranVectorFunctionCategory with + coerce: Vector FEXPR -> % + ++coerce(f) takes objects from the appropriate instantiation of + ++\spadtype{FortranExpression} and turns them into an ASP. + + Implementation == add + + real : UFST := ["real"::FST]$UFST + syms : SYMTAB := empty()$SYMTAB + declare!(N,fortranInteger()$FT,syms)$SYMTAB + xType : FT := construct(real,[N],false)$FT + declare!(X,xType,syms)$SYMTAB + declare!(FVEC,xType,syms)$SYMTAB + declare!(IFLAG,fortranInteger()$FT,syms)$SYMTAB + Rep := FortranProgram(name,["void"]$Union(fst:FST,void:"void"), + [N,X,FVEC,IFLAG],syms) + + retract(u:VEC FRAC POLY INT):$ == + v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY INT,FEXPR) + v::$ + + retractIfCan(u:VEC FRAC POLY INT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY INT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + retract(u:VEC FRAC POLY FLOAT):$ == + v : VEC FEXPR := map(retract,u)$VectorFunctions2(FRAC POLY FLOAT,FEXPR) + v::$ + + retractIfCan(u:VEC FRAC POLY FLOAT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + retract(u:VEC EXPR INT):$ == + v : VEC FEXPR := map(retract,u)$VectorFunctions2(EXPR INT,FEXPR) + v::$ + + retractIfCan(u:VEC EXPR INT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR INT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + retract(u:VEC EXPR FLOAT):$ == + v : VEC FEXPR := map(retract,u)$VectorFunctions2(EXPR FLOAT,FEXPR) + v::$ + + retractIfCan(u:VEC EXPR FLOAT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR FLOAT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + retract(u:VEC POLY INT):$ == + v : VEC FEXPR := map(retract,u)$VectorFunctions2(POLY INT,FEXPR) + v::$ + + retractIfCan(u:VEC POLY INT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY INT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + retract(u:VEC POLY FLOAT):$ == + v : VEC FEXPR := map(retract,u)$VectorFunctions2(POLY FLOAT,FEXPR) + v::$ + + retractIfCan(u:VEC POLY FLOAT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY FLOAT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + fexpr2expr(u:FEXPR):EXPR MFLOAT == + (u::EXPR MFLOAT)$FEXPR + + coerce(u:VEC FEXPR):% == + v : VEC EXPR MFLOAT + v := map(fexpr2expr,u)$VF2(FEXPR,EXPR MFLOAT) + ([assign(FVEC,v)$FortranCode,returns()$FortranCode]$List(FortranCode))::$ + + coerce(c:List FortranCode):% == coerce(c)$Rep + + coerce(r:RSFC):% == coerce(r)$Rep + + coerce(c:FortranCode):% == coerce(c)$Rep + + coerce(u:%):OutputForm == coerce(u)$Rep + + outputAsFortran(u):Void == + p := checkPrecision()$NAGLinkSupportPackage + outputAsFortran(u)$Rep + p => restorePrecision()$NAGLinkSupportPackage + +@ +\section{domain ASP7 Asp7} +\pagehead{Asp7}{ASP7} +\pagepic{ps/v103asp7.ps}{ASP7}{1.00} +<>= +)abbrev domain ASP7 Asp7 +++ Author: Mike Dewar and Godfrey Nolan and Grant Keady +++ Date Created: Mar 1993 +++ Date Last Updated: 18 March 1994 +++ 6 October 1994 +++ Related Constructors: FortranVectorFunctionCategory, FortranProgramCategory +++ Description: +++ \spadtype{Asp7} produces Fortran for Type 7 ASPs, needed for NAG routines +++ \axiomOpFrom{d02bbf}{d02Package}, \axiomOpFrom{d02gaf}{d02Package}. +++ These represent a vector of functions of the scalar X and +++ the array Z, and look like: +++ \begin{verbatim} +++ SUBROUTINE FCN(X,Z,F) +++ DOUBLE PRECISION F(*),X,Z(*) +++ F(1)=DTAN(Z(3)) +++ F(2)=((-0.03199999999999999D0*DCOS(Z(3))*DTAN(Z(3)))+(-0.02D0*Z(2) +++ &**2))/(Z(2)*DCOS(Z(3))) +++ F(3)=-0.03199999999999999D0/(X*Z(2)**2) +++ RETURN +++ END +++ \end{verbatim} + +Asp7(name): Exports == Implementation where + name : Symbol + + FST ==> FortranScalarType + FT ==> FortranType + SYMTAB ==> SymbolTable + RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode)) + MFLOAT ==> MachineFloat + FEXPR ==> FortranExpression(['X],['Y],MFLOAT) + UFST ==> Union(fst:FST,void:"void") + FRAC ==> Fraction + POLY ==> Polynomial + EXPR ==> Expression + INT ==> Integer + FLOAT ==> Float + VEC ==> Vector + VF2 ==> VectorFunctions2 + + Exports ==> FortranVectorFunctionCategory with + coerce : Vector FEXPR -> % + ++coerce(f) takes objects from the appropriate instantiation of + ++\spadtype{FortranExpression} and turns them into an ASP. + + Implementation ==> add + + real : UFST := ["real"::FST]$UFST + syms : SYMTAB := empty()$SYMTAB + declare!(X,fortranReal(),syms)$SYMTAB + yType : FT := construct(real,["*"::Symbol],false)$FT + declare!(Y,yType,syms)$SYMTAB + declare!(F,yType,syms)$SYMTAB + Rep := FortranProgram(name,["void"]$UFST,[X,Y,F],syms) + + retract(u:VEC FRAC POLY INT):$ == + v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY INT,FEXPR) + v::$ + + retractIfCan(u:VEC FRAC POLY INT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY INT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + retract(u:VEC FRAC POLY FLOAT):$ == + v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY FLOAT,FEXPR) + v::$ + + retractIfCan(u:VEC FRAC POLY FLOAT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + retract(u:VEC EXPR INT):$ == + v : VEC FEXPR := map(retract,u)$VF2(EXPR INT,FEXPR) + v::$ + + retractIfCan(u:VEC EXPR INT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR INT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + retract(u:VEC EXPR FLOAT):$ == + v : VEC FEXPR := map(retract,u)$VF2(EXPR FLOAT,FEXPR) + v::$ + + retractIfCan(u:VEC EXPR FLOAT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR FLOAT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + retract(u:VEC POLY INT):$ == + v : VEC FEXPR := map(retract,u)$VF2(POLY INT,FEXPR) + v::$ + + retractIfCan(u:VEC POLY INT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY INT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + retract(u:VEC POLY FLOAT):$ == + v : VEC FEXPR := map(retract,u)$VF2(POLY FLOAT,FEXPR) + v::$ + + retractIfCan(u:VEC POLY FLOAT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY FLOAT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + fexpr2expr(u:FEXPR):EXPR MFLOAT == + (u::EXPR MFLOAT)$FEXPR + + coerce(u:Vector FEXPR ):% == + v : Vector EXPR MFLOAT + v:=map(fexpr2expr,u)$VF2(FEXPR,EXPR MFLOAT) + ([assign(F,v)$FortranCode,returns()$FortranCode]$List(FortranCode))::% + + coerce(c:List FortranCode):% == coerce(c)$Rep + + coerce(r:RSFC):% == coerce(r)$Rep + + coerce(c:FortranCode):% == coerce(c)$Rep + + coerce(u:%):OutputForm == coerce(u)$Rep + + outputAsFortran(u):Void == + p := checkPrecision()$NAGLinkSupportPackage + outputAsFortran(u)$Rep + p => restorePrecision()$NAGLinkSupportPackage + +@ +\section{domain ASP73 Asp73} +\pagehead{Asp73}{ASP73} +\pagepic{ps/v103asp73.ps}{ASP73}{1.00} +<>= +)abbrev domain ASP73 Asp73 +++ Author: Mike Dewar, Grant Keady and Godfrey Nolan +++ Date Created: Mar 1993 +++ Date Last Updated: 30 March 1994 +++ 6 October 1994 +++ Related Constructors: FortranVectorFunctionCategory, FortranProgramCategory +++ Description: +++\spadtype{Asp73} produces Fortran for Type 73 ASPs, needed for NAG routine +++\axiomOpFrom{d03eef}{d03Package}, for example: +++\begin{verbatim} +++ SUBROUTINE PDEF(X,Y,ALPHA,BETA,GAMMA,DELTA,EPSOLN,PHI,PSI) +++ DOUBLE PRECISION ALPHA,EPSOLN,PHI,X,Y,BETA,DELTA,GAMMA,PSI +++ ALPHA=DSIN(X) +++ BETA=Y +++ GAMMA=X*Y +++ DELTA=DCOS(X)*DSIN(Y) +++ EPSOLN=Y+X +++ PHI=X +++ PSI=Y +++ RETURN +++ END +++\end{verbatim} + +Asp73(name): Exports == Implementation where + name : Symbol + + FST ==> FortranScalarType + FSTU ==> Union(fst:FST,void:"void") + FEXPR ==> FortranExpression(['X,'Y],[],MachineFloat) + FT ==> FortranType + SYMTAB ==> SymbolTable + RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode)) + FRAC ==> Fraction + POLY ==> Polynomial + EXPR ==> Expression + INT ==> Integer + FLOAT ==> Float + VEC ==> Vector + VF2 ==> VectorFunctions2 + + Exports ==> FortranVectorFunctionCategory with + coerce : VEC FEXPR -> $ + ++coerce(f) takes objects from the appropriate instantiation of + ++\spadtype{FortranExpression} and turns them into an ASP. + + Implementation ==> add + + syms : SYMTAB := empty()$SYMTAB + declare!(X,fortranReal(),syms) $SYMTAB + declare!(Y,fortranReal(),syms) $SYMTAB + declare!(ALPHA,fortranReal(),syms)$SYMTAB + declare!(BETA,fortranReal(),syms) $SYMTAB + declare!(GAMMA,fortranReal(),syms) $SYMTAB + declare!(DELTA,fortranReal(),syms) $SYMTAB + declare!(EPSOLN,fortranReal(),syms) $SYMTAB + declare!(PHI,fortranReal(),syms) $SYMTAB + declare!(PSI,fortranReal(),syms) $SYMTAB + Rep := FortranProgram(name,["void"]$FSTU, + [X,Y,ALPHA,BETA,GAMMA,DELTA,EPSOLN,PHI,PSI],syms) + + -- To help the poor compiler! + localAssign(u:Symbol,v:FEXPR):FortranCode == + assign(u,(v::EXPR MachineFloat)$FEXPR)$FortranCode + + coerce(u:VEC FEXPR):$ == + maxIndex(u) ^= 7 => error "Vector is not of dimension 7" + [localAssign(ALPHA@Symbol,elt(u,1)),_ + localAssign(BETA@Symbol,elt(u,2)),_ + localAssign(GAMMA@Symbol,elt(u,3)),_ + localAssign(DELTA@Symbol,elt(u,4)),_ + localAssign(EPSOLN@Symbol,elt(u,5)),_ + localAssign(PHI@Symbol,elt(u,6)),_ + localAssign(PSI@Symbol,elt(u,7)),_ + returns()$FortranCode]$List(FortranCode)::$ + + coerce(c:FortranCode):$ == coerce(c)$Rep + + coerce(r:RSFC):$ == coerce(r)$Rep + + coerce(c:List FortranCode):$ == coerce(c)$Rep + + coerce(u:$):OutputForm == coerce(u)$Rep + + outputAsFortran(u):Void == + p := checkPrecision()$NAGLinkSupportPackage + outputAsFortran(u)$Rep + p => restorePrecision()$NAGLinkSupportPackage + + retract(u:VEC FRAC POLY INT):$ == + v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY INT,FEXPR) + v::$ + + retractIfCan(u:VEC FRAC POLY INT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY INT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + retract(u:VEC FRAC POLY FLOAT):$ == + v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY FLOAT,FEXPR) + v::$ + + retractIfCan(u:VEC FRAC POLY FLOAT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + retract(u:VEC EXPR INT):$ == + v : VEC FEXPR := map(retract,u)$VF2(EXPR INT,FEXPR) + v::$ + + retractIfCan(u:VEC EXPR INT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR INT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + retract(u:VEC EXPR FLOAT):$ == + v : VEC FEXPR := map(retract,u)$VF2(EXPR FLOAT,FEXPR) + v::$ + + retractIfCan(u:VEC EXPR FLOAT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR FLOAT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + retract(u:VEC POLY INT):$ == + v : VEC FEXPR := map(retract,u)$VF2(POLY INT,FEXPR) + v::$ + + retractIfCan(u:VEC POLY INT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY INT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + retract(u:VEC POLY FLOAT):$ == + v : VEC FEXPR := map(retract,u)$VF2(POLY FLOAT,FEXPR) + v::$ + + retractIfCan(u:VEC POLY FLOAT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY FLOAT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + +@ +\section{domain ASP74 Asp74} +\pagehead{Asp74}{ASP74} +\pagepic{ps/v103asp74.ps}{ASP74}{1.00} +<>= +)abbrev domain ASP74 Asp74 +++ Author: Mike Dewar and Godfrey Nolan +++ Date Created: Oct 1993 +++ Date Last Updated: 30 March 1994 +++ 6 October 1994 +++ Related Constructors: FortranScalarFunctionCategory, FortranProgramCategory. +++ Description: +++\spadtype{Asp74} produces Fortran for Type 74 ASPs, needed for NAG routine +++\axiomOpFrom{d03eef}{d03Package}, for example: +++\begin{verbatim} +++ SUBROUTINE BNDY(X,Y,A,B,C,IBND) +++ DOUBLE PRECISION A,B,C,X,Y +++ INTEGER IBND +++ IF(IBND.EQ.0)THEN +++ A=0.0D0 +++ B=1.0D0 +++ C=-1.0D0*DSIN(X) +++ ELSEIF(IBND.EQ.1)THEN +++ A=1.0D0 +++ B=0.0D0 +++ C=DSIN(X)*DSIN(Y) +++ ELSEIF(IBND.EQ.2)THEN +++ A=1.0D0 +++ B=0.0D0 +++ C=DSIN(X)*DSIN(Y) +++ ELSEIF(IBND.EQ.3)THEN +++ A=0.0D0 +++ B=1.0D0 +++ C=-1.0D0*DSIN(Y) +++ ENDIF +++ END +++\end{verbatim} + +Asp74(name): Exports == Implementation where + name : Symbol + + FST ==> FortranScalarType + FSTU ==> Union(fst:FST,void:"void") + FT ==> FortranType + SYMTAB ==> SymbolTable + FC ==> FortranCode + PI ==> PositiveInteger + RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode)) + FRAC ==> Fraction + POLY ==> Polynomial + EXPR ==> Expression + INT ==> Integer + FLOAT ==> Float + MFLOAT ==> MachineFloat + FEXPR ==> FortranExpression(['X,'Y],[],MFLOAT) + U ==> Union(I: Expression Integer,F: Expression Float,_ + CF: Expression Complex Float,switch:Switch) + VEC ==> Vector + MAT ==> Matrix + M2 ==> MatrixCategoryFunctions2 + MF2a ==> M2(FRAC POLY INT,VEC FRAC POLY INT,VEC FRAC POLY INT, + MAT FRAC POLY INT, FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR) + MF2b ==> M2(FRAC POLY FLOAT,VEC FRAC POLY FLOAT,VEC FRAC POLY FLOAT, + MAT FRAC POLY FLOAT, FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR) + MF2c ==> M2(POLY INT,VEC POLY INT,VEC POLY INT,MAT POLY INT, + FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR) + MF2d ==> M2(POLY FLOAT,VEC POLY FLOAT,VEC POLY FLOAT, + MAT POLY FLOAT, FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR) + MF2e ==> M2(EXPR INT,VEC EXPR INT,VEC EXPR INT,MAT EXPR INT, + FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR) + MF2f ==> M2(EXPR FLOAT,VEC EXPR FLOAT,VEC EXPR FLOAT, + MAT EXPR FLOAT, FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR) + + Exports ==> FortranMatrixFunctionCategory with + coerce : MAT FEXPR -> $ + ++coerce(f) takes objects from the appropriate instantiation of + ++\spadtype{FortranExpression} and turns them into an ASP. + + Implementation ==> add + + syms : SYMTAB := empty()$SYMTAB + declare!(X,fortranReal(),syms)$SYMTAB + declare!(Y,fortranReal(),syms)$SYMTAB + declare!(A,fortranReal(),syms)$SYMTAB + declare!(B,fortranReal(),syms)$SYMTAB + declare!(C,fortranReal(),syms)$SYMTAB + declare!(IBND,fortranInteger(),syms)$SYMTAB + Rep := FortranProgram(name,["void"]$FSTU,[X,Y,A,B,C,IBND],syms) + + -- To help the poor compiler! + localAssign(u:Symbol,v:FEXPR):FC == assign(u,(v::EXPR MFLOAT)$FEXPR)$FC + + coerce(u:MAT FEXPR):$ == + (nrows(u) ^= 4 or ncols(u) ^= 3) => error "Not a 4X3 matrix" + flag:U := [IBND@Symbol::EXPR INT]$U + pt0:U := [0::EXPR INT]$U + pt1:U := [1::EXPR INT]$U + pt2:U := [2::EXPR INT]$U + pt3:U := [3::EXPR INT]$U + sw1: Switch := EQ(flag,pt0)$Switch + sw2: Switch := EQ(flag,pt1)$Switch + sw3: Switch := EQ(flag,pt2)$Switch + sw4: Switch := EQ(flag,pt3)$Switch + a11 : FC := localAssign(A,u(1,1)) + a12 : FC := localAssign(B,u(1,2)) + a13 : FC := localAssign(C,u(1,3)) + a21 : FC := localAssign(A,u(2,1)) + a22 : FC := localAssign(B,u(2,2)) + a23 : FC := localAssign(C,u(2,3)) + a31 : FC := localAssign(A,u(3,1)) + a32 : FC := localAssign(B,u(3,2)) + a33 : FC := localAssign(C,u(3,3)) + a41 : FC := localAssign(A,u(4,1)) + a42 : FC := localAssign(B,u(4,2)) + a43 : FC := localAssign(C,u(4,3)) + c : FC := cond(sw1,block([a11,a12,a13])$FC, + cond(sw2,block([a21,a22,a23])$FC, + cond(sw3,block([a31,a32,a33])$FC, + cond(sw4,block([a41,a42,a43])$FC)$FC)$FC)$FC)$FC + c::$ + + coerce(u:$):OutputForm == coerce(u)$Rep + + coerce(c:FortranCode):$ == coerce(c)$Rep + + coerce(r:RSFC):$ == coerce(r)$Rep + + coerce(c:List FortranCode):$ == coerce(c)$Rep + + outputAsFortran(u):Void == + p := checkPrecision()$NAGLinkSupportPackage + outputAsFortran(u)$Rep + p => restorePrecision()$NAGLinkSupportPackage + + retract(u:MAT FRAC POLY INT):$ == + v : MAT FEXPR := map(retract,u)$MF2a + v::$ + + retractIfCan(u:MAT FRAC POLY INT):Union($,"failed") == + v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2a + v case "failed" => "failed" + (v::MAT FEXPR)::$ + + retract(u:MAT FRAC POLY FLOAT):$ == + v : MAT FEXPR := map(retract,u)$MF2b + v::$ + + retractIfCan(u:MAT FRAC POLY FLOAT):Union($,"failed") == + v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2b + v case "failed" => "failed" + (v::MAT FEXPR)::$ + + retract(u:MAT EXPR INT):$ == + v : MAT FEXPR := map(retract,u)$MF2e + v::$ + + retractIfCan(u:MAT EXPR INT):Union($,"failed") == + v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2e + v case "failed" => "failed" + (v::MAT FEXPR)::$ + + retract(u:MAT EXPR FLOAT):$ == + v : MAT FEXPR := map(retract,u)$MF2f + v::$ + + retractIfCan(u:MAT EXPR FLOAT):Union($,"failed") == + v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2f + v case "failed" => "failed" + (v::MAT FEXPR)::$ + + retract(u:MAT POLY INT):$ == + v : MAT FEXPR := map(retract,u)$MF2c + v::$ + + retractIfCan(u:MAT POLY INT):Union($,"failed") == + v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2c + v case "failed" => "failed" + (v::MAT FEXPR)::$ + + retract(u:MAT POLY FLOAT):$ == + v : MAT FEXPR := map(retract,u)$MF2d + v::$ + + retractIfCan(u:MAT POLY FLOAT):Union($,"failed") == + v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2d + v case "failed" => "failed" + (v::MAT FEXPR)::$ + +@ +\section{domain ASP77 Asp77} +\pagehead{Asp77}{ASP77} +\pagepic{ps/v103asp77.ps}{ASP77}{1.00} +<>= +)abbrev domain ASP77 Asp77 +++ Author: Mike Dewar, Grant Keady and Godfrey Nolan +++ Date Created: Mar 1993 +++ Date Last Updated: 30 March 1994 +++ 6 October 1994 +++ Related Constructors: FortranMatrixFunctionCategory, FortranProgramCategory +++ Description: +++\spadtype{Asp77} produces Fortran for Type 77 ASPs, needed for NAG routine +++\axiomOpFrom{d02gbf}{d02Package}, for example: +++\begin{verbatim} +++ SUBROUTINE FCNF(X,F) +++ DOUBLE PRECISION X +++ DOUBLE PRECISION F(2,2) +++ F(1,1)=0.0D0 +++ F(1,2)=1.0D0 +++ F(2,1)=0.0D0 +++ F(2,2)=-10.0D0 +++ RETURN +++ END +++\end{verbatim} + +Asp77(name): Exports == Implementation where + name : Symbol + + FST ==> FortranScalarType + FSTU ==> Union(fst:FST,void:"void") + FT ==> FortranType + FC ==> FortranCode + SYMTAB ==> SymbolTable + RSFC ==> Record(localSymbols:SymbolTable,code:List(FC)) + FRAC ==> Fraction + POLY ==> Polynomial + EXPR ==> Expression + INT ==> Integer + FLOAT ==> Float + MFLOAT ==> MachineFloat + FEXPR ==> FortranExpression(['X],[],MFLOAT) + VEC ==> Vector + MAT ==> Matrix + M2 ==> MatrixCategoryFunctions2 + MF2 ==> M2(FEXPR,VEC FEXPR,VEC FEXPR,Matrix FEXPR,EXPR MFLOAT, + VEC EXPR MFLOAT,VEC EXPR MFLOAT,Matrix EXPR MFLOAT) + MF2a ==> M2(FRAC POLY INT,VEC FRAC POLY INT,VEC FRAC POLY INT, + MAT FRAC POLY INT, FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR) + MF2b ==> M2(FRAC POLY FLOAT,VEC FRAC POLY FLOAT,VEC FRAC POLY FLOAT, + MAT FRAC POLY FLOAT, FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR) + MF2c ==> M2(POLY INT,VEC POLY INT,VEC POLY INT,MAT POLY INT, + FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR) + MF2d ==> M2(POLY FLOAT,VEC POLY FLOAT,VEC POLY FLOAT, + MAT POLY FLOAT, FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR) + MF2e ==> M2(EXPR INT,VEC EXPR INT,VEC EXPR INT,MAT EXPR INT, + FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR) + MF2f ==> M2(EXPR FLOAT,VEC EXPR FLOAT,VEC EXPR FLOAT, + MAT EXPR FLOAT, FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR) + + + Exports ==> FortranMatrixFunctionCategory with + coerce : MAT FEXPR -> $ + ++coerce(f) takes objects from the appropriate instantiation of + ++\spadtype{FortranExpression} and turns them into an ASP. + + Implementation ==> add + + real : FSTU := ["real"::FST]$FSTU + syms : SYMTAB := empty()$SYMTAB + declare!(X,fortranReal(),syms)$SYMTAB + Rep := FortranProgram(name,["void"]$FSTU,[X,F],syms) + + fexpr2expr(u:FEXPR):EXPR MFLOAT == coerce(u)$FEXPR + + localAssign(s:Symbol,j:MAT FEXPR):FortranCode == + j' : MAT EXPR MFLOAT := map(fexpr2expr,j)$MF2 + assign(s,j')$FortranCode + + coerce(u:MAT FEXPR):$ == + dimension := nrows(u)::POLY(INT) + locals : SYMTAB := empty() + declare!(F,[real,[dimension,dimension]$List(POLY(INT)),false]$FT,locals) + code : List FC := [localAssign(F,u),returns()$FC] + ([locals,code]$RSFC)::$ + + coerce(c:List FC):$ == coerce(c)$Rep + + coerce(r:RSFC):$ == coerce(r)$Rep + + coerce(c:FC):$ == coerce(c)$Rep + + coerce(u:$):OutputForm == coerce(u)$Rep + + outputAsFortran(u):Void == + p := checkPrecision()$NAGLinkSupportPackage + outputAsFortran(u)$Rep + p => restorePrecision()$NAGLinkSupportPackage + + retract(u:MAT FRAC POLY INT):$ == + v : MAT FEXPR := map(retract,u)$MF2a + v::$ + + retractIfCan(u:MAT FRAC POLY INT):Union($,"failed") == + v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2a + v case "failed" => "failed" + (v::MAT FEXPR)::$ + + retract(u:MAT FRAC POLY FLOAT):$ == + v : MAT FEXPR := map(retract,u)$MF2b + v::$ + + retractIfCan(u:MAT FRAC POLY FLOAT):Union($,"failed") == + v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2b + v case "failed" => "failed" + (v::MAT FEXPR)::$ + + retract(u:MAT EXPR INT):$ == + v : MAT FEXPR := map(retract,u)$MF2e + v::$ + + retractIfCan(u:MAT EXPR INT):Union($,"failed") == + v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2e + v case "failed" => "failed" + (v::MAT FEXPR)::$ + + retract(u:MAT EXPR FLOAT):$ == + v : MAT FEXPR := map(retract,u)$MF2f + v::$ + + retractIfCan(u:MAT EXPR FLOAT):Union($,"failed") == + v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2f + v case "failed" => "failed" + (v::MAT FEXPR)::$ + + retract(u:MAT POLY INT):$ == + v : MAT FEXPR := map(retract,u)$MF2c + v::$ + + retractIfCan(u:MAT POLY INT):Union($,"failed") == + v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2c + v case "failed" => "failed" + (v::MAT FEXPR)::$ + + retract(u:MAT POLY FLOAT):$ == + v : MAT FEXPR := map(retract,u)$MF2d + v::$ + + retractIfCan(u:MAT POLY FLOAT):Union($,"failed") == + v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2d + v case "failed" => "failed" + (v::MAT FEXPR)::$ + +@ +\section{domain ASP78 Asp78} +\pagehead{Asp78}{ASP78} +\pagepic{ps/v103asp78.ps}{ASP78}{1.00} +<>= +)abbrev domain ASP78 Asp78 +++ Author: Mike Dewar, Grant Keady and Godfrey Nolan +++ Date Created: Mar 1993 +++ Date Last Updated: 30 March 1994 +++ 6 October 1994 +++ Related Constructors: FortranVectorFunctionCategory, FortranProgramCategory +++ Description: +++\spadtype{Asp78} produces Fortran for Type 78 ASPs, needed for NAG routine +++\axiomOpFrom{d02gbf}{d02Package}, for example: +++\begin{verbatim} +++ SUBROUTINE FCNG(X,G) +++ DOUBLE PRECISION G(*),X +++ G(1)=0.0D0 +++ G(2)=0.0D0 +++ END +++\end{verbatim} + +Asp78(name): Exports == Implementation where + name : Symbol + + FST ==> FortranScalarType + FSTU ==> Union(fst:FST,void:"void") + FT ==> FortranType + FC ==> FortranCode + SYMTAB ==> SymbolTable + RSFC ==> Record(localSymbols:SymbolTable,code:List(FC)) + FRAC ==> Fraction + POLY ==> Polynomial + EXPR ==> Expression + INT ==> Integer + FLOAT ==> Float + VEC ==> Vector + VF2 ==> VectorFunctions2 + MFLOAT ==> MachineFloat + FEXPR ==> FortranExpression(['X],[],MFLOAT) + + Exports ==> FortranVectorFunctionCategory with + coerce : VEC FEXPR -> $ + ++coerce(f) takes objects from the appropriate instantiation of + ++\spadtype{FortranExpression} and turns them into an ASP. + + Implementation ==> add + + real : FSTU := ["real"::FST]$FSTU + syms : SYMTAB := empty()$SYMTAB + declare!(X,fortranReal(),syms)$SYMTAB + gType : FT := construct(real,["*"::Symbol],false)$FT + declare!(G,gType,syms)$SYMTAB + Rep := FortranProgram(name,["void"]$FSTU,[X,G],syms) + + fexpr2expr(u:FEXPR):EXPR MFLOAT == coerce(u)$FEXPR + + coerce(u:VEC FEXPR):$ == + u' : VEC EXPR MFLOAT := map(fexpr2expr,u)$VF2(FEXPR,EXPR MFLOAT) + (assign(G,u')$FC)::$ + + coerce(u:$):OutputForm == coerce(u)$Rep + + outputAsFortran(u):Void == + p := checkPrecision()$NAGLinkSupportPackage + outputAsFortran(u)$Rep + p => restorePrecision()$NAGLinkSupportPackage + + coerce(c:List FC):$ == coerce(c)$Rep + + coerce(r:RSFC):$ == coerce(r)$Rep + + coerce(c:FC):$ == coerce(c)$Rep + + retract(u:VEC FRAC POLY INT):$ == + v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY INT,FEXPR) + v::$ + + retractIfCan(u:VEC FRAC POLY INT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY INT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + retract(u:VEC FRAC POLY FLOAT):$ == + v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY FLOAT,FEXPR) + v::$ + + retractIfCan(u:VEC FRAC POLY FLOAT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + retract(u:VEC EXPR INT):$ == + v : VEC FEXPR := map(retract,u)$VF2(EXPR INT,FEXPR) + v::$ + + retractIfCan(u:VEC EXPR INT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR INT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + retract(u:VEC EXPR FLOAT):$ == + v : VEC FEXPR := map(retract,u)$VF2(EXPR FLOAT,FEXPR) + v::$ + + retractIfCan(u:VEC EXPR FLOAT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR FLOAT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + retract(u:VEC POLY INT):$ == + v : VEC FEXPR := map(retract,u)$VF2(POLY INT,FEXPR) + v::$ + + retractIfCan(u:VEC POLY INT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY INT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + + retract(u:VEC POLY FLOAT):$ == + v : VEC FEXPR := map(retract,u)$VF2(POLY FLOAT,FEXPR) + v::$ + + retractIfCan(u:VEC POLY FLOAT):Union($,"failed") == + v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY FLOAT,FEXPR) + v case "failed" => "failed" + (v::VEC FEXPR)::$ + +@ +\section{domain ASP8 Asp8} +\pagehead{Asp8}{ASP8} +\pagepic{ps/v103asp8.ps}{ASP8}{1.00} +<>= +)abbrev domain ASP8 Asp8 +++ Author: Godfrey Nolan and Mike Dewar +++ Date Created: 11 February 1994 +++ Date Last Updated: 18 March 1994 +++ 31 May 1994 to use alternative interface. MCD +++ 30 June 1994 to handle the end condition correctly. MCD +++ 6 October 1994 +++ Related Constructors: FortranVectorFunctionCategory, FortranProgramCategory +++ Description: +++\spadtype{Asp8} produces Fortran for Type 8 ASPs, needed for NAG routine +++\axiomOpFrom{d02bbf}{d02Package}. This ASP prints intermediate values of the computed solution of +++an ODE and might look like: +++\begin{verbatim} +++ SUBROUTINE OUTPUT(XSOL,Y,COUNT,M,N,RESULT,FORWRD) +++ DOUBLE PRECISION Y(N),RESULT(M,N),XSOL +++ INTEGER M,N,COUNT +++ LOGICAL FORWRD +++ DOUBLE PRECISION X02ALF,POINTS(8) +++ EXTERNAL X02ALF +++ INTEGER I +++ POINTS(1)=1.0D0 +++ POINTS(2)=2.0D0 +++ POINTS(3)=3.0D0 +++ POINTS(4)=4.0D0 +++ POINTS(5)=5.0D0 +++ POINTS(6)=6.0D0 +++ POINTS(7)=7.0D0 +++ POINTS(8)=8.0D0 +++ COUNT=COUNT+1 +++ DO 25001 I=1,N +++ RESULT(COUNT,I)=Y(I) +++25001 CONTINUE +++ IF(COUNT.EQ.M)THEN +++ IF(FORWRD)THEN +++ XSOL=X02ALF() +++ ELSE +++ XSOL=-X02ALF() +++ ENDIF +++ ELSE +++ XSOL=POINTS(COUNT) +++ ENDIF +++ END +++\end{verbatim} + +Asp8(name): Exports == Implementation where + name : Symbol + + O ==> OutputForm + S ==> Symbol + FST ==> FortranScalarType + UFST ==> Union(fst:FST,void:"void") + FT ==> FortranType + FC ==> FortranCode + SYMTAB ==> SymbolTable + RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode)) + EX ==> Expression Integer + MFLOAT ==> MachineFloat + EXPR ==> Expression + PI ==> Polynomial Integer + EXU ==> Union(I: EXPR Integer,F: EXPR Float,CF: EXPR Complex Float, + switch: Switch) + + Exports ==> FortranVectorCategory + + Implementation ==> add + + real : UFST := ["real"::FST]$UFST + syms : SYMTAB := empty()$SYMTAB + declare!([COUNT,M,N],fortranInteger(),syms)$SYMTAB + declare!(XSOL,fortranReal(),syms)$SYMTAB + yType : FT := construct(real,[N],false)$FT + declare!(Y,yType,syms)$SYMTAB + declare!(FORWRD,fortranLogical(),syms)$SYMTAB + declare!(RESULT,construct(real,[M,N],false)$FT,syms)$SYMTAB + Rep := FortranProgram(name,["void"]$UFST,[XSOL,Y,COUNT,M,N,RESULT,FORWRD],syms) + + coerce(c:List FC):% == coerce(c)$Rep + + coerce(r:RSFC):% == coerce(r)$Rep + + coerce(c:FC):% == coerce(c)$Rep + + coerce(u:%):O == coerce(u)$Rep + + outputAsFortran(u:%):Void == + p := checkPrecision()$NAGLinkSupportPackage + outputAsFortran(u)$Rep + p => restorePrecision()$NAGLinkSupportPackage + + + f2ex(u:MFLOAT):EXPR MFLOAT == (u::EXPR MFLOAT)$EXPR(MFLOAT) + + coerce(points:Vector MFLOAT):% == + import PI + import EXPR Integer + -- Create some extra declarations + locals : SYMTAB := empty()$SYMTAB + nPol : PI := "N"::S::PI + iPol : PI := "I"::S::PI + countPol : PI := "COUNT"::S::PI + pointsDim : PI := max(#points,1)::PI + declare!(POINTS,[real,[pointsDim],false]$FT,locals)$SYMTAB + declare!(X02ALF,[real,[],true]$FT,locals)$SYMTAB + -- Now build up the code fragments + index : SegmentBinding PI := equation(I@S,1::PI..nPol)$SegmentBinding(PI) + ySym : EX := (subscript("Y"::S,[I::O])$S)::EX + loop := forLoop(index,assign(RESULT,[countPol,iPol],ySym)$FC)$FC + v:Vector EXPR MFLOAT + v := map(f2ex,points)$VectorFunctions2(MFLOAT,EXPR MFLOAT) + assign1 : FC := assign(POINTS,v)$FC + countExp: EX := COUNT@S::EX + newValue: EX := 1 + countExp + assign2 : FC := assign(COUNT,newValue)$FC + newSymbol : S := subscript(POINTS,[COUNT]@List(O))$S + assign3 : FC := assign(XSOL, newSymbol::EX )$FC + fphuge : EX := kernel(operator X02ALF,empty()$List(EX)) + assign4 : FC := assign(XSOL, fphuge)$FC + assign5 : FC := assign(XSOL, -fphuge)$FC + innerCond : FC := cond("FORWRD"::Symbol::Switch,assign4,assign5) + mExp : EX := M@S::EX + endCase : FC := cond(EQ([countExp]$EXU,[mExp]$EXU)$Switch,innerCond,assign3) + code := [assign1, assign2, loop, endCase]$List(FC) + ([locals,code]$RSFC)::% + +@ +\section{domain ASP80 Asp80} +\pagehead{Asp80}{ASP80} +\pagepic{ps/v103asp80.ps}{ASP80}{1.00} +<>= +)abbrev domain ASP80 Asp80 +++ Author: Mike Dewar and Godfrey Nolan +++ Date Created: Oct 1993 +++ Date Last Updated: 30 March 1994 +++ 6 October 1994 +++ Related Constructors: FortranMatrixFunctionCategory, FortranProgramCategory +++ Description: +++\spadtype{Asp80} produces Fortran for Type 80 ASPs, needed for NAG routine +++\axiomOpFrom{d02kef}{d02Package}, for example: +++\begin{verbatim} +++ SUBROUTINE BDYVAL(XL,XR,ELAM,YL,YR) +++ DOUBLE PRECISION ELAM,XL,YL(3),XR,YR(3) +++ YL(1)=XL +++ YL(2)=2.0D0 +++ YR(1)=1.0D0 +++ YR(2)=-1.0D0*DSQRT(XR+(-1.0D0*ELAM)) +++ RETURN +++ END +++\end{verbatim} + +Asp80(name): Exports == Implementation where + name : Symbol + + FST ==> FortranScalarType + FSTU ==> Union(fst:FST,void:"void") + FT ==> FortranType + FC ==> FortranCode + SYMTAB ==> SymbolTable + RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode)) + FRAC ==> Fraction + POLY ==> Polynomial + EXPR ==> Expression + INT ==> Integer + FLOAT ==> Float + MFLOAT ==> MachineFloat + FEXPR ==> FortranExpression(['XL,'XR,'ELAM],[],MFLOAT) + VEC ==> Vector + MAT ==> Matrix + VF2 ==> VectorFunctions2 + M2 ==> MatrixCategoryFunctions2 + MF2a ==> M2(FRAC POLY INT,VEC FRAC POLY INT,VEC FRAC POLY INT, + MAT FRAC POLY INT, FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR) + MF2b ==> M2(FRAC POLY FLOAT,VEC FRAC POLY FLOAT,VEC FRAC POLY FLOAT, + MAT FRAC POLY FLOAT, FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR) + MF2c ==> M2(POLY INT,VEC POLY INT,VEC POLY INT,MAT POLY INT, + FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR) + MF2d ==> M2(POLY FLOAT,VEC POLY FLOAT,VEC POLY FLOAT, + MAT POLY FLOAT, FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR) + MF2e ==> M2(EXPR INT,VEC EXPR INT,VEC EXPR INT,MAT EXPR INT, + FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR) + MF2f ==> M2(EXPR FLOAT,VEC EXPR FLOAT,VEC EXPR FLOAT, + MAT EXPR FLOAT, FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR) + + Exports ==> FortranMatrixFunctionCategory with + coerce : MAT FEXPR -> $ + ++coerce(f) takes objects from the appropriate instantiation of + ++\spadtype{FortranExpression} and turns them into an ASP. + + Implementation ==> add + + real : FSTU := ["real"::FST]$FSTU + syms : SYMTAB := empty()$SYMTAB + declare!(XL,fortranReal(),syms)$SYMTAB + declare!(XR,fortranReal(),syms)$SYMTAB + declare!(ELAM,fortranReal(),syms)$SYMTAB + yType : FT := construct(real,["3"::Symbol],false)$FT + declare!(YL,yType,syms)$SYMTAB + declare!(YR,yType,syms)$SYMTAB + Rep := FortranProgram(name,["void"]$FSTU, [XL,XR,ELAM,YL,YR],syms) + + fexpr2expr(u:FEXPR):EXPR MFLOAT == coerce(u)$FEXPR + + vecAssign(s:Symbol,u:VEC FEXPR):FC == + u' : VEC EXPR MFLOAT := map(fexpr2expr,u)$VF2(FEXPR,EXPR MFLOAT) + assign(s,u')$FC + + coerce(u:MAT FEXPR):$ == + [vecAssign(YL,row(u,1)),vecAssign(YR,row(u,2)),returns()$FC]$List(FC)::$ + + coerce(c:List FortranCode):$ == coerce(c)$Rep + + coerce(r:RSFC):$ == coerce(r)$Rep + + coerce(c:FortranCode):$ == coerce(c)$Rep + + coerce(u:$):OutputForm == coerce(u)$Rep + + outputAsFortran(u):Void == + p := checkPrecision()$NAGLinkSupportPackage + outputAsFortran(u)$Rep + p => restorePrecision()$NAGLinkSupportPackage + + retract(u:MAT FRAC POLY INT):$ == + v : MAT FEXPR := map(retract,u)$MF2a + v::$ + + retractIfCan(u:MAT FRAC POLY INT):Union($,"failed") == + v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2a + v case "failed" => "failed" + (v::MAT FEXPR)::$ + + retract(u:MAT FRAC POLY FLOAT):$ == + v : MAT FEXPR := map(retract,u)$MF2b + v::$ + + retractIfCan(u:MAT FRAC POLY FLOAT):Union($,"failed") == + v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2b + v case "failed" => "failed" + (v::MAT FEXPR)::$ + + retract(u:MAT EXPR INT):$ == + v : MAT FEXPR := map(retract,u)$MF2e + v::$ + + retractIfCan(u:MAT EXPR INT):Union($,"failed") == + v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2e + v case "failed" => "failed" + (v::MAT FEXPR)::$ + + retract(u:MAT EXPR FLOAT):$ == + v : MAT FEXPR := map(retract,u)$MF2f + v::$ + + retractIfCan(u:MAT EXPR FLOAT):Union($,"failed") == + v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2f + v case "failed" => "failed" + (v::MAT FEXPR)::$ + + retract(u:MAT POLY INT):$ == + v : MAT FEXPR := map(retract,u)$MF2c + v::$ + + retractIfCan(u:MAT POLY INT):Union($,"failed") == + v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2c + v case "failed" => "failed" + (v::MAT FEXPR)::$ + + retract(u:MAT POLY FLOAT):$ == + v : MAT FEXPR := map(retract,u)$MF2d + v::$ + + retractIfCan(u:MAT POLY FLOAT):Union($,"failed") == + v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2d + v case "failed" => "failed" + (v::MAT FEXPR)::$ + +@ +\section{domain ASP9 Asp9} +\pagehead{Asp9}{ASP9} +\pagepic{ps/v103asp9.ps}{ASP9}{1.00} +<>= +)abbrev domain ASP9 Asp9 +++ Author: Mike Dewar, Grant Keady and Godfrey Nolan +++ Date Created: Mar 1993 +++ Date Last Updated: 18 March 1994 +++ 12 July 1994 added COMMON blocks for d02cjf, d02ejf +++ 6 October 1994 +++ Related Constructors: FortranVectorFunctionCategory, FortranProgramCategory +++ Description: +++ \spadtype{Asp9} produces Fortran for Type 9 ASPs, needed for NAG routines +++ \axiomOpFrom{d02bhf}{d02Package}, +++ \axiomOpFrom{d02cjf}{d02Package}, +++ \axiomOpFrom{d02ejf}{d02Package}. +++ These ASPs represent a function of a scalar X and a vector Y, for example: +++ \begin{verbatim} +++ DOUBLE PRECISION FUNCTION G(X,Y) +++ DOUBLE PRECISION X,Y(*) +++ G=X+Y(1) +++ RETURN +++ END +++ \end{verbatim} +++ If the user provides a constant value for G, then extra information is added +++ via COMMON blocks used by certain routines. This specifies that the value +++ returned by G in this case is to be ignored. + +Asp9(name): Exports == Implementation where + name : Symbol + + FEXPR ==> FortranExpression(['X],['Y],MFLOAT) + MFLOAT ==> MachineFloat + FC ==> FortranCode + FST ==> FortranScalarType + FT ==> FortranType + SYMTAB ==> SymbolTable + RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode)) + UFST ==> Union(fst:FST,void:"void") + FRAC ==> Fraction + POLY ==> Polynomial + EXPR ==> Expression + INT ==> Integer + FLOAT ==> Float + + Exports ==> FortranFunctionCategory with + coerce : FEXPR -> % + ++coerce(f) takes an object from the appropriate instantiation of + ++\spadtype{FortranExpression} and turns it into an ASP. + + Implementation ==> add + + real : FST := "real"::FST + syms : SYMTAB := empty()$SYMTAB + declare!(X,fortranReal()$FT,syms)$SYMTAB + yType : FT := construct([real]$UFST,["*"::Symbol],false)$FT + declare!(Y,yType,syms)$SYMTAB + Rep := FortranProgram(name,[real]$UFST,[X,Y],syms) + + retract(u:FRAC POLY INT):$ == (retract(u)@FEXPR)::$ + retractIfCan(u:FRAC POLY INT):Union($,"failed") == + foo : Union(FEXPR,"failed") + foo := retractIfCan(u)$FEXPR + foo case "failed" => "failed" + (foo::FEXPR)::$ + + retract(u:FRAC POLY FLOAT):$ == (retract(u)@FEXPR)::$ + retractIfCan(u:FRAC POLY FLOAT):Union($,"failed") == + foo : Union(FEXPR,"failed") + foo := retractIfCan(u)$FEXPR + foo case "failed" => "failed" + (foo::FEXPR)::$ + + retract(u:EXPR FLOAT):$ == (retract(u)@FEXPR)::$ + retractIfCan(u:EXPR FLOAT):Union($,"failed") == + foo : Union(FEXPR,"failed") + foo := retractIfCan(u)$FEXPR + foo case "failed" => "failed" + (foo::FEXPR)::$ + + retract(u:EXPR INT):$ == (retract(u)@FEXPR)::$ + retractIfCan(u:EXPR INT):Union($,"failed") == + foo : Union(FEXPR,"failed") + foo := retractIfCan(u)$FEXPR + foo case "failed" => "failed" + (foo::FEXPR)::$ + + retract(u:POLY FLOAT):$ == (retract(u)@FEXPR)::$ + retractIfCan(u:POLY FLOAT):Union($,"failed") == + foo : Union(FEXPR,"failed") + foo := retractIfCan(u)$FEXPR + foo case "failed" => "failed" + (foo::FEXPR)::$ + + retract(u:POLY INT):$ == (retract(u)@FEXPR)::$ + retractIfCan(u:POLY INT):Union($,"failed") == + foo : Union(FEXPR,"failed") + foo := retractIfCan(u)$FEXPR + foo case "failed" => "failed" + (foo::FEXPR)::$ + + coerce(u:FEXPR):% == + expr : Expression MachineFloat := (u::Expression(MachineFloat))$FEXPR + (retractIfCan(u)@Union(MFLOAT,"failed"))$FEXPR case "failed" => + coerce(expr)$Rep + locals : SYMTAB := empty() + charType : FT := construct(["character"::FST]$UFST,[6::POLY(INT)],false)$FT + declare!([CHDUM1,CHDUM2,GOPT1,CHDUM,GOPT2],charType,locals)$SYMTAB + common1 := common(CD02EJ,[CHDUM1,CHDUM2,GOPT1] )$FC + common2 := common(AD02CJ,[CHDUM,GOPT2] )$FC + assign1 := assign(GOPT1,"NOGOPT")$FC + assign2 := assign(GOPT2,"NOGOPT")$FC + result := assign(name,expr)$FC + code : List FC := [common1,common2,assign1,assign2,result] + ([locals,code]$RSFC)::Rep + + coerce(c:List FortranCode):% == coerce(c)$Rep + + coerce(r:RSFC):% == coerce(r)$Rep + + coerce(c:FortranCode):% == coerce(c)$Rep + + coerce(u:%):OutputForm == coerce(u)$Rep + + outputAsFortran(u):Void == + p := checkPrecision()$NAGLinkSupportPackage + outputAsFortran(u)$Rep + p => restorePrecision()$NAGLinkSupportPackage + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\chapter{Chapter B} +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\chapter{Chapter C} +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Chapter D} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain DBASE Database} +<>= +"DBASE" -> "SETCAT" +"Database(a:OrderedSet)" -> "SetCategory()" +@ +\pagehead{Database}{DBASE} +\pagepic{ps/v103database.ps}{DBASE}{1.00} +<>= +)abbrev domain DBASE Database +++ This domain implements a simple view of a database whose fields are +++ indexed by symbols +Database(S): Exports == Implementation where + S: OrderedSet with + elt: (%,Symbol) -> String + ++ elt(x,s) returns an element of x indexed by s + display: % -> Void + ++ display(x) displays x in some form + fullDisplay: % -> Void + ++ fullDisplay(x) displays x in detail + Exports == SetCategory with + elt: (%,QueryEquation) -> % + ++ elt(db,q) returns all elements of \axiom{db} which satisfy \axiom{q}. + elt: (%,Symbol) -> DataList String + ++ elt(db,s) returns the \axiom{s} field of each element of \axiom{db}. + _+: (%,%) -> % + ++ db1+db2 returns the merge of databases db1 and db2 + _-: (%,%) -> % + ++ db1-db2 returns the difference of databases db1 and db2 i.e. consisting + ++ of elements in db1 but not in db2 + coerce: List S -> % + ++ coerce(l) makes a database out of a list + display: % -> Void + ++ display(db) prints a summary line for each entry in \axiom{db}. + fullDisplay: % -> Void + ++ fullDisplay(db) prints full details of each entry in \axiom{db}. + fullDisplay: (%,PositiveInteger,PositiveInteger) -> Void + ++ fullDisplay(db,start,end ) prints full details of entries in the range + ++ \axiom{start..end} in \axiom{db}. + Implementation == List S add + s: Symbol + Rep := List S + coerce(u: List S):% == u@% + elt(data: %,s: Symbol) == [x.s for x in data] :: DataList(String) + elt(data: %,eq: QueryEquation) == + field := variable eq + val := value eq + [x for x in data | stringMatches?(val,x.field)$Lisp] + x+y==removeDuplicates_! merge(x,y) + x-y==mergeDifference(copy(x::Rep),y::Rep)$MergeThing(S) + coerce(data): OutputForm == (#data):: OutputForm + display(data) == for x in data repeat display x + fullDisplay(data) == for x in data repeat fullDisplay x + fullDisplay(data,n,m) == for x in data for i in 1..m repeat + if i >= n then fullDisplay x + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain DLIST DataList} +<>= +"DLIST" -> "LSAGG" +"DataList(a:OrderedSet)" -> "ListAggregate(a:Type)" +@ +\pagehead{DataList}{DLIST} +\pagepic{ps/v103datalist.ps}{DLIST}{1.00} +<>= +)abbrev domain DLIST DataList +++ This domain provides some nice functions on lists +DataList(S:OrderedSet) : Exports == Implementation where + Exports == ListAggregate(S) with + coerce: List S -> % + ++ coerce(l) creates a datalist from l + coerce: % -> List S + ++ coerce(x) returns the list of elements in x + datalist: List S -> % + ++ datalist(l) creates a datalist from l + elt: (%,"unique") -> % + ++ \axiom{l.unique} returns \axiom{l} with duplicates removed. + ++ Note: \axiom{l.unique = removeDuplicates(l)}. + elt: (%,"sort") -> % + ++ \axiom{l.sort} returns \axiom{l} with elements sorted. + ++ Note: \axiom{l.sort = sort(l)} + elt: (%,"count") -> NonNegativeInteger + ++ \axiom{l."count"} returns the number of elements in \axiom{l}. + Implementation == List(S) add + elt(x,"unique") == removeDuplicates(x) + elt(x,"sort") == sort(x) + elt(x,"count") == #x + coerce(x:List S) == x pretend % + coerce(x:%):List S == x pretend (List S) + coerce(x:%): OutputForm == (x :: List S) :: OutputForm + datalist(x:List S) == x::% + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{Denavit-Hartenberg Matrices} \subsection{Homogeneous Transformations} The study of robot manipulation is concerned with the relationship between @@ -1963,13 +6427,3721 @@ DenavitHartenbergMatrix(R): Exports == Implementation where <> @ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\chapter{Chapter E} +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\chapter{Chapter F} +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain FARRAY FlexibleArray} +<>= +-- array1.spad.pamphlet FlexibleArray.input +)spool FlexibleArray.output +)set message test on +)set message auto off +)clear all +--S 1 of 16 +flexibleArray [i for i in 1..6] +--R +--R +--R (1) [1,2,3,4,5,6] +--R Type: FlexibleArray PositiveInteger +--E 1 + +--S 2 of 16 +f : FARRAY INT := new(6,0) +--R +--R +--R (2) [0,0,0,0,0,0] +--R Type: FlexibleArray Integer +--E 2 + +--S 3 of 16 +for i in 1..6 repeat f.i := i; f +--R +--R +--R (3) [1,2,3,4,5,6] +--R Type: FlexibleArray Integer +--E 3 + +--S 4 of 16 +physicalLength f +--R +--R +--R (4) 6 +--R Type: PositiveInteger +--E 4 + +--S 5 of 16 +concat!(f,11) +--R +--R +--R (5) [1,2,3,4,5,6,11] +--R Type: FlexibleArray Integer +--E 5 + +--S 6 of 16 +physicalLength f +--R +--R +--R (6) 10 +--R Type: PositiveInteger +--E 6 + +--S 7 of 16 +physicalLength!(f,15) +--R +--R +--R (7) [1,2,3,4,5,6,11] +--R Type: FlexibleArray Integer +--E 7 + +--S 8 of 16 +concat!(f,f) +--R +--R +--R (8) [1,2,3,4,5,6,11,1,2,3,4,5,6,11] +--R Type: FlexibleArray Integer +--E 8 + +--S 9 of 16 +insert!(22,f,1) +--R +--R +--R (9) [22,1,2,3,4,5,6,11,1,2,3,4,5,6,11] +--R Type: FlexibleArray Integer +--E 9 + +--S 10 of 16 +g := f(10..) +--R +--R +--R (10) [2,3,4,5,6,11] +--R Type: FlexibleArray Integer +--E 10 + +--S 11 of 16 +insert!(g,f,1) +--R +--R +--R (11) [2,3,4,5,6,11,22,1,2,3,4,5,6,11,1,2,3,4,5,6,11] +--R Type: FlexibleArray Integer +--E 11 + +--S 12 of 16 +merge!(sort! f, sort! g) +--R +--R +--R (12) [1,1,2,2,2,2,3,3,3,3,4,4,4,4,5,5,5,5,6,6,6,6,11,11,11,11,22] +--R Type: FlexibleArray Integer +--E 12 + +--S 13 of 16 +removeDuplicates! f +--R +--R +--R (13) [1,2,3,4,5,6,11,22] +--R Type: FlexibleArray Integer +--E 13 + +--S 14 of 16 +select!(i +-> even? i,f) +--R +--R +--R (14) [2,4,6,22] +--R Type: FlexibleArray Integer +--E 14 + +--S 15 of 16 +physicalLength f +--R +--R +--R (15) 8 +--R Type: PositiveInteger +--E 15 + +--S 16 of 16 +shrinkable(false)$FlexibleArray(Integer) +--R +--R +--R (16) true +--R Type: Boolean +--E 16 +)spool +)lisp (bye) +@ +<>= +==================================================================== +FlexibleArray +==================================================================== + +The FlexibleArray domain constructor creates one-dimensional +arrays of elements of the same type. Flexible arrays are an attempt +to provide a data type that has the best features of both +one-dimensional arrays (fast, random access to elements) and lists +(flexibility). They are implemented by a fixed block of storage. +When necessary for expansion, a new, larger block of storage is +allocated and the elements from the old storage area are copied into +the new block. + +Flexible arrays have available most of the operations provided by +OneDimensionalArray Vector. Since flexible arrays are also of +category ExtensibleLinearAggregate they have operations concat!, +delete!, insert!, merge!, remove!, removeDuplicates!, and select!. In +addition, the operations physicalLength and physicalLength! provide +user-control over expansion and contraction. + +A convenient way to create a flexible array is to apply the operation +flexibleArray to a list of values. + + flexibleArray [i for i in 1..6] + [1,2,3,4,5,6] + Type: FlexibleArray PositiveInteger + +Create a flexible array of six zeroes. + + f : FARRAY INT := new(6,0) + [0,0,0,0,0,0] + Type: FlexibleArray Integer + +For i=1..6 set the i-th element to i. Display f. + + for i in 1..6 repeat f.i := i; f + [1,2,3,4,5,6] + Type: FlexibleArray Integer + +Initially, the physical length is the same as the number of elements. + + physicalLength f + 6 + Type: PositiveInteger + +Add an element to the end of f. + + concat!(f,11) + [1,2,3,4,5,6,11] + Type: FlexibleArray Integer + +See that its physical length has grown. + + physicalLength f + 10 + Type: PositiveInteger + +Make f grow to have room for 15 elements. + + physicalLength!(f,15) + [1,2,3,4,5,6,11] + Type: FlexibleArray Integer + +Concatenate the elements of f to itself. The physical length +allows room for three more values at the end. + + concat!(f,f) + [1,2,3,4,5,6,11,1,2,3,4,5,6,11] + Type: FlexibleArray Integer + +Use insert! to add an element to the front of a flexible array. + + insert!(22,f,1) + [22,1,2,3,4,5,6,11,1,2,3,4,5,6,11] + Type: FlexibleArray Integer + +Create a second flexible array from f consisting of the elements from +index 10 forward. + + g := f(10..) + [2,3,4,5,6,11] + Type: FlexibleArray Integer + +Insert this array at the front of f. + + insert!(g,f,1) + [2,3,4,5,6,11,22,1,2,3,4,5,6,11,1,2,3,4,5,6,11] + Type: FlexibleArray Integer + +Merge the flexible array f into g after sorting each in place. + + merge!(sort! f, sort! g) + [1,1,2,2,2,2,3,3,3,3,4,4,4,4,5,5,5,5,6,6,6,6,11,11,11,11,22] + Type: FlexibleArray Integer + +Remove duplicates in place. + + removeDuplicates! f + [1,2,3,4,5,6,11,22] + Type: FlexibleArray Integer + +Remove all odd integers. + + select!(i +-> even? i,f) + [2,4,6,22] + Type: FlexibleArray Integer + +All these operations have shrunk the physical length of f. + + physicalLength f + 8 + Type: PositiveInteger + +To force Axiom not to shrink flexible arrays call the shrinkable +operation with the argument false. You must package call this +operation. The previous value is returned. + + shrinkable(false)$FlexibleArray(Integer) + true + Type: Boolean + +See Also: +o )help OneDimensionalArray +o )help Vector +o )help ExtensibleLinearAggregate +o )show FlexibleArray +o $AXIOM/doc/src/algebra/array1.spad.dvi + +@ +<>= +"FARRAY" -> "IFARRAY" +"FlexibleArray(a:Type)" -> "IndexedFlexibleArray(a:Type,1)" +@ +\pagehead{FlexibleArray}{FARRAY} +\pagepic{ps/v103flexiblearray.ps}{FARRAY}{1.00} +<>= +)abbrev domain FARRAY FlexibleArray +++ A FlexibleArray is the notion of an array intended to allow for growth +++ at the end only. Hence the following efficient operations +++ \spad{append(x,a)} meaning append item x at the end of the array \spad{a} +++ \spad{delete(a,n)} meaning delete the last item from the array \spad{a} +++ Flexible arrays support the other operations inherited from +++ \spadtype{ExtensibleLinearAggregate}. However, these are not efficient. +++ Flexible arrays combine the \spad{O(1)} access time property of arrays +++ with growing and shrinking at the end in \spad{O(1)} (average) time. +++ This is done by using an ordinary array which may have zero or more +++ empty slots at the end. When the array becomes full it is copied +++ into a new larger (50% larger) array. Conversely, when the array +++ becomes less than 1/2 full, it is copied into a smaller array. +++ Flexible arrays provide for an efficient implementation of many +++ data structures in particular heaps, stacks and sets. + +FlexibleArray(S: Type) == Implementation where + ARRAYMININDEX ==> 1 -- if you want to change this, be my guest + Implementation ==> IndexedFlexibleArray(S, ARRAYMININDEX) +-- Join(OneDimensionalArrayAggregate S, ExtensibleLinearAggregate S) + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\chapter{Chapter G} +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\chapter{Chapter H} +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\chapter{Chapter I} +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain ICARD IndexCard} +<>= +"ICARD" -> "ORDSET" +"IndexCard()" -> "OrderedSet()" +@ +\pagehead{IndexCard}{ICARD} +\pagepic{ps/v103indexcard.ps}{ICARD}{1.00} +<>= +)abbrev domain ICARD IndexCard +++ This domain implements a container of information +++ about the AXIOM library +IndexCard() : Exports == Implementation where + Exports == OrderedSet with + elt: (%,Symbol) -> String + ++ elt(ic,s) selects a particular field from \axiom{ic}. Valid fields + ++ are \axiom{name, nargs, exposed, type, abbreviation, kind, origin, + ++ params, condition, doc}. + display: % -> Void + ++ display(ic) prints a summary of information contained in \axiom{ic}. + fullDisplay: % -> Void + ++ fullDisplay(ic) prints all of the information contained in \axiom{ic}. + coerce: String -> % + ++ coerce(s) converts \axiom{s} into an \axiom{IndexCard}. Warning: if + ++ \axiom{s} is not of the right format then an error will occur + Implementation == add + x empty() + hconcat(" if ",condition::OutputForm) + exposed? : String := SUBSTRING(dbPart(x,3,1)$Lisp,0,1)$Lisp + exposedPart : OutputForm := + exposed? = "n" => " (unexposed)" + empty() + firstPart := hconcat(name,hconcat(" : ",type)) + secondPart := hconcat(fromPart,hconcat(ifPart,exposedPart)) + output(hconcat(firstPart,secondPart))$OutputPackage + coerce(s:String): % == (s pretend %) + coerce(x): OutputForm == (x pretend String)::OutputForm + elt(x,sel) == + s := PNAME(sel)$Lisp pretend String + s = "name" => dbName(x)$Lisp + s = "nargs" => dbPart(x,2,1$Lisp)$Lisp + s = "exposed" => SUBSTRING(dbPart(x,3,1)$Lisp,0,1)$Lisp + s = "type" => dbPart(x,4,1$Lisp)$Lisp + s = "abbreviation" => dbPart(x,5,1$Lisp)$Lisp + s = "kind" => alqlGetKindString(x)$Lisp + s = "origin" => alqlGetOrigin(x)$Lisp + s = "params" => alqlGetParams(x)$Lisp + s = "condition" => dbPart(x,6,1$Lisp)$Lisp + s = "doc" => dbComments(x)$Lisp + error "unknown selector" +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain IFARRAY IndexedFlexibleArray} +<>= +"IFARRAY" -> "A1AGG" +"IndexedFlexibleArray(a:Type,b:Integer)" -> + "OneDimensionalArrayAggregate(a:Type)" +"IndexedFlexibleArray(a:Type,1)" -> + "IndexedFlexibleArray(a:Type,b:Integer)" +"IFARRAY" -> "ELAGG" +"IndexedFlexibleArray(a:Type,b:Integer)" -> + "ExtensibleLinearAggregate(a:Type)" +@ +\pagehead{IndexedFlexibleArray}{IFARRAY} +\pagepic{ps/v103indexedflexiblearray.ps}{IFARRAY}{1.00} +<>= +)abbrev domain IFARRAY IndexedFlexibleArray +++ Author: Michael Monagan July/87, modified SMW June/91 +++ A FlexibleArray is the notion of an array intended to allow for growth +++ at the end only. Hence the following efficient operations +++ \spad{append(x,a)} meaning append item x at the end of the array \spad{a} +++ \spad{delete(a,n)} meaning delete the last item from the array \spad{a} +++ Flexible arrays support the other operations inherited from +++ \spadtype{ExtensibleLinearAggregate}. However, these are not efficient. +++ Flexible arrays combine the \spad{O(1)} access time property of arrays +++ with growing and shrinking at the end in \spad{O(1)} (average) time. +++ This is done by using an ordinary array which may have zero or more +++ empty slots at the end. When the array becomes full it is copied +++ into a new larger (50% larger) array. Conversely, when the array +++ becomes less than 1/2 full, it is copied into a smaller array. +++ Flexible arrays provide for an efficient implementation of many +++ data structures in particular heaps, stacks and sets. + +IndexedFlexibleArray(S:Type, mn: Integer): Exports == Implementation where + A ==> PrimitiveArray S + I ==> Integer + N ==> NonNegativeInteger + U ==> UniversalSegment Integer + Exports == + Join(OneDimensionalArrayAggregate S,ExtensibleLinearAggregate S) with + flexibleArray : List S -> % + ++ flexibleArray(l) creates a flexible array from the list of elements l + ++ + ++X T1:=IndexedFlexibleArray(Integer,20) + ++X flexibleArray([i for i in 1..10])$T1 + + physicalLength : % -> NonNegativeInteger + ++ physicalLength(x) returns the number of elements x can + ++ accomodate before growing + ++ + ++X T1:=IndexedFlexibleArray(Integer,20) + ++X t2:=flexibleArray([i for i in 1..10])$T1 + ++X physicalLength t2 + + physicalLength_!: (%, I) -> % + ++ physicalLength!(x,n) changes the physical length of x to be n and + ++ returns the new array. + ++ + ++X T1:=IndexedFlexibleArray(Integer,20) + ++X t2:=flexibleArray([i for i in 1..10])$T1 + ++X physicalLength!(t2,15) + + shrinkable: Boolean -> Boolean + ++ shrinkable(b) sets the shrinkable attribute of flexible arrays to b + ++ and returns the previous value + ++ + ++X T1:=IndexedFlexibleArray(Integer,20) + ++X shrinkable(false)$T1 + + Implementation == add + Rep := Record(physLen:I, logLen:I, f:A) + shrinkable? : Boolean := true + growAndFill : (%, I, S) -> % + growWith : (%, I, S) -> % + growAdding : (%, I, %) -> % + shrink: (%, I) -> % + newa : (N, A) -> A + + physicalLength(r) == (r.physLen) pretend NonNegativeInteger + physicalLength_!(r, n) == + r.physLen = 0 => error "flexible array must be non-empty" + growWith(r, n, r.f.0) + + empty() == [0, 0, empty()] + #r == (r.logLen)::N + fill_!(r, x) == (fill_!(r.f, x); r) + maxIndex r == r.logLen - 1 + mn + minIndex r == mn + new(n, a) == [n, n, new(n, a)] + + shrinkable(b) == + oldval := shrinkable? + shrinkable? := b + oldval + + flexibleArray l == + n := #l + n = 0 => empty() + x := l.1 + a := new(n,x) + for i in mn + 1..mn + n-1 for y in rest l repeat a.i := y + a + + -- local utility operations + newa(n, a) == + zero? n => empty() + new(n, a.0) + + growAdding(r, b, s) == + b = 0 => r + #r > 0 => growAndFill(r, b, (r.f).0) + #s > 0 => growAndFill(r, b, (s.f).0) + error "no default filler element" + + growAndFill(r, b, x) == + (r.logLen := r.logLen + b) <= r.physLen => r + -- enlarge by 50% + b + n := r.physLen + r.physLen quo 2 + 1 + if r.logLen > n then n := r.logLen + growWith(r, n, x) + + growWith(r, n, x) == + y := new(n::N, x)$PrimitiveArray(S) + a := r.f + for k in 0 .. r.physLen-1 repeat y.k := a.k + r.physLen := n + r.f := y + r + + shrink(r, i) == + r.logLen := r.logLen - i + negative?(n := r.logLen) => error "internal bug in flexible array" + 2*n+2 > r.physLen => r + not shrinkable? => r + if n < r.logLen + then error "cannot shrink flexible array to indicated size" + n = 0 => empty() + r.physLen := n + y := newa(n::N, a := r.f) + for k in 0 .. n-1 repeat y.k := a.k + r.f := y + r + + copy r == + n := #r + a := r.f + v := newa(n, a := r.f) + for k in 0..n-1 repeat v.k := a.k + [n, n, v] + + + elt(r:%, i:I) == + i < mn or i >= r.logLen + mn => + error "index out of range" + r.f.(i-mn) + + setelt(r:%, i:I, x:S) == + i < mn or i >= r.logLen + mn => + error "index out of range" + r.f.(i-mn) := x + + -- operations inherited from extensible aggregate + merge(g, a, b) == merge_!(g, copy a, b) + concat(x:S, r:%) == insert_!(x, r, mn) + + concat_!(r:%, x:S) == + growAndFill(r, 1, x) + r.f.(r.logLen-1) := x + r + + concat_!(a:%, b:%) == + if eq?(a, b) then b := copy b + n := #a + growAdding(a, #b, b) + copyInto_!(a, b, n + mn) + + remove_!(g:(S->Boolean), a:%) == + k:I := 0 + for i in 0..maxIndex a - mn repeat + if not g(a.i) then (a.k := a.i; k := k+1) + shrink(a, #a - k) + + delete_!(r:%, i1:I) == + i := i1 - mn + i < 0 or i > r.logLen => error "index out of range" + for k in i..r.logLen-2 repeat r.f.k := r.f.(k+1) + shrink(r, 1) + + delete_!(r:%, i:U) == + l := lo i - mn; m := maxIndex r - mn + h := (hasHi i => hi i - mn; m) + l < 0 or h > m => error "index out of range" + for j in l.. for k in h+1..m repeat r.f.j := r.f.k + shrink(r, max(0,h-l+1)) + + insert_!(x:S, r:%, i1:I):% == + i := i1 - mn + n := r.logLen + i < 0 or i > n => error "index out of range" + growAndFill(r, 1, x) + for k in n-1 .. i by -1 repeat r.f.(k+1) := r.f.k + r.f.i := x + r + + insert_!(a:%, b:%, i1:I):% == + i := i1 - mn + if eq?(a, b) then b := copy b + m := #a; n := #b + i < 0 or i > n => error "index out of range" + growAdding(b, m, a) + for k in n-1 .. i by -1 repeat b.f.(m+k) := b.f.k + for k in m-1 .. 0 by -1 repeat b.f.(i+k) := a.f.k + b + + merge_!(g, a, b) == + m := #a; n := #b; growAdding(a, n, b) + for i in m-1..0 by -1 for j in m+n-1.. by -1 repeat a.f.j := a.f.i + i := n; j := 0 + for k in 0.. while i < n+m and j < n repeat + if g(a.f.i,b.f.j) then (a.f.k := a.f.i; i := i+1) + else (a.f.k := b.f.j; j := j+1) + for k in k.. for j in j..n-1 repeat a.f.k := b.f.j + a + + select_!(g:(S->Boolean), a:%) == + k:I := 0 + for i in 0..maxIndex a - mn repeat_ + if g(a.f.i) then (a.f.k := a.f.i;k := k+1) + shrink(a, #a - k) + + if S has SetCategory then + removeDuplicates_! a == + ct := #a + ct < 2 => a + + i := mn + nlim := mn + ct + nlim0 := nlim + while i < nlim repeat + j := i+1 + for k in j..nlim-1 | a.k ^= a.i repeat + a.j := a.k + j := j+1 + nlim := j + i := i+1 + nlim ^= nlim0 => delete_!(a, i..) + a + +@ +\section{domain IARRAY1 IndexedOneDimensionalArray} +<>= +"IARRAY1" -> "A1AGG" +"IndexedOneDimensionalArray(a:Type,b:Integer)" -> + "OneDimensionalArrayAggregate(a:Type)" +@ +\pagehead{IndexedOneDimensionalArray}{IARRAY1} +\pagepic{ps/v103indexedonedimensionalarray.ps}{IARRAY1}{1.00} +<>= +)abbrev domain IARRAY1 IndexedOneDimensionalArray +++ Author Micheal Monagan Aug/87 +++ This is the basic one dimensional array data type. + +IndexedOneDimensionalArray(S:Type, mn:Integer): + OneDimensionalArrayAggregate S == add + Qmax ==> QVMAXINDEX$Lisp + Qsize ==> QVSIZE$Lisp +-- Qelt ==> QVELT$Lisp +-- Qsetelt ==> QSETVELT$Lisp + Qelt ==> ELT$Lisp + Qsetelt ==> SETELT$Lisp +-- Qelt1 ==> QVELT_-1$Lisp +-- Qsetelt1 ==> QSETVELT_-1$Lisp + Qnew ==> GETREFV$Lisp + I ==> Integer + + #x == Qsize x + fill_!(x, s) == (for i in 0..Qmax x repeat Qsetelt(x, i, s); x) + minIndex x == mn + + empty() == Qnew(0$Lisp) + new(n, s) == fill_!(Qnew n,s) + + map_!(f, s1) == + n:Integer := Qmax(s1) + n < 0 => s1 + for i in 0..n repeat Qsetelt(s1, i, f(Qelt(s1,i))) + s1 + + map(f, s1) == + n:Integer := Qmax(s1) + n < 0 => s1 + ss2:% := Qnew(n+1) + for i in 0..n repeat Qsetelt(ss2, i, f(Qelt(s1,i))) + ss2 + + map(f, a, b) == + maxind:Integer := min(Qmax a, Qmax b) + maxind < 0 => empty() + c:% := Qnew(maxind+1) + for i in 0..maxind repeat + Qsetelt(c, i, f(Qelt(a,i),Qelt(b,i))) + c + + if zero? mn then + qelt(x, i) == Qelt(x, i) + qsetelt_!(x, i, s) == Qsetelt(x, i, s) + + elt(x:%, i:I) == + negative? i or i > maxIndex(x) => error "index out of range" + qelt(x, i) + + setelt(x:%, i:I, s:S) == + negative? i or i > maxIndex(x) => error "index out of range" + qsetelt_!(x, i, s) + +-- else if one? mn then + else if (mn = 1) then + maxIndex x == Qsize x + qelt(x, i) == Qelt(x, i-1) + qsetelt_!(x, i, s) == Qsetelt(x, i-1, s) + + elt(x:%, i:I) == + QSLESSP(i,1$Lisp)$Lisp or QSLESSP(Qsize x,i)$Lisp => + error "index out of range" + Qelt(x, i-1) + + setelt(x:%, i:I, s:S) == + QSLESSP(i,1$Lisp)$Lisp or QSLESSP(Qsize x,i)$Lisp => + error "index out of range" + Qsetelt(x, i-1, s) + + else + qelt(x, i) == Qelt(x, i - mn) + qsetelt_!(x, i, s) == Qsetelt(x, i - mn, s) + + elt(x:%, i:I) == + i < mn or i > maxIndex(x) => error "index out of range" + qelt(x, i) + + setelt(x:%, i:I, s:S) == + i < mn or i > maxIndex(x) => error "index out of range" + qsetelt_!(x, i, s) + +@ +\section{domain IARRAY2 IndexedTwoDimensionalArray} +An IndexedTwoDimensionalArray is a 2-dimensional array where +the minimal row and column indices are parameters of the type. +Rows and columns are returned as IndexedOneDimensionalArray's with +minimal indices matching those of the IndexedTwoDimensionalArray. +The index of the 'first' row may be obtained by calling the +function 'minRowIndex'. The index of the 'first' column may +be obtained by calling the function 'minColIndex'. The index of +the first element of a 'Row' is the same as the index of the +first column in an array and vice versa. +<>= +"IARRAY2" -> "ARR2CAT" +"IndexedTwoDimensionalArray(a:Type,b:Integer,c:Integer)" -> +"TwoDimensionalArrayCategory(a:Type,d:IndexedOneDimensionalArray(a,b),e:IndexedOneDimensionalArray(a,c))" +"IARRAY2" -> "IIARRAY2" +"IndexedTwoDimensionalArray(a:Type,b:Integer,c:Integer)" -> +"InnerIndexedTwoDimensionalArray(a:Type,b:Integer,c:Integer,d:IndexedOneDimensionalArray(a,b),e:IndexedOneDimensionalArray(a,c))" +@ +\pagehead{IndexedTwoDimensionalArray}{IARRAY2} +\pagepic{ps/v103indexedtwodimensionalarray.ps}{IARRAY2}{1.00} +<>= +)abbrev domain IARRAY2 IndexedTwoDimensionalArray +IndexedTwoDimensionalArray(R,mnRow,mnCol):Exports == Implementation where + R : Type + mnRow, mnCol : Integer + Row ==> IndexedOneDimensionalArray(R,mnCol) + Col ==> IndexedOneDimensionalArray(R,mnRow) + + Exports ==> TwoDimensionalArrayCategory(R,Row,Col) + + Implementation ==> + InnerIndexedTwoDimensionalArray(R,mnRow,mnCol,Row,Col) + +@ +\section{domain IIARRAY2 InnerIndexedTwoDimensionalArray} +This is an internal type which provides an implementation of +2-dimensional arrays as PrimitiveArray's of PrimitiveArray's. +<>= +"IIARRAY2" -> "ARR2CAT" +"InnerIndexedTwoDimensionalArray(a:Type,b:Integer,c:Integer,d:FiniteLinearAggregate(a),e:FiniteLinearAggregate(a))" +-> "TwoDimensionalArrayCategory(a:Type,b:FiniteLinearAggregate(a),c:FiniteLinearAggregate(a))" +"InnerIndexedTwoDimensionalArray(a:Type,b:Integer,c:Integer,d:IndexedOneDimensionalArray(a,b),e:IndexedOneDimensionalArray(a,c))" +-> "InnerIndexedTwoDimensionalArray(a:Type,b:Integer,c:Integer,d:FiniteLinearAggregate(a),e:FiniteLinearAggregate(a))" +"InnerIndexedTwoDimensionalArray(a:Type,1,1,b:OneDimensionalArray(a),c:OneDimensionalArray(a))" +-> "InnerIndexedTwoDimensionalArray(a:Type,b:Integer,c:Integer,d:FiniteLinearAggregate(a),e:FiniteLinearAggregate(a))" +@ +\pagehead{InnerIndexedTwoDimensionalArray}{IIARRAY2} +\pagepic{ps/v103innerindexedtwodimensionalarray.ps}{IIARRAY2}{1.00} +<>= +)abbrev domain IIARRAY2 InnerIndexedTwoDimensionalArray +InnerIndexedTwoDimensionalArray(R,mnRow,mnCol,Row,Col):_ + Exports == Implementation where + R : Type + mnRow, mnCol : Integer + Row : FiniteLinearAggregate R + Col : FiniteLinearAggregate R + + Exports ==> TwoDimensionalArrayCategory(R,Row,Col) + + Implementation ==> add + + Rep := PrimitiveArray PrimitiveArray R + +--% Predicates + + empty? m == empty?(m)$Rep + +--% Primitive array creation + + empty() == empty()$Rep + + new(rows,cols,a) == + rows = 0 => + error "new: arrays with zero rows are not supported" +-- cols = 0 => +-- error "new: arrays with zero columns are not supported" + arr : PrimitiveArray PrimitiveArray R := new(rows,empty()) + for i in minIndex(arr)..maxIndex(arr) repeat + qsetelt_!(arr,i,new(cols,a)) + arr + +--% Size inquiries + + minRowIndex m == mnRow + minColIndex m == mnCol + maxRowIndex m == nrows m + mnRow - 1 + maxColIndex m == ncols m + mnCol - 1 + + nrows m == (# m)$Rep + + ncols m == + empty? m => 0 + # m(minIndex(m)$Rep) + +--% Part selection/assignment + + qelt(m,i,j) == + qelt(qelt(m,i - minRowIndex m)$Rep,j - minColIndex m) + + elt(m:%,i:Integer,j:Integer) == + i < minRowIndex(m) or i > maxRowIndex(m) => + error "elt: index out of range" + j < minColIndex(m) or j > maxColIndex(m) => + error "elt: index out of range" + qelt(m,i,j) + + qsetelt_!(m,i,j,r) == + setelt(qelt(m,i - minRowIndex m)$Rep,j - minColIndex m,r) + + setelt(m:%,i:Integer,j:Integer,r:R) == + i < minRowIndex(m) or i > maxRowIndex(m) => + error "setelt: index out of range" + j < minColIndex(m) or j > maxColIndex(m) => + error "setelt: index out of range" + qsetelt_!(m,i,j,r) + + if R has SetCategory then + latex(m : %) : String == + s : String := "\left[ \begin{array}{" + j : Integer + for j in minColIndex(m)..maxColIndex(m) repeat + s := concat(s,"c")$String + s := concat(s,"} ")$String + i : Integer + for i in minRowIndex(m)..maxRowIndex(m) repeat + for j in minColIndex(m)..maxColIndex(m) repeat + s := concat(s, latex(qelt(m,i,j))$R)$String + if j < maxColIndex(m) then s := concat(s, " & ")$String + if i < maxRowIndex(m) then s := concat(s, " \\ ")$String + concat(s, "\end{array} \right]")$String + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\chapter{Chapter J} +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\chapter{Chapter K} +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\chapter{Chapter L} +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\chapter{Chapter M} +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\chapter{Chapter N} +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain NONE None} +<>= +-- any.spad.pamphlet None.input +)spool None.output +)set message test on +)set message auto off +)clear all +--S 1 of 3 +[ ] +--R +--R +--R (1) [] +--R Type: List None +--E 1 + +--S 2 of 3 +[ ] :: List Float +--R +--R +--R (2) [] +--R Type: List Float +--E 2 + +--S 3 of 3 +[ ]$List(NonNegativeInteger) +--R +--R +--R (3) [] +--R Type: List NonNegativeInteger +--E 3 +)spool +)lisp (bye) +@ +<>= +==================================================================== +None examples +==================================================================== + +The None domain is not very useful for interactive work but it is +provided nevertheless for completeness of the Axiom type system. + +Probably the only place you will ever see it is if you enter an +empty list with no type information. + + [ ] + [] + Type: List None + +Such an empty list can be converted into an empty list of any other +type. + + [ ] :: List Float + [] + Type: List Float + +If you wish to produce an empty list of a particular type directly, +such as List NonNegativeInteger, do it this way. + + [ ]$List(NonNegativeInteger) + [] + Type: List NonNegativeInteger + +See Also: +o )show None +o $AXIOM/doc/src/algebra/any.spad.dvi + +@ +<>= +"NONE" -> "SETCAT" +"None()" -> "SetCategory()" +@ +\pagehead{None}{NONE} +\pagepic{ps/v103none.ps}{NONE}{1.00} +<>= +)abbrev domain NONE None +++ Author: +++ Date Created: +++ Change History: +++ Basic Functions: coerce +++ Related Constructors: NoneFunctions1 +++ Also See: Any +++ AMS Classification: +++ Keywords: none, empty +++ Description: +++ \spadtype{None} implements a type with no objects. It is mainly +++ used in technical situations where such a thing is needed (e.g. +++ the interpreter and some of the internal \spadtype{Expression} +++ code). + +None():SetCategory == add + coerce(none:%):OutputForm == "NONE" :: OutputForm + x:% = y:% == EQ(x,y)$Lisp + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain NIPROB NumericalIntegrationProblem} +\pagehead{NumericalIntegrationProblem}{NIPROB} +\pagepic{ps/v103numericalintegrationproblem.ps}{NIPROB}{1.00} +<>= +)abbrev domain NIPROB NumericalIntegrationProblem +++ Author: Brian Dupee +++ Date Created: December 1997 +++ Date Last Updated: December 1997 +++ Basic Operations: coerce, retract +++ Related Constructors: Union +++ Description: +++ \axiomType{NumericalIntegrationProblem} is a \axiom{domain} +++ for the representation of Numerical Integration problems for use +++ by ANNA. +++ +++ The representation is a Union of two record types - one for integration of +++ a function of one variable: +++ +++ \axiomType{Record}(var:\axiomType{Symbol}, +++ fn:\axiomType{Expression DoubleFloat}, +++ range:\axiomType{Segment OrderedCompletion DoubleFloat}, +++ abserr:\axiomType{DoubleFloat}, +++ relerr:\axiomType{DoubleFloat},) +++ +++ and one for multivariate integration: +++ +++ \axiomType{Record}(fn:\axiomType{Expression DoubleFloat}, +++ range:\axiomType{List Segment OrderedCompletion DoubleFloat}, +++ abserr:\axiomType{DoubleFloat}, +++ relerr:\axiomType{DoubleFloat},). +++ + +EDFA ==> Expression DoubleFloat +SOCDFA ==> Segment OrderedCompletion DoubleFloat +DFA ==> DoubleFloat +NIAA ==> Record(var:Symbol,fn:EDFA,range:SOCDFA,abserr:DFA,relerr:DFA) +MDNIAA ==> Record(fn:EDFA,range:List SOCDFA,abserr:DFA,relerr:DFA) + +NumericalIntegrationProblem():SetCategory with + coerce: NIAA -> % + ++ coerce(x) \undocumented{} + coerce: MDNIAA -> % + ++ coerce(x) \undocumented{} + coerce: Union(nia:NIAA,mdnia:MDNIAA) -> % + ++ coerce(x) \undocumented{} + coerce: % -> OutputForm + ++ coerce(x) \undocumented{} + retract: % -> Union(nia:NIAA,mdnia:MDNIAA) + ++ retract(x) \undocumented{} + + == + + add + Rep := Union(nia:NIAA,mdnia:MDNIAA) + + coerce(s:NIAA) == [s] + coerce(s:MDNIAA) == [s] + coerce(s:Union(nia:NIAA,mdnia:MDNIAA)) == s + coerce(x:%):OutputForm == + (x) case nia => (x.nia)::OutputForm + (x.mdnia)::OutputForm + retract(x:%):Union(nia:NIAA,mdnia:MDNIAA) == + (x) case nia => [x.nia] + [x.mdnia] + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain ODEPROB NumericalODEProblem} +\pagehead{NumericalODEProblem}{ODEPROB} +\pagepic{ps/v103numericalodeproblem.ps}{ODEPROB}{1.00} +<>= +)abbrev domain ODEPROB NumericalODEProblem +++ Author: Brian Dupee +++ Date Created: December 1997 +++ Date Last Updated: December 1997 +++ Basic Operations: coerce, retract +++ Related Constructors: Union +++ Description: +++ \axiomType{NumericalODEProblem} is a \axiom{domain} +++ for the representation of Numerical ODE problems for use +++ by ANNA. +++ +++ The representation is of type: +++ +++ \axiomType{Record}(xinit:\axiomType{DoubleFloat}, +++ xend:\axiomType{DoubleFloat}, +++ fn:\axiomType{Vector Expression DoubleFloat}, +++ yinit:\axiomType{List DoubleFloat},intvals:\axiomType{List DoubleFloat}, +++ g:\axiomType{Expression DoubleFloat},abserr:\axiomType{DoubleFloat}, +++ relerr:\axiomType{DoubleFloat}) +++ + +DFB ==> DoubleFloat +VEDFB ==> Vector Expression DoubleFloat +LDFB ==> List DoubleFloat +EDFB ==> Expression DoubleFloat +ODEAB ==> Record(xinit:DFB,xend:DFB,fn:VEDFB,yinit:LDFB,intvals:LDFB,g:EDFB,abserr:DFB,relerr:DFB) +NumericalODEProblem():SetCategory with + + coerce: ODEAB -> % + ++ coerce(x) \undocumented{} + coerce: % -> OutputForm + ++ coerce(x) \undocumented{} + retract: % -> ODEAB + ++ retract(x) \undocumented{} + + == + + add + Rep := ODEAB + + coerce(s:ODEAB) == s + coerce(x:%):OutputForm == + (retract(x))::OutputForm + retract(x:%):ODEAB == x :: Rep + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain OPTPROB NumericalOptimizationProblem} +\pagehead{NumericalOptimizationProblem}{OPTPROB} +\pagepic{ps/v103numericaloptimizationproblem.ps}{OPTPROB}{1.00} +<>= +)abbrev domain OPTPROB NumericalOptimizationProblem +++ Author: Brian Dupee +++ Date Created: December 1997 +++ Date Last Updated: December 1997 +++ Basic Operations: coerce, retract +++ Related Constructors: Union +++ Description: +++ \axiomType{NumericalOptimizationProblem} is a \axiom{domain} +++ for the representation of Numerical Optimization problems for use +++ by ANNA. +++ +++ The representation is a Union of two record types - one for otimization of +++ a single function of one or more variables: +++ +++ \axiomType{Record}( +++ fn:\axiomType{Expression DoubleFloat}, +++ init:\axiomType{List DoubleFloat}, +++ lb:\axiomType{List OrderedCompletion DoubleFloat}, +++ cf:\axiomType{List Expression DoubleFloat}, +++ ub:\axiomType{List OrderedCompletion DoubleFloat}) +++ +++ and one for least-squares problems i.e. optimization of a set of +++ observations of a data set: +++ +++ \axiomType{Record}(lfn:\axiomType{List Expression DoubleFloat}, +++ init:\axiomType{List DoubleFloat}). +++ + +LDFD ==> List DoubleFloat +LEDFD ==> List Expression DoubleFloat +LSAD ==> Record(lfn:LEDFD, init:LDFD) +UNOALSAD ==> Union(noa:NOAD,lsa:LSAD) +EDFD ==> Expression DoubleFloat +LOCDFD ==> List OrderedCompletion DoubleFloat +NOAD ==> Record(fn:EDFD, init:LDFD, lb:LOCDFD, cf:LEDFD, ub:LOCDFD) +NumericalOptimizationProblem():SetCategory with + + coerce: NOAD -> % + ++ coerce(x) \undocumented{} + coerce: LSAD -> % + ++ coerce(x) \undocumented{} + coerce: UNOALSAD -> % + ++ coerce(x) \undocumented{} + coerce: % -> OutputForm + ++ coerce(x) \undocumented{} + retract: % -> UNOALSAD + ++ retract(x) \undocumented{} + + == + + add + Rep := UNOALSAD + + coerce(s:NOAD) == [s] + coerce(s:LSAD) == [s] + coerce(x:UNOALSAD) == x + coerce(x:%):OutputForm == + (x) case noa => (x.noa)::OutputForm + (x.lsa)::OutputForm + retract(x:%):UNOALSAD == + (x) case noa => [x.noa] + [x.lsa] + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain PDEPROB NumericalPDEProblem} +\pagehead{NumericalPDEProblem}{PDEPROB} +\pagepic{ps/v103numericalpdeproblem.ps}{PDEPROB}{1.00} +<>= +)abbrev domain PDEPROB NumericalPDEProblem +++ Author: Brian Dupee +++ Date Created: December 1997 +++ Date Last Updated: December 1997 +++ Basic Operations: coerce, retract +++ Related Constructors: Union +++ Description: +++ \axiomType{NumericalPDEProblem} is a \axiom{domain} +++ for the representation of Numerical PDE problems for use +++ by ANNA. +++ +++ The representation is of type: +++ +++ \axiomType{Record}(pde:\axiomType{List Expression DoubleFloat}, +++ constraints:\axiomType{List PDEC}, +++ f:\axiomType{List List Expression DoubleFloat}, +++ st:\axiomType{String}, +++ tol:\axiomType{DoubleFloat}) +++ +++ where \axiomType{PDEC} is of type: +++ +++ \axiomType{Record}(start:\axiomType{DoubleFloat}, +++ finish:\axiomType{DoubleFloat}, +++ grid:\axiomType{NonNegativeInteger}, +++ boundaryType:\axiomType{Integer}, +++ dStart:\axiomType{Matrix DoubleFloat}, +++ dFinish:\axiomType{Matrix DoubleFloat}) +++ + +DFC ==> DoubleFloat +NNIC ==> NonNegativeInteger +INTC ==> Integer +MDFC ==> Matrix DoubleFloat +PDECC ==> Record(start:DFC, finish:DFC, grid:NNIC, boundaryType:INTC, + dStart:MDFC, dFinish:MDFC) +LEDFC ==> List Expression DoubleFloat +PDEBC ==> Record(pde:LEDFC, constraints:List PDECC, f:List LEDFC, + st:String, tol:DFC) +NumericalPDEProblem():SetCategory with + + coerce: PDEBC -> % + ++ coerce(x) \undocumented{} + coerce: % -> OutputForm + ++ coerce(x) \undocumented{} + retract: % -> PDEBC + ++ retract(x) \undocumented{} + + == + + add + Rep := PDEBC + + coerce(s:PDEBC) == s + coerce(x:%):OutputForm == + (retract(x))::OutputForm + retract(x:%):PDEBC == x :: Rep + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\chapter{Chapter O} +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain ARRAY1 OneDimensionalArray} +<>= +-- array1.spad.pamphlet OneDimensionalArray.input +)spool OneDimensionalArray.output +)set message test on +)set message auto off +)clear all +--S 1 of 9 +oneDimensionalArray [i**2 for i in 1..10] +--R +--R +--R (1) [1,4,9,16,25,36,49,64,81,100] +--R Type: OneDimensionalArray PositiveInteger +--E 1 + +--S 2 of 9 +a : ARRAY1 INT := new(10,0) +--R +--R +--R (2) [0,0,0,0,0,0,0,0,0,0] +--R Type: OneDimensionalArray Integer +--E 2 + +--S 3 of 9 +for i in 1..10 repeat a.i := i; a +--R +--R +--R (3) [1,2,3,4,5,6,7,8,9,10] +--R Type: OneDimensionalArray Integer +--E 3 + +--S 4 of 9 +map!(i +-> i ** 2,a); a +--R +--R +--R (4) [1,4,9,16,25,36,49,64,81,100] +--R Type: OneDimensionalArray Integer +--E 4 + +--S 5 of 9 +reverse! a +--R +--R +--R (5) [100,81,64,49,36,25,16,9,4,1] +--R Type: OneDimensionalArray Integer +--E 5 + +--S 6 of 9 +swap!(a,4,5); a +--R +--R +--R (6) [100,81,64,36,49,25,16,9,4,1] +--R Type: OneDimensionalArray Integer +--E 6 + +--S 7 of 9 +sort! a +--R +--R +--R (7) [1,4,9,16,25,36,49,64,81,100] +--R Type: OneDimensionalArray Integer +--E 7 + +--S 8 of 9 +b := a(6..10) +--R +--R +--R (8) [36,49,64,81,100] +--R Type: OneDimensionalArray Integer +--E 8 + +--S 9 of 9 +copyInto!(a,b,1) +--R +--R +--R (9) [36,49,64,81,100,36,49,64,81,100] +--R Type: OneDimensionalArray Integer +--E 9 +)spool +)lisp (bye) +@ +<>= +==================================================================== +OneDimensionalArray examples +==================================================================== + +The OneDimensionalArray domain is used for storing data in a +one-dimensional indexed data structure. Such an array is a +homogeneous data structure in that all the entries of the array must +belong to the same Axiom domain. Each array has a fixed length +specified by the user and arrays are not extensible. The indexing of +one-dimensional arrays is one-based. This means that the "first" +element of an array is given the index 1. + +To create a one-dimensional array, apply the operation +oneDimensionalArray to a list. + + oneDimensionalArray [i**2 for i in 1..10] + [1,4,9,16,25,36,49,64,81,100] + Type: OneDimensionalArray PositiveInteger + +Another approach is to first create a, a one-dimensional array of 10 +0's. OneDimensionalArray has the convenient abbreviation ARRAY1. + + a : ARRAY1 INT := new(10,0) + [0,0,0,0,0,0,0,0,0,0] + Type: OneDimensionalArray Integer + +Set each i-th element to i, then display the result. + + for i in 1..10 repeat a.i := i; a + [1,2,3,4,5,6,7,8,9,10] + Type: OneDimensionalArray Integer + +Square each element by mapping the function i +-> i^2 onto each element. + + map!(i +-> i ** 2,a); a + [1,4,9,16,25,36,49,64,81,100] + Type: OneDimensionalArray Integer + +Reverse the elements in place. + + reverse! a + [100,81,64,49,36,25,16,9,4,1] + Type: OneDimensionalArray Integer + +Swap the 4th and 5th element. + + swap!(a,4,5); a + [100,81,64,36,49,25,16,9,4,1] + Type: OneDimensionalArray Integer + +Sort the elements in place. + + sort! a + [1,4,9,16,25,36,49,64,81,100] + Type: OneDimensionalArray Integer + +Create a new one-dimensional array b containing the last 5 elements of a. + + b := a(6..10) + [36,49,64,81,100] + Type: OneDimensionalArray Integer + +Replace the first 5 elements of a with those of b. + + copyInto!(a,b,1) + [36,49,64,81,100,36,49,64,81,100] + Type: OneDimensionalArray Integer + +See Also: +o )help Vector +o )help FlexibleArray +o )show OneDimensionalArray +o $AXIOM/doc/src/algebra/array1.spad.dvi + +@ +<>= +"ARRAY1" -> "A1AGG" +"OneDimensionalArray(a:Type)" -> "OneDimensionalArrayAggregate(a:Type)" +@ +\pagehead{OneDimensionalArray}{ARRAY1} +\pagepic{ps/v103onedimensionalarray.ps}{ARRAY1}{1.00} +<>= +)abbrev domain ARRAY1 OneDimensionalArray +++ This is the domain of 1-based one dimensional arrays + +OneDimensionalArray(S:Type): Exports == Implementation where + ARRAYMININDEX ==> 1 -- if you want to change this, be my guest + Exports == OneDimensionalArrayAggregate S with + oneDimensionalArray: List S -> % + ++ oneDimensionalArray(l) creates an array from a list of elements l + ++ + ++X oneDimensionalArray [i**2 for i in 1..10] + + oneDimensionalArray: (NonNegativeInteger, S) -> % + ++ oneDimensionalArray(n,s) creates an array from n copies of element s + ++ + ++X oneDimensionalArray(10,0.0) + + Implementation == IndexedOneDimensionalArray(S, ARRAYMININDEX) add + oneDimensionalArray(u) == + n := #u + n = 0 => empty() + a := new(n, first u) + for i in 2..n for x in rest u repeat a.i := x + a + oneDimensionalArray(n,s) == new(n,s) + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\chapter{Chapter P} +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain ACPLOT PlaneAlgebraicCurvePlot} +<>= +-- acplot.spad.pamphlet PlaneAlgebraicCurvePlot.input +)spool PlaneAlgebraicCurvePlot.output +)set message test on +)set message auto off +)clear all +--S 1 of 1 +makeSketch(x+y,x,y,-1/2..1/2,-1/2..1/2)$ACPLOT +--R (1) ACPLOT +--R 1 1 1 1 +--R y + x = 0, - - <= x <= -, - - <= y <= - +--R 2 2 2 2 +--R [0.5,- 0.5] +--R [- 0.5,0.5] +--R Type: PlaneAlgebraicCurvePlot +--E 1 +)spool +)lisp (bye) +@ +<>= +==================================================================== +PlaneAlgebraicCurvePlot examples +==================================================================== + + makeSketch(x+y,x,y,-1/2..1/2,-1/2..1/2)$ACPLOT + +See Also: +o )show PlaneAlgebraicCurvePlot +o $AXIOM/doc/src/algebra/acplot.spad.dvi + +@ +<>= +"ACPLOT" -> "PPCURVE" +"PlaneAlgebraicCurvePlot()" -> "PlottablePlaneCurveCategory()" +@ +\pagehead{PlaneAlgebraicCurvePlot}{ACPLOT} +\pagepic{ps/v103planealgebraiccurveplot.ps}{ACPLOT}{1.00} +<>= +--% PlaneAlgebraicCurvePlot +++ Plot a NON-SINGULAR plane algebraic curve p(x,y) = 0. +++ Author: Clifton J. Williamson and Timothy Daly +++ Date Created: Fall 1988 +++ Date Last Updated: 27 April 1990 +++ Keywords: algebraic curve, non-singular, plot +++ Examples: +++ References: + +)abbrev domain ACPLOT PlaneAlgebraicCurvePlot + +PlaneAlgebraicCurvePlot(): PlottablePlaneCurveCategory _ + with + + makeSketch:(Polynomial Integer,Symbol,Symbol,Segment Fraction Integer,_ + Segment Fraction Integer) -> % + ++ makeSketch(p,x,y,a..b,c..d) creates an ACPLOT of the + ++ curve \spad{p = 0} in the region {\em a <= x <= b, c <= y <= d}. + ++ More specifically, 'makeSketch' plots a non-singular algebraic curve + ++ \spad{p = 0} in an rectangular region {\em xMin <= x <= xMax}, + ++ {\em yMin <= y <= yMax}. The user inputs + ++ \spad{makeSketch(p,x,y,xMin..xMax,yMin..yMax)}. + ++ Here p is a polynomial in the variables x and y with + ++ integer coefficients (p belongs to the domain + ++ \spad{Polynomial Integer}). The case + ++ where p is a polynomial in only one of the variables is + ++ allowed. The variables x and y are input to specify the + ++ the coordinate axes. The horizontal axis is the x-axis and + ++ the vertical axis is the y-axis. The rational numbers + ++ xMin,...,yMax specify the boundaries of the region in + ++ which the curve is to be plotted. + refine:(%,DoubleFloat) -> % + ++ refine(p,x) \undocumented{} + + == add + + import PointPackage DoubleFloat + import Plot + import RealSolvePackage + + BoundaryPts ==> Record(left: List Point DoubleFloat,_ + right: List Point DoubleFloat,_ + bottom: List Point DoubleFloat,_ + top: List Point DoubleFloat) + + NewPtInfo ==> Record(newPt: Point DoubleFloat,_ + type: String) + + Corners ==> Record(minXVal: DoubleFloat,_ + maxXVal: DoubleFloat,_ + minYVal: DoubleFloat,_ + maxYVal: DoubleFloat) + + kinte ==> solve$RealSolvePackage() + + rsolve ==> realSolve$RealSolvePackage() + + singValBetween?:(DoubleFloat,DoubleFloat,List DoubleFloat) -> Boolean + + segmentInfo:(DoubleFloat -> DoubleFloat,DoubleFloat,DoubleFloat,_ + List DoubleFloat,List DoubleFloat,List DoubleFloat,_ + DoubleFloat,DoubleFloat) -> _ + Record(seg:Segment DoubleFloat,_ + left: DoubleFloat,_ + lowerVals: List DoubleFloat,_ + upperVals:List DoubleFloat) + + swapCoords:Point DoubleFloat -> Point DoubleFloat + + samePlottedPt?:(Point DoubleFloat,Point DoubleFloat) -> Boolean + + findPtOnList:(Point DoubleFloat,List Point DoubleFloat) -> _ + Union(Point DoubleFloat,"failed") + + makeCorners:(DoubleFloat,DoubleFloat,DoubleFloat,DoubleFloat) -> Corners + + getXMin: Corners -> DoubleFloat + + getXMax: Corners -> DoubleFloat + + getYMin: Corners -> DoubleFloat + + getYMax: Corners -> DoubleFloat + + SFPolyToUPoly:Polynomial DoubleFloat -> _ + SparseUnivariatePolynomial DoubleFloat + + RNPolyToUPoly:Polynomial Fraction Integer -> _ + SparseUnivariatePolynomial Fraction Integer + + coerceCoefsToSFs:Polynomial Integer -> Polynomial DoubleFloat + + coerceCoefsToRNs:Polynomial Integer -> Polynomial Fraction Integer + + RNtoSF:Fraction Integer -> DoubleFloat + + RNtoNF:Fraction Integer -> Float + + SFtoNF:DoubleFloat -> Float + + listPtsOnHorizBdry:(Polynomial Fraction Integer,Symbol,Fraction Integer,_ + Float,Float) -> _ + List Point DoubleFloat + + listPtsOnVertBdry:(Polynomial Fraction Integer,Symbol,Fraction Integer,_ + Float,Float) -> _ + List Point DoubleFloat + + listPtsInRect:(List List Float,Float,Float,Float,Float) -> _ + List Point DoubleFloat + + ptsSuchThat?:(List List Float,List Float -> Boolean) -> Boolean + + inRect?:(List Float,Float,Float,Float,Float) -> Boolean + + onHorzSeg?:(List Float,Float,Float,Float) -> Boolean + + onVertSeg?:(List Float,Float,Float,Float) -> Boolean + + newX:(List List Float,List List Float,Float,Float,Float,Fraction Integer,_ + Fraction Integer) -> Fraction Integer + + newY:(List List Float,List List Float,Float,Float,Float,_ + Fraction Integer,Fraction Integer) -> Fraction Integer + + makeOneVarSketch:(Polynomial Integer,Symbol,Symbol,Fraction Integer,_ + Fraction Integer,Fraction Integer,Fraction Integer,_ + Symbol) -> % + + makeLineSketch:(Polynomial Integer,Symbol,Symbol,Fraction Integer,_ + Fraction Integer,Fraction Integer,Fraction Integer) -> % + + makeRatFcnSketch:(Polynomial Integer,Symbol,Symbol,Fraction Integer,_ + Fraction Integer,Fraction Integer,Fraction Integer,_ + Symbol) -> % + + makeGeneralSketch:(Polynomial Integer,Symbol,Symbol,Fraction Integer,_ + Fraction Integer,Fraction Integer,Fraction Integer) -> % + + traceBranches:(Polynomial DoubleFloat,Polynomial DoubleFloat,_ + Polynomial DoubleFloat,Symbol,Symbol,Corners,DoubleFloat,_ + DoubleFloat,PositiveInteger, List Point DoubleFloat,_ + BoundaryPts) -> List List Point DoubleFloat + + dummyFirstPt:(Point DoubleFloat,Polynomial DoubleFloat,_ + Polynomial DoubleFloat,Symbol,Symbol,List Point DoubleFloat,_ + List Point DoubleFloat,List Point DoubleFloat,_ + List Point DoubleFloat) -> Point DoubleFloat + + listPtsOnSegment:(Polynomial DoubleFloat,Polynomial DoubleFloat,_ + Polynomial DoubleFloat,Symbol,Symbol,Point DoubleFloat,_ + Point DoubleFloat,Corners, DoubleFloat,DoubleFloat,_ + PositiveInteger,List Point DoubleFloat,_ + List Point DoubleFloat) -> List List Point DoubleFloat + + listPtsOnLoop:(Polynomial DoubleFloat,Polynomial DoubleFloat,_ + Polynomial DoubleFloat,Symbol,Symbol,Point DoubleFloat,_ + Corners, DoubleFloat,DoubleFloat,PositiveInteger,_ + List Point DoubleFloat,List Point DoubleFloat) -> _ + List List Point DoubleFloat + + computeNextPt:(Polynomial DoubleFloat,Polynomial DoubleFloat,_ + Polynomial DoubleFloat,Symbol,Symbol,Point DoubleFloat,_ + Point DoubleFloat,Corners, DoubleFloat,DoubleFloat,_ + PositiveInteger,List Point DoubleFloat,_ + List Point DoubleFloat) -> NewPtInfo + + newtonApprox:(SparseUnivariatePolynomial DoubleFloat, DoubleFloat, _ + DoubleFloat, PositiveInteger) -> Union(DoubleFloat, "failed") + +--% representation + + Rep := Record(poly : Polynomial Integer,_ + xVar : Symbol,_ + yVar : Symbol,_ + minXVal : Fraction Integer,_ + maxXVal : Fraction Integer,_ + minYVal : Fraction Integer,_ + maxYVal : Fraction Integer,_ + bdryPts : BoundaryPts,_ + hTanPts : List Point DoubleFloat,_ + vTanPts : List Point DoubleFloat,_ + branches: List List Point DoubleFloat) + +--% global constants + + EPSILON : Float := .000001 -- precision to which realSolve finds roots + PLOTERR : DoubleFloat := float(1,-3,10) + -- maximum allowable difference in each coordinate when + -- determining if 2 plotted points are equal + +--% global flags + + NADA : String := "nothing in particular" + BDRY : String := "boundary point" + CRIT : String := "critical point" + BOTTOM : String := "bottom" + TOP : String := "top" + +--% hacks + + NFtoSF: Float -> DoubleFloat + NFtoSF x == 0 + convert(x)$Float + +--% points + makePt: (DoubleFloat,DoubleFloat) -> Point DoubleFloat + makePt(xx,yy) == point(l : List DoubleFloat := [xx,yy]) + + swapCoords(pt) == makePt(yCoord pt,xCoord pt) + + samePlottedPt?(p0,p1) == + -- determines if p1 lies in a square with side 2 PLOTERR + -- centered at p0 + x0 := xCoord p0; y0 := yCoord p0 + x1 := xCoord p1; y1 := yCoord p1 + (abs(x1-x0) < PLOTERR) and (abs(y1-y0) < PLOTERR) + + findPtOnList(pt,pointList) == + for point in pointList repeat + samePlottedPt?(pt,point) => return point + "failed" + +--% corners + + makeCorners(xMinSF,xMaxSF,yMinSF,yMaxSF) == + [xMinSF,xMaxSF,yMinSF,yMaxSF] + + getXMin(corners) == corners.minXVal + getXMax(corners) == corners.maxXVal + getYMin(corners) == corners.minYVal + getYMax(corners) == corners.maxYVal + +--% coercions + + SFPolyToUPoly(p) == + -- 'p' is of type Polynomial, but has only one variable + zero? p => 0 + monomial(leadingCoefficient p,totalDegree p) + + SFPolyToUPoly(reductum p) + + RNPolyToUPoly(p) == + -- 'p' is of type Polynomial, but has only one variable + zero? p => 0 + monomial(leadingCoefficient p,totalDegree p) + + RNPolyToUPoly(reductum p) + + coerceCoefsToSFs(p) == + -- coefficients of 'p' are coerced to be DoubleFloat's + map(coerce,p)$PolynomialFunctions2(Integer,DoubleFloat) + + coerceCoefsToRNs(p) == + -- coefficients of 'p' are coerced to be DoubleFloat's + map(coerce,p)$PolynomialFunctions2(Integer,Fraction Integer) + + RNtoSF(r) == coerce(r)@DoubleFloat + RNtoNF(r) == coerce(r)@Float + SFtoNF(x) == convert(x)@Float + +--% computation of special points + + listPtsOnHorizBdry(pRN,y,y0,xMinNF,xMaxNF) == + -- strict inequality here: corners on vertical boundary + pointList : List Point DoubleFloat := nil() + ySF := RNtoSF(y0) + f := eval(pRN,y,y0) + roots : List Float := kinte(f,EPSILON) + for root in roots repeat + if (xMinNF < root) and (root < xMaxNF) then + pointList := cons(makePt(NFtoSF root, ySF), pointList) + pointList + + listPtsOnVertBdry(pRN,x,x0,yMinNF,yMaxNF) == + pointList : List Point DoubleFloat := nil() + xSF := RNtoSF(x0) + f := eval(pRN,x,x0) + roots : List Float := kinte(f,EPSILON) + for root in roots repeat + if (yMinNF <= root) and (root <= yMaxNF) then + pointList := cons(makePt(xSF, NFtoSF root), pointList) + pointList + + listPtsInRect(points,xMin,xMax,yMin,yMax) == + pointList : List Point DoubleFloat := nil() + for point in points repeat + xx := first point; yy := second point + if (xMin<=xx) and (xx<=xMax) and (yMin<=yy) and (yy<=yMax) then + pointList := cons(makePt(NFtoSF xx,NFtoSF yy),pointList) + pointList + + ptsSuchThat?(points,pred) == + for point in points repeat + if pred point then return true + false + + inRect?(point,xMinNF,xMaxNF,yMinNF,yMaxNF) == + xx := first point; yy := second point + xMinNF <= xx and xx <= xMaxNF and yMinNF <= yy and yy <= yMaxNF + + onHorzSeg?(point,xMinNF,xMaxNF,yNF) == + xx := first point; yy := second point + yy = yNF and xMinNF <= xx and xx <= xMaxNF + + onVertSeg?(point,yMinNF,yMaxNF,xNF) == + xx := first point; yy := second point + xx = xNF and yMinNF <= yy and yy <= yMaxNF + + newX(vtanPts,singPts,yMinNF,yMaxNF,xNF,xRN,horizInc) == + xNewNF := xNF + RNtoNF horizInc + xRtNF := max(xNF,xNewNF); xLftNF := min(xNF,xNewNF) +-- ptsSuchThat?(singPts,inRect?(#1,xLftNF,xRtNF,yMinNF,yMaxNF)) => + foo : List Float -> Boolean := inRect?(#1,xLftNF,xRtNF,yMinNF,yMaxNF) + ptsSuchThat?(singPts,foo) => + newX(vtanPts,singPts,yMinNF,yMaxNF,xNF,xRN,_ + horizInc/2::(Fraction Integer)) +-- ptsSuchThat?(vtanPts,onVertSeg?(#1,yMinNF,yMaxNF,xNewNF)) => + goo : List Float -> Boolean := onVertSeg?(#1,yMinNF,yMaxNF,xNewNF) + ptsSuchThat?(vtanPts,goo) => + newX(vtanPts,singPts,yMinNF,yMaxNF,xNF,xRN,_ + horizInc/2::(Fraction Integer)) + xRN + horizInc + + newY(htanPts,singPts,xMinNF,xMaxNF,yNF,yRN,vertInc) == + yNewNF := yNF + RNtoNF vertInc + yTopNF := max(yNF,yNewNF); yBotNF := min(yNF,yNewNF) +-- ptsSuchThat?(singPts,inRect?(#1,xMinNF,xMaxNF,yBotNF,yTopNF)) => + foo : List Float -> Boolean := inRect?(#1,xMinNF,xMaxNF,yBotNF,yTopNF) + ptsSuchThat?(singPts,foo) => + newY(htanPts,singPts,xMinNF,xMaxNF,yNF,yRN,_ + vertInc/2::(Fraction Integer)) +-- ptsSuchThat?(htanPts,onHorzSeg?(#1,xMinNF,xMaxNF,yNewNF)) => + goo : List Float -> Boolean := onHorzSeg?(#1,xMinNF,xMaxNF,yNewNF) + ptsSuchThat?(htanPts,goo) => + newY(htanPts,singPts,xMinNF,xMaxNF,yNF,yRN,_ + vertInc/2::(Fraction Integer)) + yRN + vertInc + +--% creation of sketches + + makeSketch(p,x,y,xRange,yRange) == + xMin := lo xRange; xMax := hi xRange + yMin := lo yRange; yMax := hi yRange + -- test input for consistency + xMax <= xMin => + error "makeSketch: bad range for first variable" + yMax <= yMin => + error "makeSketch: bad range for second variable" + varList := variables p + # varList > 2 => + error "makeSketch: polynomial in more than 2 variables" + # varList = 0 => + error "makeSketch: constant polynomial" + -- polynomial in 1 variable + # varList = 1 => + (not member?(x,varList)) and (not member?(y,varList)) => + error "makeSketch: bad variables" + makeOneVarSketch(p,x,y,xMin,xMax,yMin,yMax,first varList) + -- polynomial in 2 variables + (not member?(x,varList)) or (not member?(y,varList)) => + error "makeSketch: bad variables" + totalDegree p = 1 => + makeLineSketch(p,x,y,xMin,xMax,yMin,yMax) + -- polynomial is linear in one variable + -- y is a rational function of x + degree(p,y) = 1 => + makeRatFcnSketch(p,x,y,xMin,xMax,yMin,yMax,y) + -- x is a rational function of y + degree(p,x) = 1 => + makeRatFcnSketch(p,x,y,xMin,xMax,yMin,yMax,x) + -- the general case + makeGeneralSketch(p,x,y,xMin,xMax,yMin,yMax) + +--% special cases + + makeOneVarSketch(p,x,y,xMin,xMax,yMin,yMax,var) == + -- the case where 'p' is a polynomial in only one variable + -- the graph consists of horizontal or vertical lines + if var = x then + minVal := RNtoNF xMin + maxVal := RNtoNF xMax + else + minVal := RNtoNF yMin + maxVal := RNtoNF yMax + lf : List Point DoubleFloat := nil() + rt : List Point DoubleFloat := nil() + bt : List Point DoubleFloat := nil() + tp : List Point DoubleFloat := nil() + htans : List Point DoubleFloat := nil() + vtans : List Point DoubleFloat := nil() + bran : List List Point DoubleFloat := nil() + roots := kinte(p,EPSILON) + sketchRoots : List DoubleFloat := nil() + for root in roots repeat + if (minVal <= root) and (root <= maxVal) then + sketchRoots := cons(NFtoSF root,sketchRoots) + null sketchRoots => + [p,x,y,xMin,xMax,yMin,yMax,[lf,rt,bt,tp],htans,vtans,bran] + if var = x then + yMinSF := RNtoSF yMin; yMaxSF := RNtoSF yMax + for rootSF in sketchRoots repeat + tp := cons(pt1 := makePt(rootSF,yMaxSF),tp) + bt := cons(pt2 := makePt(rootSF,yMinSF),bt) + branch : List Point DoubleFloat := [pt1,pt2] + bran := cons(branch,bran) + else + xMinSF := RNtoSF xMin; xMaxSF := RNtoSF xMax + for rootSF in sketchRoots repeat + rt := cons(pt1 := makePt(xMaxSF,rootSF),rt) + lf := cons(pt2 := makePt(xMinSF,rootSF),lf) + branch : List Point DoubleFloat := [pt1,pt2] + bran := cons(branch,bran) + [p,x,y,xMin,xMax,yMin,yMax,[lf,rt,bt,tp],htans,vtans,bran] + + makeLineSketch(p,x,y,xMin,xMax,yMin,yMax) == + -- the case where p(x,y) = a x + b y + c with a ^= 0, b ^= 0 + -- this is a line which is neither vertical nor horizontal + xMinSF := RNtoSF xMin; xMaxSF := RNtoSF xMax + yMinSF := RNtoSF yMin; yMaxSF := RNtoSF yMax + -- determine the coefficients a, b, and c + a := ground(coefficient(p,x,1)) :: DoubleFloat + b := ground(coefficient(p,y,1)) :: DoubleFloat + c := ground(coefficient(coefficient(p,x,0),y,0)) :: DoubleFloat + lf : List Point DoubleFloat := nil() + rt : List Point DoubleFloat := nil() + bt : List Point DoubleFloat := nil() + tp : List Point DoubleFloat := nil() + htans : List Point DoubleFloat := nil() + vtans : List Point DoubleFloat := nil() + branch : List Point DoubleFloat := nil() + bran : List List Point DoubleFloat := nil() + -- compute x coordinate of point on line with y = yMin + xBottom := (- b*yMinSF - c)/a + -- compute x coordinate of point on line with y = yMax + xTop := (- b*yMaxSF - c)/a + -- compute y coordinate of point on line with x = xMin + yLeft := (- a*xMinSF - c)/b + -- compute y coordinate of point on line with x = xMax + yRight := (- a*xMaxSF - c)/b + -- determine which of the above 4 points are in the region + -- to be plotted and list them as a branch + if (xMinSF < xBottom) and (xBottom < xMaxSF) then + bt := cons(pt := makePt(xBottom,yMinSF),bt) + branch := cons(pt,branch) + if (xMinSF < xTop) and (xTop < xMaxSF) then + tp := cons(pt := makePt(xTop,yMaxSF),tp) + branch := cons(pt,branch) + if (yMinSF <= yLeft) and (yLeft <= yMaxSF) then + lf := cons(pt := makePt(xMinSF,yLeft),lf) + branch := cons(pt,branch) + if (yMinSF <= yRight) and (yRight <= yMaxSF) then + rt := cons(pt := makePt(xMaxSF,yRight),rt) + branch := cons(pt,branch) + bran := cons(branch,bran) + [p,x,y,xMin,xMax,yMin,yMax,[lf,rt,bt,tp],htans,vtans,bran] + + singValBetween?(xCurrent,xNext,xSingList) == + for xVal in xSingList repeat + (xCurrent < xVal) and (xVal < xNext) => return true + false + + segmentInfo(f,lo,hi,botList,topList,singList,minSF,maxSF) == + repeat + -- 'current' is the smallest element of 'topList' and 'botList' + -- 'currentFrom' records the list from which it was taken + if null topList then + if null botList then + return [segment(lo,hi),hi,nil(),nil()] + else + current := first botList + botList := rest botList + currentFrom := BOTTOM + else + if null botList then + current := first topList + topList := rest topList + currentFrom := TOP + else + bot := first botList + top := first topList + if bot < top then + current := bot + botList := rest botList + currentFrom := BOTTOM + else + current := top + topList := rest topList + currentFrom := TOP + -- 'nxt' is the next smallest element of 'topList' + -- and 'botList' + -- 'nextFrom' records the list from which it was taken + if null topList then + if null botList then + return [segment(lo,hi),hi,nil(),nil()] + else + nxt := first botList + botList := rest botList + nextFrom := BOTTOM + else + if null botList then + nxt := first topList + topList := rest topList + nextFrom := TOP + else + bot := first botList + top := first topList + if bot < top then + nxt := bot + botList := rest botList + nextFrom := BOTTOM + else + nxt := top + topList := rest topList + nextFrom := TOP + if currentFrom = nextFrom then + if singValBetween?(current,nxt,singList) then + return [segment(lo,current),nxt,botList,topList] + else + val := f((nxt - current)/2::DoubleFloat) + if (val <= minSF) or (val >= maxSF) then + return [segment(lo,current),nxt,botList,topList] + else + if singValBetween?(current,nxt,singList) then + return [segment(lo,current),nxt,botList,topList] + + makeRatFcnSketch(p,x,y,xMin,xMax,yMin,yMax,depVar) == + -- the case where p(x,y) is linear in x or y + -- Thus, one variable is a rational function of the other. + -- Therefore, we may use the 2-dimensional function plotting + -- package. The only problem is determining the intervals on + -- on which the function is to be plotted. + --!! corners: e.g. upper left corner is on graph with y' > 0 + factoredP := p ::(Factored Polynomial Integer) + numberOfFactors(factoredP) > 1 => + error "reducible polynomial" --!! sketch each factor + dpdx := differentiate(p,x) + dpdy := differentiate(p,y) + pRN := coerceCoefsToRNs p + xMinSF := RNtoSF xMin; xMaxSF := RNtoSF xMax + yMinSF := RNtoSF yMin; yMaxSF := RNtoSF yMax + xMinNF := RNtoNF xMin; xMaxNF := RNtoNF xMax + yMinNF := RNtoNF yMin; yMaxNF := RNtoNF yMax + -- 'p' is of degree 1 in the variable 'depVar'. + -- Thus, 'depVar' is a rational function of the other variable. + num := -coefficient(p,depVar,0) + den := coefficient(p,depVar,1) + numUPolySF := SFPolyToUPoly(coerceCoefsToSFs(num)) + denUPolySF := SFPolyToUPoly(coerceCoefsToSFs(den)) + -- this is the rational function + f : DoubleFloat -> DoubleFloat := elt(numUPolySF,#1)/elt(denUPolySF,#1) + -- values of the dependent and independent variables + if depVar = x then + indVarMin := yMin; indVarMax := yMax + indVarMinNF := yMinNF; indVarMaxNF := yMaxNF + indVarMinSF := yMinSF; indVarMaxSF := yMaxSF + depVarMin := xMin; depVarMax := xMax + depVarMinSF := xMinSF; depVarMaxSF := xMaxSF + else + indVarMin := xMin; indVarMax := xMax + indVarMinNF := xMinNF; indVarMaxNF := xMaxNF + indVarMinSF := xMinSF; indVarMaxSF := xMaxSF + depVarMin := yMin; depVarMax := yMax + depVarMinSF := yMinSF; depVarMaxSF := yMaxSF + -- Create lists of critical points. + htanPts := rsolve([p,dpdx],[x,y],EPSILON) + vtanPts := rsolve([p,dpdy],[x,y],EPSILON) + htans := listPtsInRect(htanPts,xMinNF,xMaxNF,yMinNF,yMaxNF) + vtans := listPtsInRect(vtanPts,xMinNF,xMaxNF,yMinNF,yMaxNF) + -- Create lists which will contain boundary points. + lf : List Point DoubleFloat := nil() + rt : List Point DoubleFloat := nil() + bt : List Point DoubleFloat := nil() + tp : List Point DoubleFloat := nil() + -- Determine values of the independent variable at the which + -- the rational function has a pole as well as the values of + -- the independent variable for which there is a point on the + -- upper or lower boundary. + singList : List DoubleFloat := + roots : List Float := kinte(den,EPSILON) + outList : List DoubleFloat := nil() + for root in roots repeat + if (indVarMinNF < root) and (root < indVarMaxNF) then + outList := cons(NFtoSF root,outList) + sort(#1 < #2,outList) + topList : List DoubleFloat := + roots : List Float := kinte(eval(pRN,depVar,depVarMax),EPSILON) + outList : List DoubleFloat := nil() + for root in roots repeat + if (indVarMinNF < root) and (root < indVarMaxNF) then + outList := cons(NFtoSF root,outList) + sort(#1 < #2,outList) + botList : List DoubleFloat := + roots : List Float := kinte(eval(pRN,depVar,depVarMin),EPSILON) + outList : List DoubleFloat := nil() + for root in roots repeat + if (indVarMinNF < root) and (root < indVarMaxNF) then + outList := cons(NFtoSF root,outList) + sort(#1 < #2,outList) + -- We wish to determine if the graph has points on the 'left' + -- and 'right' boundaries, so we compute the value of the + -- rational function at the lefthand and righthand values of + -- the dependent variable. If the function has a singularity + -- on the left or right boundary, then 'leftVal' or 'rightVal' + -- is given a dummy valuewhich will convince the program that + -- there is no point on the left or right boundary. + denUPolyRN := RNPolyToUPoly(coerceCoefsToRNs(den)) + if elt(denUPolyRN,indVarMin) = 0$(Fraction Integer) then + leftVal := depVarMinSF - (abs(depVarMinSF) + 1$DoubleFloat) + else + leftVal := f(indVarMinSF) + if elt(denUPolyRN,indVarMax) = 0$(Fraction Integer) then + rightVal := depVarMinSF - (abs(depVarMinSF) + 1$DoubleFloat) + else + rightVal := f(indVarMaxSF) + -- Now put boundary points on the appropriate lists. + if depVar = x then + if (xMinSF < leftVal) and (leftVal < xMaxSF) then + bt := cons(makePt(leftVal,yMinSF),bt) + if (xMinSF < rightVal) and (rightVal < xMaxSF) then + tp := cons(makePt(rightVal,yMaxSF),tp) + for val in botList repeat + lf := cons(makePt(xMinSF,val),lf) + for val in topList repeat + rt := cons(makePt(xMaxSF,val),rt) + else + if (yMinSF < leftVal) and (leftVal < yMaxSF) then + lf := cons(makePt(xMinSF,leftVal),lf) + if (yMinSF < rightVal) and (rightVal < yMaxSF) then + rt := cons(makePt(xMaxSF,rightVal),rt) + for val in botList repeat + bt := cons(makePt(val,yMinSF),bt) + for val in topList repeat + tp := cons(makePt(val,yMaxSF),tp) + bran : List List Point DoubleFloat := nil() + -- Determine segments on which the rational function is to + -- be plotted. + if (depVarMinSF < leftVal) and (leftVal < depVarMaxSF) then + lo := indVarMinSF + else + if null topList then + if null botList then + return [p,x,y,xMin,xMax,yMin,yMax,[lf,rt,bt,tp],_ + htans,vtans,bran] + else + lo := first botList + botList := rest botList + else + if null botList then + lo := first topList + topList := rest topList + else + bot := first botList + top := first topList + if bot < top then + lo := bot + botList := rest botList + else + lo := top + topList := rest topList + hi := 0$DoubleFloat -- @#$%^&* compiler + if (depVarMinSF < rightVal) and (rightVal < depVarMaxSF) then + hi := indVarMaxSF + else + if null topList then + if null botList then + error "makeRatFcnSketch: plot domain" + else + hi := last botList + botList := remove(hi,botList) + else + if null botList then + hi := last topList + topList := remove(hi,topList) + else + bot := last botList + top := last topList + if bot > top then + hi := bot + botList := remove(hi,botList) + else + hi := top + topList := remove(hi,topList) + if (depVar = x) then + (minSF := xMinSF; maxSF := xMaxSF) + else + (minSF := yMinSF; maxSF := yMaxSF) + segList : List Segment DoubleFloat := nil() + repeat + segInfo := segmentInfo(f,lo,hi,botList,topList,singList,_ + minSF,maxSF) + segList := cons(segInfo.seg,segList) + lo := segInfo.left + botList := segInfo.lowerVals + topList := segInfo.upperVals + if lo = hi then break + for segment in segList repeat + RFPlot : Plot := plot(f,segment) + curve := first(listBranches(RFPlot)) + if depVar = y then + bran := cons(curve,bran) + else + bran := cons(map(swapCoords,curve),bran) + [p,x,y,xMin,xMax,yMin,yMax,[lf,rt,bt,tp],htans,vtans,bran] + +--% the general case + + makeGeneralSketch(pol,x,y,xMin,xMax,yMin,yMax) == + --!! corners of region should not be on curve + --!! enlarge region if necessary + factoredPol := pol :: (Factored Polynomial Integer) + numberOfFactors(factoredPol) > 1 => + error "reducible polynomial" --!! sketch each factor + p := nthFactor(factoredPol,1) + dpdx := differentiate(p,x); dpdy := differentiate(p,y) + xMinNF := RNtoNF xMin; xMaxNF := RNtoNF xMax + yMinNF := RNtoNF yMin; yMaxNF := RNtoNF yMax + -- compute singular points; error if singularities in region + singPts := rsolve([p,dpdx,dpdy],[x,y],EPSILON) +-- ptsSuchThat?(singPts,inRect?(#1,xMinNF,xMaxNF,yMinNF,yMaxNF)) => + foo : List Float -> Boolean := inRect?(#1,xMinNF,xMaxNF,yMinNF,yMaxNF) + ptsSuchThat?(singPts,foo) => + error "singular pts in region of sketch" + -- compute critical points + htanPts := rsolve([p,dpdx],[x,y],EPSILON) + vtanPts := rsolve([p,dpdy],[x,y],EPSILON) + critPts := append(htanPts,vtanPts) + -- if there are critical points on the boundary, then enlarge + -- the region, but be sure that the new region does not contain + -- any singular points + hInc : Fraction Integer := (1/20) * (xMax - xMin) + vInc : Fraction Integer := (1/20) * (yMax - yMin) +-- if ptsSuchThat?(critPts,onVertSeg?(#1,yMinNF,yMaxNF,xMinNF)) then + foo : List Float -> Boolean := onVertSeg?(#1,yMinNF,yMaxNF,xMinNF) + if ptsSuchThat?(critPts,foo) then + xMin := newX(critPts,singPts,yMinNF,yMaxNF,xMinNF,xMin,-hInc) + xMinNF := RNtoNF xMin +-- if ptsSuchThat?(critPts,onVertSeg?(#1,yMinNF,yMaxNF,xMaxNF)) then + foo : List Float -> Boolean := onVertSeg?(#1,yMinNF,yMaxNF,xMaxNF) + if ptsSuchThat?(critPts,foo) then + xMax := newX(critPts,singPts,yMinNF,yMaxNF,xMaxNF,xMax,hInc) + xMaxNF := RNtoNF xMax +-- if ptsSuchThat?(critPts,onHorzSeg?(#1,xMinNF,xMaxNF,yMinNF)) then + foo : List Float -> Boolean := onHorzSeg?(#1,xMinNF,xMaxNF,yMinNF) + if ptsSuchThat?(critPts,foo) then + yMin := newY(critPts,singPts,xMinNF,xMaxNF,yMinNF,yMin,-vInc) + yMinNF := RNtoNF yMin +-- if ptsSuchThat?(critPts,onHorzSeg?(#1,xMinNF,xMaxNF,yMaxNF)) then + foo : List Float -> Boolean := onHorzSeg?(#1,xMinNF,xMaxNF,yMaxNF) + if ptsSuchThat?(critPts,foo) then + yMax := newY(critPts,singPts,xMinNF,xMaxNF,yMaxNF,yMax,vInc) + yMaxNF := RNtoNF yMax + htans := listPtsInRect(htanPts,xMinNF,xMaxNF,yMinNF,yMaxNF) + vtans := listPtsInRect(vtanPts,xMinNF,xMaxNF,yMinNF,yMaxNF) + crits := append(htans,vtans) + -- conversions to DoubleFloats + xMinSF := RNtoSF xMin; xMaxSF := RNtoSF xMax + yMinSF := RNtoSF yMin; yMaxSF := RNtoSF yMax + corners := makeCorners(xMinSF,xMaxSF,yMinSF,yMaxSF) + pSF := coerceCoefsToSFs p + dpdxSF := coerceCoefsToSFs dpdx + dpdySF := coerceCoefsToSFs dpdy + delta := min((xMaxSF - xMinSF)/25,(yMaxSF - yMinSF)/25) + err := min(delta/100,PLOTERR/100) + bound : PositiveInteger := 10 + -- compute points on the boundary + pRN := coerceCoefsToRNs(p) + lf : List Point DoubleFloat := + listPtsOnVertBdry(pRN,x,xMin,yMinNF,yMaxNF) + rt : List Point DoubleFloat := + listPtsOnVertBdry(pRN,x,xMax,yMinNF,yMaxNF) + bt : List Point DoubleFloat := + listPtsOnHorizBdry(pRN,y,yMin,xMinNF,xMaxNF) + tp : List Point DoubleFloat := + listPtsOnHorizBdry(pRN,y,yMax,xMinNF,xMaxNF) + bdPts : BoundaryPts := [lf,rt,bt,tp] + bran := traceBranches(pSF,dpdxSF,dpdySF,x,y,corners,delta,err,_ + bound,crits,bdPts) + [p,x,y,xMin,xMax,yMin,yMax,bdPts,htans,vtans,bran] + + refine(plot,stepFraction) == + p := plot.poly; x := plot.xVar; y := plot.yVar + dpdx := differentiate(p,x); dpdy := differentiate(p,y) + pSF := coerceCoefsToSFs p + dpdxSF := coerceCoefsToSFs dpdx + dpdySF := coerceCoefsToSFs dpdy + xMin := plot.minXVal; xMax := plot.maxXVal + yMin := plot.minYVal; yMax := plot.maxYVal + xMinSF := RNtoSF xMin; xMaxSF := RNtoSF xMax + yMinSF := RNtoSF yMin; yMaxSF := RNtoSF yMax + corners := makeCorners(xMinSF,xMaxSF,yMinSF,yMaxSF) + pSF := coerceCoefsToSFs p + dpdxSF := coerceCoefsToSFs dpdx + dpdySF := coerceCoefsToSFs dpdy + delta := + stepFraction * min((xMaxSF - xMinSF)/25,(yMaxSF - yMinSF)/25) + err := min(delta/100,PLOTERR/100) + bound : PositiveInteger := 10 + crits := append(plot.hTanPts,plot.vTanPts) + bdPts := plot.bdryPts + bran := traceBranches(pSF,dpdxSF,dpdySF,x,y,corners,delta,err,_ + bound,crits,bdPts) + htans := plot.hTanPts; vtans := plot.vTanPts + [p,x,y,xMin,xMax,yMin,yMax,bdPts,htans,vtans,bran] + + traceBranches(pSF,dpdxSF,dpdySF,x,y,corners,delta,err,bound,_ + crits,bdPts) == + -- for boundary points, trace curve from boundary to boundary + -- add the branch to the list of branches + -- update list of boundary points by deleting first and last + -- points on this branch + -- update list of critical points by deleting any critical + -- points which were plotted + lf := bdPts.left; rt := bdPts.right + tp := bdPts.top ; bt := bdPts.bottom + bdry := append(append(lf,rt),append(bt,tp)) + bran : List List Point DoubleFloat := nil() + while not null bdry repeat + pt := first bdry + p0 := dummyFirstPt(pt,dpdxSF,dpdySF,x,y,lf,rt,bt,tp) + segInfo := listPtsOnSegment(pSF,dpdxSF,dpdySF,x,y,p0,pt,_ + corners,delta,err,bound,crits,bdry) + bran := cons(first segInfo,bran) + crits := second segInfo + bdry := third segInfo + -- trace loops beginning and ending with critical points + -- add the branch to the list of branches + -- update list of critical points by deleting any critical + -- points which were plotted + while not null crits repeat + pt := first crits + segInfo := listPtsOnLoop(pSF,dpdxSF,dpdySF,x,y,pt,_ + corners,delta,err,bound,crits,bdry) + bran := cons(first segInfo,bran) + crits := second segInfo + bran + + dummyFirstPt(p1,dpdxSF,dpdySF,x,y,lf,rt,bt,tp) == + -- The function 'computeNextPt' requires 2 points, p0 and p1. + -- When computing the second point on a branch which starts + -- on the boundary, we use the boundary point as p1 and the + -- 'dummy' point returned by this function as p0. + x1 := xCoord p1; y1 := yCoord p1 + zero := 0$DoubleFloat; one := 1$DoubleFloat + px := ground(eval(dpdxSF,[x,y],[x1,y1])) + py := ground(eval(dpdySF,[x,y],[x1,y1])) + if px * py < zero then -- positive slope at p1 + member?(p1,lf) or member?(p1,bt) => + makePt(x1 - one,y1 - one) + makePt(x1 + one,y1 + one) + else + member?(p1,lf) or member?(p1,tp) => + makePt(x1 - one,y1 + one) + makePt(x1 + one,y1 - one) + + + listPtsOnSegment(pSF,dpdxSF,dpdySF,x,y,p0,p1,corners,_ + delta,err,bound,crits,bdry) == + -- p1 is a boundary point; p0 is a 'dummy' point + bdry := remove(p1,bdry) + pointList : List Point DoubleFloat := [p1] + ptInfo := computeNextPt(pSF,dpdxSF,dpdySF,x,y,p0,p1,corners,_ + delta,err,bound,crits,bdry) + p2 := ptInfo.newPt + ptInfo.type = BDRY => + bdry := remove(p2,bdry) + pointList := cons(p2,pointList) + [pointList,crits,bdry] + if ptInfo.type = CRIT then crits := remove(p2,crits) + pointList := cons(p2,pointList) + repeat + pt0 := second pointList; pt1 := first pointList + ptInfo := computeNextPt(pSF,dpdxSF,dpdySF,x,y,pt0,pt1,corners,_ + delta,err,bound,crits,bdry) + p2 := ptInfo.newPt + ptInfo.type = BDRY => + bdry := remove(p2,bdry) + pointList := cons(p2,pointList) + return [pointList,crits,bdry] + if ptInfo.type = CRIT then crits := remove(p2,crits) + pointList := cons(p2,pointList) + --!! delete next line (compiler bug) + [pointList,crits,bdry] + + + listPtsOnLoop(pSF,dpdxSF,dpdySF,x,y,p1,corners,_ + delta,err,bound,crits,bdry) == + x1 := xCoord p1; y1 := yCoord p1 + px := ground(eval(dpdxSF,[x,y],[x1,y1])) + py := ground(eval(dpdySF,[x,y],[x1,y1])) + p0 := makePt(x1 - 1$DoubleFloat,y1 - 1$DoubleFloat) + pointList : List Point DoubleFloat := [p1] + ptInfo := computeNextPt(pSF,dpdxSF,dpdySF,x,y,p0,p1,corners,_ + delta,err,bound,crits,bdry) + p2 := ptInfo.newPt + ptInfo.type = BDRY => + error "boundary reached while on loop" + if ptInfo.type = CRIT then + p1 = p2 => + error "first and second points on loop are identical" + crits := remove(p2,crits) + pointList := cons(p2,pointList) + repeat + pt0 := second pointList; pt1 := first pointList + ptInfo := computeNextPt(pSF,dpdxSF,dpdySF,x,y,pt0,pt1,corners,_ + delta,err,bound,crits,bdry) + p2 := ptInfo.newPt + ptInfo.type = BDRY => + error "boundary reached while on loop" + if ptInfo.type = CRIT then + crits := remove(p2,crits) + p1 = p2 => + pointList := cons(p2,pointList) + return [pointList,crits,bdry] + pointList := cons(p2,pointList) + --!! delete next line (compiler bug) + [pointList,crits,bdry] + + computeNextPt(pSF,dpdxSF,dpdySF,x,y,p0,p1,corners,_ + delta,err,bound,crits,bdry) == + -- p0=(x0,y0) and p1=(x1,y1) are the last two points on the curve. + -- The function computes the next point on the curve. + -- The function determines if the next point is a critical point + -- or a boundary point. + -- The function returns a record of the form + -- Record(newPt:Point DoubleFloat,type:String). + -- If the new point is a boundary point, then 'type' is + -- "boundary point" and 'newPt' is a boundary point to be + -- deleted from the list of boundary points yet to be plotted. + -- Similarly, if the new point is a critical point, then 'type' is + -- "critical point" and 'newPt' is a critical point to be + -- deleted from the list of critical points yet to be plotted. + -- If the new point is neither a critical point nor a boundary + -- point, then 'type' is "nothing in particular". + xMinSF := getXMin corners; xMaxSF := getXMax corners + yMinSF := getYMin corners; yMaxSF := getYMax corners + x0 := xCoord p0; y0 := yCoord p0 + x1 := xCoord p1; y1 := yCoord p1 + px := ground(eval(dpdxSF,[x,y],[x1,y1])) + py := ground(eval(dpdySF,[x,y],[x1,y1])) + -- let m be the slope of the tangent line at p1 + -- if |m| < 1, we will increment the x-coordinate by delta + -- (indicated by 'incVar = x'), find an approximate + -- y-coordinate using the tangent line, then find the actual + -- y-coordinate using a Newton iteration + if abs(py) > abs(px) then + incVar0 := incVar := x + deltaX := (if x1 > x0 then delta else -delta) + x2Approx := x1 + deltaX + y2Approx := y1 + (-px/py)*deltaX + -- if |m| >= 1, we interchange the roles of the x- and y- + -- coordinates + else + incVar0 := incVar := y + deltaY := (if y1 > y0 then delta else -delta) + x2Approx := x1 + (-py/px)*deltaY + y2Approx := y1 + deltaY + lookingFor := NADA + -- See if (x2Approx,y2Approx) is out of bounds. + -- If so, find where the line segment connecting (x1,y1) and + -- (x2Approx,y2Approx) intersects the boundary and use this + -- point as (x2Approx,y2Approx). + -- If the resulting point is on the left or right boundary, + -- we will now consider x as the 'incremented variable' and we + -- will compute the y-coordinate using a Newton iteration. + -- Similarly, if the point is on the top or bottom boundary, + -- we will consider y as the 'incremented variable' and we + -- will compute the x-coordinate using a Newton iteration. + if x2Approx >= xMaxSF then + incVar := x + lookingFor := BDRY + x2Approx := xMaxSF + y2Approx := y1 + (-px/py)*(x2Approx - x1) + else + if x2Approx <= xMinSF then + incVar := x + lookingFor := BDRY + x2Approx := xMinSF + y2Approx := y1 + (-px/py)*(x2Approx - x1) + if y2Approx >= yMaxSF then + incVar := y + lookingFor := BDRY + y2Approx := yMaxSF + x2Approx := x1 + (-py/px)*(y2Approx - y1) + else + if y2Approx <= yMinSF then + incVar := y + lookingFor := BDRY + y2Approx := yMinSF + x2Approx := x1 + (-py/px)*(y2Approx - y1) + -- set xLo = min(x1,x2Approx), xHi = max(x1,x2Approx) + -- set yLo = min(y1,y2Approx), yHi = max(y1,y2Approx) + if x1 < x2Approx then + xLo := x1 + xHi := x2Approx + else + xLo := x2Approx + xHi := x1 + if y1 < y2Approx then + yLo := y1 + yHi := y2Approx + else + yLo := y2Approx + yHi := y1 + -- check for critical points (x*,y*) with x* between + -- x1 and x2Approx or y* between y1 and y2Approx + -- store values of x2Approx and y2Approx + x2Approxx := x2Approx + y2Approxx := y2Approx + -- xPointList will contain all critical points (x*,y*) + -- with x* between x1 and x2Approx + xPointList : List Point DoubleFloat := nil() + -- yPointList will contain all critical points (x*,y*) + -- with y* between y1 and y2Approx + yPointList : List Point DoubleFloat := nil() + for pt in crits repeat + xx := xCoord pt; yy := yCoord pt + -- if x1 = x2Approx, then p1 is a point with horizontal + -- tangent line + -- in this case, we don't want critical points with + -- x-coordinate x1 + if xx = x2Approx and not (xx = x1) then + if min(abs(yy-yLo),abs(yy-yHi)) < delta then + xPointList := cons(pt,xPointList) + if ((xLo < xx) and (xx < xHi)) then + if min(abs(yy-yLo),abs(yy-yHi)) < delta then + xPointList := cons(pt,nil()) + x2Approx := xx + if xx < x1 then xLo := xx else xHi := xx + -- if y1 = y2Approx, then p1 is a point with vertical + -- tangent line + -- in this case, we don't want critical points with + -- y-coordinate y1 + if yy = y2Approx and not (yy = y1) then + yPointList := cons(pt,yPointList) + if ((yLo < yy) and (yy < yHi)) then + if min(abs(xx-xLo),abs(xx-xHi)) < delta then + yPointList := cons(pt,nil()) + y2Approx := yy + if yy < y1 then yLo := yy else yHi := yy + -- points in both xPointList and yPointList + if (not null xPointList) and (not null yPointList) then + xPointList = yPointList => + -- this implies that the lists have only one point + incVar := incVar0 + if incVar = x then + y2Approx := y1 + (-px/py)*(x2Approx - x1) + else + x2Approx := x1 + (-py/px)*(y2Approx - y1) + lookingFor := CRIT -- proceed + incVar0 = x => + -- first try Newton iteration with 'y' as incremented variable + x2Temp := x1 + (-py/px)*(y2Approx - y1) + f := SFPolyToUPoly(eval(pSF,y,y2Approx)) + x2New := newtonApprox(f,x2Temp,err,bound) + x2New case "failed" => + y2Approx := y1 + (-px/py)*(x2Approx - x1) + incVar := x + lookingFor := CRIT -- proceed + y2Temp := y1 + (-px/py)*(x2Approx - x1) + f := SFPolyToUPoly(eval(pSF,x,x2Approx)) + y2New := newtonApprox(f,y2Temp,err,bound) + y2New case "failed" => + return computeNextPt(pSF,dpdxSF,dpdySF,x,y,p0,p1,corners,_ + abs((x2Approx-x1)/2),err,bound,crits,bdry) + pt1 := makePt(x2Approx,y2New :: DoubleFloat) + pt2 := makePt(x2New :: DoubleFloat,y2Approx) + critPt1 := findPtOnList(pt1,crits) + critPt2 := findPtOnList(pt2,crits) + (critPt1 case "failed") and (critPt2 case "failed") => + abs(x2Approx - x1) > abs(x2Temp - x1) => + return [pt1,NADA] + return [pt2,NADA] + (critPt1 case "failed") => + return [critPt2::(Point DoubleFloat),CRIT] + (critPt2 case "failed") => + return [critPt1::(Point DoubleFloat),CRIT] + abs(x2Approx - x1) > abs(x2Temp - x1) => + return [critPt2::(Point DoubleFloat),CRIT] + return [critPt1::(Point DoubleFloat),CRIT] + y2Temp := y1 + (-px/py)*(x2Approx - x1) + f := SFPolyToUPoly(eval(pSF,x,x2Approx)) + y2New := newtonApprox(f,y2Temp,err,bound) + y2New case "failed" => + x2Approx := x1 + (-py/px)*(y2Approx - y1) + incVar := y + lookingFor := CRIT -- proceed + x2Temp := x1 + (-py/px)*(y2Approx - y1) + f := SFPolyToUPoly(eval(pSF,y,y2Approx)) + x2New := newtonApprox(f,x2Temp,err,bound) + x2New case "failed" => + return computeNextPt(pSF,dpdxSF,dpdySF,x,y,p0,p1,corners,_ + abs((y2Approx-y1)/2),err,bound,crits,bdry) + pt1 := makePt(x2Approx,y2New :: DoubleFloat) + pt2 := makePt(x2New :: DoubleFloat,y2Approx) + critPt1 := findPtOnList(pt1,crits) + critPt2 := findPtOnList(pt2,crits) + (critPt1 case "failed") and (critPt2 case "failed") => + abs(y2Approx - y1) > abs(y2Temp - y1) => + return [pt2,NADA] + return [pt1,NADA] + (critPt1 case "failed") => + return [critPt2::(Point DoubleFloat),CRIT] + (critPt2 case "failed") => + return [critPt1::(Point DoubleFloat),CRIT] + abs(y2Approx - y1) > abs(y2Temp - y1) => + return [critPt1::(Point DoubleFloat),CRIT] + return [critPt2::(Point DoubleFloat),CRIT] + if (not null xPointList) and (null yPointList) then + y2Approx := y1 + (-px/py)*(x2Approx - x1) + incVar0 = x => + incVar := x + lookingFor := CRIT -- proceed + f := SFPolyToUPoly(eval(pSF,x,x2Approx)) + y2New := newtonApprox(f,y2Approx,err,bound) + y2New case "failed" => + x2Approx := x2Approxx + y2Approx := y2Approxx -- proceed + pt := makePt(x2Approx,y2New::DoubleFloat) + critPt := findPtOnList(pt,crits) + critPt case "failed" => + return [pt,NADA] + return [critPt :: (Point DoubleFloat),CRIT] + if (null xPointList) and (not null yPointList) then + x2Approx := x1 + (-py/px)*(y2Approx - y1) + incVar0 = y => + incVar := y + lookingFor := CRIT -- proceed + f := SFPolyToUPoly(eval(pSF,y,y2Approx)) + x2New := newtonApprox(f,x2Approx,err,bound) + x2New case "failed" => + x2Approx := x2Approxx + y2Approx := y2Approxx -- proceed + pt := makePt(x2New::DoubleFloat,y2Approx) + critPt := findPtOnList(pt,crits) + critPt case "failed" => + return [pt,NADA] + return [critPt :: (Point DoubleFloat),CRIT] + if incVar = x then + x2 := x2Approx + f := SFPolyToUPoly(eval(pSF,x,x2)) + y2New := newtonApprox(f,y2Approx,err,bound) + y2New case "failed" => + return computeNextPt(pSF,dpdxSF,dpdySF,x,y,p0,p1,corners,_ + abs((x2-x1)/2),err,bound,crits,bdry) + y2 := y2New :: DoubleFloat + else + y2 := y2Approx + f := SFPolyToUPoly(eval(pSF,y,y2)) + x2New := newtonApprox(f,x2Approx,err,bound) + x2New case "failed" => + return computeNextPt(pSF,dpdxSF,dpdySF,x,y,p0,p1,corners,_ + abs((y2-y1)/2),err,bound,crits,bdry) + x2 := x2New :: DoubleFloat + pt := makePt(x2,y2) + --!! check that 'pt' is not out of bounds + -- check if you've gotten a critical or boundary point + lookingFor = NADA => + [pt,lookingFor] + lookingFor = BDRY => + bdryPt := findPtOnList(pt,bdry) + bdryPt case "failed" => + error "couldn't find boundary point" + [bdryPt :: (Point DoubleFloat),BDRY] + critPt := findPtOnList(pt,crits) + critPt case "failed" => + [pt,NADA] + [critPt :: (Point DoubleFloat),CRIT] + +--% Newton iterations + + newtonApprox(f,a0,err,bound) == + -- Newton iteration to approximate a root of the polynomial 'f' + -- using an initial approximation of 'a0' + -- Newton iteration terminates when consecutive approximations + -- are within 'err' of each other + -- returns "failed" if this has not been achieved after 'bound' + -- iterations + Df := differentiate f + oldApprox := a0 + newApprox := a0 - elt(f,a0)/elt(Df,a0) + i : PositiveInteger := 1 + while abs(newApprox - oldApprox) > err repeat + i = bound => return "failed" + oldApprox := newApprox + newApprox := oldApprox - elt(f,oldApprox)/elt(Df,oldApprox) + i := i+1 + newApprox + +--% graphics output + + listBranches(acplot) == acplot.branches + +--% terminal output + + coerce(acplot:%) == + pp := acplot.poly :: OutputForm + xx := acplot.xVar :: OutputForm + yy := acplot.yVar :: OutputForm + xLo := acplot.minXVal :: OutputForm + xHi := acplot.maxXVal :: OutputForm + yLo := acplot.minYVal :: OutputForm + yHi := acplot.maxYVal :: OutputForm + zip := message(" = 0") + com := message(", ") + les := message(" <= ") + l : List OutputForm := + [pp,zip,com,xLo,les,xx,les,xHi,com,yLo,les,yy,les,yHi] + f : List OutputForm := nil() + for branch in acplot.branches repeat + ll : List OutputForm := [p :: OutputForm for p in branch] + f := cons(vconcat ll,f) + ff := vconcat(hconcat l,vconcat f) + vconcat(message "ACPLOT",ff) + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain PRIMARR PrimitiveArray} +<>= +"PRIMARR" -> "A1AGG" +"PrimitiveArray(a:Type)" -> "OneDimensionalArrayAggregate(a:Type)" +@ +\pagehead{PrimitiveArray}{PRIMARR} +\pagepic{ps/v103primitivearray.ps}{PRIMARR}{1.00} +<>= +)abbrev domain PRIMARR PrimitiveArray +++ This provides a fast array type with no bound checking on elt's. +++ Minimum index is 0 in this type, cannot be changed +PrimitiveArray(S:Type): OneDimensionalArrayAggregate S == add + Qmax ==> QVMAXINDEX$Lisp + Qsize ==> QVSIZE$Lisp +-- Qelt ==> QVELT$Lisp +-- Qsetelt ==> QSETVELT$Lisp + Qelt ==> ELT$Lisp + Qsetelt ==> SETELT$Lisp + Qnew ==> GETREFV$Lisp + + #x == Qsize x + minIndex x == 0 + empty() == Qnew(0$Lisp) + new(n, x) == fill_!(Qnew n, x) + qelt(x, i) == Qelt(x, i) + elt(x:%, i:Integer) == Qelt(x, i) + qsetelt_!(x, i, s) == Qsetelt(x, i, s) + setelt(x:%, i:Integer, s:S) == Qsetelt(x, i, s) + fill_!(x, s) == (for i in 0..Qmax x repeat Qsetelt(x, i, s); x) + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\chapter{Chapter Q} +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain QEQUAT QueryEquation} +<>= +"QEQUAT" -> "KOERCE" +"QueryEquation()" -> "CoercibleTo(OutputForm)" +@ +\pagehead{QueryEquation}{QEQUAT} +\pagepic{ps/v103queryequation.ps}{QEQUAT}{1.00} +<>= +)abbrev domain QEQUAT QueryEquation +++ This domain implements simple database queries +QueryEquation(): Exports == Implementation where + Exports == CoercibleTo(OutputForm) with + equation: (Symbol,String) -> % + ++ equation(s,"a") creates a new equation. + variable: % -> Symbol + ++ variable(q) returns the variable (i.e. left hand side) of \axiom{q}. + value: % -> String + ++ value(q) returns the value (i.e. right hand side) of \axiom{q}. + Implementation == add + Rep := Record(var:Symbol, val:String) + coerce(u) == coerce(u.var)$Symbol = coerce(u.val)$String + equation(x,s) == [x,s] + variable q == q.var + value q == q.val + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\chapter{Chapter R} +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\chapter{Chapter S} +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain SAE SimpleAlgebraicExtension} +<>= +"SimpleAlgebraicExtension(a:FRAC(UPOLYC(UFD)),b:UPOLYC(FRAC(UPOLYC(UFD))))" + [color=white,style=filled]; +"SAE" -> "MONOGEN" +"SimpleAlgebraicExtension(a:CommutativeRing,b:UnivariatePolynomialCategory(a))" + -> "MonogenicAlgebra(a:CommutativeRing,b:UnivariatePolynomialCategory(a))" +"SimpleAlgebraicExtension(a:FRAC(UPOLYC(UFD)),b:UPOLYC(FRAC(UPOLYC(UFD))))" +-> +"SimpleAlgebraicExtension(a:CommutativeRing,b:UnivariatePolynomialCategory(a))" +@ +\pagehead{SimpleAlgebraicExtension}{SAE} +\pagepic{ps/v103simplealgebraicextension.ps}{SAE}{1.00} +<>= +)abbrev domain SAE SimpleAlgebraicExtension +++ Algebraic extension of a ring by a single polynomial +++ Author: Barry Trager, Manuel Bronstein, Clifton Williamson +++ Date Created: 1986 +++ Date Last Updated: 9 May 1994 +++ Description: +++ Domain which represents simple algebraic extensions of arbitrary +++ rings. The first argument to the domain, R, is the underlying ring, +++ the second argument is a domain of univariate polynomials over K, +++ while the last argument specifies the defining minimal polynomial. +++ The elements of the domain are canonically represented as polynomials +++ of degree less than that of the minimal polynomial with coefficients +++ in R. The second argument is both the type of the third argument and +++ the underlying representation used by \spadtype{SAE} itself. +++ Keywords: ring, algebraic, extension +++ Example: )r SAE INPUT + +SimpleAlgebraicExtension(R:CommutativeRing, + UP:UnivariatePolynomialCategory R, M:UP): MonogenicAlgebra(R, UP) == add + --sqFr(pb): FactorS(Poly) from UnivPolySquareFree(Poly) + + --degree(M) > 0 and M must be monic if R is not a field. + if (r := recip leadingCoefficient M) case "failed" then + error "Modulus cannot be made monic" + Rep := UP + x,y :$ + c: R + + mkDisc : Boolean -> Void + mkDiscMat: Boolean -> Void + + M := r::R * M + d := degree M + d1 := subtractIfCan(d,1)::NonNegativeInteger + discmat:Matrix(R) := zero(d, d) + nodiscmat?:Reference(Boolean) := ref true + disc:Reference(R) := ref 0 + nodisc?:Reference(Boolean) := ref true + bsis := [monomial(1, i)$Rep for i in 0..d1]$Vector(Rep) + + if R has Finite then + size == size$R ** d + random == represents([random()$R for i in 0..d1]) + 0 == 0$Rep + 1 == 1$Rep + c * x == c *$Rep x + n:Integer * x == n *$Rep x + coerce(n:Integer):$ == coerce(n)$Rep + coerce(c) == monomial(c,0)$Rep + coerce(x):OutputForm == coerce(x)$Rep + lift(x) == x pretend Rep + reduce(p:UP):$ == (monicDivide(p,M)$Rep).remainder + x = y == x =$Rep y + x + y == x +$Rep y + - x == -$Rep x + x * y == reduce((x *$Rep y) pretend UP) + coordinates(x) == [coefficient(lift(x),i) for i in 0..d1] + represents(vect) == +/[monomial(vect.(i+1),i) for i in 0..d1] + definingPolynomial() == M + characteristic() == characteristic()$R + rank() == d::PositiveInteger + basis() == copy(bsis@Vector(Rep) pretend Vector($)) + --!! I inserted 'copy' in the definition of 'basis' -- cjw 7/19/91 + + if R has Field then + minimalPolynomial x == squareFreePart characteristicPolynomial x + + if R has Field then + coordinates(x:$,bas: Vector $) == + (m := inverse transpose coordinates bas) case "failed" => + error "coordinates: second argument must be a basis" + (m :: Matrix R) * coordinates(x) + + else if R has IntegralDomain then + coordinates(x:$,bas: Vector $) == + -- we work over the quotient field of R to invert a matrix + qf := Fraction R + imatqf := InnerMatrixQuotientFieldFunctions(R,Vector R,Vector R,_ + Matrix R,qf,Vector qf,Vector qf,Matrix qf) + mat := transpose coordinates bas + (m := inverse(mat)$imatqf) case "failed" => + error "coordinates: second argument must be a basis" + coordsQF := map(#1 :: qf,coordinates x)$VectorFunctions2(R,qf) + -- here are the coordinates as elements of the quotient field: + vecQF := (m :: Matrix qf) * coordsQF + vec : Vector R := new(d,0) + for i in 1..d repeat + xi := qelt(vecQF,i) + denom(xi) = 1 => qsetelt_!(vec,i,numer xi) + error "coordinates: coordinates are not integral over ground ring" + vec + + reducedSystem(m:Matrix $):Matrix(R) == + reducedSystem(map(lift, m)$MatrixCategoryFunctions2($, Vector $, + Vector $, Matrix $, UP, Vector UP, Vector UP, Matrix UP)) + + reducedSystem(m:Matrix $, v:Vector $):Record(mat:Matrix R,vec:Vector R) == + reducedSystem(map(lift, m)$MatrixCategoryFunctions2($, Vector $, + Vector $, Matrix $, UP, Vector UP, Vector UP, Matrix UP), + map(lift, v)$VectorFunctions2($, UP)) + + discriminant() == + if nodisc?() then mkDisc false + disc() + + mkDisc b == + nodisc?() := b + disc() := discriminant M + void + + traceMatrix() == + if nodiscmat?() then mkDiscMat false + discmat + + mkDiscMat b == + nodiscmat?() := b + mr := minRowIndex discmat; mc := minColIndex discmat + for i in 0..d1 repeat + for j in 0..d1 repeat + qsetelt_!(discmat,mr + i,mc + j,trace reduce monomial(1,i + j)) + void + + trace x == --this could be coded perhaps more efficiently + xn := x; ans := coefficient(lift xn, 0) + for n in 1..d1 repeat + (xn := generator() * xn; ans := coefficient(lift xn, n) + ans) + ans + + if R has Finite then + index k == + i:Integer := k rem size() + p:Integer := size()$R + ans:$ := 0 + for j in 0.. while i > 0 repeat + h := i rem p + -- index(p) = 0$R + if h ^= 0 then + -- here was a bug: "index" instead of + -- "coerce", otherwise it wouldn't work for + -- Rings R where "coerce: I-> R" is not surjective + a := index(h :: PositiveInteger)$R + ans := ans + reduce monomial(a, j) + i := i quo p + ans + lookup(z : $) : PositiveInteger == + -- z = index lookup z, n = lookup index n + -- the answer is merely the Horner evaluation of the + -- representation with the size of R (as integers). + zero?(z) => size()$$ pretend PositiveInteger + p : Integer := size()$R + co : Integer := lookup(leadingCoefficient z)$R + n : NonNegativeInteger := degree(z) + while not zero?(z := reductum z) repeat + co := co * p ** ((n - (n := degree z)) pretend + NonNegativeInteger) + lookup(leadingCoefficient z)$R + n = 0 => co pretend PositiveInteger + (co * p ** n) pretend PositiveInteger + +-- +-- KA:=BasicPolynomialFunctions(Poly) +-- minPoly(x) == +-- ffe:= SqFr(resultant(M::KA, KA.var - lift(x)::KA)).fs.first +-- ffe.flag = "SQFR" => ffe.f +-- mdeg:= (degree(ffe.f) // K.characteristic)::Integer +-- mat:= Zero()::Matrix(K) +-- xi:=L.1; setelt(mat,1,1,K.1); setelt(mat,1,(deg+1),K.1) +-- for i in 1..mdeg repeat +-- xi:= x * xi; xp:= lift(xi) +-- while xp ^= KA.0 repeat +-- setelt(mat,(mdeg+1),(degree(xp)+1),LeadingCoef(xp)) +-- xp:=reductum(xp) +-- setelt(mat,(mdeg+1),(deg+i+1),K.1) +-- EchelonLastRow(mat) +-- if and/(elt(mat,(i+1),j) = K.0 for j in 1..deg) +-- then return unitNormal(+/(elt(mat,(i+1),(deg+j+1))*(B::KA)**j +-- for j in 0..i)).a +-- ffe.f + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\chapter{Chapter T} +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain TUPLE Tuple} +<>= +"TUPLE" -> "PRIMARR" +"Tuple(a:Type)" -> "PrimitiveArray(a:Type)" +@ +\pagehead{Tuple}{TUPLE} +\pagepic{ps/v103tuple.ps}{TUPLE}{1.00} +<>= +)abbrev domain TUPLE Tuple +++ This domain is used to interface with the interpreter's notion +++ of comma-delimited sequences of values. +Tuple(S:Type): CoercibleTo(PrimitiveArray S) with + coerce: PrimitiveArray S -> % + ++ coerce(a) makes a tuple from primitive array a + ++ + ++X t1:PrimitiveArray(Integer):= [i for i in 1..10] + ++X t2:=coerce(t1)$Tuple(Integer) + + select: (%, NonNegativeInteger) -> S + ++ select(x,n) returns the n-th element of tuple x. + ++ tuples are 0-based + ++ + ++X t1:PrimitiveArray(Integer):= [i for i in 1..10] + ++X t2:=coerce(t1)$Tuple(Integer) + ++X select(t2,3) + + length: % -> NonNegativeInteger + ++ length(x) returns the number of elements in tuple x + ++ + ++X t1:PrimitiveArray(Integer):= [i for i in 1..10] + ++X t2:=coerce(t1)$Tuple(Integer) + ++X length(t2) + + if S has SetCategory then SetCategory + == add + Rep := Record(len : NonNegativeInteger, elts : PrimitiveArray S) + + coerce(x: PrimitiveArray S): % == [#x, x] + coerce(x:%): PrimitiveArray(S) == x.elts + length x == x.len + + select(x, n) == + n >= x.len => error "Index out of bounds" + x.elts.n + + if S has SetCategory then + x = y == (x.len = y.len) and (x.elts =$PrimitiveArray(S) y.elts) + coerce(x : %): OutputForm == + paren [(x.elts.i)::OutputForm + for i in minIndex x.elts .. maxIndex x.elts]$List(OutputForm) + +@ +\section{domain ARRAY2 TwoDimensionalArray} +<>= +-- array2.spad.pamphlet TwoDimensionalArray.input +)spool TwoDimensionalArray.output +)set message test on +)set message auto off +)clear all +--S 1 of 20 +arr : ARRAY2 INT := new(5,4,0) +--R +--R +--R +0 0 0 0+ +--R | | +--R |0 0 0 0| +--R | | +--R (1) |0 0 0 0| +--R | | +--R |0 0 0 0| +--R | | +--R +0 0 0 0+ +--R Type: TwoDimensionalArray Integer +--E 1 + +--S 2 of 20 +setelt(arr,1,1,17) +--R +--R +--R (2) 17 +--R Type: PositiveInteger +--E 2 + +--S 3 of 20 +arr +--R +--R +--R +17 0 0 0+ +--R | | +--R |0 0 0 0| +--R | | +--R (3) |0 0 0 0| +--R | | +--R |0 0 0 0| +--R | | +--R +0 0 0 0+ +--R Type: TwoDimensionalArray Integer +--E 3 + +--S 4 of 20 +elt(arr,1,1) +--R +--R +--R (4) 17 +--R Type: PositiveInteger +--E 4 + +--S 5 of 20 +arr(3,2) := 15 +--R +--R +--R (5) 15 +--R Type: PositiveInteger +--E 5 + +--S 6 of 20 +arr(3,2) +--R +--R +--R (6) 15 +--R Type: PositiveInteger +--E 6 + +--S 7 of 20 +row(arr,1) +--R +--R +--R (7) [17,0,0,0] +--R Type: OneDimensionalArray Integer +--E 7 + +--S 8 of 20 +column(arr,1) +--R +--R +--R (8) [17,0,0,0,0] +--R Type: OneDimensionalArray Integer +--E 8 + +--S 9 of 20 +nrows(arr) +--R +--R +--R (9) 5 +--R Type: PositiveInteger +--E 9 + +--S 10 of 20 +ncols(arr) +--R +--R +--R (10) 4 +--R Type: PositiveInteger +--E 10 + +--S 11 of 20 +map(-,arr) +--R +--R +--R +- 17 0 0 0+ +--R | | +--R | 0 0 0 0| +--R | | +--R (11) | 0 - 15 0 0| +--R | | +--R | 0 0 0 0| +--R | | +--R + 0 0 0 0+ +--R Type: TwoDimensionalArray Integer +--E 11 + +--S 12 of 20 +map((x +-> x + x),arr) +--R +--R +--R +34 0 0 0+ +--R | | +--R |0 0 0 0| +--R | | +--R (12) |0 30 0 0| +--R | | +--R |0 0 0 0| +--R | | +--R +0 0 0 0+ +--R Type: TwoDimensionalArray Integer +--E 12 + +--S 13 of 20 +arrc := copy(arr) +--R +--R +--R +17 0 0 0+ +--R | | +--R |0 0 0 0| +--R | | +--R (13) |0 15 0 0| +--R | | +--R |0 0 0 0| +--R | | +--R +0 0 0 0+ +--R Type: TwoDimensionalArray Integer +--E 13 + +--S 14 of 20 +map!(-,arrc) +--R +--R +--R +- 17 0 0 0+ +--R | | +--R | 0 0 0 0| +--R | | +--R (14) | 0 - 15 0 0| +--R | | +--R | 0 0 0 0| +--R | | +--R + 0 0 0 0+ +--R Type: TwoDimensionalArray Integer +--E 14 + +--S 15 of 20 +arrc +--R +--R +--R +- 17 0 0 0+ +--R | | +--R | 0 0 0 0| +--R | | +--R (15) | 0 - 15 0 0| +--R | | +--R | 0 0 0 0| +--R | | +--R + 0 0 0 0+ +--R Type: TwoDimensionalArray Integer +--E 15 + +--S 16 of 20 +arr +--R +--R +--R +17 0 0 0+ +--R | | +--R |0 0 0 0| +--R | | +--R (16) |0 15 0 0| +--R | | +--R |0 0 0 0| +--R | | +--R +0 0 0 0+ +--R Type: TwoDimensionalArray Integer +--E 16 + +--S 17 of 20 +member?(17,arr) +--R +--R +--R (17) true +--R Type: Boolean +--E 17 + +--S 18 of 20 +member?(10317,arr) +--R +--R +--R (18) false +--R Type: Boolean +--E 18 + +--S 19 of 20 +count(17,arr) +--R +--R +--R (19) 1 +--R Type: PositiveInteger +--E 19 + +--S 20 of 20 +count(0,arr) +--R +--R +--R (20) 18 +--R Type: PositiveInteger +--E 20 +)spool +)lisp (bye) +@ +<>= +==================================================================== +TwoDimensionalArray examples +==================================================================== + +The TwoDimensionalArray domain is used for storing data in a two +dimensional data structure indexed by row and by column. Such an +array is a homogeneous data structure in that all the entries of the +array must belong to the same Axiom domain.. Each array has a fixed +number of rows and columns specified by the user and arrays are not +extensible. In Axiom, the indexing of two-dimensional arrays is +one-based. This means that both the "first" row of an array and the +"first" column of an array are given the index 1. Thus, the entry +in the upper left corner of an array is in position (1,1). + +The operation new creates an array with a specified number of rows and +columns and fills the components of that array with a specified entry. +The arguments of this operation specify the number of rows, the number +of columns, and the entry. + +This creates a five-by-four array of integers, all of whose entries are +zero. + + arr : ARRAY2 INT := new(5,4,0) + +0 0 0 0+ + | | + |0 0 0 0| + | | + |0 0 0 0| + | | + |0 0 0 0| + | | + +0 0 0 0+ + Type: TwoDimensionalArray Integer + +The entries of this array can be set to other integers using setelt. + +Issue this to set the element in the upper left corner of this array to 17. + + setelt(arr,1,1,17) + 17 + Type: PositiveInteger + +Now the first element of the array is 17. + + arr + +17 0 0 0+ + | | + |0 0 0 0| + | | + |0 0 0 0| + | | + |0 0 0 0| + | | + +0 0 0 0+ + Type: TwoDimensionalArray Integer + +Likewise, elements of an array are extracted using the operation elt. + + elt(arr,1,1) + 17 + Type: PositiveInteger + +Another way to use these two operations is as follows. This sets the +element in position (3,2) of the array to 15. + + arr(3,2) := 15 + 15 + Type: PositiveInteger + +This extracts the element in position (3,2) of the array. + + arr(3,2) + 15 + Type: PositiveInteger + +The operations elt and setelt come equipped with an error check which +verifies that the indices are in the proper ranges. For example, the +above array has five rows and four columns, so if you ask for the +entry in position (6,2) with arr(6,2) Axiom displays an error message. +If there is no need for an error check, you can call the operations qelt +and qsetelt which provide the same functionality but without the error +check. Typically, these operations are called in well-tested programs. + +The operations row and column extract rows and columns, respectively, +and return objects of OneDimensionalArray with the same underlying +element type. + + row(arr,1) + [17,0,0,0] + Type: OneDimensionalArray Integer + + column(arr,1) + [17,0,0,0,0] + Type: OneDimensionalArray Integer + +You can determine the dimensions of an array by calling the operations +nrows and ncols, which return the number of rows and columns, respectively. + + nrows(arr) + 5 + Type: PositiveInteger + + ncols(arr) + 4 + Type: PositiveInteger + +To apply an operation to every element of an array, use map. This +creates a new array. This expression negates every element. + + map(-,arr) + +- 17 0 0 0+ + | | + | 0 0 0 0| + | | + | 0 - 15 0 0| + | | + | 0 0 0 0| + | | + + 0 0 0 0+ + Type: TwoDimensionalArray Integer + +This creates an array where all the elements are doubled. + + map((x +-> x + x),arr) + +34 0 0 0+ + | | + |0 0 0 0| + | | + |0 30 0 0| + | | + |0 0 0 0| + | | + +0 0 0 0+ + Type: TwoDimensionalArray Integer + +To change the array destructively, use map instead of map. If you +need to make a copy of any array, use copy. + + arrc := copy(arr) + +17 0 0 0+ + | | + |0 0 0 0| + | | + |0 15 0 0| + | | + |0 0 0 0| + | | + +0 0 0 0+ + Type: TwoDimensionalArray Integer + + map!(-,arrc) + +- 17 0 0 0+ + | | + | 0 0 0 0| + | | + | 0 - 15 0 0| + | | + | 0 0 0 0| + | | + + 0 0 0 0+ + Type: TwoDimensionalArray Integer + + arrc + +- 17 0 0 0+ + | | + | 0 0 0 0| + | | + | 0 - 15 0 0| + | | + | 0 0 0 0| + | | + + 0 0 0 0+ + Type: TwoDimensionalArray Integer + + arr + +17 0 0 0+ + | | + |0 0 0 0| + | | + |0 15 0 0| + | | + |0 0 0 0| + | | + +0 0 0 0+ + Type: TwoDimensionalArray Integer + +Use member? to see if a given element is in an array. + + member?(17,arr) + true + Type: Boolean + + member?(10317,arr) + false + Type: Boolean + +To see how many times an element appears in an array, use count. + + count(17,arr) + 1 + Type: PositiveInteger + + count(0,arr) + 18 + Type: PositiveInteger + +See Also: +o )help Matrix +o )help OneDimensionalArray +o )show TwoDimensionalArray +o $AXIOM/doc/src/algebra/array2.spad.dvi + +@ +<>= +"ARRAY2" -> "ARR2CAT" +"TwoDimensionalArray(a:Type)" -> +"TwoDimensionalArrayCategory(a:Type,b:FiniteLinearAggregate(a),c:FiniteLinearAggregate(a))" +"ARRAY2" -> "IIARRAY2" +"TwoDimensionalArray(a:Type)" -> +"InnerIndexedTwoDimensionalArray(a:Type,1,1,b:OneDimensionalArray(a),c:OneDimensionalArray(a))" +@ +\pagehead{TwoDimensionalArray}{ARRAY2} +\pagepic{ps/v103twodimensionalarray.ps}{ARRAY2}{1.00} +<>= +)abbrev domain ARRAY2 TwoDimensionalArray +TwoDimensionalArray(R):Exports == Implementation where + ++ A TwoDimensionalArray is a two dimensional array with + ++ 1-based indexing for both rows and columns. + R : Type + Row ==> OneDimensionalArray R + Col ==> OneDimensionalArray R + + Exports ==> TwoDimensionalArrayCategory(R,Row,Col) with + shallowlyMutable + ++ One may destructively alter TwoDimensionalArray's. + + Implementation ==> InnerIndexedTwoDimensionalArray(R,1,1,Row,Col) + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\chapter{Chapter U} +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\chapter{Chapter V} +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\chapter{Chapter W} +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\chapter{Chapter X} +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\chapter{Chapter Y} +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\chapter{Chapter Z} +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\chapter{The bootstrap code} +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{PRIMARR.lsp BOOTSTRAP} +{\bf PRIMARR} depends on itself. +We need to break this cycle to build the algebra. So we keep a +cached copy of the translated {\bf PRIMARR} category which we can write +into the {\bf MID} directory. We compile the lisp code and copy the +{\bf PRIMARR.o} file to the {\bf OUT} directory. This is eventually +forcibly replaced by a recompiled version. + +Note that this code is not included in the generated catdef.spad file. + +<>= + +(|/VERSIONCHECK| 2) + +(PUT (QUOTE |PRIMARR;#;$Nni;1|) (QUOTE |SPADreplace|) (QUOTE QVSIZE)) + +(DEFUN |PRIMARR;#;$Nni;1| (|x| |$|) (QVSIZE |x|)) + +(PUT (QUOTE |PRIMARR;minIndex;$I;2|) + (QUOTE |SPADreplace|) (QUOTE (XLAM (|x|) 0))) + +(DEFUN |PRIMARR;minIndex;$I;2| (|x| |$|) 0) + +(PUT (QUOTE |PRIMARR;empty;$;3|) + (QUOTE |SPADreplace|) (QUOTE (XLAM NIL (GETREFV 0)))) + +(DEFUN |PRIMARR;empty;$;3| (|$|) (GETREFV 0)) + +(DEFUN |PRIMARR;new;NniS$;4| (|n| |x| |$|) + (SPADCALL (GETREFV |n|) |x| (QREFELT |$| 12))) + +(PUT (QUOTE |PRIMARR;qelt;$IS;5|) (QUOTE |SPADreplace|) (QUOTE ELT)) + +(DEFUN |PRIMARR;qelt;$IS;5| (|x| |i| |$|) (ELT |x| |i|)) + +(PUT (QUOTE |PRIMARR;elt;$IS;6|) (QUOTE |SPADreplace|) (QUOTE ELT)) + +(DEFUN |PRIMARR;elt;$IS;6| (|x| |i| |$|) (ELT |x| |i|)) + +(PUT (QUOTE |PRIMARR;qsetelt!;$I2S;7|) (QUOTE |SPADreplace|) (QUOTE SETELT)) + +(DEFUN |PRIMARR;qsetelt!;$I2S;7| (|x| |i| |s| |$|) (SETELT |x| |i| |s|)) + +(PUT (QUOTE |PRIMARR;setelt;$I2S;8|) (QUOTE |SPADreplace|) (QUOTE SETELT)) + +(DEFUN |PRIMARR;setelt;$I2S;8| (|x| |i| |s| |$|) (SETELT |x| |i| |s|)) + +(DEFUN |PRIMARR;fill!;$S$;9| (|x| |s| |$|) + (PROG (|i| #1=#:G82338) + (RETURN + (SEQ + (SEQ + (LETT |i| 0 |PRIMARR;fill!;$S$;9|) + (LETT #1# (QVMAXINDEX |x|) |PRIMARR;fill!;$S$;9|) + G190 + (COND ((QSGREATERP |i| #1#) (GO G191))) + (SEQ (EXIT (SETELT |x| |i| |s|))) + (LETT |i| (QSADD1 |i|) |PRIMARR;fill!;$S$;9|) + (GO G190) + G191 + (EXIT NIL)) + (EXIT |x|))))) + +(DEFUN |PrimitiveArray| (#1=#:G82348) + (PROG NIL + (RETURN + (PROG (#2=#:G82349) + (RETURN + (COND + ((LETT #2# + (|lassocShiftWithFunction| + (LIST (|devaluate| #1#)) + (HGET |$ConstructorCache| (QUOTE |PrimitiveArray|)) + (QUOTE |domainEqualList|)) + |PrimitiveArray|) + (|CDRwithIncrement| #2#)) + ((QUOTE T) + (|UNWIND-PROTECT| + (PROG1 + (|PrimitiveArray;| #1#) + (LETT #2# T |PrimitiveArray|)) + (COND + ((NOT #2#) + (HREM |$ConstructorCache| (QUOTE |PrimitiveArray|)))))))))))) + +(DEFUN |PrimitiveArray;| (|#1|) + (PROG (|DV$1| |dv$| |$| #1=#:G82347 |pv$|) + (RETURN + (PROGN + (LETT |DV$1| (|devaluate| |#1|) . #2=(|PrimitiveArray|)) + (LETT |dv$| (LIST (QUOTE |PrimitiveArray|) |DV$1|) . #2#) + (LETT |$| (GETREFV 35) . #2#) + (QSETREFV |$| 0 |dv$|) + (QSETREFV |$| 3 + (LETT |pv$| + (|buildPredVector| 0 0 + (LIST + (|HasCategory| |#1| (QUOTE (|SetCategory|))) + (|HasCategory| |#1| (QUOTE (|ConvertibleTo| (|InputForm|)))) + (LETT #1# (|HasCategory| |#1| (QUOTE (|OrderedSet|))) . #2#) + (OR #1# (|HasCategory| |#1| (QUOTE (|SetCategory|)))) + (|HasCategory| (|Integer|) (QUOTE (|OrderedSet|))) + (AND (|HasCategory| |#1| (LIST (QUOTE |Evalable|) (|devaluate| |#1|))) + (|HasCategory| |#1| (QUOTE (|SetCategory|)))) + (OR + (AND + (|HasCategory| |#1| (LIST (QUOTE |Evalable|) (|devaluate| |#1|))) + #1#) + (AND + (|HasCategory| |#1| (LIST (QUOTE |Evalable|) (|devaluate| |#1|))) + (|HasCategory| |#1| (QUOTE (|SetCategory|))))))) + . #2#)) + (|haddProp| |$ConstructorCache| + (QUOTE |PrimitiveArray|) (LIST |DV$1|) (CONS 1 |$|)) + (|stuffDomainSlots| |$|) + (QSETREFV |$| 6 |#1|) + |$|)))) + +(MAKEPROP (QUOTE |PrimitiveArray|) (QUOTE |infovec|) + (LIST + (QUOTE + #(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|NonNegativeInteger|) + |PRIMARR;#;$Nni;1| (|Integer|) |PRIMARR;minIndex;$I;2| + |PRIMARR;empty;$;3| |PRIMARR;fill!;$S$;9| |PRIMARR;new;NniS$;4| + |PRIMARR;qelt;$IS;5| |PRIMARR;elt;$IS;6| |PRIMARR;qsetelt!;$I2S;7| + |PRIMARR;setelt;$I2S;8| (|Mapping| 6 6 6) (|Boolean|) (|List| 6) + (|Equation| 6) (|List| 21) (|Mapping| 19 6) (|Mapping| 19 6 6) + (|UniversalSegment| 9) (|Void|) (|Mapping| 6 6) (|InputForm|) + (|OutputForm|) (|String|) (|SingleInteger|) (|List| |$|) + (|Union| 6 (QUOTE "failed")) (|List| 9))) + (QUOTE + #(|~=| 0 |swap!| 6 |sorted?| 13 |sort!| 24 |sort| 35 |size?| 46 |setelt| + 52 |select| 66 |sample| 72 |reverse!| 76 |reverse| 81 |removeDuplicates| + 86 |remove| 91 |reduce| 103 |qsetelt!| 124 |qelt| 131 |position| 137 + |parts| 156 |new| 161 |more?| 167 |minIndex| 173 |min| 178 |merge| 184 + |members| 197 |member?| 202 |maxIndex| 208 |max| 213 |map!| 219 |map| + 225 |less?| 238 |latex| 244 |insert| 249 |indices| 263 |index?| 268 + |hash| 274 |first| 279 |find| 284 |fill!| 290 |every?| 296 |eval| 302 + |eq?| 328 |entry?| 334 |entries| 340 |empty?| 345 |empty| 350 |elt| 354 + |delete| 373 |count| 385 |copyInto!| 397 |copy| 404 |convert| 409 + |construct| 414 |concat| 419 |coerce| 442 |any?| 447 |>=| 453 |>| 459 + |=| 465 |<=| 471 |<| 477 |#| 483)) + (QUOTE ((|shallowlyMutable| . 0) (|finiteAggregate| . 0))) + (CONS + (|makeByteWordVec2| 7 (QUOTE (0 0 0 0 0 0 3 0 0 7 4 0 0 7 1 2 4))) + (CONS + (QUOTE #(|OneDimensionalArrayAggregate&| |FiniteLinearAggregate&| + |LinearAggregate&| |IndexedAggregate&| |Collection&| + |HomogeneousAggregate&| |OrderedSet&| |Aggregate&| |EltableAggregate&| + |Evalable&| |SetCategory&| NIL NIL |InnerEvalable&| NIL NIL |BasicType&|)) + (CONS + (QUOTE + #((|OneDimensionalArrayAggregate| 6) (|FiniteLinearAggregate| 6) + (|LinearAggregate| 6) (|IndexedAggregate| 9 6) (|Collection| 6) + (|HomogeneousAggregate| 6) (|OrderedSet|) (|Aggregate|) + (|EltableAggregate| 9 6) (|Evalable| 6) (|SetCategory|) (|Type|) + (|Eltable| 9 6) (|InnerEvalable| 6 6) (|CoercibleTo| 29) + (|ConvertibleTo| 28) (|BasicType|))) + (|makeByteWordVec2| 34 + (QUOTE + (2 1 19 0 0 1 3 0 26 0 9 9 1 1 3 19 0 1 2 0 19 24 0 1 1 3 0 0 1 2 0 0 + 24 0 1 1 3 0 0 1 2 0 0 24 0 1 2 0 19 0 7 1 3 0 6 0 25 6 1 3 0 6 0 9 + 6 17 2 0 0 23 0 1 0 0 0 1 1 0 0 0 1 1 0 0 0 1 1 1 0 0 1 2 1 0 6 0 1 + 2 0 0 23 0 1 4 1 6 18 0 6 6 1 3 0 6 18 0 6 1 2 0 6 18 0 1 3 0 6 0 9 + 6 16 2 0 6 0 9 14 2 1 9 6 0 1 3 1 9 6 0 9 1 2 0 9 23 0 1 1 0 20 0 1 + 2 0 0 7 6 13 2 0 19 0 7 1 1 5 9 0 10 2 3 0 0 0 1 2 3 0 0 0 1 3 0 0 + 24 0 0 1 1 0 20 0 1 2 1 19 6 0 1 1 5 9 0 1 2 3 0 0 0 1 2 0 0 27 0 1 + 3 0 0 18 0 0 1 2 0 0 27 0 1 2 0 19 0 7 1 1 1 30 0 1 3 0 0 0 0 9 1 3 + 0 0 6 0 9 1 1 0 34 0 1 2 0 19 9 0 1 1 1 31 0 1 1 5 6 0 1 2 0 33 23 + 0 1 2 0 0 0 6 12 2 0 19 23 0 1 3 6 0 0 20 20 1 2 6 0 0 21 1 3 6 0 0 + 6 6 1 2 6 0 0 22 1 2 0 19 0 0 1 2 1 19 6 0 1 1 0 20 0 1 1 0 19 0 1 + 0 0 0 11 2 0 0 0 25 1 2 0 6 0 9 15 3 0 6 0 9 6 1 2 0 0 0 9 1 2 0 0 + 0 25 1 2 1 7 6 0 1 2 0 7 23 0 1 3 0 0 0 0 9 1 1 0 0 0 1 1 2 28 0 1 + 1 0 0 20 1 1 0 0 32 1 2 0 0 6 0 1 2 0 0 0 0 1 2 0 0 0 6 1 1 1 29 0 + 1 2 0 19 23 0 1 2 3 19 0 0 1 2 3 19 0 0 1 2 1 19 0 0 1 2 3 19 0 0 1 + 2 3 19 0 0 1 1 0 7 0 8)))))) + (QUOTE |lookupComplete|))) +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Chunk collections} +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% <>= +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> + <> +<> +<> + +<> + +<> +<> +<> +<> +<> + +<> +<> + +<> +<> +<> + +<> + +<> +<> + +<> + +<> + +<> +<> @ \begin{thebibliography}{99} \end{thebibliography} +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Index} +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \printindex \end{document} diff --git a/books/ps/v103any.ps b/books/ps/v103any.ps new file mode 100644 index 0000000..f505859 --- /dev/null +++ b/books/ps/v103any.ps @@ -0,0 +1,248 @@ +%!PS-Adobe-2.0 +%%Creator: dot version 2.8 (Thu Sep 14 20:34:11 UTC 2006) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: 36 36 98 80 +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + dup scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw aligned label in bounding box aligned to current point +/alignedtext { % width adj text + /text exch def + /adj exch def + /width exch def + gsave + width 0 gt { + text stringwidth pop adj mul 0 rmoveto + } if + [] 0 setdash + text show + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +%%Page: 1 1 +%%PageBoundingBox: 36 36 98 80 +%%PageOrientation: Portrait +gsave +36 36 62 44 boxprim clip newpath +36 36 translate +0 0 1 beginpage +1.0000 set_scale +4 4 translate 0 rotate +0.167 0.600 1.000 graphcolor +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +60 42 lineto +60 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +60 42 lineto +60 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% Any +[ /Rect [ 0 0 54 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=ANY) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 54 36 moveto +0 36 lineto +0 0 lineto +54 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 54 36 moveto +0 36 lineto +0 0 lineto +54 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +14 13 moveto +(Any) +[10.08 6.48 6.96] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103asp1.ps b/books/ps/v103asp1.ps new file mode 100644 index 0000000..e8fa0c2 --- /dev/null +++ b/books/ps/v103asp1.ps @@ -0,0 +1,248 @@ +%!PS-Adobe-2.0 +%%Creator: dot version 2.8 (Thu Sep 14 20:34:11 UTC 2006) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: 36 36 98 80 +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + dup scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw aligned label in bounding box aligned to current point +/alignedtext { % width adj text + /text exch def + /adj exch def + /width exch def + gsave + width 0 gt { + text stringwidth pop adj mul 0 rmoveto + } if + [] 0 setdash + text show + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +%%Page: 1 1 +%%PageBoundingBox: 36 36 98 80 +%%PageOrientation: Portrait +gsave +36 36 62 44 boxprim clip newpath +36 36 translate +0 0 1 beginpage +1.0000 set_scale +4 4 translate 0 rotate +0.167 0.600 1.000 graphcolor +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +60 42 lineto +60 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +60 42 lineto +60 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% Asp1 +[ /Rect [ 0 0 54 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=ASP1) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 54 36 moveto +0 36 lineto +0 0 lineto +54 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 54 36 moveto +0 36 lineto +0 0 lineto +54 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +11 13 moveto +(Asp1) +[10.08 5.52 6.96 6.96] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103asp10.ps b/books/ps/v103asp10.ps new file mode 100644 index 0000000..2b83cc7 --- /dev/null +++ b/books/ps/v103asp10.ps @@ -0,0 +1,248 @@ +%!PS-Adobe-2.0 +%%Creator: dot version 2.8 (Thu Sep 14 20:34:11 UTC 2006) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: 36 36 98 80 +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + dup scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw aligned label in bounding box aligned to current point +/alignedtext { % width adj text + /text exch def + /adj exch def + /width exch def + gsave + width 0 gt { + text stringwidth pop adj mul 0 rmoveto + } if + [] 0 setdash + text show + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +%%Page: 1 1 +%%PageBoundingBox: 36 36 98 80 +%%PageOrientation: Portrait +gsave +36 36 62 44 boxprim clip newpath +36 36 translate +0 0 1 beginpage +1.0000 set_scale +4 4 translate 0 rotate +0.167 0.600 1.000 graphcolor +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +60 42 lineto +60 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +60 42 lineto +60 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% Asp10 +[ /Rect [ 0 0 54 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=ASP10) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 54 36 moveto +0 36 lineto +0 0 lineto +54 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 54 36 moveto +0 36 lineto +0 0 lineto +54 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +8 13 moveto +(Asp10) +[10.08 5.52 6.96 6.24 6.96] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103asp12.ps b/books/ps/v103asp12.ps new file mode 100644 index 0000000..1d85b17 --- /dev/null +++ b/books/ps/v103asp12.ps @@ -0,0 +1,248 @@ +%!PS-Adobe-2.0 +%%Creator: dot version 2.8 (Thu Sep 14 20:34:11 UTC 2006) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: 36 36 98 80 +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + dup scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw aligned label in bounding box aligned to current point +/alignedtext { % width adj text + /text exch def + /adj exch def + /width exch def + gsave + width 0 gt { + text stringwidth pop adj mul 0 rmoveto + } if + [] 0 setdash + text show + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +%%Page: 1 1 +%%PageBoundingBox: 36 36 98 80 +%%PageOrientation: Portrait +gsave +36 36 62 44 boxprim clip newpath +36 36 translate +0 0 1 beginpage +1.0000 set_scale +4 4 translate 0 rotate +0.167 0.600 1.000 graphcolor +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +60 42 lineto +60 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +60 42 lineto +60 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% Asp12 +[ /Rect [ 0 0 54 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=ASP12) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 54 36 moveto +0 36 lineto +0 0 lineto +54 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 54 36 moveto +0 36 lineto +0 0 lineto +54 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +8 13 moveto +(Asp12) +[10.08 5.52 6.96 6.48 6.96] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103asp19.ps b/books/ps/v103asp19.ps new file mode 100644 index 0000000..9a75a44 --- /dev/null +++ b/books/ps/v103asp19.ps @@ -0,0 +1,248 @@ +%!PS-Adobe-2.0 +%%Creator: dot version 2.8 (Thu Sep 14 20:34:11 UTC 2006) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: 36 36 98 80 +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + dup scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw aligned label in bounding box aligned to current point +/alignedtext { % width adj text + /text exch def + /adj exch def + /width exch def + gsave + width 0 gt { + text stringwidth pop adj mul 0 rmoveto + } if + [] 0 setdash + text show + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +%%Page: 1 1 +%%PageBoundingBox: 36 36 98 80 +%%PageOrientation: Portrait +gsave +36 36 62 44 boxprim clip newpath +36 36 translate +0 0 1 beginpage +1.0000 set_scale +4 4 translate 0 rotate +0.167 0.600 1.000 graphcolor +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +60 42 lineto +60 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +60 42 lineto +60 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% Asp19 +[ /Rect [ 0 0 54 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=ASP19) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 54 36 moveto +0 36 lineto +0 0 lineto +54 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 54 36 moveto +0 36 lineto +0 0 lineto +54 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +8 13 moveto +(Asp19) +[10.08 5.52 6.96 6 6.96] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103asp20.ps b/books/ps/v103asp20.ps new file mode 100644 index 0000000..1e38b47 --- /dev/null +++ b/books/ps/v103asp20.ps @@ -0,0 +1,248 @@ +%!PS-Adobe-2.0 +%%Creator: dot version 2.8 (Thu Sep 14 20:34:11 UTC 2006) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: 36 36 98 80 +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + dup scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw aligned label in bounding box aligned to current point +/alignedtext { % width adj text + /text exch def + /adj exch def + /width exch def + gsave + width 0 gt { + text stringwidth pop adj mul 0 rmoveto + } if + [] 0 setdash + text show + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +%%Page: 1 1 +%%PageBoundingBox: 36 36 98 80 +%%PageOrientation: Portrait +gsave +36 36 62 44 boxprim clip newpath +36 36 translate +0 0 1 beginpage +1.0000 set_scale +4 4 translate 0 rotate +0.167 0.600 1.000 graphcolor +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +60 42 lineto +60 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +60 42 lineto +60 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% Asp20 +[ /Rect [ 0 0 54 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=ASP20) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 54 36 moveto +0 36 lineto +0 0 lineto +54 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 54 36 moveto +0 36 lineto +0 0 lineto +54 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +8 13 moveto +(Asp20) +[10.08 5.52 6.96 6.96 6.96] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103asp24.ps b/books/ps/v103asp24.ps new file mode 100644 index 0000000..a963a87 --- /dev/null +++ b/books/ps/v103asp24.ps @@ -0,0 +1,248 @@ +%!PS-Adobe-2.0 +%%Creator: dot version 2.8 (Thu Sep 14 20:34:11 UTC 2006) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: 36 36 98 80 +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + dup scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw aligned label in bounding box aligned to current point +/alignedtext { % width adj text + /text exch def + /adj exch def + /width exch def + gsave + width 0 gt { + text stringwidth pop adj mul 0 rmoveto + } if + [] 0 setdash + text show + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +%%Page: 1 1 +%%PageBoundingBox: 36 36 98 80 +%%PageOrientation: Portrait +gsave +36 36 62 44 boxprim clip newpath +36 36 translate +0 0 1 beginpage +1.0000 set_scale +4 4 translate 0 rotate +0.167 0.600 1.000 graphcolor +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +60 42 lineto +60 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +60 42 lineto +60 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% Asp24 +[ /Rect [ 0 0 54 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=ASP24) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 54 36 moveto +0 36 lineto +0 0 lineto +54 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 54 36 moveto +0 36 lineto +0 0 lineto +54 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +8 13 moveto +(Asp24) +[10.08 5.52 6.96 6.96 6.96] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103asp27.ps b/books/ps/v103asp27.ps new file mode 100644 index 0000000..8a14feb --- /dev/null +++ b/books/ps/v103asp27.ps @@ -0,0 +1,248 @@ +%!PS-Adobe-2.0 +%%Creator: dot version 2.8 (Thu Sep 14 20:34:11 UTC 2006) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: 36 36 98 80 +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + dup scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw aligned label in bounding box aligned to current point +/alignedtext { % width adj text + /text exch def + /adj exch def + /width exch def + gsave + width 0 gt { + text stringwidth pop adj mul 0 rmoveto + } if + [] 0 setdash + text show + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +%%Page: 1 1 +%%PageBoundingBox: 36 36 98 80 +%%PageOrientation: Portrait +gsave +36 36 62 44 boxprim clip newpath +36 36 translate +0 0 1 beginpage +1.0000 set_scale +4 4 translate 0 rotate +0.167 0.600 1.000 graphcolor +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +60 42 lineto +60 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +60 42 lineto +60 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% Asp27 +[ /Rect [ 0 0 54 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=ASP27) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 54 36 moveto +0 36 lineto +0 0 lineto +54 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 54 36 moveto +0 36 lineto +0 0 lineto +54 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +8 13 moveto +(Asp27) +[10.08 5.52 6.96 6.72 6.96] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103asp28.ps b/books/ps/v103asp28.ps new file mode 100644 index 0000000..7d76e9f --- /dev/null +++ b/books/ps/v103asp28.ps @@ -0,0 +1,248 @@ +%!PS-Adobe-2.0 +%%Creator: dot version 2.8 (Thu Sep 14 20:34:11 UTC 2006) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: 36 36 98 80 +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + dup scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw aligned label in bounding box aligned to current point +/alignedtext { % width adj text + /text exch def + /adj exch def + /width exch def + gsave + width 0 gt { + text stringwidth pop adj mul 0 rmoveto + } if + [] 0 setdash + text show + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +%%Page: 1 1 +%%PageBoundingBox: 36 36 98 80 +%%PageOrientation: Portrait +gsave +36 36 62 44 boxprim clip newpath +36 36 translate +0 0 1 beginpage +1.0000 set_scale +4 4 translate 0 rotate +0.167 0.600 1.000 graphcolor +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +60 42 lineto +60 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +60 42 lineto +60 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% Asp28 +[ /Rect [ 0 0 54 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=ASP28) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 54 36 moveto +0 36 lineto +0 0 lineto +54 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 54 36 moveto +0 36 lineto +0 0 lineto +54 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +8 13 moveto +(Asp28) +[10.08 5.52 6.96 6.96 6.96] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103asp29.ps b/books/ps/v103asp29.ps new file mode 100644 index 0000000..1746178 --- /dev/null +++ b/books/ps/v103asp29.ps @@ -0,0 +1,248 @@ +%!PS-Adobe-2.0 +%%Creator: dot version 2.8 (Thu Sep 14 20:34:11 UTC 2006) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: 36 36 98 80 +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + dup scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw aligned label in bounding box aligned to current point +/alignedtext { % width adj text + /text exch def + /adj exch def + /width exch def + gsave + width 0 gt { + text stringwidth pop adj mul 0 rmoveto + } if + [] 0 setdash + text show + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +%%Page: 1 1 +%%PageBoundingBox: 36 36 98 80 +%%PageOrientation: Portrait +gsave +36 36 62 44 boxprim clip newpath +36 36 translate +0 0 1 beginpage +1.0000 set_scale +4 4 translate 0 rotate +0.167 0.600 1.000 graphcolor +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +60 42 lineto +60 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +60 42 lineto +60 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% Asp29 +[ /Rect [ 0 0 54 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=ASP29) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 54 36 moveto +0 36 lineto +0 0 lineto +54 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 54 36 moveto +0 36 lineto +0 0 lineto +54 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +8 13 moveto +(Asp29) +[10.08 5.52 6.96 6.96 6.96] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103asp30.ps b/books/ps/v103asp30.ps new file mode 100644 index 0000000..c6050c8 --- /dev/null +++ b/books/ps/v103asp30.ps @@ -0,0 +1,248 @@ +%!PS-Adobe-2.0 +%%Creator: dot version 2.8 (Thu Sep 14 20:34:11 UTC 2006) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: 36 36 98 80 +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + dup scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw aligned label in bounding box aligned to current point +/alignedtext { % width adj text + /text exch def + /adj exch def + /width exch def + gsave + width 0 gt { + text stringwidth pop adj mul 0 rmoveto + } if + [] 0 setdash + text show + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +%%Page: 1 1 +%%PageBoundingBox: 36 36 98 80 +%%PageOrientation: Portrait +gsave +36 36 62 44 boxprim clip newpath +36 36 translate +0 0 1 beginpage +1.0000 set_scale +4 4 translate 0 rotate +0.167 0.600 1.000 graphcolor +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +60 42 lineto +60 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +60 42 lineto +60 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% Asp30 +[ /Rect [ 0 0 54 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=ASP30) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 54 36 moveto +0 36 lineto +0 0 lineto +54 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 54 36 moveto +0 36 lineto +0 0 lineto +54 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +8 13 moveto +(Asp30) +[10.08 5.52 6.96 6.96 6.96] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103asp31.ps b/books/ps/v103asp31.ps new file mode 100644 index 0000000..6164199 --- /dev/null +++ b/books/ps/v103asp31.ps @@ -0,0 +1,248 @@ +%!PS-Adobe-2.0 +%%Creator: dot version 2.8 (Thu Sep 14 20:34:11 UTC 2006) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: 36 36 98 80 +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + dup scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw aligned label in bounding box aligned to current point +/alignedtext { % width adj text + /text exch def + /adj exch def + /width exch def + gsave + width 0 gt { + text stringwidth pop adj mul 0 rmoveto + } if + [] 0 setdash + text show + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +%%Page: 1 1 +%%PageBoundingBox: 36 36 98 80 +%%PageOrientation: Portrait +gsave +36 36 62 44 boxprim clip newpath +36 36 translate +0 0 1 beginpage +1.0000 set_scale +4 4 translate 0 rotate +0.167 0.600 1.000 graphcolor +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +60 42 lineto +60 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +60 42 lineto +60 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% Asp31 +[ /Rect [ 0 0 54 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=ASP31) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 54 36 moveto +0 36 lineto +0 0 lineto +54 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 54 36 moveto +0 36 lineto +0 0 lineto +54 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +8 13 moveto +(Asp31) +[10.08 5.52 6.96 6 6.96] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103asp33.ps b/books/ps/v103asp33.ps new file mode 100644 index 0000000..caebd52 --- /dev/null +++ b/books/ps/v103asp33.ps @@ -0,0 +1,248 @@ +%!PS-Adobe-2.0 +%%Creator: dot version 2.8 (Thu Sep 14 20:34:11 UTC 2006) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: 36 36 98 80 +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + dup scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw aligned label in bounding box aligned to current point +/alignedtext { % width adj text + /text exch def + /adj exch def + /width exch def + gsave + width 0 gt { + text stringwidth pop adj mul 0 rmoveto + } if + [] 0 setdash + text show + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +%%Page: 1 1 +%%PageBoundingBox: 36 36 98 80 +%%PageOrientation: Portrait +gsave +36 36 62 44 boxprim clip newpath +36 36 translate +0 0 1 beginpage +1.0000 set_scale +4 4 translate 0 rotate +0.167 0.600 1.000 graphcolor +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +60 42 lineto +60 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +60 42 lineto +60 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% Asp33 +[ /Rect [ 0 0 54 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=ASP33) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 54 36 moveto +0 36 lineto +0 0 lineto +54 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 54 36 moveto +0 36 lineto +0 0 lineto +54 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +8 13 moveto +(Asp33) +[10.08 5.52 6.96 6.96 6.96] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103asp34.ps b/books/ps/v103asp34.ps new file mode 100644 index 0000000..4937293 --- /dev/null +++ b/books/ps/v103asp34.ps @@ -0,0 +1,248 @@ +%!PS-Adobe-2.0 +%%Creator: dot version 2.8 (Thu Sep 14 20:34:11 UTC 2006) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: 36 36 98 80 +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + dup scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw aligned label in bounding box aligned to current point +/alignedtext { % width adj text + /text exch def + /adj exch def + /width exch def + gsave + width 0 gt { + text stringwidth pop adj mul 0 rmoveto + } if + [] 0 setdash + text show + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +%%Page: 1 1 +%%PageBoundingBox: 36 36 98 80 +%%PageOrientation: Portrait +gsave +36 36 62 44 boxprim clip newpath +36 36 translate +0 0 1 beginpage +1.0000 set_scale +4 4 translate 0 rotate +0.167 0.600 1.000 graphcolor +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +60 42 lineto +60 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +60 42 lineto +60 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% Asp34 +[ /Rect [ 0 0 54 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=ASP34) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 54 36 moveto +0 36 lineto +0 0 lineto +54 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 54 36 moveto +0 36 lineto +0 0 lineto +54 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +8 13 moveto +(Asp34) +[10.08 5.52 6.96 6.96 6.96] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103asp35.ps b/books/ps/v103asp35.ps new file mode 100644 index 0000000..a085696 --- /dev/null +++ b/books/ps/v103asp35.ps @@ -0,0 +1,248 @@ +%!PS-Adobe-2.0 +%%Creator: dot version 2.8 (Thu Sep 14 20:34:11 UTC 2006) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: 36 36 98 80 +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + dup scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw aligned label in bounding box aligned to current point +/alignedtext { % width adj text + /text exch def + /adj exch def + /width exch def + gsave + width 0 gt { + text stringwidth pop adj mul 0 rmoveto + } if + [] 0 setdash + text show + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +%%Page: 1 1 +%%PageBoundingBox: 36 36 98 80 +%%PageOrientation: Portrait +gsave +36 36 62 44 boxprim clip newpath +36 36 translate +0 0 1 beginpage +1.0000 set_scale +4 4 translate 0 rotate +0.167 0.600 1.000 graphcolor +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +60 42 lineto +60 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +60 42 lineto +60 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% Asp35 +[ /Rect [ 0 0 54 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=ASP35) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 54 36 moveto +0 36 lineto +0 0 lineto +54 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 54 36 moveto +0 36 lineto +0 0 lineto +54 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +8 13 moveto +(Asp35) +[10.08 5.52 6.96 6.96 6.96] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103asp4.ps b/books/ps/v103asp4.ps new file mode 100644 index 0000000..052329b --- /dev/null +++ b/books/ps/v103asp4.ps @@ -0,0 +1,248 @@ +%!PS-Adobe-2.0 +%%Creator: dot version 2.8 (Thu Sep 14 20:34:11 UTC 2006) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: 36 36 98 80 +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + dup scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw aligned label in bounding box aligned to current point +/alignedtext { % width adj text + /text exch def + /adj exch def + /width exch def + gsave + width 0 gt { + text stringwidth pop adj mul 0 rmoveto + } if + [] 0 setdash + text show + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +%%Page: 1 1 +%%PageBoundingBox: 36 36 98 80 +%%PageOrientation: Portrait +gsave +36 36 62 44 boxprim clip newpath +36 36 translate +0 0 1 beginpage +1.0000 set_scale +4 4 translate 0 rotate +0.167 0.600 1.000 graphcolor +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +60 42 lineto +60 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +60 42 lineto +60 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% Asp4 +[ /Rect [ 0 0 54 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=ASP4) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 54 36 moveto +0 36 lineto +0 0 lineto +54 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 54 36 moveto +0 36 lineto +0 0 lineto +54 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +11 13 moveto +(Asp4) +[10.08 5.52 6.96 6.96] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103asp41.ps b/books/ps/v103asp41.ps new file mode 100644 index 0000000..7fb8591 --- /dev/null +++ b/books/ps/v103asp41.ps @@ -0,0 +1,248 @@ +%!PS-Adobe-2.0 +%%Creator: dot version 2.8 (Thu Sep 14 20:34:11 UTC 2006) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: 36 36 98 80 +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + dup scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw aligned label in bounding box aligned to current point +/alignedtext { % width adj text + /text exch def + /adj exch def + /width exch def + gsave + width 0 gt { + text stringwidth pop adj mul 0 rmoveto + } if + [] 0 setdash + text show + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +%%Page: 1 1 +%%PageBoundingBox: 36 36 98 80 +%%PageOrientation: Portrait +gsave +36 36 62 44 boxprim clip newpath +36 36 translate +0 0 1 beginpage +1.0000 set_scale +4 4 translate 0 rotate +0.167 0.600 1.000 graphcolor +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +60 42 lineto +60 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +60 42 lineto +60 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% Asp41 +[ /Rect [ 0 0 54 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=ASP41) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 54 36 moveto +0 36 lineto +0 0 lineto +54 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 54 36 moveto +0 36 lineto +0 0 lineto +54 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +8 13 moveto +(Asp41) +[10.08 5.52 6.96 6 6.96] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103asp42.ps b/books/ps/v103asp42.ps new file mode 100644 index 0000000..3d4038e --- /dev/null +++ b/books/ps/v103asp42.ps @@ -0,0 +1,248 @@ +%!PS-Adobe-2.0 +%%Creator: dot version 2.8 (Thu Sep 14 20:34:11 UTC 2006) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: 36 36 98 80 +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + dup scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw aligned label in bounding box aligned to current point +/alignedtext { % width adj text + /text exch def + /adj exch def + /width exch def + gsave + width 0 gt { + text stringwidth pop adj mul 0 rmoveto + } if + [] 0 setdash + text show + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +%%Page: 1 1 +%%PageBoundingBox: 36 36 98 80 +%%PageOrientation: Portrait +gsave +36 36 62 44 boxprim clip newpath +36 36 translate +0 0 1 beginpage +1.0000 set_scale +4 4 translate 0 rotate +0.167 0.600 1.000 graphcolor +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +60 42 lineto +60 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +60 42 lineto +60 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% Asp42 +[ /Rect [ 0 0 54 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=ASP42) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 54 36 moveto +0 36 lineto +0 0 lineto +54 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 54 36 moveto +0 36 lineto +0 0 lineto +54 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +8 13 moveto +(Asp42) +[10.08 5.52 6.96 6.96 6.96] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103asp49.ps b/books/ps/v103asp49.ps new file mode 100644 index 0000000..44db130 --- /dev/null +++ b/books/ps/v103asp49.ps @@ -0,0 +1,248 @@ +%!PS-Adobe-2.0 +%%Creator: dot version 2.8 (Thu Sep 14 20:34:11 UTC 2006) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: 36 36 98 80 +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + dup scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw aligned label in bounding box aligned to current point +/alignedtext { % width adj text + /text exch def + /adj exch def + /width exch def + gsave + width 0 gt { + text stringwidth pop adj mul 0 rmoveto + } if + [] 0 setdash + text show + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +%%Page: 1 1 +%%PageBoundingBox: 36 36 98 80 +%%PageOrientation: Portrait +gsave +36 36 62 44 boxprim clip newpath +36 36 translate +0 0 1 beginpage +1.0000 set_scale +4 4 translate 0 rotate +0.167 0.600 1.000 graphcolor +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +60 42 lineto +60 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +60 42 lineto +60 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% Asp49 +[ /Rect [ 0 0 54 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=ASP49) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 54 36 moveto +0 36 lineto +0 0 lineto +54 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 54 36 moveto +0 36 lineto +0 0 lineto +54 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +8 13 moveto +(Asp49) +[10.08 5.52 6.96 6.96 6.96] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103asp50.ps b/books/ps/v103asp50.ps new file mode 100644 index 0000000..a28df5c --- /dev/null +++ b/books/ps/v103asp50.ps @@ -0,0 +1,248 @@ +%!PS-Adobe-2.0 +%%Creator: dot version 2.8 (Thu Sep 14 20:34:11 UTC 2006) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: 36 36 98 80 +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + dup scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw aligned label in bounding box aligned to current point +/alignedtext { % width adj text + /text exch def + /adj exch def + /width exch def + gsave + width 0 gt { + text stringwidth pop adj mul 0 rmoveto + } if + [] 0 setdash + text show + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +%%Page: 1 1 +%%PageBoundingBox: 36 36 98 80 +%%PageOrientation: Portrait +gsave +36 36 62 44 boxprim clip newpath +36 36 translate +0 0 1 beginpage +1.0000 set_scale +4 4 translate 0 rotate +0.167 0.600 1.000 graphcolor +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +60 42 lineto +60 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +60 42 lineto +60 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% Asp50 +[ /Rect [ 0 0 54 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=ASP50) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 54 36 moveto +0 36 lineto +0 0 lineto +54 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 54 36 moveto +0 36 lineto +0 0 lineto +54 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +8 13 moveto +(Asp50) +[10.08 5.52 6.96 6.96 6.96] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103asp55.ps b/books/ps/v103asp55.ps new file mode 100644 index 0000000..09e0e00 --- /dev/null +++ b/books/ps/v103asp55.ps @@ -0,0 +1,248 @@ +%!PS-Adobe-2.0 +%%Creator: dot version 2.8 (Thu Sep 14 20:34:11 UTC 2006) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: 36 36 98 80 +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + dup scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw aligned label in bounding box aligned to current point +/alignedtext { % width adj text + /text exch def + /adj exch def + /width exch def + gsave + width 0 gt { + text stringwidth pop adj mul 0 rmoveto + } if + [] 0 setdash + text show + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +%%Page: 1 1 +%%PageBoundingBox: 36 36 98 80 +%%PageOrientation: Portrait +gsave +36 36 62 44 boxprim clip newpath +36 36 translate +0 0 1 beginpage +1.0000 set_scale +4 4 translate 0 rotate +0.167 0.600 1.000 graphcolor +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +60 42 lineto +60 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +60 42 lineto +60 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% Asp55 +[ /Rect [ 0 0 54 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=ASP55) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 54 36 moveto +0 36 lineto +0 0 lineto +54 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 54 36 moveto +0 36 lineto +0 0 lineto +54 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +8 13 moveto +(Asp55) +[10.08 5.52 6.96 6.96 6.96] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103asp6.ps b/books/ps/v103asp6.ps new file mode 100644 index 0000000..e65982e --- /dev/null +++ b/books/ps/v103asp6.ps @@ -0,0 +1,248 @@ +%!PS-Adobe-2.0 +%%Creator: dot version 2.8 (Thu Sep 14 20:34:11 UTC 2006) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: 36 36 98 80 +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + dup scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw aligned label in bounding box aligned to current point +/alignedtext { % width adj text + /text exch def + /adj exch def + /width exch def + gsave + width 0 gt { + text stringwidth pop adj mul 0 rmoveto + } if + [] 0 setdash + text show + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +%%Page: 1 1 +%%PageBoundingBox: 36 36 98 80 +%%PageOrientation: Portrait +gsave +36 36 62 44 boxprim clip newpath +36 36 translate +0 0 1 beginpage +1.0000 set_scale +4 4 translate 0 rotate +0.167 0.600 1.000 graphcolor +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +60 42 lineto +60 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +60 42 lineto +60 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% Asp6 +[ /Rect [ 0 0 54 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=ASP6) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 54 36 moveto +0 36 lineto +0 0 lineto +54 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 54 36 moveto +0 36 lineto +0 0 lineto +54 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +11 13 moveto +(Asp6) +[10.08 5.52 6.96 6.96] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103asp7.ps b/books/ps/v103asp7.ps new file mode 100644 index 0000000..86b889c --- /dev/null +++ b/books/ps/v103asp7.ps @@ -0,0 +1,248 @@ +%!PS-Adobe-2.0 +%%Creator: dot version 2.8 (Thu Sep 14 20:34:11 UTC 2006) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: 36 36 98 80 +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + dup scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw aligned label in bounding box aligned to current point +/alignedtext { % width adj text + /text exch def + /adj exch def + /width exch def + gsave + width 0 gt { + text stringwidth pop adj mul 0 rmoveto + } if + [] 0 setdash + text show + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +%%Page: 1 1 +%%PageBoundingBox: 36 36 98 80 +%%PageOrientation: Portrait +gsave +36 36 62 44 boxprim clip newpath +36 36 translate +0 0 1 beginpage +1.0000 set_scale +4 4 translate 0 rotate +0.167 0.600 1.000 graphcolor +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +60 42 lineto +60 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +60 42 lineto +60 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% Asp7 +[ /Rect [ 0 0 54 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=ASP7) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 54 36 moveto +0 36 lineto +0 0 lineto +54 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 54 36 moveto +0 36 lineto +0 0 lineto +54 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +11 13 moveto +(Asp7) +[10.08 5.52 6.96 6.96] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103asp73.ps b/books/ps/v103asp73.ps new file mode 100644 index 0000000..fcf15a8 --- /dev/null +++ b/books/ps/v103asp73.ps @@ -0,0 +1,248 @@ +%!PS-Adobe-2.0 +%%Creator: dot version 2.8 (Thu Sep 14 20:34:11 UTC 2006) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: 36 36 98 80 +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + dup scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw aligned label in bounding box aligned to current point +/alignedtext { % width adj text + /text exch def + /adj exch def + /width exch def + gsave + width 0 gt { + text stringwidth pop adj mul 0 rmoveto + } if + [] 0 setdash + text show + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +%%Page: 1 1 +%%PageBoundingBox: 36 36 98 80 +%%PageOrientation: Portrait +gsave +36 36 62 44 boxprim clip newpath +36 36 translate +0 0 1 beginpage +1.0000 set_scale +4 4 translate 0 rotate +0.167 0.600 1.000 graphcolor +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +60 42 lineto +60 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +60 42 lineto +60 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% Asp73 +[ /Rect [ 0 0 54 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=ASP73) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 54 36 moveto +0 36 lineto +0 0 lineto +54 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 54 36 moveto +0 36 lineto +0 0 lineto +54 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +8 13 moveto +(Asp73) +[10.08 5.52 6.96 6.48 6.96] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103asp74.ps b/books/ps/v103asp74.ps new file mode 100644 index 0000000..83917d6 --- /dev/null +++ b/books/ps/v103asp74.ps @@ -0,0 +1,248 @@ +%!PS-Adobe-2.0 +%%Creator: dot version 2.8 (Thu Sep 14 20:34:11 UTC 2006) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: 36 36 98 80 +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + dup scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw aligned label in bounding box aligned to current point +/alignedtext { % width adj text + /text exch def + /adj exch def + /width exch def + gsave + width 0 gt { + text stringwidth pop adj mul 0 rmoveto + } if + [] 0 setdash + text show + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +%%Page: 1 1 +%%PageBoundingBox: 36 36 98 80 +%%PageOrientation: Portrait +gsave +36 36 62 44 boxprim clip newpath +36 36 translate +0 0 1 beginpage +1.0000 set_scale +4 4 translate 0 rotate +0.167 0.600 1.000 graphcolor +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +60 42 lineto +60 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +60 42 lineto +60 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% Asp74 +[ /Rect [ 0 0 54 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=ASP74) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 54 36 moveto +0 36 lineto +0 0 lineto +54 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 54 36 moveto +0 36 lineto +0 0 lineto +54 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +8 13 moveto +(Asp74) +[10.08 5.52 6.96 6 6.96] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103asp77.ps b/books/ps/v103asp77.ps new file mode 100644 index 0000000..eddb93a --- /dev/null +++ b/books/ps/v103asp77.ps @@ -0,0 +1,248 @@ +%!PS-Adobe-2.0 +%%Creator: dot version 2.8 (Thu Sep 14 20:34:11 UTC 2006) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: 36 36 98 80 +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + dup scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw aligned label in bounding box aligned to current point +/alignedtext { % width adj text + /text exch def + /adj exch def + /width exch def + gsave + width 0 gt { + text stringwidth pop adj mul 0 rmoveto + } if + [] 0 setdash + text show + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +%%Page: 1 1 +%%PageBoundingBox: 36 36 98 80 +%%PageOrientation: Portrait +gsave +36 36 62 44 boxprim clip newpath +36 36 translate +0 0 1 beginpage +1.0000 set_scale +4 4 translate 0 rotate +0.167 0.600 1.000 graphcolor +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +60 42 lineto +60 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +60 42 lineto +60 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% Asp77 +[ /Rect [ 0 0 54 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=ASP77) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 54 36 moveto +0 36 lineto +0 0 lineto +54 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 54 36 moveto +0 36 lineto +0 0 lineto +54 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +8 13 moveto +(Asp77) +[10.08 5.52 6.96 6.72 6.96] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103asp78.ps b/books/ps/v103asp78.ps new file mode 100644 index 0000000..9d54c49 --- /dev/null +++ b/books/ps/v103asp78.ps @@ -0,0 +1,248 @@ +%!PS-Adobe-2.0 +%%Creator: dot version 2.8 (Thu Sep 14 20:34:11 UTC 2006) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: 36 36 98 80 +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + dup scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw aligned label in bounding box aligned to current point +/alignedtext { % width adj text + /text exch def + /adj exch def + /width exch def + gsave + width 0 gt { + text stringwidth pop adj mul 0 rmoveto + } if + [] 0 setdash + text show + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +%%Page: 1 1 +%%PageBoundingBox: 36 36 98 80 +%%PageOrientation: Portrait +gsave +36 36 62 44 boxprim clip newpath +36 36 translate +0 0 1 beginpage +1.0000 set_scale +4 4 translate 0 rotate +0.167 0.600 1.000 graphcolor +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +60 42 lineto +60 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +60 42 lineto +60 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% Asp78 +[ /Rect [ 0 0 54 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=ASP78) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 54 36 moveto +0 36 lineto +0 0 lineto +54 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 54 36 moveto +0 36 lineto +0 0 lineto +54 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +8 13 moveto +(Asp78) +[10.08 5.52 6.96 6.48 6.96] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103asp8.ps b/books/ps/v103asp8.ps new file mode 100644 index 0000000..4c3eb0d --- /dev/null +++ b/books/ps/v103asp8.ps @@ -0,0 +1,248 @@ +%!PS-Adobe-2.0 +%%Creator: dot version 2.8 (Thu Sep 14 20:34:11 UTC 2006) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: 36 36 98 80 +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + dup scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw aligned label in bounding box aligned to current point +/alignedtext { % width adj text + /text exch def + /adj exch def + /width exch def + gsave + width 0 gt { + text stringwidth pop adj mul 0 rmoveto + } if + [] 0 setdash + text show + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +%%Page: 1 1 +%%PageBoundingBox: 36 36 98 80 +%%PageOrientation: Portrait +gsave +36 36 62 44 boxprim clip newpath +36 36 translate +0 0 1 beginpage +1.0000 set_scale +4 4 translate 0 rotate +0.167 0.600 1.000 graphcolor +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +60 42 lineto +60 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +60 42 lineto +60 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% Asp8 +[ /Rect [ 0 0 54 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=ASP8) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 54 36 moveto +0 36 lineto +0 0 lineto +54 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 54 36 moveto +0 36 lineto +0 0 lineto +54 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +11 13 moveto +(Asp8) +[10.08 5.52 6.96 6.96] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103asp80.ps b/books/ps/v103asp80.ps new file mode 100644 index 0000000..fa148ce --- /dev/null +++ b/books/ps/v103asp80.ps @@ -0,0 +1,248 @@ +%!PS-Adobe-2.0 +%%Creator: dot version 2.8 (Thu Sep 14 20:34:11 UTC 2006) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: 36 36 98 80 +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + dup scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw aligned label in bounding box aligned to current point +/alignedtext { % width adj text + /text exch def + /adj exch def + /width exch def + gsave + width 0 gt { + text stringwidth pop adj mul 0 rmoveto + } if + [] 0 setdash + text show + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +%%Page: 1 1 +%%PageBoundingBox: 36 36 98 80 +%%PageOrientation: Portrait +gsave +36 36 62 44 boxprim clip newpath +36 36 translate +0 0 1 beginpage +1.0000 set_scale +4 4 translate 0 rotate +0.167 0.600 1.000 graphcolor +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +60 42 lineto +60 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +60 42 lineto +60 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% Asp80 +[ /Rect [ 0 0 54 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=ASP80) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 54 36 moveto +0 36 lineto +0 0 lineto +54 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 54 36 moveto +0 36 lineto +0 0 lineto +54 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +8 13 moveto +(Asp80) +[10.08 5.52 6.96 6.96 6.96] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103asp9.ps b/books/ps/v103asp9.ps new file mode 100644 index 0000000..42bf087 --- /dev/null +++ b/books/ps/v103asp9.ps @@ -0,0 +1,248 @@ +%!PS-Adobe-2.0 +%%Creator: dot version 2.8 (Thu Sep 14 20:34:11 UTC 2006) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: 36 36 98 80 +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + dup scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw aligned label in bounding box aligned to current point +/alignedtext { % width adj text + /text exch def + /adj exch def + /width exch def + gsave + width 0 gt { + text stringwidth pop adj mul 0 rmoveto + } if + [] 0 setdash + text show + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +%%Page: 1 1 +%%PageBoundingBox: 36 36 98 80 +%%PageOrientation: Portrait +gsave +36 36 62 44 boxprim clip newpath +36 36 translate +0 0 1 beginpage +1.0000 set_scale +4 4 translate 0 rotate +0.167 0.600 1.000 graphcolor +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +60 42 lineto +60 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +60 42 lineto +60 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% Asp9 +[ /Rect [ 0 0 54 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=ASP9) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 54 36 moveto +0 36 lineto +0 0 lineto +54 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 54 36 moveto +0 36 lineto +0 0 lineto +54 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +11 13 moveto +(Asp9) +[10.08 5.52 6.96 6.96] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103database.ps b/books/ps/v103database.ps new file mode 100644 index 0000000..6c99bc0 --- /dev/null +++ b/books/ps/v103database.ps @@ -0,0 +1,248 @@ +%!PS-Adobe-2.0 +%%Creator: dot version 2.8 (Thu Sep 14 20:34:11 UTC 2006) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: 36 36 112 80 +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + dup scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw aligned label in bounding box aligned to current point +/alignedtext { % width adj text + /text exch def + /adj exch def + /width exch def + gsave + width 0 gt { + text stringwidth pop adj mul 0 rmoveto + } if + [] 0 setdash + text show + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +%%Page: 1 1 +%%PageBoundingBox: 36 36 112 80 +%%PageOrientation: Portrait +gsave +36 36 76 44 boxprim clip newpath +36 36 translate +0 0 1 beginpage +1.0000 set_scale +4 4 translate 0 rotate +0.167 0.600 1.000 graphcolor +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +74 42 lineto +74 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +74 42 lineto +74 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% Database +[ /Rect [ 0 0 68 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=DBASE) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 68 36 moveto +0 36 lineto +0 0 lineto +68 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 68 36 moveto +0 36 lineto +0 0 lineto +68 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +7 13 moveto +(Database) +[10.08 6.24 4.08 6.24 6.96 6.24 5.52 6.24] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103datalist.ps b/books/ps/v103datalist.ps new file mode 100644 index 0000000..ca74dac --- /dev/null +++ b/books/ps/v103datalist.ps @@ -0,0 +1,248 @@ +%!PS-Adobe-2.0 +%%Creator: dot version 2.8 (Thu Sep 14 20:34:11 UTC 2006) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: 36 36 110 80 +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + dup scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw aligned label in bounding box aligned to current point +/alignedtext { % width adj text + /text exch def + /adj exch def + /width exch def + gsave + width 0 gt { + text stringwidth pop adj mul 0 rmoveto + } if + [] 0 setdash + text show + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +%%Page: 1 1 +%%PageBoundingBox: 36 36 110 80 +%%PageOrientation: Portrait +gsave +36 36 74 44 boxprim clip newpath +36 36 translate +0 0 1 beginpage +1.0000 set_scale +4 4 translate 0 rotate +0.167 0.600 1.000 graphcolor +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +72 42 lineto +72 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +72 42 lineto +72 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% DataList +[ /Rect [ 0 0 66 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=DLIST) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 66 36 moveto +0 36 lineto +0 0 lineto +66 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 66 36 moveto +0 36 lineto +0 0 lineto +66 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +8 13 moveto +(DataList) +[10.08 6.24 4.08 6.24 8.64 3.84 5.28 3.84] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103denavithartenbergmatrix.ps b/books/ps/v103denavithartenbergmatrix.ps index b796658..c9864a2 100644 --- a/books/ps/v103denavithartenbergmatrix.ps +++ b/books/ps/v103denavithartenbergmatrix.ps @@ -3,7 +3,7 @@ %%For: (root) root %%Title: pic %%Pages: (atend) -%%BoundingBox: 36 36 134 80 +%%BoundingBox: 36 36 206 80 %%EndComments save %%BeginProlog @@ -180,10 +180,10 @@ def %%EndSetup %%Page: 1 1 -%%PageBoundingBox: 36 36 134 80 +%%PageBoundingBox: 36 36 206 80 %%PageOrientation: Portrait gsave -36 36 98 44 boxprim clip newpath +36 36 170 44 boxprim clip newpath 36 36 translate 0 0 1 beginpage 1.0000 set_scale @@ -192,47 +192,47 @@ gsave 0.167 0.600 1.000 graphcolor newpath -6 -6 moveto -6 42 lineto -96 42 lineto -96 -6 lineto +168 42 lineto +168 -6 lineto closepath fill 0.167 0.600 1.000 graphcolor newpath -6 -6 moveto -6 42 lineto -96 42 lineto -96 -6 lineto +168 42 lineto +168 -6 lineto closepath stroke 0.000 0.000 0.000 graphcolor 14.00 /Times-Roman set_font -% CATEGORY -[ /Rect [ 0 0 90 36 ] +% DenavitHartenbergMatrix +[ /Rect [ 0 0 162 36 ] /Border [ 0 0 0 ] - /Action << /Subtype /URI /URI (bookvol10.2.pdf#nameddest=CATEGORY) >> + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=DHMATRIX) >> /Subtype /Link /ANN pdfmark gsave 10 dict begin filled 0.537 0.247 0.902 nodecolor 0.537 0.247 0.902 nodecolor -newpath 90 36 moveto +newpath 162 36 moveto 0 36 lineto 0 0 lineto -90 0 lineto +162 0 lineto closepath fill 0.537 0.247 0.902 nodecolor -newpath 90 36 moveto +newpath 162 36 moveto 0 36 lineto 0 0 lineto -90 0 lineto +162 0 lineto closepath stroke gsave 10 dict begin 0.000 0.000 0.000 nodecolor 7 13 moveto -(CATEGORY) -[9.12 9.36 8.64 8.64 10.08 10.08 8.4 10.08] +(DenavitHartenbergMatrix) +[10.08 6.24 6.96 5.76 6.96 3.84 3.84 10.08 6.24 5.04 3.84 6.24 6.96 6.96 6.24 4.56 6.96 12.48 6.24 3.84 5.04 3.84 6.96] xshow end grestore end grestore diff --git a/books/ps/v103flexiblearray.ps b/books/ps/v103flexiblearray.ps new file mode 100644 index 0000000..2d99883 --- /dev/null +++ b/books/ps/v103flexiblearray.ps @@ -0,0 +1,248 @@ +%!PS-Adobe-2.0 +%%Creator: dot version 2.8 (Thu Sep 14 20:34:11 UTC 2006) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: 36 36 138 80 +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + dup scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw aligned label in bounding box aligned to current point +/alignedtext { % width adj text + /text exch def + /adj exch def + /width exch def + gsave + width 0 gt { + text stringwidth pop adj mul 0 rmoveto + } if + [] 0 setdash + text show + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +%%Page: 1 1 +%%PageBoundingBox: 36 36 138 80 +%%PageOrientation: Portrait +gsave +36 36 102 44 boxprim clip newpath +36 36 translate +0 0 1 beginpage +1.0000 set_scale +4 4 translate 0 rotate +0.167 0.600 1.000 graphcolor +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +100 42 lineto +100 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +100 42 lineto +100 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% FlexibleArray +[ /Rect [ 0 0 94 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=FARRAY) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 94 36 moveto +0 36 lineto +0 0 lineto +94 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 94 36 moveto +0 36 lineto +0 0 lineto +94 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +7 13 moveto +(FlexibleArray) +[7.68 3.84 5.76 6.96 3.84 6.96 3.84 6.24 10.08 5.28 4.8 5.76 6.96] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103indexcard.ps b/books/ps/v103indexcard.ps new file mode 100644 index 0000000..526a941 --- /dev/null +++ b/books/ps/v103indexcard.ps @@ -0,0 +1,248 @@ +%!PS-Adobe-2.0 +%%Creator: dot version 2.8 (Thu Sep 14 20:34:11 UTC 2006) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: 36 36 120 80 +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + dup scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw aligned label in bounding box aligned to current point +/alignedtext { % width adj text + /text exch def + /adj exch def + /width exch def + gsave + width 0 gt { + text stringwidth pop adj mul 0 rmoveto + } if + [] 0 setdash + text show + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +%%Page: 1 1 +%%PageBoundingBox: 36 36 120 80 +%%PageOrientation: Portrait +gsave +36 36 84 44 boxprim clip newpath +36 36 translate +0 0 1 beginpage +1.0000 set_scale +4 4 translate 0 rotate +0.167 0.600 1.000 graphcolor +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +82 42 lineto +82 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +82 42 lineto +82 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% IndexCard +[ /Rect [ 0 0 76 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=ICARD) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 76 36 moveto +0 36 lineto +0 0 lineto +76 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 76 36 moveto +0 36 lineto +0 0 lineto +76 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +8 13 moveto +(IndexCard) +[4.56 6.96 6.96 5.76 6.96 9.36 6.24 4.56 6.96] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103indexedflexiblearray.ps b/books/ps/v103indexedflexiblearray.ps new file mode 100644 index 0000000..78ad134 --- /dev/null +++ b/books/ps/v103indexedflexiblearray.ps @@ -0,0 +1,248 @@ +%!PS-Adobe-2.0 +%%Creator: dot version 2.8 (Thu Sep 14 20:34:11 UTC 2006) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: 36 36 184 80 +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + dup scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw aligned label in bounding box aligned to current point +/alignedtext { % width adj text + /text exch def + /adj exch def + /width exch def + gsave + width 0 gt { + text stringwidth pop adj mul 0 rmoveto + } if + [] 0 setdash + text show + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +%%Page: 1 1 +%%PageBoundingBox: 36 36 184 80 +%%PageOrientation: Portrait +gsave +36 36 148 44 boxprim clip newpath +36 36 translate +0 0 1 beginpage +1.0000 set_scale +4 4 translate 0 rotate +0.167 0.600 1.000 graphcolor +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +146 42 lineto +146 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +146 42 lineto +146 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% IndexedFlexibleArray +[ /Rect [ 0 0 140 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=IFARRAY) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 140 36 moveto +0 36 lineto +0 0 lineto +140 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 140 36 moveto +0 36 lineto +0 0 lineto +140 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +8 13 moveto +(IndexedFlexibleArray) +[4.56 6.96 6.96 5.76 6.48 6.24 6.96 7.68 3.84 5.76 6.96 3.84 6.96 3.84 6.24 10.08 5.28 4.8 5.76 6.96] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103indexedonedimensionalarray.ps b/books/ps/v103indexedonedimensionalarray.ps new file mode 100644 index 0000000..de60ba3 --- /dev/null +++ b/books/ps/v103indexedonedimensionalarray.ps @@ -0,0 +1,248 @@ +%!PS-Adobe-2.0 +%%Creator: dot version 2.8 (Thu Sep 14 20:34:11 UTC 2006) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: 36 36 232 80 +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + dup scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw aligned label in bounding box aligned to current point +/alignedtext { % width adj text + /text exch def + /adj exch def + /width exch def + gsave + width 0 gt { + text stringwidth pop adj mul 0 rmoveto + } if + [] 0 setdash + text show + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +%%Page: 1 1 +%%PageBoundingBox: 36 36 232 80 +%%PageOrientation: Portrait +gsave +36 36 196 44 boxprim clip newpath +36 36 translate +0 0 1 beginpage +1.0000 set_scale +4 4 translate 0 rotate +0.167 0.600 1.000 graphcolor +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +194 42 lineto +194 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +194 42 lineto +194 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% IndexedOneDimensionalArray +[ /Rect [ 0 0 188 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=IARRAY1) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 188 36 moveto +0 36 lineto +0 0 lineto +188 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 188 36 moveto +0 36 lineto +0 0 lineto +188 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +7 13 moveto +(IndexedOneDimensionalArray) +[4.56 6.96 6.96 5.76 6.48 6.24 6.96 10.08 6.96 6.24 10.08 3.84 10.8 6.24 6.96 5.52 3.84 6.96 6.96 6.24 3.84 10.08 5.28 4.8 5.76 6.96] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103indexedtwodimensionalarray.ps b/books/ps/v103indexedtwodimensionalarray.ps new file mode 100644 index 0000000..77378b4 --- /dev/null +++ b/books/ps/v103indexedtwodimensionalarray.ps @@ -0,0 +1,248 @@ +%!PS-Adobe-2.0 +%%Creator: dot version 2.8 (Thu Sep 14 20:34:11 UTC 2006) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: 36 36 232 80 +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + dup scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw aligned label in bounding box aligned to current point +/alignedtext { % width adj text + /text exch def + /adj exch def + /width exch def + gsave + width 0 gt { + text stringwidth pop adj mul 0 rmoveto + } if + [] 0 setdash + text show + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +%%Page: 1 1 +%%PageBoundingBox: 36 36 232 80 +%%PageOrientation: Portrait +gsave +36 36 196 44 boxprim clip newpath +36 36 translate +0 0 1 beginpage +1.0000 set_scale +4 4 translate 0 rotate +0.167 0.600 1.000 graphcolor +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +194 42 lineto +194 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +194 42 lineto +194 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% IndexedTwoDimensionalArray +[ /Rect [ 0 0 188 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=IARRAY2) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 188 36 moveto +0 36 lineto +0 0 lineto +188 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 188 36 moveto +0 36 lineto +0 0 lineto +188 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +7 13 moveto +(IndexedTwoDimensionalArray) +[4.56 6.96 6.96 5.76 6.48 6.24 6.96 7.2 9.6 6.96 10.08 3.84 10.8 6.24 6.96 5.52 3.84 6.96 6.96 6.24 3.84 10.08 5.28 4.8 5.76 6.96] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103innerindexedtwodimensionalarray.ps b/books/ps/v103innerindexedtwodimensionalarray.ps new file mode 100644 index 0000000..67c2d33 --- /dev/null +++ b/books/ps/v103innerindexedtwodimensionalarray.ps @@ -0,0 +1,248 @@ +%!PS-Adobe-2.0 +%%Creator: dot version 2.8 (Thu Sep 14 20:34:11 UTC 2006) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: 36 36 262 80 +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + dup scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw aligned label in bounding box aligned to current point +/alignedtext { % width adj text + /text exch def + /adj exch def + /width exch def + gsave + width 0 gt { + text stringwidth pop adj mul 0 rmoveto + } if + [] 0 setdash + text show + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +%%Page: 1 1 +%%PageBoundingBox: 36 36 262 80 +%%PageOrientation: Portrait +gsave +36 36 226 44 boxprim clip newpath +36 36 translate +0 0 1 beginpage +1.0000 set_scale +4 4 translate 0 rotate +0.167 0.600 1.000 graphcolor +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +224 42 lineto +224 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +224 42 lineto +224 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% InnerIndexedTwoDimensionalArray +[ /Rect [ 0 0 218 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=IIARRAY2) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 218 36 moveto +0 36 lineto +0 0 lineto +218 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 218 36 moveto +0 36 lineto +0 0 lineto +218 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +7 13 moveto +(InnerIndexedTwoDimensionalArray) +[4.56 6.96 6.96 6.24 4.8 4.56 6.96 6.96 5.76 6.48 6.24 6.96 7.2 9.6 6.96 10.08 3.84 10.8 6.24 6.96 5.52 3.84 6.96 6.96 6.24 3.84 10.08 5.28 4.8 5.76 6.96] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103none.ps b/books/ps/v103none.ps new file mode 100644 index 0000000..c9be923 --- /dev/null +++ b/books/ps/v103none.ps @@ -0,0 +1,248 @@ +%!PS-Adobe-2.0 +%%Creator: dot version 2.8 (Thu Sep 14 20:34:11 UTC 2006) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: 36 36 98 80 +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + dup scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw aligned label in bounding box aligned to current point +/alignedtext { % width adj text + /text exch def + /adj exch def + /width exch def + gsave + width 0 gt { + text stringwidth pop adj mul 0 rmoveto + } if + [] 0 setdash + text show + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +%%Page: 1 1 +%%PageBoundingBox: 36 36 98 80 +%%PageOrientation: Portrait +gsave +36 36 62 44 boxprim clip newpath +36 36 translate +0 0 1 beginpage +1.0000 set_scale +4 4 translate 0 rotate +0.167 0.600 1.000 graphcolor +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +60 42 lineto +60 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +60 42 lineto +60 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% None +[ /Rect [ 0 0 54 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=NONE) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 54 36 moveto +0 36 lineto +0 0 lineto +54 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 54 36 moveto +0 36 lineto +0 0 lineto +54 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +11 13 moveto +(None) +[9.84 6.96 6.96 6.24] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103numericalintegrationproblem.ps b/books/ps/v103numericalintegrationproblem.ps new file mode 100644 index 0000000..79fe67f --- /dev/null +++ b/books/ps/v103numericalintegrationproblem.ps @@ -0,0 +1,248 @@ +%!PS-Adobe-2.0 +%%Creator: dot version 2.8 (Thu Sep 14 20:34:11 UTC 2006) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: 36 36 228 80 +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + dup scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw aligned label in bounding box aligned to current point +/alignedtext { % width adj text + /text exch def + /adj exch def + /width exch def + gsave + width 0 gt { + text stringwidth pop adj mul 0 rmoveto + } if + [] 0 setdash + text show + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +%%Page: 1 1 +%%PageBoundingBox: 36 36 228 80 +%%PageOrientation: Portrait +gsave +36 36 192 44 boxprim clip newpath +36 36 translate +0 0 1 beginpage +1.0000 set_scale +4 4 translate 0 rotate +0.167 0.600 1.000 graphcolor +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +190 42 lineto +190 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +190 42 lineto +190 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% NumericalIntegrationProblem +[ /Rect [ 0 0 184 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=NIPROB) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 184 36 moveto +0 36 lineto +0 0 lineto +184 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 184 36 moveto +0 36 lineto +0 0 lineto +184 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +7 13 moveto +(NumericalIntegrationProblem) +[9.84 6.96 10.8 6.24 5.04 3.84 6.24 6.24 3.84 4.56 6.96 3.84 6.24 7.2 4.8 6.24 3.84 3.84 6.96 6.96 7.68 4.8 6.96 6.96 3.84 6.24 10.8] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103numericalodeproblem.ps b/books/ps/v103numericalodeproblem.ps new file mode 100644 index 0000000..73c3f6f --- /dev/null +++ b/books/ps/v103numericalodeproblem.ps @@ -0,0 +1,248 @@ +%!PS-Adobe-2.0 +%%Creator: dot version 2.8 (Thu Sep 14 20:34:11 UTC 2006) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: 36 36 196 80 +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + dup scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw aligned label in bounding box aligned to current point +/alignedtext { % width adj text + /text exch def + /adj exch def + /width exch def + gsave + width 0 gt { + text stringwidth pop adj mul 0 rmoveto + } if + [] 0 setdash + text show + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +%%Page: 1 1 +%%PageBoundingBox: 36 36 196 80 +%%PageOrientation: Portrait +gsave +36 36 160 44 boxprim clip newpath +36 36 translate +0 0 1 beginpage +1.0000 set_scale +4 4 translate 0 rotate +0.167 0.600 1.000 graphcolor +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +158 42 lineto +158 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +158 42 lineto +158 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% NumericalODEProblem +[ /Rect [ 0 0 152 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=ODEPROB) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 152 36 moveto +0 36 lineto +0 0 lineto +152 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 152 36 moveto +0 36 lineto +0 0 lineto +152 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +7 13 moveto +(NumericalODEProblem) +[9.84 6.96 10.8 6.24 5.04 3.84 6.24 6.24 3.84 10.08 10.08 8.64 7.68 4.8 6.96 6.96 3.84 6.24 10.8] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103numericaloptimizationproblem.ps b/books/ps/v103numericaloptimizationproblem.ps new file mode 100644 index 0000000..a8aa7a8 --- /dev/null +++ b/books/ps/v103numericaloptimizationproblem.ps @@ -0,0 +1,248 @@ +%!PS-Adobe-2.0 +%%Creator: dot version 2.8 (Thu Sep 14 20:34:11 UTC 2006) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: 36 36 240 80 +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + dup scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw aligned label in bounding box aligned to current point +/alignedtext { % width adj text + /text exch def + /adj exch def + /width exch def + gsave + width 0 gt { + text stringwidth pop adj mul 0 rmoveto + } if + [] 0 setdash + text show + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +%%Page: 1 1 +%%PageBoundingBox: 36 36 240 80 +%%PageOrientation: Portrait +gsave +36 36 204 44 boxprim clip newpath +36 36 translate +0 0 1 beginpage +1.0000 set_scale +4 4 translate 0 rotate +0.167 0.600 1.000 graphcolor +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +202 42 lineto +202 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +202 42 lineto +202 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% NumericalOptimizationProblem +[ /Rect [ 0 0 196 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=OPTPROB) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 196 36 moveto +0 36 lineto +0 0 lineto +196 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 196 36 moveto +0 36 lineto +0 0 lineto +196 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +7 13 moveto +(NumericalOptimizationProblem) +[9.84 6.96 10.8 6.24 5.04 3.84 6.24 6.24 3.84 10.08 6.96 3.84 3.84 10.8 3.84 6.24 6.24 3.84 3.84 6.96 6.96 7.68 4.8 6.96 6.96 3.84 6.24 10.8] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103numericalpdeproblem.ps b/books/ps/v103numericalpdeproblem.ps new file mode 100644 index 0000000..c5e37d0 --- /dev/null +++ b/books/ps/v103numericalpdeproblem.ps @@ -0,0 +1,248 @@ +%!PS-Adobe-2.0 +%%Creator: dot version 2.8 (Thu Sep 14 20:34:11 UTC 2006) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: 36 36 194 80 +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + dup scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw aligned label in bounding box aligned to current point +/alignedtext { % width adj text + /text exch def + /adj exch def + /width exch def + gsave + width 0 gt { + text stringwidth pop adj mul 0 rmoveto + } if + [] 0 setdash + text show + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +%%Page: 1 1 +%%PageBoundingBox: 36 36 194 80 +%%PageOrientation: Portrait +gsave +36 36 158 44 boxprim clip newpath +36 36 translate +0 0 1 beginpage +1.0000 set_scale +4 4 translate 0 rotate +0.167 0.600 1.000 graphcolor +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +156 42 lineto +156 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +156 42 lineto +156 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% NumericalPDEProblem +[ /Rect [ 0 0 150 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=PDEPROB) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 150 36 moveto +0 36 lineto +0 0 lineto +150 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 150 36 moveto +0 36 lineto +0 0 lineto +150 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +8 13 moveto +(NumericalPDEProblem) +[9.84 6.96 10.8 6.24 5.04 3.84 6.24 6.24 3.84 7.68 10.08 8.64 7.68 4.8 6.96 6.96 3.84 6.24 10.8] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103onedimensionalarray.ps b/books/ps/v103onedimensionalarray.ps new file mode 100644 index 0000000..daf2929 --- /dev/null +++ b/books/ps/v103onedimensionalarray.ps @@ -0,0 +1,248 @@ +%!PS-Adobe-2.0 +%%Creator: dot version 2.8 (Thu Sep 14 20:34:11 UTC 2006) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: 36 36 188 80 +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + dup scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw aligned label in bounding box aligned to current point +/alignedtext { % width adj text + /text exch def + /adj exch def + /width exch def + gsave + width 0 gt { + text stringwidth pop adj mul 0 rmoveto + } if + [] 0 setdash + text show + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +%%Page: 1 1 +%%PageBoundingBox: 36 36 188 80 +%%PageOrientation: Portrait +gsave +36 36 152 44 boxprim clip newpath +36 36 translate +0 0 1 beginpage +1.0000 set_scale +4 4 translate 0 rotate +0.167 0.600 1.000 graphcolor +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +150 42 lineto +150 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +150 42 lineto +150 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% OneDimensionalArray +[ /Rect [ 0 0 144 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=ARRAY1) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 144 36 moveto +0 36 lineto +0 0 lineto +144 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 144 36 moveto +0 36 lineto +0 0 lineto +144 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +8 13 moveto +(OneDimensionalArray) +[10.08 6.96 6.24 10.08 3.84 10.8 6.24 6.96 5.52 3.84 6.96 6.96 6.24 3.84 10.08 5.28 4.8 5.76 6.96] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103planealgebraiccurveplot.ps b/books/ps/v103planealgebraiccurveplot.ps new file mode 100644 index 0000000..416b84a --- /dev/null +++ b/books/ps/v103planealgebraiccurveplot.ps @@ -0,0 +1,248 @@ +%!PS-Adobe-2.0 +%%Creator: dot version 2.8 (Thu Sep 14 20:34:11 UTC 2006) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: 36 36 204 80 +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + dup scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw aligned label in bounding box aligned to current point +/alignedtext { % width adj text + /text exch def + /adj exch def + /width exch def + gsave + width 0 gt { + text stringwidth pop adj mul 0 rmoveto + } if + [] 0 setdash + text show + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +%%Page: 1 1 +%%PageBoundingBox: 36 36 204 80 +%%PageOrientation: Portrait +gsave +36 36 168 44 boxprim clip newpath +36 36 translate +0 0 1 beginpage +1.0000 set_scale +4 4 translate 0 rotate +0.167 0.600 1.000 graphcolor +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +166 42 lineto +166 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +166 42 lineto +166 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% PlaneAlgebraicCurvePlot +[ /Rect [ 0 0 160 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=ACPLOT) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 160 36 moveto +0 36 lineto +0 0 lineto +160 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 160 36 moveto +0 36 lineto +0 0 lineto +160 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +8 13 moveto +(PlaneAlgebraicCurvePlot) +[7.68 3.84 6.24 6.96 6.24 10.08 3.84 6.72 6.24 6.96 4.8 6.24 3.84 6.24 9.36 6.96 5.04 6.48 6.24 7.68 3.84 6.72 3.84] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103primitivearray.ps b/books/ps/v103primitivearray.ps new file mode 100644 index 0000000..340a7b5 --- /dev/null +++ b/books/ps/v103primitivearray.ps @@ -0,0 +1,248 @@ +%!PS-Adobe-2.0 +%%Creator: dot version 2.8 (Thu Sep 14 20:34:11 UTC 2006) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: 36 36 146 80 +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + dup scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw aligned label in bounding box aligned to current point +/alignedtext { % width adj text + /text exch def + /adj exch def + /width exch def + gsave + width 0 gt { + text stringwidth pop adj mul 0 rmoveto + } if + [] 0 setdash + text show + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +%%Page: 1 1 +%%PageBoundingBox: 36 36 146 80 +%%PageOrientation: Portrait +gsave +36 36 110 44 boxprim clip newpath +36 36 translate +0 0 1 beginpage +1.0000 set_scale +4 4 translate 0 rotate +0.167 0.600 1.000 graphcolor +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +108 42 lineto +108 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +108 42 lineto +108 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% PrimitiveArray +[ /Rect [ 0 0 102 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=PRIMARR) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 102 36 moveto +0 36 lineto +0 0 lineto +102 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 102 36 moveto +0 36 lineto +0 0 lineto +102 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +8 13 moveto +(PrimitiveArray) +[7.68 5.04 3.84 10.8 3.84 3.84 3.84 6.48 6.24 10.08 5.28 4.8 5.76 6.96] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103queryequation.ps b/books/ps/v103queryequation.ps new file mode 100644 index 0000000..1888f4f --- /dev/null +++ b/books/ps/v103queryequation.ps @@ -0,0 +1,248 @@ +%!PS-Adobe-2.0 +%%Creator: dot version 2.8 (Thu Sep 14 20:34:11 UTC 2006) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: 36 36 146 80 +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + dup scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw aligned label in bounding box aligned to current point +/alignedtext { % width adj text + /text exch def + /adj exch def + /width exch def + gsave + width 0 gt { + text stringwidth pop adj mul 0 rmoveto + } if + [] 0 setdash + text show + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +%%Page: 1 1 +%%PageBoundingBox: 36 36 146 80 +%%PageOrientation: Portrait +gsave +36 36 110 44 boxprim clip newpath +36 36 translate +0 0 1 beginpage +1.0000 set_scale +4 4 translate 0 rotate +0.167 0.600 1.000 graphcolor +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +108 42 lineto +108 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +108 42 lineto +108 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% QueryEquation +[ /Rect [ 0 0 102 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=QEQUAT) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 102 36 moveto +0 36 lineto +0 0 lineto +102 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 102 36 moveto +0 36 lineto +0 0 lineto +102 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +8 13 moveto +(QueryEquation) +[10.08 6.96 6.24 5.04 6.96 8.64 6.72 6.96 6.24 3.84 3.84 6.96 6.96] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103simplealgebraicextension.ps b/books/ps/v103simplealgebraicextension.ps new file mode 100644 index 0000000..56bdb98 --- /dev/null +++ b/books/ps/v103simplealgebraicextension.ps @@ -0,0 +1,248 @@ +%!PS-Adobe-2.0 +%%Creator: dot version 2.8 (Thu Sep 14 20:34:11 UTC 2006) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: 36 36 210 80 +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + dup scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw aligned label in bounding box aligned to current point +/alignedtext { % width adj text + /text exch def + /adj exch def + /width exch def + gsave + width 0 gt { + text stringwidth pop adj mul 0 rmoveto + } if + [] 0 setdash + text show + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +%%Page: 1 1 +%%PageBoundingBox: 36 36 210 80 +%%PageOrientation: Portrait +gsave +36 36 174 44 boxprim clip newpath +36 36 translate +0 0 1 beginpage +1.0000 set_scale +4 4 translate 0 rotate +0.167 0.600 1.000 graphcolor +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +172 42 lineto +172 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +172 42 lineto +172 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% SimpleAlgebraicExtension +[ /Rect [ 0 0 166 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=SAE) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 166 36 moveto +0 36 lineto +0 0 lineto +166 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 166 36 moveto +0 36 lineto +0 0 lineto +166 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +7 13 moveto +(SimpleAlgebraicExtension) +[7.68 3.84 10.56 6.96 3.84 6.24 10.08 3.84 6.72 6.24 6.96 4.8 6.24 3.84 6.24 8.64 6.96 3.84 6.24 6.96 5.52 3.84 6.96 6.96] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103tuple.ps b/books/ps/v103tuple.ps new file mode 100644 index 0000000..0a6baa5 --- /dev/null +++ b/books/ps/v103tuple.ps @@ -0,0 +1,248 @@ +%!PS-Adobe-2.0 +%%Creator: dot version 2.8 (Thu Sep 14 20:34:11 UTC 2006) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: 36 36 98 80 +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + dup scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw aligned label in bounding box aligned to current point +/alignedtext { % width adj text + /text exch def + /adj exch def + /width exch def + gsave + width 0 gt { + text stringwidth pop adj mul 0 rmoveto + } if + [] 0 setdash + text show + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +%%Page: 1 1 +%%PageBoundingBox: 36 36 98 80 +%%PageOrientation: Portrait +gsave +36 36 62 44 boxprim clip newpath +36 36 translate +0 0 1 beginpage +1.0000 set_scale +4 4 translate 0 rotate +0.167 0.600 1.000 graphcolor +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +60 42 lineto +60 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +60 42 lineto +60 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% Tuple +[ /Rect [ 0 0 54 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=TUPLE) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 54 36 moveto +0 36 lineto +0 0 lineto +54 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 54 36 moveto +0 36 lineto +0 0 lineto +54 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +11 13 moveto +(Tuple) +[7.44 6.96 6.96 3.84 6.24] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103twodimensionalarray.ps b/books/ps/v103twodimensionalarray.ps new file mode 100644 index 0000000..d9beddc --- /dev/null +++ b/books/ps/v103twodimensionalarray.ps @@ -0,0 +1,248 @@ +%!PS-Adobe-2.0 +%%Creator: dot version 2.8 (Thu Sep 14 20:34:11 UTC 2006) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: 36 36 188 80 +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + dup scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw aligned label in bounding box aligned to current point +/alignedtext { % width adj text + /text exch def + /adj exch def + /width exch def + gsave + width 0 gt { + text stringwidth pop adj mul 0 rmoveto + } if + [] 0 setdash + text show + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +%%Page: 1 1 +%%PageBoundingBox: 36 36 188 80 +%%PageOrientation: Portrait +gsave +36 36 152 44 boxprim clip newpath +36 36 translate +0 0 1 beginpage +1.0000 set_scale +4 4 translate 0 rotate +0.167 0.600 1.000 graphcolor +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +150 42 lineto +150 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +150 42 lineto +150 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% TwoDimensionalArray +[ /Rect [ 0 0 144 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=ARRAY2) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 144 36 moveto +0 36 lineto +0 0 lineto +144 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 144 36 moveto +0 36 lineto +0 0 lineto +144 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +7 13 moveto +(TwoDimensionalArray) +[7.2 9.6 6.96 10.08 3.84 10.8 6.24 6.96 5.52 3.84 6.96 6.96 6.24 3.84 10.08 5.28 4.8 5.76 6.96] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/changelog b/changelog index fc9e8ca..ab53b62 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,62 @@ +20081124 tpd src/axiom-website/patches.html +20081124 tpd books/bookvol10.3 add domains +20081124 tpd books/ps/v103twodimensionalarray.ps added +20081124 tpd books/ps/v103tuple.ps added +20081124 tpd books/ps/v103simplealgebraicextension.ps added +20081124 tpd books/ps/v103queryequation.ps added +20081124 tpd books/ps/v103primitivearray.ps added +20081124 tpd books/ps/v103planealgebraiccurveplot.ps added +20081124 tpd books/ps/v103onedimensionalarray.ps added +20081124 tpd books/ps/v103numericalpdeproblem.ps added +20081124 tpd books/ps/v103numericaloptimizationproblem.ps added +20081124 tpd books/ps/v103numericalodeproblem.ps added +20081124 tpd books/ps/v103numericalintegrationproblem.ps added +20081124 tpd books/ps/v103none.ps added +20081124 tpd books/ps/v103innerindexedtwodimensionalarray.ps added +20081124 tpd books/ps/v103indexedtwodimensionalarray.ps added +20081124 tpd books/ps/v103indexedonedimensionalarray.ps added +20081124 tpd books/ps/v103indexedflexiblearray.ps added +20081124 tpd books/ps/v103indexcard.ps added +20081124 tpd books/ps/v103flexiblearray.ps added +20081124 tpd books/ps/v103datalist.ps added +20081124 tpd books/ps/v103database.ps added +20081124 tpd books/ps/v103asp9.ps added +20081124 tpd books/ps/v103asp80.ps added +20081124 tpd books/ps/v103asp8.ps added +20081124 tpd books/ps/v103asp78.ps added +20081124 tpd books/ps/v103asp77.ps added +20081124 tpd books/ps/v103asp74.ps added +20081124 tpd books/ps/v103asp73.ps added +20081124 tpd books/ps/v103asp7.ps added +20081124 tpd books/ps/v103asp6.ps added +20081124 tpd books/ps/v103asp55.ps added +20081124 tpd books/ps/v103asp50.ps added +20081124 tpd books/ps/v103asp49.ps added +20081124 tpd books/ps/v103asp42.ps added +20081124 tpd books/ps/v103asp41.ps added +20081124 tpd books/ps/v103asp4.ps added +20081124 tpd books/ps/v103asp35.ps added +20081124 tpd books/ps/v103asp34.ps added +20081124 tpd books/ps/v103asp33.ps added +20081124 tpd books/ps/v103asp31.ps added +20081124 tpd books/ps/v103asp30.ps added +20081124 tpd books/ps/v103asp29.ps added +20081124 tpd books/ps/v103asp28.ps added +20081124 tpd books/ps/v103asp27.ps added +20081124 tpd books/ps/v103asp24.ps added +20081124 tpd books/ps/v103asp20.ps added +20081124 tpd books/ps/v103asp19.ps added +20081124 tpd books/ps/v103asp12.ps added +20081124 tpd books/ps/v103asp10.ps added +20081124 tpd books/ps/v103asp1.ps added +20081124 tpd books/ps/v103any.ps added +20081124 tpd src/algebra/Makefile remove asp.spad +20081124 tpd src/algebra/asp.spad removed, move domains to bookvol10.4 +20081124 tpd src/algebra/Makefile remove array2.spad, fix help files +20081124 tpd src/algebra/array2.spad removed, move domains to bookvol10.3 +20081124 tpd src/algebra/array1.spad move domains to bookvol10.3 +20081124 tpd src/algebra/any.spad move domains to bookvol10.3 +20081124 tpd src/axiom-website/patches.html 20081124.01.tpd.patch 20081124 tpd src/interp/setq.lisp remove date information for releases 20081124 tpd readme remove date information for releases 20081124 tpd faq document using new GCL diff --git a/src/algebra/Makefile.pamphlet b/src/algebra/Makefile.pamphlet index f398bc6..0824cc2 100644 --- a/src/algebra/Makefile.pamphlet +++ b/src/algebra/Makefile.pamphlet @@ -235,8 +235,6 @@ LAYER3=\ \subsubsection{Completed spad files} \begin{verbatim} -annacat.spad.pamphlet (NIPROB ODEPROB PDEPROB OPTPROB NUMINT ODECAT PDECAT - OPTCAT) color.spad.pamphlet (COLOR PALETTE) paramete.spad.pamphlet (PARPCURV PARPC2 PARSCURV PARSC2 PARSURF PARSU2 suchthat.spad.pamphlet (SUCH) @@ -516,7 +514,6 @@ LAYER13=\ \subsubsection{Completed spad files} \begin{verbatim} allfact.spad.pamphlet (MRATFAC MPRFF MPCPF GENMFACT RFFACTOR SUPFRACF) -array2.spad.pamphlet (ARR2CAT IIARRAY2 IARRAY2 ARRAY2) bezout.spad.pamphlet (BEZOUT) boolean.spad.pamphlet (REF LOGIC BOOLEAN IBITS BITS) brill.spad.pamphlet (BRILL) @@ -706,7 +703,6 @@ LAYER16=\ \subsection{Layer17} \subsubsection{Completed spad files} \begin{verbatim} -algext.spad.pamphlet (SAE) aggcat2.spad.pamphlet (FLAGG2 FSAGG2) galfact.spad.pamphlet (GALFACT) intfact.spad.pamphlet (PRIMES IROOT INTFACT) @@ -856,9 +852,6 @@ LAYER19=\ \begin{verbatim} algfact.spad.pamphlet (IALGFACT SAEFACT RFFACT SAERFFC ALGFACT) algfunc.spad.pamphlet (ACF ACFS AF) -asp.spad.pamphlet (ASP1 ASP10 ASP12 ASP19 ASP20 ASP24 ASP27 ASP28 ASP29 ASP30 - ASP31 ASP33 ASP34 ASP35 ASP4 ASP41 ASP42 ASP49 ASP50 ASP55 - ASP6 ASP7 ASP73 ASP74 ASP77 ASP78 ASP8 ASP80 ASP9) constant.spad.pamphlet (IAN AN) cmplxrt.spad.pamphlet (CMPLXRT) crfp.spad.pamphlet (CRFP) @@ -1015,7 +1008,6 @@ LAYER21=\ \subsection{Layer22} \subsubsection{Completed spad files} \begin{verbatim} -asp.spad.pamphlet (ASP29) combfunc.spad.pamphlet (COMBF) d01agents.spad.pamphlet (D01AGNT SNTSCAT) ffnb.spad.pamphlet (INBFF) @@ -1137,6 +1129,7 @@ DOC=${MNT}/${SYS}/doc/src/algebra OUTSRC=${MNT}/${SYS}/src/algebra INPUT=${INT}/input HELP=${MNT}/${SYS}/doc/spadhelp +BOOKS=${SPD}/books @ \subsection{The depsys variable} @@ -1165,10 +1158,9 @@ We need to figure out which mlift.spad to keep. SPADFILES= \ ${OUTSRC}/acplot.spad ${OUTSRC}/aggcat2.spad \ - ${OUTSRC}/algcat.spad ${OUTSRC}/algext.spad ${OUTSRC}/algfact.spad \ + ${OUTSRC}/algcat.spad ${OUTSRC}/algfact.spad \ ${OUTSRC}/algfunc.spad ${OUTSRC}/allfact.spad ${OUTSRC}/alql.spad \ - ${OUTSRC}/annacat.spad ${OUTSRC}/any.spad ${OUTSRC}/array1.spad \ - ${OUTSRC}/array2.spad ${OUTSRC}/asp.spad \ + ${OUTSRC}/any.spad ${OUTSRC}/array1.spad \ ${OUTSRC}/axserver.spad \ ${OUTSRC}/bags.spad ${OUTSRC}/bezout.spad ${OUTSRC}/boolean.spad \ ${OUTSRC}/brill.spad \ @@ -1324,10 +1316,9 @@ ALDORFILES= \ DOCFILES= \ ${DOC}/acplot.spad.dvi ${DOC}/aggcat2.spad.dvi \ - ${DOC}/algcat.spad.dvi ${DOC}/algext.spad.dvi ${DOC}/algfact.spad.dvi \ + ${DOC}/algcat.spad.dvi ${DOC}/algfact.spad.dvi \ ${DOC}/algfunc.spad.dvi ${DOC}/allfact.spad.dvi ${DOC}/alql.spad.dvi \ - ${DOC}/annacat.spad.dvi ${DOC}/any.spad.dvi ${DOC}/array1.spad.dvi \ - ${DOC}/array2.spad.dvi ${DOC}/asp.spad.dvi \ + ${DOC}/any.spad.dvi ${DOC}/array1.spad.dvi \ ${DOC}/axserver.spad.dvi ${DOC}/axtimer.as.dvi \ ${DOC}/bags.spad.dvi ${DOC}/bezout.spad.dvi ${DOC}/boolean.spad.dvi \ ${DOC}/brill.spad.dvi \ @@ -2390,12 +2381,12 @@ ${HELP}/FileName.help: ${IN}/fname.spad.pamphlet @${TANGLE} -R"FileName.input" ${IN}/fname.spad.pamphlet \ >${INPUT}/FileName.input -${HELP}/FlexibleArray.help: ${IN}/array1.spad.pamphlet - @echo 7023 create FlexibleArray.help from ${IN}/array1.spad.pamphlet - @${TANGLE} -R"FlexibleArray.help" ${IN}/array1.spad.pamphlet \ +${HELP}/FlexibleArray.help: ${BOOKS}/bookvol10.3.pamphlet + @echo 7023 create FlexibleArray.help from ${BOOKS}/bookvol10.3.pamphlet + @${TANGLE} -R"FlexibleArray.help" ${BOOKS}/bookvol10.3.pamphlet \ >${HELP}/FlexibleArray.help @cp ${HELP}/FlexibleArray.help ${HELP}/FARRAY.help - @${TANGLE} -R"FlexibleArray.input" ${IN}/array1.spad.pamphlet \ + @${TANGLE} -R"FlexibleArray.input" ${BOOKS}/bookvol10.3.pamphlet \ >${INPUT}/FlexibleArray.input ${HELP}/Float.help: ${IN}/float.spad.pamphlet @@ -2683,11 +2674,13 @@ ${HELP}/MultivariatePolynomial.help: ${IN}/multpoly.spad.pamphlet ${IN}/multpoly.spad.pamphlet \ >${INPUT}/MultivariatePolynomial.input -${HELP}/None.help: ${IN}/any.spad.pamphlet - @echo 7055 create None.help from ${IN}/any.spad.pamphlet - @${TANGLE} -R"None.help" ${IN}/any.spad.pamphlet >${HELP}/None.help +${HELP}/None.help: ${BOOKS}/bookvol10.3.pamphlet + @echo 7055 create None.help from ${BOOKS}/bookvol10.3.pamphlet + @${TANGLE} -R"None.help" ${BOOKS}/bookvol10.3.pamphlet \ + >${HELP}/None.help @-cp ${HELP}/None.help ${HELP}/NONE.help - @${TANGLE} -R"None.input" ${IN}/any.spad.pamphlet >${INPUT}/None.input + @${TANGLE} -R"None.input" ${BOOKS}/bookvol10.3.pamphlet \ + >${INPUT}/None.input ${HELP}/Octonion.help: ${IN}/oct.spad.pamphlet @echo 7056 create Octonion.help from ${IN}/oct.spad.pamphlet @@ -2697,13 +2690,14 @@ ${HELP}/Octonion.help: ${IN}/oct.spad.pamphlet @${TANGLE} -R"Octonion.input" ${IN}/oct.spad.pamphlet \ >${INPUT}/Octonion.input -${HELP}/OneDimensionalArray.help: ${IN}/array1.spad.pamphlet +${HELP}/OneDimensionalArray.help: ${BOOKS}/bookvol10.3.pamphlet @echo 7057 create OneDimensionalArray.help from \ - ${IN}/array1.spad.pamphlet - @${TANGLE} -R"OneDimensionalArray.help" ${IN}/array1.spad.pamphlet \ + ${BOOKS}/bookvol10.3.pamphlet + @${TANGLE} -R"OneDimensionalArray.help" ${BOOKS}/bookvol10.3.pamphlet \ >${HELP}/OneDimensionalArray.help @cp ${HELP}/OneDimensionalArray.help ${HELP}/ARRAY1.help - @${TANGLE} -R"OneDimensionalArray.input" ${IN}/array1.spad.pamphlet \ + @${TANGLE} -R"OneDimensionalArray.input" \ + ${BOOKS}/bookvol10.3.pamphlet \ >${INPUT}/OneDimensionalArray.input ${HELP}/Operator.help: ${IN}/opalg.spad.pamphlet @@ -2758,15 +2752,15 @@ ${HELP}/Permutation.help: ${IN}/perm.spad.pamphlet @${TANGLE} -R"Permutation.input" ${IN}/perm.spad.pamphlet \ >${INPUT}/Permutation.input -${HELP}/PlaneAlgebraicCurvePlot.help: ${IN}/acplot.spad.pamphlet +${HELP}/PlaneAlgebraicCurvePlot.help: ${BOOKS}/bookvol10.3.pamphlet @echo 7064 create PlaneAlgebraicCurvePlot.help from \ - ${IN}/acplot.spad.pamphlet + ${BOOKS}/bookvol10.3.pamphlet @${TANGLE} -R"PlaneAlgebraicCurvePlot.help" \ - ${IN}/acplot.spad.pamphlet \ + ${BOOKS}/bookvol10.3.pamphlet \ >${HELP}/PlaneAlgebraicCurvePlot.help @cp ${HELP}/PlaneAlgebraicCurvePlot.help ${HELP}/ACPLOT.help @${TANGLE} -R"PlaneAlgebraicCurvePlot.input" \ - ${IN}/acplot.spad.pamphlet \ + ${BOOKS}/bookvol10.3.pamphlet \ >${INPUT}/PlaneAlgebraicCurvePlot.input ${HELP}/Plot.help: ${IN}/plot.spad.pamphlet @@ -2931,13 +2925,14 @@ ${HELP}/TextFile.help: ${IN}/files.spad.pamphlet @${TANGLE} -R"TextFile.input" ${IN}/files.spad.pamphlet \ >${INPUT}/TextFile.input -${HELP}/TwoDimensionalArray.help: ${IN}/array2.spad.pamphlet +${HELP}/TwoDimensionalArray.help: ${BOOKS}/bookvol10.3.pamphlet @echo 7084 create TwoDimensionalArray.help from \ - ${IN}/array2.spad.pamphlet - @${TANGLE} -R"TwoDimensionalArray.help" ${IN}/array2.spad.pamphlet \ + ${BOOKS}/bookvol10.3.pamphlet + @${TANGLE} -R"TwoDimensionalArray.help" ${BOOKS}/bookvol10.3.pamphlet \ >${HELP}/TwoDimensionalArray.help @cp ${HELP}/TwoDimensionalArray.help ${HELP}/ARRAY2.help - @${TANGLE} -R"TwoDimensionalArray.input" ${IN}/array2.spad.pamphlet \ + @${TANGLE} -R"TwoDimensionalArray.input" \ + ${BOOKS}/bookvol10.3.pamphlet \ >${INPUT}/TwoDimensionalArray.input ${HELP}/TwoDimensionalViewport.help: ${IN}/view2d.spad.pamphlet diff --git a/src/algebra/acplot.spad.pamphlet b/src/algebra/acplot.spad.pamphlet index b76e71b..4dbec57 100644 --- a/src/algebra/acplot.spad.pamphlet +++ b/src/algebra/acplot.spad.pamphlet @@ -165,6 +165,8 @@ o $AXIOM/doc/src/algebra/acplot.spad.dvi @ \subsection{realsolv code} <>= +"REALSOLV" [color=orange,style=filled]; +"RealSolvePackage()" [color=orange,style=filled]; "REALSOLV" -> "PACKAGE" "RealSolvePackage()" -> "Package" @ @@ -219,1256 +221,6 @@ RealSolvePackage(): _ @ -\section{domain ACPLOT PlaneAlgebraicCurvePlot} -<>= --- acplot.spad.pamphlet PlaneAlgebraicCurvePlot.input -)spool PlaneAlgebraicCurvePlot.output -)set message test on -)set message auto off -)clear all ---S 1 of 1 -makeSketch(x+y,x,y,-1/2..1/2,-1/2..1/2)$ACPLOT ---R (1) ACPLOT ---R 1 1 1 1 ---R y + x = 0, - - <= x <= -, - - <= y <= - ---R 2 2 2 2 ---R [0.5,- 0.5] ---R [- 0.5,0.5] ---R Type: PlaneAlgebraicCurvePlot ---E 1 -)spool -)lisp (bye) -@ -<>= -==================================================================== -PlaneAlgebraicCurvePlot examples -==================================================================== - - makeSketch(x+y,x,y,-1/2..1/2,-1/2..1/2)$ACPLOT - -See Also: -o )show PlaneAlgebraicCurvePlot -o $AXIOM/doc/src/algebra/acplot.spad.dvi - -@ -<>= -"ACPLOT" -> "PPCURVE" -"PlaneAlgebraicCurvePlot()" -> "PlottablePlaneCurveCategory()" -@ -<>= ---% PlaneAlgebraicCurvePlot -++ Plot a NON-SINGULAR plane algebraic curve p(x,y) = 0. -++ Author: Clifton J. Williamson and Timothy Daly -++ Date Created: Fall 1988 -++ Date Last Updated: 27 April 1990 -++ Keywords: algebraic curve, non-singular, plot -++ Examples: -++ References: - -)abbrev domain ACPLOT PlaneAlgebraicCurvePlot - -PlaneAlgebraicCurvePlot(): PlottablePlaneCurveCategory _ - with - - makeSketch:(Polynomial Integer,Symbol,Symbol,Segment Fraction Integer,_ - Segment Fraction Integer) -> % - ++ makeSketch(p,x,y,a..b,c..d) creates an ACPLOT of the - ++ curve \spad{p = 0} in the region {\em a <= x <= b, c <= y <= d}. - ++ More specifically, 'makeSketch' plots a non-singular algebraic curve - ++ \spad{p = 0} in an rectangular region {\em xMin <= x <= xMax}, - ++ {\em yMin <= y <= yMax}. The user inputs - ++ \spad{makeSketch(p,x,y,xMin..xMax,yMin..yMax)}. - ++ Here p is a polynomial in the variables x and y with - ++ integer coefficients (p belongs to the domain - ++ \spad{Polynomial Integer}). The case - ++ where p is a polynomial in only one of the variables is - ++ allowed. The variables x and y are input to specify the - ++ the coordinate axes. The horizontal axis is the x-axis and - ++ the vertical axis is the y-axis. The rational numbers - ++ xMin,...,yMax specify the boundaries of the region in - ++ which the curve is to be plotted. - refine:(%,DoubleFloat) -> % - ++ refine(p,x) \undocumented{} - - == add - - import PointPackage DoubleFloat - import Plot - import RealSolvePackage - - BoundaryPts ==> Record(left: List Point DoubleFloat,_ - right: List Point DoubleFloat,_ - bottom: List Point DoubleFloat,_ - top: List Point DoubleFloat) - - NewPtInfo ==> Record(newPt: Point DoubleFloat,_ - type: String) - - Corners ==> Record(minXVal: DoubleFloat,_ - maxXVal: DoubleFloat,_ - minYVal: DoubleFloat,_ - maxYVal: DoubleFloat) - - kinte ==> solve$RealSolvePackage() - - rsolve ==> realSolve$RealSolvePackage() - - singValBetween?:(DoubleFloat,DoubleFloat,List DoubleFloat) -> Boolean - - segmentInfo:(DoubleFloat -> DoubleFloat,DoubleFloat,DoubleFloat,_ - List DoubleFloat,List DoubleFloat,List DoubleFloat,_ - DoubleFloat,DoubleFloat) -> _ - Record(seg:Segment DoubleFloat,_ - left: DoubleFloat,_ - lowerVals: List DoubleFloat,_ - upperVals:List DoubleFloat) - - swapCoords:Point DoubleFloat -> Point DoubleFloat - - samePlottedPt?:(Point DoubleFloat,Point DoubleFloat) -> Boolean - - findPtOnList:(Point DoubleFloat,List Point DoubleFloat) -> _ - Union(Point DoubleFloat,"failed") - - makeCorners:(DoubleFloat,DoubleFloat,DoubleFloat,DoubleFloat) -> Corners - - getXMin: Corners -> DoubleFloat - - getXMax: Corners -> DoubleFloat - - getYMin: Corners -> DoubleFloat - - getYMax: Corners -> DoubleFloat - - SFPolyToUPoly:Polynomial DoubleFloat -> _ - SparseUnivariatePolynomial DoubleFloat - - RNPolyToUPoly:Polynomial Fraction Integer -> _ - SparseUnivariatePolynomial Fraction Integer - - coerceCoefsToSFs:Polynomial Integer -> Polynomial DoubleFloat - - coerceCoefsToRNs:Polynomial Integer -> Polynomial Fraction Integer - - RNtoSF:Fraction Integer -> DoubleFloat - - RNtoNF:Fraction Integer -> Float - - SFtoNF:DoubleFloat -> Float - - listPtsOnHorizBdry:(Polynomial Fraction Integer,Symbol,Fraction Integer,_ - Float,Float) -> _ - List Point DoubleFloat - - listPtsOnVertBdry:(Polynomial Fraction Integer,Symbol,Fraction Integer,_ - Float,Float) -> _ - List Point DoubleFloat - - listPtsInRect:(List List Float,Float,Float,Float,Float) -> _ - List Point DoubleFloat - - ptsSuchThat?:(List List Float,List Float -> Boolean) -> Boolean - - inRect?:(List Float,Float,Float,Float,Float) -> Boolean - - onHorzSeg?:(List Float,Float,Float,Float) -> Boolean - - onVertSeg?:(List Float,Float,Float,Float) -> Boolean - - newX:(List List Float,List List Float,Float,Float,Float,Fraction Integer,_ - Fraction Integer) -> Fraction Integer - - newY:(List List Float,List List Float,Float,Float,Float,_ - Fraction Integer,Fraction Integer) -> Fraction Integer - - makeOneVarSketch:(Polynomial Integer,Symbol,Symbol,Fraction Integer,_ - Fraction Integer,Fraction Integer,Fraction Integer,_ - Symbol) -> % - - makeLineSketch:(Polynomial Integer,Symbol,Symbol,Fraction Integer,_ - Fraction Integer,Fraction Integer,Fraction Integer) -> % - - makeRatFcnSketch:(Polynomial Integer,Symbol,Symbol,Fraction Integer,_ - Fraction Integer,Fraction Integer,Fraction Integer,_ - Symbol) -> % - - makeGeneralSketch:(Polynomial Integer,Symbol,Symbol,Fraction Integer,_ - Fraction Integer,Fraction Integer,Fraction Integer) -> % - - traceBranches:(Polynomial DoubleFloat,Polynomial DoubleFloat,_ - Polynomial DoubleFloat,Symbol,Symbol,Corners,DoubleFloat,_ - DoubleFloat,PositiveInteger, List Point DoubleFloat,_ - BoundaryPts) -> List List Point DoubleFloat - - dummyFirstPt:(Point DoubleFloat,Polynomial DoubleFloat,_ - Polynomial DoubleFloat,Symbol,Symbol,List Point DoubleFloat,_ - List Point DoubleFloat,List Point DoubleFloat,_ - List Point DoubleFloat) -> Point DoubleFloat - - listPtsOnSegment:(Polynomial DoubleFloat,Polynomial DoubleFloat,_ - Polynomial DoubleFloat,Symbol,Symbol,Point DoubleFloat,_ - Point DoubleFloat,Corners, DoubleFloat,DoubleFloat,_ - PositiveInteger,List Point DoubleFloat,_ - List Point DoubleFloat) -> List List Point DoubleFloat - - listPtsOnLoop:(Polynomial DoubleFloat,Polynomial DoubleFloat,_ - Polynomial DoubleFloat,Symbol,Symbol,Point DoubleFloat,_ - Corners, DoubleFloat,DoubleFloat,PositiveInteger,_ - List Point DoubleFloat,List Point DoubleFloat) -> _ - List List Point DoubleFloat - - computeNextPt:(Polynomial DoubleFloat,Polynomial DoubleFloat,_ - Polynomial DoubleFloat,Symbol,Symbol,Point DoubleFloat,_ - Point DoubleFloat,Corners, DoubleFloat,DoubleFloat,_ - PositiveInteger,List Point DoubleFloat,_ - List Point DoubleFloat) -> NewPtInfo - - newtonApprox:(SparseUnivariatePolynomial DoubleFloat, DoubleFloat, _ - DoubleFloat, PositiveInteger) -> Union(DoubleFloat, "failed") - ---% representation - - Rep := Record(poly : Polynomial Integer,_ - xVar : Symbol,_ - yVar : Symbol,_ - minXVal : Fraction Integer,_ - maxXVal : Fraction Integer,_ - minYVal : Fraction Integer,_ - maxYVal : Fraction Integer,_ - bdryPts : BoundaryPts,_ - hTanPts : List Point DoubleFloat,_ - vTanPts : List Point DoubleFloat,_ - branches: List List Point DoubleFloat) - ---% global constants - - EPSILON : Float := .000001 -- precision to which realSolve finds roots - PLOTERR : DoubleFloat := float(1,-3,10) - -- maximum allowable difference in each coordinate when - -- determining if 2 plotted points are equal - ---% global flags - - NADA : String := "nothing in particular" - BDRY : String := "boundary point" - CRIT : String := "critical point" - BOTTOM : String := "bottom" - TOP : String := "top" - ---% hacks - - NFtoSF: Float -> DoubleFloat - NFtoSF x == 0 + convert(x)$Float - ---% points - makePt: (DoubleFloat,DoubleFloat) -> Point DoubleFloat - makePt(xx,yy) == point(l : List DoubleFloat := [xx,yy]) - - swapCoords(pt) == makePt(yCoord pt,xCoord pt) - - samePlottedPt?(p0,p1) == - -- determines if p1 lies in a square with side 2 PLOTERR - -- centered at p0 - x0 := xCoord p0; y0 := yCoord p0 - x1 := xCoord p1; y1 := yCoord p1 - (abs(x1-x0) < PLOTERR) and (abs(y1-y0) < PLOTERR) - - findPtOnList(pt,pointList) == - for point in pointList repeat - samePlottedPt?(pt,point) => return point - "failed" - ---% corners - - makeCorners(xMinSF,xMaxSF,yMinSF,yMaxSF) == - [xMinSF,xMaxSF,yMinSF,yMaxSF] - - getXMin(corners) == corners.minXVal - getXMax(corners) == corners.maxXVal - getYMin(corners) == corners.minYVal - getYMax(corners) == corners.maxYVal - ---% coercions - - SFPolyToUPoly(p) == - -- 'p' is of type Polynomial, but has only one variable - zero? p => 0 - monomial(leadingCoefficient p,totalDegree p) + - SFPolyToUPoly(reductum p) - - RNPolyToUPoly(p) == - -- 'p' is of type Polynomial, but has only one variable - zero? p => 0 - monomial(leadingCoefficient p,totalDegree p) + - RNPolyToUPoly(reductum p) - - coerceCoefsToSFs(p) == - -- coefficients of 'p' are coerced to be DoubleFloat's - map(coerce,p)$PolynomialFunctions2(Integer,DoubleFloat) - - coerceCoefsToRNs(p) == - -- coefficients of 'p' are coerced to be DoubleFloat's - map(coerce,p)$PolynomialFunctions2(Integer,Fraction Integer) - - RNtoSF(r) == coerce(r)@DoubleFloat - RNtoNF(r) == coerce(r)@Float - SFtoNF(x) == convert(x)@Float - ---% computation of special points - - listPtsOnHorizBdry(pRN,y,y0,xMinNF,xMaxNF) == - -- strict inequality here: corners on vertical boundary - pointList : List Point DoubleFloat := nil() - ySF := RNtoSF(y0) - f := eval(pRN,y,y0) - roots : List Float := kinte(f,EPSILON) - for root in roots repeat - if (xMinNF < root) and (root < xMaxNF) then - pointList := cons(makePt(NFtoSF root, ySF), pointList) - pointList - - listPtsOnVertBdry(pRN,x,x0,yMinNF,yMaxNF) == - pointList : List Point DoubleFloat := nil() - xSF := RNtoSF(x0) - f := eval(pRN,x,x0) - roots : List Float := kinte(f,EPSILON) - for root in roots repeat - if (yMinNF <= root) and (root <= yMaxNF) then - pointList := cons(makePt(xSF, NFtoSF root), pointList) - pointList - - listPtsInRect(points,xMin,xMax,yMin,yMax) == - pointList : List Point DoubleFloat := nil() - for point in points repeat - xx := first point; yy := second point - if (xMin<=xx) and (xx<=xMax) and (yMin<=yy) and (yy<=yMax) then - pointList := cons(makePt(NFtoSF xx,NFtoSF yy),pointList) - pointList - - ptsSuchThat?(points,pred) == - for point in points repeat - if pred point then return true - false - - inRect?(point,xMinNF,xMaxNF,yMinNF,yMaxNF) == - xx := first point; yy := second point - xMinNF <= xx and xx <= xMaxNF and yMinNF <= yy and yy <= yMaxNF - - onHorzSeg?(point,xMinNF,xMaxNF,yNF) == - xx := first point; yy := second point - yy = yNF and xMinNF <= xx and xx <= xMaxNF - - onVertSeg?(point,yMinNF,yMaxNF,xNF) == - xx := first point; yy := second point - xx = xNF and yMinNF <= yy and yy <= yMaxNF - - newX(vtanPts,singPts,yMinNF,yMaxNF,xNF,xRN,horizInc) == - xNewNF := xNF + RNtoNF horizInc - xRtNF := max(xNF,xNewNF); xLftNF := min(xNF,xNewNF) --- ptsSuchThat?(singPts,inRect?(#1,xLftNF,xRtNF,yMinNF,yMaxNF)) => - foo : List Float -> Boolean := inRect?(#1,xLftNF,xRtNF,yMinNF,yMaxNF) - ptsSuchThat?(singPts,foo) => - newX(vtanPts,singPts,yMinNF,yMaxNF,xNF,xRN,_ - horizInc/2::(Fraction Integer)) --- ptsSuchThat?(vtanPts,onVertSeg?(#1,yMinNF,yMaxNF,xNewNF)) => - goo : List Float -> Boolean := onVertSeg?(#1,yMinNF,yMaxNF,xNewNF) - ptsSuchThat?(vtanPts,goo) => - newX(vtanPts,singPts,yMinNF,yMaxNF,xNF,xRN,_ - horizInc/2::(Fraction Integer)) - xRN + horizInc - - newY(htanPts,singPts,xMinNF,xMaxNF,yNF,yRN,vertInc) == - yNewNF := yNF + RNtoNF vertInc - yTopNF := max(yNF,yNewNF); yBotNF := min(yNF,yNewNF) --- ptsSuchThat?(singPts,inRect?(#1,xMinNF,xMaxNF,yBotNF,yTopNF)) => - foo : List Float -> Boolean := inRect?(#1,xMinNF,xMaxNF,yBotNF,yTopNF) - ptsSuchThat?(singPts,foo) => - newY(htanPts,singPts,xMinNF,xMaxNF,yNF,yRN,_ - vertInc/2::(Fraction Integer)) --- ptsSuchThat?(htanPts,onHorzSeg?(#1,xMinNF,xMaxNF,yNewNF)) => - goo : List Float -> Boolean := onHorzSeg?(#1,xMinNF,xMaxNF,yNewNF) - ptsSuchThat?(htanPts,goo) => - newY(htanPts,singPts,xMinNF,xMaxNF,yNF,yRN,_ - vertInc/2::(Fraction Integer)) - yRN + vertInc - ---% creation of sketches - - makeSketch(p,x,y,xRange,yRange) == - xMin := lo xRange; xMax := hi xRange - yMin := lo yRange; yMax := hi yRange - -- test input for consistency - xMax <= xMin => - error "makeSketch: bad range for first variable" - yMax <= yMin => - error "makeSketch: bad range for second variable" - varList := variables p - # varList > 2 => - error "makeSketch: polynomial in more than 2 variables" - # varList = 0 => - error "makeSketch: constant polynomial" - -- polynomial in 1 variable - # varList = 1 => - (not member?(x,varList)) and (not member?(y,varList)) => - error "makeSketch: bad variables" - makeOneVarSketch(p,x,y,xMin,xMax,yMin,yMax,first varList) - -- polynomial in 2 variables - (not member?(x,varList)) or (not member?(y,varList)) => - error "makeSketch: bad variables" - totalDegree p = 1 => - makeLineSketch(p,x,y,xMin,xMax,yMin,yMax) - -- polynomial is linear in one variable - -- y is a rational function of x - degree(p,y) = 1 => - makeRatFcnSketch(p,x,y,xMin,xMax,yMin,yMax,y) - -- x is a rational function of y - degree(p,x) = 1 => - makeRatFcnSketch(p,x,y,xMin,xMax,yMin,yMax,x) - -- the general case - makeGeneralSketch(p,x,y,xMin,xMax,yMin,yMax) - ---% special cases - - makeOneVarSketch(p,x,y,xMin,xMax,yMin,yMax,var) == - -- the case where 'p' is a polynomial in only one variable - -- the graph consists of horizontal or vertical lines - if var = x then - minVal := RNtoNF xMin - maxVal := RNtoNF xMax - else - minVal := RNtoNF yMin - maxVal := RNtoNF yMax - lf : List Point DoubleFloat := nil() - rt : List Point DoubleFloat := nil() - bt : List Point DoubleFloat := nil() - tp : List Point DoubleFloat := nil() - htans : List Point DoubleFloat := nil() - vtans : List Point DoubleFloat := nil() - bran : List List Point DoubleFloat := nil() - roots := kinte(p,EPSILON) - sketchRoots : List DoubleFloat := nil() - for root in roots repeat - if (minVal <= root) and (root <= maxVal) then - sketchRoots := cons(NFtoSF root,sketchRoots) - null sketchRoots => - [p,x,y,xMin,xMax,yMin,yMax,[lf,rt,bt,tp],htans,vtans,bran] - if var = x then - yMinSF := RNtoSF yMin; yMaxSF := RNtoSF yMax - for rootSF in sketchRoots repeat - tp := cons(pt1 := makePt(rootSF,yMaxSF),tp) - bt := cons(pt2 := makePt(rootSF,yMinSF),bt) - branch : List Point DoubleFloat := [pt1,pt2] - bran := cons(branch,bran) - else - xMinSF := RNtoSF xMin; xMaxSF := RNtoSF xMax - for rootSF in sketchRoots repeat - rt := cons(pt1 := makePt(xMaxSF,rootSF),rt) - lf := cons(pt2 := makePt(xMinSF,rootSF),lf) - branch : List Point DoubleFloat := [pt1,pt2] - bran := cons(branch,bran) - [p,x,y,xMin,xMax,yMin,yMax,[lf,rt,bt,tp],htans,vtans,bran] - - makeLineSketch(p,x,y,xMin,xMax,yMin,yMax) == - -- the case where p(x,y) = a x + b y + c with a ^= 0, b ^= 0 - -- this is a line which is neither vertical nor horizontal - xMinSF := RNtoSF xMin; xMaxSF := RNtoSF xMax - yMinSF := RNtoSF yMin; yMaxSF := RNtoSF yMax - -- determine the coefficients a, b, and c - a := ground(coefficient(p,x,1)) :: DoubleFloat - b := ground(coefficient(p,y,1)) :: DoubleFloat - c := ground(coefficient(coefficient(p,x,0),y,0)) :: DoubleFloat - lf : List Point DoubleFloat := nil() - rt : List Point DoubleFloat := nil() - bt : List Point DoubleFloat := nil() - tp : List Point DoubleFloat := nil() - htans : List Point DoubleFloat := nil() - vtans : List Point DoubleFloat := nil() - branch : List Point DoubleFloat := nil() - bran : List List Point DoubleFloat := nil() - -- compute x coordinate of point on line with y = yMin - xBottom := (- b*yMinSF - c)/a - -- compute x coordinate of point on line with y = yMax - xTop := (- b*yMaxSF - c)/a - -- compute y coordinate of point on line with x = xMin - yLeft := (- a*xMinSF - c)/b - -- compute y coordinate of point on line with x = xMax - yRight := (- a*xMaxSF - c)/b - -- determine which of the above 4 points are in the region - -- to be plotted and list them as a branch - if (xMinSF < xBottom) and (xBottom < xMaxSF) then - bt := cons(pt := makePt(xBottom,yMinSF),bt) - branch := cons(pt,branch) - if (xMinSF < xTop) and (xTop < xMaxSF) then - tp := cons(pt := makePt(xTop,yMaxSF),tp) - branch := cons(pt,branch) - if (yMinSF <= yLeft) and (yLeft <= yMaxSF) then - lf := cons(pt := makePt(xMinSF,yLeft),lf) - branch := cons(pt,branch) - if (yMinSF <= yRight) and (yRight <= yMaxSF) then - rt := cons(pt := makePt(xMaxSF,yRight),rt) - branch := cons(pt,branch) - bran := cons(branch,bran) - [p,x,y,xMin,xMax,yMin,yMax,[lf,rt,bt,tp],htans,vtans,bran] - - singValBetween?(xCurrent,xNext,xSingList) == - for xVal in xSingList repeat - (xCurrent < xVal) and (xVal < xNext) => return true - false - - segmentInfo(f,lo,hi,botList,topList,singList,minSF,maxSF) == - repeat - -- 'current' is the smallest element of 'topList' and 'botList' - -- 'currentFrom' records the list from which it was taken - if null topList then - if null botList then - return [segment(lo,hi),hi,nil(),nil()] - else - current := first botList - botList := rest botList - currentFrom := BOTTOM - else - if null botList then - current := first topList - topList := rest topList - currentFrom := TOP - else - bot := first botList - top := first topList - if bot < top then - current := bot - botList := rest botList - currentFrom := BOTTOM - else - current := top - topList := rest topList - currentFrom := TOP - -- 'nxt' is the next smallest element of 'topList' - -- and 'botList' - -- 'nextFrom' records the list from which it was taken - if null topList then - if null botList then - return [segment(lo,hi),hi,nil(),nil()] - else - nxt := first botList - botList := rest botList - nextFrom := BOTTOM - else - if null botList then - nxt := first topList - topList := rest topList - nextFrom := TOP - else - bot := first botList - top := first topList - if bot < top then - nxt := bot - botList := rest botList - nextFrom := BOTTOM - else - nxt := top - topList := rest topList - nextFrom := TOP - if currentFrom = nextFrom then - if singValBetween?(current,nxt,singList) then - return [segment(lo,current),nxt,botList,topList] - else - val := f((nxt - current)/2::DoubleFloat) - if (val <= minSF) or (val >= maxSF) then - return [segment(lo,current),nxt,botList,topList] - else - if singValBetween?(current,nxt,singList) then - return [segment(lo,current),nxt,botList,topList] - - makeRatFcnSketch(p,x,y,xMin,xMax,yMin,yMax,depVar) == - -- the case where p(x,y) is linear in x or y - -- Thus, one variable is a rational function of the other. - -- Therefore, we may use the 2-dimensional function plotting - -- package. The only problem is determining the intervals on - -- on which the function is to be plotted. - --!! corners: e.g. upper left corner is on graph with y' > 0 - factoredP := p ::(Factored Polynomial Integer) - numberOfFactors(factoredP) > 1 => - error "reducible polynomial" --!! sketch each factor - dpdx := differentiate(p,x) - dpdy := differentiate(p,y) - pRN := coerceCoefsToRNs p - xMinSF := RNtoSF xMin; xMaxSF := RNtoSF xMax - yMinSF := RNtoSF yMin; yMaxSF := RNtoSF yMax - xMinNF := RNtoNF xMin; xMaxNF := RNtoNF xMax - yMinNF := RNtoNF yMin; yMaxNF := RNtoNF yMax - -- 'p' is of degree 1 in the variable 'depVar'. - -- Thus, 'depVar' is a rational function of the other variable. - num := -coefficient(p,depVar,0) - den := coefficient(p,depVar,1) - numUPolySF := SFPolyToUPoly(coerceCoefsToSFs(num)) - denUPolySF := SFPolyToUPoly(coerceCoefsToSFs(den)) - -- this is the rational function - f : DoubleFloat -> DoubleFloat := elt(numUPolySF,#1)/elt(denUPolySF,#1) - -- values of the dependent and independent variables - if depVar = x then - indVarMin := yMin; indVarMax := yMax - indVarMinNF := yMinNF; indVarMaxNF := yMaxNF - indVarMinSF := yMinSF; indVarMaxSF := yMaxSF - depVarMin := xMin; depVarMax := xMax - depVarMinSF := xMinSF; depVarMaxSF := xMaxSF - else - indVarMin := xMin; indVarMax := xMax - indVarMinNF := xMinNF; indVarMaxNF := xMaxNF - indVarMinSF := xMinSF; indVarMaxSF := xMaxSF - depVarMin := yMin; depVarMax := yMax - depVarMinSF := yMinSF; depVarMaxSF := yMaxSF - -- Create lists of critical points. - htanPts := rsolve([p,dpdx],[x,y],EPSILON) - vtanPts := rsolve([p,dpdy],[x,y],EPSILON) - htans := listPtsInRect(htanPts,xMinNF,xMaxNF,yMinNF,yMaxNF) - vtans := listPtsInRect(vtanPts,xMinNF,xMaxNF,yMinNF,yMaxNF) - -- Create lists which will contain boundary points. - lf : List Point DoubleFloat := nil() - rt : List Point DoubleFloat := nil() - bt : List Point DoubleFloat := nil() - tp : List Point DoubleFloat := nil() - -- Determine values of the independent variable at the which - -- the rational function has a pole as well as the values of - -- the independent variable for which there is a point on the - -- upper or lower boundary. - singList : List DoubleFloat := - roots : List Float := kinte(den,EPSILON) - outList : List DoubleFloat := nil() - for root in roots repeat - if (indVarMinNF < root) and (root < indVarMaxNF) then - outList := cons(NFtoSF root,outList) - sort(#1 < #2,outList) - topList : List DoubleFloat := - roots : List Float := kinte(eval(pRN,depVar,depVarMax),EPSILON) - outList : List DoubleFloat := nil() - for root in roots repeat - if (indVarMinNF < root) and (root < indVarMaxNF) then - outList := cons(NFtoSF root,outList) - sort(#1 < #2,outList) - botList : List DoubleFloat := - roots : List Float := kinte(eval(pRN,depVar,depVarMin),EPSILON) - outList : List DoubleFloat := nil() - for root in roots repeat - if (indVarMinNF < root) and (root < indVarMaxNF) then - outList := cons(NFtoSF root,outList) - sort(#1 < #2,outList) - -- We wish to determine if the graph has points on the 'left' - -- and 'right' boundaries, so we compute the value of the - -- rational function at the lefthand and righthand values of - -- the dependent variable. If the function has a singularity - -- on the left or right boundary, then 'leftVal' or 'rightVal' - -- is given a dummy valuewhich will convince the program that - -- there is no point on the left or right boundary. - denUPolyRN := RNPolyToUPoly(coerceCoefsToRNs(den)) - if elt(denUPolyRN,indVarMin) = 0$(Fraction Integer) then - leftVal := depVarMinSF - (abs(depVarMinSF) + 1$DoubleFloat) - else - leftVal := f(indVarMinSF) - if elt(denUPolyRN,indVarMax) = 0$(Fraction Integer) then - rightVal := depVarMinSF - (abs(depVarMinSF) + 1$DoubleFloat) - else - rightVal := f(indVarMaxSF) - -- Now put boundary points on the appropriate lists. - if depVar = x then - if (xMinSF < leftVal) and (leftVal < xMaxSF) then - bt := cons(makePt(leftVal,yMinSF),bt) - if (xMinSF < rightVal) and (rightVal < xMaxSF) then - tp := cons(makePt(rightVal,yMaxSF),tp) - for val in botList repeat - lf := cons(makePt(xMinSF,val),lf) - for val in topList repeat - rt := cons(makePt(xMaxSF,val),rt) - else - if (yMinSF < leftVal) and (leftVal < yMaxSF) then - lf := cons(makePt(xMinSF,leftVal),lf) - if (yMinSF < rightVal) and (rightVal < yMaxSF) then - rt := cons(makePt(xMaxSF,rightVal),rt) - for val in botList repeat - bt := cons(makePt(val,yMinSF),bt) - for val in topList repeat - tp := cons(makePt(val,yMaxSF),tp) - bran : List List Point DoubleFloat := nil() - -- Determine segments on which the rational function is to - -- be plotted. - if (depVarMinSF < leftVal) and (leftVal < depVarMaxSF) then - lo := indVarMinSF - else - if null topList then - if null botList then - return [p,x,y,xMin,xMax,yMin,yMax,[lf,rt,bt,tp],_ - htans,vtans,bran] - else - lo := first botList - botList := rest botList - else - if null botList then - lo := first topList - topList := rest topList - else - bot := first botList - top := first topList - if bot < top then - lo := bot - botList := rest botList - else - lo := top - topList := rest topList - hi := 0$DoubleFloat -- @#$%^&* compiler - if (depVarMinSF < rightVal) and (rightVal < depVarMaxSF) then - hi := indVarMaxSF - else - if null topList then - if null botList then - error "makeRatFcnSketch: plot domain" - else - hi := last botList - botList := remove(hi,botList) - else - if null botList then - hi := last topList - topList := remove(hi,topList) - else - bot := last botList - top := last topList - if bot > top then - hi := bot - botList := remove(hi,botList) - else - hi := top - topList := remove(hi,topList) - if (depVar = x) then - (minSF := xMinSF; maxSF := xMaxSF) - else - (minSF := yMinSF; maxSF := yMaxSF) - segList : List Segment DoubleFloat := nil() - repeat - segInfo := segmentInfo(f,lo,hi,botList,topList,singList,_ - minSF,maxSF) - segList := cons(segInfo.seg,segList) - lo := segInfo.left - botList := segInfo.lowerVals - topList := segInfo.upperVals - if lo = hi then break - for segment in segList repeat - RFPlot : Plot := plot(f,segment) - curve := first(listBranches(RFPlot)) - if depVar = y then - bran := cons(curve,bran) - else - bran := cons(map(swapCoords,curve),bran) - [p,x,y,xMin,xMax,yMin,yMax,[lf,rt,bt,tp],htans,vtans,bran] - ---% the general case - - makeGeneralSketch(pol,x,y,xMin,xMax,yMin,yMax) == - --!! corners of region should not be on curve - --!! enlarge region if necessary - factoredPol := pol :: (Factored Polynomial Integer) - numberOfFactors(factoredPol) > 1 => - error "reducible polynomial" --!! sketch each factor - p := nthFactor(factoredPol,1) - dpdx := differentiate(p,x); dpdy := differentiate(p,y) - xMinNF := RNtoNF xMin; xMaxNF := RNtoNF xMax - yMinNF := RNtoNF yMin; yMaxNF := RNtoNF yMax - -- compute singular points; error if singularities in region - singPts := rsolve([p,dpdx,dpdy],[x,y],EPSILON) --- ptsSuchThat?(singPts,inRect?(#1,xMinNF,xMaxNF,yMinNF,yMaxNF)) => - foo : List Float -> Boolean := inRect?(#1,xMinNF,xMaxNF,yMinNF,yMaxNF) - ptsSuchThat?(singPts,foo) => - error "singular pts in region of sketch" - -- compute critical points - htanPts := rsolve([p,dpdx],[x,y],EPSILON) - vtanPts := rsolve([p,dpdy],[x,y],EPSILON) - critPts := append(htanPts,vtanPts) - -- if there are critical points on the boundary, then enlarge - -- the region, but be sure that the new region does not contain - -- any singular points - hInc : Fraction Integer := (1/20) * (xMax - xMin) - vInc : Fraction Integer := (1/20) * (yMax - yMin) --- if ptsSuchThat?(critPts,onVertSeg?(#1,yMinNF,yMaxNF,xMinNF)) then - foo : List Float -> Boolean := onVertSeg?(#1,yMinNF,yMaxNF,xMinNF) - if ptsSuchThat?(critPts,foo) then - xMin := newX(critPts,singPts,yMinNF,yMaxNF,xMinNF,xMin,-hInc) - xMinNF := RNtoNF xMin --- if ptsSuchThat?(critPts,onVertSeg?(#1,yMinNF,yMaxNF,xMaxNF)) then - foo : List Float -> Boolean := onVertSeg?(#1,yMinNF,yMaxNF,xMaxNF) - if ptsSuchThat?(critPts,foo) then - xMax := newX(critPts,singPts,yMinNF,yMaxNF,xMaxNF,xMax,hInc) - xMaxNF := RNtoNF xMax --- if ptsSuchThat?(critPts,onHorzSeg?(#1,xMinNF,xMaxNF,yMinNF)) then - foo : List Float -> Boolean := onHorzSeg?(#1,xMinNF,xMaxNF,yMinNF) - if ptsSuchThat?(critPts,foo) then - yMin := newY(critPts,singPts,xMinNF,xMaxNF,yMinNF,yMin,-vInc) - yMinNF := RNtoNF yMin --- if ptsSuchThat?(critPts,onHorzSeg?(#1,xMinNF,xMaxNF,yMaxNF)) then - foo : List Float -> Boolean := onHorzSeg?(#1,xMinNF,xMaxNF,yMaxNF) - if ptsSuchThat?(critPts,foo) then - yMax := newY(critPts,singPts,xMinNF,xMaxNF,yMaxNF,yMax,vInc) - yMaxNF := RNtoNF yMax - htans := listPtsInRect(htanPts,xMinNF,xMaxNF,yMinNF,yMaxNF) - vtans := listPtsInRect(vtanPts,xMinNF,xMaxNF,yMinNF,yMaxNF) - crits := append(htans,vtans) - -- conversions to DoubleFloats - xMinSF := RNtoSF xMin; xMaxSF := RNtoSF xMax - yMinSF := RNtoSF yMin; yMaxSF := RNtoSF yMax - corners := makeCorners(xMinSF,xMaxSF,yMinSF,yMaxSF) - pSF := coerceCoefsToSFs p - dpdxSF := coerceCoefsToSFs dpdx - dpdySF := coerceCoefsToSFs dpdy - delta := min((xMaxSF - xMinSF)/25,(yMaxSF - yMinSF)/25) - err := min(delta/100,PLOTERR/100) - bound : PositiveInteger := 10 - -- compute points on the boundary - pRN := coerceCoefsToRNs(p) - lf : List Point DoubleFloat := - listPtsOnVertBdry(pRN,x,xMin,yMinNF,yMaxNF) - rt : List Point DoubleFloat := - listPtsOnVertBdry(pRN,x,xMax,yMinNF,yMaxNF) - bt : List Point DoubleFloat := - listPtsOnHorizBdry(pRN,y,yMin,xMinNF,xMaxNF) - tp : List Point DoubleFloat := - listPtsOnHorizBdry(pRN,y,yMax,xMinNF,xMaxNF) - bdPts : BoundaryPts := [lf,rt,bt,tp] - bran := traceBranches(pSF,dpdxSF,dpdySF,x,y,corners,delta,err,_ - bound,crits,bdPts) - [p,x,y,xMin,xMax,yMin,yMax,bdPts,htans,vtans,bran] - - refine(plot,stepFraction) == - p := plot.poly; x := plot.xVar; y := plot.yVar - dpdx := differentiate(p,x); dpdy := differentiate(p,y) - pSF := coerceCoefsToSFs p - dpdxSF := coerceCoefsToSFs dpdx - dpdySF := coerceCoefsToSFs dpdy - xMin := plot.minXVal; xMax := plot.maxXVal - yMin := plot.minYVal; yMax := plot.maxYVal - xMinSF := RNtoSF xMin; xMaxSF := RNtoSF xMax - yMinSF := RNtoSF yMin; yMaxSF := RNtoSF yMax - corners := makeCorners(xMinSF,xMaxSF,yMinSF,yMaxSF) - pSF := coerceCoefsToSFs p - dpdxSF := coerceCoefsToSFs dpdx - dpdySF := coerceCoefsToSFs dpdy - delta := - stepFraction * min((xMaxSF - xMinSF)/25,(yMaxSF - yMinSF)/25) - err := min(delta/100,PLOTERR/100) - bound : PositiveInteger := 10 - crits := append(plot.hTanPts,plot.vTanPts) - bdPts := plot.bdryPts - bran := traceBranches(pSF,dpdxSF,dpdySF,x,y,corners,delta,err,_ - bound,crits,bdPts) - htans := plot.hTanPts; vtans := plot.vTanPts - [p,x,y,xMin,xMax,yMin,yMax,bdPts,htans,vtans,bran] - - traceBranches(pSF,dpdxSF,dpdySF,x,y,corners,delta,err,bound,_ - crits,bdPts) == - -- for boundary points, trace curve from boundary to boundary - -- add the branch to the list of branches - -- update list of boundary points by deleting first and last - -- points on this branch - -- update list of critical points by deleting any critical - -- points which were plotted - lf := bdPts.left; rt := bdPts.right - tp := bdPts.top ; bt := bdPts.bottom - bdry := append(append(lf,rt),append(bt,tp)) - bran : List List Point DoubleFloat := nil() - while not null bdry repeat - pt := first bdry - p0 := dummyFirstPt(pt,dpdxSF,dpdySF,x,y,lf,rt,bt,tp) - segInfo := listPtsOnSegment(pSF,dpdxSF,dpdySF,x,y,p0,pt,_ - corners,delta,err,bound,crits,bdry) - bran := cons(first segInfo,bran) - crits := second segInfo - bdry := third segInfo - -- trace loops beginning and ending with critical points - -- add the branch to the list of branches - -- update list of critical points by deleting any critical - -- points which were plotted - while not null crits repeat - pt := first crits - segInfo := listPtsOnLoop(pSF,dpdxSF,dpdySF,x,y,pt,_ - corners,delta,err,bound,crits,bdry) - bran := cons(first segInfo,bran) - crits := second segInfo - bran - - dummyFirstPt(p1,dpdxSF,dpdySF,x,y,lf,rt,bt,tp) == - -- The function 'computeNextPt' requires 2 points, p0 and p1. - -- When computing the second point on a branch which starts - -- on the boundary, we use the boundary point as p1 and the - -- 'dummy' point returned by this function as p0. - x1 := xCoord p1; y1 := yCoord p1 - zero := 0$DoubleFloat; one := 1$DoubleFloat - px := ground(eval(dpdxSF,[x,y],[x1,y1])) - py := ground(eval(dpdySF,[x,y],[x1,y1])) - if px * py < zero then -- positive slope at p1 - member?(p1,lf) or member?(p1,bt) => - makePt(x1 - one,y1 - one) - makePt(x1 + one,y1 + one) - else - member?(p1,lf) or member?(p1,tp) => - makePt(x1 - one,y1 + one) - makePt(x1 + one,y1 - one) - - - listPtsOnSegment(pSF,dpdxSF,dpdySF,x,y,p0,p1,corners,_ - delta,err,bound,crits,bdry) == - -- p1 is a boundary point; p0 is a 'dummy' point - bdry := remove(p1,bdry) - pointList : List Point DoubleFloat := [p1] - ptInfo := computeNextPt(pSF,dpdxSF,dpdySF,x,y,p0,p1,corners,_ - delta,err,bound,crits,bdry) - p2 := ptInfo.newPt - ptInfo.type = BDRY => - bdry := remove(p2,bdry) - pointList := cons(p2,pointList) - [pointList,crits,bdry] - if ptInfo.type = CRIT then crits := remove(p2,crits) - pointList := cons(p2,pointList) - repeat - pt0 := second pointList; pt1 := first pointList - ptInfo := computeNextPt(pSF,dpdxSF,dpdySF,x,y,pt0,pt1,corners,_ - delta,err,bound,crits,bdry) - p2 := ptInfo.newPt - ptInfo.type = BDRY => - bdry := remove(p2,bdry) - pointList := cons(p2,pointList) - return [pointList,crits,bdry] - if ptInfo.type = CRIT then crits := remove(p2,crits) - pointList := cons(p2,pointList) - --!! delete next line (compiler bug) - [pointList,crits,bdry] - - - listPtsOnLoop(pSF,dpdxSF,dpdySF,x,y,p1,corners,_ - delta,err,bound,crits,bdry) == - x1 := xCoord p1; y1 := yCoord p1 - px := ground(eval(dpdxSF,[x,y],[x1,y1])) - py := ground(eval(dpdySF,[x,y],[x1,y1])) - p0 := makePt(x1 - 1$DoubleFloat,y1 - 1$DoubleFloat) - pointList : List Point DoubleFloat := [p1] - ptInfo := computeNextPt(pSF,dpdxSF,dpdySF,x,y,p0,p1,corners,_ - delta,err,bound,crits,bdry) - p2 := ptInfo.newPt - ptInfo.type = BDRY => - error "boundary reached while on loop" - if ptInfo.type = CRIT then - p1 = p2 => - error "first and second points on loop are identical" - crits := remove(p2,crits) - pointList := cons(p2,pointList) - repeat - pt0 := second pointList; pt1 := first pointList - ptInfo := computeNextPt(pSF,dpdxSF,dpdySF,x,y,pt0,pt1,corners,_ - delta,err,bound,crits,bdry) - p2 := ptInfo.newPt - ptInfo.type = BDRY => - error "boundary reached while on loop" - if ptInfo.type = CRIT then - crits := remove(p2,crits) - p1 = p2 => - pointList := cons(p2,pointList) - return [pointList,crits,bdry] - pointList := cons(p2,pointList) - --!! delete next line (compiler bug) - [pointList,crits,bdry] - - computeNextPt(pSF,dpdxSF,dpdySF,x,y,p0,p1,corners,_ - delta,err,bound,crits,bdry) == - -- p0=(x0,y0) and p1=(x1,y1) are the last two points on the curve. - -- The function computes the next point on the curve. - -- The function determines if the next point is a critical point - -- or a boundary point. - -- The function returns a record of the form - -- Record(newPt:Point DoubleFloat,type:String). - -- If the new point is a boundary point, then 'type' is - -- "boundary point" and 'newPt' is a boundary point to be - -- deleted from the list of boundary points yet to be plotted. - -- Similarly, if the new point is a critical point, then 'type' is - -- "critical point" and 'newPt' is a critical point to be - -- deleted from the list of critical points yet to be plotted. - -- If the new point is neither a critical point nor a boundary - -- point, then 'type' is "nothing in particular". - xMinSF := getXMin corners; xMaxSF := getXMax corners - yMinSF := getYMin corners; yMaxSF := getYMax corners - x0 := xCoord p0; y0 := yCoord p0 - x1 := xCoord p1; y1 := yCoord p1 - px := ground(eval(dpdxSF,[x,y],[x1,y1])) - py := ground(eval(dpdySF,[x,y],[x1,y1])) - -- let m be the slope of the tangent line at p1 - -- if |m| < 1, we will increment the x-coordinate by delta - -- (indicated by 'incVar = x'), find an approximate - -- y-coordinate using the tangent line, then find the actual - -- y-coordinate using a Newton iteration - if abs(py) > abs(px) then - incVar0 := incVar := x - deltaX := (if x1 > x0 then delta else -delta) - x2Approx := x1 + deltaX - y2Approx := y1 + (-px/py)*deltaX - -- if |m| >= 1, we interchange the roles of the x- and y- - -- coordinates - else - incVar0 := incVar := y - deltaY := (if y1 > y0 then delta else -delta) - x2Approx := x1 + (-py/px)*deltaY - y2Approx := y1 + deltaY - lookingFor := NADA - -- See if (x2Approx,y2Approx) is out of bounds. - -- If so, find where the line segment connecting (x1,y1) and - -- (x2Approx,y2Approx) intersects the boundary and use this - -- point as (x2Approx,y2Approx). - -- If the resulting point is on the left or right boundary, - -- we will now consider x as the 'incremented variable' and we - -- will compute the y-coordinate using a Newton iteration. - -- Similarly, if the point is on the top or bottom boundary, - -- we will consider y as the 'incremented variable' and we - -- will compute the x-coordinate using a Newton iteration. - if x2Approx >= xMaxSF then - incVar := x - lookingFor := BDRY - x2Approx := xMaxSF - y2Approx := y1 + (-px/py)*(x2Approx - x1) - else - if x2Approx <= xMinSF then - incVar := x - lookingFor := BDRY - x2Approx := xMinSF - y2Approx := y1 + (-px/py)*(x2Approx - x1) - if y2Approx >= yMaxSF then - incVar := y - lookingFor := BDRY - y2Approx := yMaxSF - x2Approx := x1 + (-py/px)*(y2Approx - y1) - else - if y2Approx <= yMinSF then - incVar := y - lookingFor := BDRY - y2Approx := yMinSF - x2Approx := x1 + (-py/px)*(y2Approx - y1) - -- set xLo = min(x1,x2Approx), xHi = max(x1,x2Approx) - -- set yLo = min(y1,y2Approx), yHi = max(y1,y2Approx) - if x1 < x2Approx then - xLo := x1 - xHi := x2Approx - else - xLo := x2Approx - xHi := x1 - if y1 < y2Approx then - yLo := y1 - yHi := y2Approx - else - yLo := y2Approx - yHi := y1 - -- check for critical points (x*,y*) with x* between - -- x1 and x2Approx or y* between y1 and y2Approx - -- store values of x2Approx and y2Approx - x2Approxx := x2Approx - y2Approxx := y2Approx - -- xPointList will contain all critical points (x*,y*) - -- with x* between x1 and x2Approx - xPointList : List Point DoubleFloat := nil() - -- yPointList will contain all critical points (x*,y*) - -- with y* between y1 and y2Approx - yPointList : List Point DoubleFloat := nil() - for pt in crits repeat - xx := xCoord pt; yy := yCoord pt - -- if x1 = x2Approx, then p1 is a point with horizontal - -- tangent line - -- in this case, we don't want critical points with - -- x-coordinate x1 - if xx = x2Approx and not (xx = x1) then - if min(abs(yy-yLo),abs(yy-yHi)) < delta then - xPointList := cons(pt,xPointList) - if ((xLo < xx) and (xx < xHi)) then - if min(abs(yy-yLo),abs(yy-yHi)) < delta then - xPointList := cons(pt,nil()) - x2Approx := xx - if xx < x1 then xLo := xx else xHi := xx - -- if y1 = y2Approx, then p1 is a point with vertical - -- tangent line - -- in this case, we don't want critical points with - -- y-coordinate y1 - if yy = y2Approx and not (yy = y1) then - yPointList := cons(pt,yPointList) - if ((yLo < yy) and (yy < yHi)) then - if min(abs(xx-xLo),abs(xx-xHi)) < delta then - yPointList := cons(pt,nil()) - y2Approx := yy - if yy < y1 then yLo := yy else yHi := yy - -- points in both xPointList and yPointList - if (not null xPointList) and (not null yPointList) then - xPointList = yPointList => - -- this implies that the lists have only one point - incVar := incVar0 - if incVar = x then - y2Approx := y1 + (-px/py)*(x2Approx - x1) - else - x2Approx := x1 + (-py/px)*(y2Approx - y1) - lookingFor := CRIT -- proceed - incVar0 = x => - -- first try Newton iteration with 'y' as incremented variable - x2Temp := x1 + (-py/px)*(y2Approx - y1) - f := SFPolyToUPoly(eval(pSF,y,y2Approx)) - x2New := newtonApprox(f,x2Temp,err,bound) - x2New case "failed" => - y2Approx := y1 + (-px/py)*(x2Approx - x1) - incVar := x - lookingFor := CRIT -- proceed - y2Temp := y1 + (-px/py)*(x2Approx - x1) - f := SFPolyToUPoly(eval(pSF,x,x2Approx)) - y2New := newtonApprox(f,y2Temp,err,bound) - y2New case "failed" => - return computeNextPt(pSF,dpdxSF,dpdySF,x,y,p0,p1,corners,_ - abs((x2Approx-x1)/2),err,bound,crits,bdry) - pt1 := makePt(x2Approx,y2New :: DoubleFloat) - pt2 := makePt(x2New :: DoubleFloat,y2Approx) - critPt1 := findPtOnList(pt1,crits) - critPt2 := findPtOnList(pt2,crits) - (critPt1 case "failed") and (critPt2 case "failed") => - abs(x2Approx - x1) > abs(x2Temp - x1) => - return [pt1,NADA] - return [pt2,NADA] - (critPt1 case "failed") => - return [critPt2::(Point DoubleFloat),CRIT] - (critPt2 case "failed") => - return [critPt1::(Point DoubleFloat),CRIT] - abs(x2Approx - x1) > abs(x2Temp - x1) => - return [critPt2::(Point DoubleFloat),CRIT] - return [critPt1::(Point DoubleFloat),CRIT] - y2Temp := y1 + (-px/py)*(x2Approx - x1) - f := SFPolyToUPoly(eval(pSF,x,x2Approx)) - y2New := newtonApprox(f,y2Temp,err,bound) - y2New case "failed" => - x2Approx := x1 + (-py/px)*(y2Approx - y1) - incVar := y - lookingFor := CRIT -- proceed - x2Temp := x1 + (-py/px)*(y2Approx - y1) - f := SFPolyToUPoly(eval(pSF,y,y2Approx)) - x2New := newtonApprox(f,x2Temp,err,bound) - x2New case "failed" => - return computeNextPt(pSF,dpdxSF,dpdySF,x,y,p0,p1,corners,_ - abs((y2Approx-y1)/2),err,bound,crits,bdry) - pt1 := makePt(x2Approx,y2New :: DoubleFloat) - pt2 := makePt(x2New :: DoubleFloat,y2Approx) - critPt1 := findPtOnList(pt1,crits) - critPt2 := findPtOnList(pt2,crits) - (critPt1 case "failed") and (critPt2 case "failed") => - abs(y2Approx - y1) > abs(y2Temp - y1) => - return [pt2,NADA] - return [pt1,NADA] - (critPt1 case "failed") => - return [critPt2::(Point DoubleFloat),CRIT] - (critPt2 case "failed") => - return [critPt1::(Point DoubleFloat),CRIT] - abs(y2Approx - y1) > abs(y2Temp - y1) => - return [critPt1::(Point DoubleFloat),CRIT] - return [critPt2::(Point DoubleFloat),CRIT] - if (not null xPointList) and (null yPointList) then - y2Approx := y1 + (-px/py)*(x2Approx - x1) - incVar0 = x => - incVar := x - lookingFor := CRIT -- proceed - f := SFPolyToUPoly(eval(pSF,x,x2Approx)) - y2New := newtonApprox(f,y2Approx,err,bound) - y2New case "failed" => - x2Approx := x2Approxx - y2Approx := y2Approxx -- proceed - pt := makePt(x2Approx,y2New::DoubleFloat) - critPt := findPtOnList(pt,crits) - critPt case "failed" => - return [pt,NADA] - return [critPt :: (Point DoubleFloat),CRIT] - if (null xPointList) and (not null yPointList) then - x2Approx := x1 + (-py/px)*(y2Approx - y1) - incVar0 = y => - incVar := y - lookingFor := CRIT -- proceed - f := SFPolyToUPoly(eval(pSF,y,y2Approx)) - x2New := newtonApprox(f,x2Approx,err,bound) - x2New case "failed" => - x2Approx := x2Approxx - y2Approx := y2Approxx -- proceed - pt := makePt(x2New::DoubleFloat,y2Approx) - critPt := findPtOnList(pt,crits) - critPt case "failed" => - return [pt,NADA] - return [critPt :: (Point DoubleFloat),CRIT] - if incVar = x then - x2 := x2Approx - f := SFPolyToUPoly(eval(pSF,x,x2)) - y2New := newtonApprox(f,y2Approx,err,bound) - y2New case "failed" => - return computeNextPt(pSF,dpdxSF,dpdySF,x,y,p0,p1,corners,_ - abs((x2-x1)/2),err,bound,crits,bdry) - y2 := y2New :: DoubleFloat - else - y2 := y2Approx - f := SFPolyToUPoly(eval(pSF,y,y2)) - x2New := newtonApprox(f,x2Approx,err,bound) - x2New case "failed" => - return computeNextPt(pSF,dpdxSF,dpdySF,x,y,p0,p1,corners,_ - abs((y2-y1)/2),err,bound,crits,bdry) - x2 := x2New :: DoubleFloat - pt := makePt(x2,y2) - --!! check that 'pt' is not out of bounds - -- check if you've gotten a critical or boundary point - lookingFor = NADA => - [pt,lookingFor] - lookingFor = BDRY => - bdryPt := findPtOnList(pt,bdry) - bdryPt case "failed" => - error "couldn't find boundary point" - [bdryPt :: (Point DoubleFloat),BDRY] - critPt := findPtOnList(pt,crits) - critPt case "failed" => - [pt,NADA] - [critPt :: (Point DoubleFloat),CRIT] - ---% Newton iterations - - newtonApprox(f,a0,err,bound) == - -- Newton iteration to approximate a root of the polynomial 'f' - -- using an initial approximation of 'a0' - -- Newton iteration terminates when consecutive approximations - -- are within 'err' of each other - -- returns "failed" if this has not been achieved after 'bound' - -- iterations - Df := differentiate f - oldApprox := a0 - newApprox := a0 - elt(f,a0)/elt(Df,a0) - i : PositiveInteger := 1 - while abs(newApprox - oldApprox) > err repeat - i = bound => return "failed" - oldApprox := newApprox - newApprox := oldApprox - elt(f,oldApprox)/elt(Df,oldApprox) - i := i+1 - newApprox - ---% graphics output - - listBranches(acplot) == acplot.branches - ---% terminal output - - coerce(acplot:%) == - pp := acplot.poly :: OutputForm - xx := acplot.xVar :: OutputForm - yy := acplot.yVar :: OutputForm - xLo := acplot.minXVal :: OutputForm - xHi := acplot.maxXVal :: OutputForm - yLo := acplot.minYVal :: OutputForm - yHi := acplot.maxYVal :: OutputForm - zip := message(" = 0") - com := message(", ") - les := message(" <= ") - l : List OutputForm := - [pp,zip,com,xLo,les,xx,les,xHi,com,yLo,les,yy,les,yHi] - f : List OutputForm := nil() - for branch in acplot.branches repeat - ll : List OutputForm := [p :: OutputForm for p in branch] - f := cons(vconcat ll,f) - ff := vconcat(hconcat l,vconcat f) - vconcat(message "ACPLOT",ff) - -@ \section{License} <>= --Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. @@ -1506,7 +258,6 @@ PlaneAlgebraicCurvePlot(): PlottablePlaneCurveCategory _ <> <> -<> @ \eject diff --git a/src/algebra/algext.spad.pamphlet b/src/algebra/algext.spad.pamphlet deleted file mode 100644 index 3fd1300..0000000 --- a/src/algebra/algext.spad.pamphlet +++ /dev/null @@ -1,240 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra algext.spad} -\author{Barry Trager, Manuel Bronstein, Clifton Williamson} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{domain SAE SimpleAlgebraicExtension} -<>= -"SAE" -> "MONOGEN" -"SimpleAlgebraicExtension(a:CommutativeRing,b:UnivariatePolynomialCategory(a))" - -> "MonogenicAlgebra(a:CommutativeRing,b:UnivariatePolynomialCategory(a))" -@ -<>= -)abbrev domain SAE SimpleAlgebraicExtension -++ Algebraic extension of a ring by a single polynomial -++ Author: Barry Trager, Manuel Bronstein, Clifton Williamson -++ Date Created: 1986 -++ Date Last Updated: 9 May 1994 -++ Description: -++ Domain which represents simple algebraic extensions of arbitrary -++ rings. The first argument to the domain, R, is the underlying ring, -++ the second argument is a domain of univariate polynomials over K, -++ while the last argument specifies the defining minimal polynomial. -++ The elements of the domain are canonically represented as polynomials -++ of degree less than that of the minimal polynomial with coefficients -++ in R. The second argument is both the type of the third argument and -++ the underlying representation used by \spadtype{SAE} itself. -++ Keywords: ring, algebraic, extension -++ Example: )r SAE INPUT - -SimpleAlgebraicExtension(R:CommutativeRing, - UP:UnivariatePolynomialCategory R, M:UP): MonogenicAlgebra(R, UP) == add - --sqFr(pb): FactorS(Poly) from UnivPolySquareFree(Poly) - - --degree(M) > 0 and M must be monic if R is not a field. - if (r := recip leadingCoefficient M) case "failed" then - error "Modulus cannot be made monic" - Rep := UP - x,y :$ - c: R - - mkDisc : Boolean -> Void - mkDiscMat: Boolean -> Void - - M := r::R * M - d := degree M - d1 := subtractIfCan(d,1)::NonNegativeInteger - discmat:Matrix(R) := zero(d, d) - nodiscmat?:Reference(Boolean) := ref true - disc:Reference(R) := ref 0 - nodisc?:Reference(Boolean) := ref true - bsis := [monomial(1, i)$Rep for i in 0..d1]$Vector(Rep) - - if R has Finite then - size == size$R ** d - random == represents([random()$R for i in 0..d1]) - 0 == 0$Rep - 1 == 1$Rep - c * x == c *$Rep x - n:Integer * x == n *$Rep x - coerce(n:Integer):$ == coerce(n)$Rep - coerce(c) == monomial(c,0)$Rep - coerce(x):OutputForm == coerce(x)$Rep - lift(x) == x pretend Rep - reduce(p:UP):$ == (monicDivide(p,M)$Rep).remainder - x = y == x =$Rep y - x + y == x +$Rep y - - x == -$Rep x - x * y == reduce((x *$Rep y) pretend UP) - coordinates(x) == [coefficient(lift(x),i) for i in 0..d1] - represents(vect) == +/[monomial(vect.(i+1),i) for i in 0..d1] - definingPolynomial() == M - characteristic() == characteristic()$R - rank() == d::PositiveInteger - basis() == copy(bsis@Vector(Rep) pretend Vector($)) - --!! I inserted 'copy' in the definition of 'basis' -- cjw 7/19/91 - - if R has Field then - minimalPolynomial x == squareFreePart characteristicPolynomial x - - if R has Field then - coordinates(x:$,bas: Vector $) == - (m := inverse transpose coordinates bas) case "failed" => - error "coordinates: second argument must be a basis" - (m :: Matrix R) * coordinates(x) - - else if R has IntegralDomain then - coordinates(x:$,bas: Vector $) == - -- we work over the quotient field of R to invert a matrix - qf := Fraction R - imatqf := InnerMatrixQuotientFieldFunctions(R,Vector R,Vector R,_ - Matrix R,qf,Vector qf,Vector qf,Matrix qf) - mat := transpose coordinates bas - (m := inverse(mat)$imatqf) case "failed" => - error "coordinates: second argument must be a basis" - coordsQF := map(#1 :: qf,coordinates x)$VectorFunctions2(R,qf) - -- here are the coordinates as elements of the quotient field: - vecQF := (m :: Matrix qf) * coordsQF - vec : Vector R := new(d,0) - for i in 1..d repeat - xi := qelt(vecQF,i) - denom(xi) = 1 => qsetelt_!(vec,i,numer xi) - error "coordinates: coordinates are not integral over ground ring" - vec - - reducedSystem(m:Matrix $):Matrix(R) == - reducedSystem(map(lift, m)$MatrixCategoryFunctions2($, Vector $, - Vector $, Matrix $, UP, Vector UP, Vector UP, Matrix UP)) - - reducedSystem(m:Matrix $, v:Vector $):Record(mat:Matrix R,vec:Vector R) == - reducedSystem(map(lift, m)$MatrixCategoryFunctions2($, Vector $, - Vector $, Matrix $, UP, Vector UP, Vector UP, Matrix UP), - map(lift, v)$VectorFunctions2($, UP)) - - discriminant() == - if nodisc?() then mkDisc false - disc() - - mkDisc b == - nodisc?() := b - disc() := discriminant M - void - - traceMatrix() == - if nodiscmat?() then mkDiscMat false - discmat - - mkDiscMat b == - nodiscmat?() := b - mr := minRowIndex discmat; mc := minColIndex discmat - for i in 0..d1 repeat - for j in 0..d1 repeat - qsetelt_!(discmat,mr + i,mc + j,trace reduce monomial(1,i + j)) - void - - trace x == --this could be coded perhaps more efficiently - xn := x; ans := coefficient(lift xn, 0) - for n in 1..d1 repeat - (xn := generator() * xn; ans := coefficient(lift xn, n) + ans) - ans - - if R has Finite then - index k == - i:Integer := k rem size() - p:Integer := size()$R - ans:$ := 0 - for j in 0.. while i > 0 repeat - h := i rem p - -- index(p) = 0$R - if h ^= 0 then - -- here was a bug: "index" instead of - -- "coerce", otherwise it wouldn't work for - -- Rings R where "coerce: I-> R" is not surjective - a := index(h :: PositiveInteger)$R - ans := ans + reduce monomial(a, j) - i := i quo p - ans - lookup(z : $) : PositiveInteger == - -- z = index lookup z, n = lookup index n - -- the answer is merely the Horner evaluation of the - -- representation with the size of R (as integers). - zero?(z) => size()$$ pretend PositiveInteger - p : Integer := size()$R - co : Integer := lookup(leadingCoefficient z)$R - n : NonNegativeInteger := degree(z) - while not zero?(z := reductum z) repeat - co := co * p ** ((n - (n := degree z)) pretend - NonNegativeInteger) + lookup(leadingCoefficient z)$R - n = 0 => co pretend PositiveInteger - (co * p ** n) pretend PositiveInteger - --- --- KA:=BasicPolynomialFunctions(Poly) --- minPoly(x) == --- ffe:= SqFr(resultant(M::KA, KA.var - lift(x)::KA)).fs.first --- ffe.flag = "SQFR" => ffe.f --- mdeg:= (degree(ffe.f) // K.characteristic)::Integer --- mat:= Zero()::Matrix(K) --- xi:=L.1; setelt(mat,1,1,K.1); setelt(mat,1,(deg+1),K.1) --- for i in 1..mdeg repeat --- xi:= x * xi; xp:= lift(xi) --- while xp ^= KA.0 repeat --- setelt(mat,(mdeg+1),(degree(xp)+1),LeadingCoef(xp)) --- xp:=reductum(xp) --- setelt(mat,(mdeg+1),(deg+i+1),K.1) --- EchelonLastRow(mat) --- if and/(elt(mat,(i+1),j) = K.0 for j in 1..deg) --- then return unitNormal(+/(elt(mat,(i+1),(deg+j+1))*(B::KA)**j --- for j in 0..i)).a --- ffe.f - -@ -\section{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. -@ -<<*>>= -<> - -<> -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/algebra/annacat.spad.pamphlet b/src/algebra/annacat.spad.pamphlet deleted file mode 100644 index cbd258f..0000000 --- a/src/algebra/annacat.spad.pamphlet +++ /dev/null @@ -1,295 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra annacat.spad} -\author{Brian Dupee} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{domain NIPROB NumericalIntegrationProblem} -<>= -)abbrev domain NIPROB NumericalIntegrationProblem -++ Author: Brian Dupee -++ Date Created: December 1997 -++ Date Last Updated: December 1997 -++ Basic Operations: coerce, retract -++ Related Constructors: Union -++ Description: -++ \axiomType{NumericalIntegrationProblem} is a \axiom{domain} -++ for the representation of Numerical Integration problems for use -++ by ANNA. -++ -++ The representation is a Union of two record types - one for integration of -++ a function of one variable: -++ -++ \axiomType{Record}(var:\axiomType{Symbol}, -++ fn:\axiomType{Expression DoubleFloat}, -++ range:\axiomType{Segment OrderedCompletion DoubleFloat}, -++ abserr:\axiomType{DoubleFloat}, -++ relerr:\axiomType{DoubleFloat},) -++ -++ and one for multivariate integration: -++ -++ \axiomType{Record}(fn:\axiomType{Expression DoubleFloat}, -++ range:\axiomType{List Segment OrderedCompletion DoubleFloat}, -++ abserr:\axiomType{DoubleFloat}, -++ relerr:\axiomType{DoubleFloat},). -++ - -EDFA ==> Expression DoubleFloat -SOCDFA ==> Segment OrderedCompletion DoubleFloat -DFA ==> DoubleFloat -NIAA ==> Record(var:Symbol,fn:EDFA,range:SOCDFA,abserr:DFA,relerr:DFA) -MDNIAA ==> Record(fn:EDFA,range:List SOCDFA,abserr:DFA,relerr:DFA) - -NumericalIntegrationProblem():SetCategory with - coerce: NIAA -> % - ++ coerce(x) \undocumented{} - coerce: MDNIAA -> % - ++ coerce(x) \undocumented{} - coerce: Union(nia:NIAA,mdnia:MDNIAA) -> % - ++ coerce(x) \undocumented{} - coerce: % -> OutputForm - ++ coerce(x) \undocumented{} - retract: % -> Union(nia:NIAA,mdnia:MDNIAA) - ++ retract(x) \undocumented{} - - == - - add - Rep := Union(nia:NIAA,mdnia:MDNIAA) - - coerce(s:NIAA) == [s] - coerce(s:MDNIAA) == [s] - coerce(s:Union(nia:NIAA,mdnia:MDNIAA)) == s - coerce(x:%):OutputForm == - (x) case nia => (x.nia)::OutputForm - (x.mdnia)::OutputForm - retract(x:%):Union(nia:NIAA,mdnia:MDNIAA) == - (x) case nia => [x.nia] - [x.mdnia] - -@ -\section{domain ODEPROB NumericalODEProblem} -<>= -)abbrev domain ODEPROB NumericalODEProblem -++ Author: Brian Dupee -++ Date Created: December 1997 -++ Date Last Updated: December 1997 -++ Basic Operations: coerce, retract -++ Related Constructors: Union -++ Description: -++ \axiomType{NumericalODEProblem} is a \axiom{domain} -++ for the representation of Numerical ODE problems for use -++ by ANNA. -++ -++ The representation is of type: -++ -++ \axiomType{Record}(xinit:\axiomType{DoubleFloat}, -++ xend:\axiomType{DoubleFloat}, -++ fn:\axiomType{Vector Expression DoubleFloat}, -++ yinit:\axiomType{List DoubleFloat},intvals:\axiomType{List DoubleFloat}, -++ g:\axiomType{Expression DoubleFloat},abserr:\axiomType{DoubleFloat}, -++ relerr:\axiomType{DoubleFloat}) -++ - -DFB ==> DoubleFloat -VEDFB ==> Vector Expression DoubleFloat -LDFB ==> List DoubleFloat -EDFB ==> Expression DoubleFloat -ODEAB ==> Record(xinit:DFB,xend:DFB,fn:VEDFB,yinit:LDFB,intvals:LDFB,g:EDFB,abserr:DFB,relerr:DFB) -NumericalODEProblem():SetCategory with - - coerce: ODEAB -> % - ++ coerce(x) \undocumented{} - coerce: % -> OutputForm - ++ coerce(x) \undocumented{} - retract: % -> ODEAB - ++ retract(x) \undocumented{} - - == - - add - Rep := ODEAB - - coerce(s:ODEAB) == s - coerce(x:%):OutputForm == - (retract(x))::OutputForm - retract(x:%):ODEAB == x :: Rep - -@ -\section{domain PDEPROB NumericalPDEProblem} -<>= -)abbrev domain PDEPROB NumericalPDEProblem -++ Author: Brian Dupee -++ Date Created: December 1997 -++ Date Last Updated: December 1997 -++ Basic Operations: coerce, retract -++ Related Constructors: Union -++ Description: -++ \axiomType{NumericalPDEProblem} is a \axiom{domain} -++ for the representation of Numerical PDE problems for use -++ by ANNA. -++ -++ The representation is of type: -++ -++ \axiomType{Record}(pde:\axiomType{List Expression DoubleFloat}, -++ constraints:\axiomType{List PDEC}, -++ f:\axiomType{List List Expression DoubleFloat}, -++ st:\axiomType{String}, -++ tol:\axiomType{DoubleFloat}) -++ -++ where \axiomType{PDEC} is of type: -++ -++ \axiomType{Record}(start:\axiomType{DoubleFloat}, -++ finish:\axiomType{DoubleFloat}, -++ grid:\axiomType{NonNegativeInteger}, -++ boundaryType:\axiomType{Integer}, -++ dStart:\axiomType{Matrix DoubleFloat}, -++ dFinish:\axiomType{Matrix DoubleFloat}) -++ - -DFC ==> DoubleFloat -NNIC ==> NonNegativeInteger -INTC ==> Integer -MDFC ==> Matrix DoubleFloat -PDECC ==> Record(start:DFC, finish:DFC, grid:NNIC, boundaryType:INTC, - dStart:MDFC, dFinish:MDFC) -LEDFC ==> List Expression DoubleFloat -PDEBC ==> Record(pde:LEDFC, constraints:List PDECC, f:List LEDFC, - st:String, tol:DFC) -NumericalPDEProblem():SetCategory with - - coerce: PDEBC -> % - ++ coerce(x) \undocumented{} - coerce: % -> OutputForm - ++ coerce(x) \undocumented{} - retract: % -> PDEBC - ++ retract(x) \undocumented{} - - == - - add - Rep := PDEBC - - coerce(s:PDEBC) == s - coerce(x:%):OutputForm == - (retract(x))::OutputForm - retract(x:%):PDEBC == x :: Rep - -@ -\section{domain OPTPROB NumericalOptimizationProblem} -<>= -)abbrev domain OPTPROB NumericalOptimizationProblem -++ Author: Brian Dupee -++ Date Created: December 1997 -++ Date Last Updated: December 1997 -++ Basic Operations: coerce, retract -++ Related Constructors: Union -++ Description: -++ \axiomType{NumericalOptimizationProblem} is a \axiom{domain} -++ for the representation of Numerical Optimization problems for use -++ by ANNA. -++ -++ The representation is a Union of two record types - one for otimization of -++ a single function of one or more variables: -++ -++ \axiomType{Record}( -++ fn:\axiomType{Expression DoubleFloat}, -++ init:\axiomType{List DoubleFloat}, -++ lb:\axiomType{List OrderedCompletion DoubleFloat}, -++ cf:\axiomType{List Expression DoubleFloat}, -++ ub:\axiomType{List OrderedCompletion DoubleFloat}) -++ -++ and one for least-squares problems i.e. optimization of a set of -++ observations of a data set: -++ -++ \axiomType{Record}(lfn:\axiomType{List Expression DoubleFloat}, -++ init:\axiomType{List DoubleFloat}). -++ - -LDFD ==> List DoubleFloat -LEDFD ==> List Expression DoubleFloat -LSAD ==> Record(lfn:LEDFD, init:LDFD) -UNOALSAD ==> Union(noa:NOAD,lsa:LSAD) -EDFD ==> Expression DoubleFloat -LOCDFD ==> List OrderedCompletion DoubleFloat -NOAD ==> Record(fn:EDFD, init:LDFD, lb:LOCDFD, cf:LEDFD, ub:LOCDFD) -NumericalOptimizationProblem():SetCategory with - - coerce: NOAD -> % - ++ coerce(x) \undocumented{} - coerce: LSAD -> % - ++ coerce(x) \undocumented{} - coerce: UNOALSAD -> % - ++ coerce(x) \undocumented{} - coerce: % -> OutputForm - ++ coerce(x) \undocumented{} - retract: % -> UNOALSAD - ++ retract(x) \undocumented{} - - == - - add - Rep := UNOALSAD - - coerce(s:NOAD) == [s] - coerce(s:LSAD) == [s] - coerce(x:UNOALSAD) == x - coerce(x:%):OutputForm == - (x) case noa => (x.noa)::OutputForm - (x.lsa)::OutputForm - retract(x:%):UNOALSAD == - (x) case noa => [x.noa] - [x.lsa] - -@ -\section{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. -@ -<<*>>= -<> - -<> -<> -<> -<> -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/algebra/any.spad.pamphlet b/src/algebra/any.spad.pamphlet index 757c012..61b47c6 100644 --- a/src/algebra/any.spad.pamphlet +++ b/src/algebra/any.spad.pamphlet @@ -9,98 +9,6 @@ \eject \tableofcontents \eject -\section{domain NONE None} -<>= --- any.spad.pamphlet None.input -)spool None.output -)set message test on -)set message auto off -)clear all ---S 1 of 3 -[ ] ---R ---R ---R (1) [] ---R Type: List None ---E 1 - ---S 2 of 3 -[ ] :: List Float ---R ---R ---R (2) [] ---R Type: List Float ---E 2 - ---S 3 of 3 -[ ]$List(NonNegativeInteger) ---R ---R ---R (3) [] ---R Type: List NonNegativeInteger ---E 3 -)spool -)lisp (bye) -@ -<>= -==================================================================== -None examples -==================================================================== - -The None domain is not very useful for interactive work but it is -provided nevertheless for completeness of the Axiom type system. - -Probably the only place you will ever see it is if you enter an -empty list with no type information. - - [ ] - [] - Type: List None - -Such an empty list can be converted into an empty list of any other -type. - - [ ] :: List Float - [] - Type: List Float - -If you wish to produce an empty list of a particular type directly, -such as List NonNegativeInteger, do it this way. - - [ ]$List(NonNegativeInteger) - [] - Type: List NonNegativeInteger - -See Also: -o )show None -o $AXIOM/doc/src/algebra/any.spad.dvi - -@ -<>= -"NONE" -> "SETCAT" -"None()" -> "SetCategory()" -@ -<>= -)abbrev domain NONE None -++ Author: -++ Date Created: -++ Change History: -++ Basic Functions: coerce -++ Related Constructors: NoneFunctions1 -++ Also See: Any -++ AMS Classification: -++ Keywords: none, empty -++ Description: -++ \spadtype{None} implements a type with no objects. It is mainly -++ used in technical situations where such a thing is needed (e.g. -++ the interpreter and some of the internal \spadtype{Expression} -++ code). - -None():SetCategory == add - coerce(none:%):OutputForm == "NONE" :: OutputForm - x:% = y:% == EQ(x,y)$Lisp - -@ \section{package NONE1 NoneFunctions1} <>= "NONE1" -> "PACKAGE" @@ -131,91 +39,6 @@ NoneFunctions1(S:Type): Exports == Implementation where coerce(s:S):None == s pretend None @ -\section{domain ANY Any} -<>= -"ANY" -> "SETCAT" -"Any()" -> "SetCategory()" -@ -<>= -)abbrev domain ANY Any -++ Author: Robert S. Sutor -++ Date Created: -++ Change History: -++ Basic Functions: any, domainOf, objectOf, dom, obj, showTypeInOutput -++ Related Constructors: AnyFunctions1 -++ Also See: None -++ AMS Classification: -++ Keywords: -++ Description: -++ \spadtype{Any} implements a type that packages up objects and their -++ types in objects of \spadtype{Any}. Roughly speaking that means -++ that if \spad{s : S} then when converted to \spadtype{Any}, the new -++ object will include both the original object and its type. This is -++ a way of converting arbitrary objects into a single type without -++ losing any of the original information. Any object can be converted -++ to one of \spadtype{Any}. - -Any(): SetCategory with - any : (SExpression, None) -> % - ++ any(type,object) is a technical function for creating - ++ an object of \spadtype{Any}. Arugment \spad{type} is a - ++ \spadgloss{LISP} form for the type of \spad{object}. - domainOf : % -> OutputForm - ++ domainOf(a) returns a printable form of the type of the - ++ original object that was converted to \spadtype{Any}. - objectOf : % -> OutputForm - ++ objectOf(a) returns a printable form of the - ++ original object that was converted to \spadtype{Any}. - dom : % -> SExpression - ++ dom(a) returns a \spadgloss{LISP} form of the type of the - ++ original object that was converted to \spadtype{Any}. - obj : % -> None - ++ obj(a) essentially returns the original object that was - ++ converted to \spadtype{Any} except that the type is forced - ++ to be \spadtype{None}. - showTypeInOutput: Boolean -> String - ++ showTypeInOutput(bool) affects the way objects of - ++ \spadtype{Any} are displayed. If \spad{bool} is true - ++ then the type of the original object that was converted - ++ to \spadtype{Any} will be printed. If \spad{bool} is - ++ false, it will not be printed. - - == add - Rep := Record(dm: SExpression, ob: None) - - printTypeInOutputP:Reference(Boolean) := ref false - - obj x == x.ob - dom x == x.dm - domainOf x == x.dm pretend OutputForm - x = y == (x.dm = y.dm) and EQ(x.ob, y.ob)$Lisp - - objectOf(x : %) : OutputForm == - spad2BootCoerce(x.ob, x.dm, - list("OutputForm"::Symbol)$List(Symbol))$Lisp - - showTypeInOutput(b : Boolean) : String == - printTypeInOutputP := ref b - b=> "Type of object will be displayed in output of a member of Any" - "Type of object will not be displayed in output of a member of Any" - - coerce(x):OutputForm == - obj1 : OutputForm := objectOf x - not deref printTypeInOutputP => obj1 - dom1 := - p:Symbol := prefix2String(devaluate(x.dm)$Lisp)$Lisp - atom?(p pretend SExpression) => list(p)$List(Symbol) - list(p)$Symbol - hconcat cons(obj1, - cons(":"::OutputForm, [a::OutputForm for a in dom1])) - - any(domain, object) == - (isValidType(domain)$Lisp)@Boolean => [domain, object] - domain := devaluate(domain)$Lisp - (isValidType(domain)$Lisp)@Boolean => [domain, object] - error "function any must have a domain as first argument" - -@ \section{package ANY1 AnyFunctions1} <>= "ANY1" -> "PACKAGE" @@ -311,9 +134,7 @@ AnyFunctions1(S:Type): with -- to resolve two types in the interpreter because at worst the answer -- may be Any. -<> <> -<> <> @ \eject diff --git a/src/algebra/array1.spad.pamphlet b/src/algebra/array1.spad.pamphlet index 5d5b1c2..975c0d2 100644 --- a/src/algebra/array1.spad.pamphlet +++ b/src/algebra/array1.spad.pamphlet @@ -9,213 +9,6 @@ \eject \tableofcontents \eject -\section{domain PRIMARR PrimitiveArray} -<>= -"PRIMARR" -> "A1AGG" -"PrimitiveArray(a:Type)" -> "OneDimensionalArrayAggregate(a:Type)" -@ -<>= -)abbrev domain PRIMARR PrimitiveArray -++ This provides a fast array type with no bound checking on elt's. -++ Minimum index is 0 in this type, cannot be changed -PrimitiveArray(S:Type): OneDimensionalArrayAggregate S == add - Qmax ==> QVMAXINDEX$Lisp - Qsize ==> QVSIZE$Lisp --- Qelt ==> QVELT$Lisp --- Qsetelt ==> QSETVELT$Lisp - Qelt ==> ELT$Lisp - Qsetelt ==> SETELT$Lisp - Qnew ==> GETREFV$Lisp - - #x == Qsize x - minIndex x == 0 - empty() == Qnew(0$Lisp) - new(n, x) == fill_!(Qnew n, x) - qelt(x, i) == Qelt(x, i) - elt(x:%, i:Integer) == Qelt(x, i) - qsetelt_!(x, i, s) == Qsetelt(x, i, s) - setelt(x:%, i:Integer, s:S) == Qsetelt(x, i, s) - fill_!(x, s) == (for i in 0..Qmax x repeat Qsetelt(x, i, s); x) - -@ -\section{PRIMARR.lsp BOOTSTRAP} -{\bf PRIMARR} depends on itself. -We need to break this cycle to build the algebra. So we keep a -cached copy of the translated {\bf PRIMARR} category which we can write -into the {\bf MID} directory. We compile the lisp code and copy the -{\bf PRIMARR.o} file to the {\bf OUT} directory. This is eventually -forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<>= - -(|/VERSIONCHECK| 2) - -(PUT (QUOTE |PRIMARR;#;$Nni;1|) (QUOTE |SPADreplace|) (QUOTE QVSIZE)) - -(DEFUN |PRIMARR;#;$Nni;1| (|x| |$|) (QVSIZE |x|)) - -(PUT (QUOTE |PRIMARR;minIndex;$I;2|) - (QUOTE |SPADreplace|) (QUOTE (XLAM (|x|) 0))) - -(DEFUN |PRIMARR;minIndex;$I;2| (|x| |$|) 0) - -(PUT (QUOTE |PRIMARR;empty;$;3|) - (QUOTE |SPADreplace|) (QUOTE (XLAM NIL (GETREFV 0)))) - -(DEFUN |PRIMARR;empty;$;3| (|$|) (GETREFV 0)) - -(DEFUN |PRIMARR;new;NniS$;4| (|n| |x| |$|) - (SPADCALL (GETREFV |n|) |x| (QREFELT |$| 12))) - -(PUT (QUOTE |PRIMARR;qelt;$IS;5|) (QUOTE |SPADreplace|) (QUOTE ELT)) - -(DEFUN |PRIMARR;qelt;$IS;5| (|x| |i| |$|) (ELT |x| |i|)) - -(PUT (QUOTE |PRIMARR;elt;$IS;6|) (QUOTE |SPADreplace|) (QUOTE ELT)) - -(DEFUN |PRIMARR;elt;$IS;6| (|x| |i| |$|) (ELT |x| |i|)) - -(PUT (QUOTE |PRIMARR;qsetelt!;$I2S;7|) (QUOTE |SPADreplace|) (QUOTE SETELT)) - -(DEFUN |PRIMARR;qsetelt!;$I2S;7| (|x| |i| |s| |$|) (SETELT |x| |i| |s|)) - -(PUT (QUOTE |PRIMARR;setelt;$I2S;8|) (QUOTE |SPADreplace|) (QUOTE SETELT)) - -(DEFUN |PRIMARR;setelt;$I2S;8| (|x| |i| |s| |$|) (SETELT |x| |i| |s|)) - -(DEFUN |PRIMARR;fill!;$S$;9| (|x| |s| |$|) - (PROG (|i| #1=#:G82338) - (RETURN - (SEQ - (SEQ - (LETT |i| 0 |PRIMARR;fill!;$S$;9|) - (LETT #1# (QVMAXINDEX |x|) |PRIMARR;fill!;$S$;9|) - G190 - (COND ((QSGREATERP |i| #1#) (GO G191))) - (SEQ (EXIT (SETELT |x| |i| |s|))) - (LETT |i| (QSADD1 |i|) |PRIMARR;fill!;$S$;9|) - (GO G190) - G191 - (EXIT NIL)) - (EXIT |x|))))) - -(DEFUN |PrimitiveArray| (#1=#:G82348) - (PROG NIL - (RETURN - (PROG (#2=#:G82349) - (RETURN - (COND - ((LETT #2# - (|lassocShiftWithFunction| - (LIST (|devaluate| #1#)) - (HGET |$ConstructorCache| (QUOTE |PrimitiveArray|)) - (QUOTE |domainEqualList|)) - |PrimitiveArray|) - (|CDRwithIncrement| #2#)) - ((QUOTE T) - (|UNWIND-PROTECT| - (PROG1 - (|PrimitiveArray;| #1#) - (LETT #2# T |PrimitiveArray|)) - (COND - ((NOT #2#) - (HREM |$ConstructorCache| (QUOTE |PrimitiveArray|)))))))))))) - -(DEFUN |PrimitiveArray;| (|#1|) - (PROG (|DV$1| |dv$| |$| #1=#:G82347 |pv$|) - (RETURN - (PROGN - (LETT |DV$1| (|devaluate| |#1|) . #2=(|PrimitiveArray|)) - (LETT |dv$| (LIST (QUOTE |PrimitiveArray|) |DV$1|) . #2#) - (LETT |$| (GETREFV 35) . #2#) - (QSETREFV |$| 0 |dv$|) - (QSETREFV |$| 3 - (LETT |pv$| - (|buildPredVector| 0 0 - (LIST - (|HasCategory| |#1| (QUOTE (|SetCategory|))) - (|HasCategory| |#1| (QUOTE (|ConvertibleTo| (|InputForm|)))) - (LETT #1# (|HasCategory| |#1| (QUOTE (|OrderedSet|))) . #2#) - (OR #1# (|HasCategory| |#1| (QUOTE (|SetCategory|)))) - (|HasCategory| (|Integer|) (QUOTE (|OrderedSet|))) - (AND (|HasCategory| |#1| (LIST (QUOTE |Evalable|) (|devaluate| |#1|))) - (|HasCategory| |#1| (QUOTE (|SetCategory|)))) - (OR - (AND - (|HasCategory| |#1| (LIST (QUOTE |Evalable|) (|devaluate| |#1|))) - #1#) - (AND - (|HasCategory| |#1| (LIST (QUOTE |Evalable|) (|devaluate| |#1|))) - (|HasCategory| |#1| (QUOTE (|SetCategory|))))))) - . #2#)) - (|haddProp| |$ConstructorCache| - (QUOTE |PrimitiveArray|) (LIST |DV$1|) (CONS 1 |$|)) - (|stuffDomainSlots| |$|) - (QSETREFV |$| 6 |#1|) - |$|)))) - -(MAKEPROP (QUOTE |PrimitiveArray|) (QUOTE |infovec|) - (LIST - (QUOTE - #(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|NonNegativeInteger|) - |PRIMARR;#;$Nni;1| (|Integer|) |PRIMARR;minIndex;$I;2| - |PRIMARR;empty;$;3| |PRIMARR;fill!;$S$;9| |PRIMARR;new;NniS$;4| - |PRIMARR;qelt;$IS;5| |PRIMARR;elt;$IS;6| |PRIMARR;qsetelt!;$I2S;7| - |PRIMARR;setelt;$I2S;8| (|Mapping| 6 6 6) (|Boolean|) (|List| 6) - (|Equation| 6) (|List| 21) (|Mapping| 19 6) (|Mapping| 19 6 6) - (|UniversalSegment| 9) (|Void|) (|Mapping| 6 6) (|InputForm|) - (|OutputForm|) (|String|) (|SingleInteger|) (|List| |$|) - (|Union| 6 (QUOTE "failed")) (|List| 9))) - (QUOTE - #(|~=| 0 |swap!| 6 |sorted?| 13 |sort!| 24 |sort| 35 |size?| 46 |setelt| - 52 |select| 66 |sample| 72 |reverse!| 76 |reverse| 81 |removeDuplicates| - 86 |remove| 91 |reduce| 103 |qsetelt!| 124 |qelt| 131 |position| 137 - |parts| 156 |new| 161 |more?| 167 |minIndex| 173 |min| 178 |merge| 184 - |members| 197 |member?| 202 |maxIndex| 208 |max| 213 |map!| 219 |map| - 225 |less?| 238 |latex| 244 |insert| 249 |indices| 263 |index?| 268 - |hash| 274 |first| 279 |find| 284 |fill!| 290 |every?| 296 |eval| 302 - |eq?| 328 |entry?| 334 |entries| 340 |empty?| 345 |empty| 350 |elt| 354 - |delete| 373 |count| 385 |copyInto!| 397 |copy| 404 |convert| 409 - |construct| 414 |concat| 419 |coerce| 442 |any?| 447 |>=| 453 |>| 459 - |=| 465 |<=| 471 |<| 477 |#| 483)) - (QUOTE ((|shallowlyMutable| . 0) (|finiteAggregate| . 0))) - (CONS - (|makeByteWordVec2| 7 (QUOTE (0 0 0 0 0 0 3 0 0 7 4 0 0 7 1 2 4))) - (CONS - (QUOTE #(|OneDimensionalArrayAggregate&| |FiniteLinearAggregate&| - |LinearAggregate&| |IndexedAggregate&| |Collection&| - |HomogeneousAggregate&| |OrderedSet&| |Aggregate&| |EltableAggregate&| - |Evalable&| |SetCategory&| NIL NIL |InnerEvalable&| NIL NIL |BasicType&|)) - (CONS - (QUOTE - #((|OneDimensionalArrayAggregate| 6) (|FiniteLinearAggregate| 6) - (|LinearAggregate| 6) (|IndexedAggregate| 9 6) (|Collection| 6) - (|HomogeneousAggregate| 6) (|OrderedSet|) (|Aggregate|) - (|EltableAggregate| 9 6) (|Evalable| 6) (|SetCategory|) (|Type|) - (|Eltable| 9 6) (|InnerEvalable| 6 6) (|CoercibleTo| 29) - (|ConvertibleTo| 28) (|BasicType|))) - (|makeByteWordVec2| 34 - (QUOTE - (2 1 19 0 0 1 3 0 26 0 9 9 1 1 3 19 0 1 2 0 19 24 0 1 1 3 0 0 1 2 0 0 - 24 0 1 1 3 0 0 1 2 0 0 24 0 1 2 0 19 0 7 1 3 0 6 0 25 6 1 3 0 6 0 9 - 6 17 2 0 0 23 0 1 0 0 0 1 1 0 0 0 1 1 0 0 0 1 1 1 0 0 1 2 1 0 6 0 1 - 2 0 0 23 0 1 4 1 6 18 0 6 6 1 3 0 6 18 0 6 1 2 0 6 18 0 1 3 0 6 0 9 - 6 16 2 0 6 0 9 14 2 1 9 6 0 1 3 1 9 6 0 9 1 2 0 9 23 0 1 1 0 20 0 1 - 2 0 0 7 6 13 2 0 19 0 7 1 1 5 9 0 10 2 3 0 0 0 1 2 3 0 0 0 1 3 0 0 - 24 0 0 1 1 0 20 0 1 2 1 19 6 0 1 1 5 9 0 1 2 3 0 0 0 1 2 0 0 27 0 1 - 3 0 0 18 0 0 1 2 0 0 27 0 1 2 0 19 0 7 1 1 1 30 0 1 3 0 0 0 0 9 1 3 - 0 0 6 0 9 1 1 0 34 0 1 2 0 19 9 0 1 1 1 31 0 1 1 5 6 0 1 2 0 33 23 - 0 1 2 0 0 0 6 12 2 0 19 23 0 1 3 6 0 0 20 20 1 2 6 0 0 21 1 3 6 0 0 - 6 6 1 2 6 0 0 22 1 2 0 19 0 0 1 2 1 19 6 0 1 1 0 20 0 1 1 0 19 0 1 - 0 0 0 11 2 0 0 0 25 1 2 0 6 0 9 15 3 0 6 0 9 6 1 2 0 0 0 9 1 2 0 0 - 0 25 1 2 1 7 6 0 1 2 0 7 23 0 1 3 0 0 0 0 9 1 1 0 0 0 1 1 2 28 0 1 - 1 0 0 20 1 1 0 0 32 1 2 0 0 6 0 1 2 0 0 0 0 1 2 0 0 0 6 1 1 1 29 0 - 1 2 0 19 23 0 1 2 3 19 0 0 1 2 3 19 0 0 1 2 1 19 0 0 1 2 3 19 0 0 1 - 2 3 19 0 0 1 1 0 7 0 8)))))) - (QUOTE |lookupComplete|))) -@ \section{package PRIMARR2 PrimitiveArrayFunctions2} <>= "PRIMARR2" -> "PACKAGE" @@ -270,876 +63,6 @@ PrimitiveArrayFunctions2(A, B): Exports == Implementation where reduce(f, v, b) == reduce(f, v, b)$O2 @ -\section{domain TUPLE Tuple} -<>= -"TUPLE" -> "PRIMARR" -"Tuple(a:Type)" -> "PrimitiveArray(a:Type)" -@ -<>= -)abbrev domain TUPLE Tuple -++ This domain is used to interface with the interpreter's notion -++ of comma-delimited sequences of values. -Tuple(S:Type): CoercibleTo(PrimitiveArray S) with - coerce: PrimitiveArray S -> % - ++ coerce(a) makes a tuple from primitive array a - ++ - ++X t1:PrimitiveArray(Integer):= [i for i in 1..10] - ++X t2:=coerce(t1)$Tuple(Integer) - - select: (%, NonNegativeInteger) -> S - ++ select(x,n) returns the n-th element of tuple x. - ++ tuples are 0-based - ++ - ++X t1:PrimitiveArray(Integer):= [i for i in 1..10] - ++X t2:=coerce(t1)$Tuple(Integer) - ++X select(t2,3) - - length: % -> NonNegativeInteger - ++ length(x) returns the number of elements in tuple x - ++ - ++X t1:PrimitiveArray(Integer):= [i for i in 1..10] - ++X t2:=coerce(t1)$Tuple(Integer) - ++X length(t2) - - if S has SetCategory then SetCategory - == add - Rep := Record(len : NonNegativeInteger, elts : PrimitiveArray S) - - coerce(x: PrimitiveArray S): % == [#x, x] - coerce(x:%): PrimitiveArray(S) == x.elts - length x == x.len - - select(x, n) == - n >= x.len => error "Index out of bounds" - x.elts.n - - if S has SetCategory then - x = y == (x.len = y.len) and (x.elts =$PrimitiveArray(S) y.elts) - coerce(x : %): OutputForm == - paren [(x.elts.i)::OutputForm - for i in minIndex x.elts .. maxIndex x.elts]$List(OutputForm) - -@ -\section{domain IFARRAY IndexedFlexibleArray} -<>= -"IFARRAY" -> "A1AGG" -"IndexedFlexibleArray(a:Type,b:Integer)" -> - "OneDimensionalArrayAggregate(a:Type)" -"IndexedFlexibleArray(a:Type,1)" -> - "IndexedFlexibleArray(a:Type,b:Integer)" -"IFARRAY" -> "ELAGG" -"IndexedFlexibleArray(a:Type,b:Integer)" -> - "ExtensibleLinearAggregate(a:Type)" -@ -<>= -)abbrev domain IFARRAY IndexedFlexibleArray -++ Author: Michael Monagan July/87, modified SMW June/91 -++ A FlexibleArray is the notion of an array intended to allow for growth -++ at the end only. Hence the following efficient operations -++ \spad{append(x,a)} meaning append item x at the end of the array \spad{a} -++ \spad{delete(a,n)} meaning delete the last item from the array \spad{a} -++ Flexible arrays support the other operations inherited from -++ \spadtype{ExtensibleLinearAggregate}. However, these are not efficient. -++ Flexible arrays combine the \spad{O(1)} access time property of arrays -++ with growing and shrinking at the end in \spad{O(1)} (average) time. -++ This is done by using an ordinary array which may have zero or more -++ empty slots at the end. When the array becomes full it is copied -++ into a new larger (50% larger) array. Conversely, when the array -++ becomes less than 1/2 full, it is copied into a smaller array. -++ Flexible arrays provide for an efficient implementation of many -++ data structures in particular heaps, stacks and sets. - -IndexedFlexibleArray(S:Type, mn: Integer): Exports == Implementation where - A ==> PrimitiveArray S - I ==> Integer - N ==> NonNegativeInteger - U ==> UniversalSegment Integer - Exports == - Join(OneDimensionalArrayAggregate S,ExtensibleLinearAggregate S) with - flexibleArray : List S -> % - ++ flexibleArray(l) creates a flexible array from the list of elements l - ++ - ++X T1:=IndexedFlexibleArray(Integer,20) - ++X flexibleArray([i for i in 1..10])$T1 - - physicalLength : % -> NonNegativeInteger - ++ physicalLength(x) returns the number of elements x can - ++ accomodate before growing - ++ - ++X T1:=IndexedFlexibleArray(Integer,20) - ++X t2:=flexibleArray([i for i in 1..10])$T1 - ++X physicalLength t2 - - physicalLength_!: (%, I) -> % - ++ physicalLength!(x,n) changes the physical length of x to be n and - ++ returns the new array. - ++ - ++X T1:=IndexedFlexibleArray(Integer,20) - ++X t2:=flexibleArray([i for i in 1..10])$T1 - ++X physicalLength!(t2,15) - - shrinkable: Boolean -> Boolean - ++ shrinkable(b) sets the shrinkable attribute of flexible arrays to b - ++ and returns the previous value - ++ - ++X T1:=IndexedFlexibleArray(Integer,20) - ++X shrinkable(false)$T1 - - Implementation == add - Rep := Record(physLen:I, logLen:I, f:A) - shrinkable? : Boolean := true - growAndFill : (%, I, S) -> % - growWith : (%, I, S) -> % - growAdding : (%, I, %) -> % - shrink: (%, I) -> % - newa : (N, A) -> A - - physicalLength(r) == (r.physLen) pretend NonNegativeInteger - physicalLength_!(r, n) == - r.physLen = 0 => error "flexible array must be non-empty" - growWith(r, n, r.f.0) - - empty() == [0, 0, empty()] - #r == (r.logLen)::N - fill_!(r, x) == (fill_!(r.f, x); r) - maxIndex r == r.logLen - 1 + mn - minIndex r == mn - new(n, a) == [n, n, new(n, a)] - - shrinkable(b) == - oldval := shrinkable? - shrinkable? := b - oldval - - flexibleArray l == - n := #l - n = 0 => empty() - x := l.1 - a := new(n,x) - for i in mn + 1..mn + n-1 for y in rest l repeat a.i := y - a - - -- local utility operations - newa(n, a) == - zero? n => empty() - new(n, a.0) - - growAdding(r, b, s) == - b = 0 => r - #r > 0 => growAndFill(r, b, (r.f).0) - #s > 0 => growAndFill(r, b, (s.f).0) - error "no default filler element" - - growAndFill(r, b, x) == - (r.logLen := r.logLen + b) <= r.physLen => r - -- enlarge by 50% + b - n := r.physLen + r.physLen quo 2 + 1 - if r.logLen > n then n := r.logLen - growWith(r, n, x) - - growWith(r, n, x) == - y := new(n::N, x)$PrimitiveArray(S) - a := r.f - for k in 0 .. r.physLen-1 repeat y.k := a.k - r.physLen := n - r.f := y - r - - shrink(r, i) == - r.logLen := r.logLen - i - negative?(n := r.logLen) => error "internal bug in flexible array" - 2*n+2 > r.physLen => r - not shrinkable? => r - if n < r.logLen - then error "cannot shrink flexible array to indicated size" - n = 0 => empty() - r.physLen := n - y := newa(n::N, a := r.f) - for k in 0 .. n-1 repeat y.k := a.k - r.f := y - r - - copy r == - n := #r - a := r.f - v := newa(n, a := r.f) - for k in 0..n-1 repeat v.k := a.k - [n, n, v] - - - elt(r:%, i:I) == - i < mn or i >= r.logLen + mn => - error "index out of range" - r.f.(i-mn) - - setelt(r:%, i:I, x:S) == - i < mn or i >= r.logLen + mn => - error "index out of range" - r.f.(i-mn) := x - - -- operations inherited from extensible aggregate - merge(g, a, b) == merge_!(g, copy a, b) - concat(x:S, r:%) == insert_!(x, r, mn) - - concat_!(r:%, x:S) == - growAndFill(r, 1, x) - r.f.(r.logLen-1) := x - r - - concat_!(a:%, b:%) == - if eq?(a, b) then b := copy b - n := #a - growAdding(a, #b, b) - copyInto_!(a, b, n + mn) - - remove_!(g:(S->Boolean), a:%) == - k:I := 0 - for i in 0..maxIndex a - mn repeat - if not g(a.i) then (a.k := a.i; k := k+1) - shrink(a, #a - k) - - delete_!(r:%, i1:I) == - i := i1 - mn - i < 0 or i > r.logLen => error "index out of range" - for k in i..r.logLen-2 repeat r.f.k := r.f.(k+1) - shrink(r, 1) - - delete_!(r:%, i:U) == - l := lo i - mn; m := maxIndex r - mn - h := (hasHi i => hi i - mn; m) - l < 0 or h > m => error "index out of range" - for j in l.. for k in h+1..m repeat r.f.j := r.f.k - shrink(r, max(0,h-l+1)) - - insert_!(x:S, r:%, i1:I):% == - i := i1 - mn - n := r.logLen - i < 0 or i > n => error "index out of range" - growAndFill(r, 1, x) - for k in n-1 .. i by -1 repeat r.f.(k+1) := r.f.k - r.f.i := x - r - - insert_!(a:%, b:%, i1:I):% == - i := i1 - mn - if eq?(a, b) then b := copy b - m := #a; n := #b - i < 0 or i > n => error "index out of range" - growAdding(b, m, a) - for k in n-1 .. i by -1 repeat b.f.(m+k) := b.f.k - for k in m-1 .. 0 by -1 repeat b.f.(i+k) := a.f.k - b - - merge_!(g, a, b) == - m := #a; n := #b; growAdding(a, n, b) - for i in m-1..0 by -1 for j in m+n-1.. by -1 repeat a.f.j := a.f.i - i := n; j := 0 - for k in 0.. while i < n+m and j < n repeat - if g(a.f.i,b.f.j) then (a.f.k := a.f.i; i := i+1) - else (a.f.k := b.f.j; j := j+1) - for k in k.. for j in j..n-1 repeat a.f.k := b.f.j - a - - select_!(g:(S->Boolean), a:%) == - k:I := 0 - for i in 0..maxIndex a - mn repeat_ - if g(a.f.i) then (a.f.k := a.f.i;k := k+1) - shrink(a, #a - k) - - if S has SetCategory then - removeDuplicates_! a == - ct := #a - ct < 2 => a - - i := mn - nlim := mn + ct - nlim0 := nlim - while i < nlim repeat - j := i+1 - for k in j..nlim-1 | a.k ^= a.i repeat - a.j := a.k - j := j+1 - nlim := j - i := i+1 - nlim ^= nlim0 => delete_!(a, i..) - a - -@ -\section{domain FARRAY FlexibleArray} -<>= --- array1.spad.pamphlet FlexibleArray.input -)spool FlexibleArray.output -)set message test on -)set message auto off -)clear all ---S 1 of 16 -flexibleArray [i for i in 1..6] ---R ---R ---R (1) [1,2,3,4,5,6] ---R Type: FlexibleArray PositiveInteger ---E 1 - ---S 2 of 16 -f : FARRAY INT := new(6,0) ---R ---R ---R (2) [0,0,0,0,0,0] ---R Type: FlexibleArray Integer ---E 2 - ---S 3 of 16 -for i in 1..6 repeat f.i := i; f ---R ---R ---R (3) [1,2,3,4,5,6] ---R Type: FlexibleArray Integer ---E 3 - ---S 4 of 16 -physicalLength f ---R ---R ---R (4) 6 ---R Type: PositiveInteger ---E 4 - ---S 5 of 16 -concat!(f,11) ---R ---R ---R (5) [1,2,3,4,5,6,11] ---R Type: FlexibleArray Integer ---E 5 - ---S 6 of 16 -physicalLength f ---R ---R ---R (6) 10 ---R Type: PositiveInteger ---E 6 - ---S 7 of 16 -physicalLength!(f,15) ---R ---R ---R (7) [1,2,3,4,5,6,11] ---R Type: FlexibleArray Integer ---E 7 - ---S 8 of 16 -concat!(f,f) ---R ---R ---R (8) [1,2,3,4,5,6,11,1,2,3,4,5,6,11] ---R Type: FlexibleArray Integer ---E 8 - ---S 9 of 16 -insert!(22,f,1) ---R ---R ---R (9) [22,1,2,3,4,5,6,11,1,2,3,4,5,6,11] ---R Type: FlexibleArray Integer ---E 9 - ---S 10 of 16 -g := f(10..) ---R ---R ---R (10) [2,3,4,5,6,11] ---R Type: FlexibleArray Integer ---E 10 - ---S 11 of 16 -insert!(g,f,1) ---R ---R ---R (11) [2,3,4,5,6,11,22,1,2,3,4,5,6,11,1,2,3,4,5,6,11] ---R Type: FlexibleArray Integer ---E 11 - ---S 12 of 16 -merge!(sort! f, sort! g) ---R ---R ---R (12) [1,1,2,2,2,2,3,3,3,3,4,4,4,4,5,5,5,5,6,6,6,6,11,11,11,11,22] ---R Type: FlexibleArray Integer ---E 12 - ---S 13 of 16 -removeDuplicates! f ---R ---R ---R (13) [1,2,3,4,5,6,11,22] ---R Type: FlexibleArray Integer ---E 13 - ---S 14 of 16 -select!(i +-> even? i,f) ---R ---R ---R (14) [2,4,6,22] ---R Type: FlexibleArray Integer ---E 14 - ---S 15 of 16 -physicalLength f ---R ---R ---R (15) 8 ---R Type: PositiveInteger ---E 15 - ---S 16 of 16 -shrinkable(false)$FlexibleArray(Integer) ---R ---R ---R (16) true ---R Type: Boolean ---E 16 -)spool -)lisp (bye) -@ -<>= -==================================================================== -FlexibleArray -==================================================================== - -The FlexibleArray domain constructor creates one-dimensional -arrays of elements of the same type. Flexible arrays are an attempt -to provide a data type that has the best features of both -one-dimensional arrays (fast, random access to elements) and lists -(flexibility). They are implemented by a fixed block of storage. -When necessary for expansion, a new, larger block of storage is -allocated and the elements from the old storage area are copied into -the new block. - -Flexible arrays have available most of the operations provided by -OneDimensionalArray Vector. Since flexible arrays are also of -category ExtensibleLinearAggregate they have operations concat!, -delete!, insert!, merge!, remove!, removeDuplicates!, and select!. In -addition, the operations physicalLength and physicalLength! provide -user-control over expansion and contraction. - -A convenient way to create a flexible array is to apply the operation -flexibleArray to a list of values. - - flexibleArray [i for i in 1..6] - [1,2,3,4,5,6] - Type: FlexibleArray PositiveInteger - -Create a flexible array of six zeroes. - - f : FARRAY INT := new(6,0) - [0,0,0,0,0,0] - Type: FlexibleArray Integer - -For i=1..6 set the i-th element to i. Display f. - - for i in 1..6 repeat f.i := i; f - [1,2,3,4,5,6] - Type: FlexibleArray Integer - -Initially, the physical length is the same as the number of elements. - - physicalLength f - 6 - Type: PositiveInteger - -Add an element to the end of f. - - concat!(f,11) - [1,2,3,4,5,6,11] - Type: FlexibleArray Integer - -See that its physical length has grown. - - physicalLength f - 10 - Type: PositiveInteger - -Make f grow to have room for 15 elements. - - physicalLength!(f,15) - [1,2,3,4,5,6,11] - Type: FlexibleArray Integer - -Concatenate the elements of f to itself. The physical length -allows room for three more values at the end. - - concat!(f,f) - [1,2,3,4,5,6,11,1,2,3,4,5,6,11] - Type: FlexibleArray Integer - -Use insert! to add an element to the front of a flexible array. - - insert!(22,f,1) - [22,1,2,3,4,5,6,11,1,2,3,4,5,6,11] - Type: FlexibleArray Integer - -Create a second flexible array from f consisting of the elements from -index 10 forward. - - g := f(10..) - [2,3,4,5,6,11] - Type: FlexibleArray Integer - -Insert this array at the front of f. - - insert!(g,f,1) - [2,3,4,5,6,11,22,1,2,3,4,5,6,11,1,2,3,4,5,6,11] - Type: FlexibleArray Integer - -Merge the flexible array f into g after sorting each in place. - - merge!(sort! f, sort! g) - [1,1,2,2,2,2,3,3,3,3,4,4,4,4,5,5,5,5,6,6,6,6,11,11,11,11,22] - Type: FlexibleArray Integer - -Remove duplicates in place. - - removeDuplicates! f - [1,2,3,4,5,6,11,22] - Type: FlexibleArray Integer - -Remove all odd integers. - - select!(i +-> even? i,f) - [2,4,6,22] - Type: FlexibleArray Integer - -All these operations have shrunk the physical length of f. - - physicalLength f - 8 - Type: PositiveInteger - -To force Axiom not to shrink flexible arrays call the shrinkable -operation with the argument false. You must package call this -operation. The previous value is returned. - - shrinkable(false)$FlexibleArray(Integer) - true - Type: Boolean - -See Also: -o )help OneDimensionalArray -o )help Vector -o )help ExtensibleLinearAggregate -o )show FlexibleArray -o $AXIOM/doc/src/algebra/array1.spad.dvi - -@ -<>= -"FARRAY" -> "IFARRAY" -"FlexibleArray(a:Type)" -> "IndexedFlexibleArray(a:Type,1)" -@ -<>= -)abbrev domain FARRAY FlexibleArray -++ A FlexibleArray is the notion of an array intended to allow for growth -++ at the end only. Hence the following efficient operations -++ \spad{append(x,a)} meaning append item x at the end of the array \spad{a} -++ \spad{delete(a,n)} meaning delete the last item from the array \spad{a} -++ Flexible arrays support the other operations inherited from -++ \spadtype{ExtensibleLinearAggregate}. However, these are not efficient. -++ Flexible arrays combine the \spad{O(1)} access time property of arrays -++ with growing and shrinking at the end in \spad{O(1)} (average) time. -++ This is done by using an ordinary array which may have zero or more -++ empty slots at the end. When the array becomes full it is copied -++ into a new larger (50% larger) array. Conversely, when the array -++ becomes less than 1/2 full, it is copied into a smaller array. -++ Flexible arrays provide for an efficient implementation of many -++ data structures in particular heaps, stacks and sets. - -FlexibleArray(S: Type) == Implementation where - ARRAYMININDEX ==> 1 -- if you want to change this, be my guest - Implementation ==> IndexedFlexibleArray(S, ARRAYMININDEX) --- Join(OneDimensionalArrayAggregate S, ExtensibleLinearAggregate S) - -@ -\section{domain IARRAY1 IndexedOneDimensionalArray} -<>= -"IARRAY1" -> "A1AGG" -"IndexedOneDimensionalArray(a:Type,b:Integer)" -> - "OneDimensionalArrayAggregate(a:Type)" -@ -<>= -)abbrev domain IARRAY1 IndexedOneDimensionalArray -++ Author Micheal Monagan Aug/87 -++ This is the basic one dimensional array data type. - -IndexedOneDimensionalArray(S:Type, mn:Integer): - OneDimensionalArrayAggregate S == add - Qmax ==> QVMAXINDEX$Lisp - Qsize ==> QVSIZE$Lisp --- Qelt ==> QVELT$Lisp --- Qsetelt ==> QSETVELT$Lisp - Qelt ==> ELT$Lisp - Qsetelt ==> SETELT$Lisp --- Qelt1 ==> QVELT_-1$Lisp --- Qsetelt1 ==> QSETVELT_-1$Lisp - Qnew ==> GETREFV$Lisp - I ==> Integer - - #x == Qsize x - fill_!(x, s) == (for i in 0..Qmax x repeat Qsetelt(x, i, s); x) - minIndex x == mn - - empty() == Qnew(0$Lisp) - new(n, s) == fill_!(Qnew n,s) - - map_!(f, s1) == - n:Integer := Qmax(s1) - n < 0 => s1 - for i in 0..n repeat Qsetelt(s1, i, f(Qelt(s1,i))) - s1 - - map(f, s1) == - n:Integer := Qmax(s1) - n < 0 => s1 - ss2:% := Qnew(n+1) - for i in 0..n repeat Qsetelt(ss2, i, f(Qelt(s1,i))) - ss2 - - map(f, a, b) == - maxind:Integer := min(Qmax a, Qmax b) - maxind < 0 => empty() - c:% := Qnew(maxind+1) - for i in 0..maxind repeat - Qsetelt(c, i, f(Qelt(a,i),Qelt(b,i))) - c - - if zero? mn then - qelt(x, i) == Qelt(x, i) - qsetelt_!(x, i, s) == Qsetelt(x, i, s) - - elt(x:%, i:I) == - negative? i or i > maxIndex(x) => error "index out of range" - qelt(x, i) - - setelt(x:%, i:I, s:S) == - negative? i or i > maxIndex(x) => error "index out of range" - qsetelt_!(x, i, s) - --- else if one? mn then - else if (mn = 1) then - maxIndex x == Qsize x - qelt(x, i) == Qelt(x, i-1) - qsetelt_!(x, i, s) == Qsetelt(x, i-1, s) - - elt(x:%, i:I) == - QSLESSP(i,1$Lisp)$Lisp or QSLESSP(Qsize x,i)$Lisp => - error "index out of range" - Qelt(x, i-1) - - setelt(x:%, i:I, s:S) == - QSLESSP(i,1$Lisp)$Lisp or QSLESSP(Qsize x,i)$Lisp => - error "index out of range" - Qsetelt(x, i-1, s) - - else - qelt(x, i) == Qelt(x, i - mn) - qsetelt_!(x, i, s) == Qsetelt(x, i - mn, s) - - elt(x:%, i:I) == - i < mn or i > maxIndex(x) => error "index out of range" - qelt(x, i) - - setelt(x:%, i:I, s:S) == - i < mn or i > maxIndex(x) => error "index out of range" - qsetelt_!(x, i, s) - -@ -\section{domain ARRAY1 OneDimensionalArray} -<>= --- array1.spad.pamphlet OneDimensionalArray.input -)spool OneDimensionalArray.output -)set message test on -)set message auto off -)clear all ---S 1 of 9 -oneDimensionalArray [i**2 for i in 1..10] ---R ---R ---R (1) [1,4,9,16,25,36,49,64,81,100] ---R Type: OneDimensionalArray PositiveInteger ---E 1 - ---S 2 of 9 -a : ARRAY1 INT := new(10,0) ---R ---R ---R (2) [0,0,0,0,0,0,0,0,0,0] ---R Type: OneDimensionalArray Integer ---E 2 - ---S 3 of 9 -for i in 1..10 repeat a.i := i; a ---R ---R ---R (3) [1,2,3,4,5,6,7,8,9,10] ---R Type: OneDimensionalArray Integer ---E 3 - ---S 4 of 9 -map!(i +-> i ** 2,a); a ---R ---R ---R (4) [1,4,9,16,25,36,49,64,81,100] ---R Type: OneDimensionalArray Integer ---E 4 - ---S 5 of 9 -reverse! a ---R ---R ---R (5) [100,81,64,49,36,25,16,9,4,1] ---R Type: OneDimensionalArray Integer ---E 5 - ---S 6 of 9 -swap!(a,4,5); a ---R ---R ---R (6) [100,81,64,36,49,25,16,9,4,1] ---R Type: OneDimensionalArray Integer ---E 6 - ---S 7 of 9 -sort! a ---R ---R ---R (7) [1,4,9,16,25,36,49,64,81,100] ---R Type: OneDimensionalArray Integer ---E 7 - ---S 8 of 9 -b := a(6..10) ---R ---R ---R (8) [36,49,64,81,100] ---R Type: OneDimensionalArray Integer ---E 8 - ---S 9 of 9 -copyInto!(a,b,1) ---R ---R ---R (9) [36,49,64,81,100,36,49,64,81,100] ---R Type: OneDimensionalArray Integer ---E 9 -)spool -)lisp (bye) -@ -<>= -==================================================================== -OneDimensionalArray examples -==================================================================== - -The OneDimensionalArray domain is used for storing data in a -one-dimensional indexed data structure. Such an array is a -homogeneous data structure in that all the entries of the array must -belong to the same Axiom domain. Each array has a fixed length -specified by the user and arrays are not extensible. The indexing of -one-dimensional arrays is one-based. This means that the "first" -element of an array is given the index 1. - -To create a one-dimensional array, apply the operation -oneDimensionalArray to a list. - - oneDimensionalArray [i**2 for i in 1..10] - [1,4,9,16,25,36,49,64,81,100] - Type: OneDimensionalArray PositiveInteger - -Another approach is to first create a, a one-dimensional array of 10 -0's. OneDimensionalArray has the convenient abbreviation ARRAY1. - - a : ARRAY1 INT := new(10,0) - [0,0,0,0,0,0,0,0,0,0] - Type: OneDimensionalArray Integer - -Set each i-th element to i, then display the result. - - for i in 1..10 repeat a.i := i; a - [1,2,3,4,5,6,7,8,9,10] - Type: OneDimensionalArray Integer - -Square each element by mapping the function i +-> i^2 onto each element. - - map!(i +-> i ** 2,a); a - [1,4,9,16,25,36,49,64,81,100] - Type: OneDimensionalArray Integer - -Reverse the elements in place. - - reverse! a - [100,81,64,49,36,25,16,9,4,1] - Type: OneDimensionalArray Integer - -Swap the 4th and 5th element. - - swap!(a,4,5); a - [100,81,64,36,49,25,16,9,4,1] - Type: OneDimensionalArray Integer - -Sort the elements in place. - - sort! a - [1,4,9,16,25,36,49,64,81,100] - Type: OneDimensionalArray Integer - -Create a new one-dimensional array b containing the last 5 elements of a. - - b := a(6..10) - [36,49,64,81,100] - Type: OneDimensionalArray Integer - -Replace the first 5 elements of a with those of b. - - copyInto!(a,b,1) - [36,49,64,81,100,36,49,64,81,100] - Type: OneDimensionalArray Integer - -See Also: -o )help Vector -o )help FlexibleArray -o )show OneDimensionalArray -o $AXIOM/doc/src/algebra/array1.spad.dvi - -@ -<>= -"ARRAY1" -> "A1AGG" -"OneDimensionalArray(a:Type)" -> "OneDimensionalArrayAggregate(a:Type)" -@ -<>= -)abbrev domain ARRAY1 OneDimensionalArray -++ This is the domain of 1-based one dimensional arrays - -OneDimensionalArray(S:Type): Exports == Implementation where - ARRAYMININDEX ==> 1 -- if you want to change this, be my guest - Exports == OneDimensionalArrayAggregate S with - oneDimensionalArray: List S -> % - ++ oneDimensionalArray(l) creates an array from a list of elements l - ++ - ++X oneDimensionalArray [i**2 for i in 1..10] - - oneDimensionalArray: (NonNegativeInteger, S) -> % - ++ oneDimensionalArray(n,s) creates an array from n copies of element s - ++ - ++X oneDimensionalArray(10,0.0) - - Implementation == IndexedOneDimensionalArray(S, ARRAYMININDEX) add - oneDimensionalArray(u) == - n := #u - n = 0 => empty() - a := new(n, first u) - for i in 2..n for x in rest u repeat a.i := x - a - oneDimensionalArray(n,s) == new(n,s) - -@ \section{package ARRAY12 OneDimensionalArrayFunctions2} <>= "ARRAY12" -> "PACKAGE" @@ -1231,13 +154,7 @@ OneDimensionalArrayFunctions2(A, B): Exports == Implementation where <<*>>= <> -<> <> -<> -<> -<> -<> -<> <> --%% TupleFunctions2 diff --git a/src/algebra/array2.spad.pamphlet b/src/algebra/array2.spad.pamphlet deleted file mode 100644 index bc45d6e..0000000 --- a/src/algebra/array2.spad.pamphlet +++ /dev/null @@ -1,654 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra array2.spad} -\author{The Axiom Team} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{domain IIARRAY2 InnerIndexedTwoDimensionalArray} -This is an internal type which provides an implementation of -2-dimensional arrays as PrimitiveArray's of PrimitiveArray's. -<>= -"IIARRAY2" -> "ARR2CAT" -"InnerIndexedTwoDimensionalArray(a:Type,b:Integer,c:Integer,d:FiniteLinearAggregate(a),e:FiniteLinearAggregate(a))" --> "TwoDimensionalArrayCategory(a:Type,b:FiniteLinearAggregate(a),c:FiniteLinearAggregate(a))" -"InnerIndexedTwoDimensionalArray(a:Type,b:Integer,c:Integer,d:IndexedOneDimensionalArray(a,b),e:IndexedOneDimensionalArray(a,c))" --> "InnerIndexedTwoDimensionalArray(a:Type,b:Integer,c:Integer,d:FiniteLinearAggregate(a),e:FiniteLinearAggregate(a))" -"InnerIndexedTwoDimensionalArray(a:Type,1,1,b:OneDimensionalArray(a),c:OneDimensionalArray(a))" --> "InnerIndexedTwoDimensionalArray(a:Type,b:Integer,c:Integer,d:FiniteLinearAggregate(a),e:FiniteLinearAggregate(a))" -@ -<>= -)abbrev domain IIARRAY2 InnerIndexedTwoDimensionalArray -InnerIndexedTwoDimensionalArray(R,mnRow,mnCol,Row,Col):_ - Exports == Implementation where - R : Type - mnRow, mnCol : Integer - Row : FiniteLinearAggregate R - Col : FiniteLinearAggregate R - - Exports ==> TwoDimensionalArrayCategory(R,Row,Col) - - Implementation ==> add - - Rep := PrimitiveArray PrimitiveArray R - ---% Predicates - - empty? m == empty?(m)$Rep - ---% Primitive array creation - - empty() == empty()$Rep - - new(rows,cols,a) == - rows = 0 => - error "new: arrays with zero rows are not supported" --- cols = 0 => --- error "new: arrays with zero columns are not supported" - arr : PrimitiveArray PrimitiveArray R := new(rows,empty()) - for i in minIndex(arr)..maxIndex(arr) repeat - qsetelt_!(arr,i,new(cols,a)) - arr - ---% Size inquiries - - minRowIndex m == mnRow - minColIndex m == mnCol - maxRowIndex m == nrows m + mnRow - 1 - maxColIndex m == ncols m + mnCol - 1 - - nrows m == (# m)$Rep - - ncols m == - empty? m => 0 - # m(minIndex(m)$Rep) - ---% Part selection/assignment - - qelt(m,i,j) == - qelt(qelt(m,i - minRowIndex m)$Rep,j - minColIndex m) - - elt(m:%,i:Integer,j:Integer) == - i < minRowIndex(m) or i > maxRowIndex(m) => - error "elt: index out of range" - j < minColIndex(m) or j > maxColIndex(m) => - error "elt: index out of range" - qelt(m,i,j) - - qsetelt_!(m,i,j,r) == - setelt(qelt(m,i - minRowIndex m)$Rep,j - minColIndex m,r) - - setelt(m:%,i:Integer,j:Integer,r:R) == - i < minRowIndex(m) or i > maxRowIndex(m) => - error "setelt: index out of range" - j < minColIndex(m) or j > maxColIndex(m) => - error "setelt: index out of range" - qsetelt_!(m,i,j,r) - - if R has SetCategory then - latex(m : %) : String == - s : String := "\left[ \begin{array}{" - j : Integer - for j in minColIndex(m)..maxColIndex(m) repeat - s := concat(s,"c")$String - s := concat(s,"} ")$String - i : Integer - for i in minRowIndex(m)..maxRowIndex(m) repeat - for j in minColIndex(m)..maxColIndex(m) repeat - s := concat(s, latex(qelt(m,i,j))$R)$String - if j < maxColIndex(m) then s := concat(s, " & ")$String - if i < maxRowIndex(m) then s := concat(s, " \\ ")$String - concat(s, "\end{array} \right]")$String - -@ -\section{domain IARRAY2 IndexedTwoDimensionalArray} -An IndexedTwoDimensionalArray is a 2-dimensional array where -the minimal row and column indices are parameters of the type. -Rows and columns are returned as IndexedOneDimensionalArray's with -minimal indices matching those of the IndexedTwoDimensionalArray. -The index of the 'first' row may be obtained by calling the -function 'minRowIndex'. The index of the 'first' column may -be obtained by calling the function 'minColIndex'. The index of -the first element of a 'Row' is the same as the index of the -first column in an array and vice versa. -<>= -"IARRAY2" -> "ARR2CAT" -"IndexedTwoDimensionalArray(a:Type,b:Integer,c:Integer)" -> -"TwoDimensionalArrayCategory(a:Type,d:IndexedOneDimensionalArray(a,b),e:IndexedOneDimensionalArray(a,c))" -"IARRAY2" -> "IIARRAY2" -"IndexedTwoDimensionalArray(a:Type,b:Integer,c:Integer)" -> -"InnerIndexedTwoDimensionalArray(a:Type,b:Integer,c:Integer,d:IndexedOneDimensionalArray(a,b),e:IndexedOneDimensionalArray(a,c))" -@ -<>= -)abbrev domain IARRAY2 IndexedTwoDimensionalArray -IndexedTwoDimensionalArray(R,mnRow,mnCol):Exports == Implementation where - R : Type - mnRow, mnCol : Integer - Row ==> IndexedOneDimensionalArray(R,mnCol) - Col ==> IndexedOneDimensionalArray(R,mnRow) - - Exports ==> TwoDimensionalArrayCategory(R,Row,Col) - - Implementation ==> - InnerIndexedTwoDimensionalArray(R,mnRow,mnCol,Row,Col) - -@ -\section{domain ARRAY2 TwoDimensionalArray} -<>= --- array2.spad.pamphlet TwoDimensionalArray.input -)spool TwoDimensionalArray.output -)set message test on -)set message auto off -)clear all ---S 1 of 20 -arr : ARRAY2 INT := new(5,4,0) ---R ---R ---R +0 0 0 0+ ---R | | ---R |0 0 0 0| ---R | | ---R (1) |0 0 0 0| ---R | | ---R |0 0 0 0| ---R | | ---R +0 0 0 0+ ---R Type: TwoDimensionalArray Integer ---E 1 - ---S 2 of 20 -setelt(arr,1,1,17) ---R ---R ---R (2) 17 ---R Type: PositiveInteger ---E 2 - ---S 3 of 20 -arr ---R ---R ---R +17 0 0 0+ ---R | | ---R |0 0 0 0| ---R | | ---R (3) |0 0 0 0| ---R | | ---R |0 0 0 0| ---R | | ---R +0 0 0 0+ ---R Type: TwoDimensionalArray Integer ---E 3 - ---S 4 of 20 -elt(arr,1,1) ---R ---R ---R (4) 17 ---R Type: PositiveInteger ---E 4 - ---S 5 of 20 -arr(3,2) := 15 ---R ---R ---R (5) 15 ---R Type: PositiveInteger ---E 5 - ---S 6 of 20 -arr(3,2) ---R ---R ---R (6) 15 ---R Type: PositiveInteger ---E 6 - ---S 7 of 20 -row(arr,1) ---R ---R ---R (7) [17,0,0,0] ---R Type: OneDimensionalArray Integer ---E 7 - ---S 8 of 20 -column(arr,1) ---R ---R ---R (8) [17,0,0,0,0] ---R Type: OneDimensionalArray Integer ---E 8 - ---S 9 of 20 -nrows(arr) ---R ---R ---R (9) 5 ---R Type: PositiveInteger ---E 9 - ---S 10 of 20 -ncols(arr) ---R ---R ---R (10) 4 ---R Type: PositiveInteger ---E 10 - ---S 11 of 20 -map(-,arr) ---R ---R ---R +- 17 0 0 0+ ---R | | ---R | 0 0 0 0| ---R | | ---R (11) | 0 - 15 0 0| ---R | | ---R | 0 0 0 0| ---R | | ---R + 0 0 0 0+ ---R Type: TwoDimensionalArray Integer ---E 11 - ---S 12 of 20 -map((x +-> x + x),arr) ---R ---R ---R +34 0 0 0+ ---R | | ---R |0 0 0 0| ---R | | ---R (12) |0 30 0 0| ---R | | ---R |0 0 0 0| ---R | | ---R +0 0 0 0+ ---R Type: TwoDimensionalArray Integer ---E 12 - ---S 13 of 20 -arrc := copy(arr) ---R ---R ---R +17 0 0 0+ ---R | | ---R |0 0 0 0| ---R | | ---R (13) |0 15 0 0| ---R | | ---R |0 0 0 0| ---R | | ---R +0 0 0 0+ ---R Type: TwoDimensionalArray Integer ---E 13 - ---S 14 of 20 -map!(-,arrc) ---R ---R ---R +- 17 0 0 0+ ---R | | ---R | 0 0 0 0| ---R | | ---R (14) | 0 - 15 0 0| ---R | | ---R | 0 0 0 0| ---R | | ---R + 0 0 0 0+ ---R Type: TwoDimensionalArray Integer ---E 14 - ---S 15 of 20 -arrc ---R ---R ---R +- 17 0 0 0+ ---R | | ---R | 0 0 0 0| ---R | | ---R (15) | 0 - 15 0 0| ---R | | ---R | 0 0 0 0| ---R | | ---R + 0 0 0 0+ ---R Type: TwoDimensionalArray Integer ---E 15 - ---S 16 of 20 -arr ---R ---R ---R +17 0 0 0+ ---R | | ---R |0 0 0 0| ---R | | ---R (16) |0 15 0 0| ---R | | ---R |0 0 0 0| ---R | | ---R +0 0 0 0+ ---R Type: TwoDimensionalArray Integer ---E 16 - ---S 17 of 20 -member?(17,arr) ---R ---R ---R (17) true ---R Type: Boolean ---E 17 - ---S 18 of 20 -member?(10317,arr) ---R ---R ---R (18) false ---R Type: Boolean ---E 18 - ---S 19 of 20 -count(17,arr) ---R ---R ---R (19) 1 ---R Type: PositiveInteger ---E 19 - ---S 20 of 20 -count(0,arr) ---R ---R ---R (20) 18 ---R Type: PositiveInteger ---E 20 -)spool -)lisp (bye) -@ -<>= -==================================================================== -TwoDimensionalArray examples -==================================================================== - -The TwoDimensionalArray domain is used for storing data in a two -dimensional data structure indexed by row and by column. Such an -array is a homogeneous data structure in that all the entries of the -array must belong to the same Axiom domain.. Each array has a fixed -number of rows and columns specified by the user and arrays are not -extensible. In Axiom, the indexing of two-dimensional arrays is -one-based. This means that both the "first" row of an array and the -"first" column of an array are given the index 1. Thus, the entry -in the upper left corner of an array is in position (1,1). - -The operation new creates an array with a specified number of rows and -columns and fills the components of that array with a specified entry. -The arguments of this operation specify the number of rows, the number -of columns, and the entry. - -This creates a five-by-four array of integers, all of whose entries are -zero. - - arr : ARRAY2 INT := new(5,4,0) - +0 0 0 0+ - | | - |0 0 0 0| - | | - |0 0 0 0| - | | - |0 0 0 0| - | | - +0 0 0 0+ - Type: TwoDimensionalArray Integer - -The entries of this array can be set to other integers using setelt. - -Issue this to set the element in the upper left corner of this array to 17. - - setelt(arr,1,1,17) - 17 - Type: PositiveInteger - -Now the first element of the array is 17. - - arr - +17 0 0 0+ - | | - |0 0 0 0| - | | - |0 0 0 0| - | | - |0 0 0 0| - | | - +0 0 0 0+ - Type: TwoDimensionalArray Integer - -Likewise, elements of an array are extracted using the operation elt. - - elt(arr,1,1) - 17 - Type: PositiveInteger - -Another way to use these two operations is as follows. This sets the -element in position (3,2) of the array to 15. - - arr(3,2) := 15 - 15 - Type: PositiveInteger - -This extracts the element in position (3,2) of the array. - - arr(3,2) - 15 - Type: PositiveInteger - -The operations elt and setelt come equipped with an error check which -verifies that the indices are in the proper ranges. For example, the -above array has five rows and four columns, so if you ask for the -entry in position (6,2) with arr(6,2) Axiom displays an error message. -If there is no need for an error check, you can call the operations qelt -and qsetelt which provide the same functionality but without the error -check. Typically, these operations are called in well-tested programs. - -The operations row and column extract rows and columns, respectively, -and return objects of OneDimensionalArray with the same underlying -element type. - - row(arr,1) - [17,0,0,0] - Type: OneDimensionalArray Integer - - column(arr,1) - [17,0,0,0,0] - Type: OneDimensionalArray Integer - -You can determine the dimensions of an array by calling the operations -nrows and ncols, which return the number of rows and columns, respectively. - - nrows(arr) - 5 - Type: PositiveInteger - - ncols(arr) - 4 - Type: PositiveInteger - -To apply an operation to every element of an array, use map. This -creates a new array. This expression negates every element. - - map(-,arr) - +- 17 0 0 0+ - | | - | 0 0 0 0| - | | - | 0 - 15 0 0| - | | - | 0 0 0 0| - | | - + 0 0 0 0+ - Type: TwoDimensionalArray Integer - -This creates an array where all the elements are doubled. - - map((x +-> x + x),arr) - +34 0 0 0+ - | | - |0 0 0 0| - | | - |0 30 0 0| - | | - |0 0 0 0| - | | - +0 0 0 0+ - Type: TwoDimensionalArray Integer - -To change the array destructively, use map instead of map. If you -need to make a copy of any array, use copy. - - arrc := copy(arr) - +17 0 0 0+ - | | - |0 0 0 0| - | | - |0 15 0 0| - | | - |0 0 0 0| - | | - +0 0 0 0+ - Type: TwoDimensionalArray Integer - - map!(-,arrc) - +- 17 0 0 0+ - | | - | 0 0 0 0| - | | - | 0 - 15 0 0| - | | - | 0 0 0 0| - | | - + 0 0 0 0+ - Type: TwoDimensionalArray Integer - - arrc - +- 17 0 0 0+ - | | - | 0 0 0 0| - | | - | 0 - 15 0 0| - | | - | 0 0 0 0| - | | - + 0 0 0 0+ - Type: TwoDimensionalArray Integer - - arr - +17 0 0 0+ - | | - |0 0 0 0| - | | - |0 15 0 0| - | | - |0 0 0 0| - | | - +0 0 0 0+ - Type: TwoDimensionalArray Integer - -Use member? to see if a given element is in an array. - - member?(17,arr) - true - Type: Boolean - - member?(10317,arr) - false - Type: Boolean - -To see how many times an element appears in an array, use count. - - count(17,arr) - 1 - Type: PositiveInteger - - count(0,arr) - 18 - Type: PositiveInteger - -See Also: -o )help Matrix -o )help OneDimensionalArray -o )show TwoDimensionalArray -o $AXIOM/doc/src/algebra/array2.spad.dvi - -@ -<>= -"ARRAY2" -> "ARR2CAT" -"TwoDimensionalArray(a:Type)" -> -"TwoDimensionalArrayCategory(a:Type,b:FiniteLinearAggregate(a),c:FiniteLinearAggregate(a))" -"ARRAY2" -> "IIARRAY2" -"TwoDimensionalArray(a:Type)" -> -"InnerIndexedTwoDimensionalArray(a:Type,1,1,b:OneDimensionalArray(a),c:OneDimensionalArray(a))" -@ -<>= -)abbrev domain ARRAY2 TwoDimensionalArray -TwoDimensionalArray(R):Exports == Implementation where - ++ A TwoDimensionalArray is a two dimensional array with - ++ 1-based indexing for both rows and columns. - R : Type - Row ==> OneDimensionalArray R - Col ==> OneDimensionalArray R - - Exports ==> TwoDimensionalArrayCategory(R,Row,Col) with - shallowlyMutable - ++ One may destructively alter TwoDimensionalArray's. - - Implementation ==> InnerIndexedTwoDimensionalArray(R,1,1,Row,Col) - -@ -\section{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. -@ -<<*>>= - -<> -<> -<> -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/algebra/asp.spad.pamphlet b/src/algebra/asp.spad.pamphlet deleted file mode 100644 index 220c4ab..0000000 --- a/src/algebra/asp.spad.pamphlet +++ /dev/null @@ -1,4297 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra asp.spad} -\author{Mike Dewar, Grant Keady, Godfrey Nolan} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{domain ASP1 Asp1} -<>= -)abbrev domain ASP1 Asp1 -++ Author: Mike Dewar, Grant Keady, Godfrey Nolan -++ Date Created: Mar 1993 -++ Date Last Updated: 18 March 1994 -++ 6 October 1994 -++ Related Constructors: FortranFunctionCategory, FortranProgramCategory. -++ Description: -++ \spadtype{Asp1} produces Fortran for Type 1 ASPs, needed for various -++ NAG routines. Type 1 ASPs take a univariate expression (in the symbol -++ X) and turn it into a Fortran Function like the following: -++\begin{verbatim} -++ DOUBLE PRECISION FUNCTION F(X) -++ DOUBLE PRECISION X -++ F=DSIN(X) -++ RETURN -++ END -++\end{verbatim} - - -Asp1(name): Exports == Implementation where - name : Symbol - - FEXPR ==> FortranExpression - FST ==> FortranScalarType - FT ==> FortranType - SYMTAB ==> SymbolTable - RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode)) - FRAC ==> Fraction - POLY ==> Polynomial - EXPR ==> Expression - INT ==> Integer - FLOAT ==> Float - - Exports ==> FortranFunctionCategory with - coerce : FEXPR(['X],[],MachineFloat) -> $ - ++coerce(f) takes an object from the appropriate instantiation of - ++\spadtype{FortranExpression} and turns it into an ASP. - - Implementation ==> add - - -- Build Symbol Table for Rep - syms : SYMTAB := empty()$SYMTAB - declare!(X,fortranReal()$FT,syms)$SYMTAB - real : FST := "real"::FST - - Rep := FortranProgram(name,[real]$Union(fst:FST,void:"void"),[X],syms) - - retract(u:FRAC POLY INT):$ == (retract(u)@FEXPR(['X],[],MachineFloat))::$ - retractIfCan(u:FRAC POLY INT):Union($,"failed") == - foo : Union(FEXPR(['X],[],MachineFloat),"failed") - foo := retractIfCan(u)$FEXPR(['X],[],MachineFloat) - foo case "failed" => "failed" - foo::FEXPR(['X],[],MachineFloat)::$ - - retract(u:FRAC POLY FLOAT):$ == (retract(u)@FEXPR(['X],[],MachineFloat))::$ - retractIfCan(u:FRAC POLY FLOAT):Union($,"failed") == - foo : Union(FEXPR(['X],[],MachineFloat),"failed") - foo := retractIfCan(u)$FEXPR(['X],[],MachineFloat) - foo case "failed" => "failed" - foo::FEXPR(['X],[],MachineFloat)::$ - - retract(u:EXPR FLOAT):$ == (retract(u)@FEXPR(['X],[],MachineFloat))::$ - retractIfCan(u:EXPR FLOAT):Union($,"failed") == - foo : Union(FEXPR(['X],[],MachineFloat),"failed") - foo := retractIfCan(u)$FEXPR(['X],[],MachineFloat) - foo case "failed" => "failed" - foo::FEXPR(['X],[],MachineFloat)::$ - - retract(u:EXPR INT):$ == (retract(u)@FEXPR(['X],[],MachineFloat))::$ - retractIfCan(u:EXPR INT):Union($,"failed") == - foo : Union(FEXPR(['X],[],MachineFloat),"failed") - foo := retractIfCan(u)$FEXPR(['X],[],MachineFloat) - foo case "failed" => "failed" - foo::FEXPR(['X],[],MachineFloat)::$ - - retract(u:POLY FLOAT):$ == (retract(u)@FEXPR(['X],[],MachineFloat))::$ - retractIfCan(u:POLY FLOAT):Union($,"failed") == - foo : Union(FEXPR(['X],[],MachineFloat),"failed") - foo := retractIfCan(u)$FEXPR(['X],[],MachineFloat) - foo case "failed" => "failed" - foo::FEXPR(['X],[],MachineFloat)::$ - - retract(u:POLY INT):$ == (retract(u)@FEXPR(['X],[],MachineFloat))::$ - retractIfCan(u:POLY INT):Union($,"failed") == - foo : Union(FEXPR(['X],[],MachineFloat),"failed") - foo := retractIfCan(u)$FEXPR(['X],[],MachineFloat) - foo case "failed" => "failed" - foo::FEXPR(['X],[],MachineFloat)::$ - - coerce(u:FEXPR(['X],[],MachineFloat)):$ == - coerce((u::Expression(MachineFloat))$FEXPR(['X],[],MachineFloat))$Rep - - coerce(c:List FortranCode):$ == coerce(c)$Rep - - coerce(r:RSFC):$ == coerce(r)$Rep - - coerce(c:FortranCode):$ == coerce(c)$Rep - - coerce(u:$):OutputForm == coerce(u)$Rep - - outputAsFortran(u):Void == - p := checkPrecision()$NAGLinkSupportPackage - outputAsFortran(u)$Rep - p => restorePrecision()$NAGLinkSupportPackage - -@ -\section{domain ASP10 Asp10} -<>= -)abbrev domain ASP10 Asp10 -++ Author: Mike Dewar and Godfrey Nolan -++ Date Created: Mar 1993 -++ Date Last Updated: 18 March 1994 -++ 6 October 1994 -++ Related Constructors: FortranVectorFunctionCategory, FortranProgramCategory -++ Description: -++\spadtype{ASP10} produces Fortran for Type 10 ASPs, needed for NAG routine -++\axiomOpFrom{d02kef}{d02Package}. This ASP computes the values of a set of functions, for example: -++\begin{verbatim} -++ SUBROUTINE COEFFN(P,Q,DQDL,X,ELAM,JINT) -++ DOUBLE PRECISION ELAM,P,Q,X,DQDL -++ INTEGER JINT -++ P=1.0D0 -++ Q=((-1.0D0*X**3)+ELAM*X*X-2.0D0)/(X*X) -++ DQDL=1.0D0 -++ RETURN -++ END -++\end{verbatim} - -Asp10(name): Exports == Implementation where - name : Symbol - - FST ==> FortranScalarType - FT ==> FortranType - SYMTAB ==> SymbolTable - EXF ==> Expression Float - RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode)) - FEXPR ==> FortranExpression(['JINT,'X,'ELAM],[],MFLOAT) - MFLOAT ==> MachineFloat - FRAC ==> Fraction - POLY ==> Polynomial - EXPR ==> Expression - INT ==> Integer - FLOAT ==> Float - VEC ==> Vector - VF2 ==> VectorFunctions2 - - Exports ==> FortranVectorFunctionCategory with - coerce : Vector FEXPR -> % - ++coerce(f) takes objects from the appropriate instantiation of - ++\spadtype{FortranExpression} and turns them into an ASP. - - Implementation ==> add - - real : FST := "real"::FST - syms : SYMTAB := empty()$SYMTAB - declare!(P,fortranReal()$FT,syms)$SYMTAB - declare!(Q,fortranReal()$FT,syms)$SYMTAB - declare!(DQDL,fortranReal()$FT,syms)$SYMTAB - declare!(X,fortranReal()$FT,syms)$SYMTAB - declare!(ELAM,fortranReal()$FT,syms)$SYMTAB - declare!(JINT,fortranInteger()$FT,syms)$SYMTAB - Rep := FortranProgram(name,["void"]$Union(fst:FST,void:"void"), - [P,Q,DQDL,X,ELAM,JINT],syms) - - retract(u:VEC FRAC POLY INT):$ == - v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY INT,FEXPR) - v::$ - - retractIfCan(u:VEC FRAC POLY INT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY INT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC FRAC POLY FLOAT):$ == - v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY FLOAT,FEXPR) - v::$ - - retractIfCan(u:VEC FRAC POLY FLOAT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC EXPR INT):$ == - v : VEC FEXPR := map(retract,u)$VF2(EXPR INT,FEXPR) - v::$ - - retractIfCan(u:VEC EXPR INT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR INT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC EXPR FLOAT):$ == - v : VEC FEXPR := map(retract,u)$VF2(EXPR FLOAT,FEXPR) - v::$ - - retractIfCan(u:VEC EXPR FLOAT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR FLOAT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC POLY INT):$ == - v : VEC FEXPR := map(retract,u)$VF2(POLY INT,FEXPR) - v::$ - - retractIfCan(u:VEC POLY INT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY INT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC POLY FLOAT):$ == - v : VEC FEXPR := map(retract,u)$VF2(POLY FLOAT,FEXPR) - v::$ - - retractIfCan(u:VEC POLY FLOAT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY FLOAT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - coerce(c:FortranCode):% == coerce(c)$Rep - - coerce(r:RSFC):% == coerce(r)$Rep - - coerce(c:List FortranCode):% == coerce(c)$Rep - - -- To help the poor old compiler! - localAssign(s:Symbol,u:Expression MFLOAT):FortranCode == - assign(s,u)$FortranCode - - coerce(u:Vector FEXPR):% == - import Vector FEXPR - not (#u = 3) => error "Incorrect Dimension For Vector" - ([localAssign(P,elt(u,1)::Expression MFLOAT),_ - localAssign(Q,elt(u,2)::Expression MFLOAT),_ - localAssign(DQDL,elt(u,3)::Expression MFLOAT),_ - returns()$FortranCode ]$List(FortranCode))::Rep - - coerce(u:%):OutputForm == coerce(u)$Rep - - outputAsFortran(u):Void == - p := checkPrecision()$NAGLinkSupportPackage - outputAsFortran(u)$Rep - p => restorePrecision()$NAGLinkSupportPackage - -@ -\section{domain ASP12 Asp12} -<>= -)abbrev domain ASP12 Asp12 -++ Author: Mike Dewar and Godfrey Nolan -++ Date Created: Oct 1993 -++ Date Last Updated: 18 March 1994 -++ 21 June 1994 Changed print to printStatement -++ Related Constructors: -++ Description: -++\spadtype{Asp12} produces Fortran for Type 12 ASPs, needed for NAG routine -++\axiomOpFrom{d02kef}{d02Package} etc., for example: -++\begin{verbatim} -++ SUBROUTINE MONIT (MAXIT,IFLAG,ELAM,FINFO) -++ DOUBLE PRECISION ELAM,FINFO(15) -++ INTEGER MAXIT,IFLAG -++ IF(MAXIT.EQ.-1)THEN -++ PRINT*,"Output from Monit" -++ ENDIF -++ PRINT*,MAXIT,IFLAG,ELAM,(FINFO(I),I=1,4) -++ RETURN -++ END -++\end{verbatim} -Asp12(name): Exports == Implementation where - name : Symbol - - O ==> OutputForm - S ==> Symbol - FST ==> FortranScalarType - FT ==> FortranType - FC ==> FortranCode - SYMTAB ==> SymbolTable - EXI ==> Expression Integer - RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode)) - U ==> Union(I: Expression Integer,F: Expression Float,_ - CF: Expression Complex Float,switch:Switch) - UFST ==> Union(fst:FST,void:"void") - - Exports ==> FortranProgramCategory with - outputAsFortran:() -> Void - ++outputAsFortran() generates the default code for \spadtype{ASP12}. - - Implementation ==> add - - import FC - import Switch - - real : FST := "real"::FST - syms : SYMTAB := empty()$SYMTAB - declare!(MAXIT,fortranInteger()$FT,syms)$SYMTAB - declare!(IFLAG,fortranInteger()$FT,syms)$SYMTAB - declare!(ELAM,fortranReal()$FT,syms)$SYMTAB - fType : FT := construct([real]$UFST,["15"::Symbol],false)$FT - declare!(FINFO,fType,syms)$SYMTAB - Rep := FortranProgram(name,["void"]$UFST,[MAXIT,IFLAG,ELAM,FINFO],syms) - - -- eqn : O := (I::O)=(1@Integer::EXI::O) - code:=([cond(EQ([MAXIT@S::EXI]$U,[-1::EXI]$U), - printStatement(["_"Output from Monit_""::O])), - printStatement([MAXIT::O,IFLAG::O,ELAM::O,subscript("(FINFO"::S,[I::O])::O,"I=1"::S::O,"4)"::S::O]), -- YUCK! - returns()]$List(FortranCode))::Rep - - coerce(u:%):OutputForm == coerce(u)$Rep - - outputAsFortran(u:%):Void == outputAsFortran(u)$Rep - outputAsFortran():Void == outputAsFortran(code)$Rep - -@ -\section{domain ASP19 Asp19} -<>= -)abbrev domain ASP19 Asp19 -++ Author: Mike Dewar, Godfrey Nolan, Grant Keady -++ Date Created: Mar 1993 -++ Date Last Updated: 18 March 1994 -++ 6 October 1994 -++ Related Constructors: FortranVectorFunctionCategory, FortranProgramCategory -++ Description: -++\spadtype{Asp19} produces Fortran for Type 19 ASPs, evaluating a set of -++functions and their jacobian at a given point, for example: -++\begin{verbatim} -++ SUBROUTINE LSFUN2(M,N,XC,FVECC,FJACC,LJC) -++ DOUBLE PRECISION FVECC(M),FJACC(LJC,N),XC(N) -++ INTEGER M,N,LJC -++ INTEGER I,J -++ DO 25003 I=1,LJC -++ DO 25004 J=1,N -++ FJACC(I,J)=0.0D0 -++25004 CONTINUE -++25003 CONTINUE -++ FVECC(1)=((XC(1)-0.14D0)*XC(3)+(15.0D0*XC(1)-2.1D0)*XC(2)+1.0D0)/( -++ &XC(3)+15.0D0*XC(2)) -++ FVECC(2)=((XC(1)-0.18D0)*XC(3)+(7.0D0*XC(1)-1.26D0)*XC(2)+1.0D0)/( -++ &XC(3)+7.0D0*XC(2)) -++ FVECC(3)=((XC(1)-0.22D0)*XC(3)+(4.333333333333333D0*XC(1)-0.953333 -++ &3333333333D0)*XC(2)+1.0D0)/(XC(3)+4.333333333333333D0*XC(2)) -++ FVECC(4)=((XC(1)-0.25D0)*XC(3)+(3.0D0*XC(1)-0.75D0)*XC(2)+1.0D0)/( -++ &XC(3)+3.0D0*XC(2)) -++ FVECC(5)=((XC(1)-0.29D0)*XC(3)+(2.2D0*XC(1)-0.6379999999999999D0)* -++ &XC(2)+1.0D0)/(XC(3)+2.2D0*XC(2)) -++ FVECC(6)=((XC(1)-0.32D0)*XC(3)+(1.666666666666667D0*XC(1)-0.533333 -++ &3333333333D0)*XC(2)+1.0D0)/(XC(3)+1.666666666666667D0*XC(2)) -++ FVECC(7)=((XC(1)-0.35D0)*XC(3)+(1.285714285714286D0*XC(1)-0.45D0)* -++ &XC(2)+1.0D0)/(XC(3)+1.285714285714286D0*XC(2)) -++ FVECC(8)=((XC(1)-0.39D0)*XC(3)+(XC(1)-0.39D0)*XC(2)+1.0D0)/(XC(3)+ -++ &XC(2)) -++ FVECC(9)=((XC(1)-0.37D0)*XC(3)+(XC(1)-0.37D0)*XC(2)+1.285714285714 -++ &286D0)/(XC(3)+XC(2)) -++ FVECC(10)=((XC(1)-0.58D0)*XC(3)+(XC(1)-0.58D0)*XC(2)+1.66666666666 -++ &6667D0)/(XC(3)+XC(2)) -++ FVECC(11)=((XC(1)-0.73D0)*XC(3)+(XC(1)-0.73D0)*XC(2)+2.2D0)/(XC(3) -++ &+XC(2)) -++ FVECC(12)=((XC(1)-0.96D0)*XC(3)+(XC(1)-0.96D0)*XC(2)+3.0D0)/(XC(3) -++ &+XC(2)) -++ FVECC(13)=((XC(1)-1.34D0)*XC(3)+(XC(1)-1.34D0)*XC(2)+4.33333333333 -++ &3333D0)/(XC(3)+XC(2)) -++ FVECC(14)=((XC(1)-2.1D0)*XC(3)+(XC(1)-2.1D0)*XC(2)+7.0D0)/(XC(3)+X -++ &C(2)) -++ FVECC(15)=((XC(1)-4.39D0)*XC(3)+(XC(1)-4.39D0)*XC(2)+15.0D0)/(XC(3 -++ &)+XC(2)) -++ FJACC(1,1)=1.0D0 -++ FJACC(1,2)=-15.0D0/(XC(3)**2+30.0D0*XC(2)*XC(3)+225.0D0*XC(2)**2) -++ FJACC(1,3)=-1.0D0/(XC(3)**2+30.0D0*XC(2)*XC(3)+225.0D0*XC(2)**2) -++ FJACC(2,1)=1.0D0 -++ FJACC(2,2)=-7.0D0/(XC(3)**2+14.0D0*XC(2)*XC(3)+49.0D0*XC(2)**2) -++ FJACC(2,3)=-1.0D0/(XC(3)**2+14.0D0*XC(2)*XC(3)+49.0D0*XC(2)**2) -++ FJACC(3,1)=1.0D0 -++ FJACC(3,2)=((-0.1110223024625157D-15*XC(3))-4.333333333333333D0)/( -++ &XC(3)**2+8.666666666666666D0*XC(2)*XC(3)+18.77777777777778D0*XC(2) -++ &**2) -++ FJACC(3,3)=(0.1110223024625157D-15*XC(2)-1.0D0)/(XC(3)**2+8.666666 -++ &666666666D0*XC(2)*XC(3)+18.77777777777778D0*XC(2)**2) -++ FJACC(4,1)=1.0D0 -++ FJACC(4,2)=-3.0D0/(XC(3)**2+6.0D0*XC(2)*XC(3)+9.0D0*XC(2)**2) -++ FJACC(4,3)=-1.0D0/(XC(3)**2+6.0D0*XC(2)*XC(3)+9.0D0*XC(2)**2) -++ FJACC(5,1)=1.0D0 -++ FJACC(5,2)=((-0.1110223024625157D-15*XC(3))-2.2D0)/(XC(3)**2+4.399 -++ &999999999999D0*XC(2)*XC(3)+4.839999999999998D0*XC(2)**2) -++ FJACC(5,3)=(0.1110223024625157D-15*XC(2)-1.0D0)/(XC(3)**2+4.399999 -++ &999999999D0*XC(2)*XC(3)+4.839999999999998D0*XC(2)**2) -++ FJACC(6,1)=1.0D0 -++ FJACC(6,2)=((-0.2220446049250313D-15*XC(3))-1.666666666666667D0)/( -++ &XC(3)**2+3.333333333333333D0*XC(2)*XC(3)+2.777777777777777D0*XC(2) -++ &**2) -++ FJACC(6,3)=(0.2220446049250313D-15*XC(2)-1.0D0)/(XC(3)**2+3.333333 -++ &333333333D0*XC(2)*XC(3)+2.777777777777777D0*XC(2)**2) -++ FJACC(7,1)=1.0D0 -++ FJACC(7,2)=((-0.5551115123125783D-16*XC(3))-1.285714285714286D0)/( -++ &XC(3)**2+2.571428571428571D0*XC(2)*XC(3)+1.653061224489796D0*XC(2) -++ &**2) -++ FJACC(7,3)=(0.5551115123125783D-16*XC(2)-1.0D0)/(XC(3)**2+2.571428 -++ &571428571D0*XC(2)*XC(3)+1.653061224489796D0*XC(2)**2) -++ FJACC(8,1)=1.0D0 -++ FJACC(8,2)=-1.0D0/(XC(3)**2+2.0D0*XC(2)*XC(3)+XC(2)**2) -++ FJACC(8,3)=-1.0D0/(XC(3)**2+2.0D0*XC(2)*XC(3)+XC(2)**2) -++ FJACC(9,1)=1.0D0 -++ FJACC(9,2)=-1.285714285714286D0/(XC(3)**2+2.0D0*XC(2)*XC(3)+XC(2)* -++ &*2) -++ FJACC(9,3)=-1.285714285714286D0/(XC(3)**2+2.0D0*XC(2)*XC(3)+XC(2)* -++ &*2) -++ FJACC(10,1)=1.0D0 -++ FJACC(10,2)=-1.666666666666667D0/(XC(3)**2+2.0D0*XC(2)*XC(3)+XC(2) -++ &**2) -++ FJACC(10,3)=-1.666666666666667D0/(XC(3)**2+2.0D0*XC(2)*XC(3)+XC(2) -++ &**2) -++ FJACC(11,1)=1.0D0 -++ FJACC(11,2)=-2.2D0/(XC(3)**2+2.0D0*XC(2)*XC(3)+XC(2)**2) -++ FJACC(11,3)=-2.2D0/(XC(3)**2+2.0D0*XC(2)*XC(3)+XC(2)**2) -++ FJACC(12,1)=1.0D0 -++ FJACC(12,2)=-3.0D0/(XC(3)**2+2.0D0*XC(2)*XC(3)+XC(2)**2) -++ FJACC(12,3)=-3.0D0/(XC(3)**2+2.0D0*XC(2)*XC(3)+XC(2)**2) -++ FJACC(13,1)=1.0D0 -++ FJACC(13,2)=-4.333333333333333D0/(XC(3)**2+2.0D0*XC(2)*XC(3)+XC(2) -++ &**2) -++ FJACC(13,3)=-4.333333333333333D0/(XC(3)**2+2.0D0*XC(2)*XC(3)+XC(2) -++ &**2) -++ FJACC(14,1)=1.0D0 -++ FJACC(14,2)=-7.0D0/(XC(3)**2+2.0D0*XC(2)*XC(3)+XC(2)**2) -++ FJACC(14,3)=-7.0D0/(XC(3)**2+2.0D0*XC(2)*XC(3)+XC(2)**2) -++ FJACC(15,1)=1.0D0 -++ FJACC(15,2)=-15.0D0/(XC(3)**2+2.0D0*XC(2)*XC(3)+XC(2)**2) -++ FJACC(15,3)=-15.0D0/(XC(3)**2+2.0D0*XC(2)*XC(3)+XC(2)**2) -++ RETURN -++ END -++\end{verbatim} - -Asp19(name): Exports == Implementation where - name : Symbol - - FST ==> FortranScalarType - FT ==> FortranType - FC ==> FortranCode - SYMTAB ==> SymbolTable - RSFC ==> Record(localSymbols:SymbolTable,code:List(FC)) - FSTU ==> Union(fst:FST,void:"void") - FRAC ==> Fraction - POLY ==> Polynomial - EXPR ==> Expression - INT ==> Integer - FLOAT ==> Float - MFLOAT ==> MachineFloat - VEC ==> Vector - VF2 ==> VectorFunctions2 - MF2 ==> MatrixCategoryFunctions2(FEXPR,VEC FEXPR,VEC FEXPR,Matrix FEXPR,EXPR MFLOAT,VEC EXPR MFLOAT,VEC EXPR MFLOAT,Matrix EXPR MFLOAT) - FEXPR ==> FortranExpression([],['XC],MFLOAT) - S ==> Symbol - - Exports ==> FortranVectorFunctionCategory with - coerce : VEC FEXPR -> $ - ++coerce(f) takes objects from the appropriate instantiation of - ++\spadtype{FortranExpression} and turns them into an ASP. - - Implementation ==> add - - real : FSTU := ["real"::FST]$FSTU - syms : SYMTAB := empty()$SYMTAB - declare!(M,fortranInteger()$FT,syms)$SYMTAB - declare!(N,fortranInteger()$FT,syms)$SYMTAB - declare!(LJC,fortranInteger()$FT,syms)$SYMTAB - xcType : FT := construct(real,[N],false)$FT - declare!(XC,xcType,syms)$SYMTAB - fveccType : FT := construct(real,[M],false)$FT - declare!(FVECC,fveccType,syms)$SYMTAB - fjaccType : FT := construct(real,[LJC,N],false)$FT - declare!(FJACC,fjaccType,syms)$SYMTAB - Rep := FortranProgram(name,["void"]$FSTU,[M,N,XC,FVECC,FJACC,LJC],syms) - - coerce(c:List FC):$ == coerce(c)$Rep - - coerce(r:RSFC):$ == coerce(r)$Rep - - coerce(c:FC):$ == coerce(c)$Rep - - -- Take a symbol, pull of the script and turn it into an integer!! - o2int(u:S):Integer == - o : OutputForm := first elt(scripts(u)$S,sub) - o pretend Integer - - -- To help the poor old compiler! - fexpr2expr(u:FEXPR):EXPR MFLOAT == coerce(u)$FEXPR - - localAssign1(s:S,j:Matrix FEXPR):FC == - j' : Matrix EXPR MFLOAT := map(fexpr2expr,j)$MF2 - assign(s,j')$FC - - localAssign2(s:S,j:VEC FEXPR):FC == - j' : VEC EXPR MFLOAT := map(fexpr2expr,j)$VF2(FEXPR,EXPR MFLOAT) - assign(s,j')$FC - - coerce(u:VEC FEXPR):$ == - -- First zero the Jacobian matrix in case we miss some derivatives which - -- are zero. - import POLY INT - seg1 : Segment (POLY INT) := segment(1::(POLY INT),LJC@S::(POLY INT)) - seg2 : Segment (POLY INT) := segment(1::(POLY INT),N@S::(POLY INT)) - s1 : SegmentBinding POLY INT := equation(I@S,seg1) - s2 : SegmentBinding POLY INT := equation(J@S,seg2) - as : FC := assign(FJACC,[I@S::(POLY INT),J@S::(POLY INT)],0.0::EXPR FLOAT) - clear : FC := forLoop(s1,forLoop(s2,as)) - j:Integer - x:S := XC::S - pu:List(S) := [] - -- Work out which variables appear in the expressions - for e in entries(u) repeat - pu := setUnion(pu,variables(e)$FEXPR) - scriptList : List Integer := map(o2int,pu)$ListFunctions2(S,Integer) - -- This should be the maximum XC_n which occurs (there may be others - -- which don't): - n:Integer := reduce(max,scriptList)$List(Integer) - p:List(S) := [] - for j in 1..n repeat p:= cons(subscript(x,[j::OutputForm])$S,p) - p:= reverse(p) - jac:Matrix(FEXPR) := _ - jacobian(u,p)$MultiVariableCalculusFunctions(S,FEXPR,VEC FEXPR,List(S)) - c1:FC := localAssign2(FVECC,u) - c2:FC := localAssign1(FJACC,jac) - [clear,c1,c2,returns()]$List(FC)::$ - - coerce(u:$):OutputForm == coerce(u)$Rep - - outputAsFortran(u):Void == - p := checkPrecision()$NAGLinkSupportPackage - outputAsFortran(u)$Rep - p => restorePrecision()$NAGLinkSupportPackage - - - retract(u:VEC FRAC POLY INT):$ == - v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY INT,FEXPR) - v::$ - - retractIfCan(u:VEC FRAC POLY INT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY INT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC FRAC POLY FLOAT):$ == - v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY FLOAT,FEXPR) - v::$ - - retractIfCan(u:VEC FRAC POLY FLOAT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC EXPR INT):$ == - v : VEC FEXPR := map(retract,u)$VF2(EXPR INT,FEXPR) - v::$ - - retractIfCan(u:VEC EXPR INT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR INT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC EXPR FLOAT):$ == - v : VEC FEXPR := map(retract,u)$VF2(EXPR FLOAT,FEXPR) - v::$ - - retractIfCan(u:VEC EXPR FLOAT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR FLOAT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC POLY INT):$ == - v : VEC FEXPR := map(retract,u)$VF2(POLY INT,FEXPR) - v::$ - - retractIfCan(u:VEC POLY INT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY INT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC POLY FLOAT):$ == - v : VEC FEXPR := map(retract,u)$VF2(POLY FLOAT,FEXPR) - v::$ - - retractIfCan(u:VEC POLY FLOAT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY FLOAT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - -@ -\section{domain ASP20 Asp20} -<>= -)abbrev domain ASP20 Asp20 -++ Author: Mike Dewar and Godfrey Nolan and Grant Keady -++ Date Created: Dec 1993 -++ Date Last Updated: 21 March 1994 -++ 6 October 1994 -++ Related Constructors: FortranVectorFunctionCategory, FortranProgramCategory -++ Description: -++\spadtype{Asp20} produces Fortran for Type 20 ASPs, for example: -++\begin{verbatim} -++ SUBROUTINE QPHESS(N,NROWH,NCOLH,JTHCOL,HESS,X,HX) -++ DOUBLE PRECISION HX(N),X(N),HESS(NROWH,NCOLH) -++ INTEGER JTHCOL,N,NROWH,NCOLH -++ HX(1)=2.0D0*X(1) -++ HX(2)=2.0D0*X(2) -++ HX(3)=2.0D0*X(4)+2.0D0*X(3) -++ HX(4)=2.0D0*X(4)+2.0D0*X(3) -++ HX(5)=2.0D0*X(5) -++ HX(6)=(-2.0D0*X(7))+(-2.0D0*X(6)) -++ HX(7)=(-2.0D0*X(7))+(-2.0D0*X(6)) -++ RETURN -++ END -++\end{verbatim} - -Asp20(name): Exports == Implementation where - name : Symbol - - FST ==> FortranScalarType - FT ==> FortranType - SYMTAB ==> SymbolTable - PI ==> PositiveInteger - UFST ==> Union(fst:FST,void:"void") - RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode)) - FRAC ==> Fraction - POLY ==> Polynomial - EXPR ==> Expression - INT ==> Integer - FLOAT ==> Float - VEC ==> Vector - MAT ==> Matrix - VF2 ==> VectorFunctions2 - MFLOAT ==> MachineFloat - FEXPR ==> FortranExpression([],['X,'HESS],MFLOAT) - O ==> OutputForm - M2 ==> MatrixCategoryFunctions2 - MF2a ==> M2(FRAC POLY INT,VEC FRAC POLY INT,VEC FRAC POLY INT, - MAT FRAC POLY INT,FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR) - MF2b ==> M2(FRAC POLY FLOAT,VEC FRAC POLY FLOAT,VEC FRAC POLY FLOAT, - MAT FRAC POLY FLOAT, FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR) - MF2c ==> M2(POLY INT,VEC POLY INT,VEC POLY INT,MAT POLY INT, - FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR) - MF2d ==> M2(POLY FLOAT,VEC POLY FLOAT,VEC POLY FLOAT, - MAT POLY FLOAT, FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR) - MF2e ==> M2(EXPR INT,VEC EXPR INT,VEC EXPR INT,MAT EXPR INT, - FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR) - MF2f ==> M2(EXPR FLOAT,VEC EXPR FLOAT,VEC EXPR FLOAT, - MAT EXPR FLOAT, FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR) - - - Exports ==> FortranMatrixFunctionCategory with - coerce: MAT FEXPR -> $ - ++coerce(f) takes objects from the appropriate instantiation of - ++\spadtype{FortranExpression} and turns them into an ASP. - - Implementation ==> add - - real : UFST := ["real"::FST]$UFST - syms : SYMTAB := empty() - declare!(N,fortranInteger(),syms)$SYMTAB - declare!(NROWH,fortranInteger(),syms)$SYMTAB - declare!(NCOLH,fortranInteger(),syms)$SYMTAB - declare!(JTHCOL,fortranInteger(),syms)$SYMTAB - hessType : FT := construct(real,[NROWH,NCOLH],false)$FT - declare!(HESS,hessType,syms)$SYMTAB - xType : FT := construct(real,[N],false)$FT - declare!(X,xType,syms)$SYMTAB - declare!(HX,xType,syms)$SYMTAB - Rep := FortranProgram(name,["void"]$UFST, - [N,NROWH,NCOLH,JTHCOL,HESS,X,HX],syms) - - coerce(c:List FortranCode):$ == coerce(c)$Rep - - coerce(r:RSFC):$ == coerce(r)$Rep - - coerce(c:FortranCode):$ == coerce(c)$Rep - - -- To help the poor old compiler! - fexpr2expr(u:FEXPR):EXPR MFLOAT == coerce(u)$FEXPR - - localAssign(s:Symbol,j:VEC FEXPR):FortranCode == - j' : VEC EXPR MFLOAT := map(fexpr2expr,j)$VF2(FEXPR,EXPR MFLOAT) - assign(s,j')$FortranCode - - coerce(u:MAT FEXPR):$ == - j:Integer - x:Symbol := X::Symbol - n := nrows(u)::PI - p:VEC FEXPR := [retract(subscript(x,[j::O])$Symbol)@FEXPR for j in 1..n] - prod:VEC FEXPR := u*p - ([localAssign(HX,prod),returns()$FortranCode]$List(FortranCode))::$ - - retract(u:MAT FRAC POLY INT):$ == - v : MAT FEXPR := map(retract,u)$MF2a - v::$ - - retractIfCan(u:MAT FRAC POLY INT):Union($,"failed") == - v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2a - v case "failed" => "failed" - (v::MAT FEXPR)::$ - - retract(u:MAT FRAC POLY FLOAT):$ == - v : MAT FEXPR := map(retract,u)$MF2b - v::$ - - retractIfCan(u:MAT FRAC POLY FLOAT):Union($,"failed") == - v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2b - v case "failed" => "failed" - (v::MAT FEXPR)::$ - - retract(u:MAT EXPR INT):$ == - v : MAT FEXPR := map(retract,u)$MF2e - v::$ - - retractIfCan(u:MAT EXPR INT):Union($,"failed") == - v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2e - v case "failed" => "failed" - (v::MAT FEXPR)::$ - - retract(u:MAT EXPR FLOAT):$ == - v : MAT FEXPR := map(retract,u)$MF2f - v::$ - - retractIfCan(u:MAT EXPR FLOAT):Union($,"failed") == - v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2f - v case "failed" => "failed" - (v::MAT FEXPR)::$ - - retract(u:MAT POLY INT):$ == - v : MAT FEXPR := map(retract,u)$MF2c - v::$ - - retractIfCan(u:MAT POLY INT):Union($,"failed") == - v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2c - v case "failed" => "failed" - (v::MAT FEXPR)::$ - - retract(u:MAT POLY FLOAT):$ == - v : MAT FEXPR := map(retract,u)$MF2d - v::$ - - retractIfCan(u:MAT POLY FLOAT):Union($,"failed") == - v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2d - v case "failed" => "failed" - (v::MAT FEXPR)::$ - - coerce(u:$):O == coerce(u)$Rep - - outputAsFortran(u):Void == - p := checkPrecision()$NAGLinkSupportPackage - outputAsFortran(u)$Rep - p => restorePrecision()$NAGLinkSupportPackage - -@ -\section{domain ASP24 Asp24} -<>= -)abbrev domain ASP24 Asp24 -++ Author: Mike Dewar, Grant Keady and Godfrey Nolan -++ Date Created: Mar 1993 -++ Date Last Updated: 21 March 1994 -++ 6 October 1994 -++ Related Constructors: FortranScalarFunctionCategory, FortranProgramCategory -++ Description: -++\spadtype{Asp24} produces Fortran for Type 24 ASPs which evaluate a -++multivariate function at a point (needed for NAG routine \axiomOpFrom{e04jaf}{e04Package}), for example: -++\begin{verbatim} -++ SUBROUTINE FUNCT1(N,XC,FC) -++ DOUBLE PRECISION FC,XC(N) -++ INTEGER N -++ FC=10.0D0*XC(4)**4+(-40.0D0*XC(1)*XC(4)**3)+(60.0D0*XC(1)**2+5 -++ &.0D0)*XC(4)**2+((-10.0D0*XC(3))+(-40.0D0*XC(1)**3))*XC(4)+16.0D0*X -++ &C(3)**4+(-32.0D0*XC(2)*XC(3)**3)+(24.0D0*XC(2)**2+5.0D0)*XC(3)**2+ -++ &(-8.0D0*XC(2)**3*XC(3))+XC(2)**4+100.0D0*XC(2)**2+20.0D0*XC(1)*XC( -++ &2)+10.0D0*XC(1)**4+XC(1)**2 -++ RETURN -++ END -++\end{verbatim} - -Asp24(name): Exports == Implementation where - name : Symbol - - FST ==> FortranScalarType - FT ==> FortranType - SYMTAB ==> SymbolTable - RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode)) - FSTU ==> Union(fst:FST,void:"void") - FEXPR ==> FortranExpression([],['XC],MachineFloat) - FRAC ==> Fraction - POLY ==> Polynomial - EXPR ==> Expression - INT ==> Integer - FLOAT ==> Float - - Exports ==> FortranFunctionCategory with - coerce : FEXPR -> $ - ++ coerce(f) takes an object from the appropriate instantiation of - ++ \spadtype{FortranExpression} and turns it into an ASP. - - - Implementation ==> add - - - real : FSTU := ["real"::FST]$FSTU - syms : SYMTAB := empty() - declare!(N,fortranInteger(),syms)$SYMTAB - xcType : FT := construct(real,[N::Symbol],false)$FT - declare!(XC,xcType,syms)$SYMTAB - declare!(FC,fortranReal(),syms)$SYMTAB - Rep := FortranProgram(name,["void"]$FSTU,[N,XC,FC],syms) - - coerce(c:List FortranCode):$ == coerce(c)$Rep - - coerce(r:RSFC):$ == coerce(r)$Rep - - coerce(c:FortranCode):$ == coerce(c)$Rep - - coerce(u:FEXPR):$ == - coerce(assign(FC,u::Expression(MachineFloat))$FortranCode)$Rep - - retract(u:FRAC POLY INT):$ == (retract(u)@FEXPR)::$ - retractIfCan(u:FRAC POLY INT):Union($,"failed") == - foo : Union(FEXPR,"failed") - foo := retractIfCan(u)$FEXPR - foo case "failed" => "failed" - (foo::FEXPR)::$ - - retract(u:FRAC POLY FLOAT):$ == (retract(u)@FEXPR)::$ - retractIfCan(u:FRAC POLY FLOAT):Union($,"failed") == - foo : Union(FEXPR,"failed") - foo := retractIfCan(u)$FEXPR - foo case "failed" => "failed" - (foo::FEXPR)::$ - - retract(u:EXPR FLOAT):$ == (retract(u)@FEXPR)::$ - retractIfCan(u:EXPR FLOAT):Union($,"failed") == - foo : Union(FEXPR,"failed") - foo := retractIfCan(u)$FEXPR - foo case "failed" => "failed" - (foo::FEXPR)::$ - - retract(u:EXPR INT):$ == (retract(u)@FEXPR)::$ - retractIfCan(u:EXPR INT):Union($,"failed") == - foo : Union(FEXPR,"failed") - foo := retractIfCan(u)$FEXPR - foo case "failed" => "failed" - (foo::FEXPR)::$ - - retract(u:POLY FLOAT):$ == (retract(u)@FEXPR)::$ - retractIfCan(u:POLY FLOAT):Union($,"failed") == - foo : Union(FEXPR,"failed") - foo := retractIfCan(u)$FEXPR - foo case "failed" => "failed" - (foo::FEXPR)::$ - - retract(u:POLY INT):$ == (retract(u)@FEXPR)::$ - retractIfCan(u:POLY INT):Union($,"failed") == - foo : Union(FEXPR,"failed") - foo := retractIfCan(u)$FEXPR - foo case "failed" => "failed" - (foo::FEXPR)::$ - - coerce(u:$):OutputForm == coerce(u)$Rep - - outputAsFortran(u):Void == - p := checkPrecision()$NAGLinkSupportPackage - outputAsFortran(u)$Rep - p => restorePrecision()$NAGLinkSupportPackage - -@ -\section{domain ASP27 Asp27} -<>= -)abbrev domain ASP27 Asp27 -++ Author: Mike Dewar and Godfrey Nolan -++ Date Created: Nov 1993 -++ Date Last Updated: 27 April 1994 -++ 6 October 1994 -++ Related Constructors: FortranScalarFunctionCategory, FortranProgramCategory -++ Description: -++\spadtype{Asp27} produces Fortran for Type 27 ASPs, needed for NAG routine -++\axiomOpFrom{f02fjf}{f02Package} ,for example: -++\begin{verbatim} -++ FUNCTION DOT(IFLAG,N,Z,W,RWORK,LRWORK,IWORK,LIWORK) -++ DOUBLE PRECISION W(N),Z(N),RWORK(LRWORK) -++ INTEGER N,LIWORK,IFLAG,LRWORK,IWORK(LIWORK) -++ DOT=(W(16)+(-0.5D0*W(15)))*Z(16)+((-0.5D0*W(16))+W(15)+(-0.5D0*W(1 -++ &4)))*Z(15)+((-0.5D0*W(15))+W(14)+(-0.5D0*W(13)))*Z(14)+((-0.5D0*W( -++ &14))+W(13)+(-0.5D0*W(12)))*Z(13)+((-0.5D0*W(13))+W(12)+(-0.5D0*W(1 -++ &1)))*Z(12)+((-0.5D0*W(12))+W(11)+(-0.5D0*W(10)))*Z(11)+((-0.5D0*W( -++ &11))+W(10)+(-0.5D0*W(9)))*Z(10)+((-0.5D0*W(10))+W(9)+(-0.5D0*W(8)) -++ &)*Z(9)+((-0.5D0*W(9))+W(8)+(-0.5D0*W(7)))*Z(8)+((-0.5D0*W(8))+W(7) -++ &+(-0.5D0*W(6)))*Z(7)+((-0.5D0*W(7))+W(6)+(-0.5D0*W(5)))*Z(6)+((-0. -++ &5D0*W(6))+W(5)+(-0.5D0*W(4)))*Z(5)+((-0.5D0*W(5))+W(4)+(-0.5D0*W(3 -++ &)))*Z(4)+((-0.5D0*W(4))+W(3)+(-0.5D0*W(2)))*Z(3)+((-0.5D0*W(3))+W( -++ &2)+(-0.5D0*W(1)))*Z(2)+((-0.5D0*W(2))+W(1))*Z(1) -++ RETURN -++ END -++\end{verbatim} - -Asp27(name): Exports == Implementation where - name : Symbol - - O ==> OutputForm - FST ==> FortranScalarType - FT ==> FortranType - SYMTAB ==> SymbolTable - UFST ==> Union(fst:FST,void:"void") - FC ==> FortranCode - PI ==> PositiveInteger - RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode)) - EXPR ==> Expression - MAT ==> Matrix - MFLOAT ==> MachineFloat - - - - Exports == FortranMatrixCategory - - Implementation == add - - - real : UFST := ["real"::FST]$UFST - integer : UFST := ["integer"::FST]$UFST - syms : SYMTAB := empty()$SYMTAB - declare!(IFLAG,fortranInteger(),syms)$SYMTAB - declare!(N,fortranInteger(),syms)$SYMTAB - declare!(LRWORK,fortranInteger(),syms)$SYMTAB - declare!(LIWORK,fortranInteger(),syms)$SYMTAB - zType : FT := construct(real,[N],false)$FT - declare!(Z,zType,syms)$SYMTAB - declare!(W,zType,syms)$SYMTAB - rType : FT := construct(real,[LRWORK],false)$FT - declare!(RWORK,rType,syms)$SYMTAB - iType : FT := construct(integer,[LIWORK],false)$FT - declare!(IWORK,iType,syms)$SYMTAB - Rep := FortranProgram(name,real, - [IFLAG,N,Z,W,RWORK,LRWORK,IWORK,LIWORK],syms) - - -- To help the poor old compiler! - localCoerce(u:Symbol):EXPR(MFLOAT) == coerce(u)$EXPR(MFLOAT) - - coerce (u:MAT MFLOAT):$ == - Ws: Symbol := W - Zs: Symbol := Z - code : List FC - l:EXPR MFLOAT := "+"/ _ - [("+"/[localCoerce(elt(Ws,[j::O])$Symbol) * u(j,i)_ - for j in 1..nrows(u)::PI])_ - *localCoerce(elt(Zs,[i::O])$Symbol) for i in 1..ncols(u)::PI] - c := assign(name,l)$FC - code := [c,returns()]$List(FC) - code::$ - - coerce(c:List FortranCode):$ == coerce(c)$Rep - - coerce(r:RSFC):$ == coerce(r)$Rep - - coerce(c:FortranCode):$ == coerce(c)$Rep - - coerce(u:$):OutputForm == coerce(u)$Rep - - outputAsFortran(u):Void == - p := checkPrecision()$NAGLinkSupportPackage - outputAsFortran(u)$Rep - p => restorePrecision()$NAGLinkSupportPackage - -@ -\section{domain ASP28 Asp28} -<>= -)abbrev domain ASP28 Asp28 -++ Author: Mike Dewar -++ Date Created: 21 March 1994 -++ Date Last Updated: 28 April 1994 -++ 6 October 1994 -++ Related Constructors: FortranVectorFunctionCategory, FortranProgramCategory -++ Description: -++\spadtype{Asp28} produces Fortran for Type 28 ASPs, used in NAG routine -++\axiomOpFrom{f02fjf}{f02Package}, for example: -++\begin{verbatim} -++ SUBROUTINE IMAGE(IFLAG,N,Z,W,RWORK,LRWORK,IWORK,LIWORK) -++ DOUBLE PRECISION Z(N),W(N),IWORK(LRWORK),RWORK(LRWORK) -++ INTEGER N,LIWORK,IFLAG,LRWORK -++ W(1)=0.01707454969713436D0*Z(16)+0.001747395874954051D0*Z(15)+0.00 -++ &2106973900813502D0*Z(14)+0.002957434991769087D0*Z(13)+(-0.00700554 -++ &0882865317D0*Z(12))+(-0.01219194009813166D0*Z(11))+0.0037230647365 -++ &3087D0*Z(10)+0.04932374658377151D0*Z(9)+(-0.03586220812223305D0*Z( -++ &8))+(-0.04723268012114625D0*Z(7))+(-0.02434652144032987D0*Z(6))+0. -++ &2264766947290192D0*Z(5)+(-0.1385343580686922D0*Z(4))+(-0.116530050 -++ &8238904D0*Z(3))+(-0.2803531651057233D0*Z(2))+1.019463911841327D0*Z -++ &(1) -++ W(2)=0.0227345011107737D0*Z(16)+0.008812321197398072D0*Z(15)+0.010 -++ &94012210519586D0*Z(14)+(-0.01764072463999744D0*Z(13))+(-0.01357136 -++ &72105995D0*Z(12))+0.00157466157362272D0*Z(11)+0.05258889186338282D -++ &0*Z(10)+(-0.01981532388243379D0*Z(9))+(-0.06095390688679697D0*Z(8) -++ &)+(-0.04153119955569051D0*Z(7))+0.2176561076571465D0*Z(6)+(-0.0532 -++ &5555586632358D0*Z(5))+(-0.1688977368984641D0*Z(4))+(-0.32440166056 -++ &67343D0*Z(3))+0.9128222941872173D0*Z(2)+(-0.2419652703415429D0*Z(1 -++ &)) -++ W(3)=0.03371198197190302D0*Z(16)+0.02021603150122265D0*Z(15)+(-0.0 -++ &06607305534689702D0*Z(14))+(-0.03032392238968179D0*Z(13))+0.002033 -++ &305231024948D0*Z(12)+0.05375944956767728D0*Z(11)+(-0.0163213312502 -++ &9967D0*Z(10))+(-0.05483186562035512D0*Z(9))+(-0.04901428822579872D -++ &0*Z(8))+0.2091097927887612D0*Z(7)+(-0.05760560341383113D0*Z(6))+(- -++ &0.1236679206156403D0*Z(5))+(-0.3523683853026259D0*Z(4))+0.88929961 -++ &32269974D0*Z(3)+(-0.2995429545781457D0*Z(2))+(-0.02986582812574917 -++ &D0*Z(1)) -++ W(4)=0.05141563713660119D0*Z(16)+0.005239165960779299D0*Z(15)+(-0. -++ &01623427735779699D0*Z(14))+(-0.01965809746040371D0*Z(13))+0.054688 -++ &97337339577D0*Z(12)+(-0.014224695935687D0*Z(11))+(-0.0505181779315 -++ &6355D0*Z(10))+(-0.04353074206076491D0*Z(9))+0.2012230497530726D0*Z -++ &(8)+(-0.06630874514535952D0*Z(7))+(-0.1280829963720053D0*Z(6))+(-0 -++ &.305169742604165D0*Z(5))+0.8600427128450191D0*Z(4)+(-0.32415033802 -++ &68184D0*Z(3))+(-0.09033531980693314D0*Z(2))+0.09089205517109111D0* -++ &Z(1) -++ W(5)=0.04556369767776375D0*Z(16)+(-0.001822737697581869D0*Z(15))+( -++ &-0.002512226501941856D0*Z(14))+0.02947046460707379D0*Z(13)+(-0.014 -++ &45079632086177D0*Z(12))+(-0.05034242196614937D0*Z(11))+(-0.0376966 -++ &3291725935D0*Z(10))+0.2171103102175198D0*Z(9)+(-0.0824949256021352 -++ &4D0*Z(8))+(-0.1473995209288945D0*Z(7))+(-0.315042193418466D0*Z(6)) -++ &+0.9591623347824002D0*Z(5)+(-0.3852396953763045D0*Z(4))+(-0.141718 -++ &5427288274D0*Z(3))+(-0.03423495461011043D0*Z(2))+0.319820917706851 -++ &6D0*Z(1) -++ W(6)=0.04015147277405744D0*Z(16)+0.01328585741341559D0*Z(15)+0.048 -++ &26082005465965D0*Z(14)+(-0.04319641116207706D0*Z(13))+(-0.04931323 -++ &319055762D0*Z(12))+(-0.03526886317505474D0*Z(11))+0.22295383396730 -++ &01D0*Z(10)+(-0.07375317649315155D0*Z(9))+(-0.1589391311991561D0*Z( -++ &8))+(-0.328001910890377D0*Z(7))+0.952576555482747D0*Z(6)+(-0.31583 -++ &09975786731D0*Z(5))+(-0.1846882042225383D0*Z(4))+(-0.0703762046700 -++ &4427D0*Z(3))+0.2311852964327382D0*Z(2)+0.04254083491825025D0*Z(1) -++ W(7)=0.06069778964023718D0*Z(16)+0.06681263884671322D0*Z(15)+(-0.0 -++ &2113506688615768D0*Z(14))+(-0.083996867458326D0*Z(13))+(-0.0329843 -++ &8523869648D0*Z(12))+0.2276878326327734D0*Z(11)+(-0.067356038933017 -++ &95D0*Z(10))+(-0.1559813965382218D0*Z(9))+(-0.3363262957694705D0*Z( -++ &8))+0.9442791158560948D0*Z(7)+(-0.3199955249404657D0*Z(6))+(-0.136 -++ &2463839920727D0*Z(5))+(-0.1006185171570586D0*Z(4))+0.2057504515015 -++ &423D0*Z(3)+(-0.02065879269286707D0*Z(2))+0.03160990266745513D0*Z(1 -++ &) -++ W(8)=0.126386868896738D0*Z(16)+0.002563370039476418D0*Z(15)+(-0.05 -++ &581757739455641D0*Z(14))+(-0.07777893205900685D0*Z(13))+0.23117338 -++ &45834199D0*Z(12)+(-0.06031581134427592D0*Z(11))+(-0.14805474755869 -++ &52D0*Z(10))+(-0.3364014128402243D0*Z(9))+0.9364014128402244D0*Z(8) -++ &+(-0.3269452524413048D0*Z(7))+(-0.1396841886557241D0*Z(6))+(-0.056 -++ &1733845834199D0*Z(5))+0.1777789320590069D0*Z(4)+(-0.04418242260544 -++ &359D0*Z(3))+(-0.02756337003947642D0*Z(2))+0.07361313110326199D0*Z( -++ &1) -++ W(9)=0.07361313110326199D0*Z(16)+(-0.02756337003947642D0*Z(15))+(- -++ &0.04418242260544359D0*Z(14))+0.1777789320590069D0*Z(13)+(-0.056173 -++ &3845834199D0*Z(12))+(-0.1396841886557241D0*Z(11))+(-0.326945252441 -++ &3048D0*Z(10))+0.9364014128402244D0*Z(9)+(-0.3364014128402243D0*Z(8 -++ &))+(-0.1480547475586952D0*Z(7))+(-0.06031581134427592D0*Z(6))+0.23 -++ &11733845834199D0*Z(5)+(-0.07777893205900685D0*Z(4))+(-0.0558175773 -++ &9455641D0*Z(3))+0.002563370039476418D0*Z(2)+0.126386868896738D0*Z( -++ &1) -++ W(10)=0.03160990266745513D0*Z(16)+(-0.02065879269286707D0*Z(15))+0 -++ &.2057504515015423D0*Z(14)+(-0.1006185171570586D0*Z(13))+(-0.136246 -++ &3839920727D0*Z(12))+(-0.3199955249404657D0*Z(11))+0.94427911585609 -++ &48D0*Z(10)+(-0.3363262957694705D0*Z(9))+(-0.1559813965382218D0*Z(8 -++ &))+(-0.06735603893301795D0*Z(7))+0.2276878326327734D0*Z(6)+(-0.032 -++ &98438523869648D0*Z(5))+(-0.083996867458326D0*Z(4))+(-0.02113506688 -++ &615768D0*Z(3))+0.06681263884671322D0*Z(2)+0.06069778964023718D0*Z( -++ &1) -++ W(11)=0.04254083491825025D0*Z(16)+0.2311852964327382D0*Z(15)+(-0.0 -++ &7037620467004427D0*Z(14))+(-0.1846882042225383D0*Z(13))+(-0.315830 -++ &9975786731D0*Z(12))+0.952576555482747D0*Z(11)+(-0.328001910890377D -++ &0*Z(10))+(-0.1589391311991561D0*Z(9))+(-0.07375317649315155D0*Z(8) -++ &)+0.2229538339673001D0*Z(7)+(-0.03526886317505474D0*Z(6))+(-0.0493 -++ &1323319055762D0*Z(5))+(-0.04319641116207706D0*Z(4))+0.048260820054 -++ &65965D0*Z(3)+0.01328585741341559D0*Z(2)+0.04015147277405744D0*Z(1) -++ W(12)=0.3198209177068516D0*Z(16)+(-0.03423495461011043D0*Z(15))+(- -++ &0.1417185427288274D0*Z(14))+(-0.3852396953763045D0*Z(13))+0.959162 -++ &3347824002D0*Z(12)+(-0.315042193418466D0*Z(11))+(-0.14739952092889 -++ &45D0*Z(10))+(-0.08249492560213524D0*Z(9))+0.2171103102175198D0*Z(8 -++ &)+(-0.03769663291725935D0*Z(7))+(-0.05034242196614937D0*Z(6))+(-0. -++ &01445079632086177D0*Z(5))+0.02947046460707379D0*Z(4)+(-0.002512226 -++ &501941856D0*Z(3))+(-0.001822737697581869D0*Z(2))+0.045563697677763 -++ &75D0*Z(1) -++ W(13)=0.09089205517109111D0*Z(16)+(-0.09033531980693314D0*Z(15))+( -++ &-0.3241503380268184D0*Z(14))+0.8600427128450191D0*Z(13)+(-0.305169 -++ &742604165D0*Z(12))+(-0.1280829963720053D0*Z(11))+(-0.0663087451453 -++ &5952D0*Z(10))+0.2012230497530726D0*Z(9)+(-0.04353074206076491D0*Z( -++ &8))+(-0.05051817793156355D0*Z(7))+(-0.014224695935687D0*Z(6))+0.05 -++ &468897337339577D0*Z(5)+(-0.01965809746040371D0*Z(4))+(-0.016234277 -++ &35779699D0*Z(3))+0.005239165960779299D0*Z(2)+0.05141563713660119D0 -++ &*Z(1) -++ W(14)=(-0.02986582812574917D0*Z(16))+(-0.2995429545781457D0*Z(15)) -++ &+0.8892996132269974D0*Z(14)+(-0.3523683853026259D0*Z(13))+(-0.1236 -++ &679206156403D0*Z(12))+(-0.05760560341383113D0*Z(11))+0.20910979278 -++ &87612D0*Z(10)+(-0.04901428822579872D0*Z(9))+(-0.05483186562035512D -++ &0*Z(8))+(-0.01632133125029967D0*Z(7))+0.05375944956767728D0*Z(6)+0 -++ &.002033305231024948D0*Z(5)+(-0.03032392238968179D0*Z(4))+(-0.00660 -++ &7305534689702D0*Z(3))+0.02021603150122265D0*Z(2)+0.033711981971903 -++ &02D0*Z(1) -++ W(15)=(-0.2419652703415429D0*Z(16))+0.9128222941872173D0*Z(15)+(-0 -++ &.3244016605667343D0*Z(14))+(-0.1688977368984641D0*Z(13))+(-0.05325 -++ &555586632358D0*Z(12))+0.2176561076571465D0*Z(11)+(-0.0415311995556 -++ &9051D0*Z(10))+(-0.06095390688679697D0*Z(9))+(-0.01981532388243379D -++ &0*Z(8))+0.05258889186338282D0*Z(7)+0.00157466157362272D0*Z(6)+(-0. -++ &0135713672105995D0*Z(5))+(-0.01764072463999744D0*Z(4))+0.010940122 -++ &10519586D0*Z(3)+0.008812321197398072D0*Z(2)+0.0227345011107737D0*Z -++ &(1) -++ W(16)=1.019463911841327D0*Z(16)+(-0.2803531651057233D0*Z(15))+(-0. -++ &1165300508238904D0*Z(14))+(-0.1385343580686922D0*Z(13))+0.22647669 -++ &47290192D0*Z(12)+(-0.02434652144032987D0*Z(11))+(-0.04723268012114 -++ &625D0*Z(10))+(-0.03586220812223305D0*Z(9))+0.04932374658377151D0*Z -++ &(8)+0.00372306473653087D0*Z(7)+(-0.01219194009813166D0*Z(6))+(-0.0 -++ &07005540882865317D0*Z(5))+0.002957434991769087D0*Z(4)+0.0021069739 -++ &00813502D0*Z(3)+0.001747395874954051D0*Z(2)+0.01707454969713436D0* -++ &Z(1) -++ RETURN -++ END -++\end{verbatim} - -Asp28(name): Exports == Implementation where - name : Symbol - - FST ==> FortranScalarType - FT ==> FortranType - SYMTAB ==> SymbolTable - FC ==> FortranCode - PI ==> PositiveInteger - RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode)) - EXPR ==> Expression - MFLOAT ==> MachineFloat - VEC ==> Vector - UFST ==> Union(fst:FST,void:"void") - MAT ==> Matrix - - Exports == FortranMatrixCategory - - Implementation == add - - - real : UFST := ["real"::FST]$UFST - syms : SYMTAB := empty() - declare!(IFLAG,fortranInteger(),syms)$SYMTAB - declare!(N,fortranInteger(),syms)$SYMTAB - declare!(LRWORK,fortranInteger(),syms)$SYMTAB - declare!(LIWORK,fortranInteger(),syms)$SYMTAB - xType : FT := construct(real,[N],false)$FT - declare!(Z,xType,syms)$SYMTAB - declare!(W,xType,syms)$SYMTAB - rType : FT := construct(real,[LRWORK],false)$FT - declare!(RWORK,rType,syms)$SYMTAB - iType : FT := construct(real,[LIWORK],false)$FT - declare!(IWORK,rType,syms)$SYMTAB - Rep := FortranProgram(name,["void"]$UFST, - [IFLAG,N,Z,W,RWORK,LRWORK,IWORK,LIWORK],syms) - - -- To help the poor old compiler! - localCoerce(u:Symbol):EXPR(MFLOAT) == coerce(u)$EXPR(MFLOAT) - - coerce (u:MAT MFLOAT):$ == - Zs: Symbol := Z - code : List FC - r: List EXPR MFLOAT - r := ["+"/[u(j,i)*localCoerce(elt(Zs,[i::OutputForm])$Symbol)_ - for i in 1..ncols(u)$MAT(MFLOAT)::PI]_ - for j in 1..nrows(u)$MAT(MFLOAT)::PI] - code := [assign(W@Symbol,vector(r)$VEC(EXPR MFLOAT)),returns()]$List(FC) - code::$ - - coerce(c:FortranCode):$ == coerce(c)$Rep - - coerce(r:RSFC):$ == coerce(r)$Rep - - coerce(c:List FortranCode):$ == coerce(c)$Rep - - coerce(u:$):OutputForm == coerce(u)$Rep - - outputAsFortran(u):Void == - p := checkPrecision()$NAGLinkSupportPackage - outputAsFortran(u)$Rep - p => restorePrecision()$NAGLinkSupportPackage - -@ -\section{domain ASP29 Asp29} -<>= -)abbrev domain ASP29 Asp29 -++ Author: Mike Dewar and Godfrey Nolan -++ Date Created: Nov 1993 -++ Date Last Updated: 18 March 1994 -++ Related Constructors: FortranScalarFunctionCategory, FortranProgramCategory -++ Description: -++\spadtype{Asp29} produces Fortran for Type 29 ASPs, needed for NAG routine -++\axiomOpFrom{f02fjf}{f02Package}, for example: -++\begin{verbatim} -++ SUBROUTINE MONIT(ISTATE,NEXTIT,NEVALS,NEVECS,K,F,D) -++ DOUBLE PRECISION D(K),F(K) -++ INTEGER K,NEXTIT,NEVALS,NVECS,ISTATE -++ CALL F02FJZ(ISTATE,NEXTIT,NEVALS,NEVECS,K,F,D) -++ RETURN -++ END -++\end{verbatim} - -Asp29(name): Exports == Implementation where - name : Symbol - - FST ==> FortranScalarType - FT ==> FortranType - FSTU ==> Union(fst:FST,void:"void") - SYMTAB ==> SymbolTable - FC ==> FortranCode - PI ==> PositiveInteger - EXF ==> Expression Float - EXI ==> Expression Integer - VEF ==> Vector Expression Float - VEI ==> Vector Expression Integer - MEI ==> Matrix Expression Integer - MEF ==> Matrix Expression Float - UEXPR ==> Union(I: Expression Integer,F: Expression Float,_ - CF: Expression Complex Float) - RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode)) - - Exports == FortranProgramCategory with - outputAsFortran:() -> Void - ++outputAsFortran() generates the default code for \spadtype{ASP29}. - - - Implementation == add - - import FST - import FT - import FC - import SYMTAB - - real : FSTU := ["real"::FST]$FSTU - integer : FSTU := ["integer"::FST]$FSTU - syms : SYMTAB := empty() - declare!(ISTATE,fortranInteger(),syms) - declare!(NEXTIT,fortranInteger(),syms) - declare!(NEVALS,fortranInteger(),syms) - declare!(NVECS,fortranInteger(),syms) - declare!(K,fortranInteger(),syms) - kType : FT := construct(real,[K],false)$FT - declare!(F,kType,syms) - declare!(D,kType,syms) - Rep := FortranProgram(name,["void"]$FSTU, - [ISTATE,NEXTIT,NEVALS,NEVECS,K,F,D],syms) - - - outputAsFortran():Void == - callOne := call("F02FJZ(ISTATE,NEXTIT,NEVALS,NEVECS,K,F,D)") - code : List FC := [callOne,returns()]$List(FC) - outputAsFortran(coerce(code)@Rep)$Rep - -@ -\section{domain ASP30 Asp30} -<>= -)abbrev domain ASP30 Asp30 -++ Author: Mike Dewar and Godfrey Nolan -++ Date Created: Nov 1993 -++ Date Last Updated: 28 March 1994 -++ 6 October 1994 -++ Related Constructors: FortranScalarFunctionCategory, FortranProgramCategory -++ Description: -++\spadtype{Asp30} produces Fortran for Type 30 ASPs, needed for NAG routine -++\axiomOpFrom{f04qaf}{f04Package}, for example: -++\begin{verbatim} -++ SUBROUTINE APROD(MODE,M,N,X,Y,RWORK,LRWORK,IWORK,LIWORK) -++ DOUBLE PRECISION X(N),Y(M),RWORK(LRWORK) -++ INTEGER M,N,LIWORK,IFAIL,LRWORK,IWORK(LIWORK),MODE -++ DOUBLE PRECISION A(5,5) -++ EXTERNAL F06PAF -++ A(1,1)=1.0D0 -++ A(1,2)=0.0D0 -++ A(1,3)=0.0D0 -++ A(1,4)=-1.0D0 -++ A(1,5)=0.0D0 -++ A(2,1)=0.0D0 -++ A(2,2)=1.0D0 -++ A(2,3)=0.0D0 -++ A(2,4)=0.0D0 -++ A(2,5)=-1.0D0 -++ A(3,1)=0.0D0 -++ A(3,2)=0.0D0 -++ A(3,3)=1.0D0 -++ A(3,4)=-1.0D0 -++ A(3,5)=0.0D0 -++ A(4,1)=-1.0D0 -++ A(4,2)=0.0D0 -++ A(4,3)=-1.0D0 -++ A(4,4)=4.0D0 -++ A(4,5)=-1.0D0 -++ A(5,1)=0.0D0 -++ A(5,2)=-1.0D0 -++ A(5,3)=0.0D0 -++ A(5,4)=-1.0D0 -++ A(5,5)=4.0D0 -++ IF(MODE.EQ.1)THEN -++ CALL F06PAF('N',M,N,1.0D0,A,M,X,1,1.0D0,Y,1) -++ ELSEIF(MODE.EQ.2)THEN -++ CALL F06PAF('T',M,N,1.0D0,A,M,Y,1,1.0D0,X,1) -++ ENDIF -++ RETURN -++ END -++\end{verbatim} - -Asp30(name): Exports == Implementation where - name : Symbol - - FST ==> FortranScalarType - FT ==> FortranType - SYMTAB ==> SymbolTable - FC ==> FortranCode - PI ==> PositiveInteger - RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode)) - UFST ==> Union(fst:FST,void:"void") - MAT ==> Matrix - MFLOAT ==> MachineFloat - EXI ==> Expression Integer - UEXPR ==> Union(I:Expression Integer,F:Expression Float,_ - CF:Expression Complex Float,switch:Switch) - S ==> Symbol - - Exports == FortranMatrixCategory - - Implementation == add - - import FC - import FT - import Switch - - real : UFST := ["real"::FST]$UFST - integer : UFST := ["integer"::FST]$UFST - syms : SYMTAB := empty()$SYMTAB - declare!(MODE,fortranInteger()$FT,syms)$SYMTAB - declare!(M,fortranInteger()$FT,syms)$SYMTAB - declare!(N,fortranInteger()$FT,syms)$SYMTAB - declare!(LRWORK,fortranInteger()$FT,syms)$SYMTAB - declare!(LIWORK,fortranInteger()$FT,syms)$SYMTAB - xType : FT := construct(real,[N],false)$FT - declare!(X,xType,syms)$SYMTAB - yType : FT := construct(real,[M],false)$FT - declare!(Y,yType,syms)$SYMTAB - rType : FT := construct(real,[LRWORK],false)$FT - declare!(RWORK,rType,syms)$SYMTAB - iType : FT := construct(integer,[LIWORK],false)$FT - declare!(IWORK,iType,syms)$SYMTAB - declare!(IFAIL,fortranInteger()$FT,syms)$SYMTAB - Rep := FortranProgram(name,["void"]$UFST, - [MODE,M,N,X,Y,RWORK,LRWORK,IWORK,LIWORK],syms) - - coerce(a:MAT MFLOAT):$ == - locals : SYMTAB := empty() - numRows := nrows(a) :: Polynomial Integer - numCols := ncols(a) :: Polynomial Integer - declare!(A,[real,[numRows,numCols],false]$FT,locals) - declare!(F06PAF@S,construct(["void"]$UFST,[]@List(S),true)$FT,locals) - ptA:UEXPR := [("MODE"::S)::EXI] - ptB:UEXPR := [1::EXI] - ptC:UEXPR := [2::EXI] - sw1 : Switch := EQ(ptA,ptB)$Switch - sw2 : Switch := EQ(ptA,ptC)$Switch - callOne := call("F06PAF('N',M,N,1.0D0,A,M,X,1,1.0D0,Y,1)") - callTwo := call("F06PAF('T',M,N,1.0D0,A,M,Y,1,1.0D0,X,1)") - c : FC := cond(sw1,callOne,cond(sw2,callTwo)) - code : List FC := [assign(A,a),c,returns()] - ([locals,code]$RSFC)::$ - - coerce(c:List FortranCode):$ == coerce(c)$Rep - - coerce(r:RSFC):$ == coerce(r)$Rep - - coerce(c:FortranCode):$ == coerce(c)$Rep - - coerce(u:$):OutputForm == coerce(u)$Rep - - outputAsFortran(u):Void == - p := checkPrecision()$NAGLinkSupportPackage - outputAsFortran(u)$Rep - p => restorePrecision()$NAGLinkSupportPackage - -@ -\section{domain ASP31 Asp31} -<>= -)abbrev domain ASP31 Asp31 -++ Author: Mike Dewar, Grant Keady and Godfrey Nolan -++ Date Created: Mar 1993 -++ Date Last Updated: 22 March 1994 -++ 6 October 1994 -++ Related Constructors: FortranMatrixFunctionCategory, FortranProgramCategory -++ Description: -++\spadtype{Asp31} produces Fortran for Type 31 ASPs, needed for NAG routine -++\axiomOpFrom{d02ejf}{d02Package}, for example: -++\begin{verbatim} -++ SUBROUTINE PEDERV(X,Y,PW) -++ DOUBLE PRECISION X,Y(*) -++ DOUBLE PRECISION PW(3,3) -++ PW(1,1)=-0.03999999999999999D0 -++ PW(1,2)=10000.0D0*Y(3) -++ PW(1,3)=10000.0D0*Y(2) -++ PW(2,1)=0.03999999999999999D0 -++ PW(2,2)=(-10000.0D0*Y(3))+(-60000000.0D0*Y(2)) -++ PW(2,3)=-10000.0D0*Y(2) -++ PW(3,1)=0.0D0 -++ PW(3,2)=60000000.0D0*Y(2) -++ PW(3,3)=0.0D0 -++ RETURN -++ END -++\end{verbatim} - -Asp31(name): Exports == Implementation where - name : Symbol - - O ==> OutputForm - FST ==> FortranScalarType - UFST ==> Union(fst:FST,void:"void") - MFLOAT ==> MachineFloat - FEXPR ==> FortranExpression(['X],['Y],MFLOAT) - FT ==> FortranType - FC ==> FortranCode - SYMTAB ==> SymbolTable - RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode)) - FRAC ==> Fraction - POLY ==> Polynomial - EXPR ==> Expression - INT ==> Integer - FLOAT ==> Float - VEC ==> Vector - MAT ==> Matrix - VF2 ==> VectorFunctions2 - MF2 ==> MatrixCategoryFunctions2(FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR, - EXPR MFLOAT,VEC EXPR MFLOAT,VEC EXPR MFLOAT,MAT EXPR MFLOAT) - - - - Exports ==> FortranVectorFunctionCategory with - coerce : VEC FEXPR -> $ - ++coerce(f) takes objects from the appropriate instantiation of - ++\spadtype{FortranExpression} and turns them into an ASP. - - Implementation ==> add - - - real : UFST := ["real"::FST]$UFST - syms : SYMTAB := empty() - declare!(X,fortranReal(),syms)$SYMTAB - yType : FT := construct(real,["*"::Symbol],false)$FT - declare!(Y,yType,syms)$SYMTAB - Rep := FortranProgram(name,["void"]$UFST,[X,Y,PW],syms) - - -- To help the poor old compiler! - fexpr2expr(u:FEXPR):EXPR MFLOAT == coerce(u)$FEXPR - - localAssign(s:Symbol,j:MAT FEXPR):FC == - j' : MAT EXPR MFLOAT := map(fexpr2expr,j)$MF2 - assign(s,j')$FC - - makeXList(n:Integer):List(Symbol) == - j:Integer - y:Symbol := Y::Symbol - p:List(Symbol) := [] - for j in 1 .. n repeat p:= cons(subscript(y,[j::OutputForm])$Symbol,p) - p:= reverse(p) - - coerce(u:VEC FEXPR):$ == - dimension := #u::Polynomial Integer - locals : SYMTAB := empty() - declare!(PW,[real,[dimension,dimension],false]$FT,locals)$SYMTAB - n:Integer := maxIndex(u)$VEC(FEXPR) - p:List(Symbol) := makeXList(n) - jac: MAT FEXPR := jacobian(u,p)$MultiVariableCalculusFunctions(_ - Symbol,FEXPR ,VEC FEXPR,List(Symbol)) - code : List FC := [localAssign(PW,jac),returns()$FC]$List(FC) - ([locals,code]$RSFC)::$ - - retract(u:VEC FRAC POLY INT):$ == - v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY INT,FEXPR) - v::$ - - retractIfCan(u:VEC FRAC POLY INT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY INT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC FRAC POLY FLOAT):$ == - v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY FLOAT,FEXPR) - v::$ - - retractIfCan(u:VEC FRAC POLY FLOAT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC EXPR INT):$ == - v : VEC FEXPR := map(retract,u)$VF2(EXPR INT,FEXPR) - v::$ - - retractIfCan(u:VEC EXPR INT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR INT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC EXPR FLOAT):$ == - v : VEC FEXPR := map(retract,u)$VF2(EXPR FLOAT,FEXPR) - v::$ - - retractIfCan(u:VEC EXPR FLOAT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR FLOAT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC POLY INT):$ == - v : VEC FEXPR := map(retract,u)$VF2(POLY INT,FEXPR) - v::$ - - retractIfCan(u:VEC POLY INT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY INT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC POLY FLOAT):$ == - v : VEC FEXPR := map(retract,u)$VF2(POLY FLOAT,FEXPR) - v::$ - - retractIfCan(u:VEC POLY FLOAT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY FLOAT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - coerce(c:List FC):$ == coerce(c)$Rep - - coerce(r:RSFC):$ == coerce(r)$Rep - - coerce(c:FC):$ == coerce(c)$Rep - - coerce(u:$):O == coerce(u)$Rep - - outputAsFortran(u):Void == - p := checkPrecision()$NAGLinkSupportPackage - outputAsFortran(u)$Rep - p => restorePrecision()$NAGLinkSupportPackage - -@ -\section{domain ASP33 Asp33} -<>= -)abbrev domain ASP33 Asp33 -++ Author: Mike Dewar and Godfrey Nolan -++ Date Created: Nov 1993 -++ Date Last Updated: 30 March 1994 -++ Related Constructors: FortranScalarFunctionCategory, FortranProgramCategory. -++ Description: -++\spadtype{Asp33} produces Fortran for Type 33 ASPs, needed for NAG routine -++\axiomOpFrom{d02kef}{d02Package}. The code is a dummy ASP: -++\begin{verbatim} -++ SUBROUTINE REPORT(X,V,JINT) -++ DOUBLE PRECISION V(3),X -++ INTEGER JINT -++ RETURN -++ END -++\end{verbatim} - -Asp33(name): Exports == Implementation where - name : Symbol - - FST ==> FortranScalarType - UFST ==> Union(fst:FST,void:"void") - FT ==> FortranType - SYMTAB ==> SymbolTable - FC ==> FortranCode - RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode)) - - Exports ==> FortranProgramCategory with - outputAsFortran:() -> Void - ++outputAsFortran() generates the default code for \spadtype{ASP33}. - - - Implementation ==> add - - real : UFST := ["real"::FST]$UFST - syms : SYMTAB := empty() - declare!(JINT,fortranInteger(),syms)$SYMTAB - declare!(X,fortranReal(),syms)$SYMTAB - vType : FT := construct(real,["3"::Symbol],false)$FT - declare!(V,vType,syms)$SYMTAB - Rep := FortranProgram(name,["void"]$UFST,[X,V,JINT],syms) - - outputAsFortran():Void == - outputAsFortran( (returns()$FortranCode)::Rep )$Rep - - outputAsFortran(u):Void == outputAsFortran(u)$Rep - - coerce(u:$):OutputForm == coerce(u)$Rep - -@ -\section{domain ASP34 Asp34} -<>= -)abbrev domain ASP34 Asp34 -++ Author: Mike Dewar and Godfrey Nolan -++ Date Created: Nov 1993 -++ Date Last Updated: 14 June 1994 (Themos Tsikas) -++ 6 October 1994 -++ Related Constructors: FortranScalarFunctionCategory, FortranProgramCategory -++ Description: -++\spadtype{Asp34} produces Fortran for Type 34 ASPs, needed for NAG routine -++\axiomOpFrom{f04mbf}{f04Package}, for example: -++\begin{verbatim} -++ SUBROUTINE MSOLVE(IFLAG,N,X,Y,RWORK,LRWORK,IWORK,LIWORK) -++ DOUBLE PRECISION RWORK(LRWORK),X(N),Y(N) -++ INTEGER I,J,N,LIWORK,IFLAG,LRWORK,IWORK(LIWORK) -++ DOUBLE PRECISION W1(3),W2(3),MS(3,3) -++ IFLAG=-1 -++ MS(1,1)=2.0D0 -++ MS(1,2)=1.0D0 -++ MS(1,3)=0.0D0 -++ MS(2,1)=1.0D0 -++ MS(2,2)=2.0D0 -++ MS(2,3)=1.0D0 -++ MS(3,1)=0.0D0 -++ MS(3,2)=1.0D0 -++ MS(3,3)=2.0D0 -++ CALL F04ASF(MS,N,X,N,Y,W1,W2,IFLAG) -++ IFLAG=-IFLAG -++ RETURN -++ END -++\end{verbatim} - -Asp34(name): Exports == Implementation where - name : Symbol - - FST ==> FortranScalarType - FT ==> FortranType - UFST ==> Union(fst:FST,void:"void") - SYMTAB ==> SymbolTable - FC ==> FortranCode - PI ==> PositiveInteger - EXI ==> Expression Integer - RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode)) - - Exports == FortranMatrixCategory - - Implementation == add - - real : UFST := ["real"::FST]$UFST - integer : UFST := ["integer"::FST]$UFST - syms : SYMTAB := empty()$SYMTAB - declare!(IFLAG,fortranInteger(),syms)$SYMTAB - declare!(N,fortranInteger(),syms)$SYMTAB - xType : FT := construct(real,[N],false)$FT - declare!(X,xType,syms)$SYMTAB - declare!(Y,xType,syms)$SYMTAB - declare!(LRWORK,fortranInteger(),syms)$SYMTAB - declare!(LIWORK,fortranInteger(),syms)$SYMTAB - rType : FT := construct(real,[LRWORK],false)$FT - declare!(RWORK,rType,syms)$SYMTAB - iType : FT := construct(integer,[LIWORK],false)$FT - declare!(IWORK,iType,syms)$SYMTAB - Rep := FortranProgram(name,["void"]$UFST, - [IFLAG,N,X,Y,RWORK,LRWORK,IWORK,LIWORK],syms) - - -- To help the poor old compiler - localAssign(s:Symbol,u:EXI):FC == assign(s,u)$FC - - coerce(u:Matrix MachineFloat):$ == - dimension := nrows(u) ::Polynomial Integer - locals : SYMTAB := empty()$SYMTAB - declare!(I,fortranInteger(),syms)$SYMTAB - declare!(J,fortranInteger(),syms)$SYMTAB - declare!(W1,[real,[dimension],false]$FT,locals)$SYMTAB - declare!(W2,[real,[dimension],false]$FT,locals)$SYMTAB - declare!(MS,[real,[dimension,dimension],false]$FT,locals)$SYMTAB - assign1 : FC := localAssign(IFLAG@Symbol,(-1)@EXI) - call : FC := call("F04ASF(MS,N,X,N,Y,W1,W2,IFLAG)")$FC - assign2 : FC := localAssign(IFLAG::Symbol,-(IFLAG@Symbol::EXI)) - assign3 : FC := assign(MS,u)$FC - code : List FC := [assign1,assign3,call,assign2,returns()]$List(FC) - ([locals,code]$RSFC)::$ - - coerce(c:List FortranCode):$ == coerce(c)$Rep - - coerce(r:RSFC):$ == coerce(r)$Rep - - coerce(c:FortranCode):$ == coerce(c)$Rep - - coerce(u:$):OutputForm == coerce(u)$Rep - - outputAsFortran(u):Void == - p := checkPrecision()$NAGLinkSupportPackage - outputAsFortran(u)$Rep - p => restorePrecision()$NAGLinkSupportPackage - -@ -\section{domain ASP35 Asp35} -<>= -)abbrev domain ASP35 Asp35 -++ Author: Mike Dewar, Godfrey Nolan, Grant Keady -++ Date Created: Mar 1993 -++ Date Last Updated: 22 March 1994 -++ 6 October 1994 -++ Related Constructors: FortranVectorFunctionCategory, FortranProgramCategory -++ Description: -++\spadtype{Asp35} produces Fortran for Type 35 ASPs, needed for NAG routines -++\axiomOpFrom{c05pbf}{c05Package}, \axiomOpFrom{c05pcf}{c05Package}, for example: -++\begin{verbatim} -++ SUBROUTINE FCN(N,X,FVEC,FJAC,LDFJAC,IFLAG) -++ DOUBLE PRECISION X(N),FVEC(N),FJAC(LDFJAC,N) -++ INTEGER LDFJAC,N,IFLAG -++ IF(IFLAG.EQ.1)THEN -++ FVEC(1)=(-1.0D0*X(2))+X(1) -++ FVEC(2)=(-1.0D0*X(3))+2.0D0*X(2) -++ FVEC(3)=3.0D0*X(3) -++ ELSEIF(IFLAG.EQ.2)THEN -++ FJAC(1,1)=1.0D0 -++ FJAC(1,2)=-1.0D0 -++ FJAC(1,3)=0.0D0 -++ FJAC(2,1)=0.0D0 -++ FJAC(2,2)=2.0D0 -++ FJAC(2,3)=-1.0D0 -++ FJAC(3,1)=0.0D0 -++ FJAC(3,2)=0.0D0 -++ FJAC(3,3)=3.0D0 -++ ENDIF -++ END -++\end{verbatim} - -Asp35(name): Exports == Implementation where - name : Symbol - - FST ==> FortranScalarType - FT ==> FortranType - UFST ==> Union(fst:FST,void:"void") - SYMTAB ==> SymbolTable - FC ==> FortranCode - PI ==> PositiveInteger - RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode)) - FRAC ==> Fraction - POLY ==> Polynomial - EXPR ==> Expression - INT ==> Integer - FLOAT ==> Float - VEC ==> Vector - MAT ==> Matrix - VF2 ==> VectorFunctions2 - MFLOAT ==> MachineFloat - FEXPR ==> FortranExpression([],['X],MFLOAT) - MF2 ==> MatrixCategoryFunctions2(FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR, - EXPR MFLOAT,VEC EXPR MFLOAT,VEC EXPR MFLOAT,MAT EXPR MFLOAT) - SWU ==> Union(I:Expression Integer,F:Expression Float, - CF:Expression Complex Float,switch:Switch) - - Exports ==> FortranVectorFunctionCategory with - coerce : VEC FEXPR -> $ - ++coerce(f) takes objects from the appropriate instantiation of - ++\spadtype{FortranExpression} and turns them into an ASP. - - Implementation ==> add - - real : UFST := ["real"::FST]$UFST - syms : SYMTAB := empty()$SYMTAB - declare!(N,fortranInteger(),syms)$SYMTAB - xType : FT := construct(real,[N],false)$FT - declare!(X,xType,syms)$SYMTAB - declare!(FVEC,xType,syms)$SYMTAB - declare!(LDFJAC,fortranInteger(),syms)$SYMTAB - jType : FT := construct(real,[LDFJAC,N],false)$FT - declare!(FJAC,jType,syms)$SYMTAB - declare!(IFLAG,fortranInteger(),syms)$SYMTAB - Rep := FortranProgram(name,["void"]$UFST,[N,X,FVEC,FJAC,LDFJAC,IFLAG],syms) - - coerce(u:$):OutputForm == coerce(u)$Rep - - makeXList(n:Integer):List(Symbol) == - x:Symbol := X::Symbol - [subscript(x,[j::OutputForm])$Symbol for j in 1..n] - - fexpr2expr(u:FEXPR):EXPR MFLOAT == coerce(u)$FEXPR - - localAssign1(s:Symbol,j:MAT FEXPR):FC == - j' : MAT EXPR MFLOAT := map(fexpr2expr,j)$MF2 - assign(s,j')$FC - - localAssign2(s:Symbol,j:VEC FEXPR):FC == - j' : VEC EXPR MFLOAT := map(fexpr2expr,j)$VF2(FEXPR,EXPR MFLOAT) - assign(s,j')$FC - - coerce(u:VEC FEXPR):$ == - n:Integer := maxIndex(u) - p:List(Symbol) := makeXList(n) - jac: MAT FEXPR := jacobian(u,p)$MultiVariableCalculusFunctions(_ - Symbol,FEXPR,VEC FEXPR,List(Symbol)) - assf:FC := localAssign2(FVEC,u) - assj:FC := localAssign1(FJAC,jac) - iflag:SWU := [IFLAG@Symbol::EXPR(INT)]$SWU - sw1:Switch := EQ(iflag,[1::EXPR(INT)]$SWU) - sw2:Switch := EQ(iflag,[2::EXPR(INT)]$SWU) - cond(sw1,assf,cond(sw2,assj)$FC)$FC::$ - - coerce(c:List FC):$ == coerce(c)$Rep - - coerce(r:RSFC):$ == coerce(r)$Rep - - coerce(c:FC):$ == coerce(c)$Rep - - outputAsFortran(u):Void == - p := checkPrecision()$NAGLinkSupportPackage - outputAsFortran(u)$Rep - p => restorePrecision()$NAGLinkSupportPackage - - retract(u:VEC FRAC POLY INT):$ == - v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY INT,FEXPR) - v::$ - - retractIfCan(u:VEC FRAC POLY INT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY INT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC FRAC POLY FLOAT):$ == - v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY FLOAT,FEXPR) - v::$ - - retractIfCan(u:VEC FRAC POLY FLOAT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC EXPR INT):$ == - v : VEC FEXPR := map(retract,u)$VF2(EXPR INT,FEXPR) - v::$ - - retractIfCan(u:VEC EXPR INT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR INT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC EXPR FLOAT):$ == - v : VEC FEXPR := map(retract,u)$VF2(EXPR FLOAT,FEXPR) - v::$ - - retractIfCan(u:VEC EXPR FLOAT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR FLOAT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC POLY INT):$ == - v : VEC FEXPR := map(retract,u)$VF2(POLY INT,FEXPR) - v::$ - - retractIfCan(u:VEC POLY INT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY INT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC POLY FLOAT):$ == - v : VEC FEXPR := map(retract,u)$VF2(POLY FLOAT,FEXPR) - v::$ - - retractIfCan(u:VEC POLY FLOAT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY FLOAT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - -@ -\section{domain ASP4 Asp4} -<>= -)abbrev domain ASP4 Asp4 -++ Author: Mike Dewar, Grant Keady and Godfrey Nolan -++ Date Created: Mar 1993 -++ Date Last Updated: 18 March 1994 -++ 6 October 1994 -++ Related Constructors: FortranScalarFunctionCategory, FortranProgramCategory -++ Description: -++\spadtype{Asp4} produces Fortran for Type 4 ASPs, which take an expression -++in X(1) .. X(NDIM) and produce a real function of the form: -++\begin{verbatim} -++ DOUBLE PRECISION FUNCTION FUNCTN(NDIM,X) -++ DOUBLE PRECISION X(NDIM) -++ INTEGER NDIM -++ FUNCTN=(4.0D0*X(1)*X(3)**2*DEXP(2.0D0*X(1)*X(3)))/(X(4)**2+(2.0D0* -++ &X(2)+2.0D0)*X(4)+X(2)**2+2.0D0*X(2)+1.0D0) -++ RETURN -++ END -++\end{verbatim} - -Asp4(name): Exports == Implementation where - name : Symbol - - FEXPR ==> FortranExpression([],['X],MachineFloat) - FST ==> FortranScalarType - FT ==> FortranType - SYMTAB ==> SymbolTable - RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode)) - FSTU ==> Union(fst:FST,void:"void") - FRAC ==> Fraction - POLY ==> Polynomial - EXPR ==> Expression - INT ==> Integer - FLOAT ==> Float - - Exports ==> FortranFunctionCategory with - coerce : FEXPR -> $ - ++coerce(f) takes an object from the appropriate instantiation of - ++\spadtype{FortranExpression} and turns it into an ASP. - - Implementation ==> add - - real : FSTU := ["real"::FST]$FSTU - syms : SYMTAB := empty()$SYMTAB - declare!(NDIM,fortranInteger(),syms)$SYMTAB - xType : FT := construct(real,[NDIM],false)$FT - declare!(X,xType,syms)$SYMTAB - Rep := FortranProgram(name,real,[NDIM,X],syms) - - retract(u:FRAC POLY INT):$ == (retract(u)@FEXPR)::$ - retractIfCan(u:FRAC POLY INT):Union($,"failed") == - foo : Union(FEXPR,"failed") - foo := retractIfCan(u)$FEXPR - foo case "failed" => "failed" - foo::FEXPR::$ - - retract(u:FRAC POLY FLOAT):$ == (retract(u)@FEXPR)::$ - retractIfCan(u:FRAC POLY FLOAT):Union($,"failed") == - foo : Union(FEXPR,"failed") - foo := retractIfCan(u)$FEXPR - foo case "failed" => "failed" - foo::FEXPR::$ - - retract(u:EXPR FLOAT):$ == (retract(u)@FEXPR)::$ - retractIfCan(u:EXPR FLOAT):Union($,"failed") == - foo : Union(FEXPR,"failed") - foo := retractIfCan(u)$FEXPR - foo case "failed" => "failed" - foo::FEXPR::$ - - retract(u:EXPR INT):$ == (retract(u)@FEXPR)::$ - retractIfCan(u:EXPR INT):Union($,"failed") == - foo : Union(FEXPR,"failed") - foo := retractIfCan(u)$FEXPR - foo case "failed" => "failed" - foo::FEXPR::$ - - retract(u:POLY FLOAT):$ == (retract(u)@FEXPR)::$ - retractIfCan(u:POLY FLOAT):Union($,"failed") == - foo : Union(FEXPR,"failed") - foo := retractIfCan(u)$FEXPR - foo case "failed" => "failed" - foo::FEXPR::$ - - retract(u:POLY INT):$ == (retract(u)@FEXPR)::$ - retractIfCan(u:POLY INT):Union($,"failed") == - foo : Union(FEXPR,"failed") - foo := retractIfCan(u)$FEXPR - foo case "failed" => "failed" - foo::FEXPR::$ - - coerce(u:FEXPR):$ == - coerce((u::Expression(MachineFloat))$FEXPR)$Rep - - coerce(c:List FortranCode):$ == coerce(c)$Rep - - coerce(r:RSFC):$ == coerce(r)$Rep - - coerce(c:FortranCode):$ == coerce(c)$Rep - - coerce(u:$):OutputForm == coerce(u)$Rep - - outputAsFortran(u):Void == - p := checkPrecision()$NAGLinkSupportPackage - outputAsFortran(u)$Rep - p => restorePrecision()$NAGLinkSupportPackage - -@ -\section{domain ASP41 Asp41} -<>= -)abbrev domain ASP41 Asp41 -++ Author: Mike Dewar, Godfrey Nolan -++ Date Created: -++ Date Last Updated: 29 March 1994 -++ 6 October 1994 -++ Related Constructors: FortranFunctionCategory, FortranProgramCategory. -++ Description: -++\spadtype{Asp41} produces Fortran for Type 41 ASPs, needed for NAG -++routines \axiomOpFrom{d02raf}{d02Package} and \axiomOpFrom{d02saf}{d02Package} -++in particular. These ASPs are in fact -++three Fortran routines which return a vector of functions, and their -++derivatives wrt Y(i) and also a continuation parameter EPS, for example: -++\begin{verbatim} -++ SUBROUTINE FCN(X,EPS,Y,F,N) -++ DOUBLE PRECISION EPS,F(N),X,Y(N) -++ INTEGER N -++ F(1)=Y(2) -++ F(2)=Y(3) -++ F(3)=(-1.0D0*Y(1)*Y(3))+2.0D0*EPS*Y(2)**2+(-2.0D0*EPS) -++ RETURN -++ END -++ SUBROUTINE JACOBF(X,EPS,Y,F,N) -++ DOUBLE PRECISION EPS,F(N,N),X,Y(N) -++ INTEGER N -++ F(1,1)=0.0D0 -++ F(1,2)=1.0D0 -++ F(1,3)=0.0D0 -++ F(2,1)=0.0D0 -++ F(2,2)=0.0D0 -++ F(2,3)=1.0D0 -++ F(3,1)=-1.0D0*Y(3) -++ F(3,2)=4.0D0*EPS*Y(2) -++ F(3,3)=-1.0D0*Y(1) -++ RETURN -++ END -++ SUBROUTINE JACEPS(X,EPS,Y,F,N) -++ DOUBLE PRECISION EPS,F(N),X,Y(N) -++ INTEGER N -++ F(1)=0.0D0 -++ F(2)=0.0D0 -++ F(3)=2.0D0*Y(2)**2-2.0D0 -++ RETURN -++ END -++\end{verbatim} - -Asp41(nameOne,nameTwo,nameThree): Exports == Implementation where - nameOne : Symbol - nameTwo : Symbol - nameThree : Symbol - - D ==> differentiate - FST ==> FortranScalarType - UFST ==> Union(fst:FST,void:"void") - FT ==> FortranType - FC ==> FortranCode - SYMTAB ==> SymbolTable - RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode)) - FRAC ==> Fraction - POLY ==> Polynomial - EXPR ==> Expression - INT ==> Integer - FLOAT ==> Float - VEC ==> Vector - VF2 ==> VectorFunctions2 - MFLOAT ==> MachineFloat - FEXPR ==> FortranExpression(['X,'EPS],['Y],MFLOAT) - S ==> Symbol - MF2 ==> MatrixCategoryFunctions2(FEXPR,VEC FEXPR,VEC FEXPR,Matrix FEXPR, - EXPR MFLOAT,VEC EXPR MFLOAT,VEC EXPR MFLOAT,Matrix EXPR MFLOAT) - - Exports ==> FortranVectorFunctionCategory with - coerce : VEC FEXPR -> $ - ++coerce(f) takes objects from the appropriate instantiation of - ++\spadtype{FortranExpression} and turns them into an ASP. - - Implementation ==> add - real : UFST := ["real"::FST]$UFST - - symOne : SYMTAB := empty()$SYMTAB - declare!(N,fortranInteger(),symOne)$SYMTAB - declare!(X,fortranReal(),symOne)$SYMTAB - declare!(EPS,fortranReal(),symOne)$SYMTAB - yType : FT := construct(real,[N],false)$FT - declare!(Y,yType,symOne)$SYMTAB - declare!(F,yType,symOne)$SYMTAB - - symTwo : SYMTAB := empty()$SYMTAB - declare!(N,fortranInteger(),symTwo)$SYMTAB - declare!(X,fortranReal(),symTwo)$SYMTAB - declare!(EPS,fortranReal(),symTwo)$SYMTAB - declare!(Y,yType,symTwo)$SYMTAB - fType : FT := construct(real,[N,N],false)$FT - declare!(F,fType,symTwo)$SYMTAB - - symThree : SYMTAB := empty()$SYMTAB - declare!(N,fortranInteger(),symThree)$SYMTAB - declare!(X,fortranReal(),symThree)$SYMTAB - declare!(EPS,fortranReal(),symThree)$SYMTAB - declare!(Y,yType,symThree)$SYMTAB - declare!(F,yType,symThree)$SYMTAB - - R1:=FortranProgram(nameOne,["void"]$UFST,[X,EPS,Y,F,N],symOne) - R2:=FortranProgram(nameTwo,["void"]$UFST,[X,EPS,Y,F,N],symTwo) - R3:=FortranProgram(nameThree,["void"]$UFST,[X,EPS,Y,F,N],symThree) - Rep := Record(f:R1,fJacob:R2,eJacob:R3) - Fsym:Symbol:=coerce "F" - - fexpr2expr(u:FEXPR):EXPR MFLOAT == coerce(u)$FEXPR - - localAssign1(s:S,j:Matrix FEXPR):FC == - j' : Matrix EXPR MFLOAT := map(fexpr2expr,j)$MF2 - assign(s,j')$FC - - localAssign2(s:S,j:VEC FEXPR):FC == - j' : VEC EXPR MFLOAT := map(fexpr2expr,j)$VF2(FEXPR,EXPR MFLOAT) - assign(s,j')$FC - - makeCodeOne(u:VEC FEXPR):FortranCode == - -- simple assign - localAssign2(Fsym,u) - - makeCodeThree(u:VEC FEXPR):FortranCode == - -- compute jacobian wrt to eps - jacEps:VEC FEXPR := [D(v,EPS) for v in entries(u)]$VEC(FEXPR) - makeCodeOne(jacEps) - - makeYList(n:Integer):List(Symbol) == - j:Integer - y:Symbol := Y::Symbol - p:List(Symbol) := [] - [subscript(y,[j::OutputForm])$Symbol for j in 1..n] - - makeCodeTwo(u:VEC FEXPR):FortranCode == - -- compute jacobian wrt to f - n:Integer := maxIndex(u)$VEC(FEXPR) - p:List(Symbol) := makeYList(n) - jac:Matrix(FEXPR) := _ - jacobian(u,p)$MultiVariableCalculusFunctions(S,FEXPR,VEC FEXPR,List(S)) - localAssign1(Fsym,jac) - - coerce(u:VEC FEXPR):$ == - aF:FortranCode := makeCodeOne(u) - bF:FortranCode := makeCodeTwo(u) - cF:FortranCode := makeCodeThree(u) - -- add returns() to complete subroutines - aLF:List(FortranCode) := [aF,returns()$FortranCode]$List(FortranCode) - bLF:List(FortranCode) := [bF,returns()$FortranCode]$List(FortranCode) - cLF:List(FortranCode) := [cF,returns()$FortranCode]$List(FortranCode) - [coerce(aLF)$R1,coerce(bLF)$R2,coerce(cLF)$R3] - - coerce(u:$):OutputForm == - bracket commaSeparate - [nameOne::OutputForm,nameTwo::OutputForm,nameThree::OutputForm] - - outputAsFortran(u:$):Void == - p := checkPrecision()$NAGLinkSupportPackage - outputAsFortran elt(u,f)$Rep - outputAsFortran elt(u,fJacob)$Rep - outputAsFortran elt(u,eJacob)$Rep - p => restorePrecision()$NAGLinkSupportPackage - - retract(u:VEC FRAC POLY INT):$ == - v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY INT,FEXPR) - v::$ - - retractIfCan(u:VEC FRAC POLY INT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY INT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC FRAC POLY FLOAT):$ == - v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY FLOAT,FEXPR) - v::$ - - retractIfCan(u:VEC FRAC POLY FLOAT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC EXPR INT):$ == - v : VEC FEXPR := map(retract,u)$VF2(EXPR INT,FEXPR) - v::$ - - retractIfCan(u:VEC EXPR INT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR INT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC EXPR FLOAT):$ == - v : VEC FEXPR := map(retract,u)$VF2(EXPR FLOAT,FEXPR) - v::$ - - retractIfCan(u:VEC EXPR FLOAT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR FLOAT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC POLY INT):$ == - v : VEC FEXPR := map(retract,u)$VF2(POLY INT,FEXPR) - v::$ - - retractIfCan(u:VEC POLY INT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY INT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC POLY FLOAT):$ == - v : VEC FEXPR := map(retract,u)$VF2(POLY FLOAT,FEXPR) - v::$ - - retractIfCan(u:VEC POLY FLOAT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY FLOAT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - -@ -\section{domain ASP42 Asp42} -<>= -)abbrev domain ASP42 Asp42 -++ Author: Mike Dewar, Godfrey Nolan -++ Date Created: -++ Date Last Updated: 29 March 1994 -++ 6 October 1994 -++ Related Constructors: FortranFunctionCategory, FortranProgramCategory. -++ Description: -++\spadtype{Asp42} produces Fortran for Type 42 ASPs, needed for NAG -++routines \axiomOpFrom{d02raf}{d02Package} and \axiomOpFrom{d02saf}{d02Package} -++in particular. These ASPs are in fact -++three Fortran routines which return a vector of functions, and their -++derivatives wrt Y(i) and also a continuation parameter EPS, for example: -++\begin{verbatim} -++ SUBROUTINE G(EPS,YA,YB,BC,N) -++ DOUBLE PRECISION EPS,YA(N),YB(N),BC(N) -++ INTEGER N -++ BC(1)=YA(1) -++ BC(2)=YA(2) -++ BC(3)=YB(2)-1.0D0 -++ RETURN -++ END -++ SUBROUTINE JACOBG(EPS,YA,YB,AJ,BJ,N) -++ DOUBLE PRECISION EPS,YA(N),AJ(N,N),BJ(N,N),YB(N) -++ INTEGER N -++ AJ(1,1)=1.0D0 -++ AJ(1,2)=0.0D0 -++ AJ(1,3)=0.0D0 -++ AJ(2,1)=0.0D0 -++ AJ(2,2)=1.0D0 -++ AJ(2,3)=0.0D0 -++ AJ(3,1)=0.0D0 -++ AJ(3,2)=0.0D0 -++ AJ(3,3)=0.0D0 -++ BJ(1,1)=0.0D0 -++ BJ(1,2)=0.0D0 -++ BJ(1,3)=0.0D0 -++ BJ(2,1)=0.0D0 -++ BJ(2,2)=0.0D0 -++ BJ(2,3)=0.0D0 -++ BJ(3,1)=0.0D0 -++ BJ(3,2)=1.0D0 -++ BJ(3,3)=0.0D0 -++ RETURN -++ END -++ SUBROUTINE JACGEP(EPS,YA,YB,BCEP,N) -++ DOUBLE PRECISION EPS,YA(N),YB(N),BCEP(N) -++ INTEGER N -++ BCEP(1)=0.0D0 -++ BCEP(2)=0.0D0 -++ BCEP(3)=0.0D0 -++ RETURN -++ END -++\end{verbatim} - -Asp42(nameOne,nameTwo,nameThree): Exports == Implementation where - nameOne : Symbol - nameTwo : Symbol - nameThree : Symbol - - D ==> differentiate - FST ==> FortranScalarType - FT ==> FortranType - FP ==> FortranProgram - FC ==> FortranCode - PI ==> PositiveInteger - NNI ==> NonNegativeInteger - SYMTAB ==> SymbolTable - RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode)) - UFST ==> Union(fst:FST,void:"void") - FRAC ==> Fraction - POLY ==> Polynomial - EXPR ==> Expression - INT ==> Integer - FLOAT ==> Float - VEC ==> Vector - VF2 ==> VectorFunctions2 - MFLOAT ==> MachineFloat - FEXPR ==> FortranExpression(['EPS],['YA,'YB],MFLOAT) - S ==> Symbol - MF2 ==> MatrixCategoryFunctions2(FEXPR,VEC FEXPR,VEC FEXPR,Matrix FEXPR, - EXPR MFLOAT,VEC EXPR MFLOAT,VEC EXPR MFLOAT,Matrix EXPR MFLOAT) - - Exports ==> FortranVectorFunctionCategory with - coerce : VEC FEXPR -> $ - ++coerce(f) takes objects from the appropriate instantiation of - ++\spadtype{FortranExpression} and turns them into an ASP. - - Implementation ==> add - real : UFST := ["real"::FST]$UFST - - symOne : SYMTAB := empty()$SYMTAB - declare!(EPS,fortranReal(),symOne)$SYMTAB - declare!(N,fortranInteger(),symOne)$SYMTAB - yType : FT := construct(real,[N],false)$FT - declare!(YA,yType,symOne)$SYMTAB - declare!(YB,yType,symOne)$SYMTAB - declare!(BC,yType,symOne)$SYMTAB - - symTwo : SYMTAB := empty()$SYMTAB - declare!(EPS,fortranReal(),symTwo)$SYMTAB - declare!(N,fortranInteger(),symTwo)$SYMTAB - declare!(YA,yType,symTwo)$SYMTAB - declare!(YB,yType,symTwo)$SYMTAB - ajType : FT := construct(real,[N,N],false)$FT - declare!(AJ,ajType,symTwo)$SYMTAB - declare!(BJ,ajType,symTwo)$SYMTAB - - symThree : SYMTAB := empty()$SYMTAB - declare!(EPS,fortranReal(),symThree)$SYMTAB - declare!(N,fortranInteger(),symThree)$SYMTAB - declare!(YA,yType,symThree)$SYMTAB - declare!(YB,yType,symThree)$SYMTAB - declare!(BCEP,yType,symThree)$SYMTAB - - rt := ["void"]$UFST - R1:=FortranProgram(nameOne,rt,[EPS,YA,YB,BC,N],symOne) - R2:=FortranProgram(nameTwo,rt,[EPS,YA,YB,AJ,BJ,N],symTwo) - R3:=FortranProgram(nameThree,rt,[EPS,YA,YB,BCEP,N],symThree) - Rep := Record(g:R1,gJacob:R2,geJacob:R3) - BCsym:Symbol:=coerce "BC" - AJsym:Symbol:=coerce "AJ" - BJsym:Symbol:=coerce "BJ" - BCEPsym:Symbol:=coerce "BCEP" - - makeList(n:Integer,s:Symbol):List(Symbol) == - j:Integer - p:List(Symbol) := [] - for j in 1 .. n repeat p:= cons(subscript(s,[j::OutputForm])$Symbol,p) - reverse(p) - - fexpr2expr(u:FEXPR):EXPR MFLOAT == coerce(u)$FEXPR - - localAssign1(s:S,j:Matrix FEXPR):FC == - j' : Matrix EXPR MFLOAT := map(fexpr2expr,j)$MF2 - assign(s,j')$FC - - localAssign2(s:S,j:VEC FEXPR):FC == - j' : VEC EXPR MFLOAT := map(fexpr2expr,j)$VF2(FEXPR,EXPR MFLOAT) - assign(s,j')$FC - - makeCodeOne(u:VEC FEXPR):FortranCode == - -- simple assign - localAssign2(BCsym,u) - - makeCodeTwo(u:VEC FEXPR):List(FortranCode) == - -- compute jacobian wrt to ya - n:Integer := maxIndex(u) - p:List(Symbol) := makeList(n,YA::Symbol) - jacYA:Matrix(FEXPR) := _ - jacobian(u,p)$MultiVariableCalculusFunctions(S,FEXPR,VEC FEXPR,List(S)) - -- compute jacobian wrt to yb - p:List(Symbol) := makeList(n,YB::Symbol) - jacYB: Matrix(FEXPR) := _ - jacobian(u,p)$MultiVariableCalculusFunctions(S,FEXPR,VEC FEXPR,List(S)) - -- assign jacobians to AJ & BJ - [localAssign1(AJsym,jacYA),localAssign1(BJsym,jacYB),returns()$FC]$List(FC) - - makeCodeThree(u:VEC FEXPR):FortranCode == - -- compute jacobian wrt to eps - jacEps:VEC FEXPR := [D(v,EPS) for v in entries u]$VEC(FEXPR) - localAssign2(BCEPsym,jacEps) - - coerce(u:VEC FEXPR):$ == - aF:FortranCode := makeCodeOne(u) - bF:List(FortranCode) := makeCodeTwo(u) - cF:FortranCode := makeCodeThree(u) - -- add returns() to complete subroutines - aLF:List(FortranCode) := [aF,returns()$FC]$List(FortranCode) - cLF:List(FortranCode) := [cF,returns()$FC]$List(FortranCode) - [coerce(aLF)$R1,coerce(bF)$R2,coerce(cLF)$R3] - - coerce(u:$) : OutputForm == - bracket commaSeparate - [nameOne::OutputForm,nameTwo::OutputForm,nameThree::OutputForm] - - outputAsFortran(u:$):Void == - p := checkPrecision()$NAGLinkSupportPackage - outputAsFortran elt(u,g)$Rep - outputAsFortran elt(u,gJacob)$Rep - outputAsFortran elt(u,geJacob)$Rep - p => restorePrecision()$NAGLinkSupportPackage - - retract(u:VEC FRAC POLY INT):$ == - v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY INT,FEXPR) - v::$ - - retractIfCan(u:VEC FRAC POLY INT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY INT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC FRAC POLY FLOAT):$ == - v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY FLOAT,FEXPR) - v::$ - - retractIfCan(u:VEC FRAC POLY FLOAT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC EXPR INT):$ == - v : VEC FEXPR := map(retract,u)$VF2(EXPR INT,FEXPR) - v::$ - - retractIfCan(u:VEC EXPR INT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR INT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC EXPR FLOAT):$ == - v : VEC FEXPR := map(retract,u)$VF2(EXPR FLOAT,FEXPR) - v::$ - - retractIfCan(u:VEC EXPR FLOAT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR FLOAT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC POLY INT):$ == - v : VEC FEXPR := map(retract,u)$VF2(POLY INT,FEXPR) - v::$ - - retractIfCan(u:VEC POLY INT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY INT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC POLY FLOAT):$ == - v : VEC FEXPR := map(retract,u)$VF2(POLY FLOAT,FEXPR) - v::$ - - retractIfCan(u:VEC POLY FLOAT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY FLOAT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - -@ -\section{domain ASP49 Asp49} -<>= -)abbrev domain ASP49 Asp49 -++ Author: Mike Dewar, Grant Keady and Godfrey Nolan -++ Date Created: Mar 1993 -++ Date Last Updated: 23 March 1994 -++ 6 October 1994 -++ Related Constructors: FortranScalarFunctionCategory, FortranProgramCategory -++ Description: -++\spadtype{Asp49} produces Fortran for Type 49 ASPs, needed for NAG routines -++\axiomOpFrom{e04dgf}{e04Package}, \axiomOpFrom{e04ucf}{e04Package}, for example: -++\begin{verbatim} -++ SUBROUTINE OBJFUN(MODE,N,X,OBJF,OBJGRD,NSTATE,IUSER,USER) -++ DOUBLE PRECISION X(N),OBJF,OBJGRD(N),USER(*) -++ INTEGER N,IUSER(*),MODE,NSTATE -++ OBJF=X(4)*X(9)+((-1.0D0*X(5))+X(3))*X(8)+((-1.0D0*X(3))+X(1))*X(7) -++ &+(-1.0D0*X(2)*X(6)) -++ OBJGRD(1)=X(7) -++ OBJGRD(2)=-1.0D0*X(6) -++ OBJGRD(3)=X(8)+(-1.0D0*X(7)) -++ OBJGRD(4)=X(9) -++ OBJGRD(5)=-1.0D0*X(8) -++ OBJGRD(6)=-1.0D0*X(2) -++ OBJGRD(7)=(-1.0D0*X(3))+X(1) -++ OBJGRD(8)=(-1.0D0*X(5))+X(3) -++ OBJGRD(9)=X(4) -++ RETURN -++ END -++\end{verbatim} - -Asp49(name): Exports == Implementation where - name : Symbol - - FST ==> FortranScalarType - UFST ==> Union(fst:FST,void:"void") - FT ==> FortranType - FC ==> FortranCode - SYMTAB ==> SymbolTable - RSFC ==> Record(localSymbols:SymbolTable,code:List(FC)) - MFLOAT ==> MachineFloat - FEXPR ==> FortranExpression([],['X],MFLOAT) - FRAC ==> Fraction - POLY ==> Polynomial - EXPR ==> Expression - INT ==> Integer - FLOAT ==> Float - VEC ==> Vector - VF2 ==> VectorFunctions2 - S ==> Symbol - - Exports ==> FortranFunctionCategory with - coerce : FEXPR -> $ - ++coerce(f) takes an object from the appropriate instantiation of - ++\spadtype{FortranExpression} and turns it into an ASP. - - Implementation ==> add - - real : UFST := ["real"::FST]$UFST - integer : UFST := ["integer"::FST]$UFST - syms : SYMTAB := empty()$SYMTAB - declare!(MODE,fortranInteger(),syms)$SYMTAB - declare!(N,fortranInteger(),syms)$SYMTAB - xType : FT := construct(real,[N::S],false)$FT - declare!(X,xType,syms)$SYMTAB - declare!(OBJF,fortranReal(),syms)$SYMTAB - declare!(OBJGRD,xType,syms)$SYMTAB - declare!(NSTATE,fortranInteger(),syms)$SYMTAB - iuType : FT := construct(integer,["*"::S],false)$FT - declare!(IUSER,iuType,syms)$SYMTAB - uType : FT := construct(real,["*"::S],false)$FT - declare!(USER,uType,syms)$SYMTAB - Rep := FortranProgram(name,["void"]$UFST, - [MODE,N,X,OBJF,OBJGRD,NSTATE,IUSER,USER],syms) - - fexpr2expr(u:FEXPR):EXPR MFLOAT == coerce(u)$FEXPR - - localAssign(s:S,j:VEC FEXPR):FC == - j' : VEC EXPR MFLOAT := map(fexpr2expr,j)$VF2(FEXPR,EXPR MFLOAT) - assign(s,j')$FC - - coerce(u:FEXPR):$ == - vars:List(S) := variables(u) - grd:VEC FEXPR := gradient(u,vars)$MultiVariableCalculusFunctions(_ - S,FEXPR,VEC FEXPR,List(S)) - code : List(FC) := [assign(OBJF@S,fexpr2expr u)$FC,_ - localAssign(OBJGRD@S,grd),_ - returns()$FC] - code::$ - - coerce(u:$):OutputForm == coerce(u)$Rep - - coerce(c:List FC):$ == coerce(c)$Rep - - coerce(r:RSFC):$ == coerce(r)$Rep - - coerce(c:FC):$ == coerce(c)$Rep - - outputAsFortran(u):Void == - p := checkPrecision()$NAGLinkSupportPackage - outputAsFortran(u)$Rep - p => restorePrecision()$NAGLinkSupportPackage - - retract(u:FRAC POLY INT):$ == (retract(u)@FEXPR)::$ - retractIfCan(u:FRAC POLY INT):Union($,"failed") == - foo : Union(FEXPR,"failed") - foo := retractIfCan(u)$FEXPR - foo case "failed" => "failed" - (foo::FEXPR)::$ - - retract(u:FRAC POLY FLOAT):$ == (retract(u)@FEXPR)::$ - retractIfCan(u:FRAC POLY FLOAT):Union($,"failed") == - foo : Union(FEXPR,"failed") - foo := retractIfCan(u)$FEXPR - foo case "failed" => "failed" - (foo::FEXPR)::$ - - retract(u:EXPR FLOAT):$ == (retract(u)@FEXPR)::$ - retractIfCan(u:EXPR FLOAT):Union($,"failed") == - foo : Union(FEXPR,"failed") - foo := retractIfCan(u)$FEXPR - foo case "failed" => "failed" - (foo::FEXPR)::$ - - retract(u:EXPR INT):$ == (retract(u)@FEXPR)::$ - retractIfCan(u:EXPR INT):Union($,"failed") == - foo : Union(FEXPR,"failed") - foo := retractIfCan(u)$FEXPR - foo case "failed" => "failed" - (foo::FEXPR)::$ - - retract(u:POLY FLOAT):$ == (retract(u)@FEXPR)::$ - retractIfCan(u:POLY FLOAT):Union($,"failed") == - foo : Union(FEXPR,"failed") - foo := retractIfCan(u)$FEXPR - foo case "failed" => "failed" - (foo::FEXPR)::$ - - retract(u:POLY INT):$ == (retract(u)@FEXPR)::$ - retractIfCan(u:POLY INT):Union($,"failed") == - foo : Union(FEXPR,"failed") - foo := retractIfCan(u)$FEXPR - foo case "failed" => "failed" - (foo::FEXPR)::$ - -@ -\section{domain ASP50 Asp50} -<>= -)abbrev domain ASP50 Asp50 -++ Author: Mike Dewar, Grant Keady and Godfrey Nolan -++ Date Created: Mar 1993 -++ Date Last Updated: 23 March 1994 -++ 6 October 1994 -++ Related Constructors: FortranVectorFunctionCategory, FortranProgramCategory -++ Description: -++\spadtype{Asp50} produces Fortran for Type 50 ASPs, needed for NAG routine -++\axiomOpFrom{e04fdf}{e04Package}, for example: -++\begin{verbatim} -++ SUBROUTINE LSFUN1(M,N,XC,FVECC) -++ DOUBLE PRECISION FVECC(M),XC(N) -++ INTEGER I,M,N -++ FVECC(1)=((XC(1)-2.4D0)*XC(3)+(15.0D0*XC(1)-36.0D0)*XC(2)+1.0D0)/( -++ &XC(3)+15.0D0*XC(2)) -++ FVECC(2)=((XC(1)-2.8D0)*XC(3)+(7.0D0*XC(1)-19.6D0)*XC(2)+1.0D0)/(X -++ &C(3)+7.0D0*XC(2)) -++ FVECC(3)=((XC(1)-3.2D0)*XC(3)+(4.333333333333333D0*XC(1)-13.866666 -++ &66666667D0)*XC(2)+1.0D0)/(XC(3)+4.333333333333333D0*XC(2)) -++ FVECC(4)=((XC(1)-3.5D0)*XC(3)+(3.0D0*XC(1)-10.5D0)*XC(2)+1.0D0)/(X -++ &C(3)+3.0D0*XC(2)) -++ FVECC(5)=((XC(1)-3.9D0)*XC(3)+(2.2D0*XC(1)-8.579999999999998D0)*XC -++ &(2)+1.0D0)/(XC(3)+2.2D0*XC(2)) -++ FVECC(6)=((XC(1)-4.199999999999999D0)*XC(3)+(1.666666666666667D0*X -++ &C(1)-7.0D0)*XC(2)+1.0D0)/(XC(3)+1.666666666666667D0*XC(2)) -++ FVECC(7)=((XC(1)-4.5D0)*XC(3)+(1.285714285714286D0*XC(1)-5.7857142 -++ &85714286D0)*XC(2)+1.0D0)/(XC(3)+1.285714285714286D0*XC(2)) -++ FVECC(8)=((XC(1)-4.899999999999999D0)*XC(3)+(XC(1)-4.8999999999999 -++ &99D0)*XC(2)+1.0D0)/(XC(3)+XC(2)) -++ FVECC(9)=((XC(1)-4.699999999999999D0)*XC(3)+(XC(1)-4.6999999999999 -++ &99D0)*XC(2)+1.285714285714286D0)/(XC(3)+XC(2)) -++ FVECC(10)=((XC(1)-6.8D0)*XC(3)+(XC(1)-6.8D0)*XC(2)+1.6666666666666 -++ &67D0)/(XC(3)+XC(2)) -++ FVECC(11)=((XC(1)-8.299999999999999D0)*XC(3)+(XC(1)-8.299999999999 -++ &999D0)*XC(2)+2.2D0)/(XC(3)+XC(2)) -++ FVECC(12)=((XC(1)-10.6D0)*XC(3)+(XC(1)-10.6D0)*XC(2)+3.0D0)/(XC(3) -++ &+XC(2)) -++ FVECC(13)=((XC(1)-1.34D0)*XC(3)+(XC(1)-1.34D0)*XC(2)+4.33333333333 -++ &3333D0)/(XC(3)+XC(2)) -++ FVECC(14)=((XC(1)-2.1D0)*XC(3)+(XC(1)-2.1D0)*XC(2)+7.0D0)/(XC(3)+X -++ &C(2)) -++ FVECC(15)=((XC(1)-4.39D0)*XC(3)+(XC(1)-4.39D0)*XC(2)+15.0D0)/(XC(3 -++ &)+XC(2)) -++ END -++\end{verbatim} - -Asp50(name): Exports == Implementation where - name : Symbol - - FST ==> FortranScalarType - FT ==> FortranType - UFST ==> Union(fst:FST,void:"void") - SYMTAB ==> SymbolTable - RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode)) - FRAC ==> Fraction - POLY ==> Polynomial - EXPR ==> Expression - INT ==> Integer - FLOAT ==> Float - VEC ==> Vector - VF2 ==> VectorFunctions2 - FEXPR ==> FortranExpression([],['XC],MFLOAT) - MFLOAT ==> MachineFloat - - Exports ==> FortranVectorFunctionCategory with - coerce : VEC FEXPR -> $ - ++coerce(f) takes objects from the appropriate instantiation of - ++\spadtype{FortranExpression} and turns them into an ASP. - - Implementation ==> add - - real : UFST := ["real"::FST]$UFST - syms : SYMTAB := empty()$SYMTAB - declare!(M,fortranInteger(),syms)$SYMTAB - declare!(N,fortranInteger(),syms)$SYMTAB - xcType : FT := construct(real,[N],false)$FT - declare!(XC,xcType,syms)$SYMTAB - fveccType : FT := construct(real,[M],false)$FT - declare!(FVECC,fveccType,syms)$SYMTAB - declare!(I,fortranInteger(),syms)$SYMTAB - tType : FT := construct(real,[M,N],false)$FT --- declare!(TC,tType,syms)$SYMTAB --- declare!(Y,fveccType,syms)$SYMTAB - Rep := FortranProgram(name,["void"]$UFST, [M,N,XC,FVECC],syms) - - fexpr2expr(u:FEXPR):EXPR MFLOAT == coerce(u)$FEXPR - - coerce(u:VEC FEXPR):$ == - u' : VEC EXPR MFLOAT := map(fexpr2expr,u)$VF2(FEXPR,EXPR MFLOAT) - assign(FVECC,u')$FortranCode::$ - - retract(u:VEC FRAC POLY INT):$ == - v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY INT,FEXPR) - v::$ - - retractIfCan(u:VEC FRAC POLY INT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY INT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC FRAC POLY FLOAT):$ == - v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY FLOAT,FEXPR) - v::$ - - retractIfCan(u:VEC FRAC POLY FLOAT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC EXPR INT):$ == - v : VEC FEXPR := map(retract,u)$VF2(EXPR INT,FEXPR) - v::$ - - retractIfCan(u:VEC EXPR INT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR INT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC EXPR FLOAT):$ == - v : VEC FEXPR := map(retract,u)$VF2(EXPR FLOAT,FEXPR) - v::$ - - retractIfCan(u:VEC EXPR FLOAT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR FLOAT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC POLY INT):$ == - v : VEC FEXPR := map(retract,u)$VF2(POLY INT,FEXPR) - v::$ - - retractIfCan(u:VEC POLY INT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY INT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC POLY FLOAT):$ == - v : VEC FEXPR := map(retract,u)$VF2(POLY FLOAT,FEXPR) - v::$ - - retractIfCan(u:VEC POLY FLOAT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY FLOAT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - coerce(c:List FortranCode):$ == coerce(c)$Rep - - coerce(r:RSFC):$ == coerce(r)$Rep - - coerce(c:FortranCode):$ == coerce(c)$Rep - - coerce(u:$):OutputForm == coerce(u)$Rep - - outputAsFortran(u):Void == - p := checkPrecision()$NAGLinkSupportPackage - outputAsFortran(u)$Rep - p => restorePrecision()$NAGLinkSupportPackage - -@ -\section{domain ASP55 Asp55} -<>= -)abbrev domain ASP55 Asp55 -++ Author: Mike Dewar, Grant Keady and Godfrey Nolan -++ Date Created: June 1993 -++ Date Last Updated: 23 March 1994 -++ 6 October 1994 -++ Related Constructors: FortranScalarFunctionCategory, FortranProgramCategory -++ Description: -++\spadtype{Asp55} produces Fortran for Type 55 ASPs, needed for NAG routines -++\axiomOpFrom{e04dgf}{e04Package} and \axiomOpFrom{e04ucf}{e04Package}, for example: -++\begin{verbatim} -++ SUBROUTINE CONFUN(MODE,NCNLN,N,NROWJ,NEEDC,X,C,CJAC,NSTATE,IUSER -++ &,USER) -++ DOUBLE PRECISION C(NCNLN),X(N),CJAC(NROWJ,N),USER(*) -++ INTEGER N,IUSER(*),NEEDC(NCNLN),NROWJ,MODE,NCNLN,NSTATE -++ IF(NEEDC(1).GT.0)THEN -++ C(1)=X(6)**2+X(1)**2 -++ CJAC(1,1)=2.0D0*X(1) -++ CJAC(1,2)=0.0D0 -++ CJAC(1,3)=0.0D0 -++ CJAC(1,4)=0.0D0 -++ CJAC(1,5)=0.0D0 -++ CJAC(1,6)=2.0D0*X(6) -++ ENDIF -++ IF(NEEDC(2).GT.0)THEN -++ C(2)=X(2)**2+(-2.0D0*X(1)*X(2))+X(1)**2 -++ CJAC(2,1)=(-2.0D0*X(2))+2.0D0*X(1) -++ CJAC(2,2)=2.0D0*X(2)+(-2.0D0*X(1)) -++ CJAC(2,3)=0.0D0 -++ CJAC(2,4)=0.0D0 -++ CJAC(2,5)=0.0D0 -++ CJAC(2,6)=0.0D0 -++ ENDIF -++ IF(NEEDC(3).GT.0)THEN -++ C(3)=X(3)**2+(-2.0D0*X(1)*X(3))+X(2)**2+X(1)**2 -++ CJAC(3,1)=(-2.0D0*X(3))+2.0D0*X(1) -++ CJAC(3,2)=2.0D0*X(2) -++ CJAC(3,3)=2.0D0*X(3)+(-2.0D0*X(1)) -++ CJAC(3,4)=0.0D0 -++ CJAC(3,5)=0.0D0 -++ CJAC(3,6)=0.0D0 -++ ENDIF -++ RETURN -++ END -++\end{verbatim} - -Asp55(name): Exports == Implementation where - name : Symbol - - FST ==> FortranScalarType - FT ==> FortranType - FSTU ==> Union(fst:FST,void:"void") - SYMTAB ==> SymbolTable - FC ==> FortranCode - RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode)) - FRAC ==> Fraction - POLY ==> Polynomial - EXPR ==> Expression - INT ==> Integer - S ==> Symbol - FLOAT ==> Float - VEC ==> Vector - VF2 ==> VectorFunctions2 - MAT ==> Matrix - MFLOAT ==> MachineFloat - FEXPR ==> FortranExpression([],['X],MFLOAT) - MF2 ==> MatrixCategoryFunctions2(FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR, - EXPR MFLOAT,VEC EXPR MFLOAT,VEC EXPR MFLOAT,MAT EXPR MFLOAT) - SWU ==> Union(I:Expression Integer,F:Expression Float, - CF:Expression Complex Float,switch:Switch) - - Exports ==> FortranVectorFunctionCategory with - coerce : VEC FEXPR -> $ - ++coerce(f) takes objects from the appropriate instantiation of - ++\spadtype{FortranExpression} and turns them into an ASP. - - Implementation ==> add - - real : FSTU := ["real"::FST]$FSTU - integer : FSTU := ["integer"::FST]$FSTU - syms : SYMTAB := empty()$SYMTAB - declare!(MODE,fortranInteger(),syms)$SYMTAB - declare!(NCNLN,fortranInteger(),syms)$SYMTAB - declare!(N,fortranInteger(),syms)$SYMTAB - declare!(NROWJ,fortranInteger(),syms)$SYMTAB - needcType : FT := construct(integer,[NCNLN::Symbol],false)$FT - declare!(NEEDC,needcType,syms)$SYMTAB - xType : FT := construct(real,[N::Symbol],false)$FT - declare!(X,xType,syms)$SYMTAB - cType : FT := construct(real,[NCNLN::Symbol],false)$FT - declare!(C,cType,syms)$SYMTAB - cjacType : FT := construct(real,[NROWJ::Symbol,N::Symbol],false)$FT - declare!(CJAC,cjacType,syms)$SYMTAB - declare!(NSTATE,fortranInteger(),syms)$SYMTAB - iuType : FT := construct(integer,["*"::Symbol],false)$FT - declare!(IUSER,iuType,syms)$SYMTAB - uType : FT := construct(real,["*"::Symbol],false)$FT - declare!(USER,uType,syms)$SYMTAB - Rep := FortranProgram(name,["void"]$FSTU, - [MODE,NCNLN,N,NROWJ,NEEDC,X,C,CJAC,NSTATE,IUSER,USER],syms) - - -- Take a symbol, pull of the script and turn it into an integer!! - o2int(u:S):Integer == - o : OutputForm := first elt(scripts(u)$S,sub) - o pretend Integer - - localAssign(s:Symbol,dim:List POLY INT,u:FEXPR):FC == - assign(s,dim,(u::EXPR MFLOAT)$FEXPR)$FC - - makeCond(index:INT,fun:FEXPR,jac:VEC FEXPR):FC == - needc : EXPR INT := (subscript(NEEDC,[index::OutputForm])$S)::EXPR(INT) - sw : Switch := GT([needc]$SWU,[0::EXPR(INT)]$SWU)$Switch - ass : List FC := [localAssign(CJAC,[index::POLY INT,i::POLY INT],jac.i)_ - for i in 1..maxIndex(jac)] - cond(sw,block([localAssign(C,[index::POLY INT],fun),:ass])$FC)$FC - - coerce(u:VEC FEXPR):$ == - ncnln:Integer := maxIndex(u) - x:S := X::S - pu:List(S) := [] - -- Work out which variables appear in the expressions - for e in entries(u) repeat - pu := setUnion(pu,variables(e)$FEXPR) - scriptList : List Integer := map(o2int,pu)$ListFunctions2(S,Integer) - -- This should be the maximum X_n which occurs (there may be others - -- which don't): - n:Integer := reduce(max,scriptList)$List(Integer) - p:List(S) := [] - for j in 1..n repeat p:= cons(subscript(x,[j::OutputForm])$S,p) - p:= reverse(p) - jac:MAT FEXPR := _ - jacobian(u,p)$MultiVariableCalculusFunctions(S,FEXPR,VEC FEXPR,List(S)) - code : List FC := [makeCond(j,u.j,row(jac,j)) for j in 1..ncnln] - [:code,returns()$FC]::$ - - coerce(c:List FC):$ == coerce(c)$Rep - - coerce(r:RSFC):$ == coerce(r)$Rep - - coerce(c:FC):$ == coerce(c)$Rep - - coerce(u:$):OutputForm == coerce(u)$Rep - - outputAsFortran(u):Void == - p := checkPrecision()$NAGLinkSupportPackage - outputAsFortran(u)$Rep - p => restorePrecision()$NAGLinkSupportPackage - - retract(u:VEC FRAC POLY INT):$ == - v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY INT,FEXPR) - v::$ - - retractIfCan(u:VEC FRAC POLY INT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY INT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC FRAC POLY FLOAT):$ == - v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY FLOAT,FEXPR) - v::$ - - retractIfCan(u:VEC FRAC POLY FLOAT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC EXPR INT):$ == - v : VEC FEXPR := map(retract,u)$VF2(EXPR INT,FEXPR) - v::$ - - retractIfCan(u:VEC EXPR INT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR INT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC EXPR FLOAT):$ == - v : VEC FEXPR := map(retract,u)$VF2(EXPR FLOAT,FEXPR) - v::$ - - retractIfCan(u:VEC EXPR FLOAT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR FLOAT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC POLY INT):$ == - v : VEC FEXPR := map(retract,u)$VF2(POLY INT,FEXPR) - v::$ - - retractIfCan(u:VEC POLY INT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY INT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC POLY FLOAT):$ == - v : VEC FEXPR := map(retract,u)$VF2(POLY FLOAT,FEXPR) - v::$ - - retractIfCan(u:VEC POLY FLOAT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY FLOAT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - -@ -\section{domain ASP6 Asp6} -<>= -)abbrev domain ASP6 Asp6 -++ Author: Mike Dewar and Godfrey Nolan and Grant Keady -++ Date Created: Mar 1993 -++ Date Last Updated: 18 March 1994 -++ 6 October 1994 -++ Related Constructors: FortranVectorFunctionCategory, FortranProgramCategory -++ Description: -++ \spadtype{Asp6} produces Fortran for Type 6 ASPs, needed for NAG routines -++ \axiomOpFrom{c05nbf}{c05Package}, \axiomOpFrom{c05ncf}{c05Package}. -++ These represent vectors of functions of X(i) and look like: -++ \begin{verbatim} -++ SUBROUTINE FCN(N,X,FVEC,IFLAG) -++ DOUBLE PRECISION X(N),FVEC(N) -++ INTEGER N,IFLAG -++ FVEC(1)=(-2.0D0*X(2))+(-2.0D0*X(1)**2)+3.0D0*X(1)+1.0D0 -++ FVEC(2)=(-2.0D0*X(3))+(-2.0D0*X(2)**2)+3.0D0*X(2)+(-1.0D0*X(1))+1. -++ &0D0 -++ FVEC(3)=(-2.0D0*X(4))+(-2.0D0*X(3)**2)+3.0D0*X(3)+(-1.0D0*X(2))+1. -++ &0D0 -++ FVEC(4)=(-2.0D0*X(5))+(-2.0D0*X(4)**2)+3.0D0*X(4)+(-1.0D0*X(3))+1. -++ &0D0 -++ FVEC(5)=(-2.0D0*X(6))+(-2.0D0*X(5)**2)+3.0D0*X(5)+(-1.0D0*X(4))+1. -++ &0D0 -++ FVEC(6)=(-2.0D0*X(7))+(-2.0D0*X(6)**2)+3.0D0*X(6)+(-1.0D0*X(5))+1. -++ &0D0 -++ FVEC(7)=(-2.0D0*X(8))+(-2.0D0*X(7)**2)+3.0D0*X(7)+(-1.0D0*X(6))+1. -++ &0D0 -++ FVEC(8)=(-2.0D0*X(9))+(-2.0D0*X(8)**2)+3.0D0*X(8)+(-1.0D0*X(7))+1. -++ &0D0 -++ FVEC(9)=(-2.0D0*X(9)**2)+3.0D0*X(9)+(-1.0D0*X(8))+1.0D0 -++ RETURN -++ END -++ \end{verbatim} - -Asp6(name): Exports == Implementation where - name : Symbol - - FEXPR ==> FortranExpression([],['X],MFLOAT) - MFLOAT ==> MachineFloat - FST ==> FortranScalarType - FT ==> FortranType - SYMTAB ==> SymbolTable - RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode)) - UFST ==> Union(fst:FST,void:"void") - FRAC ==> Fraction - POLY ==> Polynomial - EXPR ==> Expression - INT ==> Integer - FLOAT ==> Float - VEC ==> Vector - VF2 ==> VectorFunctions2 - - Exports == FortranVectorFunctionCategory with - coerce: Vector FEXPR -> % - ++coerce(f) takes objects from the appropriate instantiation of - ++\spadtype{FortranExpression} and turns them into an ASP. - - Implementation == add - - real : UFST := ["real"::FST]$UFST - syms : SYMTAB := empty()$SYMTAB - declare!(N,fortranInteger()$FT,syms)$SYMTAB - xType : FT := construct(real,[N],false)$FT - declare!(X,xType,syms)$SYMTAB - declare!(FVEC,xType,syms)$SYMTAB - declare!(IFLAG,fortranInteger()$FT,syms)$SYMTAB - Rep := FortranProgram(name,["void"]$Union(fst:FST,void:"void"), - [N,X,FVEC,IFLAG],syms) - - retract(u:VEC FRAC POLY INT):$ == - v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY INT,FEXPR) - v::$ - - retractIfCan(u:VEC FRAC POLY INT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY INT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC FRAC POLY FLOAT):$ == - v : VEC FEXPR := map(retract,u)$VectorFunctions2(FRAC POLY FLOAT,FEXPR) - v::$ - - retractIfCan(u:VEC FRAC POLY FLOAT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC EXPR INT):$ == - v : VEC FEXPR := map(retract,u)$VectorFunctions2(EXPR INT,FEXPR) - v::$ - - retractIfCan(u:VEC EXPR INT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR INT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC EXPR FLOAT):$ == - v : VEC FEXPR := map(retract,u)$VectorFunctions2(EXPR FLOAT,FEXPR) - v::$ - - retractIfCan(u:VEC EXPR FLOAT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR FLOAT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC POLY INT):$ == - v : VEC FEXPR := map(retract,u)$VectorFunctions2(POLY INT,FEXPR) - v::$ - - retractIfCan(u:VEC POLY INT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY INT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC POLY FLOAT):$ == - v : VEC FEXPR := map(retract,u)$VectorFunctions2(POLY FLOAT,FEXPR) - v::$ - - retractIfCan(u:VEC POLY FLOAT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY FLOAT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - fexpr2expr(u:FEXPR):EXPR MFLOAT == - (u::EXPR MFLOAT)$FEXPR - - coerce(u:VEC FEXPR):% == - v : VEC EXPR MFLOAT - v := map(fexpr2expr,u)$VF2(FEXPR,EXPR MFLOAT) - ([assign(FVEC,v)$FortranCode,returns()$FortranCode]$List(FortranCode))::$ - - coerce(c:List FortranCode):% == coerce(c)$Rep - - coerce(r:RSFC):% == coerce(r)$Rep - - coerce(c:FortranCode):% == coerce(c)$Rep - - coerce(u:%):OutputForm == coerce(u)$Rep - - outputAsFortran(u):Void == - p := checkPrecision()$NAGLinkSupportPackage - outputAsFortran(u)$Rep - p => restorePrecision()$NAGLinkSupportPackage - -@ -\section{domain ASP7 Asp7} -<>= -)abbrev domain ASP7 Asp7 -++ Author: Mike Dewar and Godfrey Nolan and Grant Keady -++ Date Created: Mar 1993 -++ Date Last Updated: 18 March 1994 -++ 6 October 1994 -++ Related Constructors: FortranVectorFunctionCategory, FortranProgramCategory -++ Description: -++ \spadtype{Asp7} produces Fortran for Type 7 ASPs, needed for NAG routines -++ \axiomOpFrom{d02bbf}{d02Package}, \axiomOpFrom{d02gaf}{d02Package}. -++ These represent a vector of functions of the scalar X and -++ the array Z, and look like: -++ \begin{verbatim} -++ SUBROUTINE FCN(X,Z,F) -++ DOUBLE PRECISION F(*),X,Z(*) -++ F(1)=DTAN(Z(3)) -++ F(2)=((-0.03199999999999999D0*DCOS(Z(3))*DTAN(Z(3)))+(-0.02D0*Z(2) -++ &**2))/(Z(2)*DCOS(Z(3))) -++ F(3)=-0.03199999999999999D0/(X*Z(2)**2) -++ RETURN -++ END -++ \end{verbatim} - -Asp7(name): Exports == Implementation where - name : Symbol - - FST ==> FortranScalarType - FT ==> FortranType - SYMTAB ==> SymbolTable - RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode)) - MFLOAT ==> MachineFloat - FEXPR ==> FortranExpression(['X],['Y],MFLOAT) - UFST ==> Union(fst:FST,void:"void") - FRAC ==> Fraction - POLY ==> Polynomial - EXPR ==> Expression - INT ==> Integer - FLOAT ==> Float - VEC ==> Vector - VF2 ==> VectorFunctions2 - - Exports ==> FortranVectorFunctionCategory with - coerce : Vector FEXPR -> % - ++coerce(f) takes objects from the appropriate instantiation of - ++\spadtype{FortranExpression} and turns them into an ASP. - - Implementation ==> add - - real : UFST := ["real"::FST]$UFST - syms : SYMTAB := empty()$SYMTAB - declare!(X,fortranReal(),syms)$SYMTAB - yType : FT := construct(real,["*"::Symbol],false)$FT - declare!(Y,yType,syms)$SYMTAB - declare!(F,yType,syms)$SYMTAB - Rep := FortranProgram(name,["void"]$UFST,[X,Y,F],syms) - - retract(u:VEC FRAC POLY INT):$ == - v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY INT,FEXPR) - v::$ - - retractIfCan(u:VEC FRAC POLY INT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY INT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC FRAC POLY FLOAT):$ == - v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY FLOAT,FEXPR) - v::$ - - retractIfCan(u:VEC FRAC POLY FLOAT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC EXPR INT):$ == - v : VEC FEXPR := map(retract,u)$VF2(EXPR INT,FEXPR) - v::$ - - retractIfCan(u:VEC EXPR INT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR INT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC EXPR FLOAT):$ == - v : VEC FEXPR := map(retract,u)$VF2(EXPR FLOAT,FEXPR) - v::$ - - retractIfCan(u:VEC EXPR FLOAT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR FLOAT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC POLY INT):$ == - v : VEC FEXPR := map(retract,u)$VF2(POLY INT,FEXPR) - v::$ - - retractIfCan(u:VEC POLY INT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY INT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC POLY FLOAT):$ == - v : VEC FEXPR := map(retract,u)$VF2(POLY FLOAT,FEXPR) - v::$ - - retractIfCan(u:VEC POLY FLOAT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY FLOAT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - fexpr2expr(u:FEXPR):EXPR MFLOAT == - (u::EXPR MFLOAT)$FEXPR - - coerce(u:Vector FEXPR ):% == - v : Vector EXPR MFLOAT - v:=map(fexpr2expr,u)$VF2(FEXPR,EXPR MFLOAT) - ([assign(F,v)$FortranCode,returns()$FortranCode]$List(FortranCode))::% - - coerce(c:List FortranCode):% == coerce(c)$Rep - - coerce(r:RSFC):% == coerce(r)$Rep - - coerce(c:FortranCode):% == coerce(c)$Rep - - coerce(u:%):OutputForm == coerce(u)$Rep - - outputAsFortran(u):Void == - p := checkPrecision()$NAGLinkSupportPackage - outputAsFortran(u)$Rep - p => restorePrecision()$NAGLinkSupportPackage - -@ -\section{domain ASP73 Asp73} -<>= -)abbrev domain ASP73 Asp73 -++ Author: Mike Dewar, Grant Keady and Godfrey Nolan -++ Date Created: Mar 1993 -++ Date Last Updated: 30 March 1994 -++ 6 October 1994 -++ Related Constructors: FortranVectorFunctionCategory, FortranProgramCategory -++ Description: -++\spadtype{Asp73} produces Fortran for Type 73 ASPs, needed for NAG routine -++\axiomOpFrom{d03eef}{d03Package}, for example: -++\begin{verbatim} -++ SUBROUTINE PDEF(X,Y,ALPHA,BETA,GAMMA,DELTA,EPSOLN,PHI,PSI) -++ DOUBLE PRECISION ALPHA,EPSOLN,PHI,X,Y,BETA,DELTA,GAMMA,PSI -++ ALPHA=DSIN(X) -++ BETA=Y -++ GAMMA=X*Y -++ DELTA=DCOS(X)*DSIN(Y) -++ EPSOLN=Y+X -++ PHI=X -++ PSI=Y -++ RETURN -++ END -++\end{verbatim} - -Asp73(name): Exports == Implementation where - name : Symbol - - FST ==> FortranScalarType - FSTU ==> Union(fst:FST,void:"void") - FEXPR ==> FortranExpression(['X,'Y],[],MachineFloat) - FT ==> FortranType - SYMTAB ==> SymbolTable - RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode)) - FRAC ==> Fraction - POLY ==> Polynomial - EXPR ==> Expression - INT ==> Integer - FLOAT ==> Float - VEC ==> Vector - VF2 ==> VectorFunctions2 - - Exports ==> FortranVectorFunctionCategory with - coerce : VEC FEXPR -> $ - ++coerce(f) takes objects from the appropriate instantiation of - ++\spadtype{FortranExpression} and turns them into an ASP. - - Implementation ==> add - - syms : SYMTAB := empty()$SYMTAB - declare!(X,fortranReal(),syms) $SYMTAB - declare!(Y,fortranReal(),syms) $SYMTAB - declare!(ALPHA,fortranReal(),syms)$SYMTAB - declare!(BETA,fortranReal(),syms) $SYMTAB - declare!(GAMMA,fortranReal(),syms) $SYMTAB - declare!(DELTA,fortranReal(),syms) $SYMTAB - declare!(EPSOLN,fortranReal(),syms) $SYMTAB - declare!(PHI,fortranReal(),syms) $SYMTAB - declare!(PSI,fortranReal(),syms) $SYMTAB - Rep := FortranProgram(name,["void"]$FSTU, - [X,Y,ALPHA,BETA,GAMMA,DELTA,EPSOLN,PHI,PSI],syms) - - -- To help the poor compiler! - localAssign(u:Symbol,v:FEXPR):FortranCode == - assign(u,(v::EXPR MachineFloat)$FEXPR)$FortranCode - - coerce(u:VEC FEXPR):$ == - maxIndex(u) ^= 7 => error "Vector is not of dimension 7" - [localAssign(ALPHA@Symbol,elt(u,1)),_ - localAssign(BETA@Symbol,elt(u,2)),_ - localAssign(GAMMA@Symbol,elt(u,3)),_ - localAssign(DELTA@Symbol,elt(u,4)),_ - localAssign(EPSOLN@Symbol,elt(u,5)),_ - localAssign(PHI@Symbol,elt(u,6)),_ - localAssign(PSI@Symbol,elt(u,7)),_ - returns()$FortranCode]$List(FortranCode)::$ - - coerce(c:FortranCode):$ == coerce(c)$Rep - - coerce(r:RSFC):$ == coerce(r)$Rep - - coerce(c:List FortranCode):$ == coerce(c)$Rep - - coerce(u:$):OutputForm == coerce(u)$Rep - - outputAsFortran(u):Void == - p := checkPrecision()$NAGLinkSupportPackage - outputAsFortran(u)$Rep - p => restorePrecision()$NAGLinkSupportPackage - - retract(u:VEC FRAC POLY INT):$ == - v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY INT,FEXPR) - v::$ - - retractIfCan(u:VEC FRAC POLY INT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY INT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC FRAC POLY FLOAT):$ == - v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY FLOAT,FEXPR) - v::$ - - retractIfCan(u:VEC FRAC POLY FLOAT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC EXPR INT):$ == - v : VEC FEXPR := map(retract,u)$VF2(EXPR INT,FEXPR) - v::$ - - retractIfCan(u:VEC EXPR INT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR INT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC EXPR FLOAT):$ == - v : VEC FEXPR := map(retract,u)$VF2(EXPR FLOAT,FEXPR) - v::$ - - retractIfCan(u:VEC EXPR FLOAT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR FLOAT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC POLY INT):$ == - v : VEC FEXPR := map(retract,u)$VF2(POLY INT,FEXPR) - v::$ - - retractIfCan(u:VEC POLY INT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY INT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC POLY FLOAT):$ == - v : VEC FEXPR := map(retract,u)$VF2(POLY FLOAT,FEXPR) - v::$ - - retractIfCan(u:VEC POLY FLOAT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY FLOAT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - -@ -\section{domain ASP74 Asp74} -<>= -)abbrev domain ASP74 Asp74 -++ Author: Mike Dewar and Godfrey Nolan -++ Date Created: Oct 1993 -++ Date Last Updated: 30 March 1994 -++ 6 October 1994 -++ Related Constructors: FortranScalarFunctionCategory, FortranProgramCategory. -++ Description: -++\spadtype{Asp74} produces Fortran for Type 74 ASPs, needed for NAG routine -++\axiomOpFrom{d03eef}{d03Package}, for example: -++\begin{verbatim} -++ SUBROUTINE BNDY(X,Y,A,B,C,IBND) -++ DOUBLE PRECISION A,B,C,X,Y -++ INTEGER IBND -++ IF(IBND.EQ.0)THEN -++ A=0.0D0 -++ B=1.0D0 -++ C=-1.0D0*DSIN(X) -++ ELSEIF(IBND.EQ.1)THEN -++ A=1.0D0 -++ B=0.0D0 -++ C=DSIN(X)*DSIN(Y) -++ ELSEIF(IBND.EQ.2)THEN -++ A=1.0D0 -++ B=0.0D0 -++ C=DSIN(X)*DSIN(Y) -++ ELSEIF(IBND.EQ.3)THEN -++ A=0.0D0 -++ B=1.0D0 -++ C=-1.0D0*DSIN(Y) -++ ENDIF -++ END -++\end{verbatim} - -Asp74(name): Exports == Implementation where - name : Symbol - - FST ==> FortranScalarType - FSTU ==> Union(fst:FST,void:"void") - FT ==> FortranType - SYMTAB ==> SymbolTable - FC ==> FortranCode - PI ==> PositiveInteger - RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode)) - FRAC ==> Fraction - POLY ==> Polynomial - EXPR ==> Expression - INT ==> Integer - FLOAT ==> Float - MFLOAT ==> MachineFloat - FEXPR ==> FortranExpression(['X,'Y],[],MFLOAT) - U ==> Union(I: Expression Integer,F: Expression Float,_ - CF: Expression Complex Float,switch:Switch) - VEC ==> Vector - MAT ==> Matrix - M2 ==> MatrixCategoryFunctions2 - MF2a ==> M2(FRAC POLY INT,VEC FRAC POLY INT,VEC FRAC POLY INT, - MAT FRAC POLY INT, FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR) - MF2b ==> M2(FRAC POLY FLOAT,VEC FRAC POLY FLOAT,VEC FRAC POLY FLOAT, - MAT FRAC POLY FLOAT, FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR) - MF2c ==> M2(POLY INT,VEC POLY INT,VEC POLY INT,MAT POLY INT, - FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR) - MF2d ==> M2(POLY FLOAT,VEC POLY FLOAT,VEC POLY FLOAT, - MAT POLY FLOAT, FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR) - MF2e ==> M2(EXPR INT,VEC EXPR INT,VEC EXPR INT,MAT EXPR INT, - FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR) - MF2f ==> M2(EXPR FLOAT,VEC EXPR FLOAT,VEC EXPR FLOAT, - MAT EXPR FLOAT, FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR) - - Exports ==> FortranMatrixFunctionCategory with - coerce : MAT FEXPR -> $ - ++coerce(f) takes objects from the appropriate instantiation of - ++\spadtype{FortranExpression} and turns them into an ASP. - - Implementation ==> add - - syms : SYMTAB := empty()$SYMTAB - declare!(X,fortranReal(),syms)$SYMTAB - declare!(Y,fortranReal(),syms)$SYMTAB - declare!(A,fortranReal(),syms)$SYMTAB - declare!(B,fortranReal(),syms)$SYMTAB - declare!(C,fortranReal(),syms)$SYMTAB - declare!(IBND,fortranInteger(),syms)$SYMTAB - Rep := FortranProgram(name,["void"]$FSTU,[X,Y,A,B,C,IBND],syms) - - -- To help the poor compiler! - localAssign(u:Symbol,v:FEXPR):FC == assign(u,(v::EXPR MFLOAT)$FEXPR)$FC - - coerce(u:MAT FEXPR):$ == - (nrows(u) ^= 4 or ncols(u) ^= 3) => error "Not a 4X3 matrix" - flag:U := [IBND@Symbol::EXPR INT]$U - pt0:U := [0::EXPR INT]$U - pt1:U := [1::EXPR INT]$U - pt2:U := [2::EXPR INT]$U - pt3:U := [3::EXPR INT]$U - sw1: Switch := EQ(flag,pt0)$Switch - sw2: Switch := EQ(flag,pt1)$Switch - sw3: Switch := EQ(flag,pt2)$Switch - sw4: Switch := EQ(flag,pt3)$Switch - a11 : FC := localAssign(A,u(1,1)) - a12 : FC := localAssign(B,u(1,2)) - a13 : FC := localAssign(C,u(1,3)) - a21 : FC := localAssign(A,u(2,1)) - a22 : FC := localAssign(B,u(2,2)) - a23 : FC := localAssign(C,u(2,3)) - a31 : FC := localAssign(A,u(3,1)) - a32 : FC := localAssign(B,u(3,2)) - a33 : FC := localAssign(C,u(3,3)) - a41 : FC := localAssign(A,u(4,1)) - a42 : FC := localAssign(B,u(4,2)) - a43 : FC := localAssign(C,u(4,3)) - c : FC := cond(sw1,block([a11,a12,a13])$FC, - cond(sw2,block([a21,a22,a23])$FC, - cond(sw3,block([a31,a32,a33])$FC, - cond(sw4,block([a41,a42,a43])$FC)$FC)$FC)$FC)$FC - c::$ - - coerce(u:$):OutputForm == coerce(u)$Rep - - coerce(c:FortranCode):$ == coerce(c)$Rep - - coerce(r:RSFC):$ == coerce(r)$Rep - - coerce(c:List FortranCode):$ == coerce(c)$Rep - - outputAsFortran(u):Void == - p := checkPrecision()$NAGLinkSupportPackage - outputAsFortran(u)$Rep - p => restorePrecision()$NAGLinkSupportPackage - - retract(u:MAT FRAC POLY INT):$ == - v : MAT FEXPR := map(retract,u)$MF2a - v::$ - - retractIfCan(u:MAT FRAC POLY INT):Union($,"failed") == - v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2a - v case "failed" => "failed" - (v::MAT FEXPR)::$ - - retract(u:MAT FRAC POLY FLOAT):$ == - v : MAT FEXPR := map(retract,u)$MF2b - v::$ - - retractIfCan(u:MAT FRAC POLY FLOAT):Union($,"failed") == - v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2b - v case "failed" => "failed" - (v::MAT FEXPR)::$ - - retract(u:MAT EXPR INT):$ == - v : MAT FEXPR := map(retract,u)$MF2e - v::$ - - retractIfCan(u:MAT EXPR INT):Union($,"failed") == - v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2e - v case "failed" => "failed" - (v::MAT FEXPR)::$ - - retract(u:MAT EXPR FLOAT):$ == - v : MAT FEXPR := map(retract,u)$MF2f - v::$ - - retractIfCan(u:MAT EXPR FLOAT):Union($,"failed") == - v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2f - v case "failed" => "failed" - (v::MAT FEXPR)::$ - - retract(u:MAT POLY INT):$ == - v : MAT FEXPR := map(retract,u)$MF2c - v::$ - - retractIfCan(u:MAT POLY INT):Union($,"failed") == - v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2c - v case "failed" => "failed" - (v::MAT FEXPR)::$ - - retract(u:MAT POLY FLOAT):$ == - v : MAT FEXPR := map(retract,u)$MF2d - v::$ - - retractIfCan(u:MAT POLY FLOAT):Union($,"failed") == - v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2d - v case "failed" => "failed" - (v::MAT FEXPR)::$ - -@ -\section{domain ASP77 Asp77} -<>= -)abbrev domain ASP77 Asp77 -++ Author: Mike Dewar, Grant Keady and Godfrey Nolan -++ Date Created: Mar 1993 -++ Date Last Updated: 30 March 1994 -++ 6 October 1994 -++ Related Constructors: FortranMatrixFunctionCategory, FortranProgramCategory -++ Description: -++\spadtype{Asp77} produces Fortran for Type 77 ASPs, needed for NAG routine -++\axiomOpFrom{d02gbf}{d02Package}, for example: -++\begin{verbatim} -++ SUBROUTINE FCNF(X,F) -++ DOUBLE PRECISION X -++ DOUBLE PRECISION F(2,2) -++ F(1,1)=0.0D0 -++ F(1,2)=1.0D0 -++ F(2,1)=0.0D0 -++ F(2,2)=-10.0D0 -++ RETURN -++ END -++\end{verbatim} - -Asp77(name): Exports == Implementation where - name : Symbol - - FST ==> FortranScalarType - FSTU ==> Union(fst:FST,void:"void") - FT ==> FortranType - FC ==> FortranCode - SYMTAB ==> SymbolTable - RSFC ==> Record(localSymbols:SymbolTable,code:List(FC)) - FRAC ==> Fraction - POLY ==> Polynomial - EXPR ==> Expression - INT ==> Integer - FLOAT ==> Float - MFLOAT ==> MachineFloat - FEXPR ==> FortranExpression(['X],[],MFLOAT) - VEC ==> Vector - MAT ==> Matrix - M2 ==> MatrixCategoryFunctions2 - MF2 ==> M2(FEXPR,VEC FEXPR,VEC FEXPR,Matrix FEXPR,EXPR MFLOAT, - VEC EXPR MFLOAT,VEC EXPR MFLOAT,Matrix EXPR MFLOAT) - MF2a ==> M2(FRAC POLY INT,VEC FRAC POLY INT,VEC FRAC POLY INT, - MAT FRAC POLY INT, FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR) - MF2b ==> M2(FRAC POLY FLOAT,VEC FRAC POLY FLOAT,VEC FRAC POLY FLOAT, - MAT FRAC POLY FLOAT, FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR) - MF2c ==> M2(POLY INT,VEC POLY INT,VEC POLY INT,MAT POLY INT, - FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR) - MF2d ==> M2(POLY FLOAT,VEC POLY FLOAT,VEC POLY FLOAT, - MAT POLY FLOAT, FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR) - MF2e ==> M2(EXPR INT,VEC EXPR INT,VEC EXPR INT,MAT EXPR INT, - FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR) - MF2f ==> M2(EXPR FLOAT,VEC EXPR FLOAT,VEC EXPR FLOAT, - MAT EXPR FLOAT, FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR) - - - Exports ==> FortranMatrixFunctionCategory with - coerce : MAT FEXPR -> $ - ++coerce(f) takes objects from the appropriate instantiation of - ++\spadtype{FortranExpression} and turns them into an ASP. - - Implementation ==> add - - real : FSTU := ["real"::FST]$FSTU - syms : SYMTAB := empty()$SYMTAB - declare!(X,fortranReal(),syms)$SYMTAB - Rep := FortranProgram(name,["void"]$FSTU,[X,F],syms) - - fexpr2expr(u:FEXPR):EXPR MFLOAT == coerce(u)$FEXPR - - localAssign(s:Symbol,j:MAT FEXPR):FortranCode == - j' : MAT EXPR MFLOAT := map(fexpr2expr,j)$MF2 - assign(s,j')$FortranCode - - coerce(u:MAT FEXPR):$ == - dimension := nrows(u)::POLY(INT) - locals : SYMTAB := empty() - declare!(F,[real,[dimension,dimension]$List(POLY(INT)),false]$FT,locals) - code : List FC := [localAssign(F,u),returns()$FC] - ([locals,code]$RSFC)::$ - - coerce(c:List FC):$ == coerce(c)$Rep - - coerce(r:RSFC):$ == coerce(r)$Rep - - coerce(c:FC):$ == coerce(c)$Rep - - coerce(u:$):OutputForm == coerce(u)$Rep - - outputAsFortran(u):Void == - p := checkPrecision()$NAGLinkSupportPackage - outputAsFortran(u)$Rep - p => restorePrecision()$NAGLinkSupportPackage - - retract(u:MAT FRAC POLY INT):$ == - v : MAT FEXPR := map(retract,u)$MF2a - v::$ - - retractIfCan(u:MAT FRAC POLY INT):Union($,"failed") == - v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2a - v case "failed" => "failed" - (v::MAT FEXPR)::$ - - retract(u:MAT FRAC POLY FLOAT):$ == - v : MAT FEXPR := map(retract,u)$MF2b - v::$ - - retractIfCan(u:MAT FRAC POLY FLOAT):Union($,"failed") == - v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2b - v case "failed" => "failed" - (v::MAT FEXPR)::$ - - retract(u:MAT EXPR INT):$ == - v : MAT FEXPR := map(retract,u)$MF2e - v::$ - - retractIfCan(u:MAT EXPR INT):Union($,"failed") == - v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2e - v case "failed" => "failed" - (v::MAT FEXPR)::$ - - retract(u:MAT EXPR FLOAT):$ == - v : MAT FEXPR := map(retract,u)$MF2f - v::$ - - retractIfCan(u:MAT EXPR FLOAT):Union($,"failed") == - v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2f - v case "failed" => "failed" - (v::MAT FEXPR)::$ - - retract(u:MAT POLY INT):$ == - v : MAT FEXPR := map(retract,u)$MF2c - v::$ - - retractIfCan(u:MAT POLY INT):Union($,"failed") == - v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2c - v case "failed" => "failed" - (v::MAT FEXPR)::$ - - retract(u:MAT POLY FLOAT):$ == - v : MAT FEXPR := map(retract,u)$MF2d - v::$ - - retractIfCan(u:MAT POLY FLOAT):Union($,"failed") == - v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2d - v case "failed" => "failed" - (v::MAT FEXPR)::$ - -@ -\section{domain ASP78 Asp78} -<>= -)abbrev domain ASP78 Asp78 -++ Author: Mike Dewar, Grant Keady and Godfrey Nolan -++ Date Created: Mar 1993 -++ Date Last Updated: 30 March 1994 -++ 6 October 1994 -++ Related Constructors: FortranVectorFunctionCategory, FortranProgramCategory -++ Description: -++\spadtype{Asp78} produces Fortran for Type 78 ASPs, needed for NAG routine -++\axiomOpFrom{d02gbf}{d02Package}, for example: -++\begin{verbatim} -++ SUBROUTINE FCNG(X,G) -++ DOUBLE PRECISION G(*),X -++ G(1)=0.0D0 -++ G(2)=0.0D0 -++ END -++\end{verbatim} - -Asp78(name): Exports == Implementation where - name : Symbol - - FST ==> FortranScalarType - FSTU ==> Union(fst:FST,void:"void") - FT ==> FortranType - FC ==> FortranCode - SYMTAB ==> SymbolTable - RSFC ==> Record(localSymbols:SymbolTable,code:List(FC)) - FRAC ==> Fraction - POLY ==> Polynomial - EXPR ==> Expression - INT ==> Integer - FLOAT ==> Float - VEC ==> Vector - VF2 ==> VectorFunctions2 - MFLOAT ==> MachineFloat - FEXPR ==> FortranExpression(['X],[],MFLOAT) - - Exports ==> FortranVectorFunctionCategory with - coerce : VEC FEXPR -> $ - ++coerce(f) takes objects from the appropriate instantiation of - ++\spadtype{FortranExpression} and turns them into an ASP. - - Implementation ==> add - - real : FSTU := ["real"::FST]$FSTU - syms : SYMTAB := empty()$SYMTAB - declare!(X,fortranReal(),syms)$SYMTAB - gType : FT := construct(real,["*"::Symbol],false)$FT - declare!(G,gType,syms)$SYMTAB - Rep := FortranProgram(name,["void"]$FSTU,[X,G],syms) - - fexpr2expr(u:FEXPR):EXPR MFLOAT == coerce(u)$FEXPR - - coerce(u:VEC FEXPR):$ == - u' : VEC EXPR MFLOAT := map(fexpr2expr,u)$VF2(FEXPR,EXPR MFLOAT) - (assign(G,u')$FC)::$ - - coerce(u:$):OutputForm == coerce(u)$Rep - - outputAsFortran(u):Void == - p := checkPrecision()$NAGLinkSupportPackage - outputAsFortran(u)$Rep - p => restorePrecision()$NAGLinkSupportPackage - - coerce(c:List FC):$ == coerce(c)$Rep - - coerce(r:RSFC):$ == coerce(r)$Rep - - coerce(c:FC):$ == coerce(c)$Rep - - retract(u:VEC FRAC POLY INT):$ == - v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY INT,FEXPR) - v::$ - - retractIfCan(u:VEC FRAC POLY INT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY INT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC FRAC POLY FLOAT):$ == - v : VEC FEXPR := map(retract,u)$VF2(FRAC POLY FLOAT,FEXPR) - v::$ - - retractIfCan(u:VEC FRAC POLY FLOAT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(FRAC POLY FLOAT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC EXPR INT):$ == - v : VEC FEXPR := map(retract,u)$VF2(EXPR INT,FEXPR) - v::$ - - retractIfCan(u:VEC EXPR INT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR INT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC EXPR FLOAT):$ == - v : VEC FEXPR := map(retract,u)$VF2(EXPR FLOAT,FEXPR) - v::$ - - retractIfCan(u:VEC EXPR FLOAT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(EXPR FLOAT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC POLY INT):$ == - v : VEC FEXPR := map(retract,u)$VF2(POLY INT,FEXPR) - v::$ - - retractIfCan(u:VEC POLY INT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY INT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - - retract(u:VEC POLY FLOAT):$ == - v : VEC FEXPR := map(retract,u)$VF2(POLY FLOAT,FEXPR) - v::$ - - retractIfCan(u:VEC POLY FLOAT):Union($,"failed") == - v:Union(VEC FEXPR,"failed"):=map(retractIfCan,u)$VF2(POLY FLOAT,FEXPR) - v case "failed" => "failed" - (v::VEC FEXPR)::$ - -@ -\section{domain ASP8 Asp8} -<>= -)abbrev domain ASP8 Asp8 -++ Author: Godfrey Nolan and Mike Dewar -++ Date Created: 11 February 1994 -++ Date Last Updated: 18 March 1994 -++ 31 May 1994 to use alternative interface. MCD -++ 30 June 1994 to handle the end condition correctly. MCD -++ 6 October 1994 -++ Related Constructors: FortranVectorFunctionCategory, FortranProgramCategory -++ Description: -++\spadtype{Asp8} produces Fortran for Type 8 ASPs, needed for NAG routine -++\axiomOpFrom{d02bbf}{d02Package}. This ASP prints intermediate values of the computed solution of -++an ODE and might look like: -++\begin{verbatim} -++ SUBROUTINE OUTPUT(XSOL,Y,COUNT,M,N,RESULT,FORWRD) -++ DOUBLE PRECISION Y(N),RESULT(M,N),XSOL -++ INTEGER M,N,COUNT -++ LOGICAL FORWRD -++ DOUBLE PRECISION X02ALF,POINTS(8) -++ EXTERNAL X02ALF -++ INTEGER I -++ POINTS(1)=1.0D0 -++ POINTS(2)=2.0D0 -++ POINTS(3)=3.0D0 -++ POINTS(4)=4.0D0 -++ POINTS(5)=5.0D0 -++ POINTS(6)=6.0D0 -++ POINTS(7)=7.0D0 -++ POINTS(8)=8.0D0 -++ COUNT=COUNT+1 -++ DO 25001 I=1,N -++ RESULT(COUNT,I)=Y(I) -++25001 CONTINUE -++ IF(COUNT.EQ.M)THEN -++ IF(FORWRD)THEN -++ XSOL=X02ALF() -++ ELSE -++ XSOL=-X02ALF() -++ ENDIF -++ ELSE -++ XSOL=POINTS(COUNT) -++ ENDIF -++ END -++\end{verbatim} - -Asp8(name): Exports == Implementation where - name : Symbol - - O ==> OutputForm - S ==> Symbol - FST ==> FortranScalarType - UFST ==> Union(fst:FST,void:"void") - FT ==> FortranType - FC ==> FortranCode - SYMTAB ==> SymbolTable - RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode)) - EX ==> Expression Integer - MFLOAT ==> MachineFloat - EXPR ==> Expression - PI ==> Polynomial Integer - EXU ==> Union(I: EXPR Integer,F: EXPR Float,CF: EXPR Complex Float, - switch: Switch) - - Exports ==> FortranVectorCategory - - Implementation ==> add - - real : UFST := ["real"::FST]$UFST - syms : SYMTAB := empty()$SYMTAB - declare!([COUNT,M,N],fortranInteger(),syms)$SYMTAB - declare!(XSOL,fortranReal(),syms)$SYMTAB - yType : FT := construct(real,[N],false)$FT - declare!(Y,yType,syms)$SYMTAB - declare!(FORWRD,fortranLogical(),syms)$SYMTAB - declare!(RESULT,construct(real,[M,N],false)$FT,syms)$SYMTAB - Rep := FortranProgram(name,["void"]$UFST,[XSOL,Y,COUNT,M,N,RESULT,FORWRD],syms) - - coerce(c:List FC):% == coerce(c)$Rep - - coerce(r:RSFC):% == coerce(r)$Rep - - coerce(c:FC):% == coerce(c)$Rep - - coerce(u:%):O == coerce(u)$Rep - - outputAsFortran(u:%):Void == - p := checkPrecision()$NAGLinkSupportPackage - outputAsFortran(u)$Rep - p => restorePrecision()$NAGLinkSupportPackage - - - f2ex(u:MFLOAT):EXPR MFLOAT == (u::EXPR MFLOAT)$EXPR(MFLOAT) - - coerce(points:Vector MFLOAT):% == - import PI - import EXPR Integer - -- Create some extra declarations - locals : SYMTAB := empty()$SYMTAB - nPol : PI := "N"::S::PI - iPol : PI := "I"::S::PI - countPol : PI := "COUNT"::S::PI - pointsDim : PI := max(#points,1)::PI - declare!(POINTS,[real,[pointsDim],false]$FT,locals)$SYMTAB - declare!(X02ALF,[real,[],true]$FT,locals)$SYMTAB - -- Now build up the code fragments - index : SegmentBinding PI := equation(I@S,1::PI..nPol)$SegmentBinding(PI) - ySym : EX := (subscript("Y"::S,[I::O])$S)::EX - loop := forLoop(index,assign(RESULT,[countPol,iPol],ySym)$FC)$FC - v:Vector EXPR MFLOAT - v := map(f2ex,points)$VectorFunctions2(MFLOAT,EXPR MFLOAT) - assign1 : FC := assign(POINTS,v)$FC - countExp: EX := COUNT@S::EX - newValue: EX := 1 + countExp - assign2 : FC := assign(COUNT,newValue)$FC - newSymbol : S := subscript(POINTS,[COUNT]@List(O))$S - assign3 : FC := assign(XSOL, newSymbol::EX )$FC - fphuge : EX := kernel(operator X02ALF,empty()$List(EX)) - assign4 : FC := assign(XSOL, fphuge)$FC - assign5 : FC := assign(XSOL, -fphuge)$FC - innerCond : FC := cond("FORWRD"::Symbol::Switch,assign4,assign5) - mExp : EX := M@S::EX - endCase : FC := cond(EQ([countExp]$EXU,[mExp]$EXU)$Switch,innerCond,assign3) - code := [assign1, assign2, loop, endCase]$List(FC) - ([locals,code]$RSFC)::% - -@ -\section{domain ASP80 Asp80} -<>= -)abbrev domain ASP80 Asp80 -++ Author: Mike Dewar and Godfrey Nolan -++ Date Created: Oct 1993 -++ Date Last Updated: 30 March 1994 -++ 6 October 1994 -++ Related Constructors: FortranMatrixFunctionCategory, FortranProgramCategory -++ Description: -++\spadtype{Asp80} produces Fortran for Type 80 ASPs, needed for NAG routine -++\axiomOpFrom{d02kef}{d02Package}, for example: -++\begin{verbatim} -++ SUBROUTINE BDYVAL(XL,XR,ELAM,YL,YR) -++ DOUBLE PRECISION ELAM,XL,YL(3),XR,YR(3) -++ YL(1)=XL -++ YL(2)=2.0D0 -++ YR(1)=1.0D0 -++ YR(2)=-1.0D0*DSQRT(XR+(-1.0D0*ELAM)) -++ RETURN -++ END -++\end{verbatim} - -Asp80(name): Exports == Implementation where - name : Symbol - - FST ==> FortranScalarType - FSTU ==> Union(fst:FST,void:"void") - FT ==> FortranType - FC ==> FortranCode - SYMTAB ==> SymbolTable - RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode)) - FRAC ==> Fraction - POLY ==> Polynomial - EXPR ==> Expression - INT ==> Integer - FLOAT ==> Float - MFLOAT ==> MachineFloat - FEXPR ==> FortranExpression(['XL,'XR,'ELAM],[],MFLOAT) - VEC ==> Vector - MAT ==> Matrix - VF2 ==> VectorFunctions2 - M2 ==> MatrixCategoryFunctions2 - MF2a ==> M2(FRAC POLY INT,VEC FRAC POLY INT,VEC FRAC POLY INT, - MAT FRAC POLY INT, FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR) - MF2b ==> M2(FRAC POLY FLOAT,VEC FRAC POLY FLOAT,VEC FRAC POLY FLOAT, - MAT FRAC POLY FLOAT, FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR) - MF2c ==> M2(POLY INT,VEC POLY INT,VEC POLY INT,MAT POLY INT, - FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR) - MF2d ==> M2(POLY FLOAT,VEC POLY FLOAT,VEC POLY FLOAT, - MAT POLY FLOAT, FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR) - MF2e ==> M2(EXPR INT,VEC EXPR INT,VEC EXPR INT,MAT EXPR INT, - FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR) - MF2f ==> M2(EXPR FLOAT,VEC EXPR FLOAT,VEC EXPR FLOAT, - MAT EXPR FLOAT, FEXPR,VEC FEXPR,VEC FEXPR,MAT FEXPR) - - Exports ==> FortranMatrixFunctionCategory with - coerce : MAT FEXPR -> $ - ++coerce(f) takes objects from the appropriate instantiation of - ++\spadtype{FortranExpression} and turns them into an ASP. - - Implementation ==> add - - real : FSTU := ["real"::FST]$FSTU - syms : SYMTAB := empty()$SYMTAB - declare!(XL,fortranReal(),syms)$SYMTAB - declare!(XR,fortranReal(),syms)$SYMTAB - declare!(ELAM,fortranReal(),syms)$SYMTAB - yType : FT := construct(real,["3"::Symbol],false)$FT - declare!(YL,yType,syms)$SYMTAB - declare!(YR,yType,syms)$SYMTAB - Rep := FortranProgram(name,["void"]$FSTU, [XL,XR,ELAM,YL,YR],syms) - - fexpr2expr(u:FEXPR):EXPR MFLOAT == coerce(u)$FEXPR - - vecAssign(s:Symbol,u:VEC FEXPR):FC == - u' : VEC EXPR MFLOAT := map(fexpr2expr,u)$VF2(FEXPR,EXPR MFLOAT) - assign(s,u')$FC - - coerce(u:MAT FEXPR):$ == - [vecAssign(YL,row(u,1)),vecAssign(YR,row(u,2)),returns()$FC]$List(FC)::$ - - coerce(c:List FortranCode):$ == coerce(c)$Rep - - coerce(r:RSFC):$ == coerce(r)$Rep - - coerce(c:FortranCode):$ == coerce(c)$Rep - - coerce(u:$):OutputForm == coerce(u)$Rep - - outputAsFortran(u):Void == - p := checkPrecision()$NAGLinkSupportPackage - outputAsFortran(u)$Rep - p => restorePrecision()$NAGLinkSupportPackage - - retract(u:MAT FRAC POLY INT):$ == - v : MAT FEXPR := map(retract,u)$MF2a - v::$ - - retractIfCan(u:MAT FRAC POLY INT):Union($,"failed") == - v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2a - v case "failed" => "failed" - (v::MAT FEXPR)::$ - - retract(u:MAT FRAC POLY FLOAT):$ == - v : MAT FEXPR := map(retract,u)$MF2b - v::$ - - retractIfCan(u:MAT FRAC POLY FLOAT):Union($,"failed") == - v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2b - v case "failed" => "failed" - (v::MAT FEXPR)::$ - - retract(u:MAT EXPR INT):$ == - v : MAT FEXPR := map(retract,u)$MF2e - v::$ - - retractIfCan(u:MAT EXPR INT):Union($,"failed") == - v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2e - v case "failed" => "failed" - (v::MAT FEXPR)::$ - - retract(u:MAT EXPR FLOAT):$ == - v : MAT FEXPR := map(retract,u)$MF2f - v::$ - - retractIfCan(u:MAT EXPR FLOAT):Union($,"failed") == - v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2f - v case "failed" => "failed" - (v::MAT FEXPR)::$ - - retract(u:MAT POLY INT):$ == - v : MAT FEXPR := map(retract,u)$MF2c - v::$ - - retractIfCan(u:MAT POLY INT):Union($,"failed") == - v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2c - v case "failed" => "failed" - (v::MAT FEXPR)::$ - - retract(u:MAT POLY FLOAT):$ == - v : MAT FEXPR := map(retract,u)$MF2d - v::$ - - retractIfCan(u:MAT POLY FLOAT):Union($,"failed") == - v:Union(MAT FEXPR,"failed"):=map(retractIfCan,u)$MF2d - v case "failed" => "failed" - (v::MAT FEXPR)::$ - -@ -\section{domain ASP9 Asp9} -<>= -)abbrev domain ASP9 Asp9 -++ Author: Mike Dewar, Grant Keady and Godfrey Nolan -++ Date Created: Mar 1993 -++ Date Last Updated: 18 March 1994 -++ 12 July 1994 added COMMON blocks for d02cjf, d02ejf -++ 6 October 1994 -++ Related Constructors: FortranVectorFunctionCategory, FortranProgramCategory -++ Description: -++ \spadtype{Asp9} produces Fortran for Type 9 ASPs, needed for NAG routines -++ \axiomOpFrom{d02bhf}{d02Package}, -++ \axiomOpFrom{d02cjf}{d02Package}, -++ \axiomOpFrom{d02ejf}{d02Package}. -++ These ASPs represent a function of a scalar X and a vector Y, for example: -++ \begin{verbatim} -++ DOUBLE PRECISION FUNCTION G(X,Y) -++ DOUBLE PRECISION X,Y(*) -++ G=X+Y(1) -++ RETURN -++ END -++ \end{verbatim} -++ If the user provides a constant value for G, then extra information is added -++ via COMMON blocks used by certain routines. This specifies that the value -++ returned by G in this case is to be ignored. - -Asp9(name): Exports == Implementation where - name : Symbol - - FEXPR ==> FortranExpression(['X],['Y],MFLOAT) - MFLOAT ==> MachineFloat - FC ==> FortranCode - FST ==> FortranScalarType - FT ==> FortranType - SYMTAB ==> SymbolTable - RSFC ==> Record(localSymbols:SymbolTable,code:List(FortranCode)) - UFST ==> Union(fst:FST,void:"void") - FRAC ==> Fraction - POLY ==> Polynomial - EXPR ==> Expression - INT ==> Integer - FLOAT ==> Float - - Exports ==> FortranFunctionCategory with - coerce : FEXPR -> % - ++coerce(f) takes an object from the appropriate instantiation of - ++\spadtype{FortranExpression} and turns it into an ASP. - - Implementation ==> add - - real : FST := "real"::FST - syms : SYMTAB := empty()$SYMTAB - declare!(X,fortranReal()$FT,syms)$SYMTAB - yType : FT := construct([real]$UFST,["*"::Symbol],false)$FT - declare!(Y,yType,syms)$SYMTAB - Rep := FortranProgram(name,[real]$UFST,[X,Y],syms) - - retract(u:FRAC POLY INT):$ == (retract(u)@FEXPR)::$ - retractIfCan(u:FRAC POLY INT):Union($,"failed") == - foo : Union(FEXPR,"failed") - foo := retractIfCan(u)$FEXPR - foo case "failed" => "failed" - (foo::FEXPR)::$ - - retract(u:FRAC POLY FLOAT):$ == (retract(u)@FEXPR)::$ - retractIfCan(u:FRAC POLY FLOAT):Union($,"failed") == - foo : Union(FEXPR,"failed") - foo := retractIfCan(u)$FEXPR - foo case "failed" => "failed" - (foo::FEXPR)::$ - - retract(u:EXPR FLOAT):$ == (retract(u)@FEXPR)::$ - retractIfCan(u:EXPR FLOAT):Union($,"failed") == - foo : Union(FEXPR,"failed") - foo := retractIfCan(u)$FEXPR - foo case "failed" => "failed" - (foo::FEXPR)::$ - - retract(u:EXPR INT):$ == (retract(u)@FEXPR)::$ - retractIfCan(u:EXPR INT):Union($,"failed") == - foo : Union(FEXPR,"failed") - foo := retractIfCan(u)$FEXPR - foo case "failed" => "failed" - (foo::FEXPR)::$ - - retract(u:POLY FLOAT):$ == (retract(u)@FEXPR)::$ - retractIfCan(u:POLY FLOAT):Union($,"failed") == - foo : Union(FEXPR,"failed") - foo := retractIfCan(u)$FEXPR - foo case "failed" => "failed" - (foo::FEXPR)::$ - - retract(u:POLY INT):$ == (retract(u)@FEXPR)::$ - retractIfCan(u:POLY INT):Union($,"failed") == - foo : Union(FEXPR,"failed") - foo := retractIfCan(u)$FEXPR - foo case "failed" => "failed" - (foo::FEXPR)::$ - - coerce(u:FEXPR):% == - expr : Expression MachineFloat := (u::Expression(MachineFloat))$FEXPR - (retractIfCan(u)@Union(MFLOAT,"failed"))$FEXPR case "failed" => - coerce(expr)$Rep - locals : SYMTAB := empty() - charType : FT := construct(["character"::FST]$UFST,[6::POLY(INT)],false)$FT - declare!([CHDUM1,CHDUM2,GOPT1,CHDUM,GOPT2],charType,locals)$SYMTAB - common1 := common(CD02EJ,[CHDUM1,CHDUM2,GOPT1] )$FC - common2 := common(AD02CJ,[CHDUM,GOPT2] )$FC - assign1 := assign(GOPT1,"NOGOPT")$FC - assign2 := assign(GOPT2,"NOGOPT")$FC - result := assign(name,expr)$FC - code : List FC := [common1,common2,assign1,assign2,result] - ([locals,code]$RSFC)::Rep - - coerce(c:List FortranCode):% == coerce(c)$Rep - - coerce(r:RSFC):% == coerce(r)$Rep - - coerce(c:FortranCode):% == coerce(c)$Rep - - coerce(u:%):OutputForm == coerce(u)$Rep - - outputAsFortran(u):Void == - p := checkPrecision()$NAGLinkSupportPackage - outputAsFortran(u)$Rep - p => restorePrecision()$NAGLinkSupportPackage - -@ -\section{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. -@ -<<*>>= -<> - -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -<> -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index 14a951d..c3b380b 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -739,6 +739,10 @@ ubuntu64 parallel core support
put axiom-website under git control
20081123.01.tpd.patch fraction.spad missed in category update
+20081124.01.tpd.patch +November release cleanup
+20081124.02.tpd.patch +bookvol10.3 add domains
\ No newline at end of file