diff --git a/books/bookvol10.3.pamphlet b/books/bookvol10.3.pamphlet index 6e000ec..508767b 100644 --- a/books/bookvol10.3.pamphlet +++ b/books/bookvol10.3.pamphlet @@ -5168,6 +5168,189 @@ Asp9(name): Exports == Implementation where %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Chapter B} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain BFUNCT BasicFunctions} +\pagehead{BasicFunctions}{BFUNCT} +\pagepic{ps/v103basicfunctions.ps}{BFUNCT}{1.00} +<>= +)abbrev domain BFUNCT BasicFunctions +++ Author: Brian Dupee +++ Date Created: August 1994 +++ Date Last Updated: April 1996 +++ Basic Operations: bfKeys, bfEntry +++ Description: A Domain which implements a table containing details of +++ points at which particular functions have evaluation problems. +DF ==> DoubleFloat +SDF ==> Stream DoubleFloat +RS ==> Record(zeros: SDF, ones: SDF, singularities: SDF) + +BasicFunctions(): E == I where + E ==> SetCategory with + bfKeys:() -> List Symbol + ++ bfKeys() returns the names of each function in the + ++ \axiomType{BasicFunctions} table + bfEntry:Symbol -> RS + ++ bfEntry(k) returns the entry in the \axiomType{BasicFunctions} table + ++ corresponding to \spad{k} + finiteAggregate + + I ==> add + + Rep := Table(Symbol,RS) + import Rep, SDF + + f(x:DF):DF == + positive?(x) => -x + -x+1 + + bf():$ == + import RS + dpi := pi()$DF + ndpi:SDF := map(#1*dpi,(z := generate(f,0))) -- [n pi for n in Z] + n1dpi:SDF := map(-(2*(#1)-1)*dpi/2,z) -- [(n+1) pi /2] + n2dpi:SDF := map(2*#1*dpi,z) -- [2 n pi for n in Z] + n3dpi:SDF := map(-(4*(#1)-1)*dpi/4,z) + n4dpi:SDF := map(-(4*(#1)-1)*dpi/2,z) + sinEntry:RS := [ndpi, n4dpi, empty()$SDF] + cosEntry:RS := [n1dpi, n2dpi, esdf := empty()$SDF] + tanEntry:RS := [ndpi, n3dpi, n1dpi] + asinEntry:RS := [construct([0$DF])$SDF, + construct([float(8414709848078965,-16,10)$DF]), esdf] + acosEntry:RS := [construct([1$DF])$SDF, + construct([float(54030230586813977,-17,10)$DF]), esdf] + atanEntry:RS := [construct([0$DF])$SDF, + construct([float(15574077246549023,-16,10)$DF]), esdf] + secEntry:RS := [esdf, n2dpi, n1dpi] + cscEntry:RS := [esdf, n4dpi, ndpi] + cotEntry:RS := [n1dpi, n3dpi, ndpi] + logEntry:RS := [construct([1$DF])$SDF,esdf, construct([0$DF])$SDF] + entryList:List(Record(key:Symbol,entry:RS)) := + [[sin@Symbol, sinEntry], [cos@Symbol, cosEntry], + [tan@Symbol, tanEntry], [sec@Symbol, secEntry], + [csc@Symbol, cscEntry], [cot@Symbol, cotEntry], + [asin@Symbol, asinEntry], [acos@Symbol, acosEntry], + [atan@Symbol, atanEntry], [log@Symbol, logEntry]] + construct(entryList)$Rep + + bfKeys():List Symbol == keys(bf())$Rep + + bfEntry(k:Symbol):RS == qelt(bf(),k)$Rep + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain BINFILE BinaryFile} +\pagehead{BinaryFile}{BINFILE} +\pagepic{ps/v103binaryfile.ps}{BINFILE}{1.00} +See also:\\ +\refto{File}{FILE} +\refto{TextFile}{TEXTFILE} +\refto{KeyedAccessFile}{KAFILE} +\refto{Library}{LIB} +<>= +)abbrev domain BINFILE BinaryFile +++ Author: Barry M. Trager +++ Date Created: 1993 +++ Date Last Updated: +++ Basic Operations: writeByte! readByte! readByteIfCan! +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ This domain provides an implementation of binary files. Data is +++ accessed one byte at a time as a small integer. + +BinaryFile: Cat == Def where + + Cat == FileCategory(FileName, SingleInteger) with + readIfCan_!: % -> Union(SingleInteger, "failed") + ++ readIfCan!(f) returns a value from the file f, if possible. + ++ If f is not open for reading, or if f is at the end of file + ++ then \spad{"failed"} is the result. + +-- "#": % -> SingleInteger +-- ++ #(f) returns the length of the file f in bytes. + + position: % -> SingleInteger + ++ position(f) returns the current byte-position in the file f. + + position_!: (%, SingleInteger) -> SingleInteger + ++ position!(f, i) sets the current byte-position to i. + + Def == File(SingleInteger) add + FileState ==> SExpression + + Rep := Record(fileName: FileName, _ + fileState: FileState, _ + fileIOmode: String) + +-- direc : Symbol := INTERN("DIRECTION","KEYWORD")$Lisp +-- input : Symbol := INTERN("INPUT","KEYWORD")$Lisp +-- output : Symbol := INTERN("OUTPUT","KEYWORD")$Lisp +-- eltype : Symbol := INTERN("ELEMENT-TYPE","KEYWORD")$Lisp +-- bytesize : SExpression := LIST(QUOTE(UNSIGNED$Lisp)$Lisp,8)$Lisp + + + defstream(fn: FileName, mode: String): FileState == + mode = "input" => + not readable? fn => error ["File is not readable", fn] + BINARY__OPEN__INPUT(fn::String)$Lisp +-- OPEN(fn::String, direc, input, eltype, bytesize)$Lisp + mode = "output" => + not writable? fn => error ["File is not writable", fn] + BINARY__OPEN__OUTPUT(fn::String)$Lisp +-- OPEN(fn::String, direc, output, eltype, bytesize)$Lisp + error ["IO mode must be input or output", mode] + + open(fname, mode) == + fstream := defstream(fname, mode) + [fname, fstream, mode] + + reopen_!(f, mode) == + fname := f.fileName + f.fileState := defstream(fname, mode) + f.fileIOmode:= mode + f + + close_! f == + f.fileIOmode = "output" => + BINARY__CLOSE__OUTPUT()$Lisp + f + f.fileIOmode = "input" => + BINARY__CLOSE__INPUT()$Lisp + f + error "file must be in read or write state" + + read! f == + f.fileIOmode ^= "input" => error "File not in read state" + BINARY__SELECT__INPUT(f.fileState)$Lisp + BINARY__READBYTE()$Lisp +-- READ_-BYTE(f.fileState)$Lisp + readIfCan_! f == + f.fileIOmode ^= "input" => error "File not in read state" + BINARY__SELECT__INPUT(f.fileState)$Lisp + n:SingleInteger:=BINARY__READBYTE()$Lisp + n = -1 => "failed" + n::Union(SingleInteger,"failed") +-- READ_-BYTE(f.fileState,NIL$Lisp, +-- "failed"::Union(SingleInteger,"failed"))$Lisp + write_!(f, x) == + f.fileIOmode ^= "output" => error "File not in write state" + x < 0 or x>255 => error "integer cannot be represented as a byte" + BINARY__PRINBYTE(x)$Lisp +-- WRITE_-BYTE(x, f.fileState)$Lisp + x + +-- # f == FILE_-LENGTH(f.fileState)$Lisp + position f == + f.fileIOmode ^= "input" => error "file must be in read state" + FILE_-POSITION(f.fileState)$Lisp + position_!(f,i) == + f.fileIOmode ^= "input" => error "file must be in read state" + (FILE_-POSITION(f.fileState,i)$Lisp ; i) + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{domain BITS Bits} <>= "BITS" -> "BTAGG" @@ -8505,6 +8688,53 @@ Color(): Exports == Implementation where @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain COMM Commutator} +\pagehead{Commutator}{COMM} +\pagepic{ps/v103commutator.ps}{COMM}{1.00} +See also:\\ +\refto{OrdSetInts}{OSI} +\refto{FreeNilpotentLie}{FNLA} +<>= +)abbrev domain COMM Commutator +++ Author : Larry Lambe +++ Date created: 30 June 1988. +++ Updated : 10 March 1991 +++ Description: A type for basic commutators +Commutator: Export == Implement where + I ==> Integer + OSI ==> OrdSetInts + O ==> OutputForm + + Export == SetCategory with + mkcomm : I -> % + ++ mkcomm(i) \undocumented{} + mkcomm : (%,%) -> % + ++ mkcomm(i,j) \undocumented{} + + Implement == add + P := Record(left:%,right:%) + Rep := Union(OSI,P) + x,y: % + i : I + + x = y == + (x case OSI) and (y case OSI) => x::OSI = y::OSI + (x case P) and (y case P) => + xx:P := x::P + yy:P := y::P + (xx.right = yy.right) and (xx.left = yy.left) + false + + mkcomm(i) == i::OSI + mkcomm(x,y) == construct(x,y)$P + + coerce(x: %): O == + x case OSI => x::OSI::O + xx := x::P + bracket([xx.left::O,xx.right::O])$O + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{domain CONTFRAC ContinuedFraction} <>= -- contfrac.spad.pamphlet ContinuedFraction.input @@ -15938,6 +16168,1785 @@ e04ucfAnnaType(): NumericalOptimizationCategory == Result add %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Chapter F} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain FR Factored} +<>= +-- fr.spad.pamphlet Factored.input +)spool Factored.output +)set message test on +)set message auto off +)clear all +--S 1 of 38 +g := factor(4312) +--R +--R +--R 3 2 +--R (1) 2 7 11 +--R Type: Factored Integer +--E 1 + +--S 2 of 38 +unit(g) +--R +--R +--R (2) 1 +--R Type: PositiveInteger +--E 2 + +--S 3 of 38 +numberOfFactors(g) +--R +--R +--R (3) 3 +--R Type: PositiveInteger +--E 3 + +--S 4 of 38 +[nthFactor(g,i) for i in 1..numberOfFactors(g)] +--R +--R +--R (4) [2,7,11] +--R Type: List Integer +--E 4 + +--S 5 of 38 +[nthExponent(g,i) for i in 1..numberOfFactors(g)] +--R +--R +--R (5) [3,2,1] +--R Type: List Integer +--E 5 + +--S 6 of 38 +[nthFlag(g,i) for i in 1..numberOfFactors(g)] +--R +--R +--R (6) ["prime","prime","prime"] +--R Type: List Union("nil","sqfr","irred","prime") +--E 6 + +--S 7 of 38 +factorList(g) +--R +--R +--R (7) +--R [[flg= "prime",fctr= 2,xpnt= 3], [flg= "prime",fctr= 7,xpnt= 2], +--R [flg= "prime",fctr= 11,xpnt= 1]] +--RType: List Record(flg: Union("nil","sqfr","irred","prime"),fctr: Integer,xpnt: Integer) +--E 7 + +--S 8 of 38 +factors(g) +--R +--R +--R (8) +--R [[factor= 2,exponent= 3],[factor= 7,exponent= 2],[factor= 11,exponent= 1]] +--R Type: List Record(factor: Integer,exponent: Integer) +--E 8 + +--S 9 of 38 +first(%).factor +--R +--R +--R (9) 2 +--R Type: PositiveInteger +--E 9 + +--S 10 of 38 +g := factor(4312) +--R +--R +--R 3 2 +--R (10) 2 7 11 +--R Type: Factored Integer +--E 10 + +--S 11 of 38 +expand(g) +--R +--R +--R (11) 4312 +--R Type: PositiveInteger +--E 11 + +--S 12 of 38 +reduce(*,[t.factor for t in factors(g)]) +--R +--R +--R (12) 154 +--R Type: PositiveInteger +--E 12 + +--S 13 of 38 +g := factor(4312) +--R +--R +--R 3 2 +--R (13) 2 7 11 +--R Type: Factored Integer +--E 13 + +--S 14 of 38 +f := factor(246960) +--R +--R +--R 4 2 3 +--R (14) 2 3 5 7 +--R Type: Factored Integer +--E 14 + +--S 15 of 38 +f * g +--R +--R +--R 7 2 5 +--R (15) 2 3 5 7 11 +--R Type: Factored Integer +--E 15 + +--S 16 of 38 +f**500 +--R +--R +--R 2000 1000 500 1500 +--R (16) 2 3 5 7 +--R Type: Factored Integer +--E 16 + +--S 17 of 38 +gcd(f,g) +--R +--R +--R 3 2 +--R (17) 2 7 +--R Type: Factored Integer +--E 17 + +--S 18 of 38 +lcm(f,g) +--R +--R +--R 4 2 3 +--R (18) 2 3 5 7 11 +--R Type: Factored Integer +--E 18 + +--S 19 of 38 +f + g +--R +--R +--R 3 2 +--R (19) 2 7 641 +--R Type: Factored Integer +--E 19 + +--S 20 of 38 +f - g +--R +--R +--R 3 2 +--R (20) 2 7 619 +--R Type: Factored Integer +--E 20 + +--S 21 of 38 +zero?(factor(0)) +--R +--R +--R (21) true +--R Type: Boolean +--E 21 + +--S 22 of 38 +zero?(g) +--R +--R +--R (22) false +--R Type: Boolean +--E 22 + +--S 23 of 38 +one?(factor(1)) +--R +--R +--R (23) true +--R Type: Boolean +--E 23 + +--S 24 of 38 +one?(f) +--R +--R +--R (24) false +--R Type: Boolean +--E 24 + +--S 25 of 38 +0$Factored(Integer) +--R +--R +--R (25) 0 +--R Type: Factored Integer +--E 25 + +--S 26 of 38 +1$Factored(Integer) +--R +--R +--R (26) 1 +--R Type: Factored Integer +--E 26 + +--S 27 of 38 +nilFactor(24,2) +--R +--R +--R 2 +--R (27) 24 +--R Type: Factored Integer +--E 27 + +--S 28 of 38 +nthFlag(%,1) +--R +--R +--R (28) "nil" +--R Type: Union("nil",...) +--E 28 + +--S 29 of 38 +sqfrFactor(30,2) +--R +--R +--R 2 +--R (29) 30 +--R Type: Factored Integer +--E 29 + +--S 30 of 38 +irreducibleFactor(13,10) +--R +--R +--R 10 +--R (30) 13 +--R Type: Factored Integer +--E 30 + +--S 31 of 38 +primeFactor(11,5) +--R +--R +--R 5 +--R (31) 11 +--R Type: Factored Integer +--E 31 + +--S 32 of 38 +h := factor(-720) +--R +--R +--R 4 2 +--R (32) - 2 3 5 +--R Type: Factored Integer +--E 32 + +--S 33 of 38 +h - makeFR(unit(h),factorList(h)) +--R +--R +--R (33) 0 +--R Type: Factored Integer +--E 33 + +--S 34 of 38 +p := (4*x*x-12*x+9)*y*y + (4*x*x-12*x+9)*y + 28*x*x - 84*x + 63 +--R +--R +--R 2 2 2 2 +--R (34) (4x - 12x + 9)y + (4x - 12x + 9)y + 28x - 84x + 63 +--R Type: Polynomial Integer +--E 34 + +--S 35 of 38 +fp := factor(p) +--R +--R +--R 2 2 +--R (35) (2x - 3) (y + y + 7) +--R Type: Factored Polynomial Integer +--E 35 + +--S 36 of 38 +D(p,x) +--R +--R +--R 2 +--R (36) (8x - 12)y + (8x - 12)y + 56x - 84 +--R Type: Polynomial Integer +--E 36 + +--S 37 of 38 +D(fp,x) +--R +--R +--R 2 +--R (37) 4(2x - 3)(y + y + 7) +--R Type: Factored Polynomial Integer +--E 37 + +--S 38 of 38 +numberOfFactors(%) +--R +--R +--R (38) 3 +--R Type: PositiveInteger +--E 38 +)spool +)lisp (bye) +@ +<>= +==================================================================== +Factored examples +==================================================================== + +Factored creates a domain whose objects are kept in factored form as +long as possible. Thus certain operations like * (multiplication) and +gcd are relatively easy to do. Others, such as addition, require +somewhat more work, and the result may not be completely factored +unless the argument domain R provides a factor operation. Each object +consists of a unit and a list of factors, where each factor consists +of a member of R (the base), an exponent, and a flag indicating what +is known about the base. A flag may be one of "nil", "sqfr", "irred" +or "prime", which mean that nothing is known about the base, it is +square-free, it is irreducible, or it is prime, respectively. The +current restriction to factored objects of integral domains allows +simplification to be performed without worrying about multiplication +order. + +==================================================================== +Decomposing Factored Objects +==================================================================== + +In this section we will work with a factored integer. + + g := factor(4312) + 3 2 + 2 7 11 + Type: Factored Integer + +Let's begin by decomposing g into pieces. The only possible +units for integers are 1 and -1. + + unit(g) + 1 + Type: PositiveInteger + +There are three factors. + + numberOfFactors(g) + 3 + Type: PositiveInteger + +We can make a list of the bases, ... + + [nthFactor(g,i) for i in 1..numberOfFactors(g)] + [2,7,11] + Type: List Integer + +and the exponents, ... + + [nthExponent(g,i) for i in 1..numberOfFactors(g)] + [3,2,1] + Type: List Integer + +and the flags. You can see that all the bases (factors) are prime. + + [nthFlag(g,i) for i in 1..numberOfFactors(g)] + ["prime","prime","prime"] + Type: List Union("nil","sqfr","irred","prime") + +A useful operation for pulling apart a factored object into a list +of records of the components is factorList. + + factorList(g) + [[flg= "prime",fctr= 2,xpnt= 3], [flg= "prime",fctr= 7,xpnt= 2], + [flg= "prime",fctr= 11,xpnt= 1]] + Type: List Record(flg: Union("nil","sqfr","irred","prime"), + fctr: Integer,xpnt: Integer) + +If you don't care about the flags, use factors. + + factors(g) + [[factor= 2,exponent= 3],[factor= 7,exponent= 2],[factor= 11,exponent= 1]] + Type: List Record(factor: Integer,exponent: Integer) + +Neither of these operations returns the unit. + + first(%).factor + 2 + Type: PositiveInteger + +==================================================================== +Expanding Factored Objects +==================================================================== + +Recall that we are working with this factored integer. + + g := factor(4312) + 3 2 + 2 7 11 + Type: Factored Integer + +To multiply out the factors with their multiplicities, use expand. + + expand(g) + 4312 + Type: PositiveInteger + +If you would like, say, the distinct factors multiplied together but +with multiplicity one, you could do it this way. + + reduce(*,[t.factor for t in factors(g)]) + 154 + Type: PositiveInteger + +==================================================================== +Arithmetic with Factored Objects +==================================================================== + +We're still working with this factored integer. + + g := factor(4312) + 3 2 + 2 7 11 + Type: Factored Integer + +We'll also define this factored integer. + + f := factor(246960) + 4 2 3 + 2 3 5 7 + Type: Factored Integer + +Operations involving multiplication and division are particularly +easy with factored objects. + + f * g + 7 2 5 + 2 3 5 7 11 + Type: Factored Integer + + f**500 + 2000 1000 500 1500 + 2 3 5 7 + Type: Factored Integer + + gcd(f,g) + 3 2 + 2 7 + Type: Factored Integer + + lcm(f,g) + 4 2 3 + 2 3 5 7 11 + Type: Factored Integer + +If we use addition and subtraction things can slow down because +we may need to compute greatest common divisors. + + f + g + 3 2 + 2 7 641 + Type: Factored Integer + + f - g + 3 2 + 2 7 619 + Type: Factored Integer + +Test for equality with 0 and 1 by using zero? and one?, respectively. + + zero?(factor(0)) + true + Type: Boolean + + zero?(g) + false + Type: Boolean + + one?(factor(1)) + true + Type: Boolean + + one?(f) + false + Type: Boolean + +Another way to get the zero and one factored objects is to use +package calling. + + 0$Factored(Integer) + 0 + Type: Factored Integer + + 1$Factored(Integer) + 1 + Type: Factored Integer + +==================================================================== +Creating New Factored Objects +==================================================================== + +The map operation is used to iterate across the unit and bases of a +factored object. + +The following four operations take a base and an exponent and create a +factored object. They differ in handling the flag component. + + nilFactor(24,2) + 2 + 24 + Type: Factored Integer + +This factor has no associated information. + + nthFlag(%,1) + "nil" + Type: Union("nil",...) + +This factor is asserted to be square-free. + + sqfrFactor(30,2) + 2 + 30 + Type: Factored Integer + +This factor is asserted to be irreducible. + + irreducibleFactor(13,10) + 10 + 13 + Type: Factored Integer + +This factor is asserted to be prime. + + primeFactor(11,5) + 5 + 11 + Type: Factored Integer + +A partial inverse to factorList is makeFR. + + h := factor(-720) + 4 2 + - 2 3 5 + Type: Factored Integer + +The first argument is the unit and the second is a list of records as +returned by factorList. + + h - makeFR(unit(h),factorList(h)) + 0 + Type: Factored Integer + +==================================================================== +Factored Objects with Variables +==================================================================== + +Some of the operations available for polynomials are also available +for factored polynomials. + + p := (4*x*x-12*x+9)*y*y + (4*x*x-12*x+9)*y + 28*x*x - 84*x + 63 + 2 2 2 2 + (4x - 12x + 9)y + (4x - 12x + 9)y + 28x - 84x + 63 + Type: Polynomial Integer + + fp := factor(p) + 2 2 + (2x - 3) (y + y + 7) + Type: Factored Polynomial Integer + +You can differentiate with respect to a variable. + + D(p,x) + 2 + (8x - 12)y + (8x - 12)y + 56x - 84 + Type: Polynomial Integer + + D(fp,x) + 2 + 4(2x - 3)(y + y + 7) + Type: Factored Polynomial Integer + + numberOfFactors(%) + 3 + Type: PositiveInteger + +See Also: +o )help FactoredFunctions2 +o )show Factored +o $AXIOM/doc/src/algebra/fr.spad.dvi + +@ +\pagehead{Factored}{FR} +\pagepic{ps/v103factored.ps}{FR}{1.00} +<>= +)abbrev domain FR Factored +++ Author: Robert S. Sutor +++ Date Created: 1985 +++ Change History: +++ 21 Jan 1991 J Grabmeier Corrected a bug in exquo. +++ 16 Aug 1994 R S Sutor Improved convert to InputForm +++ Basic Operations: +++ expand, exponent, factorList, factors, flagFactor, irreducibleFactor, +++ makeFR, map, nilFactor, nthFactor, nthFlag, numberOfFactors, +++ primeFactor, sqfrFactor, unit, unitNormalize, +++ Related Constructors: FactoredFunctionUtilities, FactoredFunctions2 +++ Also See: +++ AMS Classifications: 11A51, 11Y05 +++ Keywords: factorization, prime, square-free, irreducible, factor +++ References: +++ Description: +++ \spadtype{Factored} creates a domain whose objects are kept in +++ factored form as long as possible. Thus certain operations like +++ multiplication and gcd are relatively easy to do. Others, like +++ addition require somewhat more work, and unless the argument +++ domain provides a factor function, the result may not be +++ completely factored. Each object consists of a unit and a list of +++ factors, where a factor has a member of R (the "base"), and +++ exponent and a flag indicating what is known about the base. A +++ flag may be one of "nil", "sqfr", "irred" or "prime", which respectively mean +++ that nothing is known about the base, it is square-free, it is +++ irreducible, or it is prime. The current +++ restriction to integral domains allows simplification to be +++ performed without worrying about multiplication order. + +Factored(R: IntegralDomain): Exports == Implementation where + fUnion ==> Union("nil", "sqfr", "irred", "prime") + FF ==> Record(flg: fUnion, fctr: R, xpnt: Integer) + SRFE ==> Set(Record(factor:R, exponent:Integer)) + + Exports ==> Join(IntegralDomain, DifferentialExtension R, Algebra R, + FullyEvalableOver R, FullyRetractableTo R) with + expand: % -> R + ++ expand(f) multiplies the unit and factors together, yielding an + ++ "unfactored" object. Note: this is purposely not called + ++ \spadfun{coerce} which would cause the interpreter to do this + ++ automatically. + ++ + ++X f:=nilFactor(y-x,3) + ++X expand(f) + + exponent: % -> Integer + ++ exponent(u) returns the exponent of the first factor of + ++ \spadvar{u}, or 0 if the factored form consists solely of a unit. + ++ + ++X f:=nilFactor(y-x,3) + ++X exponent(f) + + makeFR : (R, List FF) -> % + ++ makeFR(unit,listOfFactors) creates a factored object (for + ++ use by factoring code). + ++ + ++X f:=nilFactor(x-y,3) + ++X g:=factorList f + ++X makeFR(z,g) + + factorList : % -> List FF + ++ factorList(u) returns the list of factors with flags (for + ++ use by factoring code). + ++ + ++X f:=nilFactor(x-y,3) + ++X factorList f + + nilFactor: (R, Integer) -> % + ++ nilFactor(base,exponent) creates a factored object with + ++ a single factor with no information about the kind of + ++ base (flag = "nil"). + ++ + ++X nilFactor(24,2) + ++X nilFactor(x-y,3) + + factors: % -> List Record(factor:R, exponent:Integer) + ++ factors(u) returns a list of the factors in a form suitable + ++ for iteration. That is, it returns a list where each element + ++ is a record containing a base and exponent. The original + ++ object is the product of all the factors and the unit (which + ++ can be extracted by \axiom{unit(u)}). + ++ + ++X f:=x*y^3-3*x^2*y^2+3*x^3*y-x^4 + ++X factors f + ++X g:=makeFR(z,factorList f) + ++X factors g + + irreducibleFactor: (R, Integer) -> % + ++ irreducibleFactor(base,exponent) creates a factored object with + ++ a single factor whose base is asserted to be irreducible + ++ (flag = "irred"). + ++ + ++X a:=irreducibleFactor(3,1) + ++X nthFlag(a,1) + + nthExponent: (%, Integer) -> Integer + ++ nthExponent(u,n) returns the exponent of the nth factor of + ++ \spadvar{u}. If \spadvar{n} is not a valid index for a factor + ++ (for example, less than 1 or too big), 0 is returned. + ++ + ++X a:=factor 9720000 + ++X nthExponent(a,2) + + nthFactor: (%,Integer) -> R + ++ nthFactor(u,n) returns the base of the nth factor of + ++ \spadvar{u}. If \spadvar{n} is not a valid index for a factor + ++ (for example, less than 1 or too big), 1 is returned. If + ++ \spadvar{u} consists only of a unit, the unit is returned. + ++ + ++X a:=factor 9720000 + ++X nthFactor(a,2) + + nthFlag: (%,Integer) -> fUnion + ++ nthFlag(u,n) returns the information flag of the nth factor of + ++ \spadvar{u}. If \spadvar{n} is not a valid index for a factor + ++ (for example, less than 1 or too big), "nil" is returned. + ++ + ++X a:=factor 9720000 + ++X nthFlag(a,2) + + numberOfFactors : % -> NonNegativeInteger + ++ numberOfFactors(u) returns the number of factors in \spadvar{u}. + ++ + ++X a:=factor 9720000 + ++X numberOfFactors a + + primeFactor: (R,Integer) -> % + ++ primeFactor(base,exponent) creates a factored object with + ++ a single factor whose base is asserted to be prime + ++ (flag = "prime"). + ++ + ++X a:=primeFactor(3,4) + ++X nthFlag(a,1) + + sqfrFactor: (R,Integer) -> % + ++ sqfrFactor(base,exponent) creates a factored object with + ++ a single factor whose base is asserted to be square-free + ++ (flag = "sqfr"). + ++ + ++X a:=sqfrFactor(3,5) + ++X nthFlag(a,1) + + flagFactor: (R,Integer, fUnion) -> % + ++ flagFactor(base,exponent,flag) creates a factored object with + ++ a single factor whose base is asserted to be properly + ++ described by the information flag. + + unit: % -> R + ++ unit(u) extracts the unit part of the factorization. + ++ + ++X f:=x*y^3-3*x^2*y^2+3*x^3*y-x^4 + ++X unit f + ++X g:=makeFR(z,factorList f) + ++X unit g + + unitNormalize: % -> % + ++ unitNormalize(u) normalizes the unit part of the factorization. + ++ For example, when working with factored integers, this operation will + ++ ensure that the bases are all positive integers. + + map: (R -> R, %) -> % + ++ map(fn,u) maps the function \userfun{fn} across the factors of + ++ \spadvar{u} and creates a new factored object. Note: this clears + ++ the information flags (sets them to "nil") because the effect of + ++ \userfun{fn} is clearly not known in general. + ++ + ++X m(a:Factored Polynomial Integer):Factored Polynomial Integer == a^2 + ++X f:=x*y^3-3*x^2*y^2+3*x^3*y-x^4 + ++X map(m,f) + ++X g:=makeFR(z,factorList f) + ++X map(m,g) + + -- the following operations are conditional on R + + if R has GcdDomain then GcdDomain + if R has RealConstant then RealConstant + if R has UniqueFactorizationDomain then UniqueFactorizationDomain + + if R has ConvertibleTo InputForm then ConvertibleTo InputForm + + if R has IntegerNumberSystem then + rational? : % -> Boolean + ++ rational?(u) tests if \spadvar{u} is actually a + ++ rational number (see \spadtype{Fraction Integer}). + rational : % -> Fraction Integer + ++ rational(u) assumes spadvar{u} is actually a rational number + ++ and does the conversion to rational number + ++ (see \spadtype{Fraction Integer}). + rationalIfCan: % -> Union(Fraction Integer, "failed") + ++ rationalIfCan(u) returns a rational number if u + ++ really is one, and "failed" otherwise. + + if R has Eltable(%, %) then Eltable(%, %) + if R has Evalable(%) then Evalable(%) + if R has InnerEvalable(Symbol, %) then InnerEvalable(Symbol, %) + + Implementation ==> add + + -- Representation: + -- Note: exponents are allowed to be integers so that some special cases + -- may be used in simplications + Rep := Record(unt:R, fct:List FF) + + if R has ConvertibleTo InputForm then + convert(x:%):InputForm == + empty?(lf := reverse factorList x) => convert(unit x)@InputForm + l := empty()$List(InputForm) + for rec in lf repeat +-- one?(rec.fctr) => l + ((rec.fctr) = 1) => l + iFactor : InputForm := binary( convert("::" :: Symbol)@InputForm, [convert(rec.fctr)@InputForm, (devaluate R)$Lisp :: InputForm ]$List(InputForm) ) + iExpon : InputForm := convert(rec.xpnt)@InputForm + iFun : List InputForm := + rec.flg case "nil" => + [convert("nilFactor" :: Symbol)@InputForm, iFactor, iExpon]$List(InputForm) + rec.flg case "sqfr" => + [convert("sqfrFactor" :: Symbol)@InputForm, iFactor, iExpon]$List(InputForm) + rec.flg case "prime" => + [convert("primeFactor" :: Symbol)@InputForm, iFactor, iExpon]$List(InputForm) + rec.flg case "irred" => + [convert("irreducibleFactor" :: Symbol)@InputForm, iFactor, iExpon]$List(InputForm) + nil$List(InputForm) + l := concat( iFun pretend InputForm, l ) +-- one?(rec.xpnt) => +-- l := concat(convert(rec.fctr)@InputForm, l) +-- l := concat(convert(rec.fctr)@InputForm ** rec.xpnt, l) + empty? l => convert(unit x)@InputForm + if unit x ^= 1 then l := concat(convert(unit x)@InputForm,l) + empty? rest l => first l + binary(convert(_*::Symbol)@InputForm, l)@InputForm + + orderedR? := R has OrderedSet + + -- Private function signatures: + reciprocal : % -> % + qexpand : % -> R + negexp? : % -> Boolean + SimplifyFactorization : List FF -> List FF + LispLessP : (FF, FF) -> Boolean + mkFF : (R, List FF) -> % + SimplifyFactorization1 : (FF, List FF) -> List FF + stricterFlag : (fUnion, fUnion) -> fUnion + + nilFactor(r, i) == flagFactor(r, i, "nil") + sqfrFactor(r, i) == flagFactor(r, i, "sqfr") + irreducibleFactor(r, i) == flagFactor(r, i, "irred") + primeFactor(r, i) == flagFactor(r, i, "prime") + unit? u == (empty? u.fct) and (not zero? u.unt) + factorList u == u.fct + unit u == u.unt + numberOfFactors u == # u.fct + 0 == [1, [["nil", 0, 1]$FF]] + zero? u == # u.fct = 1 and + (first u.fct).flg case "nil" and + zero? (first u.fct).fctr and +-- one? u.unt + (u.unt = 1) + 1 == [1, empty()] + one? u == empty? u.fct and u.unt = 1 + mkFF(r, x) == [r, x] + coerce(j:Integer):% == (j::R)::% + characteristic() == characteristic()$R + i:Integer * u:% == (i :: %) * u + r:R * u:% == (r :: %) * u + factors u == [[fe.fctr, fe.xpnt] for fe in factorList u] + expand u == retract u + negexp? x == "or"/[negative?(y.xpnt) for y in factorList x] + + makeFR(u, l) == +-- normalizing code to be installed when contents are handled better +-- current squareFree returns the content as a unit part. +-- if (not unit?(u)) then +-- l := cons(["nil", u, 1]$FF,l) +-- u := 1 + unitNormalize mkFF(u, SimplifyFactorization l) + + if R has IntegerNumberSystem then + rational? x == true + rationalIfCan x == rational x + + rational x == + convert(unit x)@Integer * + _*/[(convert(f.fctr)@Integer)::Fraction(Integer) + ** f.xpnt for f in factorList x] + + if R has Eltable(R, R) then + elt(x:%, v:%) == x(expand v) + + if R has Evalable(R) then + eval(x:%, l:List Equation %) == + eval(x,[expand lhs e = expand rhs e for e in l]$List(Equation R)) + + if R has InnerEvalable(Symbol, R) then + eval(x:%, ls:List Symbol, lv:List %) == + eval(x, ls, [expand v for v in lv]$List(R)) + + if R has RealConstant then + --! negcount and rest commented out since RealConstant doesn't support + --! positive? or negative? + -- negcount: % -> Integer + -- positive?(x:%):Boolean == not(zero? x) and even?(negcount x) + -- negative?(x:%):Boolean == not(zero? x) and odd?(negcount x) + -- negcount x == + -- n := count(negative?(#1.fctr), factorList x)$List(FF) + -- negative? unit x => n + 1 + -- n + + convert(x:%):Float == + convert(unit x)@Float * + _*/[convert(f.fctr)@Float ** f.xpnt for f in factorList x] + + convert(x:%):DoubleFloat == + convert(unit x)@DoubleFloat * + _*/[convert(f.fctr)@DoubleFloat ** f.xpnt for f in factorList x] + + u:% * v:% == + zero? u or zero? v => 0 +-- one? u => v + (u = 1) => v +-- one? v => u + (v = 1) => u + mkFF(unit u * unit v, + SimplifyFactorization concat(factorList u, copy factorList v)) + + u:% ** n:NonNegativeInteger == + mkFF(unit(u)**n, [[x.flg, x.fctr, n * x.xpnt] for x in factorList u]) + + SimplifyFactorization x == + empty? x => empty() + x := sort_!(LispLessP, x) + x := SimplifyFactorization1(first x, rest x) + if orderedR? then x := sort_!(LispLessP, x) + x + + SimplifyFactorization1(f, x) == + empty? x => + zero?(f.xpnt) => empty() + list f + f1 := first x + f.fctr = f1.fctr => + SimplifyFactorization1([stricterFlag(f.flg, f1.flg), + f.fctr, f.xpnt + f1.xpnt], rest x) + l := SimplifyFactorization1(first x, rest x) + zero?(f.xpnt) => l + concat(f, l) + + + coerce(x:%):OutputForm == + empty?(lf := reverse factorList x) => (unit x)::OutputForm + l := empty()$List(OutputForm) + for rec in lf repeat +-- one?(rec.fctr) => l + ((rec.fctr) = 1) => l +-- one?(rec.xpnt) => + ((rec.xpnt) = 1) => + l := concat(rec.fctr :: OutputForm, l) + l := concat(rec.fctr::OutputForm ** rec.xpnt::OutputForm, l) + empty? l => (unit x) :: OutputForm + e := + empty? rest l => first l + reduce(_*, l) + 1 = unit x => e + (unit x)::OutputForm * e + + retract(u:%):R == + negexp? u => error "Negative exponent in factored object" + qexpand u + + qexpand u == + unit u * + _*/[y.fctr ** (y.xpnt::NonNegativeInteger) for y in factorList u] + + retractIfCan(u:%):Union(R, "failed") == + negexp? u => "failed" + qexpand u + + LispLessP(y, y1) == + orderedR? => y.fctr < y1.fctr + GGREATERP(y.fctr, y1.fctr)$Lisp => false + true + + stricterFlag(fl1, fl2) == + fl1 case "prime" => fl1 + fl1 case "irred" => + fl2 case "prime" => fl2 + fl1 + fl1 case "sqfr" => + fl2 case "nil" => fl1 + fl2 + fl2 + + if R has IntegerNumberSystem + then + coerce(r:R):% == + factor(r)$IntegerFactorizationPackage(R) pretend % + else + if R has UniqueFactorizationDomain + then + coerce(r:R):% == + zero? r => 0 + unit? r => mkFF(r, empty()) + unitNormalize(squareFree(r) pretend %) + else + coerce(r:R):% == +-- one? r => 1 + (r = 1) => 1 + unitNormalize mkFF(1, [["nil", r, 1]$FF]) + + u = v == + (unit u = unit v) and # u.fct = # v.fct and + set(factors u)$SRFE =$SRFE set(factors v)$SRFE + + - u == + zero? u => u + mkFF(- unit u, factorList u) + + recip u == + not empty? factorList u => "failed" + (r := recip unit u) case "failed" => "failed" + mkFF(r::R, empty()) + + reciprocal u == + mkFF((recip unit u)::R, + [[y.flg, y.fctr, - y.xpnt]$FF for y in factorList u]) + + exponent u == -- exponent of first factor + empty?(fl := factorList u) or zero? u => 0 + first(fl).xpnt + + nthExponent(u, i) == + l := factorList u + zero? u or i < 1 or i > #l => 0 + (l.(minIndex(l) + i - 1)).xpnt + + nthFactor(u, i) == + zero? u => 0 + zero? i => unit u + l := factorList u + negative? i or i > #l => 1 + (l.(minIndex(l) + i - 1)).fctr + + nthFlag(u, i) == + l := factorList u + zero? u or i < 1 or i > #l => "nil" + (l.(minIndex(l) + i - 1)).flg + + flagFactor(r, i, fl) == + zero? i => 1 + zero? r => 0 + unitNormalize mkFF(1, [[fl, r, i]$FF]) + + differentiate(u:%, deriv: R -> R) == + ans := deriv(unit u) * ((u exquo unit(u)::%)::%) + ans + (_+/[fact.xpnt * deriv(fact.fctr) * + ((u exquo nilFactor(fact.fctr, 1))::%) for fact in factorList u]) + + map(fn, u) == + fn(unit u) * _*/[irreducibleFactor(fn(f.fctr),f.xpnt) for f in factorList u] + + u exquo v == + empty?(x1 := factorList v) => unitNormal(retract v).associate * u + empty? factorList u => "failed" + v1 := u * reciprocal v + goodQuotient:Boolean := true + while (goodQuotient and (not empty? x1)) repeat + if x1.first.xpnt < 0 + then goodQuotient := false + else x1 := rest x1 + goodQuotient => v1 + "failed" + + unitNormal u == -- does a bunch of work, but more canonical + (ur := recip(un := unit u)) case "failed" => [1, u, 1] + as := ur::R + vl := empty()$List(FF) + for x in factorList u repeat + ucar := unitNormal(x.fctr) + e := abs(x.xpnt)::NonNegativeInteger + if x.xpnt < 0 + then -- associate is recip of unit + un := un * (ucar.associate ** e) + as := as * (ucar.unit ** e) + else + un := un * (ucar.unit ** e) + as := as * (ucar.associate ** e) +-- if not one?(ucar.canonical) then + if not ((ucar.canonical) = 1) then + vl := concat([x.flg, ucar.canonical, x.xpnt], vl) + [mkFF(un, empty()), mkFF(1, reverse_! vl), mkFF(as, empty())] + + unitNormalize u == + uca := unitNormal u + mkFF(unit(uca.unit)*unit(uca.canonical),factorList(uca.canonical)) + + if R has GcdDomain then + u + v == + zero? u => v + zero? v => u + v1 := reciprocal(u1 := gcd(u, v)) + (expand(u * v1) + expand(v * v1)) * u1 + + gcd(u, v) == +-- one? u or one? v => 1 + (u = 1) or (v = 1) => 1 + zero? u => v + zero? v => u + f1 := empty()$List(Integer) -- list of used factor indices in x + f2 := f1 -- list of indices corresponding to a given factor + f3 := empty()$List(List Integer) -- list of f2-like lists + x := concat(factorList u, factorList v) + for i in minIndex x .. maxIndex x repeat + if not member?(i, f1) then + f1 := concat(i, f1) + f2 := [i] + for j in i+1..maxIndex x repeat + if x.i.fctr = x.j.fctr then + f1 := concat(j, f1) + f2 := concat(j, f2) + f3 := concat(f2, f3) + x1 := empty()$List(FF) + while not empty? f3 repeat + f1 := first f3 + if #f1 > 1 then + i := first f1 + y := copy x.i + f1 := rest f1 + while not empty? f1 repeat + i := first f1 + if x.i.xpnt < y.xpnt then y.xpnt := x.i.xpnt + f1 := rest f1 + x1 := concat(y, x1) + f3 := rest f3 + if orderedR? then x1 := sort_!(LispLessP, x1) + mkFF(1, x1) + + else -- R not a GCD domain + u + v == + zero? u => v + zero? v => u + irreducibleFactor(expand u + expand v, 1) + + if R has UniqueFactorizationDomain then + prime? u == + not(empty?(l := factorList u)) and (empty? rest l) and +-- one?(l.first.xpnt) and (l.first.flg case "prime") + ((l.first.xpnt) = 1) and (l.first.flg case "prime") + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain FILE File} +<>= +-- files.spad.pamphlet File.input +)spool File.output +)set message test on +)set message auto off +)clear all +--S 1 of 12 +ifile:File List Integer:=open("jazz1","output") +--R +--R +--R (1) "jazz1" +--R Type: File List Integer +--E 1 + +--S 2 of 12 +write!(ifile, [-1,2,3]) +--R +--R +--R (2) [- 1,2,3] +--R Type: List Integer +--E 2 + +--S 3 of 12 +write!(ifile, [10,-10,0,111]) +--R +--R +--R (3) [10,- 10,0,111] +--R Type: List Integer +--E 3 + +--S 4 of 12 +write!(ifile, [7]) +--R +--R +--R (4) [7] +--R Type: List Integer +--E 4 + +--S 5 of 12 +reopen!(ifile, "input") +--R +--R +--R (5) "jazz1" +--R Type: File List Integer +--E 5 + +--S 6 of 12 +read! ifile +--R +--R +--R (6) [- 1,2,3] +--R Type: List Integer +--E 6 + +--S 7 of 12 +read! ifile +--R +--R +--R (7) [10,- 10,0,111] +--R Type: List Integer +--E 7 + +--S 8 of 12 +readIfCan! ifile +--R +--R +--R (8) [7] +--R Type: Union(List Integer,...) +--E 8 + +--S 9 of 12 +readIfCan! ifile +--R +--R +--R (9) "failed" +--R Type: Union("failed",...) +--E 9 + +--S 10 of 12 +iomode ifile +--R +--R +--R (10) "input" +--R Type: String +--E 10 + +--S 11 of 12 +name ifile +--R +--R +--R (11) "jazz1" +--R Type: FileName +--E 11 + +--S 12 of 12 +close! ifile +--R +--R +--R (12) "jazz1" +--R Type: File List Integer +--E 12 +)system rm jazz1 +)spool +)lisp (bye) +@ +<>= +==================================================================== +File examples +==================================================================== + +The File(S) domain provides a basic interface to read and write values +of type S in files. + +Before working with a file, it must be made accessible to Axiom with +the open operation. + + ifile:File List Integer:=open("/tmp/jazz1","output") + "jazz1" + Type: File List Integer + +The open function arguments are a FileNam} and a String specifying the +mode. If a full pathname is not specified, the current default +directory is assumed. The mode must be one of "input" or "output". +If it is not specified, "input" is assumed. Once the file has been +opened, you can read or write data. + +The operations read and write are provided. + + write!(ifile, [-1,2,3]) + [- 1,2,3] + Type: List Integer + + write!(ifile, [10,-10,0,111]) + [10,- 10,0,111] + Type: List Integer + + write!(ifile, [7]) + [7] + Type: List Integer + +You can change from writing to reading (or vice versa) by reopening a file. + + reopen!(ifile, "input") + "jazz1" + Type: File List Integer + + read! ifile + [- 1,2,3] + Type: List Integer + + read! ifile + [10,- 10,0,111] + Type: List Integer + +The read operation can cause an error if one tries to read more data +than is in the file. To guard against this possibility the readIfCan +operation should be used. + + readIfCan! ifile + [7] + Type: Union(List Integer,...) + + readIfCan! ifile + "failed" + Type: Union("failed",...) + +You can find the current mode of the file, and the file's name. + + iomode ifile + "input" + Type: String + + name ifile + "jazz1" + Type: FileName + +When you are finished with a file, you should close it. + + close! ifile + "jazz1" + Type: File List Integer + + )system rm /tmp/jazz1 + +A limitation of the underlying LISP system is that not all values can +be represented in a file. In particular, delayed values containing +compiled functions cannot be saved. + +See Also: +o )help TextFile +o )help KeyedAccessFile +o )help Library +o )help Filename +o )show File +o $AXIOM/doc/src/algebra/files.spad.dvi + +@ +\pagehead{File}{FILE} +\pagepic{ps/v103file.ps}{FILE}{1.00} +See also:\\ +\refto{TextFile}{TEXTFILE} +\refto{BinaryFile}{BINFILE} +\refto{KeyedAccessFile}{KAFILE} +\refto{Library}{LIB} +<>= +)abbrev domain FILE File +++ Author: Stephen M. Watt, Victor Miller +++ Date Created: 1984 +++ Date Last Updated: June 4, 1991 +++ Basic Operations: +++ Related Domains: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ Examples: +++ References: +++ Description: +++ This domain provides a basic model of files to save arbitrary values. +++ The operations provide sequential access to the contents. + +File(S:SetCategory): FileCategory(FileName, S) with + readIfCan_!: % -> Union(S, "failed") + ++ readIfCan!(f) returns a value from the file f, if possible. + ++ If f is not open for reading, or if f is at the end of file + ++ then \spad{"failed"} is the result. + == add + FileState ==> SExpression + IOMode ==> String + + Rep:=Record(fileName: FileName, _ + fileState: FileState, _ + fileIOmode: IOMode) + + defstream(fn: FileName, mode: IOMode): FileState == + mode = "input" => + not readable? fn => error ["File is not readable", fn] + MAKE_-INSTREAM(fn::String)$Lisp + mode = "output" => + not writable? fn => error ["File is not writable", fn] + MAKE_-OUTSTREAM(fn::String)$Lisp + error ["IO mode must be input or output", mode] + + f1 = f2 == + f1.fileName = f2.fileName + coerce(f: %): OutputForm == + f.fileName::OutputForm + + open fname == + open(fname, "input") + open(fname, mode) == + fstream := defstream(fname, mode) + [fname, fstream, mode] + reopen_!(f, mode) == + fname := f.fileName + f.fileState := defstream(fname, mode) + f.fileIOmode:= mode + f + close_! f == + SHUT(f.fileState)$Lisp + f.fileIOmode := "closed" + f + name f == + f.fileName + iomode f == + f.fileIOmode + read_! f == + f.fileIOmode ^= "input" => + error "File not in read state" + x := VMREAD(f.fileState)$Lisp + PLACEP(x)$Lisp => + error "End of file" + x + readIfCan_! f == + f.fileIOmode ^= "input" => + error "File not in read state" + x: S := VMREAD(f.fileState)$Lisp + PLACEP(x)$Lisp => "failed" + x + write_!(f, x) == + f.fileIOmode ^= "output" => + error "File not in write state" + z := PRINT_-FULL(x, f.fileState)$Lisp + TERPRI(f.fileState)$Lisp + x + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain FNAME FileName} +<>= +-- fname.spad.pamphlet FileName.input +)spool FileName.output +)set message test on +)set message auto off +)clear all +--S 1 of 18 +fn: FileName +--R +--R Type: Void +--E 1 + +--S 2 of 18 +fn := "fname.input" +--R +--R +--R (2) "fname.input" +--R Type: FileName +--E 2 + +--S 3 of 18 +directory fn +--R +--R +--R (3) "" +--R Type: String +--E 3 + +--S 4 of 18 +name fn +--R +--R +--R (4) "fname" +--R Type: String +--E 4 + +--S 5 of 18 +extension fn +--R +--R +--R (5) "input" +--R Type: String +--E 5 + +--S 6 of 18 +fn := filename("/tmp", "fname", "input") +--R +--R +--R (6) "/tmp/fname.input" +--R Type: FileName +--E 6 + +--S 7 of 18 +objdir := "/tmp" +--R +--R +--R (7) "/tmp" +--R Type: String +--E 7 + +--S 8 of 18 +fn := filename(objdir, "table", "spad") +--R +--R +--R (8) "/tmp/table.spad" +--R Type: FileName +--E 8 + +--S 9 of 18 +fn := filename("", "letter", "") +--R +--R +--R (9) "letter" +--R Type: FileName +--E 9 + +--S 10 of 18 +exists? "/etc/passwd" +--R +--R +--R (10) true +--R Type: Boolean +--E 10 + +--S 11 of 18 +readable? "/etc/passwd" +--R +--R +--R (11) true +--R Type: Boolean +--E 11 + +--S 12 of 18 +readable? "/etc/security/passwd" +--R +--R +--R (12) false +--R Type: Boolean +--E 12 + +--S 13 of 18 +readable? "/ect/passwd" +--R +--R +--R (13) false +--R Type: Boolean +--E 13 + +--S 14 of 18 +writable? "/etc/passwd" +--R +--R +--R (14) true +--R Type: Boolean +--E 14 + +--S 15 of 18 +writable? "/dev/null" +--R +--R +--R (15) true +--R Type: Boolean +--E 15 + +--S 16 of 18 +writable? "/etc/DoesNotExist" +--R +--R +--R (16) true +--R Type: Boolean +--E 16 + +--S 17 of 18 +writable? "/tmp/DoesNotExist" +--R +--R +--R (17) true +--R Type: Boolean +--E 17 + +--S 18 of 18 +fn := new(objdir, "xxx", "yy") +--R +--R +--I (18) "/tmp/xxx1419.yy" +--R Type: FileName +--E 18 +)spool +)lisp (bye) +@ +<>= +==================================================================== +FileName examples +==================================================================== + +The FileName domain provides an interface to the computer's file +system. Functions are provided to manipulate file names and to test +properties of files. + +The simplest way to use file names in the Axiom interpreter is to rely +on conversion to and from strings. The syntax of these strings +depends on the operating system. + + fn: FileName + Type: Void + +On Linux, this is a proper file syntax: + + fn := "fname.input" + "fname.input" + Type: FileName + +Although it is very convenient to be able to use string notation +for file names in the interpreter, it is desirable to have a portable +way of creating and manipulating file names from within programs. + +A measure of portability is obtained by considering a file name to +consist of three parts: the directory, the name, and the extension. + + directory fn + "" + Type: String + + name fn + "fname" + Type: String + + extension fn + "input" + Type: String + +The meaning of these three parts depends on the operating system. +For example, on CMS the file "SPADPROF INPUT M" would have directory +"M", name "SPADPROF" and extension "INPUT". + +It is possible to create a filename from its parts. + + fn := filename("/tmp", "fname", "input") + "/tmp/fname.input" + Type: FileName + +When writing programs, it is helpful to refer to directories via +variables. + + objdir := "/tmp" + "/tmp" + Type: String + + fn := filename(objdir, "table", "spad") + "/tmp/table.spad" + Type: FileName + +If the directory or the extension is given as an empty string, then +a default is used. On AIX, the defaults are the current directory +and no extension. + + fn := filename("", "letter", "") + "letter" + Type: FileName + +Three tests provide information about names in the file system. + +The exists? operation tests whether the named file exists. + + exists? "/etc/passwd" + true + Type: Boolean + +The operation readable? tells whether the named file can be read. If +the file does not exist, then it cannot be read. + + readable? "/etc/passwd" + true + Type: Boolean + + readable? "/etc/security/passwd" + false + Type: Boolean + + readable? "/ect/passwd" + false + Type: Boolean + +Likewise, the operation writable? tells whether the named file can be +written. If the file does not exist, the test is determined by the +properties of the directory. + + writable? "/etc/passwd" + true + Type: Boolean + + writable? "/dev/null" + true + Type: Boolean + + writable? "/etc/DoesNotExist" + true + Type: Boolean + + writable? "/tmp/DoesNotExist" + true + Type: Boolean + +The new operation constructs the name of a new writable file. The +argument sequence is the same as for filename, except that the name +part is actually a prefix for a constructed unique name. + +The resulting file is in the specified directory with the given +extension, and the same defaults are used. + + fn := new(objdir, "xxx", "yy") + "/tmp/xxx1419.yy" + Type: FileName + +See Also: +o )show FileName +o $AXIOM/doc/src/algebra/fname.spad.dvi + +@ +\pagehead{FileName}{FNAME} +\pagepic{ps/v103filename.ps}{FNAME}{1.00} +<>= +)abbrev domain FNAME FileName +++ Author: Stephen M. Watt +++ Date Created: 1985 +++ Date Last Updated: June 20, 1991 +++ Basic Operations: +++ Related Domains: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ Examples: +++ References: +++ Description: +++ This domain provides an interface to names in the file system. + +FileName(): FileNameCategory == add + + f1 = f2 == EQUAL(f1, f2)$Lisp + coerce(f: %): OutputForm == f::String::OutputForm + + coerce(f: %): String == NAMESTRING(f)$Lisp + coerce(s: String): % == PARSE_-NAMESTRING(s)$Lisp + + filename(d,n,e) == fnameMake(d,n,e)$Lisp + + directory(f:%): String == fnameDirectory(f)$Lisp + name(f:%): String == fnameName(f)$Lisp + extension(f:%): String == fnameType(f)$Lisp + + exists? f == fnameExists?(f)$Lisp + readable? f == fnameReadable?(f)$Lisp + writable? f == fnameWritable?(f)$Lisp + + new(d,pref,e) == fnameNew(d,pref,e)$Lisp + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{domain FDIV FiniteDivisor} \pagehead{FiniteDivisor}{FDIV} \pagepic{ps/v103finitedivisor.ps}{FDIV}{1.00} @@ -16075,6 +18084,1219 @@ FiniteDivisor(F, UP, UPUP, R): Exports == Implementation where @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain FF FiniteField} +\pagehead{FiniteField}{FF} +\pagepic{ps/v103finitefield.ps}{FF}{1.00} +See also:\\ +\refto{FiniteFieldExtensionByPolynomial}{FFP} +\refto{FiniteFieldExtension}{FFX} +\refto{InnerFiniteField}{IFF} +<>= +)abbrev domain FF FiniteField +++ Author: ??? +++ Date Created: ??? +++ Date Last Updated: 29 May 1990 +++ Basic Operations: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: field, extension field, algebraic extension, +++ finite extension, finite field, Galois field +++ Reference: +++ R.Lidl, H.Niederreiter: Finite Field, Encyclopedia of Mathematics an +++ Its Applications, Vol. 20, Cambridge Univ. Press, 1983, ISBN 0 521 30240 4 +++ J. Grabmeier, A. Scheerhorn: Finite Fields in AXIOM. +++ AXIOM Technical Report Series, ATR/5 NP2522. +++ Description: +++ FiniteField(p,n) implements finite fields with p**n elements. +++ This packages checks that p is prime. +++ For a non-checking version, see \spadtype{InnerFiniteField}. +FiniteField(p:PositiveInteger, n:PositiveInteger): _ + FiniteAlgebraicExtensionField(PrimeField p) ==_ + FiniteFieldExtensionByPolynomial(PrimeField p,_ + createIrreduciblePoly(n)$FiniteFieldPolynomialPackage(PrimeField p)) + -- old code for generating irreducible polynomials: + -- now "better" order (sparse polys first) + -- generateIrredPoly(n)$IrredPolyOverFiniteField(GF)) + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain FFCG FiniteFieldCyclicGroup} +\pagehead{FiniteFieldCyclicGroup}{FFCG} +\pagepic{ps/v103finitefieldcyclicgroup.ps}{FFCG}{1.00} +See also:\\ +\refto{FiniteFieldCyclicGroupExtensionByPolynomial}{FFCGP} +\refto{FiniteFieldCyclicGroupExtension}{FFCGX} +<>= +)abbrev domain FFCG FiniteFieldCyclicGroup +++ Authors: J.Grabmeier, A.Scheerhorn +++ Date Created: 04.04.1991 +++ Date Last Updated: +++ Basic Operations: +++ Related Constructors: FiniteFieldCyclicGroupExtensionByPolynomial, +++ FiniteFieldPolynomialPackage +++ Also See: FiniteField, FiniteFieldNormalBasis +++ AMS Classifications: +++ Keywords: finite field, primitive elements, cyclic group +++ References: +++ R.Lidl, H.Niederreiter: Finite Field, Encycoldia of Mathematics and +++ Its Applications, Vol. 20, Cambridge Univ. Press, 1983, ISBN 0 521 30240 4 +++ Description: +++ FiniteFieldCyclicGroup(p,n) implements a finite field extension of degee n +++ over the prime field with p elements. Its elements are represented by +++ powers of a primitive element, i.e. a generator of the multiplicative +++ (cyclic) group. As primitive element we choose the root of the extension +++ polynomial, which is created by {\em createPrimitivePoly} from +++ \spadtype{FiniteFieldPolynomialPackage}. The Zech logarithms are stored +++ in a table of size half of the field size, and use \spadtype{SingleInteger} +++ for representing field elements, hence, there are restrictions +++ on the size of the field. + +FiniteFieldCyclicGroup(p,extdeg):_ + Exports == Implementation where + p : PositiveInteger + extdeg : PositiveInteger + PI ==> PositiveInteger + FFPOLY ==> FiniteFieldPolynomialPackage(PrimeField(p)) + SI ==> SingleInteger + Exports ==> FiniteAlgebraicExtensionField(PrimeField(p)) with + getZechTable:() -> PrimitiveArray(SingleInteger) + ++ getZechTable() returns the zech logarithm table of the field. + ++ This table is used to perform additions in the field quickly. + Implementation ==> FiniteFieldCyclicGroupExtensionByPolynomial(PrimeField(p),_ + createPrimitivePoly(extdeg)$FFPOLY) + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain FFCGX FiniteFieldCyclicGroupExtension} +\pagehead{FiniteFieldCyclicGroupExtension}{FFCGX} +\pagepic{ps/v103finitefieldcyclicgroupextension.ps}{FFCGX}{1.00} +See also:\\ +\refto{FiniteFieldCyclicGroupExtensionByPolynomial}{FFCGP} +\refto{FiniteFieldCyclicGroup}{FFCG} +<>= +)abbrev domain FFCGX FiniteFieldCyclicGroupExtension +++ Authors: J.Grabmeier, A.Scheerhorn +++ Date Created: 04.04.1991 +++ Date Last Updated: +++ Basic Operations: +++ Related Constructors: FiniteFieldCyclicGroupExtensionByPolynomial, +++ FiniteFieldPolynomialPackage +++ Also See: FiniteFieldExtension, FiniteFieldNormalBasisExtension +++ AMS Classifications: +++ Keywords: finite field, primitive elements, cyclic group +++ References: +++ R.Lidl, H.Niederreiter: Finite Field, Encycoldia of Mathematics and +++ Its Applications, Vol. 20, Cambridge Univ. Press, 1983, ISBN 0 521 30240 4 +++ J. Grabmeier, A. Scheerhorn: Finite Fields in AXIOM. +++ AXIOM Technical Report Series, ATR/5 NP2522. +++ Description: +++ FiniteFieldCyclicGroupExtension(GF,n) implements a extension of degree n +++ over the ground field {\em GF}. Its elements are represented by powers of +++ a primitive element, i.e. a generator of the multiplicative (cyclic) group. +++ As primitive element we choose the root of the extension polynomial, which +++ is created by {\em createPrimitivePoly} from +++ \spadtype{FiniteFieldPolynomialPackage}. Zech logarithms are stored +++ in a table of size half of the field size, and use \spadtype{SingleInteger} +++ for representing field elements, hence, there are restrictions +++ on the size of the field. + + +FiniteFieldCyclicGroupExtension(GF,extdeg):_ + Exports == Implementation where + GF : FiniteFieldCategory + extdeg : PositiveInteger + PI ==> PositiveInteger + FFPOLY ==> FiniteFieldPolynomialPackage(GF) + SI ==> SingleInteger + Exports ==> FiniteAlgebraicExtensionField(GF) with + getZechTable:() -> PrimitiveArray(SingleInteger) + ++ getZechTable() returns the zech logarithm table of the field. + ++ This table is used to perform additions in the field quickly. + Implementation ==> FiniteFieldCyclicGroupExtensionByPolynomial(GF,_ + createPrimitivePoly(extdeg)$FFPOLY) + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain FFCGP FiniteFieldCyclicGroupExtensionByPolynomial} +\pagehead{FiniteFieldCyclicGroupExtensionByPolynomial}{FFCGP} +\pagepic{ps/v103finitefieldcyclicgroupextensionbypolynomial.ps}{FFCGP}{1.00} +See also:\\ +\refto{FiniteFieldCyclicGroupExtension}{FFCGX} +\refto{FiniteFieldCyclicGroup}{FFCG} +<>= +)abbrev domain FFCGP FiniteFieldCyclicGroupExtensionByPolynomial +++ Authors: J.Grabmeier, A.Scheerhorn +++ Date Created: 26.03.1991 +++ Date Last Updated: 31 March 1991 +++ Basic Operations: +++ Related Constructors: FiniteFieldFunctions +++ Also See: FiniteFieldExtensionByPolynomial, +++ FiniteFieldNormalBasisExtensionByPolynomial +++ AMS Classifications: +++ Keywords: finite field, primitive elements, cyclic group +++ References: +++ R.Lidl, H.Niederreiter: Finite Field, Encycoldia of Mathematics and +++ Its Applications, Vol. 20, Cambridge Univ. Press, 1983, ISBN 0 521 30240 4 +++ J. Grabmeier, A. Scheerhorn: Finite Fields in AXIOM. +++ AXIOM Technical Report Series, ATR/5 NP2522. +++ Description: +++ FiniteFieldCyclicGroupExtensionByPolynomial(GF,defpol) implements a +++ finite extension field of the ground field {\em GF}. Its elements are +++ represented by powers of a primitive element, i.e. a generator of the +++ multiplicative (cyclic) group. As primitive +++ element we choose the root of the extension polynomial {\em defpol}, +++ which MUST be primitive (user responsibility). Zech logarithms are stored +++ in a table of size half of the field size, and use \spadtype{SingleInteger} +++ for representing field elements, hence, there are restrictions +++ on the size of the field. + + +FiniteFieldCyclicGroupExtensionByPolynomial(GF,defpol):_ + Exports == Implementation where + GF : FiniteFieldCategory -- the ground field + defpol: SparseUnivariatePolynomial GF -- the extension polynomial + -- the root of defpol is used as the primitive element + + PI ==> PositiveInteger + NNI ==> NonNegativeInteger + I ==> Integer + SI ==> SingleInteger + SUP ==> SparseUnivariatePolynomial + SAE ==> SimpleAlgebraicExtension(GF,SUP GF,defpol) + V ==> Vector GF + FFP ==> FiniteFieldExtensionByPolynomial(GF,defpol) + FFF ==> FiniteFieldFunctions(GF) + OUT ==> OutputForm + ARR ==> PrimitiveArray(SI) + TBL ==> Table(PI,NNI) + + + Exports ==> FiniteAlgebraicExtensionField(GF) with + + getZechTable:() -> ARR + ++ getZechTable() returns the zech logarithm table of the field + ++ it is used to perform additions in the field quickly. + Implementation ==> add + +-- global variables =================================================== + + Rep:= SI + -- elements are represented by small integers in the range + -- (-1)..(size()-2). The (-1) representing the field element zero, + -- the other small integers representing the corresponding power + -- of the primitive element, the root of the defining polynomial + + -- it would be very nice if we could use the representation + -- Rep:= Union("zero", IntegerMod(size()$GF ** degree(defpol) -1)), + -- why doesn't the compiler like this ? + + extdeg:NNI :=degree(defpol)$(SUP GF)::NNI + -- the extension degree + + sizeFF:NNI:=(size()$GF ** extdeg) pretend NNI + -- the size of the field + + if sizeFF > 2**20 then + error "field too large for this representation" + + sizeCG:SI:=(sizeFF - 1) pretend SI + -- the order of the cyclic group + + sizeFG:SI:=(sizeCG quo (size()$GF-1)) pretend SI + -- the order of the factor group + + + zechlog:ARR:=new(((sizeFF+1) quo 2)::NNI,-1::SI)$ARR + -- the table for the zech logarithm + + alpha :=new()$Symbol :: OutputForm + -- get a new symbol for the output representation of + -- the elements + + primEltGF:GF:= + odd?(extdeg)$I => -$GF coefficient(defpol,0)$(SUP GF) + coefficient(defpol,0)$(SUP GF) + -- the corresponding primitive element of the groundfield + -- equals the trace of the primitive element w.r.t. the groundfield + + facOfGroupSize := nil()$(List Record(factor:Integer,exponent:Integer)) + -- the factorization of sizeCG + + initzech?:Boolean:=true + -- gets false after initialization of the zech logarithm array + + initelt?:Boolean:=true + -- gets false after initialization of the normal element + + normalElt:SI:=0 + -- the global variable containing a normal element + +-- functions ========================================================== + + -- for completeness we have to give a dummy implementation for + -- 'tableForDiscreteLogarithm', although this function is not + -- necessary in the cyclic group representation case + + tableForDiscreteLogarithm(fac) == table()$TBL + + + getZechTable() == zechlog + initializeZech:() -> Void + initializeElt: () -> Void + + order(x:$):PI == + zero?(x) => + error"order: order of zero undefined" + (sizeCG quo gcd(sizeCG,x pretend NNI))::PI + + primitive?(x:$) == +-- zero?(x) or one?(x) => false + zero?(x) or (x = 1) => false + gcd(x::Rep,sizeCG)$Rep = 1$Rep => true + false + + coordinates(x:$) == + x=0 => new(extdeg,0)$(Vector GF) + primElement:SAE:=convert(monomial(1,1)$(SUP GF))$SAE +-- the primitive element in the corresponding algebraic extension + coordinates(primElement **$SAE (x pretend SI))$SAE + + x:$ + y:$ == + if initzech? then initializeZech() + zero? x => y + zero? y => x + d:Rep:=positiveRemainder(y -$Rep x,sizeCG)$Rep + (d pretend SI) <= shift(sizeCG,-$SI (1$SI)) => + zechlog.(d pretend SI) =$SI -1::SI => 0 + addmod(x,zechlog.(d pretend SI) pretend Rep,sizeCG)$Rep + --d:Rep:=positiveRemainder(x -$Rep y,sizeCG)$Rep + d:Rep:=(sizeCG -$SI d)::Rep + addmod(y,zechlog.(d pretend SI) pretend Rep,sizeCG)$Rep + --positiveRemainder(x +$Rep zechlog.(d pretend SI) -$Rep d,sizeCG)$Rep + + + initializeZech() == + zechlog:=createZechTable(defpol)$FFF + -- set initialization flag + initzech? := false + void()$Void + + basis(n:PI) == + extensionDegree() rem n ^= 0 => + error("argument must divide extension degree") + m:=sizeCG quo (size()$GF**n-1) + [index((1+i*m) ::PI) for i in 0..(n-1)]::Vector $ + + n:I * x:$ == ((n::GF)::$) * x + + minimalPolynomial(a) == + f:SUP $:=monomial(1,1)$(SUP $) - monomial(a,0)$(SUP $) + u:$:=Frobenius(a) + while not(u = a) repeat + f:=f * (monomial(1,1)$(SUP $) - monomial(u,0)$(SUP $)) + u:=Frobenius(u) + p:SUP GF:=0$(SUP GF) + while not zero?(f)$(SUP $) repeat + g:GF:=retract(leadingCoefficient(f)$(SUP $)) + p:=p+monomial(g,_ + degree(f)$(SUP $))$(SUP GF) + f:=reductum(f)$(SUP $) + p + + factorsOfCyclicGroupSize() == + if empty? facOfGroupSize then initializeElt() + facOfGroupSize + + representationType() == "cyclic" + + definingPolynomial() == defpol + + random() == + positiveRemainder(random()$Rep,sizeFF pretend Rep)$Rep -$Rep 1$Rep + + represents(v) == + u:FFP:=represents(v)$FFP + u =$FFP 0$FFP => 0 + discreteLog(u)$FFP pretend Rep + + + + coerce(e:GF):$ == + zero?(e)$GF => 0 + log:I:=discreteLog(primEltGF,e)$GF::NNI *$I sizeFG + -- version before 10.20.92: log pretend Rep + -- 1$GF is coerced to sizeCG pretend Rep by old version + -- now 1$GF is coerced to 0$Rep which is correct. + positiveRemainder(log,sizeCG) pretend Rep + + + retractIfCan(x:$) == + zero? x => 0$GF + u:= (x::Rep) exquo$Rep (sizeFG pretend Rep) + u = "failed" => "failed" + primEltGF **$GF ((u::$) pretend SI) + + retract(x:$) == + a:=retractIfCan(x) + a="failed" => error "element not in groundfield" + a :: GF + + basis() == [index(i :: PI) for i in 1..extdeg]::Vector $ + + + inGroundField?(x) == + zero? x=> true + positiveRemainder(x::Rep,sizeFG pretend Rep)$Rep =$Rep 0$Rep => true + false + + discreteLog(b:$,x:$) == + zero? x => "failed" + e:= extendedEuclidean(b,sizeCG,x)$Rep + e = "failed" => "failed" + e1:Record(coef1:$,coef2:$) := e :: Record(coef1:$,coef2:$) + positiveRemainder(e1.coef1,sizeCG)$Rep pretend NNI + + - x:$ == + zero? x => 0 + characteristic() =$I 2 => x + addmod(x,shift(sizeCG,-1)$SI pretend Rep,sizeCG) + + generator() == 1$SI + createPrimitiveElement() == 1$SI + primitiveElement() == 1$SI + + discreteLog(x:$) == + zero? x => error "discrete logarithm error" + x pretend NNI + + normalElement() == + if initelt? then initializeElt() + normalElt::$ + + initializeElt() == + facOfGroupSize := factors(factor(sizeCG)$Integer) + normalElt:=createNormalElement() pretend SI + initelt?:=false + void()$Void + + extensionDegree() == extdeg pretend PI + + characteristic() == characteristic()$GF + + lookup(x:$) == + x =$Rep (-$Rep 1$Rep) => sizeFF pretend PI + (x +$Rep 1$Rep) pretend PI + + index(a:PI) == + positiveRemainder(a,sizeFF)$I pretend Rep -$Rep 1$Rep + + 0 == (-$Rep 1$Rep) + + 1 == 0$Rep + +-- to get a "exponent like" output form + coerce(x:$):OUT == + x =$Rep (-$Rep 1$Rep) => "0"::OUT + x =$Rep 0$Rep => "1"::OUT + y:I:=lookup(x)-1 + alpha **$OUT (y::OUT) + + x:$ = y:$ == x =$Rep y + + x:$ * y:$ == + x = 0 => 0 + y = 0 => 0 + addmod(x,y,sizeCG)$Rep + + a:GF * x:$ == coerce(a)@$ * x + x:$/a:GF == x/coerce(a)@$ + +-- x:$ / a:GF == +-- a = 0$GF => error "division by zero" +-- x * inv(coerce(a)) + + inv(x:$) == + zero?(x) => error "inv: not invertible" +-- one?(x) => 1 + (x = 1) => 1 + sizeCG -$Rep x + + x:$ ** n:PI == x ** n::I + + x:$ ** n:NNI == x ** n::I + + x:$ ** n:I == + m:Rep:=positiveRemainder(n,sizeCG)$I pretend Rep + m =$Rep 0$Rep => 1 + x = 0 => 0 + mulmod(m,x,sizeCG::Rep)$Rep + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain FFX FiniteFieldExtension} +\pagehead{FiniteFieldExtension}{FFX} +\pagepic{ps/v103finitefieldextension.ps}{FFX}{1.00} +See also:\\ +\refto{FiniteFieldExtensionByPolynomial}{FFP} +\refto{InnerFiniteField}{IFF} +\refto{FiniteField}{FF} +<>= +)abbrev domain FFX FiniteFieldExtension +++ Authors: R.Sutor, J. Grabmeier, A. Scheerhorn +++ Date Created: +++ Date Last Updated: 31 March 1991 +++ Basic Operations: +++ Related Constructors: FiniteFieldExtensionByPolynomial, +++ FiniteFieldPolynomialPackage +++ Also See: FiniteFieldCyclicGroupExtension, +++ FiniteFieldNormalBasisExtension +++ AMS Classifications: +++ Keywords: field, extension field, algebraic extension, +++ finite extension, finite field, Galois field +++ Reference: +++ R.Lidl, H.Niederreiter: Finite Field, Encyclopedia of Mathematics an +++ Its Applications, Vol. 20, Cambridge Univ. Press, 1983, ISBN 0 521 30240 4 +++ J. Grabmeier, A. Scheerhorn: Finite Fields in AXIOM. +++ AXIOM Technical Report Series, ATR/5 NP2522. +++ Description: +++ FiniteFieldExtensionByPolynomial(GF, n) implements an extension +++ of the finite field {\em GF} of degree n generated by the extension +++ polynomial constructed by +++ \spadfunFrom{createIrreduciblePoly}{FiniteFieldPolynomialPackage} from +++ \spadtype{FiniteFieldPolynomialPackage}. +FiniteFieldExtension(GF, n): Exports == Implementation where + GF: FiniteFieldCategory + n : PositiveInteger + Exports ==> FiniteAlgebraicExtensionField(GF) + -- MonogenicAlgebra(GF, SUP) with -- have to check this + Implementation ==> FiniteFieldExtensionByPolynomial(GF, + createIrreduciblePoly(n)$FiniteFieldPolynomialPackage(GF)) + -- old code for generating irreducible polynomials: + -- now "better" order (sparse polys first) + -- generateIrredPoly(n)$IrredPolyOverFiniteField(GF)) + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain FFP FiniteFieldExtensionByPolynomial} +\pagehead{FiniteFieldExtensionByPolynomial}{FFP} +\pagepic{ps/v103finitefieldextensionbypolynomial.ps}{FFP}{1.00} +See also:\\ +\refto{FiniteFieldExtension}{FFX} +\refto{InnerFiniteField}{IFF} +\refto{FiniteField}{FF} +<>= +)abbrev domain FFP FiniteFieldExtensionByPolynomial +++ Authors: R.Sutor, J. Grabmeier, O. Gschnitzer, A. Scheerhorn +++ Date Created: +++ Date Last Updated: 31 March 1991 +++ Basic Operations: +++ Related Constructors: +++ Also See: FiniteFieldCyclicGroupExtensionByPolynomial, +++ FiniteFieldNormalBasisExtensionByPolynomial +++ AMS Classifications: +++ Keywords: field, extension field, algebraic extension, +++ finite extension, finite field, Galois field +++ Reference: +++ R.Lidl, H.Niederreiter: Finite Field, Encyclopedia of Mathematics an +++ Its Applications, Vol. 20, Cambridge Univ. Press, 1983, ISBN 0 521 30240 4 +++ J. Grabmeier, A. Scheerhorn: Finite Fields in AXIOM. +++ AXIOM Technical Report Series, ATR/5 NP2522. +++ Description: +++ FiniteFieldExtensionByPolynomial(GF, defpol) implements the extension +++ of the finite field {\em GF} generated by the extension polynomial +++ {\em defpol} which MUST be irreducible. +++ Note: the user has the responsibility to ensure that +++ {\em defpol} is irreducible. + +FiniteFieldExtensionByPolynomial(GF:FiniteFieldCategory,_ + defpol:SparseUnivariatePolynomial GF): Exports == Implementation where +-- GF : FiniteFieldCategory +-- defpol : SparseUnivariatePolynomial GF + + PI ==> PositiveInteger + NNI ==> NonNegativeInteger + SUP ==> SparseUnivariatePolynomial + I ==> Integer + R ==> Record(key:PI,entry:NNI) + TBL ==> Table(PI,NNI) + SAE ==> SimpleAlgebraicExtension(GF,SUP GF,defpol) + OUT ==> OutputForm + + Exports ==> FiniteAlgebraicExtensionField(GF) + + Implementation ==> add + +-- global variables ==================================================== + + Rep:=SAE + + extdeg:PI := degree(defpol)$(SUP GF) pretend PI + -- the extension degree + + alpha := new()$Symbol :: OutputForm + -- a new symbol for the output form of field elements + + sizeCG:Integer := size()$GF**extdeg - 1 + -- the order of the multiplicative group + + facOfGroupSize := nil()$(List Record(factor:Integer,exponent:Integer)) + -- the factorization of sizeCG + + normalElt:PI:=1 + -- for the lookup of the normal Element computed by + -- createNormalElement + + primitiveElt:PI:=1 + -- for the lookup of the primitive Element computed by + -- createPrimitiveElement() + + initlog?:Boolean:=true + -- gets false after initialization of the discrete logarithm table + + initelt?:Boolean:=true + -- gets false after initialization of the primitive and the + -- normal element + + + discLogTable:Table(PI,TBL):=table()$Table(PI,TBL) + -- tables indexed by the factors of sizeCG, + -- discLogTable(factor) is a table with keys + -- primitiveElement() ** (i * (sizeCG quo factor)) and entries i for + -- i in 0..n-1, n computed in initialize() in order to use + -- the minimal size limit 'limit' optimal. + +-- functions =========================================================== + +-- createNormalElement() == +-- a:=primitiveElement() +-- nElt:=generator() +-- for i in 1.. repeat +-- normal? nElt => return nElt +-- nElt:=nElt*a +-- nElt + + generator() == reduce(monomial(1,1)$SUP(GF))$Rep + norm x == resultant(defpol, lift x) + + initializeElt: () -> Void + initializeLog: () -> Void + basis(n:PI) == + (extdeg rem n) ^= 0 => error "argument must divide extension degree" + a:$:=norm(primitiveElement(),n) + vector [a**i for i in 0..n-1] + + degree(x) == + y:$:=1 + m:=zero(extdeg,extdeg+1)$(Matrix GF) + for i in 1..extdeg+1 repeat + setColumn_!(m,i,coordinates(y))$(Matrix GF) + y:=y*x + rank(m)::PI + + minimalPolynomial(x:$) == + y:$:=1 + m:=zero(extdeg,extdeg+1)$(Matrix GF) + for i in 1..extdeg+1 repeat + setColumn_!(m,i,coordinates(y))$(Matrix GF) + y:=y*x + v:=first nullSpace(m)$(Matrix GF) + +/[monomial(v.(i+1),i)$(SUP GF) for i in 0..extdeg] + + + normal?(x) == + l:List List GF:=[entries coordinates x] + a:=x + for i in 2..extdeg repeat + a:=Frobenius(a) + l:=concat(l,entries coordinates a)$(List List GF) + ((rank matrix(l)$(Matrix GF)) = extdeg::NNI) => true + false + + + a:GF * x:$ == a *$Rep x + n:I * x:$ == n *$Rep x + -x == -$Rep x + random() == random()$Rep + coordinates(x:$) == coordinates(x)$Rep + represents(v) == represents(v)$Rep + coerce(x:GF):$ == coerce(x)$Rep + definingPolynomial() == defpol + retract(x) == retract(x)$Rep + retractIfCan(x) == retractIfCan(x)$Rep + index(x) == index(x)$Rep + lookup(x) == lookup(x)$Rep + x:$/y:$ == x /$Rep y + x:$/a:GF == x/coerce(a) +-- x:$ / a:GF == +-- a = 0$GF => error "division by zero" +-- x * inv(coerce(a)) + x:$ * y:$ == x *$Rep y + x:$ + y:$ == x +$Rep y + x:$ - y:$ == x -$Rep y + x:$ = y:$ == x =$Rep y + basis() == basis()$Rep + 0 == 0$Rep + 1 == 1$Rep + + factorsOfCyclicGroupSize() == + if empty? facOfGroupSize then initializeElt() + facOfGroupSize + + representationType() == "polynomial" + + tableForDiscreteLogarithm(fac) == + if initlog? then initializeLog() + tbl:=search(fac::PI,discLogTable)$Table(PI,TBL) + tbl case "failed" => + error "tableForDiscreteLogarithm: argument must be prime divisor_ + of the order of the multiplicative group" + tbl pretend TBL + + primitiveElement() == + if initelt? then initializeElt() + index(primitiveElt) + + normalElement() == + if initelt? then initializeElt() + index(normalElt) + + initializeElt() == + facOfGroupSize:=factors(factor(sizeCG)$Integer) + -- get a primitive element + pE:=createPrimitiveElement() + primitiveElt:=lookup(pE) + -- create a normal element + nElt:=generator() + while not normal? nElt repeat + nElt:=nElt*pE + normalElt:=lookup(nElt) + -- set elements initialization flag + initelt? := false + void()$Void + + initializeLog() == + if initelt? then initializeElt() +-- set up tables for discrete logarithm + limit:Integer:=30 + -- the minimum size for the discrete logarithm table + for f in facOfGroupSize repeat + fac:=f.factor + base:$:=primitiveElement() ** (sizeCG quo fac) + l:Integer:=length(fac)$Integer + n:Integer:=0 + if odd?(l)$Integer then n:=shift(fac,-(l quo 2)) + else n:=shift(1,(l quo 2)) + if n < limit then + d:=(fac-1) quo limit + 1 + n:=(fac-1) quo d + 1 + tbl:TBL:=table()$TBL + a:$:=1 + for i in (0::NNI)..(n-1)::NNI repeat + insert_!([lookup(a),i::NNI]$R,tbl)$TBL + a:=a*base + insert_!([fac::PI,copy(tbl)$TBL]_ + $Record(key:PI,entry:TBL),discLogTable)$Table(PI,TBL) + -- set logarithm initialization flag + initlog? := false + -- tell user about initialization + --print("discrete logarithm tables initialized"::OUT) + void()$Void + + coerce(e:$):OutputForm == outputForm(lift(e),alpha) + + extensionDegree() == extdeg + + size() == (sizeCG + 1) pretend NNI + +-- sizeOfGroundField() == size()$GF + + inGroundField?(x) == + retractIfCan(x) = "failed" => false + true + + characteristic() == characteristic()$GF + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain FFNB FiniteFieldNormalBasis} +\pagehead{FiniteFieldNormalBasis}{FFNB} +\pagepic{ps/v103finitefieldnormalbasis.ps}{FFNB}{1.00} +See also:\\ +\refto{FiniteFieldNormalBasisExtensionByPolynomial}{FFNBP} +\refto{FiniteFieldNormalBasisExtension}{FFNBX} +<>= +)abbrev domain FFNB FiniteFieldNormalBasis +++ Authors: J.Grabmeier, A.Scheerhorn +++ Date Created: 26.03.1991 +++ Date Last Updated: +++ Basic Operations: +++ Related Constructors: FiniteFieldNormalBasisExtensionByPolynomial, +++ FiniteFieldPolynomialPackage +++ Also See: FiniteField, FiniteFieldCyclicGroup +++ AMS Classifications: +++ Keywords: finite field, normal basis +++ References: +++ R.Lidl, H.Niederreiter: Finite Field, Encyclopedia of Mathematics and +++ Its Applications, Vol. 20, Cambridge Univ. Press, 1983, ISBN 0 521 30240 4 +++ J. Grabmeier, A. Scheerhorn: Finite Fields in AXIOM. +++ AXIOM Technical Report Series, ATR/5 NP2522. +++ Description: +++ FiniteFieldNormalBasis(p,n) implements a +++ finite extension field of degree n over the prime field with p elements. +++ The elements are represented by coordinate vectors with respect to +++ a normal basis, +++ i.e. a basis consisting of the conjugates (q-powers) of an element, in +++ this case called normal element. +++ This is chosen as a root of the extension polynomial +++ created by \spadfunFrom{createNormalPoly}{FiniteFieldPolynomialPackage}. +FiniteFieldNormalBasis(p,extdeg):_ + Exports == Implementation where + p : PositiveInteger + extdeg: PositiveInteger -- the extension degree + NNI ==> NonNegativeInteger + FFF ==> FiniteFieldFunctions(PrimeField(p)) + TERM ==> Record(value:PrimeField(p),index:SingleInteger) + Exports ==> FiniteAlgebraicExtensionField(PrimeField(p)) with + getMultiplicationTable: () -> Vector List TERM + ++ getMultiplicationTable() returns the multiplication + ++ table for the normal basis of the field. + ++ This table is used to perform multiplications between field elements. + getMultiplicationMatrix: () -> Matrix PrimeField(p) + ++ getMultiplicationMatrix() returns the multiplication table in + ++ form of a matrix. + sizeMultiplication:() -> NNI + ++ sizeMultiplication() returns the number of entries in the + ++ multiplication table of the field. Note: The time of multiplication + ++ of field elements depends on this size. + + Implementation ==> FiniteFieldNormalBasisExtensionByPolynomial(PrimeField(p),_ + createLowComplexityNormalBasis(extdeg)$FFF) + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain FFNBX FiniteFieldNormalBasisExtension} +\pagehead{FiniteFieldNormalBasisExtension}{FFNBX} +\pagepic{ps/v103finitefieldnormalbasisextension.ps}{FFNBX}{1.00} +See also:\\ +\refto{FiniteFieldNormalBasisExtensionByPolynomial}{FFNBP} +\refto{FiniteFieldNormalBasis}{FFNB} +<>= +)abbrev domain FFNBX FiniteFieldNormalBasisExtension +++ Authors: J.Grabmeier, A.Scheerhorn +++ Date Created: 26.03.1991 +++ Date Last Updated: +++ Basic Operations: +++ Related Constructors: FiniteFieldNormalBasisExtensionByPolynomial, +++ FiniteFieldPolynomialPackage +++ Also See: FiniteFieldExtension, FiniteFieldCyclicGroupExtension +++ AMS Classifications: +++ Keywords: finite field, normal basis +++ References: +++ R.Lidl, H.Niederreiter: Finite Field, Encyclopedia of Mathematics and +++ Its Applications, Vol. 20, Cambridge Univ. Press, 1983, ISBN 0 521 30240 4 +++ J. Grabmeier, A. Scheerhorn: Finite Fields in AXIOM. +++ AXIOM Technical Report Series, ATR/5 NP2522. +++ Description: +++ FiniteFieldNormalBasisExtensionByPolynomial(GF,n) implements a +++ finite extension field of degree n over the ground field {\em GF}. +++ The elements are represented by coordinate vectors with respect +++ to a normal basis, +++ i.e. a basis consisting of the conjugates (q-powers) of an element, in +++ this case called normal element. This is chosen as a root of the extension +++ polynomial, created by {\em createNormalPoly} from +++ \spadtype{FiniteFieldPolynomialPackage} +FiniteFieldNormalBasisExtension(GF,extdeg):_ + Exports == Implementation where + GF : FiniteFieldCategory -- the ground field + extdeg: PositiveInteger -- the extension degree + NNI ==> NonNegativeInteger + FFF ==> FiniteFieldFunctions(GF) + TERM ==> Record(value:GF,index:SingleInteger) + Exports ==> FiniteAlgebraicExtensionField(GF) with + getMultiplicationTable: () -> Vector List TERM + ++ getMultiplicationTable() returns the multiplication + ++ table for the normal basis of the field. + ++ This table is used to perform multiplications between field elements. + getMultiplicationMatrix: () -> Matrix GF + ++ getMultiplicationMatrix() returns the multiplication table in + ++ form of a matrix. + sizeMultiplication:() -> NNI + ++ sizeMultiplication() returns the number of entries in the + ++ multiplication table of the field. Note: the time of multiplication + ++ of field elements depends on this size. + + Implementation ==> FiniteFieldNormalBasisExtensionByPolynomial(GF,_ + createLowComplexityNormalBasis(extdeg)$FFF) + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain FFNBP FiniteFieldNormalBasisExtensionByPolynomial} +\pagehead{FiniteFieldNormalBasisExtensionByPolynomial}{FFNBP} +\pagepic{ps/v103finitefieldnormalbasisextensionbypolynomial.ps}{FFNBP}{1.00} +See also:\\ +\refto{FiniteFieldNormalBasisExtension}{FFNBX} +\refto{FiniteFieldNormalBasis}{FFNB} +<>= +)abbrev domain FFNBP FiniteFieldNormalBasisExtensionByPolynomial +++ Authors: J.Grabmeier, A.Scheerhorn +++ Date Created: 26.03.1991 +++ Date Last Updated: 08 May 1991 +++ Basic Operations: +++ Related Constructors: InnerNormalBasisFieldFunctions, FiniteFieldFunctions, +++ Also See: FiniteFieldExtensionByPolynomial, +++ FiniteFieldCyclicGroupExtensionByPolynomial +++ AMS Classifications: +++ Keywords: finite field, normal basis +++ References: +++ R.Lidl, H.Niederreiter: Finite Field, Encyclopedia of Mathematics and +++ Its Applications, Vol. 20, Cambridge Univ. Press, 1983, ISBN 0 521 30240 4 +++ J. Grabmeier, A. Scheerhorn: Finite Fields in AXIOM . +++ AXIOM Technical Report Series, ATR/5 NP2522. +++ Description: +++ FiniteFieldNormalBasisExtensionByPolynomial(GF,uni) implements a +++ finite extension of the ground field {\em GF}. The elements are +++ represented by coordinate vectors with respect to. a normal basis, +++ i.e. a basis +++ consisting of the conjugates (q-powers) of an element, in this case +++ called normal element, where q is the size of {\em GF}. +++ The normal element is chosen as a root of the extension +++ polynomial, which MUST be normal over {\em GF} (user responsibility) +FiniteFieldNormalBasisExtensionByPolynomial(GF,uni): Exports == _ + Implementation where + GF : FiniteFieldCategory -- the ground field + uni : Union(SparseUnivariatePolynomial GF,_ + Vector List Record(value:GF,index:SingleInteger)) + + PI ==> PositiveInteger + NNI ==> NonNegativeInteger + I ==> Integer + SI ==> SingleInteger + SUP ==> SparseUnivariatePolynomial + V ==> Vector GF + M ==> Matrix GF + OUT ==> OutputForm + TERM ==> Record(value:GF,index:SI) + R ==> Record(key:PI,entry:NNI) + TBL ==> Table(PI,NNI) + FFF ==> FiniteFieldFunctions(GF) + INBFF ==> InnerNormalBasisFieldFunctions(GF) + + Exports ==> FiniteAlgebraicExtensionField(GF) with + + getMultiplicationTable: () -> Vector List TERM + ++ getMultiplicationTable() returns the multiplication + ++ table for the normal basis of the field. + ++ This table is used to perform multiplications between field elements. + getMultiplicationMatrix:() -> M + ++ getMultiplicationMatrix() returns the multiplication table in + ++ form of a matrix. + sizeMultiplication:() -> NNI + ++ sizeMultiplication() returns the number of entries in the + ++ multiplication table of the field. + ++ Note: the time of multiplication + ++ of field elements depends on this size. + Implementation ==> add + +-- global variables =================================================== + + Rep:= V -- elements are represented by vectors over GF + + alpha :=new()$Symbol :: OutputForm + -- get a new Symbol for the output representation of the elements + + initlog?:Boolean:=true + -- gets false after initialization of the logarithm table + + initelt?:Boolean:=true + -- gets false after initialization of the primitive element + + initmult?:Boolean:=true + -- gets false after initialization of the multiplication + -- table or the primitive element + + extdeg:PI :=1 + + defpol:SUP(GF):=0$SUP(GF) + -- the defining polynomial + + multTable:Vector List TERM:=new(1,nil()$(List TERM)) + -- global variable containing the multiplication table + + if uni case (Vector List TERM) then + multTable:=uni :: (Vector List TERM) + extdeg:= (#multTable) pretend PI + vv:V:=new(extdeg,0)$V + vv.1:=1$GF + setFieldInfo(multTable,1$GF)$INBFF + defpol:=minimalPolynomial(vv)$INBFF + initmult?:=false + else + defpol:=uni :: SUP(GF) + extdeg:=degree(defpol)$(SUP GF) pretend PI + multTable:Vector List TERM:=new(extdeg,nil()$(List TERM)) + + basisOutput : List OUT := + qs:OUT:=(q::Symbol)::OUT + append([alpha, alpha **$OUT qs],_ + [alpha **$OUT (qs **$OUT i::OUT) for i in 2..extdeg-1] ) + + + facOfGroupSize :=nil()$(List Record(factor:Integer,exponent:Integer)) + -- the factorization of the cyclic group size + + + traceAlpha:GF:=-$GF coefficient(defpol,(degree(defpol)-1)::NNI) + -- the inverse of the trace of the normalElt + -- is computed here. It defines the imbedding of + -- GF in the extension field + + primitiveElt:PI:=1 + -- for the lookup the primitive Element computed by createPrimitiveElement() + + discLogTable:Table(PI,TBL):=table()$Table(PI,TBL) + -- tables indexed by the factors of sizeCG, + -- discLogTable(factor) is a table with keys + -- primitiveElement() ** (i * (sizeCG quo factor)) and entries i for + -- i in 0..n-1, n computed in initialize() in order to use + -- the minimal size limit 'limit' optimal. + +-- functions =========================================================== + + initializeLog: () -> Void + initializeElt: () -> Void + initializeMult: () -> Void + + + coerce(v:GF):$ == new(extdeg,v /$GF traceAlpha)$Rep + represents(v) == v::$ + + degree(a) == + d:PI:=1 + b:= qPot(a::Rep,1)$INBFF + while (b^=a) repeat + b:= qPot(b::Rep,1)$INBFF + d:=d+1 + d + + linearAssociatedExp(x,f) == + xm:SUP(GF):=monomial(1$GF,extdeg)$(SUP GF) - 1$(SUP GF) + r:= (f * pol(x::Rep)$INBFF) rem xm + vectorise(r,extdeg)$(SUP GF) + linearAssociatedLog(x) == pol(x::Rep)$INBFF + linearAssociatedOrder(x) == + xm:SUP(GF):=monomial(1$GF,extdeg)$(SUP GF) - 1$(SUP GF) + xm quo gcd(xm,pol(x::Rep)$INBFF) + linearAssociatedLog(b,x) == + zero? x => 0 + xm:SUP(GF):=monomial(1$GF,extdeg)$(SUP GF) - 1$(SUP GF) + e:= extendedEuclidean(pol(b::Rep)$INBFF,xm,pol(x::Rep)$INBFF)$(SUP GF) + e = "failed" => "failed" + e1:= e :: Record(coef1:(SUP GF),coef2:(SUP GF)) + e1.coef1 + + getMultiplicationTable() == + if initmult? then initializeMult() + multTable + getMultiplicationMatrix() == + if initmult? then initializeMult() + createMultiplicationMatrix(multTable)$FFF + sizeMultiplication() == + if initmult? then initializeMult() + sizeMultiplication(multTable)$FFF + + trace(a:$) == retract trace(a,1) + norm(a:$) == retract norm(a,1) + generator() == normalElement(extdeg)$INBFF + basis(n:PI) == + (extdeg rem n) ^= 0 => error "argument must divide extension degree" + [Frobenius(trace(normalElement,n),i) for i in 0..(n-1)]::(Vector $) + + a:GF * x:$ == a *$Rep x + + x:$/a:GF == x/coerce(a) +-- x:$ / a:GF == +-- a = 0$GF => error "division by zero" +-- x * inv(coerce(a)) + + + coordinates(x:$) == x::Rep + + Frobenius(e) == qPot(e::Rep,1)$INBFF + Frobenius(e,n) == qPot(e::Rep,n)$INBFF + + retractIfCan(x) == + inGroundField?(x) => + x.1 *$GF traceAlpha + "failed" + + retract(x) == + inGroundField?(x) => + x.1 *$GF traceAlpha + error("element not in ground field") + +-- to get a "normal basis like" output form + coerce(x:$):OUT == + l:List OUT:=nil()$(List OUT) + n : PI := extdeg +-- one? n => (x.1) :: OUT + (n = 1) => (x.1) :: OUT + for i in 1..n for b in basisOutput repeat + if not zero? x.i then + mon : OUT := +-- one? x.i => b + (x.i = 1) => b + ((x.i)::OUT) *$OUT b + l:=cons(mon,l)$(List OUT) + null(l)$(List OUT) => (0::OUT) + r:=reduce("+",l)$(List OUT) + r + + initializeElt() == + facOfGroupSize := factors factor(size()$GF**extdeg-1)$I + -- get a primitive element + primitiveElt:=lookup(createPrimitiveElement()) + initelt?:=false + void()$Void + + initializeMult() == + multTable:=createMultiplicationTable(defpol)$FFF + setFieldInfo(multTable,traceAlpha)$INBFF + -- reset initialize flag + initmult?:=false + void()$Void + + initializeLog() == + if initelt? then initializeElt() + -- set up tables for discrete logarithm + limit:Integer:=30 + -- the minimum size for the discrete logarithm table + for f in facOfGroupSize repeat + fac:=f.factor + base:$:=index(primitiveElt)**((size()$GF**extdeg -$I 1$I) quo$I fac) + l:Integer:=length(fac)$Integer + n:Integer:=0 + if odd?(l)$I then n:=shift(fac,-$I (l quo$I 2))$I + else n:=shift(1,l quo$I 2)$I + if n <$I limit then + d:=(fac -$I 1$I) quo$I limit +$I 1$I + n:=(fac -$I 1$I) quo$I d +$I 1$I + tbl:TBL:=table()$TBL + a:$:=1 + for i in (0::NNI)..(n-1)::NNI repeat + insert_!([lookup(a),i::NNI]$R,tbl)$TBL + a:=a*base + insert_!([fac::PI,copy(tbl)$TBL]_ + $Record(key:PI,entry:TBL),discLogTable)$Table(PI,TBL) + initlog?:=false + -- tell user about initialization + --print("discrete logarithm table initialized"::OUT) + void()$Void + + tableForDiscreteLogarithm(fac) == + if initlog? then initializeLog() + tbl:=search(fac::PI,discLogTable)$Table(PI,TBL) + tbl case "failed" => + error "tableForDiscreteLogarithm: argument must be prime _ +divisor of the order of the multiplicative group" + tbl :: TBL + + primitiveElement() == + if initelt? then initializeElt() + index(primitiveElt) + + factorsOfCyclicGroupSize() == + if empty? facOfGroupSize then initializeElt() + facOfGroupSize + + extensionDegree() == extdeg + + sizeOfGroundField() == size()$GF pretend NNI + + definingPolynomial() == defpol + + trace(a,d) == + v:=trace(a::Rep,d)$INBFF + erg:=v + for i in 2..(extdeg quo d) repeat + erg:=concat(erg,v)$Rep + erg + + characteristic() == characteristic()$GF + + random() == random(extdeg)$INBFF + + x:$ * y:$ == + if initmult? then initializeMult() + setFieldInfo(multTable,traceAlpha)$INBFF + x::Rep *$INBFF y::Rep + + + 1 == new(extdeg,inv(traceAlpha)$GF)$Rep + + 0 == zero(extdeg)$Rep + + size() == size()$GF ** extdeg + + index(n:PI) == index(extdeg,n)$INBFF + + lookup(x:$) == lookup(x::Rep)$INBFF + + + basis() == + a:=basis(extdeg)$INBFF + vector([e::$ for e in entries a]) + + + x:$ ** e:I == + if initmult? then initializeMult() + setFieldInfo(multTable,traceAlpha)$INBFF + (x::Rep) **$INBFF e + + normal?(x) == normal?(x::Rep)$INBFF + + -(x:$) == -$Rep x + x:$ + y:$ == x +$Rep y + x:$ - y:$ == x -$Rep y + x:$ = y:$ == x =$Rep y + n:I * x:$ == x *$Rep (n::GF) + + + + + representationType() == "normal" + + minimalPolynomial(a) == + if initmult? then initializeMult() + setFieldInfo(multTable,traceAlpha)$INBFF + minimalPolynomial(a::Rep)$INBFF + +-- is x an element of the ground field GF ? + inGroundField?(x) == + erg:=true + for i in 2..extdeg repeat + not(x.i =$GF x.1) => erg:=false + erg + + x:$ / y:$ == + if initmult? then initializeMult() + setFieldInfo(multTable,traceAlpha)$INBFF + x::Rep /$INBFF y::Rep + + inv(a) == + if initmult? then initializeMult() + setFieldInfo(multTable,traceAlpha)$INBFF + inv(a::Rep)$INBFF + + norm(a,d) == + if initmult? then initializeMult() + setFieldInfo(multTable,traceAlpha)$INBFF + norm(a::Rep,d)$INBFF + + normalElement() == normalElement(extdeg)$INBFF + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{domain FARRAY FlexibleArray} <>= -- array1.spad.pamphlet FlexibleArray.input @@ -16378,6 +19600,4114 @@ FlexibleArray(S: Type) == Implementation where @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain FLOAT Float} +As reported in bug number 4733 (rounding of negative numbers) +errors were observed in operations such as +\begin{verbatim} + -> round(-3.9) + -> truncate(-3.9) +\end{verbatim} +The problem is the unexpected behaviour of the shift +with negative integer arguments. +\begin{verbatim} + -> shift(-7,-1) +\end{verbatim} +returns -4 while the code here in float expects the +value to be -3. shift uses the lisp function ASH +'arithmetic shift left' but the spad code expects +an unsigned 'logical' shift. See +\begin{verbatim} + http://www.lispworks.com/reference/HyperSpec/Body/f_ash.htm#ash +\end{verbatim} +A new internal function shift2 is defined in terms of +shift to compensate for the use of ASH and provide the +required function. + +It is currently unknown whether the unexpected behaviour +of shift for negative arguments will cause bugs in other +parts of Axiom. +<>= +-- float.spad.pamphlet Float.input +)spool Float.output +)set message test on +)set message auto off +)clear all +--S 1 of 37 +1.234 +--R +--R +--R (1) 1.234 +--R Type: Float +--E 1 + +--S 2 of 37 +1.234E2 +--R +--R +--R (2) 123.4 +--R Type: Float +--E 2 + +--S 3 of 37 +sqrt(1.2 + 2.3 / 3.4 ** 4.5) +--R +--R +--R (3) 1.0996972790 671286226 +--R Type: Float +--E 3 + +--S 4 of 37 +i := 3 :: Float +--R +--R +--R (4) 3.0 +--R Type: Float +--E 4 + +--S 5 of 37 +i :: Integer +--R +--R +--R (5) 3 +--R Type: Integer +--E 5 + +--S 6 of 37 +i :: Fraction Integer +--R +--R +--R (6) 3 +--R Type: Fraction Integer +--E 6 + +--S 7 of 37 +r := 3/7 :: Float +--R +--R +--R (7) 0.4285714285 7142857143 +--R Type: Float +--E 7 + +--S 8 of 37 +r :: Fraction Integer +--R +--R +--R 3 +--R (8) - +--R 7 +--R Type: Fraction Integer +--E 8 + +--S 9 of 37 +r :: Integer +--R +--R +--RDaly Bug +--R Cannot convert from type Float to Integer for value +--R 0.4285714285 7142857143 +--R +--E 9 + +--S 10 of 37 +truncate 3.6 +--R +--R +--R (9) 3.0 +--R Type: Float +--E 10 + +--S 11 of 37 +round 3.6 +--R +--R +--R (10) 4.0 +--R Type: Float +--E 11 + +--S 12 of 37 +truncate(-3.6) +--R +--R +--R (11) - 3.0 +--R Type: Float +--E 12 + +--S 13 of 37 +round(-3.6) +--R +--R +--R (12) - 4.0 +--R Type: Float +--E 13 + +--S 14 of 37 +fractionPart 3.6 +--R +--R +--R (13) 0.6 +--R Type: Float +--E 14 + +--S 15 of 37 +digits 40 +--R +--R +--R (14) 20 +--R Type: PositiveInteger +--E 15 + +--S 16 of 37 +sqrt 0.2 +--R +--R +--R (15) 0.4472135954 9995793928 1834733746 2552470881 +--R Type: Float +--E 16 + +--S 17 of 37 +pi()$Float +--R +--R +--R (16) 3.1415926535 8979323846 2643383279 502884197 +--R Type: Float +--E 17 + +--S 18 of 37 +digits 500 +--R +--R +--R (17) 40 +--R Type: PositiveInteger +--E 18 + +--S 19 of 37 +pi()$Float +--R +--R +--R (18) +--R 3.1415926535 8979323846 2643383279 5028841971 6939937510 5820974944 592307816 +--R 4 0628620899 8628034825 3421170679 8214808651 3282306647 0938446095 505822317 +--R 2 5359408128 4811174502 8410270193 8521105559 6446229489 5493038196 442881097 +--R 5 6659334461 2847564823 3786783165 2712019091 4564856692 3460348610 454326648 +--R 2 1339360726 0249141273 7245870066 0631558817 4881520920 9628292540 917153643 +--R 6 7892590360 0113305305 4882046652 1384146951 9415116094 3305727036 575959195 +--R 3 0921861173 8193261179 3105118548 0744623799 6274956735 1885752724 891227938 +--R 1 830119491 +--R Type: Float +--E 19 + +--S 20 of 37 +digits 20 +--R +--R +--R (19) 500 +--R Type: PositiveInteger +--E 20 + +--S 21 of 37 +outputSpacing 0; x := sqrt 0.2 +--R +--R +--R (20) 0.44721359549995793928 +--R Type: Float +--E 21 + +--S 22 of 37 +outputSpacing 5; x +--R +--R +--R (21) 0.44721 35954 99957 93928 +--R Type: Float +--E 22 + +--S 23 of 37 +y := x/10**10 +--R +--R +--R (22) 0.44721 35954 99957 93928 E -10 +--R Type: Float +--E 23 + +--S 24 of 37 +outputFloating(); x +--R +--R +--R (23) 0.44721 35954 99957 93928 E 0 +--R Type: Float +--E 24 + +--S 25 of 37 +outputFixed(); y +--R +--R +--R (24) 0.00000 00000 44721 35954 99957 93928 +--R Type: Float +--E 25 + +--S 26 of 37 +outputFloating 2; y +--R +--R +--R (25) 0.45 E -10 +--R Type: Float +--E 26 + +--S 27 of 37 +outputFixed 2; x +--R +--R +--R (26) 0.45 +--R Type: Float +--E 27 + +--S 28 of 37 +outputGeneral() +--R +--R Type: Void +--E 28 + +--S 29 of 37 +a: Matrix Fraction Integer := matrix [ [1/(i+j+1) for j in 0..9] for i in 0..9] +--R +--R +--R + 1 1 1 1 1 1 1 1 1+ +--R |1 - - - - - - - - --| +--R | 2 3 4 5 6 7 8 9 10| +--R | | +--R |1 1 1 1 1 1 1 1 1 1| +--R |- - - - - - - - -- --| +--R |2 3 4 5 6 7 8 9 10 11| +--R | | +--R |1 1 1 1 1 1 1 1 1 1| +--R |- - - - - - - -- -- --| +--R |3 4 5 6 7 8 9 10 11 12| +--R | | +--R |1 1 1 1 1 1 1 1 1 1| +--R |- - - - - - -- -- -- --| +--R |4 5 6 7 8 9 10 11 12 13| +--R | | +--R |1 1 1 1 1 1 1 1 1 1| +--R |- - - - - -- -- -- -- --| +--R |5 6 7 8 9 10 11 12 13 14| +--R (28) | | +--R |1 1 1 1 1 1 1 1 1 1| +--R |- - - - -- -- -- -- -- --| +--R |6 7 8 9 10 11 12 13 14 15| +--R | | +--R |1 1 1 1 1 1 1 1 1 1| +--R |- - - -- -- -- -- -- -- --| +--R |7 8 9 10 11 12 13 14 15 16| +--R | | +--R |1 1 1 1 1 1 1 1 1 1| +--R |- - -- -- -- -- -- -- -- --| +--R |8 9 10 11 12 13 14 15 16 17| +--R | | +--R |1 1 1 1 1 1 1 1 1 1| +--R |- -- -- -- -- -- -- -- -- --| +--R |9 10 11 12 13 14 15 16 17 18| +--R | | +--R | 1 1 1 1 1 1 1 1 1 1| +--R |-- -- -- -- -- -- -- -- -- --| +--R +10 11 12 13 14 15 16 17 18 19+ +--R Type: Matrix Fraction Integer +--E 29 + +--S 30 of 37 +d:= determinant a +--R +--R +--R 1 +--R (29) ----------------------------------------------------- +--R 46206893947914691316295628839036278726983680000000000 +--R Type: Fraction Integer +--E 30 + +--S 31 of 37 +d :: Float +--R +--R +--R (30) 0.21641 79226 43149 18691 E -52 +--R Type: Float +--E 31 + +--S 32 of 37 +b: Matrix DoubleFloat := matrix [ [1/(i+j+1$DoubleFloat) for j in 0..9] for i in 0..9] +--R +--R +--R (31) +--R [ +--R [1., 0.5, 0.33333333333333331, 0.25, 0.20000000000000001, +--R 0.16666666666666666, 0.14285714285714285, 0.125, 0.1111111111111111, +--R 0.10000000000000001] +--R , +--R +--R [0.5, 0.33333333333333331, 0.25, 0.20000000000000001, 0.16666666666666666, +--R 0.14285714285714285, 0.125, 0.1111111111111111, 0.10000000000000001, +--R 9.0909090909090912E-2] +--R , +--R +--R [0.33333333333333331, 0.25, 0.20000000000000001, 0.16666666666666666, +--R 0.14285714285714285, 0.125, 0.1111111111111111, 0.10000000000000001, +--R 9.0909090909090912E-2, 8.3333333333333329E-2] +--R , +--R +--R [0.25, 0.20000000000000001, 0.16666666666666666, 0.14285714285714285, +--R 0.125, 0.1111111111111111, 0.10000000000000001, 9.0909090909090912E-2, +--R 8.3333333333333329E-2, 7.6923076923076927E-2] +--R , +--R +--R [0.20000000000000001, 0.16666666666666666, 0.14285714285714285, 0.125, +--R 0.1111111111111111, 0.10000000000000001, 9.0909090909090912E-2, +--R 8.3333333333333329E-2, 7.6923076923076927E-2, 7.1428571428571425E-2] +--R , +--R +--R [0.16666666666666666, 0.14285714285714285, 0.125, 0.1111111111111111, +--R 0.10000000000000001, 9.0909090909090912E-2, 8.3333333333333329E-2, +--R 7.6923076923076927E-2, 7.1428571428571425E-2, 6.6666666666666666E-2] +--R , +--R +--R [0.14285714285714285, 0.125, 0.1111111111111111, 0.10000000000000001, +--R 9.0909090909090912E-2, 8.3333333333333329E-2, 7.6923076923076927E-2, +--R 7.1428571428571425E-2, 6.6666666666666666E-2, 6.25E-2] +--R , +--R +--R [0.125, 0.1111111111111111, 0.10000000000000001, 9.0909090909090912E-2, +--R 8.3333333333333329E-2, 7.6923076923076927E-2, 7.1428571428571425E-2, +--R 6.6666666666666666E-2, 6.25E-2, 5.8823529411764705E-2] +--R , +--R +--R [0.1111111111111111, 0.10000000000000001, 9.0909090909090912E-2, +--R 8.3333333333333329E-2, 7.6923076923076927E-2, 7.1428571428571425E-2, +--R 6.6666666666666666E-2, 6.25E-2, 5.8823529411764705E-2, +--R 5.5555555555555552E-2] +--R , +--R +--R [0.10000000000000001, 9.0909090909090912E-2, 8.3333333333333329E-2, +--R 7.6923076923076927E-2, 7.1428571428571425E-2, 6.6666666666666666E-2, +--R 6.25E-2, 5.8823529411764705E-2, 5.5555555555555552E-2, +--R 5.2631578947368418E-2] +--R ] +--R Type: Matrix DoubleFloat +--E 32 + +--S 33 of 37 +determinant b +--R +--R +--R (32) 2.1643677945721411E-53 +--R Type: DoubleFloat +--E 33 + +--S 34 of 37 +digits 40 +--R +--R +--R (33) 20 +--R Type: PositiveInteger +--E 34 + +--S 35 of 37 +c: Matrix Float := matrix [ [1/(i+j+1$Float) for j in 0..9] for i in 0..9] +--R +--R +--R (34) +--R [ +--R [1.0, 0.5, 0.33333 33333 33333 33333 33333 33333 33333 33333, 0.25, 0.2, +--R 0.16666 66666 66666 66666 66666 66666 66666 66667, +--R 0.14285 71428 57142 85714 28571 42857 14285 71429, 0.125, +--R 0.11111 11111 11111 11111 11111 11111 11111 11111, 0.1] +--R , +--R +--R [0.5, 0.33333 33333 33333 33333 33333 33333 33333 33333, 0.25, 0.2, +--R 0.16666 66666 66666 66666 66666 66666 66666 66667, +--R 0.14285 71428 57142 85714 28571 42857 14285 71429, 0.125, +--R 0.11111 11111 11111 11111 11111 11111 11111 11111, 0.1, +--R 0.09090 90909 09090 90909 09090 90909 09090 90909 1] +--R , +--R +--R [0.33333 33333 33333 33333 33333 33333 33333 33333, 0.25, 0.2, +--R 0.16666 66666 66666 66666 66666 66666 66666 66667, +--R 0.14285 71428 57142 85714 28571 42857 14285 71429, 0.125, +--R 0.11111 11111 11111 11111 11111 11111 11111 11111, 0.1, +--R 0.09090 90909 09090 90909 09090 90909 09090 90909 1, +--R 0.08333 33333 33333 33333 33333 33333 33333 33333 4] +--R , +--R +--R [0.25, 0.2, 0.16666 66666 66666 66666 66666 66666 66666 66667, +--R 0.14285 71428 57142 85714 28571 42857 14285 71429, 0.125, +--R 0.11111 11111 11111 11111 11111 11111 11111 11111, 0.1, +--R 0.09090 90909 09090 90909 09090 90909 09090 90909 1, +--R 0.08333 33333 33333 33333 33333 33333 33333 33333 4, +--R 0.07692 30769 23076 92307 69230 76923 07692 30769 2] +--R , +--R +--R [0.2, 0.16666 66666 66666 66666 66666 66666 66666 66667, +--R 0.14285 71428 57142 85714 28571 42857 14285 71429, 0.125, +--R 0.11111 11111 11111 11111 11111 11111 11111 11111, 0.1, +--R 0.09090 90909 09090 90909 09090 90909 09090 90909 1, +--R 0.08333 33333 33333 33333 33333 33333 33333 33333 4, +--R 0.07692 30769 23076 92307 69230 76923 07692 30769 2, +--R 0.07142 85714 28571 42857 14285 71428 57142 85714 3] +--R , +--R +--R [0.16666 66666 66666 66666 66666 66666 66666 66667, +--R 0.14285 71428 57142 85714 28571 42857 14285 71429, 0.125, +--R 0.11111 11111 11111 11111 11111 11111 11111 11111, 0.1, +--R 0.09090 90909 09090 90909 09090 90909 09090 90909 1, +--R 0.08333 33333 33333 33333 33333 33333 33333 33333 4, +--R 0.07692 30769 23076 92307 69230 76923 07692 30769 2, +--R 0.07142 85714 28571 42857 14285 71428 57142 85714 3, +--R 0.06666 66666 66666 66666 66666 66666 66666 66666 7] +--R , +--R +--R [0.14285 71428 57142 85714 28571 42857 14285 71429, 0.125, +--R 0.11111 11111 11111 11111 11111 11111 11111 11111, 0.1, +--R 0.09090 90909 09090 90909 09090 90909 09090 90909 1, +--R 0.08333 33333 33333 33333 33333 33333 33333 33333 4, +--R 0.07692 30769 23076 92307 69230 76923 07692 30769 2, +--R 0.07142 85714 28571 42857 14285 71428 57142 85714 3, +--R 0.06666 66666 66666 66666 66666 66666 66666 66666 7, 0.0625] +--R , +--R +--R [0.125, 0.11111 11111 11111 11111 11111 11111 11111 11111, 0.1, +--R 0.09090 90909 09090 90909 09090 90909 09090 90909 1, +--R 0.08333 33333 33333 33333 33333 33333 33333 33333 4, +--R 0.07692 30769 23076 92307 69230 76923 07692 30769 2, +--R 0.07142 85714 28571 42857 14285 71428 57142 85714 3, +--R 0.06666 66666 66666 66666 66666 66666 66666 66666 7, 0.0625, +--R 0.05882 35294 11764 70588 23529 41176 47058 82352 9] +--R , +--R +--R [0.11111 11111 11111 11111 11111 11111 11111 11111, 0.1, +--R 0.09090 90909 09090 90909 09090 90909 09090 90909 1, +--R 0.08333 33333 33333 33333 33333 33333 33333 33333 4, +--R 0.07692 30769 23076 92307 69230 76923 07692 30769 2, +--R 0.07142 85714 28571 42857 14285 71428 57142 85714 3, +--R 0.06666 66666 66666 66666 66666 66666 66666 66666 7, 0.0625, +--R 0.05882 35294 11764 70588 23529 41176 47058 82352 9, +--R 0.05555 55555 55555 55555 55555 55555 55555 55555 6] +--R , +--R +--R [0.1, 0.09090 90909 09090 90909 09090 90909 09090 90909 1, +--R 0.08333 33333 33333 33333 33333 33333 33333 33333 4, +--R 0.07692 30769 23076 92307 69230 76923 07692 30769 2, +--R 0.07142 85714 28571 42857 14285 71428 57142 85714 3, +--R 0.06666 66666 66666 66666 66666 66666 66666 66666 7, 0.0625, +--R 0.05882 35294 11764 70588 23529 41176 47058 82352 9, +--R 0.05555 55555 55555 55555 55555 55555 55555 55555 6, +--R 0.05263 15789 47368 42105 26315 78947 36842 10526 3] +--R ] +--R Type: Matrix Float +--E 35 + +--S 36 of 37 +determinant c +--R +--R +--R (35) 0.21641 79226 43149 18690 60594 98362 26174 36159 E -52 +--R Type: Float +--E 36 + +--S 37 of 37 +digits 20 +--R +--R +--R (36) 40 +--R Type: PositiveInteger +--E 37 +)spool +)lisp (bye) +@ +<>= +==================================================================== +Float +==================================================================== + +Axiom provides two kinds of floating point numbers. The domain Float +implements a model of arbitrary precision floating point numbers. The +domain DoubleFloat is intended to make available hardware floating +point arithmetic in Axiom. The actual model of floating point that +DoubleFloat provides is system-dependent. For example, on the IBM +system 370 Axiom uses IBM double precision which has fourteen +hexadecimal digits of precision or roughly sixteen decimal digits. +Arbitrary precision floats allow the user to specify the precision at +which arithmetic operations are computed. Although this is an +attractive facility, it comes at a cost. Arbitrary-precision +floating-point arithmetic typically takes twenty to two hundred times +more time than hardware floating point. + +==================================================================== +Introduction to Float +==================================================================== + +Scientific notation is supported for input and output of floating +point numbers. A floating point number is written as a string of +digits containing a decimal point optionally followed by the letter +"E", and then the exponent. + +We begin by doing some calculations using arbitrary precision floats. +The default precision is twenty decimal digits. + + 1.234 + 1.234 + Type: Float + +A decimal base for the exponent is assumed, so the number +1.234E2 denotes 1.234x10^2. + + 1.234E2 + 123.4 + Type: Float +The normal arithmetic operations are available for floating point numbers. + + sqrt(1.2 + 2.3 / 3.4 ** 4.5) + 1.0996972790 671286226 + Type: Float + +==================================================================== +Conversion Functions +==================================================================== + +You can use conversion to go back and forth between Integer, Fraction +Integer and Float, as appropriate. + + i := 3 :: Float + 3.0 + Type: Float + + i :: Integer + 3 + Type: Integer + + i :: Fraction Integer + 3 + Type: Fraction Integer + +Since you are explicitly asking for a conversion, you must take +responsibility for any loss of exactness. + + r := 3/7 :: Float + 0.4285714285 7142857143 + Type: Float + + r :: Fraction Integer + 3 + - + 7 + Type: Fraction Integer + +This conversion cannot be performed: use truncate or round if that is +what you intend. + + r :: Integer + Cannot convert from type Float to Integer for value + 0.4285714285 7142857143 + +The operations truncate and round truncate ... + + truncate 3.6 + 3.0 + Type: Float + +and round to the nearest integral Float respectively. + + round 3.6 + 4.0 + Type: Float + + truncate(-3.6) + - 3.0 + Type: Float + + round(-3.6) + - 4.0 + Type: Float + +The operation fractionPart computes the fractional part of x, that is, +x - truncate x. + + fractionPart 3.6 + 0.6 + Type: Float + +The operation digits allows the user to set the precision. It returns +the previous value it was using. + + digits 40 + 20 + Type: PositiveInteger + + sqrt 0.2 + 0.4472135954 9995793928 1834733746 2552470881 + Type: Float + + pi()$Float + 3.1415926535 8979323846 2643383279 502884197 + Type: Float + +The precision is only limited by the computer memory available. +Calculations at 500 or more digits of precision are not difficult. + + digits 500 + 40 + Type: PositiveInteger + + pi()$Float + 3.1415926535 8979323846 2643383279 5028841971 6939937510 5820974944 592307816 + 4 0628620899 8628034825 3421170679 8214808651 3282306647 0938446095 505822317 + 2 5359408128 4811174502 8410270193 8521105559 6446229489 5493038196 442881097 + 5 6659334461 2847564823 3786783165 2712019091 4564856692 3460348610 454326648 + 2 1339360726 0249141273 7245870066 0631558817 4881520920 9628292540 917153643 + 6 7892590360 0113305305 4882046652 1384146951 9415116094 3305727036 575959195 + 3 0921861173 8193261179 3105118548 0744623799 6274956735 1885752724 891227938 + 1 830119491 + Type: Float + +Reset digits to its default value. + + digits 20 + 500 + Type: PositiveInteger + +Numbers of type Float are represented as a record of two +integers, namely, the mantissa and the exponent where the base of the +exponent is binary. That is, the floating point number (m,e) +represents the number m x 2^e. A consequence of using a binary +base is that decimal numbers can not, in general, be represented +exactly. + +==================================================================== +Output Functions +==================================================================== + +A number of operations exist for specifying how numbers of type Float +are to be displayed. By default, spaces are inserted every ten digits +in the output for readability. Note that you cannot include spaces in +the input form of a floating point number, though you can use +underscores. + +Output spacing can be modified with the outputSpacing operation. This +inserts no spaces and then displays the value of x. + + outputSpacing 0; x := sqrt 0.2 + 0.44721359549995793928 + Type: Float + +Issue this to have the spaces inserted every 5 digits. + + outputSpacing 5; x + 0.44721 35954 99957 93928 + Type: Float + +By default, the system displays floats in either fixed format +or scientific format, depending on the magnitude of the number. + + y := x/10**10 + 0.44721 35954 99957 93928 E -10 + Type: Float + +A particular format may be requested with the operations +outputFloating and outputFixed. + + outputFloating(); x + 0.44721 35954 99957 93928 E 0 + Type: Float + + outputFixed(); y + 0.00000 00000 44721 35954 99957 93928 + Type: Float + +Additionally, you can ask for n digits to be displayed after the +decimal point. + + outputFloating 2; y + 0.45 E -10 + Type: Float + + outputFixed 2; x + 0.45 + Type: Float + +This resets the output printing to the default behavior. + + outputGeneral() + Type: Void + +==================================================================== +An Example: Determinant of a Hilbert Matrix +==================================================================== + +Consider the problem of computing the determinant of a 10 by 10 +Hilbert matrix. The (i,j)-th entry of a Hilbert matrix is given +by 1/(i+j+1). + +First do the computation using rational numbers to obtain the +exact result. + + a: Matrix Fraction Integer:=matrix[ [1/(i+j+1) for j in 0..9] for i in 0..9] + + 1 1 1 1 1 1 1 1 1+ + |1 - - - - - - - - --| + | 2 3 4 5 6 7 8 9 10| + | | + |1 1 1 1 1 1 1 1 1 1| + |- - - - - - - - -- --| + |2 3 4 5 6 7 8 9 10 11| + | | + |1 1 1 1 1 1 1 1 1 1| + |- - - - - - - -- -- --| + |3 4 5 6 7 8 9 10 11 12| + | | + |1 1 1 1 1 1 1 1 1 1| + |- - - - - - -- -- -- --| + |4 5 6 7 8 9 10 11 12 13| + | | + |1 1 1 1 1 1 1 1 1 1| + |- - - - - -- -- -- -- --| + |5 6 7 8 9 10 11 12 13 14| + | | + |1 1 1 1 1 1 1 1 1 1| + |- - - - -- -- -- -- -- --| + |6 7 8 9 10 11 12 13 14 15| + | | + |1 1 1 1 1 1 1 1 1 1| + |- - - -- -- -- -- -- -- --| + |7 8 9 10 11 12 13 14 15 16| + | | + |1 1 1 1 1 1 1 1 1 1| + |- - -- -- -- -- -- -- -- --| + |8 9 10 11 12 13 14 15 16 17| + | | + |1 1 1 1 1 1 1 1 1 1| + |- -- -- -- -- -- -- -- -- --| + |9 10 11 12 13 14 15 16 17 18| + | | + | 1 1 1 1 1 1 1 1 1 1| + |-- -- -- -- -- -- -- -- -- --| + +10 11 12 13 14 15 16 17 18 19+ + Type: Matrix Fraction Integer + +This version of determinant uses Gaussian elimination. + + d:= determinant a + 1 + ----------------------------------------------------- + 46206893947914691316295628839036278726983680000000000 + Type: Fraction Integer + + d :: Float + 0.21641 79226 43149 18691 E -52 + Type: Float + +Now use hardware floats. Note that a semicolon (;) is used to prevent +the display of the matrix. + + b: Matrix DoubleFloat:=matrix[ [1/(i+j+1\$DoubleFloat) for j in 0..9] for i in 0..9]; + + + Type: Matrix DoubleFloat + +The result given by hardware floats is correct only to four +significant digits of precision. In the jargon of numerical analysis, +the Hilbert matrix is said to be "ill-conditioned." + + determinant b + 2.1643677945721411E-53 + Type: DoubleFloat + +Now repeat the computation at a higher precision using Float. + + digits 40 + 20 + Type: PositiveInteger + + c: Matrix Float := matrix [ [1/(i+j+1\$Float) for j in 0..9] for i in 0..9]; + Type: Matrix Float + + determinant c + 0.21641 79226 43149 18690 60594 98362 26174 36159 E -52 + Type: Float + +Reset digits to its default value. + + digits 20 + 40 + Type: PositiveInteger + +See Also: +o )help DoubleFloat +o )show Float +o $AXIOM/doc/src/algebra/float.spad.dvi + +@ +\pagehead{Float}{FLOAT} +\pagepic{ps/v103float.ps}{FLOAT}{1.00} +<>= +)abbrev domain FLOAT Float + +B ==> Boolean +I ==> Integer +S ==> String +PI ==> PositiveInteger +RN ==> Fraction Integer +SF ==> DoubleFloat +N ==> NonNegativeInteger + +++ Author: Michael Monagan +++ Date Created: +++ December 1987 +++ Change History: +++ 19 Jun 1990 +++ Basic Operations: outputFloating, outputFixed, outputGeneral, outputSpacing, +++ atan, convert, exp1, log2, log10, normalize, rationalApproximation, +++ relerror, shift, / , ** +++ Keywords: float, floating point, number +++ Description: \spadtype{Float} implements arbitrary precision floating +++ point arithmetic. +++ The number of significant digits of each operation can be set +++ to an arbitrary value (the default is 20 decimal digits). +++ The operation \spad{float(mantissa,exponent,\spadfunFrom{base}{FloatingPointSystem})} for integer +++ \spad{mantissa}, \spad{exponent} specifies the number +++ \spad{mantissa * \spadfunFrom{base}{FloatingPointSystem} ** exponent} +++ The underlying representation for floats is binary +++ not decimal. The implications of this are described below. +++ +++ The model adopted is that arithmetic operations are rounded to +++ to nearest unit in the last place, that is, accurate to within +++ \spad{2**(-\spadfunFrom{bits}{FloatingPointSystem})}. +++ Also, the elementary functions and constants are +++ accurate to one unit in the last place. +++ A float is represented as a record of two integers, the mantissa +++ and the exponent. The \spadfunFrom{base}{FloatingPointSystem} +++ of the representation is binary, hence +++ a \spad{Record(m:mantissa,e:exponent)} represents the number \spad{m * 2 ** e}. +++ Though it is not assumed that the underlying integers are represented +++ with a binary \spadfunFrom{base}{FloatingPointSystem}, +++ the code will be most efficient when this is the +++ the case (this is true in most implementations of Lisp). +++ The decision to choose the \spadfunFrom{base}{FloatingPointSystem} to be +++ binary has some unfortunate +++ consequences. First, decimal numbers like 0.3 cannot be represented +++ exactly. Second, there is a further loss of accuracy during +++ conversion to decimal for output. To compensate for this, if d +++ digits of precision are specified, \spad{1 + ceiling(log2 d)} bits are used. +++ Two numbers that are displayed identically may therefore be +++ not equal. On the other hand, a significant efficiency loss would +++ be incurred if we chose to use a decimal \spadfunFrom{base}{FloatingPointSystem} when the underlying +++ integer base is binary. +++ +++ Algorithms used: +++ For the elementary functions, the general approach is to apply +++ identities so that the taylor series can be used, and, so +++ that it will converge within \spad{O( sqrt n )} steps. For example, +++ using the identity \spad{exp(x) = exp(x/2)**2}, we can compute +++ \spad{exp(1/3)} to n digits of precision as follows. We have +++ \spad{exp(1/3) = exp(2 ** (-sqrt s) / 3) ** (2 ** sqrt s)}. +++ The taylor series will converge in less than sqrt n steps and the +++ exponentiation requires sqrt n multiplications for a total of +++ \spad{2 sqrt n} multiplications. Assuming integer multiplication costs +++ \spad{O( n**2 )} the overall running time is \spad{O( sqrt(n) n**2 )}. +++ This approach is the best known approach for precisions up to +++ about 10,000 digits at which point the methods of Brent +++ which are \spad{O( log(n) n**2 )} become competitive. Note also that +++ summing the terms of the taylor series for the elementary +++ functions is done using integer operations. This avoids the +++ overhead of floating point operations and results in efficient +++ code at low precisions. This implementation makes no attempt +++ to reuse storage, relying on the underlying system to do +++ \spadgloss{garbage collection}. I estimate that the efficiency of this +++ package at low precisions could be improved by a factor of 2 +++ if in-place operations were available. +++ +++ Running times: in the following, n is the number of bits of precision +++ \spad{*}, \spad{/}, \spad{sqrt}, \spad{pi}, \spad{exp1}, \spad{log2}, \spad{log10}: \spad{ O( n**2 )} +++ \spad{exp}, \spad{log}, \spad{sin}, \spad{atan}: \spad{ O( sqrt(n) n**2 )} +++ The other elementary functions are coded in terms of the ones above. + + +Float(): + Join(FloatingPointSystem, DifferentialRing, ConvertibleTo String, OpenMath,_ + CoercibleTo DoubleFloat, TranscendentalFunctionCategory, ConvertibleTo InputForm) with + _/ : (%, I) -> % + ++ x / i computes the division from x by an integer i. + _*_*: (%, %) -> % + ++ x ** y computes \spad{exp(y log x)} where \spad{x >= 0}. + normalize: % -> % + ++ normalize(x) normalizes x at current precision. + relerror : (%, %) -> I + ++ relerror(x,y) computes the absolute value of \spad{x - y} divided by + ++ y, when \spad{y \^= 0}. + shift: (%, I) -> % + ++ shift(x,n) adds n to the exponent of float x. + rationalApproximation: (%, N) -> RN + ++ rationalApproximation(f, n) computes a rational approximation + ++ r to f with relative error \spad{< 10**(-n)}. + rationalApproximation: (%, N, N) -> RN + ++ rationalApproximation(f, n, b) computes a rational + ++ approximation r to f with relative error \spad{< b**(-n)}, that is + ++ \spad{|(r-f)/f| < b**(-n)}. + log2 : () -> % + ++ log2() returns \spad{ln 2}, i.e. \spad{0.6931471805...}. + log10: () -> % + ++ log10() returns \spad{ln 10}: \spad{2.3025809299...}. + exp1 : () -> % + ++ exp1() returns exp 1: \spad{2.7182818284...}. + atan : (%,%) -> % + ++ atan(x,y) computes the arc tangent from x with phase y. + log2 : % -> % + ++ log2(x) computes the logarithm for x to base 2. + log10: % -> % + ++ log10(x) computes the logarithm for x to base 10. + convert: SF -> % + ++ convert(x) converts a \spadtype{DoubleFloat} x to a \spadtype{Float}. + outputFloating: () -> Void + ++ outputFloating() sets the output mode to floating (scientific) notation, i.e. + ++ \spad{mantissa * 10 exponent} is displayed as \spad{0.mantissa E exponent}. + outputFloating: N -> Void + ++ outputFloating(n) sets the output mode to floating (scientific) notation + ++ with n significant digits displayed after the decimal point. + outputFixed: () -> Void + ++ outputFixed() sets the output mode to fixed point notation; + ++ the output will contain a decimal point. + outputFixed: N -> Void + ++ outputFixed(n) sets the output mode to fixed point notation, + ++ with n digits displayed after the decimal point. + outputGeneral: () -> Void + ++ outputGeneral() sets the output mode (default mode) to general + ++ notation; numbers will be displayed in either fixed or floating + ++ (scientific) notation depending on the magnitude. + outputGeneral: N -> Void + ++ outputGeneral(n) sets the output mode to general notation + ++ with n significant digits displayed. + outputSpacing: N -> Void + ++ outputSpacing(n) inserts a space after n (default 10) digits on output; + ++ outputSpacing(0) means no spaces are inserted. + arbitraryPrecision + arbitraryExponent + == add + BASE ==> 2 + BITS:Reference(PI) := ref 68 -- 20 digits + LENGTH ==> INTEGER_-LENGTH$Lisp + ISQRT ==> approxSqrt$IntegerRoots(I) + Rep := Record( mantissa:I, exponent:I ) + StoredConstant ==> Record( precision:PI, value:% ) + UCA ==> Record( unit:%, coef:%, associate:% ) + inc ==> increasePrecision + dec ==> decreasePrecision + + -- local utility operations + shift2 : (I,I) -> I -- WSP: fix bug in shift + times : (%,%) -> % -- multiply x and y with no rounding + itimes: (I,%) -> % -- multiply by a small integer + chop: (%,PI) -> % -- chop x at p bits of precision + dvide: (%,%) -> % -- divide x by y with no rounding + square: (%,I) -> % -- repeated squaring with chopping + power: (%,I) -> % -- x ** n with chopping + plus: (%,%) -> % -- addition with no rounding + sub: (%,%) -> % -- subtraction with no rounding + negate: % -> % -- negation with no rounding + ceillog10base2: PI -> PI -- rational approximation + floorln2: PI -> PI -- rational approximation + + atanSeries: % -> % -- atan(x) by taylor series |x| < 1/2 + atanInverse: I -> % -- atan(1/n) for n an integer > 1 + expInverse: I -> % -- exp(1/n) for n an integer + expSeries: % -> % -- exp(x) by taylor series |x| < 1/2 + logSeries: % -> % -- log(x) by taylor series 1/2 < x < 2 + sinSeries: % -> % -- sin(x) by taylor series |x| < 1/2 + cosSeries: % -> % -- cos(x) by taylor series |x| < 1/2 + piRamanujan: () -> % -- pi using Ramanujans series + + writeOMFloat(dev: OpenMathDevice, x: %): Void == + OMputApp(dev) + OMputSymbol(dev, "bigfloat1", "bigfloat") + OMputInteger(dev, mantissa x) + OMputInteger(dev, 2) + OMputInteger(dev, exponent x) + OMputEndApp(dev) + + OMwrite(x: %): String == + s: String := "" + sp := OM_-STRINGTOSTRINGPTR(s)$Lisp + dev: OpenMathDevice := OMopenString(sp pretend String, OMencodingXML) + OMputObject(dev) + writeOMFloat(dev, x) + OMputEndObject(dev) + OMclose(dev) + s := OM_-STRINGPTRTOSTRING(sp)$Lisp pretend String + s + + OMwrite(x: %, wholeObj: Boolean): String == + s: String := "" + sp := OM_-STRINGTOSTRINGPTR(s)$Lisp + dev: OpenMathDevice := OMopenString(sp pretend String, OMencodingXML) + if wholeObj then + OMputObject(dev) + writeOMFloat(dev, x) + if wholeObj then + OMputEndObject(dev) + OMclose(dev) + s := OM_-STRINGPTRTOSTRING(sp)$Lisp pretend String + s + + OMwrite(dev: OpenMathDevice, x: %): Void == + OMputObject(dev) + writeOMFloat(dev, x) + OMputEndObject(dev) + + OMwrite(dev: OpenMathDevice, x: %, wholeObj: Boolean): Void == + if wholeObj then + OMputObject(dev) + writeOMFloat(dev, x) + if wholeObj then + OMputEndObject(dev) + + shift2(x,y) == sign(x)*shift(sign(x)*x,y) + + asin x == + zero? x => 0 + negative? x => -asin(-x) +-- one? x => pi()/2 + (x = 1) => pi()/2 + x > 1 => error "asin: argument > 1 in magnitude" + inc 5; r := atan(x/sqrt(sub(1,times(x,x)))); dec 5 + normalize r + + acos x == + zero? x => pi()/2 + negative? x => (inc 3; r := pi()-acos(-x); dec 3; normalize r) +-- one? x => 0 + (x = 1) => 0 + x > 1 => error "acos: argument > 1 in magnitude" + inc 5; r := atan(sqrt(sub(1,times(x,x)))/x); dec 5 + normalize r + + atan(x,y) == + x = 0 => + y > 0 => pi()/2 + y < 0 => -pi()/2 + 0 + -- Only count on first quadrant being on principal branch. + theta := atan abs(y/x) + if x < 0 then theta := pi() - theta + if y < 0 then theta := - theta + theta + + atan x == + zero? x => 0 + negative? x => -atan(-x) + if x > 1 then + inc 4 + r := if zero? fractionPart x and x < [bits(),0] then atanInverse wholePart x + else atan(1/x) + r := pi/2 - r + dec 4 + return normalize r + -- make |x| < O( 2**(-sqrt p) ) < 1/2 to speed series convergence + -- by using the formula atan(x) = 2*atan(x/(1+sqrt(1+x**2))) + k := ISQRT (bits()-100)::I quo 5 + k := max(0,2 + k + order x) + inc(2*k) + for i in 1..k repeat x := x/(1+sqrt(1+x*x)) + t := atanSeries x + dec(2*k) + t := shift(t,k) + normalize t + + atanSeries x == + -- atan(x) = x (1 - x**2/3 + x**4/5 - x**6/7 + ...) |x| < 1 + p := bits() + LENGTH bits() + 2 + s:I := d:I := shift(1,p) + y := times(x,x) + t := m := - shift2(y.mantissa,y.exponent+p) + for i in 3.. by 2 while t ^= 0 repeat + s := s + t quo i + t := (m * t) quo d + x * [s,-p] + + atanInverse n == + -- compute atan(1/n) for an integer n > 1 + -- atan n = 1/n - 1/n**3/3 + 1/n**5/4 - ... + -- pi = 16 atan(1/5) - 4 atan(1/239) + n2 := -n*n + e:I := bits() + LENGTH bits() + LENGTH n + 1 + s:I := shift(1,e) quo n + t:I := s quo n2 + for k in 3.. by 2 while t ^= 0 repeat + s := s + t quo k + t := t quo n2 + normalize [s,-e] + + sin x == + s := sign x; x := abs x; p := bits(); inc 4 + if x > [6,0] then (inc p; x := 2*pi*fractionPart(x/pi/2); bits p) + if x > [3,0] then (inc p; s := -s; x := x - pi; bits p) + if x > [3,-1] then (inc p; x := pi - x; dec p) + -- make |x| < O( 2**(-sqrt p) ) < 1/2 to speed series convergence + -- by using the formula sin(3*x/3) = 3 sin(x/3) - 4 sin(x/3)**3 + -- the running time is O( sqrt p M(p) ) assuming |x| < 1 + k := ISQRT (bits()-100)::I quo 4 + k := max(0,2 + k + order x) + if k > 0 then (inc k; x := x / 3**k::N) + r := sinSeries x + for i in 1..k repeat r := itimes(3,r)-shift(r**3,2) + bits p + s * r + + sinSeries x == + -- sin(x) = x (1 - x**2/3! + x**4/5! - x**6/7! + ... |x| < 1/2 + p := bits() + LENGTH bits() + 2 + y := times(x,x) + s:I := d:I := shift(1,p) + m:I := - shift2(y.mantissa,y.exponent+p) + t:I := m quo 6 + for i in 4.. by 2 while t ^= 0 repeat + s := s + t + t := (m * t) quo (i*(i+1)) + t := t quo d + x * [s,-p] + + cos x == + s:I := 1; x := abs x; p := bits(); inc 4 + if x > [6,0] then (inc p; x := 2*pi*fractionPart(x/pi/2); dec p) + if x > [3,0] then (inc p; s := -s; x := x-pi; dec p) + if x > [1,0] then + -- take care of the accuracy problem near pi/2 + inc p; x := pi/2-x; bits p; x := normalize x + return (s * sin x) + -- make |x| < O( 2**(-sqrt p) ) < 1/2 to speed series convergence + -- by using the formula cos(2*x/2) = 2 cos(x/2)**2 - 1 + -- the running time is O( sqrt p M(p) ) assuming |x| < 1 + k := ISQRT (bits()-100)::I quo 3 + k := max(0,2 + k + order x) + -- need to increase precision by more than k, otherwise recursion + -- causes loss of accuracy. + -- Michael Monagan suggests adding a factor of log(k) + if k > 0 then (inc(k+length(k)**2); x := shift(x,-k)) + r := cosSeries x + for i in 1..k repeat r := shift(r*r,1)-1 + bits p + s * r + + + + cosSeries x == + -- cos(x) = 1 - x**2/2! + x**4/4! - x**6/6! + ... |x| < 1/2 + p := bits() + LENGTH bits() + 1 + y := times(x,x) + s:I := d:I := shift(1,p) + m:I := - shift2(y.mantissa,y.exponent+p) + t:I := m quo 2 + for i in 3.. by 2 while t ^= 0 repeat + s := s + t + t := (m * t) quo (i*(i+1)) + t := t quo d + normalize [s,-p] + + tan x == + s := sign x; x := abs x; p := bits(); inc 6 + if x > [3,0] then (inc p; x := pi()*fractionPart(x/pi()); dec p) + if x > [3,-1] then (inc p; x := pi()-x; s := -s; dec p) + if x > 1 then (c := cos x; t := sqrt(1-c*c)/c) + else (c := sin x; t := c/sqrt(1-c*c)) + bits p + s * t + + P:StoredConstant := [1,[1,2]] + pi() == + -- We use Ramanujan's identity to compute pi. + -- The running time is quadratic in the precision. + -- This is about twice as fast as Machin's identity on Lisp/VM + -- pi = 16 atan(1/5) - 4 atan(1/239) + bits() <= P.precision => normalize P.value + (P := [bits(), piRamanujan()]) value + + piRamanujan() == + -- Ramanujans identity for 1/pi + -- Reference: Shanks and Wrench, Math Comp, 1962 + -- "Calculation of pi to 100,000 Decimals". + n := bits() + LENGTH bits() + 11 + t:I := shift(1,n) quo 882 + d:I := 4*882**2 + s:I := 0 + for i in 2.. by 2 for j in 1123.. by 21460 while t ^= 0 repeat + s := s + j*t + m := -(i-1)*(2*i-1)*(2*i-3) + t := (m*t) quo (d*i**3) + 1 / [s,-n-2] + + sinh x == + zero? x => 0 + lost:I := max(- order x,0) + 2*lost > bits() => x + inc(5+lost); e := exp x; s := (e-1/e)/2; dec(5+lost) + normalize s + + cosh x == + (inc 5; e := exp x; c := (e+1/e)/2; dec 5; normalize c) + + tanh x == + zero? x => 0 + lost:I := max(- order x,0) + 2*lost > bits() => x + inc(6+lost); e := exp x; e := e*e; t := (e-1)/(e+1); dec(6+lost) + normalize t + + asinh x == + p := min(0,order x) + if zero? x or 2*p < -bits() then return x + inc(5-p); r := log(x+sqrt(1+x*x)); dec(5-p) + normalize r + + acosh x == + if x < 1 then error "invalid argument to acosh" + inc 5; r := log(x+sqrt(sub(times(x,x),1))); dec 5 + normalize r + + atanh x == + if x > 1 or x < -1 then error "invalid argument to atanh" + p := min(0,order x) + if zero? x or 2*p < -bits() then return x + inc(5-p); r := log((x+1)/(1-x))/2; dec(5-p) + normalize r + + log x == + negative? x => error "negative log" + zero? x => error "log 0 generated" + p := bits(); inc 5 + -- apply log(x) = n log 2 + log(x/2**n) so that 1/2 < x < 2 + if (n := order x) < 0 then n := n+1 + l := if n = 0 then 0 else (x := shift(x,-n); n * log2) + -- speed the series convergence by finding m and k such that + -- | exp(m/2**k) x - 1 | < 1 / 2 ** O(sqrt p) + -- write log(exp(m/2**k) x) as m/2**k + log x + k := ISQRT (p-100)::I quo 3 + if k > 1 then + k := max(1,k+order(x-1)) + inc k + ek := expInverse (2**k::N) + dec(p quo 2); m := order square(x,k); inc(p quo 2) + m := (6847196937 * m) quo 9878417065 -- m := m log 2 + x := x * ek ** (-m) + l := l + [m,-k] + l := l + logSeries x + bits p + normalize l + + logSeries x == + -- log(x) = 2 y (1 + y**2/3 + y**4/5 ...) for y = (x-1) / (x+1) + -- given 1/2 < x < 2 on input we have -1/3 < y < 1/3 + p := bits() + (g := LENGTH bits() + 3) + inc g; y := (x-1)/(x+1); dec g + s:I := d:I := shift(1,p) + z := times(y,y) + t := m := shift2(z.mantissa,z.exponent+p) + for i in 3.. by 2 while t ^= 0 repeat + s := s + t quo i + t := m * t quo d + y * [s,1-p] + + L2:StoredConstant := [1,1] + log2() == + -- log x = 2 * sum( ((x-1)/(x+1))**(2*k+1)/(2*k+1), k=1.. ) + -- log 2 = 2 * sum( 1/9**k / (2*k+1), k=0..n ) / 3 + n := bits() :: N + n <= L2.precision => normalize L2.value + n := n + LENGTH n + 3 -- guard bits + s:I := shift(1,n+1) quo 3 + t:I := s quo 9 + for k in 3.. by 2 while t ^= 0 repeat + s := s + t quo k + t := t quo 9 + L2 := [bits(),[s,-n]] + normalize L2.value + + L10:StoredConstant := [1,[1,1]] + log10() == + -- log x = 2 * sum( ((x-1)/(x+1))**(2*k+1)/(2*k+1), k=0.. ) + -- log 5/4 = 2 * sum( 1/81**k / (2*k+1), k=0.. ) / 9 + n := bits() :: N + n <= L10.precision => normalize L10.value + n := n + LENGTH n + 5 -- guard bits + s:I := shift(1,n+1) quo 9 + t:I := s quo 81 + for k in 3.. by 2 while t ^= 0 repeat + s := s + t quo k + t := t quo 81 + -- We have log 10 = log 5 + log 2 and log 5/4 = log 5 - 2 log 2 + inc 2; L10 := [bits(),[s,-n] + 3*log2]; dec 2 + normalize L10.value + + log2(x) == (inc 2; r := log(x)/log2; dec 2; normalize r) + log10(x) == (inc 2; r := log(x)/log10; dec 2; normalize r) + + exp(x) == + -- exp(n+x) = exp(1)**n exp(x) for n such that |x| < 1 + p := bits(); inc 5; e1:% := 1 + if (n := wholePart x) ^= 0 then + inc LENGTH n; e1 := exp1 ** n; dec LENGTH n + x := fractionPart x + if zero? x then (bits p; return normalize e1) + -- make |x| < O( 2**(-sqrt p) ) < 1/2 to speed series convergence + -- by repeated use of the formula exp(2*x/2) = exp(x/2)**2 + -- results in an overall running time of O( sqrt p M(p) ) + k := ISQRT (p-100)::I quo 3 + k := max(0,2 + k + order x) + if k > 0 then (inc k; x := shift(x,-k)) + e := expSeries x + if k > 0 then e := square(e,k) + bits p + e * e1 + + expSeries x == + -- exp(x) = 1 + x + x**2/2 + ... + x**i/i! valid for all x + p := bits() + LENGTH bits() + 1 + s:I := d:I := shift(1,p) + t:I := n:I := shift2(x.mantissa,x.exponent+p) + for i in 2.. while t ^= 0 repeat + s := s + t + t := (n * t) quo i + t := t quo d + normalize [s,-p] + + expInverse k == + -- computes exp(1/k) via continued fraction + p0:I := 2*k+1; p1:I := 6*k*p0+1 + q0:I := 2*k-1; q1:I := 6*k*q0+1 + for i in 10*k.. by 4*k while 2 * LENGTH p0 < bits() repeat + (p0,p1) := (p1,i*p1+p0) + (q0,q1) := (q1,i*q1+q0) + dvide([p1,0],[q1,0]) + + E:StoredConstant := [1,[1,1]] + exp1() == + if bits() > E.precision then E := [bits(),expInverse 1] + normalize E.value + + sqrt x == + negative? x => error "negative sqrt" + m := x.mantissa; e := x.exponent + l := LENGTH m + p := 2 * bits() - l + 2 + if odd?(e-l) then p := p - 1 + i := shift2(x.mantissa,p) + -- ISQRT uses a variable precision newton iteration + i := ISQRT i + normalize [i,(e-p) quo 2] + + bits() == BITS() + bits(n) == (t := bits(); BITS() := n; t) + precision() == bits() + precision(n) == bits(n) + increasePrecision n == (b := bits(); bits((b + n)::PI); b) + decreasePrecision n == (b := bits(); bits((b - n)::PI); b) + ceillog10base2 n == ((13301 * n + 4003) quo 4004) :: PI + digits() == max(1,4004 * (bits()-1) quo 13301)::PI + digits(n) == (t := digits(); bits (1 + ceillog10base2 n); t) + + order(a) == LENGTH a.mantissa + a.exponent - 1 + relerror(a,b) == order((a-b)/b) + 0 == [0,0] + 1 == [1,0] + base() == BASE + mantissa x == x.mantissa + exponent x == x.exponent + one? a == a = 1 + zero? a == zero?(a.mantissa) + negative? a == negative?(a.mantissa) + positive? a == positive?(a.mantissa) + + chop(x,p) == + e : I := LENGTH x.mantissa - p + if e > 0 then x := [shift2(x.mantissa,-e),x.exponent+e] + x + float(m,e) == normalize [m,e] + float(m,e,b) == + m = 0 => 0 + inc 4; r := m * [b,0] ** e; dec 4 + normalize r + normalize x == + m := x.mantissa + m = 0 => 0 + e : I := LENGTH m - bits() + if e > 0 then + y := shift2(m,1-e) + if odd? y then + y := (if y>0 then y+1 else y-1) quo 2 + if LENGTH y > bits() then + y := y quo 2 + e := e+1 + else y := y quo 2 + x := [y,x.exponent+e] + x + shift(x:%,n:I) == [x.mantissa,x.exponent+n] + + x = y == + order x = order y and sign x = sign y and zero? (x - y) + x < y == + y.mantissa = 0 => x.mantissa < 0 + x.mantissa = 0 => y.mantissa > 0 + negative? x and positive? y => true + negative? y and positive? x => false + order x < order y => positive? x + order x > order y => negative? x + negative? (x-y) + + abs x == if negative? x then -x else normalize x + ceiling x == + if negative? x then return (-floor(-x)) + if zero? fractionPart x then x else truncate x + 1 + wholePart x == shift2(x.mantissa,x.exponent) + floor x == if negative? x then -ceiling(-x) else truncate x + round x == (half := [sign x,-1]; truncate(x + half)) + sign x == if x.mantissa < 0 then -1 else 1 + truncate x == + if x.exponent >= 0 then return x + normalize [shift2(x.mantissa,x.exponent),0] + recip(x) == if x=0 then "failed" else 1/x + differentiate x == 0 + + - x == normalize negate x + negate x == [-x.mantissa,x.exponent] + x + y == normalize plus(x,y) + x - y == normalize plus(x,negate y) + sub(x,y) == plus(x,negate y) + plus(x,y) == + mx := x.mantissa; my := y.mantissa + mx = 0 => y + my = 0 => x + ex := x.exponent; ey := y.exponent + ex = ey => [mx+my,ex] + de := ex + LENGTH mx - ey - LENGTH my + de > bits()+1 => x + de < -(bits()+1) => y + if ex < ey then (mx,my,ex,ey) := (my,mx,ey,ex) + mw := my + shift2(mx,ex-ey) + [mw,ey] + + x:% * y:% == normalize times (x,y) + x:I * y:% == + if LENGTH x > bits() then normalize [x,0] * y + else normalize [x * y.mantissa,y.exponent] + x:% / y:% == normalize dvide(x,y) + x:% / y:I == + if LENGTH y > bits() then x / normalize [y,0] else x / [y,0] + inv x == 1 / x + + times(x:%,y:%) == [x.mantissa * y.mantissa, x.exponent + y.exponent] + itimes(n:I,y:%) == [n * y.mantissa,y.exponent] + + dvide(x,y) == + ew := LENGTH y.mantissa - LENGTH x.mantissa + bits() + 1 + mw := shift2(x.mantissa,ew) quo y.mantissa + ew := x.exponent - y.exponent - ew + [mw,ew] + + square(x,n) == + ma := x.mantissa; ex := x.exponent + for k in 1..n repeat + ma := ma * ma; ex := ex + ex + l:I := bits()::I - LENGTH ma + ma := shift2(ma,l); ex := ex - l + [ma,ex] + + power(x,n) == + y:% := 1; z:% := x + repeat + if odd? n then y := chop( times(y,z), bits() ) + if (n := n quo 2) = 0 then return y + z := chop( times(z,z), bits() ) + + x:% ** y:% == + x = 0 => + y = 0 => error "0**0 is undefined" + y < 0 => error "division by 0" + y > 0 => 0 + y = 0 => 1 + y = 1 => x + x = 1 => 1 + p := abs order y + 5 + inc p; r := exp(y*log(x)); dec p + normalize r + + x:% ** r:RN == + x = 0 => + r = 0 => error "0**0 is undefined" + r < 0 => error "division by 0" + r > 0 => 0 + r = 0 => 1 + r = 1 => x + x = 1 => 1 + n := numer r + d := denom r + negative? x => + odd? d => + odd? n => return -((-x)**r) + return ((-x)**r) + error "negative root" + if d = 2 then + inc LENGTH n; y := sqrt(x); y := y**n; dec LENGTH n + return normalize y + y := [n,0]/[d,0] + x ** y + + x:% ** n:I == + x = 0 => + n = 0 => error "0**0 is undefined" + n < 0 => error "division by 0" + n > 0 => 0 + n = 0 => 1 + n = 1 => x + x = 1 => 1 + p := bits() + bits(p + LENGTH n + 2) + y := power(x,abs n) + if n < 0 then y := dvide(1,y) + bits p + normalize y + + -- Utility routines for conversion to decimal + ceilLength10: I -> I + chop10: (%,I) -> % + convert10:(%,I) -> % + floorLength10: I -> I + length10: I -> I + normalize10: (%,I) -> % + quotient10: (%,%,I) -> % + power10: (%,I,I) -> % + times10: (%,%,I) -> % + + convert10(x,d) == + m := x.mantissa; e := x.exponent + --!! deal with bits here + b := bits(); (q,r) := divide(abs e, b) + b := 2**b::N; r := 2**r::N + -- compute 2**e = b**q * r + h := power10([b,0],q,d+5) + h := chop10([r*h.mantissa,h.exponent],d+5) + if e < 0 then h := quotient10([m,0],h,d) + else times10([m,0],h,d) + + ceilLength10 n == 146 * LENGTH n quo 485 + 1 + floorLength10 n == 643 * LENGTH n quo 2136 +-- length10 n == DECIMAL_-LENGTH(n)$Lisp + length10 n == + ln := LENGTH(n:=abs n) + upper := 76573 * ln quo 254370 + lower := 21306 * (ln-1) quo 70777 + upper = lower => upper + 1 + n := n quo (10**lower::N) + while n >= 10 repeat + n:= n quo 10 + lower := lower + 1 + lower + 1 + + chop10(x,p) == + e : I := floorLength10 x.mantissa - p + if e > 0 then x := [x.mantissa quo 10**e::N,x.exponent+e] + x + normalize10(x,p) == + ma := x.mantissa + ex := x.exponent + e : I := length10 ma - p + if e > 0 then + ma := ma quo 10**(e-1)::N + ex := ex + e + (ma,r) := divide(ma, 10) + if r > 4 then + ma := ma + 1 + if ma = 10**p::N then (ma := 1; ex := ex + p) + [ma,ex] + times10(x,y,p) == normalize10(times(x,y),p) + quotient10(x,y,p) == + ew := floorLength10 y.mantissa - ceilLength10 x.mantissa + p + 2 + if ew < 0 then ew := 0 + mw := (x.mantissa * 10**ew::N) quo y.mantissa + ew := x.exponent - y.exponent - ew + normalize10([mw,ew],p) + power10(x,n,d) == + x = 0 => 0 + n = 0 => 1 + n = 1 => x + x = 1 => 1 + p:I := d + LENGTH n + 1 + e:I := n + y:% := 1 + z:% := x + repeat + if odd? e then y := chop10(times(y,z),p) + if (e := e quo 2) = 0 then return y + z := chop10(times(z,z),p) + + -------------------------------- + -- Output routines for Floats -- + -------------------------------- + zero ==> char("0") + separator ==> space()$Character + + SPACING : Reference(N) := ref 10 + OUTMODE : Reference(S) := ref "general" + OUTPREC : Reference(I) := ref(-1) + + fixed : % -> S + floating : % -> S + general : % -> S + + padFromLeft(s:S):S == + zero? SPACING() => s + n:I := #s - 1 + t := new( (n + 1 + n quo SPACING()) :: N , separator ) + for i in 0..n for j in minIndex t .. repeat + t.j := s.(i + minIndex s) + if (i+1) rem SPACING() = 0 then j := j+1 + t + padFromRight(s:S):S == + SPACING() = 0 => s + n:I := #s - 1 + t := new( (n + 1 + n quo SPACING()) :: N , separator ) + for i in n..0 by -1 for j in maxIndex t .. by -1 repeat + t.j := s.(i + minIndex s) + if (n-i+1) rem SPACING() = 0 then j := j-1 + t + + fixed f == + zero? f => "0.0" + zero? exponent f => + padFromRight concat(convert(mantissa f)@S, ".0") + negative? f => concat("-", fixed abs f) + d := if OUTPREC() = -1 then digits::I else OUTPREC() +-- g := convert10(abs f,digits); m := g.mantissa; e := g.exponent + g := convert10(abs f,d); m := g.mantissa; e := g.exponent + if OUTPREC() ^= -1 then + -- round g to OUTPREC digits after the decimal point + l := length10 m + if -e > OUTPREC() and -e < 2*digits::I then + g := normalize10(g,l+e+OUTPREC()) + m := g.mantissa; e := g.exponent + s := convert(m)@S; n := #s; o := e+n + p := if OUTPREC() = -1 then n::I else OUTPREC() + t:S + if e >= 0 then + s := concat(s, new(e::N, zero)) + t := "" + else if o <= 0 then + t := concat(new((-o)::N,zero), s) + s := "0" + else + t := s(o + minIndex s .. n + minIndex s - 1) + s := s(minIndex s .. o + minIndex s - 1) + n := #t + if OUTPREC() = -1 then + t := rightTrim(t,zero) + if t = "" then t := "0" + else if n > p then t := t(minIndex t .. p + minIndex t- 1) + else t := concat(t, new((p-n)::N,zero)) + concat(padFromRight s, concat(".", padFromLeft t)) + + floating f == + zero? f => "0.0" + negative? f => concat("-", floating abs f) + t:S := if zero? SPACING() then "E" else " E " + zero? exponent f => + s := convert(mantissa f)@S + concat ["0.", padFromLeft s, t, convert(#s)@S] + -- base conversion to decimal rounded to the requested precision + d := if OUTPREC() = -1 then digits::I else OUTPREC() + g := convert10(f,d); m := g.mantissa; e := g.exponent + -- I'm assuming that length10 m = # s given n > 0 + s := convert(m)@S; n := #s; o := e+n + s := padFromLeft s + concat ["0.", s, t, convert(o)@S] + + general(f) == + zero? f => "0.0" + negative? f => concat("-", general abs f) + d := if OUTPREC() = -1 then digits::I else OUTPREC() + zero? exponent f => + d := d + 1 + s := convert(mantissa f)@S + OUTPREC() ^= -1 and (e := #s) > d => + t:S := if zero? SPACING() then "E" else " E " + concat ["0.", padFromLeft s, t, convert(e)@S] + padFromRight concat(s, ".0") + -- base conversion to decimal rounded to the requested precision + g := convert10(f,d); m := g.mantissa; e := g.exponent + -- I'm assuming that length10 m = # s given n > 0 + s := convert(m)@S; n := #s; o := n + e + -- Note: at least one digit is displayed after the decimal point + -- and trailing zeroes after the decimal point are dropped + if o > 0 and o <= max(n,d) then + -- fixed format: add trailing zeroes before the decimal point + if o > n then s := concat(s, new((o-n)::N,zero)) + t := rightTrim(s(o + minIndex s .. n + minIndex s - 1), zero) + if t = "" then t := "0" else t := padFromLeft t + s := padFromRight s(minIndex s .. o + minIndex s - 1) + concat(s, concat(".", t)) + else if o <= 0 and o >= -5 then + -- fixed format: up to 5 leading zeroes after the decimal point + concat("0.",padFromLeft concat(new((-o)::N,zero),rightTrim(s,zero))) + else + -- print using E format written 0.mantissa E exponent + t := padFromLeft rightTrim(s,zero) + s := if zero? SPACING() then "E" else " E " + concat ["0.", t, s, convert(e+n)@S] + + outputSpacing n == SPACING() := n + outputFixed() == (OUTMODE() := "fixed"; OUTPREC() := -1) + outputFixed n == (OUTMODE() := "fixed"; OUTPREC() := n::I) + outputGeneral() == (OUTMODE() := "general"; OUTPREC() := -1) + outputGeneral n == (OUTMODE() := "general"; OUTPREC() := n::I) + outputFloating() == (OUTMODE() := "floating"; OUTPREC() := -1) + outputFloating n == (OUTMODE() := "floating"; OUTPREC() := n::I) + + convert(f):S == + b:Integer := + OUTPREC() = -1 and not zero? f => + bits(length(abs mantissa f)::PositiveInteger) + 0 + s := + OUTMODE() = "fixed" => fixed f + OUTMODE() = "floating" => floating f + OUTMODE() = "general" => general f + empty()$String + if b > 0 then bits(b::PositiveInteger) + s = empty()$String => error "bad output mode" + s + + coerce(f):OutputForm == + f >= 0 => message(convert(f)@S) + - (coerce(-f)@OutputForm) + + convert(f):InputForm == + convert [convert("float"::Symbol), convert mantissa f, + convert exponent f, convert base()]$List(InputForm) + + -- Conversion routines + convert(x:%):Float == x pretend Float + convert(x:%):SF == makeSF(x.mantissa,x.exponent)$Lisp + coerce(x:%):SF == convert(x)@SF + convert(sf:SF):% == float(mantissa sf,exponent sf,base()$SF) + + retract(f:%):RN == rationalApproximation(f,(bits()-1)::N,BASE) + + retractIfCan(f:%):Union(RN, "failed") == + rationalApproximation(f,(bits()-1)::N,BASE) + + retract(f:%):I == + (f = (n := wholePart f)::%) => n + error "Not an integer" + + retractIfCan(f:%):Union(I, "failed") == + (f = (n := wholePart f)::%) => n + "failed" + + rationalApproximation(f,d) == rationalApproximation(f,d,10) + + rationalApproximation(f,d,b) == + t: Integer + nu := f.mantissa; ex := f.exponent + if ex >= 0 then return ((nu*BASE**(ex::N))/1) + de := BASE**((-ex)::N) + if b < 2 then error "base must be > 1" + tol := b**d + s := nu; t := de + p0,p1,q0,q1 : Integer + p0 := 0; p1 := 1; q0 := 1; q1 := 0 + repeat + (q,r) := divide(s, t) + p2 := q*p1+p0 + q2 := q*q1+q0 + if r = 0 or tol*abs(nu*q2-de*p2) < de*abs(p2) then return (p2/q2) + (p0,p1) := (p1,p2) + (q0,q1) := (q1,q2) + (s,t) := (t,r) + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain FC FortranCode} +\pagehead{FortranCode}{FC} +\pagepic{ps/v103fortrancode.ps}{FC}{1.00} +See also:\\ +\refto{Result}{RESULT} +\refto{FortranProgram}{FORTRAN} +\refto{ThreeDimensionalMatrix}{M3D} +\refto{SimpleFortranProgram}{SFORT} +\refto{Switch}{SWITCH} +\refto{FortranTemplate}{FTEM} +\refto{FortranExpression}{FEXPR} +<>= +)abbrev domain FC FortranCode +-- The FortranCode domain is used to represent operations which are to be +-- translated into FORTRAN. +++ Author: Mike Dewar +++ Date Created: April 1991 +++ Date Last Updated: 22 March 1994 +++ 26 May 1994 Added common, MCD +++ 21 June 1994 Changed print to printStatement, MCD +++ 30 June 1994 Added stop, MCD +++ 12 July 1994 Added assign for String, MCD +++ 9 January 1995 Added fortran2Lines to getCall, MCD +++ Basic Operations: +++ Related Constructors: FortranProgram, Switch, FortranType +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ This domain builds representations of program code segments for use with +++ the FortranProgram domain. +FortranCode(): public == private where + L ==> List + PI ==> PositiveInteger + PIN ==> Polynomial Integer + SEX ==> SExpression + O ==> OutputForm + OP ==> Union(Null:"null", + Assignment:"assignment", + Conditional:"conditional", + Return:"return", + Block:"block", + Comment:"comment", + Call:"call", + For:"for", + While:"while", + Repeat:"repeat", + Goto:"goto", + Continue:"continue", + ArrayAssignment:"arrayAssignment", + Save:"save", + Stop:"stop", + Common:"common", + Print:"print") + ARRAYASS ==> Record(var:Symbol, rand:O, ints2Floats?:Boolean) + EXPRESSION ==> Record(ints2Floats?:Boolean,expr:O) + ASS ==> Record(var:Symbol, + arrayIndex:L PIN, + rand:EXPRESSION + ) + COND ==> Record(switch: Switch(), + thenClause: $, + elseClause: $ + ) + RETURN ==> Record(empty?:Boolean,value:EXPRESSION) + BLOCK ==> List $ + COMMENT ==> List String + COMMON ==> Record(name:Symbol,contents:List Symbol) + CALL ==> String + FOR ==> Record(range:SegmentBinding PIN, span:PIN, body:$) + LABEL ==> SingleInteger + LOOP ==> Record(switch:Switch(),body:$) + PRINTLIST ==> List O + OPREC ==> Union(nullBranch:"null", assignmentBranch:ASS, + arrayAssignmentBranch:ARRAYASS, + conditionalBranch:COND, returnBranch:RETURN, + blockBranch:BLOCK, commentBranch:COMMENT, callBranch:CALL, + forBranch:FOR, labelBranch:LABEL, loopBranch:LOOP, + commonBranch:COMMON, printBranch:PRINTLIST) + + public == SetCategory with + coerce: $ -> O + ++ coerce(f) returns an object of type OutputForm. + forLoop: (SegmentBinding PIN,$) -> $ + ++ forLoop(i=1..10,c) creates a representation of a FORTRAN DO loop with + ++ \spad{i} ranging over the values 1 to 10. + forLoop: (SegmentBinding PIN,PIN,$) -> $ + ++ forLoop(i=1..10,n,c) creates a representation of a FORTRAN DO loop with + ++ \spad{i} ranging over the values 1 to 10 by n. + whileLoop: (Switch,$) -> $ + ++ whileLoop(s,c) creates a while loop in FORTRAN. + repeatUntilLoop: (Switch,$) -> $ + ++ repeatUntilLoop(s,c) creates a repeat ... until loop in FORTRAN. + goto: SingleInteger -> $ + ++ goto(l) creates a representation of a FORTRAN GOTO statement + continue: SingleInteger -> $ + ++ continue(l) creates a representation of a FORTRAN CONTINUE labelled + ++ with l + comment: String -> $ + ++ comment(s) creates a representation of the String s as a single FORTRAN + ++ comment. + comment: List String -> $ + ++ comment(s) creates a representation of the Strings s as a multi-line + ++ FORTRAN comment. + call: String -> $ + ++ call(s) creates a representation of a FORTRAN CALL statement + returns: () -> $ + ++ returns() creates a representation of a FORTRAN RETURN statement. + returns: Expression MachineFloat -> $ + ++ returns(e) creates a representation of a FORTRAN RETURN statement + ++ with a returned value. + returns: Expression MachineInteger -> $ + ++ returns(e) creates a representation of a FORTRAN RETURN statement + ++ with a returned value. + returns: Expression MachineComplex -> $ + ++ returns(e) creates a representation of a FORTRAN RETURN statement + ++ with a returned value. + returns: Expression Float -> $ + ++ returns(e) creates a representation of a FORTRAN RETURN statement + ++ with a returned value. + returns: Expression Integer -> $ + ++ returns(e) creates a representation of a FORTRAN RETURN statement + ++ with a returned value. + returns: Expression Complex Float -> $ + ++ returns(e) creates a representation of a FORTRAN RETURN statement + ++ with a returned value. + cond: (Switch,$) -> $ + ++ cond(s,e) creates a representation of the FORTRAN expression + ++ IF (s) THEN e. + cond: (Switch,$,$) -> $ + ++ cond(s,e,f) creates a representation of the FORTRAN expression + ++ IF (s) THEN e ELSE f. + assign: (Symbol,String) -> $ + ++ assign(x,y) creates a representation of the FORTRAN expression + ++ x=y. + assign: (Symbol,Expression MachineInteger) -> $ + ++ assign(x,y) creates a representation of the FORTRAN expression + ++ x=y. + assign: (Symbol,Expression MachineFloat) -> $ + ++ assign(x,y) creates a representation of the FORTRAN expression + ++ x=y. + assign: (Symbol,Expression MachineComplex) -> $ + ++ assign(x,y) creates a representation of the FORTRAN expression + ++ x=y. + assign: (Symbol,Matrix MachineInteger) -> $ + ++ assign(x,y) creates a representation of the FORTRAN expression + ++ x=y. + assign: (Symbol,Matrix MachineFloat) -> $ + ++ assign(x,y) creates a representation of the FORTRAN expression + ++ x=y. + assign: (Symbol,Matrix MachineComplex) -> $ + ++ assign(x,y) creates a representation of the FORTRAN expression + ++ x=y. + assign: (Symbol,Vector MachineInteger) -> $ + ++ assign(x,y) creates a representation of the FORTRAN expression + ++ x=y. + assign: (Symbol,Vector MachineFloat) -> $ + ++ assign(x,y) creates a representation of the FORTRAN expression + ++ x=y. + assign: (Symbol,Vector MachineComplex) -> $ + ++ assign(x,y) creates a representation of the FORTRAN expression + ++ x=y. + assign: (Symbol,Matrix Expression MachineInteger) -> $ + ++ assign(x,y) creates a representation of the FORTRAN expression + ++ x=y. + assign: (Symbol,Matrix Expression MachineFloat) -> $ + ++ assign(x,y) creates a representation of the FORTRAN expression + ++ x=y. + assign: (Symbol,Matrix Expression MachineComplex) -> $ + ++ assign(x,y) creates a representation of the FORTRAN expression + ++ x=y. + assign: (Symbol,Vector Expression MachineInteger) -> $ + ++ assign(x,y) creates a representation of the FORTRAN expression + ++ x=y. + assign: (Symbol,Vector Expression MachineFloat) -> $ + ++ assign(x,y) creates a representation of the FORTRAN expression + ++ x=y. + assign: (Symbol,Vector Expression MachineComplex) -> $ + ++ assign(x,y) creates a representation of the FORTRAN expression + ++ x=y. + assign: (Symbol,L PIN,Expression MachineInteger) -> $ + ++ assign(x,l,y) creates a representation of the assignment of \spad{y} + ++ to the \spad{l}'th element of array \spad{x} (\spad{l} is a list of + ++ indices). + assign: (Symbol,L PIN,Expression MachineFloat) -> $ + ++ assign(x,l,y) creates a representation of the assignment of \spad{y} + ++ to the \spad{l}'th element of array \spad{x} (\spad{l} is a list of + ++ indices). + assign: (Symbol,L PIN,Expression MachineComplex) -> $ + ++ assign(x,l,y) creates a representation of the assignment of \spad{y} + ++ to the \spad{l}'th element of array \spad{x} (\spad{l} is a list of + ++ indices). + assign: (Symbol,Expression Integer) -> $ + ++ assign(x,y) creates a representation of the FORTRAN expression + ++ x=y. + assign: (Symbol,Expression Float) -> $ + ++ assign(x,y) creates a representation of the FORTRAN expression + ++ x=y. + assign: (Symbol,Expression Complex Float) -> $ + ++ assign(x,y) creates a representation of the FORTRAN expression + ++ x=y. + assign: (Symbol,Matrix Expression Integer) -> $ + ++ assign(x,y) creates a representation of the FORTRAN expression + ++ x=y. + assign: (Symbol,Matrix Expression Float) -> $ + ++ assign(x,y) creates a representation of the FORTRAN expression + ++ x=y. + assign: (Symbol,Matrix Expression Complex Float) -> $ + ++ assign(x,y) creates a representation of the FORTRAN expression + ++ x=y. + assign: (Symbol,Vector Expression Integer) -> $ + ++ assign(x,y) creates a representation of the FORTRAN expression + ++ x=y. + assign: (Symbol,Vector Expression Float) -> $ + ++ assign(x,y) creates a representation of the FORTRAN expression + ++ x=y. + assign: (Symbol,Vector Expression Complex Float) -> $ + ++ assign(x,y) creates a representation of the FORTRAN expression + ++ x=y. + assign: (Symbol,L PIN,Expression Integer) -> $ + ++ assign(x,l,y) creates a representation of the assignment of \spad{y} + ++ to the \spad{l}'th element of array \spad{x} (\spad{l} is a list of + ++ indices). + assign: (Symbol,L PIN,Expression Float) -> $ + ++ assign(x,l,y) creates a representation of the assignment of \spad{y} + ++ to the \spad{l}'th element of array \spad{x} (\spad{l} is a list of + ++ indices). + assign: (Symbol,L PIN,Expression Complex Float) -> $ + ++ assign(x,l,y) creates a representation of the assignment of \spad{y} + ++ to the \spad{l}'th element of array \spad{x} (\spad{l} is a list of + ++ indices). + block: List($) -> $ + ++ block(l) creates a representation of the statements in l as a block. + stop: () -> $ + ++ stop() creates a representation of a STOP statement. + save: () -> $ + ++ save() creates a representation of a SAVE statement. + printStatement: List O -> $ + ++ printStatement(l) creates a representation of a PRINT statement. + common: (Symbol,List Symbol) -> $ + ++ common(name,contents) creates a representation a named common block. + operation: $ -> OP + ++ operation(f) returns the name of the operation represented by \spad{f}. + code: $ -> OPREC + ++ code(f) returns the internal representation of the object represented + ++ by \spad{f}. + printCode: $ -> Void + ++ printCode(f) prints out \spad{f} in FORTRAN notation. + getCode: $ -> SEX + ++ getCode(f) returns a Lisp list of strings representing \spad{f} + ++ in Fortran notation. This is used by the FortranProgram domain. + setLabelValue:SingleInteger -> SingleInteger + ++ setLabelValue(i) resets the counter which produces labels to i + + private == add + import Void + import ASS + import COND + import RETURN + import L PIN + import O + import SEX + import FortranType + import TheSymbolTable + + Rep := Record(op: OP, data: OPREC) + + -- We need to be able to generate unique labels + labelValue:SingleInteger := 25000::SingleInteger + setLabelValue(u:SingleInteger):SingleInteger == labelValue := u + newLabel():SingleInteger == + labelValue := labelValue + 1$SingleInteger + labelValue + + commaSep(l:List String):List(String) == + [(l.1),:[:[",",u] for u in rest(l)]] + + getReturn(rec:RETURN):SEX == + returnToken : SEX := convert("RETURN"::Symbol::O)$SEX + elt(rec,empty?)$RETURN => + getStatement(returnToken,NIL$Lisp)$Lisp + rt : EXPRESSION := elt(rec,value)$RETURN + rv : O := elt(rt,expr)$EXPRESSION + getStatement([returnToken,convert(rv)$SEX]$Lisp, + elt(rt,ints2Floats?)$EXPRESSION )$Lisp + + getStop():SEX == + fortran2Lines(LIST("STOP")$Lisp)$Lisp + + getSave():SEX == + fortran2Lines(LIST("SAVE")$Lisp)$Lisp + + getCommon(u:COMMON):SEX == + fortran2Lines(APPEND(LIST("COMMON"," /",string (u.name),"/ ")$Lisp,_ + addCommas(u.contents)$Lisp)$Lisp)$Lisp + + getPrint(l:PRINTLIST):SEX == + ll : SEX := LIST("PRINT*")$Lisp + for i in l repeat + ll := APPEND(ll,CONS(",",expression2Fortran(i)$Lisp)$Lisp)$Lisp + fortran2Lines(ll)$Lisp + + getBlock(rec:BLOCK):SEX == + indentFortLevel(convert(1@Integer)$SEX)$Lisp + expr : SEX := LIST()$Lisp + for u in rec repeat + expr := APPEND(expr,getCode(u))$Lisp + indentFortLevel(convert(-1@Integer)$SEX)$Lisp + expr + + getBody(f:$):SEX == + operation(f) case Block => getCode f + indentFortLevel(convert(1@Integer)$SEX)$Lisp + expr := getCode f + indentFortLevel(convert(-1@Integer)$SEX)$Lisp + expr + + getElseIf(f:$):SEX == + rec := code f + expr := + fortFormatElseIf(elt(rec.conditionalBranch,switch)$COND::O)$Lisp + expr := + APPEND(expr,getBody elt(rec.conditionalBranch,thenClause)$COND)$Lisp + elseBranch := elt(rec.conditionalBranch,elseClause)$COND + not(operation(elseBranch) case Null) => + operation(elseBranch) case Conditional => + APPEND(expr,getElseIf elseBranch)$Lisp + expr := APPEND(expr, getStatement(ELSE::O,NIL$Lisp)$Lisp)$Lisp + expr := APPEND(expr, getBody elseBranch)$Lisp + expr + + getContinue(label:SingleInteger):SEX == + lab : O := label::O + if (width(lab) > 6) then error "Label too big" + cnt : O := "CONTINUE"::O + --sp : O := hspace(6-width lab) + sp : O := hspace(_$fortIndent$Lisp -width lab) + LIST(STRCONC(STRINGIMAGE(lab)$Lisp,sp,cnt)$Lisp)$Lisp + + getGoto(label:SingleInteger):SEX == + fortran2Lines( + LIST(STRCONC("GOTO ",STRINGIMAGE(label::O)$Lisp)$Lisp)$Lisp)$Lisp + + getRepeat(repRec:LOOP):SEX == + sw : Switch := NOT elt(repRec,switch)$LOOP + lab := newLabel() + bod := elt(repRec,body)$LOOP + APPEND(getContinue lab,getBody bod, + fortFormatIfGoto(sw::O,lab)$Lisp)$Lisp + + getWhile(whileRec:LOOP):SEX == + sw := NOT elt(whileRec,switch)$LOOP + lab1 := newLabel() + lab2 := newLabel() + bod := elt(whileRec,body)$LOOP + APPEND(fortFormatLabelledIfGoto(sw::O,lab1,lab2)$Lisp, + getBody bod, getBody goto(lab1), getContinue lab2)$Lisp + + getArrayAssign(rec:ARRAYASS):SEX == + getfortarrayexp((rec.var)::O,rec.rand,rec.ints2Floats?)$Lisp + + getAssign(rec:ASS):SEX == + indices : L PIN := elt(rec,arrayIndex)$ASS + if indices = []::(L PIN) then + lhs := elt(rec,var)$ASS::O + else + lhs := cons(elt(rec,var)$ASS::PIN,indices)::O + -- Must get the index brackets correct: + lhs := (cdr car cdr convert(lhs)$SEX::SEX)::O -- Yuck! + elt(elt(rec,rand)$ASS,ints2Floats?)$EXPRESSION => + assignment2Fortran1(lhs,elt(elt(rec,rand)$ASS,expr)$EXPRESSION)$Lisp + integerAssignment2Fortran1(lhs,elt(elt(rec,rand)$ASS,expr)$EXPRESSION)$Lisp + + getCond(rec:COND):SEX == + expr := APPEND(fortFormatIf(elt(rec,switch)$COND::O)$Lisp, + getBody elt(rec,thenClause)$COND)$Lisp + elseBranch := elt(rec,elseClause)$COND + if not(operation(elseBranch) case Null) then + operation(elseBranch) case Conditional => + expr := APPEND(expr,getElseIf elseBranch)$Lisp + expr := APPEND(expr,getStatement(ELSE::O,NIL$Lisp)$Lisp, + getBody elseBranch)$Lisp + APPEND(expr,getStatement(ENDIF::O,NIL$Lisp)$Lisp)$Lisp + + getComment(rec:COMMENT):SEX == + convert([convert(concat("C ",c)$String)@SEX for c in rec])@SEX + + getCall(rec:CALL):SEX == + expr := concat("CALL ",rec)$String + #expr > 1320 => error "Fortran CALL too large" + fortran2Lines(convert([convert(expr)@SEX ])@SEX)$Lisp + + getFor(rec:FOR):SEX == + rnge : SegmentBinding PIN := elt(rec,range)$FOR + increment : PIN := elt(rec,span)$FOR + lab : SingleInteger := newLabel() + declare!(variable rnge,fortranInteger()) + expr := fortFormatDo(variable rnge, (lo segment rnge)::O,_ + (hi segment rnge)::O,increment::O,lab)$Lisp + APPEND(expr, getBody elt(rec,body)$FOR, getContinue(lab))$Lisp + + getCode(f:$):SEX == + opp:OP := operation f + rec:OPREC:= code f + opp case Assignment => getAssign(rec.assignmentBranch) + opp case ArrayAssignment => getArrayAssign(rec.arrayAssignmentBranch) + opp case Conditional => getCond(rec.conditionalBranch) + opp case Return => getReturn(rec.returnBranch) + opp case Block => getBlock(rec.blockBranch) + opp case Comment => getComment(rec.commentBranch) + opp case Call => getCall(rec.callBranch) + opp case For => getFor(rec.forBranch) + opp case Continue => getContinue(rec.labelBranch) + opp case Goto => getGoto(rec.labelBranch) + opp case Repeat => getRepeat(rec.loopBranch) + opp case While => getWhile(rec.loopBranch) + opp case Save => getSave() + opp case Stop => getStop() + opp case Print => getPrint(rec.printBranch) + opp case Common => getCommon(rec.commonBranch) + error "Unsupported program construct." + convert(0)@SEX + + printCode(f:$):Void == + displayLines1$Lisp getCode f + void()$Void + + code (f:$):OPREC == + elt(f,data)$Rep + + operation (f:$):OP == + elt(f,op)$Rep + + common(name:Symbol,contents:List Symbol):$ == + [["common"]$OP,[[name,contents]$COMMON]$OPREC]$Rep + + stop():$ == + [["stop"]$OP,["null"]$OPREC]$Rep + + save():$ == + [["save"]$OP,["null"]$OPREC]$Rep + + printStatement(l:List O):$ == + [["print"]$OP,[l]$OPREC]$Rep + + comment(s:List String):$ == + [["comment"]$OP,[s]$OPREC]$Rep + + comment(s:String):$ == + [["comment"]$OP,[list s]$OPREC]$Rep + + forLoop(r:SegmentBinding PIN,body:$):$ == + [["for"]$OP,[[r,(incr segment r)::PIN,body]$FOR]$OPREC]$Rep + + forLoop(r:SegmentBinding PIN,increment:PIN,body:$):$ == + [["for"]$OP,[[r,increment,body]$FOR]$OPREC]$Rep + + goto(l:SingleInteger):$ == + [["goto"]$OP,[l]$OPREC]$Rep + + continue(l:SingleInteger):$ == + [["continue"]$OP,[l]$OPREC]$Rep + + whileLoop(sw:Switch,b:$):$ == + [["while"]$OP,[[sw,b]$LOOP]$OPREC]$Rep + + repeatUntilLoop(sw:Switch,b:$):$ == + [["repeat"]$OP,[[sw,b]$LOOP]$OPREC]$Rep + + returns():$ == + v := [false,0::O]$EXPRESSION + [["return"]$OP,[[true,v]$RETURN]$OPREC]$Rep + + returns(v:Expression MachineInteger):$ == + [["return"]$OP,[[false,[false,v::O]$EXPRESSION]$RETURN]$OPREC]$Rep + + returns(v:Expression MachineFloat):$ == + [["return"]$OP,[[false,[false,v::O]$EXPRESSION]$RETURN]$OPREC]$Rep + + returns(v:Expression MachineComplex):$ == + [["return"]$OP,[[false,[false,v::O]$EXPRESSION]$RETURN]$OPREC]$Rep + + returns(v:Expression Integer):$ == + [["return"]$OP,[[false,[false,v::O]$EXPRESSION]$RETURN]$OPREC]$Rep + + returns(v:Expression Float):$ == + [["return"]$OP,[[false,[false,v::O]$EXPRESSION]$RETURN]$OPREC]$Rep + + returns(v:Expression Complex Float):$ == + [["return"]$OP,[[false,[false,v::O]$EXPRESSION]$RETURN]$OPREC]$Rep + + block(l:List $):$ == + [["block"]$OP,[l]$OPREC]$Rep + + cond(sw:Switch,thenC:$):$ == + [["conditional"]$OP, + [[sw,thenC,[["null"]$OP,["null"]$OPREC]$Rep]$COND]$OPREC]$Rep + + cond(sw:Switch,thenC:$,elseC:$):$ == + [["conditional"]$OP,[[sw,thenC,elseC]$COND]$OPREC]$Rep + + coerce(f : $):O == + (f.op)::O + + assign(v:Symbol,rhs:String):$ == + [["assignment"]$OP,[[v,nil()::L PIN,[false,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep + + assign(v:Symbol,rhs:Matrix MachineInteger):$ == + [["arrayAssignment"]$OP,[[v,rhs::O,false]$ARRAYASS]$OPREC]$Rep + + assign(v:Symbol,rhs:Matrix MachineFloat):$ == + [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep + + assign(v:Symbol,rhs:Matrix MachineComplex):$ == + [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep + + assign(v:Symbol,rhs:Vector MachineInteger):$ == + [["arrayAssignment"]$OP,[[v,rhs::O,false]$ARRAYASS]$OPREC]$Rep + + assign(v:Symbol,rhs:Vector MachineFloat):$ == + [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep + + assign(v:Symbol,rhs:Vector MachineComplex):$ == + [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep + + assign(v:Symbol,rhs:Matrix Expression MachineInteger):$ == + [["arrayAssignment"]$OP,[[v,rhs::O,false]$ARRAYASS]$OPREC]$Rep + + assign(v:Symbol,rhs:Matrix Expression MachineFloat):$ == + [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep + + assign(v:Symbol,rhs:Matrix Expression MachineComplex):$ == + [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep + + assign(v:Symbol,rhs:Vector Expression MachineInteger):$ == + [["arrayAssignment"]$OP,[[v,rhs::O,false]$ARRAYASS]$OPREC]$Rep + + assign(v:Symbol,rhs:Vector Expression MachineFloat):$ == + [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep + + assign(v:Symbol,rhs:Vector Expression MachineComplex):$ == + [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep + + assign(v:Symbol,index:L PIN,rhs:Expression MachineInteger):$ == + [["assignment"]$OP,[[v,index,[false,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep + + assign(v:Symbol,index:L PIN,rhs:Expression MachineFloat):$ == + [["assignment"]$OP,[[v,index,[true,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep + + assign(v:Symbol,index:L PIN,rhs:Expression MachineComplex):$ == + [["assignment"]$OP,[[v,index,[true,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep + + assign(v:Symbol,rhs:Expression MachineInteger):$ == + [["assignment"]$OP,[[v,nil()::L PIN,[false,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep + + assign(v:Symbol,rhs:Expression MachineFloat):$ == + [["assignment"]$OP,[[v,nil()::L PIN,[true,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep + + assign(v:Symbol,rhs:Expression MachineComplex):$ == + [["assignment"]$OP,[[v,nil()::L PIN,[true,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep + + assign(v:Symbol,rhs:Matrix Expression Integer):$ == + [["arrayAssignment"]$OP,[[v,rhs::O,false]$ARRAYASS]$OPREC]$Rep + + assign(v:Symbol,rhs:Matrix Expression Float):$ == + [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep + + assign(v:Symbol,rhs:Matrix Expression Complex Float):$ == + [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep + + assign(v:Symbol,rhs:Vector Expression Integer):$ == + [["arrayAssignment"]$OP,[[v,rhs::O,false]$ARRAYASS]$OPREC]$Rep + + assign(v:Symbol,rhs:Vector Expression Float):$ == + [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep + + assign(v:Symbol,rhs:Vector Expression Complex Float):$ == + [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep + + assign(v:Symbol,index:L PIN,rhs:Expression Integer):$ == + [["assignment"]$OP,[[v,index,[false,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep + + assign(v:Symbol,index:L PIN,rhs:Expression Float):$ == + [["assignment"]$OP,[[v,index,[true,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep + + assign(v:Symbol,index:L PIN,rhs:Expression Complex Float):$ == + [["assignment"]$OP,[[v,index,[true,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep + + assign(v:Symbol,rhs:Expression Integer):$ == + [["assignment"]$OP,[[v,nil()::L PIN,[false,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep + + assign(v:Symbol,rhs:Expression Float):$ == + [["assignment"]$OP,[[v,nil()::L PIN,[true,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep + + assign(v:Symbol,rhs:Expression Complex Float):$ == + [["assignment"]$OP,[[v,nil()::L PIN,[true,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep + + call(s:String):$ == + [["call"]$OP,[s]$OPREC]$Rep + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain FEXPR FortranExpression} +\pagehead{FortranExpression}{FEXPR} +\pagepic{ps/v103fortranexpression.ps}{FEXPR}{1.00} +See also:\\ +\refto{Result}{RESULT} +\refto{FortranCode}{FC} +\refto{FortranProgram}{FORTRAN} +\refto{ThreeDimensionalMatrix}{M3D} +\refto{SimpleFortranProgram}{SFORT} +\refto{Switch}{SWITCH} +\refto{FortranTemplate}{FTEM} +<>= +)abbrev domain FEXPR FortranExpression +++ Author: Mike Dewar +++ Date Created: December 1993 +++ Date Last Updated: 19 May 1994 +++ 7 July 1994 added %power to f77Functions +++ 12 July 1994 added RetractableTo(R) +++ Basic Operations: +++ Related Domains: +++ Also See: FortranMachineTypeCategory, MachineInteger, MachineFloat, +++ MachineComplex +++ AMS Classifications: +++ Keywords: +++ Examples: +++ References: +++ Description: A domain of expressions involving functions which can be +++ translated into standard Fortran-77, with some extra extensions from +++ the NAG Fortran Library. +FortranExpression(basicSymbols,subscriptedSymbols,R): + Exports==Implementation where + basicSymbols : List Symbol + subscriptedSymbols : List Symbol + R : FortranMachineTypeCategory + + EXPR ==> Expression + EXF2 ==> ExpressionFunctions2 + S ==> Symbol + L ==> List + BO ==> BasicOperator + FRAC ==> Fraction + POLY ==> Polynomial + + Exports ==> Join(ExpressionSpace,Algebra(R),RetractableTo(R), + PartialDifferentialRing(Symbol)) with + retract : EXPR R -> $ + ++ retract(e) takes e and transforms it into a + ++ FortranExpression checking that it contains no non-Fortran + ++ functions, and that it only contains the given basic symbols + ++ and subscripted symbols which correspond to scalar and array + ++ parameters respectively. + retractIfCan : EXPR R -> Union($,"failed") + ++ retractIfCan(e) takes e and tries to transform it into a + ++ FortranExpression checking that it contains no non-Fortran + ++ functions, and that it only contains the given basic symbols + ++ and subscripted symbols which correspond to scalar and array + ++ parameters respectively. + retract : S -> $ + ++ retract(e) takes e and transforms it into a FortranExpression + ++ checking that it is one of the given basic symbols + ++ or subscripted symbols which correspond to scalar and array + ++ parameters respectively. + retractIfCan : S -> Union($,"failed") + ++ retractIfCan(e) takes e and tries to transform it into a FortranExpression + ++ checking that it is one of the given basic symbols + ++ or subscripted symbols which correspond to scalar and array + ++ parameters respectively. + coerce : $ -> EXPR R + ++ coerce(x) \undocumented{} + if (R has RetractableTo(Integer)) then + retract : EXPR Integer -> $ + ++ retract(e) takes e and transforms it into a + ++ FortranExpression checking that it contains no non-Fortran + ++ functions, and that it only contains the given basic symbols + ++ and subscripted symbols which correspond to scalar and array + ++ parameters respectively. + retractIfCan : EXPR Integer -> Union($,"failed") + ++ retractIfCan(e) takes e and tries to transform it into a + ++ FortranExpression checking that it contains no non-Fortran + ++ functions, and that it only contains the given basic symbols + ++ and subscripted symbols which correspond to scalar and array + ++ parameters respectively. + retract : FRAC POLY Integer -> $ + ++ retract(e) takes e and transforms it into a + ++ FortranExpression checking that it contains no non-Fortran + ++ functions, and that it only contains the given basic symbols + ++ and subscripted symbols which correspond to scalar and array + ++ parameters respectively. + retractIfCan : FRAC POLY Integer -> Union($,"failed") + ++ retractIfCan(e) takes e and tries to transform it into a + ++ FortranExpression checking that it contains no non-Fortran + ++ functions, and that it only contains the given basic symbols + ++ and subscripted symbols which correspond to scalar and array + ++ parameters respectively. + retract : POLY Integer -> $ + ++ retract(e) takes e and transforms it into a + ++ FortranExpression checking that it contains no non-Fortran + ++ functions, and that it only contains the given basic symbols + ++ and subscripted symbols which correspond to scalar and array + ++ parameters respectively. + retractIfCan : POLY Integer -> Union($,"failed") + ++ retractIfCan(e) takes e and tries to transform it into a + ++ FortranExpression checking that it contains no non-Fortran + ++ functions, and that it only contains the given basic symbols + ++ and subscripted symbols which correspond to scalar and array + ++ parameters respectively. + if (R has RetractableTo(Float)) then + retract : EXPR Float -> $ + ++ retract(e) takes e and transforms it into a + ++ FortranExpression checking that it contains no non-Fortran + ++ functions, and that it only contains the given basic symbols + ++ and subscripted symbols which correspond to scalar and array + ++ parameters respectively. + retractIfCan : EXPR Float -> Union($,"failed") + ++ retractIfCan(e) takes e and tries to transform it into a + ++ FortranExpression checking that it contains no non-Fortran + ++ functions, and that it only contains the given basic symbols + ++ and subscripted symbols which correspond to scalar and array + ++ parameters respectively. + retract : FRAC POLY Float -> $ + ++ retract(e) takes e and transforms it into a + ++ FortranExpression checking that it contains no non-Fortran + ++ functions, and that it only contains the given basic symbols + ++ and subscripted symbols which correspond to scalar and array + ++ parameters respectively. + retractIfCan : FRAC POLY Float -> Union($,"failed") + ++ retractIfCan(e) takes e and tries to transform it into a + ++ FortranExpression checking that it contains no non-Fortran + ++ functions, and that it only contains the given basic symbols + ++ and subscripted symbols which correspond to scalar and array + ++ parameters respectively. + retract : POLY Float -> $ + ++ retract(e) takes e and transforms it into a + ++ FortranExpression checking that it contains no non-Fortran + ++ functions, and that it only contains the given basic symbols + ++ and subscripted symbols which correspond to scalar and array + ++ parameters respectively. + retractIfCan : POLY Float -> Union($,"failed") + ++ retractIfCan(e) takes e and tries to transform it into a + ++ FortranExpression checking that it contains no non-Fortran + ++ functions, and that it only contains the given basic symbols + ++ and subscripted symbols which correspond to scalar and array + ++ parameters respectively. + abs : $ -> $ + ++ abs(x) represents the Fortran intrinsic function ABS + sqrt : $ -> $ + ++ sqrt(x) represents the Fortran intrinsic function SQRT + exp : $ -> $ + ++ exp(x) represents the Fortran intrinsic function EXP + log : $ -> $ + ++ log(x) represents the Fortran intrinsic function LOG + log10 : $ -> $ + ++ log10(x) represents the Fortran intrinsic function LOG10 + sin : $ -> $ + ++ sin(x) represents the Fortran intrinsic function SIN + cos : $ -> $ + ++ cos(x) represents the Fortran intrinsic function COS + tan : $ -> $ + ++ tan(x) represents the Fortran intrinsic function TAN + asin : $ -> $ + ++ asin(x) represents the Fortran intrinsic function ASIN + acos : $ -> $ + ++ acos(x) represents the Fortran intrinsic function ACOS + atan : $ -> $ + ++ atan(x) represents the Fortran intrinsic function ATAN + sinh : $ -> $ + ++ sinh(x) represents the Fortran intrinsic function SINH + cosh : $ -> $ + ++ cosh(x) represents the Fortran intrinsic function COSH + tanh : $ -> $ + ++ tanh(x) represents the Fortran intrinsic function TANH + pi : () -> $ + ++ pi(x) represents the NAG Library function X01AAF which returns + ++ an approximation to the value of pi + variables : $ -> L S + ++ variables(e) return a list of all the variables in \spad{e}. + useNagFunctions : () -> Boolean + ++ useNagFunctions() indicates whether NAG functions are being used + ++ for mathematical and machine constants. + useNagFunctions : Boolean -> Boolean + ++ useNagFunctions(v) sets the flag which controls whether NAG functions + ++ are being used for mathematical and machine constants. The previous + ++ value is returned. + + Implementation ==> EXPR R add + + -- The standard FORTRAN-77 intrinsic functions, plus nthRoot which + -- can be translated into an arithmetic expression: + f77Functions : L S := [abs,sqrt,exp,log,log10,sin,cos,tan,asin,acos, + atan,sinh,cosh,tanh,nthRoot,%power] + nagFunctions : L S := [pi, X01AAF] + useNagFunctionsFlag : Boolean := true + + -- Local functions to check for "unassigned" symbols etc. + + mkEqn(s1:Symbol,s2:Symbol):Equation EXPR(R) == + equation(s2::EXPR(R),script(s1,scripts(s2))::EXPR(R)) + + fixUpSymbols(u:EXPR R):Union(EXPR R,"failed") == + -- If its a univariate expression then just fix it up: + syms : L S := variables(u) +-- one?(#basicSymbols) and zero?(#subscriptedSymbols) => + (#basicSymbols = 1) and zero?(#subscriptedSymbols) => +-- not one?(#syms) => "failed" + not (#syms = 1) => "failed" + subst(u,equation(first(syms)::EXPR(R),first(basicSymbols)::EXPR(R))) + -- We have one variable but it is subscripted: +-- zero?(#basicSymbols) and one?(#subscriptedSymbols) => + zero?(#basicSymbols) and (#subscriptedSymbols = 1) => + -- Make sure we don't have both X and X_i + for s in syms repeat + not scripted?(s) => return "failed" +-- not one?(#(syms:=removeDuplicates! [name(s) for s in syms]))=> "failed" + not ((#(syms:=removeDuplicates! [name(s) for s in syms])) = 1)=> "failed" + sym : Symbol := first subscriptedSymbols + subst(u,[mkEqn(sym,i) for i in variables(u)]) + "failed" + + extraSymbols?(u:EXPR R):Boolean == + syms : L S := [name(v) for v in variables(u)] + extras : L S := setDifference(syms, + setUnion(basicSymbols,subscriptedSymbols)) + not empty? extras + + checkSymbols(u:EXPR R):EXPR(R) == + syms : L S := [name(v) for v in variables(u)] + extras : L S := setDifference(syms, + setUnion(basicSymbols,subscriptedSymbols)) + not empty? extras => + m := fixUpSymbols(u) + m case EXPR(R) => m::EXPR(R) + error("Extra symbols detected:",[string(v) for v in extras]$L(String)) + u + + notSymbol?(v:BO):Boolean == + s : S := name v + member?(s,basicSymbols) or + scripted?(s) and member?(name s,subscriptedSymbols) => false + true + + extraOperators?(u:EXPR R):Boolean == + ops : L S := [name v for v in operators(u) | notSymbol?(v)] + if useNagFunctionsFlag then + fortranFunctions : L S := append(f77Functions,nagFunctions) + else + fortranFunctions : L S := f77Functions + extras : L S := setDifference(ops,fortranFunctions) + not empty? extras + + checkOperators(u:EXPR R):Void == + ops : L S := [name v for v in operators(u) | notSymbol?(v)] + if useNagFunctionsFlag then + fortranFunctions : L S := append(f77Functions,nagFunctions) + else + fortranFunctions : L S := f77Functions + extras : L S := setDifference(ops,fortranFunctions) + not empty? extras => + error("Non FORTRAN-77 functions detected:",[string(v) for v in extras]) + void() + + checkForNagOperators(u:EXPR R):$ == + useNagFunctionsFlag => + import Pi + import PiCoercions(R) + piOp : BasicOperator := operator X01AAF + piSub : Equation EXPR R := + equation(pi()$Pi::EXPR(R),kernel(piOp,0::EXPR(R))$EXPR(R)) + subst(u,piSub) pretend $ + u pretend $ + + -- Conditional retractions: + + if R has RetractableTo(Integer) then + + retractIfCan(u:POLY Integer):Union($,"failed") == + retractIfCan((u::EXPR Integer)$EXPR(Integer))@Union($,"failed") + + retract(u:POLY Integer):$ == + retract((u::EXPR Integer)$EXPR(Integer))@$ + + retractIfCan(u:FRAC POLY Integer):Union($,"failed") == + retractIfCan((u::EXPR Integer)$EXPR(Integer))@Union($,"failed") + + retract(u:FRAC POLY Integer):$ == + retract((u::EXPR Integer)$EXPR(Integer))@$ + + int2R(u:Integer):R == u::R + + retractIfCan(u:EXPR Integer):Union($,"failed") == + retractIfCan(map(int2R,u)$EXF2(Integer,R))@Union($,"failed") + + retract(u:EXPR Integer):$ == + retract(map(int2R,u)$EXF2(Integer,R))@$ + + if R has RetractableTo(Float) then + + retractIfCan(u:POLY Float):Union($,"failed") == + retractIfCan((u::EXPR Float)$EXPR(Float))@Union($,"failed") + + retract(u:POLY Float):$ == + retract((u::EXPR Float)$EXPR(Float))@$ + + retractIfCan(u:FRAC POLY Float):Union($,"failed") == + retractIfCan((u::EXPR Float)$EXPR(Float))@Union($,"failed") + + retract(u:FRAC POLY Float):$ == + retract((u::EXPR Float)$EXPR(Float))@$ + + float2R(u:Float):R == (u::R) + + retractIfCan(u:EXPR Float):Union($,"failed") == + retractIfCan(map(float2R,u)$EXF2(Float,R))@Union($,"failed") + + retract(u:EXPR Float):$ == + retract(map(float2R,u)$EXF2(Float,R))@$ + + -- Exported Functions + + useNagFunctions():Boolean == useNagFunctionsFlag + useNagFunctions(v:Boolean):Boolean == + old := useNagFunctionsFlag + useNagFunctionsFlag := v + old + + log10(x:$):$ == + kernel(operator log10,x) + + pi():$ == kernel(operator X01AAF,0) + + coerce(u:$):EXPR R == u pretend EXPR(R) + + retractIfCan(u:EXPR R):Union($,"failed") == + if (extraSymbols? u) then + m := fixUpSymbols(u) + m case "failed" => return "failed" + u := m::EXPR(R) + extraOperators? u => "failed" + checkForNagOperators(u) + + retract(u:EXPR R):$ == + u:=checkSymbols(u) + checkOperators(u) + checkForNagOperators(u) + + retractIfCan(u:Symbol):Union($,"failed") == + not (member?(u,basicSymbols) or + scripted?(u) and member?(name u,subscriptedSymbols)) => "failed" + (((u::EXPR(R))$(EXPR R))pretend Rep)::$ + + retract(u:Symbol):$ == + res : Union($,"failed") := retractIfCan(u) + res case "failed" => error("Illegal Symbol Detected:",u::String) + res::$ + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain FORTRAN FortranProgram} +\pagehead{FortranProgram}{FORTRAN} +\pagepic{ps/v103fortranprogram.ps}{FORTRAN}{1.00} +See also:\\ +\refto{Result}{RESULT} +\refto{FortranCode}{FC} +\refto{ThreeDimensionalMatrix}{M3D} +\refto{SimpleFortranProgram}{SFORT} +\refto{Switch}{SWITCH} +\refto{FortranTemplate}{FTEM} +\refto{FortranExpression}{FEXPR} +<>= +)abbrev domain FORTRAN FortranProgram +++ Author: Mike Dewar +++ Date Created: October 1992 +++ Date Last Updated: 13 January 1994 +++ 23 January 1995 Added support for intrinsic functions +++ Basic Operations: +++ Related Constructors: FortranType, FortranCode, Switch +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: \axiomType{FortranProgram} allows the user to build and manipulate simple +++ models of FORTRAN subprograms. These can then be transformed into actual FORTRAN +++ notation. +FortranProgram(name,returnType,arguments,symbols): Exports == Implement where + name : Symbol + returnType : Union(fst:FortranScalarType,void:"void") + arguments : List Symbol + symbols : SymbolTable + + FC ==> FortranCode + EXPR ==> Expression + INT ==> Integer + CMPX ==> Complex + MINT ==> MachineInteger + MFLOAT ==> MachineFloat + MCMPLX ==> MachineComplex + REP ==> Record(localSymbols : SymbolTable, code : List FortranCode) + + Exports ==> FortranProgramCategory with + coerce : FortranCode -> $ + ++ coerce(fc) \undocumented{} + coerce : List FortranCode -> $ + ++ coerce(lfc) \undocumented{} + coerce : REP -> $ + ++ coerce(r) \undocumented{} + coerce : EXPR MINT -> $ + ++ coerce(e) \undocumented{} + coerce : EXPR MFLOAT -> $ + ++ coerce(e) \undocumented{} + coerce : EXPR MCMPLX -> $ + ++ coerce(e) \undocumented{} + coerce : Equation EXPR MINT -> $ + ++ coerce(eq) \undocumented{} + coerce : Equation EXPR MFLOAT -> $ + ++ coerce(eq) \undocumented{} + coerce : Equation EXPR MCMPLX -> $ + ++ coerce(eq) \undocumented{} + coerce : EXPR INT -> $ + ++ coerce(e) \undocumented{} + coerce : EXPR Float -> $ + ++ coerce(e) \undocumented{} + coerce : EXPR CMPX Float -> $ + ++ coerce(e) \undocumented{} + coerce : Equation EXPR INT -> $ + ++ coerce(eq) \undocumented{} + coerce : Equation EXPR Float -> $ + ++ coerce(eq) \undocumented{} + coerce : Equation EXPR CMPX Float -> $ + ++ coerce(eq) \undocumented{} + + Implement ==> add + + Rep := REP + + import SExpression + import TheSymbolTable + import FortranCode + + makeRep(b:List FortranCode):$ == + construct(empty()$SymbolTable,b)$REP + + codeFrom(u:$):List FortranCode == + elt(u::Rep,code)$REP + + outputAsFortran(p:$):Void == + setLabelValue(25000::SingleInteger)$FC + -- Do this first to catch any extra type declarations: + tempName := "FPTEMP"::Symbol + newSubProgram(tempName) + initialiseIntrinsicList()$Lisp + body : List SExpression := [getCode(l)$FortranCode for l in codeFrom(p)] + intrinsics : SExpression := getIntrinsicList()$Lisp + endSubProgram() + fortFormatHead(returnType::OutputForm, name::OutputForm, _ + arguments::OutputForm)$Lisp + printTypes(symbols)$SymbolTable + printTypes((p::Rep).localSymbols)$SymbolTable + printTypes(tempName)$TheSymbolTable + fortFormatIntrinsics(intrinsics)$Lisp + clearTheSymbolTable(tempName) + for expr in body repeat displayLines1(expr)$Lisp + dispStatement(END::OutputForm)$Lisp + void()$Void + + mkString(l:List Symbol):String == + unparse(convert(l::OutputForm)@InputForm)$InputForm + + checkVariables(user:List Symbol,target:List Symbol):Void == + -- We don't worry about whether the user has subscripted the + -- variables or not. + setDifference(map(name$Symbol,user),target) ^= empty()$List(Symbol) => + s1 : String := mkString(user) + s2 : String := mkString(target) + error ["Incompatible variable lists:", s1, s2] + void()$Void + + coerce(u:EXPR MINT) : $ == + checkVariables(variables(u)$EXPR(MINT),arguments) + l : List(FC) := [assign(name,u)$FC,returns()$FC] + makeRep l + + coerce(u:Equation EXPR MINT) : $ == + retractIfCan(lhs u)@Union(Kernel(EXPR MINT),"failed") case "failed" => + error "left hand side is not a kernel" + vList : List Symbol := variables lhs u + #vList ^= #arguments => + error "Incorrect number of arguments" + veList : List EXPR MINT := [w::EXPR(MINT) for w in vList] + aeList : List EXPR MINT := [w::EXPR(MINT) for w in arguments] + eList : List Equation EXPR MINT := + [equation(w,v) for w in veList for v in aeList] + (subst(rhs u,eList))::$ + + coerce(u:EXPR MFLOAT) : $ == + checkVariables(variables(u)$EXPR(MFLOAT),arguments) + l : List(FC) := [assign(name,u)$FC,returns()$FC] + makeRep l + + coerce(u:Equation EXPR MFLOAT) : $ == + retractIfCan(lhs u)@Union(Kernel(EXPR MFLOAT),"failed") case "failed" => + error "left hand side is not a kernel" + vList : List Symbol := variables lhs u + #vList ^= #arguments => + error "Incorrect number of arguments" + veList : List EXPR MFLOAT := [w::EXPR(MFLOAT) for w in vList] + aeList : List EXPR MFLOAT := [w::EXPR(MFLOAT) for w in arguments] + eList : List Equation EXPR MFLOAT := + [equation(w,v) for w in veList for v in aeList] + (subst(rhs u,eList))::$ + + coerce(u:EXPR MCMPLX) : $ == + checkVariables(variables(u)$EXPR(MCMPLX),arguments) + l : List(FC) := [assign(name,u)$FC,returns()$FC] + makeRep l + + coerce(u:Equation EXPR MCMPLX) : $ == + retractIfCan(lhs u)@Union(Kernel EXPR MCMPLX,"failed") case "failed"=> + error "left hand side is not a kernel" + vList : List Symbol := variables lhs u + #vList ^= #arguments => + error "Incorrect number of arguments" + veList : List EXPR MCMPLX := [w::EXPR(MCMPLX) for w in vList] + aeList : List EXPR MCMPLX := [w::EXPR(MCMPLX) for w in arguments] + eList : List Equation EXPR MCMPLX := + [equation(w,v) for w in veList for v in aeList] + (subst(rhs u,eList))::$ + + + coerce(u:REP):$ == + u@Rep + + coerce(u:$):OutputForm == + coerce(name)$Symbol + + coerce(c:List FortranCode):$ == + makeRep c + + coerce(c:FortranCode):$ == + makeRep [c] + + coerce(u:EXPR INT) : $ == + checkVariables(variables(u)$EXPR(INT),arguments) + l : List(FC) := [assign(name,u)$FC,returns()$FC] + makeRep l + + coerce(u:Equation EXPR INT) : $ == + retractIfCan(lhs u)@Union(Kernel(EXPR INT),"failed") case "failed" => + error "left hand side is not a kernel" + vList : List Symbol := variables lhs u + #vList ^= #arguments => + error "Incorrect number of arguments" + veList : List EXPR INT := [w::EXPR(INT) for w in vList] + aeList : List EXPR INT := [w::EXPR(INT) for w in arguments] + eList : List Equation EXPR INT := + [equation(w,v) for w in veList for v in aeList] + (subst(rhs u,eList))::$ + + coerce(u:EXPR Float) : $ == + checkVariables(variables(u)$EXPR(Float),arguments) + l : List(FC) := [assign(name,u)$FC,returns()$FC] + makeRep l + + coerce(u:Equation EXPR Float) : $ == + retractIfCan(lhs u)@Union(Kernel(EXPR Float),"failed") case "failed" => + error "left hand side is not a kernel" + vList : List Symbol := variables lhs u + #vList ^= #arguments => + error "Incorrect number of arguments" + veList : List EXPR Float := [w::EXPR(Float) for w in vList] + aeList : List EXPR Float := [w::EXPR(Float) for w in arguments] + eList : List Equation EXPR Float := + [equation(w,v) for w in veList for v in aeList] + (subst(rhs u,eList))::$ + + coerce(u:EXPR Complex Float) : $ == + checkVariables(variables(u)$EXPR(Complex Float),arguments) + l : List(FC) := [assign(name,u)$FC,returns()$FC] + makeRep l + + coerce(u:Equation EXPR CMPX Float) : $ == + retractIfCan(lhs u)@Union(Kernel EXPR CMPX Float,"failed") case "failed"=> + error "left hand side is not a kernel" + vList : List Symbol := variables lhs u + #vList ^= #arguments => + error "Incorrect number of arguments" + veList : List EXPR CMPX Float := [w::EXPR(CMPX Float) for w in vList] + aeList : List EXPR CMPX Float := [w::EXPR(CMPX Float) for w in arguments] + eList : List Equation EXPR CMPX Float := + [equation(w,v) for w in veList for v in aeList] + (subst(rhs u,eList))::$ + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain FST FortranScalarType} +\pagehead{FortranScalarType}{FST} +\pagepic{ps/v103fortranscalartype.ps}{FST}{1.00} +See also:\\ +\refto{FortranType}{FT} +\refto{SymbolTable}{SYMTAB} +\refto{TheSymbolTable}{SYMS} +<>= +)abbrev domain FST FortranScalarType +++ Author: Mike Dewar +++ Date Created: October 1992 +++ Date Last Updated: +++ Basic Operations: +++ Related Domains: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ Examples: +++ References: +++ Description: Creates and manipulates objects which correspond to the +++ basic FORTRAN data types: REAL, INTEGER, COMPLEX, LOGICAL and CHARACTER +FortranScalarType() : exports == implementation where + + exports == CoercibleTo OutputForm with + coerce : String -> $ + ++ coerce(s) transforms the string s into an element of + ++ FortranScalarType provided s is one of "real", "double precision", + ++ "complex", "logical", "integer", "character", "REAL", + ++ "COMPLEX", "LOGICAL", "INTEGER", "CHARACTER", + ++ "DOUBLE PRECISION" + coerce : Symbol -> $ + ++ coerce(s) transforms the symbol s into an element of + ++ FortranScalarType provided s is one of real, complex,double precision, + ++ logical, integer, character, REAL, COMPLEX, LOGICAL, + ++ INTEGER, CHARACTER, DOUBLE PRECISION + coerce : $ -> Symbol + ++ coerce(x) returns the symbol associated with x + coerce : $ -> SExpression + ++ coerce(x) returns the s-expression associated with x + real? : $ -> Boolean + ++ real?(t) tests whether t is equivalent to the FORTRAN type REAL. + double? : $ -> Boolean + ++ double?(t) tests whether t is equivalent to the FORTRAN type + ++ DOUBLE PRECISION + integer? : $ -> Boolean + ++ integer?(t) tests whether t is equivalent to the FORTRAN type INTEGER. + complex? : $ -> Boolean + ++ complex?(t) tests whether t is equivalent to the FORTRAN type COMPLEX. + doubleComplex? : $ -> Boolean + ++ doubleComplex?(t) tests whether t is equivalent to the (non-standard) + ++ FORTRAN type DOUBLE COMPLEX. + character? : $ -> Boolean + ++ character?(t) tests whether t is equivalent to the FORTRAN type + ++ CHARACTER. + logical? : $ -> Boolean + ++ logical?(t) tests whether t is equivalent to the FORTRAN type LOGICAL. + "=" : ($,$) -> Boolean + ++ x=y tests for equality + + implementation == add + + U == Union(RealThing:"real", + IntegerThing:"integer", + ComplexThing:"complex", + CharacterThing:"character", + LogicalThing:"logical", + DoublePrecisionThing:"double precision", + DoubleComplexThing:"double complex") + Rep := U + + doubleSymbol : Symbol := "double precision"::Symbol + upperDoubleSymbol : Symbol := "DOUBLE PRECISION"::Symbol + doubleComplexSymbol : Symbol := "double complex"::Symbol + upperDoubleComplexSymbol : Symbol := "DOUBLE COMPLEX"::Symbol + + u = v == + u case RealThing and v case RealThing => true + u case IntegerThing and v case IntegerThing => true + u case ComplexThing and v case ComplexThing => true + u case LogicalThing and v case LogicalThing => true + u case CharacterThing and v case CharacterThing => true + u case DoublePrecisionThing and v case DoublePrecisionThing => true + u case DoubleComplexThing and v case DoubleComplexThing => true + false + + coerce(t:$):OutputForm == + t case RealThing => coerce(REAL)$Symbol + t case IntegerThing => coerce(INTEGER)$Symbol + t case ComplexThing => coerce(COMPLEX)$Symbol + t case CharacterThing => coerce(CHARACTER)$Symbol + t case DoublePrecisionThing => coerce(upperDoubleSymbol)$Symbol + t case DoubleComplexThing => coerce(upperDoubleComplexSymbol)$Symbol + coerce(LOGICAL)$Symbol + + coerce(t:$):SExpression == + t case RealThing => convert(real::Symbol)@SExpression + t case IntegerThing => convert(integer::Symbol)@SExpression + t case ComplexThing => convert(complex::Symbol)@SExpression + t case CharacterThing => convert(character::Symbol)@SExpression + t case DoublePrecisionThing => convert(doubleSymbol)@SExpression + t case DoubleComplexThing => convert(doubleComplexSymbol)@SExpression + convert(logical::Symbol)@SExpression + + coerce(t:$):Symbol == + t case RealThing => real::Symbol + t case IntegerThing => integer::Symbol + t case ComplexThing => complex::Symbol + t case CharacterThing => character::Symbol + t case DoublePrecisionThing => doubleSymbol + t case DoublePrecisionThing => doubleComplexSymbol + logical::Symbol + + coerce(s:Symbol):$ == + s = real => ["real"]$Rep + s = REAL => ["real"]$Rep + s = integer => ["integer"]$Rep + s = INTEGER => ["integer"]$Rep + s = complex => ["complex"]$Rep + s = COMPLEX => ["complex"]$Rep + s = character => ["character"]$Rep + s = CHARACTER => ["character"]$Rep + s = logical => ["logical"]$Rep + s = LOGICAL => ["logical"]$Rep + s = doubleSymbol => ["double precision"]$Rep + s = upperDoubleSymbol => ["double precision"]$Rep + s = doubleComplexSymbol => ["double complex"]$Rep + s = upperDoubleCOmplexSymbol => ["double complex"]$Rep + + coerce(s:String):$ == + s = "real" => ["real"]$Rep + s = "integer" => ["integer"]$Rep + s = "complex" => ["complex"]$Rep + s = "character" => ["character"]$Rep + s = "logical" => ["logical"]$Rep + s = "double precision" => ["double precision"]$Rep + s = "double complex" => ["double complex"]$Rep + s = "REAL" => ["real"]$Rep + s = "INTEGER" => ["integer"]$Rep + s = "COMPLEX" => ["complex"]$Rep + s = "CHARACTER" => ["character"]$Rep + s = "LOGICAL" => ["logical"]$Rep + s = "DOUBLE PRECISION" => ["double precision"]$Rep + s = "DOUBLE COMPLEX" => ["double complex"]$Rep + error concat([s," is invalid as a Fortran Type"])$String + + real?(t:$):Boolean == t case RealThing + + double?(t:$):Boolean == t case DoublePrecisionThing + + logical?(t:$):Boolean == t case LogicalThing + + integer?(t:$):Boolean == t case IntegerThing + + character?(t:$):Boolean == t case CharacterThing + + complex?(t:$):Boolean == t case ComplexThing + + doubleComplex?(t:$):Boolean == t case DoubleComplexThing + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain FTEM FortranTemplate} +\pagehead{FortranTemplate}{FTEM} +\pagepic{ps/v103fortrantemplate.ps}{FTEM}{1.00} +See also:\\ +\refto{Result}{RESULT} +\refto{FortranCode}{FC} +\refto{FortranProgram}{FORTRAN} +\refto{ThreeDimensionalMatrix}{M3D} +\refto{SimpleFortranProgram}{SFORT} +\refto{Switch}{SWITCH} +\refto{FortranExpression}{FEXPR} +<>= +)abbrev domain FTEM FortranTemplate +++ Author: Mike Dewar +++ Date Created: October 1992 +++ Date Last Updated: +++ Basic Operations: +++ Related Domains: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ Examples: +++ References: +++ Description: Code to manipulate Fortran templates +FortranTemplate() : specification == implementation where + + specification == FileCategory(FileName, String) with + + processTemplate : (FileName, FileName) -> FileName + ++ processTemplate(tp,fn) processes the template tp, writing the + ++ result out to fn. + processTemplate : (FileName) -> FileName + ++ processTemplate(tp) processes the template tp, writing the + ++ result to the current FORTRAN output stream. + fortranLiteralLine : String -> Void + ++ fortranLiteralLine(s) writes s to the current Fortran output stream, + ++ followed by a carriage return + fortranLiteral : String -> Void + ++ fortranLiteral(s) writes s to the current Fortran output stream + fortranCarriageReturn : () -> Void + ++ fortranCarriageReturn() produces a carriage return on the current + ++ Fortran output stream + + implementation == TextFile add + + import TemplateUtilities + import FortranOutputStackPackage + + Rep := TextFile + + fortranLiteralLine(s:String):Void == + PRINTEXP(s,_$fortranOutputStream$Lisp)$Lisp + TERPRI(_$fortranOutputStream$Lisp)$Lisp + + fortranLiteral(s:String):Void == + PRINTEXP(s,_$fortranOutputStream$Lisp)$Lisp + + fortranCarriageReturn():Void == + TERPRI(_$fortranOutputStream$Lisp)$Lisp + + writePassiveLine!(line:String):Void == + -- We might want to be a bit clever here and look for new SubPrograms etc. + fortranLiteralLine line + + processTemplate(tp:FileName, fn:FileName):FileName == + pushFortranOutputStack(fn) + processTemplate(tp) + popFortranOutputStack() + fn + + getLine(fp:TextFile):String == + line : String := stripCommentsAndBlanks readLine!(fp) + while not empty?(line) and elt(line,maxIndex line) = char "__" repeat + setelt(line,maxIndex line,char " ") + line := concat(line, stripCommentsAndBlanks readLine!(fp))$String + line + + processTemplate(tp:FileName):FileName == + fp : TextFile := open(tp,"input") + active : Boolean := true + line : String + endInput : Boolean := false + while not (endInput or endOfFile? fp) repeat + if active then + line := getLine fp + line = "endInput" => endInput := true + if line = "beginVerbatim" then + active := false + else + not empty? line => interpretString line + else + line := readLine!(fp) + if line = "endVerbatim" then + active := true + else + writePassiveLine! line + close!(fp) + if not active then + error concat(["Missing `endVerbatim' line in ",tp::String])$String + string(_$fortranOutputFile$Lisp)::FileName + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain FT FortranType} +\pagehead{FortranType}{FT} +\pagepic{ps/v103fortrantype.ps}{FT}{1.00} +See also:\\ +\refto{FortranScalarType}{FST} +\refto{SymbolTable}{SYMTAB} +\refto{TheSymbolTable}{SYMS} +<>= +)abbrev domain FT FortranType +++ Author: Mike Dewar +++ Date Created: October 1992 +++ Date Last Updated: +++ Basic Operations: +++ Related Domains: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ Examples: +++ References: +++ Description: Creates and manipulates objects which correspond to FORTRAN +++ data types, including array dimensions. +FortranType() : exports == implementation where + + FST ==> FortranScalarType + FSTU ==> Union(fst:FST,void:"void") + + exports == SetCategory with + coerce : $ -> OutputForm + ++ coerce(x) provides a printable form for x + coerce : FST -> $ + ++ coerce(t) creates an element from a scalar type + scalarTypeOf : $ -> FSTU + ++ scalarTypeOf(t) returns the FORTRAN data type of t + dimensionsOf : $ -> List Polynomial Integer + ++ dimensionsOf(t) returns the dimensions of t + external? : $ -> Boolean + ++ external?(u) returns true if u is declared to be EXTERNAL + construct : (FSTU,List Symbol,Boolean) -> $ + ++ construct(type,dims) creates an element of FortranType + construct : (FSTU,List Polynomial Integer,Boolean) -> $ + ++ construct(type,dims) creates an element of FortranType + fortranReal : () -> $ + ++ fortranReal() returns REAL, an element of FortranType + fortranDouble : () -> $ + ++ fortranDouble() returns DOUBLE PRECISION, an element of FortranType + fortranInteger : () -> $ + ++ fortranInteger() returns INTEGER, an element of FortranType + fortranLogical : () -> $ + ++ fortranLogical() returns LOGICAL, an element of FortranType + fortranComplex : () -> $ + ++ fortranComplex() returns COMPLEX, an element of FortranType + fortranDoubleComplex: () -> $ + ++ fortranDoubleComplex() returns DOUBLE COMPLEX, an element of + ++ FortranType + fortranCharacter : () -> $ + ++ fortranCharacter() returns CHARACTER, an element of FortranType + + implementation == add + + Dims == List Polynomial Integer + Rep := Record(type : FSTU, dimensions : Dims, external : Boolean) + + coerce(a:$):OutputForm == + t : OutputForm + if external?(a) then + if scalarTypeOf(a) case void then + t := "EXTERNAL"::OutputForm + else + t := blankSeparate(["EXTERNAL"::OutputForm, + coerce(scalarTypeOf a)$FSTU])$OutputForm + else + t := coerce(scalarTypeOf a)$FSTU + empty? dimensionsOf(a) => t + sub(t, + paren([u::OutputForm for u in dimensionsOf(a)])$OutputForm)$OutputForm + + scalarTypeOf(u:$):FSTU == + u.type + + dimensionsOf(u:$):Dims == + u.dimensions + + external?(u:$):Boolean == + u.external + + construct(t:FSTU, d:List Symbol, e:Boolean):$ == + e and not empty? d => error "EXTERNAL objects cannot have dimensions" + not(e) and t case void => error "VOID objects must be EXTERNAL" + construct(t,[l::Polynomial(Integer) for l in d],e)$Rep + + construct(t:FSTU, d:List Polynomial Integer, e:Boolean):$ == + e and not empty? d => error "EXTERNAL objects cannot have dimensions" + not(e) and t case void => error "VOID objects must be EXTERNAL" + construct(t,d,e)$Rep + + coerce(u:FST):$ == + construct([u]$FSTU,[]@List Polynomial Integer,false) + + fortranReal():$ == ("real"::FST)::$ + + fortranDouble():$ == ("double precision"::FST)::$ + + fortranInteger():$ == ("integer"::FST)::$ + + fortranComplex():$ == ("complex"::FST)::$ + + fortranDoubleComplex():$ == ("double complex"::FST)::$ + + fortranCharacter():$ == ("character"::FST)::$ + + fortranLogical():$ == ("logical"::FST)::$ + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain FCOMP FourierComponent} +\pagehead{FourierComponent}{FCOMP} +\pagepic{ps/v103fouriercomponent.ps}{FCOMP}{1.00} +See also:\\ +\refto{FourierSeries}{FSERIES} +<>= +)abbrev domain FCOMP FourierComponent +++ Author: James Davenport +++ Date Created: 17 April 1992 +++ Date Last Updated: 12 June 1992 +++ Basic Functions: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +FourierComponent(E:OrderedSet): + OrderedSet with + sin: E -> $ + ++ sin(x) makes a sin kernel for use in Fourier series + cos: E -> $ + ++ cos(x) makes a cos kernel for use in Fourier series + sin?: $ -> Boolean + ++ sin?(x) returns true if term is a sin, otherwise false + argument: $ -> E + ++ argument(x) returns the argument of a given sin/cos expressions + == + add + --representations + Rep:=Record(SinIfTrue:Boolean, arg:E) + e:E + x,y:$ + sin e == [true,e] + cos e == [false,e] + sin? x == x.SinIfTrue + argument x == x.arg + coerce(x):OutputForm == + hconcat((if x.SinIfTrue then "sin" else "cos")::OutputForm, + bracket((x.arg)::OutputForm)) + x true + y.arg < x.arg => false + x.SinIfTrue => false + y.SinIfTrue + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain FSERIES FourierSeries} +\pagehead{FourierSeries}{FSERIES} +\pagepic{ps/v103fourierseries.ps}{FSERIES}{1.00} +See also:\\ +\refto{FourierComponent}{FCOMP} +<>= +)abbrev domain FSERIES FourierSeries +++ Author: James Davenport +++ Date Created: 17 April 1992 +++ Date Last Updated: +++ Basic Functions: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +FourierSeries(R:Join(CommutativeRing,Algebra(Fraction Integer)), + E:Join(OrderedSet,AbelianGroup)): + Algebra(R) with + if E has canonical and R has canonical then canonical + coerce: R -> $ + ++ coerce(r) converts coefficients into Fourier Series + coerce: FourierComponent(E) -> $ + ++ coerce(c) converts sin/cos terms into Fourier Series + makeSin: (E,R) -> $ + ++ makeSin(e,r) makes a sin expression with given argument and coefficient + makeCos: (E,R) -> $ + ++ makeCos(e,r) makes a sin expression with given argument and coefficient + == FreeModule(R,FourierComponent(E)) + add + --representations + Term := Record(k:FourierComponent(E),c:R) + Rep := List Term + multiply : (Term,Term) -> $ + w,x1,x2:$ + t1,t2:Term + n:NonNegativeInteger + z:Integer + e:FourierComponent(E) + a:E + r:R + 1 == [[cos 0,1]] + coerce e == + sin? e and zero? argument e => 0 + if argument e < 0 then + not sin? e => e:=cos(- argument e) + return [[sin(- argument e),-1]] + [[e,1]] + multiply(t1,t2) == + r:=(t1.c*t2.c)*(1/2) + s1:=argument t1.k + s2:=argument t2.k + sum:=s1+s2 + diff:=s1-s2 + sin? t1.k => + sin? t2.k => + makeCos(diff,r) + makeCos(sum,-r) + makeSin(sum,r) + makeSin(diff,r) + sin? t2.k => + makeSin(sum,r) + makeSin(diff,r) + makeCos(diff,r) + makeCos(sum,r) + x1*x2 == + null x1 => 0 + null x2 => 0 + +/[+/[multiply(t1,t2) for t2 in x2] for t1 in x1] + makeCos(a,r) == + a<0 => [[cos(-a),r]] + [[cos a,r]] + makeSin(a,r) == + zero? a => [] + a<0 => [[sin(-a),-r]] + [[sin a,r]] + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain FRAC Fraction} +<>= +-- fraction.spad.pamphlet Fraction.input +)spool Fraction.output +)set message test on +)set message auto off +)clear all +--S 1 of 12 +a := 11/12 +--R +--R +--R 11 +--R (1) -- +--R 12 +--R Type: Fraction Integer +--E 1 + +--S 2 of 12 +b := 23/24 +--R +--R +--R 23 +--R (2) -- +--R 24 +--R Type: Fraction Integer +--E 2 + +--S 3 of 12 +3 - a*b**2 + a + b/a +--R +--R +--R 313271 +--R (3) ------ +--R 76032 +--R Type: Fraction Integer +--E 3 + +--S 4 of 12 +numer(a) +--R +--R +--R (4) 11 +--R Type: PositiveInteger +--E 4 + +--S 5 of 12 +denom(b) +--R +--R +--R (5) 24 +--R Type: PositiveInteger +--E 5 + +--S 6 of 12 +r := (x**2 + 2*x + 1)/(x**2 - 2*x + 1) +--R +--R +--R 2 +--R x + 2x + 1 +--R (6) ----------- +--R 2 +--R x - 2x + 1 +--R Type: Fraction Polynomial Integer +--E 6 + +--S 7 of 12 +factor(r) +--R +--R +--R 2 +--R x + 2x + 1 +--R (7) ----------- +--R 2 +--R x - 2x + 1 +--R Type: Factored Fraction Polynomial Integer +--E 7 + +--S 8 of 12 +map(factor,r) +--R +--R +--R 2 +--R (x + 1) +--R (8) -------- +--R 2 +--R (x - 1) +--R Type: Fraction Factored Polynomial Integer +--E 8 + +--S 9 of 12 +continuedFraction(7/12) +--R +--R +--R 1 | 1 | 1 | 1 | +--R (9) +---+ + +---+ + +---+ + +---+ +--R | 1 | 1 | 2 | 2 +--R Type: ContinuedFraction Integer +--E 9 + +--S 10 of 12 +partialFraction(7,12) +--R +--R +--R 3 1 +--R (10) 1 - -- + - +--R 2 3 +--R 2 +--R Type: PartialFraction Integer +--E 10 + +--S 11 of 12 +g := 2/3 + 4/5*%i +--R +--R +--R 2 4 +--R (11) - + - %i +--R 3 5 +--R Type: Complex Fraction Integer +--E 11 + +--S 12 of 12 +g :: FRAC COMPLEX INT +--R +--R +--R 10 + 12%i +--R (12) --------- +--R 15 +--R Type: Fraction Complex Integer +--E 12 +)spool +)lisp (bye) +@ +<>= +==================================================================== +Fraction examples +==================================================================== + +The Fraction domain implements quotients. The elements must +belong to a domain of category IntegralDomain: multiplication +must be commutative and the product of two non-zero elements must not +be zero. This allows you to make fractions of most things you would +think of, but don't expect to create a fraction of two matrices! The +abbreviation for Fraction is FRAC. + +Use / to create a fraction. + + a := 11/12 + 11 + -- + 12 + Type: Fraction Integer + + b := 23/24 + 23 + -- + 24 + Type: Fraction Integer + +The standard arithmetic operations are available. + + 3 - a*b**2 + a + b/a + 313271 + ------ + 76032 + Type: Fraction Integer + +Extract the numerator and denominator by using numer and denom, +respectively. + + numer(a) + 11 + Type: PositiveInteger + + denom(b) + 24 + Type: PositiveInteger + +Operations like max, min, negative?, positive? and zero? +are all available if they are provided for the numerators and +denominators. + +Don't expect a useful answer from factor, gcd or lcm if you apply +them to fractions. + + r := (x**2 + 2*x + 1)/(x**2 - 2*x + 1) + 2 + x + 2x + 1 + ----------- + 2 + x - 2x + 1 + Type: Fraction Polynomial Integer + +Since all non-zero fractions are invertible, these operations have trivial +definitions. + + factor(r) + 2 + x + 2x + 1 + ----------- + 2 + x - 2x + 1 + Type: Factored Fraction Polynomial Integer + +Use map to apply factor to the numerator and denominator, which is +probably what you mean. + + map(factor,r) + 2 + (x + 1) + -------- + 2 + (x - 1) + Type: Fraction Factored Polynomial Integer + +Other forms of fractions are available. Use continuedFraction to +create a continued fraction. + + continuedFraction(7/12) + 1 | 1 | 1 | 1 | + +---+ + +---+ + +---+ + +---+ + | 1 | 1 | 2 | 2 + Type: ContinuedFraction Integer + +Use partialFraction to create a partial fraction. + + partialFraction(7,12) + 3 1 + 1 - -- + - + 2 3 + 2 + Type: PartialFraction Integer + +Use conversion to create alternative views of fractions with objects +moved in and out of the numerator and denominator. + + g := 2/3 + 4/5*%i + 2 4 + - + - %i + 3 5 + Type: Complex Fraction Integer + + g :: FRAC COMPLEX INT + 10 + 12%i + --------- + 15 + Type: Fraction Complex Integer + +See Also: +o )help ContinuedFraction +o )help PartialFraction +o )help Integer +o )show Fraction +o $AXIOM/doc/src/algebra/fraction.spad.dvi + +@ +\pagehead{Fraction}{FRAC} +\pagepic{ps/v103fraction.ps}{FRAC}{1.00} +See also:\\ +\refto{Localize}{LO} +\refto{LocalAlgebra}{LA} +<>= +)abbrev domain FRAC Fraction +++ Author: +++ Date Created: +++ Date Last Updated: 12 February 1992 +++ Basic Functions: Field, numer, denom +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: fraction, localization +++ References: +++ Description: Fraction takes an IntegralDomain S and produces +++ the domain of Fractions with numerators and denominators from S. +++ If S is also a GcdDomain, then gcd's between numerator and +++ denominator will be cancelled during all operations. +Fraction(S: IntegralDomain): QuotientFieldCategory S with + if S has IntegerNumberSystem and S has OpenMath then OpenMath + if S has canonical and S has GcdDomain and S has canonicalUnitNormal + then canonical + ++ \spad{canonical} means that equal elements are in fact identical. + == LocalAlgebra(S, S, S) add + Rep:= Record(num:S, den:S) + coerce(d:S):% == [d,1] + zero?(x:%) == zero? x.num + + + if S has GcdDomain and S has canonicalUnitNormal then + retract(x:%):S == +-- one?(x.den) => x.num + ((x.den) = 1) => x.num + error "Denominator not equal to 1" + + retractIfCan(x:%):Union(S, "failed") == +-- one?(x.den) => x.num + ((x.den) = 1) => x.num + "failed" + else + retract(x:%):S == + (a:= x.num exquo x.den) case "failed" => + error "Denominator not equal to 1" + a + retractIfCan(x:%):Union(S,"failed") == x.num exquo x.den + + if S has EuclideanDomain then + wholePart x == +-- one?(x.den) => x.num + ((x.den) = 1) => x.num + x.num quo x.den + + if S has IntegerNumberSystem then + + floor x == +-- one?(x.den) => x.num + ((x.den) = 1) => x.num + x < 0 => -ceiling(-x) + wholePart x + + ceiling x == +-- one?(x.den) => x.num + ((x.den) = 1) => x.num + x < 0 => -floor(-x) + 1 + wholePart x + + if S has OpenMath then + -- TODO: somwhere this file does something which redefines the division + -- operator. Doh! + + writeOMFrac(dev: OpenMathDevice, x: %): Void == + OMputApp(dev) + OMputSymbol(dev, "nums1", "rational") + OMwrite(dev, x.num, false) + OMwrite(dev, x.den, false) + OMputEndApp(dev) + + OMwrite(x: %): String == + s: String := "" + sp := OM_-STRINGTOSTRINGPTR(s)$Lisp + dev: OpenMathDevice := _ + OMopenString(sp pretend String, OMencodingXML) + OMputObject(dev) + writeOMFrac(dev, x) + OMputEndObject(dev) + OMclose(dev) + s := OM_-STRINGPTRTOSTRING(sp)$Lisp pretend String + s + + OMwrite(x: %, wholeObj: Boolean): String == + s: String := "" + sp := OM_-STRINGTOSTRINGPTR(s)$Lisp + dev: OpenMathDevice := _ + OMopenString(sp pretend String, OMencodingXML) + if wholeObj then + OMputObject(dev) + writeOMFrac(dev, x) + if wholeObj then + OMputEndObject(dev) + OMclose(dev) + s := OM_-STRINGPTRTOSTRING(sp)$Lisp pretend String + s + + OMwrite(dev: OpenMathDevice, x: %): Void == + OMputObject(dev) + writeOMFrac(dev, x) + OMputEndObject(dev) + + OMwrite(dev: OpenMathDevice, x: %, wholeObj: Boolean): Void == + if wholeObj then + OMputObject(dev) + writeOMFrac(dev, x) + if wholeObj then + OMputEndObject(dev) + + if S has GcdDomain then + cancelGcd: % -> S + normalize: % -> % + + normalize x == + zero?(x.num) => 0 +-- one?(x.den) => x + ((x.den) = 1) => x + uca := unitNormal(x.den) + zero?(x.den := uca.canonical) => error "division by zero" + x.num := x.num * uca.associate + x + + recip x == + zero?(x.num) => "failed" + normalize [x.den, x.num] + + cancelGcd x == +-- one?(x.den) => x.den + ((x.den) = 1) => x.den + d := gcd(x.num, x.den) + xn := x.num exquo d + xn case "failed" => + error "gcd not gcd in QF cancelGcd (numerator)" + xd := x.den exquo d + xd case "failed" => + error "gcd not gcd in QF cancelGcd (denominator)" + x.num := xn :: S + x.den := xd :: S + d + + nn:S / dd:S == + zero? dd => error "division by zero" + cancelGcd(z := [nn, dd]) + normalize z + + x + y == + zero? y => x + zero? x => y + z := [x.den,y.den] + d := cancelGcd z + g := [z.den * x.num + z.num * y.num, d] + cancelGcd g + g.den := g.den * z.num * z.den + normalize g + + -- We can not rely on the defaulting mechanism + -- to supply a definition for -, even though this + -- definition would do, for thefollowing reasons: + -- 1) The user could have defined a subtraction + -- in Localize, which would not work for + -- QuotientField; + -- 2) even if he doesn't, the system currently + -- places a default definition in Localize, + -- which uses Localize's +, which does not + -- cancel gcds + x - y == + zero? y => x + z := [x.den, y.den] + d := cancelGcd z + g := [z.den * x.num - z.num * y.num, d] + cancelGcd g + g.den := g.den * z.num * z.den + normalize g + + x:% * y:% == + zero? x or zero? y => 0 +-- one? x => y + (x = 1) => y +-- one? y => x + (y = 1) => x + (x, y) := ([x.num, y.den], [y.num, x.den]) + cancelGcd x; cancelGcd y; + normalize [x.num * y.num, x.den * y.den] + + n:Integer * x:% == + y := [n::S, x.den] + cancelGcd y + normalize [x.num * y.num, y.den] + + nn:S * x:% == + y := [nn, x.den] + cancelGcd y + normalize [x.num * y.num, y.den] + + differentiate(x:%, deriv:S -> S) == + y := [deriv(x.den), x.den] + d := cancelGcd(y) + y.num := deriv(x.num) * y.den - x.num * y.num + (d, y.den) := (y.den, d) + cancelGcd y + y.den := y.den * d * d + normalize y + + if S has canonicalUnitNormal then + x = y == (x.num = y.num) and (x.den = y.den) + --x / dd == (cancelGcd (z:=[x.num,dd*x.den]); normalize z) + +-- one? x == one? (x.num) and one? (x.den) + one? x == ((x.num) = 1) and ((x.den) = 1) + -- again assuming canonical nature of representation + + else + nn:S/dd:S == if zero? dd then error "division by zero" else [nn,dd] + + recip x == + zero?(x.num) => "failed" + [x.den, x.num] + + if (S has RetractableTo Fraction Integer) then + retract(x:%):Fraction(Integer) == retract(retract(x)@S) + + retractIfCan(x:%):Union(Fraction Integer, "failed") == + (u := retractIfCan(x)@Union(S, "failed")) case "failed" => "failed" + retractIfCan(u::S) + + else if (S has RetractableTo Integer) then + retract(x:%):Fraction(Integer) == + retract(numer x) / retract(denom x) + + retractIfCan(x:%):Union(Fraction Integer, "failed") == + (n := retractIfCan numer x) case "failed" => "failed" + (d := retractIfCan denom x) case "failed" => "failed" + (n::Integer) / (d::Integer) + + QFP ==> SparseUnivariatePolynomial % + DP ==> SparseUnivariatePolynomial S + import UnivariatePolynomialCategoryFunctions2(%,QFP,S,DP) + import UnivariatePolynomialCategoryFunctions2(S,DP,%,QFP) + + if S has GcdDomain then + gcdPolynomial(pp,qq) == + zero? pp => qq + zero? qq => pp + zero? degree pp or zero? degree qq => 1 + denpp:="lcm"/[denom u for u in coefficients pp] + ppD:DP:=map(retract(#1*denpp),pp) + denqq:="lcm"/[denom u for u in coefficients qq] + qqD:DP:=map(retract(#1*denqq),qq) + g:=gcdPolynomial(ppD,qqD) + zero? degree g => 1 +-- one? (lc:=leadingCoefficient g) => map(#1::%,g) + ((lc:=leadingCoefficient g) = 1) => map(#1::%,g) + map(#1 / lc,g) + + if (S has PolynomialFactorizationExplicit) then + -- we'll let the solveLinearPolynomialEquations operator + -- default from Field + pp,qq: QFP + lpp: List QFP + import Factored SparseUnivariatePolynomial % + if S has CharacteristicNonZero then + if S has canonicalUnitNormal and S has GcdDomain then + charthRoot x == + n:= charthRoot x.num + n case "failed" => "failed" + d:=charthRoot x.den + d case "failed" => "failed" + n/d + else + charthRoot x == + -- to find x = p-th root of n/d + -- observe that xd is p-th root of n*d**(p-1) + ans:=charthRoot(x.num * + (x.den)**(characteristic()$%-1)::NonNegativeInteger) + ans case "failed" => "failed" + ans / x.den + clear: List % -> List S + clear l == + d:="lcm"/[x.den for x in l] + [ x.num * (d exquo x.den)::S for x in l] + mat: Matrix % + conditionP mat == + matD: Matrix S + matD:= matrix [ clear l for l in listOfLists mat ] + ansD := conditionP matD + ansD case "failed" => "failed" + ansDD:=ansD :: Vector(S) + [ ansDD(i)::% for i in 1..#ansDD]$Vector(%) + + factorPolynomial(pp) == + zero? pp => 0 + denpp:="lcm"/[denom u for u in coefficients pp] + ppD:DP:=map(retract(#1*denpp),pp) + ff:=factorPolynomial ppD + den1:%:=denpp::% + lfact:List Record(flg:Union("nil", "sqfr", "irred", "prime"), + fctr:QFP, xpnt:Integer) + lfact:= [[w.flg, + if leadingCoefficient w.fctr =1 then map(#1::%,w.fctr) + else (lc:=(leadingCoefficient w.fctr)::%; + den1:=den1/lc**w.xpnt; + map(#1::%/lc,w.fctr)), + w.xpnt] for w in factorList ff] + makeFR(map(#1::%/den1,unit(ff)),lfact) + factorSquareFreePolynomial(pp) == + zero? pp => 0 + degree pp = 0 => makeFR(pp,empty()) + lcpp:=leadingCoefficient pp + pp:=pp/lcpp + denpp:="lcm"/[denom u for u in coefficients pp] + ppD:DP:=map(retract(#1*denpp),pp) + ff:=factorSquareFreePolynomial ppD + den1:%:=denpp::%/lcpp + lfact:List Record(flg:Union("nil", "sqfr", "irred", "prime"), + fctr:QFP, xpnt:Integer) + lfact:= [[w.flg, + if leadingCoefficient w.fctr =1 then map(#1::%,w.fctr) + else (lc:=(leadingCoefficient w.fctr)::%; + den1:=den1/lc**w.xpnt; + map(#1::%/lc,w.fctr)), + w.xpnt] for w in factorList ff] + makeFR(map(#1::%/den1,unit(ff)),lfact) + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{domain FRIDEAL FractionalIdeal} \pagehead{FractionalIdeal}{FRIDEAL} \pagepic{ps/v103fractionalideal.ps}{FRIDEAL}{1.00} @@ -16667,6 +23997,1126 @@ FramedModule(R, F, UP, A, ibasis): Exports == Implementation where @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain FAGROUP FreeAbelianGroup} +\pagehead{FreeAbelianGroup}{FAGROUP} +\pagepic{ps/v103freeabeliangroup.ps}{FAGROUP}{1.00} +See also:\\ +\refto{ListMonoidOps}{LMOPS} +\refto{FreeMonoid}{FMONOID} +\refto{FreeGroup}{FGROUP} +\refto{InnerFreeAbelianMonoid}{IFAMON} +\refto{FreeAbelianMonoid}{FAMONOID} +<>= +)abbrev domain FAGROUP FreeAbelianGroup +++ Free abelian group on any set of generators +++ Author: Manuel Bronstein +++ Date Created: November 1989 +++ Date Last Updated: 6 June 1991 +++ Description: +++ The free abelian group on a set S is the monoid of finite sums of +++ the form \spad{reduce(+,[ni * si])} where the si's are in S, and the ni's +++ are integers. The operation is commutative. +FreeAbelianGroup(S:SetCategory): Exports == Implementation where + Exports ==> Join(AbelianGroup, Module Integer, + FreeAbelianMonoidCategory(S, Integer)) with + if S has OrderedSet then OrderedSet + + Implementation ==> InnerFreeAbelianMonoid(S, Integer, 1) add + - f == mapCoef("-", f) + + if S has OrderedSet then + inmax: List Record(gen: S, exp: Integer) -> Record(gen: S, exp:Integer) + + inmax l == + mx := first l + for t in rest l repeat + if mx.gen < t.gen then mx := t + mx + + -- lexicographic order + a < b == + zero? a => + zero? b => false + 0 < (inmax terms b).exp + ta := inmax terms a + zero? b => ta.exp < 0 + tb := inmax terms b + ta.gen < tb.gen => 0 < tb.exp + tb.gen < ta.gen => ta.exp < 0 + ta.exp < tb.exp => true + tb.exp < ta.exp => false + lc := ta.exp * ta.gen + (a - lc) < (b - lc) + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain FAMONOID FreeAbelianMonoid} +\pagehead{FreeAbelianMonoid}{FAMONOID} +\pagepic{ps/v103freeabelianmonoid.ps}{FAMONOID}{1.00} +See also:\\ +\refto{ListMonoidOps}{LMOPS} +\refto{FreeMonoid}{FMONOID} +\refto{FreeGroup}{FGROUP} +\refto{InnerFreeAbelianMonoid}{IFAMON} +\refto{FreeAbelianGroup}{FAGROUP} +<>= +)abbrev domain FAMONOID FreeAbelianMonoid +++ Free abelian monoid on any set of generators +++ Author: Manuel Bronstein +++ Date Created: November 1989 +++ Date Last Updated: 6 June 1991 +++ Description: +++ The free abelian monoid on a set S is the monoid of finite sums of +++ the form \spad{reduce(+,[ni * si])} where the si's are in S, and the ni's +++ are non-negative integers. The operation is commutative. +FreeAbelianMonoid(S: SetCategory): + FreeAbelianMonoidCategory(S, NonNegativeInteger) + == InnerFreeAbelianMonoid(S, NonNegativeInteger, 1) + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain FGROUP FreeGroup} +\pagehead{FreeGroup}{FGROUP} +\pagepic{ps/v103freegroup.ps}{FGROUP}{1.00} +See also:\\ +\refto{ListMonoidOps}{LMOPS} +\refto{FreeMonoid}{FMONOID} +\refto{InnerFreeAbelianMonoid}{IFAMON} +\refto{FreeAbelianMonoid}{FAMONOID} +\refto{FreeAbelianGroup}{FAGROUP} +<>= +)abbrev domain FGROUP FreeGroup +++ Free group on any set of generators +++ Author: Stephen M. Watt +++ Date Created: ??? +++ Date Last Updated: 6 June 1991 +++ Description: +++ The free group on a set S is the group of finite products of +++ the form \spad{reduce(*,[si ** ni])} where the si's are in S, and the ni's +++ are integers. The multiplication is not commutative. +FreeGroup(S: SetCategory): Join(Group, RetractableTo S) with + "*": (S, $) -> $ + ++ s * x returns the product of x by s on the left. + "*": ($, S) -> $ + ++ x * s returns the product of x by s on the right. + "**" : (S, Integer) -> $ + ++ s ** n returns the product of s by itself n times. + size : $ -> NonNegativeInteger + ++ size(x) returns the number of monomials in x. + nthExpon : ($, Integer) -> Integer + ++ nthExpon(x, n) returns the exponent of the n^th monomial of x. + nthFactor : ($, Integer) -> S + ++ nthFactor(x, n) returns the factor of the n^th monomial of x. + mapExpon : (Integer -> Integer, $) -> $ + ++ mapExpon(f, a1\^e1 ... an\^en) returns \spad{a1\^f(e1) ... an\^f(en)}. + mapGen : (S -> S, $) -> $ + ++ mapGen(f, a1\^e1 ... an\^en) returns \spad{f(a1)\^e1 ... f(an)\^en}. + factors : $ -> List Record(gen: S, exp: Integer) + ++ factors(a1\^e1,...,an\^en) returns \spad{[[a1, e1],...,[an, en]]}. + == ListMonoidOps(S, Integer, 1) add + Rep := ListMonoidOps(S, Integer, 1) + + 1 == makeUnit() + one? f == empty? listOfMonoms f + s:S ** n:Integer == makeTerm(s, n) + f:$ * s:S == rightMult(f, s) + s:S * f:$ == leftMult(s, f) + inv f == reverse_! mapExpon("-", f) + factors f == copy listOfMonoms f + mapExpon(f, x) == mapExpon(f, x)$Rep + mapGen(f, x) == mapGen(f, x)$Rep + coerce(f:$):OutputForm == outputForm(f, "*", "**", 1) + + f:$ * g:$ == + one? f => g + one? g => f + r := reverse listOfMonoms f + q := copy listOfMonoms g + while not empty? r and not empty? q and r.first.gen = q.first.gen + and r.first.exp = -q.first.exp repeat + r := rest r + q := rest q + empty? r => makeMulti q + empty? q => makeMulti reverse_! r + r.first.gen = q.first.gen => + setlast_!(h := reverse_! r, + [q.first.gen, q.first.exp + r.first.exp]) + makeMulti concat_!(h, rest q) + makeMulti concat_!(reverse_! r, q) + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain FMONOID FreeMonoid} +\pagehead{FreeMonoid}{FMONOID} +\pagepic{ps/v103freemonoid.ps}{FMONOID}{1.00} +See also:\\ +\refto{ListMonoidOps}{LMOPS} +\refto{FreeGroup}{FGROUP} +\refto{InnerFreeAbelianMonoid}{IFAMON} +\refto{FreeAbelianMonoid}{FAMONOID} +\refto{FreeAbelianGroup}{FAGROUP} +<>= +)abbrev domain FMONOID FreeMonoid +++ Free monoid on any set of generators +++ Author: Stephen M. Watt +++ Date Created: ??? +++ Date Last Updated: 6 June 1991 +++ Description: +++ The free monoid on a set S is the monoid of finite products of +++ the form \spad{reduce(*,[si ** ni])} where the si's are in S, and the ni's +++ are nonnegative integers. The multiplication is not commutative. +FreeMonoid(S: SetCategory): FMcategory == FMdefinition where + NNI ==> NonNegativeInteger + REC ==> Record(gen: S, exp: NonNegativeInteger) + Ex ==> OutputForm + + FMcategory ==> Join(Monoid, RetractableTo S) with + "*": (S, $) -> $ + ++ s * x returns the product of x by s on the left. + "*": ($, S) -> $ + ++ x * s returns the product of x by s on the right. + "**": (S, NonNegativeInteger) -> $ + ++ s ** n returns the product of s by itself n times. + hclf: ($, $) -> $ + ++ hclf(x, y) returns the highest common left factor of x and y, + ++ i.e. the largest d such that \spad{x = d a} and \spad{y = d b}. + hcrf: ($, $) -> $ + ++ hcrf(x, y) returns the highest common right factor of x and y, + ++ i.e. the largest d such that \spad{x = a d} and \spad{y = b d}. + lquo: ($, $) -> Union($, "failed") + ++ lquo(x, y) returns the exact left quotient of x by y i.e. + ++ q such that \spad{x = y * q}, + ++ "failed" if x is not of the form \spad{y * q}. + rquo: ($, $) -> Union($, "failed") + ++ rquo(x, y) returns the exact right quotient of x by y i.e. + ++ q such that \spad{x = q * y}, + ++ "failed" if x is not of the form \spad{q * y}. + divide: ($, $) -> Union(Record(lm: $, rm: $), "failed") + ++ divide(x, y) returns the left and right exact quotients of + ++ x by y, i.e. \spad{[l, r]} such that \spad{x = l * y * r}, + ++ "failed" if x is not of the form \spad{l * y * r}. + overlap: ($, $) -> Record(lm: $, mm: $, rm: $) + ++ overlap(x, y) returns \spad{[l, m, r]} such that + ++ \spad{x = l * m}, \spad{y = m * r} and l and r have no overlap, + ++ i.e. \spad{overlap(l, r) = [l, 1, r]}. + size : $ -> NNI + ++ size(x) returns the number of monomials in x. + factors : $ -> List Record(gen: S, exp: NonNegativeInteger) + ++ factors(a1\^e1,...,an\^en) returns \spad{[[a1, e1],...,[an, en]]}. + nthExpon : ($, Integer) -> NonNegativeInteger + ++ nthExpon(x, n) returns the exponent of the n^th monomial of x. + nthFactor : ($, Integer) -> S + ++ nthFactor(x, n) returns the factor of the n^th monomial of x. + mapExpon : (NNI -> NNI, $) -> $ + ++ mapExpon(f, a1\^e1 ... an\^en) returns \spad{a1\^f(e1) ... an\^f(en)}. + mapGen : (S -> S, $) -> $ + ++ mapGen(f, a1\^e1 ... an\^en) returns \spad{f(a1)\^e1 ... f(an)\^en}. + if S has OrderedSet then OrderedSet + + FMdefinition ==> ListMonoidOps(S, NonNegativeInteger, 1) add + Rep := ListMonoidOps(S, NonNegativeInteger, 1) + + 1 == makeUnit() + one? f == empty? listOfMonoms f + coerce(f:$): Ex == outputForm(f, "*", "**", 1) + hcrf(f, g) == reverse_! hclf(reverse f, reverse g) + f:$ * s:S == rightMult(f, s) + s:S * f:$ == leftMult(s, f) + factors f == copy listOfMonoms f + mapExpon(f, x) == mapExpon(f, x)$Rep + mapGen(f, x) == mapGen(f, x)$Rep + s:S ** n:NonNegativeInteger == makeTerm(s, n) + + f:$ * g:$ == +-- one? f => g + (f = 1) => g +-- one? g => f + (g = 1) => f + lg := listOfMonoms g + ls := last(lf := listOfMonoms f) + ls.gen = lg.first.gen => + setlast_!(h := copy lf,[lg.first.gen,lg.first.exp+ls.exp]) + makeMulti concat(h, rest lg) + makeMulti concat(lf, lg) + + overlap(la, ar) == +-- one? la or one? ar => [la, 1, ar] + (la = 1) or (ar = 1) => [la, 1, ar] + lla := la0 := listOfMonoms la + lar := listOfMonoms ar + l:List(REC) := empty() + while not empty? lla repeat + if lla.first.gen = lar.first.gen then + if lla.first.exp < lar.first.exp and empty? rest lla then + return [makeMulti l, + makeTerm(lla.first.gen, lla.first.exp), + makeMulti concat([lar.first.gen, + (lar.first.exp - lla.first.exp)::NNI], + rest lar)] + if lla.first.exp >= lar.first.exp then + if (ru:= lquo(makeMulti rest lar, + makeMulti rest lla)) case $ then + if lla.first.exp > lar.first.exp then + l := concat_!(l, [lla.first.gen, + (lla.first.exp - lar.first.exp)::NNI]) + m := concat([lla.first.gen, lar.first.exp], + rest lla) + else m := lla + return [makeMulti l, makeMulti m, ru::$] + l := concat_!(l, lla.first) + lla := rest lla + [makeMulti la0, 1, makeMulti lar] + + divide(lar, a) == +-- one? a => [lar, 1] + (a = 1) => [lar, 1] + Na : Integer := #(la := listOfMonoms a) + Nlar : Integer := #(llar := listOfMonoms lar) + l:List(REC) := empty() + while Na <= Nlar repeat + if llar.first.gen = la.first.gen and + llar.first.exp >= la.first.exp then + -- Can match a portion of this lar factor. + -- Now match tail. + (q:=lquo(makeMulti rest llar,makeMulti rest la))case $ => + if llar.first.exp > la.first.exp then + l := concat_!(l, [la.first.gen, + (llar.first.exp - la.first.exp)::NNI]) + return [makeMulti l, q::$] + l := concat_!(l, first llar) + llar := rest llar + Nlar := Nlar - 1 + "failed" + + hclf(f, g) == + h:List(REC) := empty() + for f0 in listOfMonoms f for g0 in listOfMonoms g repeat + f0.gen ^= g0.gen => return makeMulti h + h := concat_!(h, [f0.gen, min(f0.exp, g0.exp)]) + f0.exp ^= g0.exp => return makeMulti h + makeMulti h + + lquo(aq, a) == + size a > #(laq := copy listOfMonoms aq) => "failed" + for a0 in listOfMonoms a repeat + a0.gen ^= laq.first.gen or a0.exp > laq.first.exp => + return "failed" + if a0.exp = laq.first.exp then laq := rest laq + else setfirst_!(laq, [laq.first.gen, + (laq.first.exp - a0.exp)::NNI]) + makeMulti laq + + rquo(qa, a) == + (u := lquo(reverse qa, reverse a)) case "failed" => "failed" + reverse_!(u::$) + + if S has OrderedSet then + a < b == + la := listOfMonoms a + lb := listOfMonoms b + na: Integer := #la + nb: Integer := #lb + while na > 0 and nb > 0 repeat + la.first.gen > lb.first.gen => return false + la.first.gen < lb.first.gen => return true + if la.first.exp = lb.first.exp then + la:=rest la + lb:=rest lb + na:=na - 1 + nb:=nb - 1 + else if la.first.exp > lb.first.exp then + la:=concat([la.first.gen, + (la.first.exp - lb.first.exp)::NNI], rest lb) + lb:=rest lb + nb:=nb - 1 + else + lb:=concat([lb.first.gen, + (lb.first.exp-la.first.exp)::NNI], rest la) + la:=rest la + na:=na-1 + empty? la and not empty? lb + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain FNLA FreeNilpotentLie} +\pagehead{FreeNilpotentLie}{FNLA} +\pagepic{ps/v103freenilpotentlie.ps}{FNLA}{1.00} +See also:\\ +\refto{OrdSetInts}{OSI} +\refto{Commutator}{COMM} +<>= +)abbrev domain FNLA FreeNilpotentLie +++ Author: Larry Lambe +++ Date Created: July 1988 +++ Date Last Updated: March 13 1991 +++ Related Constructors: OrderedSetInts, Commutator +++ AMS Classification: Primary 17B05, 17B30; Secondary 17A50 +++ Keywords: free Lie algebra, Hall basis, basic commutators +++ Related Constructors: HallBasis, FreeMod, Commutator, OrdSetInts +++ Description: Generate the Free Lie Algebra over a ring R with identity; +++ A P. Hall basis is generated by a package call to HallBasis. + +FreeNilpotentLie(n:NNI,class:NNI,R: CommutativeRing): Export == Implement where + B ==> Boolean + Com ==> Commutator + HB ==> HallBasis + I ==> Integer + NNI ==> NonNegativeInteger + O ==> OutputForm + OSI ==> OrdSetInts + FM ==> FreeModule(R,OSI) + VI ==> Vector Integer + VLI ==> Vector List Integer + lC ==> leadingCoefficient + lS ==> leadingSupport + + Export ==> NonAssociativeAlgebra(R) with + dimension : () -> NNI + ++ dimension() is the rank of this Lie algebra + deepExpand : % -> O + ++ deepExpand(x) \undocumented{} + shallowExpand : % -> O + ++ shallowExpand(x) \undocumented{} + generator : NNI -> % + ++ generator(i) is the ith Hall Basis element + + Implement ==> FM add + Rep := FM + f,g : % + + coms:VLI + coms := generate(n,class)$HB + + dimension == #coms + + have : (I,I) -> % + -- have(left,right) is a lookup function for basic commutators + -- already generated; if the nth basic commutator is + -- [left,wt,right], then have(left,right) = n + have(i,j) == + wt:I := coms(i).2 + coms(j).2 + wt > class => 0 + lo:I := 1 + hi:I := dimension + while hi-lo > 1 repeat + mid:I := (hi+lo) quo 2 + if coms(mid).2 < wt then lo := mid else hi := mid + while coms(hi).1 < i repeat hi := hi + 1 + while coms(hi).3 < j repeat hi := hi + 1 + monomial(1,hi::OSI)$FM + + generator(i) == + i > dimension => 0$Rep + monomial(1,i::OSI)$FM + + putIn : I -> % + putIn(i) == + monomial(1$R,i::OSI)$FM + + brkt : (I,%) -> % + brkt(k,f) == + f = 0 => 0 + dg:I := value lS f + reductum(f) = 0 => + k = dg => 0 + k > dg => -lC(f)*brkt(dg, putIn(k)) + inHallBasis?(n,k,dg,coms(dg).1) => lC(f)*have(k, dg) + lC(f)*( brkt(coms(dg).1, _ + brkt(k,putIn coms(dg).3)) - brkt(coms(dg).3, _ + brkt(k,putIn coms(dg).1) )) + brkt(k,monomial(lC f,lS f)$FM)+brkt(k,reductum f) + + f*g == + reductum(f) = 0 => + lC(f)*brkt(value(lS f),g) + monomial(lC f,lS f)$FM*g + reductum(f)*g + + Fac : I -> Com + -- an auxilliary function used for output of Free Lie algebra + -- elements (see expand) + Fac(m) == + coms(m).1 = 0 => mkcomm(m)$Com + mkcomm(Fac coms(m).1, Fac coms(m).3) + + shallowE : (R,OSI) -> O + shallowE(r,s) == + k := value s + r = 1 => + k <= n => s::O + mkcomm(mkcomm(coms(k).1)$Com,mkcomm(coms(k).3)$Com)$Com::O + k <= n => r::O * s::O + r::O * mkcomm(mkcomm(coms(k).1)$Com,mkcomm(coms(k).3)$Com)$Com::O + + shallowExpand(f) == + f = 0 => 0::O + reductum(f) = 0 => shallowE(lC f,lS f) + shallowE(lC f,lS f) + shallowExpand(reductum f) + + deepExpand(f) == + f = 0 => 0::O + reductum(f) = 0 => + lC(f)=1 => Fac(value(lS f))::O + lC(f)::O * Fac(value(lS f))::O + lC(f)=1 => Fac(value(lS f))::O + deepExpand(reductum f) + lC(f)::O * Fac(value(lS f))::O + deepExpand(reductum f) + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain FPARFRAC FullPartialFractionExpansion} +<>= +-- fparfrac.spad.pamphlet FullPartialFractionExpansion.input +)spool FullPartialFractionExpansion.output +)set message test on +)set message auto off +)clear all +--S 1 of 16 +Fx := FRAC UP(x, FRAC INT) +--R +--R +--R (1) Fraction UnivariatePolynomial(x,Fraction Integer) +--R Type: Domain +--E 1 + +--S 2 of 16 +f : Fx := 36 / (x**5-2*x**4-2*x**3+4*x**2+x-2) +--R +--R +--R 36 +--R (2) ---------------------------- +--R 5 4 3 2 +--R x - 2x - 2x + 4x + x - 2 +--R Type: Fraction UnivariatePolynomial(x,Fraction Integer) +--E 2 + +--S 3 of 16 +g := fullPartialFraction f +--R +--R +--R 4 4 --+ - 3%A - 6 +--R (3) ----- - ----- + > --------- +--R x - 2 x + 1 --+ 2 +--R 2 (x - %A) +--R %A - 1= 0 +--RType: FullPartialFractionExpansion(Fraction Integer,UnivariatePolynomial(x,Fraction Integer)) +--E 3 + +--S 4 of 16 +g :: Fx +--R +--R +--R 36 +--R (4) ---------------------------- +--R 5 4 3 2 +--R x - 2x - 2x + 4x + x - 2 +--R Type: Fraction UnivariatePolynomial(x,Fraction Integer) +--E 4 + +--S 5 of 16 +g5 := D(g, 5) +--R +--R +--R 480 480 --+ 2160%A + 4320 +--R (5) - -------- + -------- + > ------------- +--R 6 6 --+ 7 +--R (x - 2) (x + 1) 2 (x - %A) +--R %A - 1= 0 +--RType: FullPartialFractionExpansion(Fraction Integer,UnivariatePolynomial(x,Fraction Integer)) +--E 5 + +--S 6 of 16 +f5 := D(f, 5) +--R +--R +--R (6) +--R 10 9 8 7 6 +--R - 544320x + 4354560x - 14696640x + 28615680x - 40085280x +--R + +--R 5 4 3 2 +--R 46656000x - 39411360x + 18247680x - 5870880x + 3317760x + 246240 +--R / +--R 20 19 18 17 16 15 14 13 +--R x - 12x + 53x - 76x - 159x + 676x - 391x - 1596x +--R + +--R 12 11 10 9 8 7 6 5 +--R 2527x + 1148x - 4977x + 1372x + 4907x - 3444x - 2381x + 2924x +--R + +--R 4 3 2 +--R 276x - 1184x + 208x + 192x - 64 +--R Type: Fraction UnivariatePolynomial(x,Fraction Integer) +--E 6 + +--S 7 of 16 +g5::Fx - f5 +--R +--R +--R (7) 0 +--R Type: Fraction UnivariatePolynomial(x,Fraction Integer) +--E 7 + +--S 8 of 16 +f : Fx := (x**5 * (x-1)) / ((x**2 + x + 1)**2 * (x-2)**3) +--R +--R +--R 6 5 +--R x - x +--R (8) ----------------------------------- +--R 7 6 5 3 2 +--R x - 4x + 3x + 9x - 6x - 4x - 8 +--R Type: Fraction UnivariatePolynomial(x,Fraction Integer) +--E 8 + +--S 9 of 16 +g := fullPartialFraction f +--R +--R +--R (9) +--R 1952 464 32 179 135 +--R ---- --- -- - ---- %A + ---- +--R 2401 343 49 --+ 2401 2401 +--R ------ + -------- + -------- + > ---------------- +--R x - 2 2 3 --+ x - %A +--R (x - 2) (x - 2) 2 +--R %A + %A + 1= 0 +--R + +--R 37 20 +--R ---- %A + ---- +--R --+ 1029 1029 +--R > -------------- +--R --+ 2 +--R 2 (x - %A) +--R %A + %A + 1= 0 +--RType: FullPartialFractionExpansion(Fraction Integer,UnivariatePolynomial(x,Fraction Integer)) +--E 9 + +--S 10 of 16 +g :: Fx - f +--R +--R +--R (10) 0 +--R Type: Fraction UnivariatePolynomial(x,Fraction Integer) +--E 10 + +--S 11 of 16 +f : Fx := (2*x**7-7*x**5+26*x**3+8*x) / (x**8-5*x**6+6*x**4+4*x**2-8) +--R +--R +--R 7 5 3 +--R 2x - 7x + 26x + 8x +--R (11) ------------------------ +--R 8 6 4 2 +--R x - 5x + 6x + 4x - 8 +--R Type: Fraction UnivariatePolynomial(x,Fraction Integer) +--E 11 + +--S 12 of 16 +g := fullPartialFraction f +--R +--R +--R 1 1 +--R - - +--R --+ 2 --+ 1 --+ 2 +--R (12) > ------ + > --------- + > ------ +--R --+ x - %A --+ 3 --+ x - %A +--R 2 2 (x - %A) 2 +--R %A - 2= 0 %A - 2= 0 %A + 1= 0 +--RType: FullPartialFractionExpansion(Fraction Integer,UnivariatePolynomial(x,Fraction Integer)) +--E 12 + +--S 13 of 16 +g :: Fx - f +--R +--R +--R (13) 0 +--R Type: Fraction UnivariatePolynomial(x,Fraction Integer) +--E 13 + +--S 14 of 16 +f:Fx := x**3 / (x**21 + 2*x**20 + 4*x**19 + 7*x**18 + 10*x**17 + 17*x**16 + 22*x**15 + 30*x**14 + 36*x**13 + 40*x**12 + 47*x**11 + 46*x**10 + 49*x**9 + 43*x**8 + 38*x**7 + 32*x**6 + 23*x**5 + 19*x**4 + 10*x**3 + 7*x**2 + 2*x + 1) +--R +--R +--R (14) +--R 3 +--R x +--R / +--R 21 20 19 18 17 16 15 14 13 12 +--R x + 2x + 4x + 7x + 10x + 17x + 22x + 30x + 36x + 40x +--R + +--R 11 10 9 8 7 6 5 4 3 2 +--R 47x + 46x + 49x + 43x + 38x + 32x + 23x + 19x + 10x + 7x + 2x +--R + +--R 1 +--R Type: Fraction UnivariatePolynomial(x,Fraction Integer) +--E 14 + +--S 15 of 16 +g := fullPartialFraction f +--R +--R +--R (15) +--R 1 1 19 +--R - %A - %A - -- +--R --+ 2 --+ 9 27 +--R > ------ + > --------- +--R --+ x - %A --+ x - %A +--R 2 2 +--R %A + 1= 0 %A + %A + 1= 0 +--R + +--R 1 1 +--R -- %A - -- +--R --+ 27 27 +--R > ---------- +--R --+ 2 +--R 2 (x - %A) +--R %A + %A + 1= 0 +--R + +--R SIGMA +--R 5 2 +--R %A + %A + 1= 0 +--R , +--R 96556567040 4 420961732891 3 59101056149 2 +--R - ------------ %A + ------------ %A - ------------ %A +--R 912390759099 912390759099 912390759099 +--R + +--R 373545875923 529673492498 +--R - ------------ %A + ------------ +--R 912390759099 912390759099 +--R / +--R x - %A +--R + +--R SIGMA +--R 5 2 +--R %A + %A + 1= 0 +--R , +--R 5580868 4 2024443 3 4321919 2 84614 5070620 +--R - -------- %A - -------- %A + -------- %A - ------- %A - -------- +--R 94070601 94070601 94070601 1542141 94070601 +--R -------------------------------------------------------------------- +--R 2 +--R (x - %A) +--R + +--R SIGMA +--R 5 2 +--R %A + %A + 1= 0 +--R , +--R 1610957 4 2763014 3 2016775 2 266953 4529359 +--R -------- %A + -------- %A - -------- %A + -------- %A + -------- +--R 94070601 94070601 94070601 94070601 94070601 +--R ------------------------------------------------------------------- +--R 3 +--R (x - %A) +--RType: FullPartialFractionExpansion(Fraction Integer,UnivariatePolynomial(x,Fraction Integer)) +--E 15 + +--S 16 of 16 +g :: Fx - f +--R +--R +--R (16) 0 +--R Type: Fraction UnivariatePolynomial(x,Fraction Integer) +--E 16 +)spool +)lisp (bye) +@ +<>= +==================================================================== +FullPartialFractionExpansion expansion +==================================================================== + +The domain FullPartialFractionExpansion implements factor-free +conversion of quotients to full partial fractions. + +Our examples will all involve quotients of univariate polynomials +with rational number coefficients. + + Fx := FRAC UP(x, FRAC INT) + Fraction UnivariatePolynomial(x,Fraction Integer) + Type: Domain + +Here is a simple-looking rational function. + + f : Fx := 36 / (x**5-2*x**4-2*x**3+4*x**2+x-2) + 36 + ---------------------------- + 5 4 3 2 + x - 2x - 2x + 4x + x - 2 + Type: Fraction UnivariatePolynomial(x,Fraction Integer) + +We use fullPartialFraction to convert it to an object of type +FullPartialFractionExpansion. + + g := fullPartialFraction f + 4 4 --+ - 3%A - 6 + ----- - ----- + > --------- + x - 2 x + 1 --+ 2 + 2 (x - %A) + %A - 1= 0 +Type: FullPartialFractionExpansion(Fraction Integer, + UnivariatePolynomial(x,Fraction Integer)) + +Use a coercion to change it back into a quotient. + + g :: Fx + 36 + ---------------------------- + 5 4 3 2 + x - 2x - 2x + 4x + x - 2 + Type: Fraction UnivariatePolynomial(x,Fraction Integer) + +Full partial fractions differentiate faster than rational functions. + + g5 := D(g, 5) + 480 480 --+ 2160%A + 4320 + - -------- + -------- + > ------------- + 6 6 --+ 7 + (x - 2) (x + 1) 2 (x - %A) + %A - 1= 0 +Type: FullPartialFractionExpansion(Fraction Integer, + UnivariatePolynomial(x,Fraction Integer)) + + f5 := D(f, 5) + 10 9 8 7 6 + - 544320x + 4354560x - 14696640x + 28615680x - 40085280x + + + 5 4 3 2 + 46656000x - 39411360x + 18247680x - 5870880x + 3317760x + 246240 + / + 20 19 18 17 16 15 14 13 + x - 12x + 53x - 76x - 159x + 676x - 391x - 1596x + + + 12 11 10 9 8 7 6 5 + 2527x + 1148x - 4977x + 1372x + 4907x - 3444x - 2381x + 2924x + + + 4 3 2 + 276x - 1184x + 208x + 192x - 64 + Type: Fraction UnivariatePolynomial(x,Fraction Integer) + +We can check that the two forms represent the same function. + + g5::Fx - f5 + 0 + Type: Fraction UnivariatePolynomial(x,Fraction Integer) + +Here are some examples that are more complicated. + + f : Fx := (x**5 * (x-1)) / ((x**2 + x + 1)**2 * (x-2)**3) + 6 5 + x - x + ----------------------------------- + 7 6 5 3 2 + x - 4x + 3x + 9x - 6x - 4x - 8 + Type: Fraction UnivariatePolynomial(x,Fraction Integer) + + g := fullPartialFraction f + 1952 464 32 179 135 + ---- --- -- - ---- %A + ---- + 2401 343 49 --+ 2401 2401 + ------ + -------- + -------- + > ---------------- + x - 2 2 3 --+ x - %A + (x - 2) (x - 2) 2 + %A + %A + 1= 0 + + + 37 20 + ---- %A + ---- + --+ 1029 1029 + > -------------- + --+ 2 + 2 (x - %A) + %A + %A + 1= 0 +Type: FullPartialFractionExpansion(Fraction Integer, + UnivariatePolynomial(x,Fraction Integer)) + + g :: Fx - f + 0 + Type: Fraction UnivariatePolynomial(x,Fraction Integer) + + f : Fx := (2*x**7-7*x**5+26*x**3+8*x) / (x**8-5*x**6+6*x**4+4*x**2-8) + 7 5 3 + 2x - 7x + 26x + 8x + ------------------------ + 8 6 4 2 + x - 5x + 6x + 4x - 8 + Type: Fraction UnivariatePolynomial(x,Fraction Integer) + + g := fullPartialFraction f + 1 1 + - - + --+ 2 --+ 1 --+ 2 + > ------ + > --------- + > ------ + --+ x - %A --+ 3 --+ x - %A + 2 2 (x - %A) 2 + %A - 2= 0 %A - 2= 0 %A + 1= 0 +Type: FullPartialFractionExpansion(Fraction Integer, + UnivariatePolynomial(x,Fraction Integer)) + + g :: Fx - f + 0 + Type: Fraction UnivariatePolynomial(x,Fraction Integer) + + f:Fx := x**3 / (x**21 + 2*x**20 + 4*x**19 + 7*x**18 + 10*x**17 + 17*x**16 + 22*x**15 + 30*x**14 + 36*x**13 + 40*x**12 + 47*x**11 + 46*x**10 + 49*x**9 + 43*x**8 + 38*x**7 + 32*x**6 + 23*x**5 + 19*x**4 + 10*x**3 + 7*x**2 + 2*x + 1) + 3 + x + / + 21 20 19 18 17 16 15 14 13 12 + x + 2x + 4x + 7x + 10x + 17x + 22x + 30x + 36x + 40x + + + 11 10 9 8 7 6 5 4 3 2 + 47x + 46x + 49x + 43x + 38x + 32x + 23x + 19x + 10x + 7x + 2x + + + 1 + Type: Fraction UnivariatePolynomial(x,Fraction Integer) + + g := fullPartialFraction f + 1 1 19 + - %A - %A - -- + --+ 2 --+ 9 27 + > ------ + > --------- + --+ x - %A --+ x - %A + 2 2 + %A + 1= 0 %A + %A + 1= 0 + + + 1 1 + -- %A - -- + --+ 27 27 + > ---------- + --+ 2 + 2 (x - %A) + %A + %A + 1= 0 + + + SIGMA + 5 2 + %A + %A + 1= 0 + , + 96556567040 4 420961732891 3 59101056149 2 + - ------------ %A + ------------ %A - ------------ %A + 912390759099 912390759099 912390759099 + + + 373545875923 529673492498 + - ------------ %A + ------------ + 912390759099 912390759099 + / + x - %A + + + SIGMA + 5 2 + %A + %A + 1= 0 + , + 5580868 4 2024443 3 4321919 2 84614 5070620 + - -------- %A - -------- %A + -------- %A - ------- %A - -------- + 94070601 94070601 94070601 1542141 94070601 + -------------------------------------------------------------------- + 2 + (x - %A) + + + SIGMA + 5 2 + %A + %A + 1= 0 + , + 1610957 4 2763014 3 2016775 2 266953 4529359 + -------- %A + -------- %A - -------- %A + -------- %A + -------- + 94070601 94070601 94070601 94070601 94070601 + ------------------------------------------------------------------- + 3 + (x - %A) +Type: FullPartialFractionExpansion(Fraction Integer,UnivariatePolynomial(x,Fraction Integer)) + +This verification takes much longer than the conversion to partial fractions. + + g :: Fx - f + 0 + Type: Fraction UnivariatePolynomial(x,Fraction Integer) + +Use PartialFraction for standard partial fraction decompositions. + +For more information, see the paper: Bronstein, M and Salvy, B. +"Full Partial Fraction Decomposition of Rational Functions," +Proceedings of ISSAC'93, Kiev, ACM Press. + +See Also: +o )help PartialFraction +o )show FullPartialFractionExpansion +o $AXIOM/doc/src/algebra/fparfrac.spad.dvi + +@ +\pagehead{FullPartialFractionExpansion}{FPARFRAC} +\pagepic{ps/v103fullpartialfractionexpansion.ps}{FPARFRAC}{1.00} +<>= +)abbrev domain FPARFRAC FullPartialFractionExpansion +++ Full partial fraction expansion of rational functions +++ Author: Manuel Bronstein +++ Date Created: 9 December 1992 +++ Date Last Updated: 6 October 1993 +++ References: M.Bronstein & B.Salvy, +++ Full Partial Fraction Decomposition of Rational Functions, +++ in Proceedings of ISSAC'93, Kiev, ACM Press. +FullPartialFractionExpansion(F, UP): Exports == Implementation where + F : Join(Field, CharacteristicZero) + UP : UnivariatePolynomialCategory F + + N ==> NonNegativeInteger + Q ==> Fraction Integer + O ==> OutputForm + RF ==> Fraction UP + SUP ==> SparseUnivariatePolynomial RF + REC ==> Record(exponent: N, center: UP, num: UP) + ODV ==> OrderlyDifferentialVariable Symbol + ODP ==> OrderlyDifferentialPolynomial UP + ODF ==> Fraction ODP + FPF ==> Record(polyPart: UP, fracPart: List REC) + + Exports ==> Join(SetCategory, ConvertibleTo RF) with + "+": (UP, $) -> $ + ++ p + x returns the sum of p and x + fullPartialFraction: RF -> $ + ++ fullPartialFraction(f) returns \spad{[p, [[j, Dj, Hj]...]]} such that + ++ \spad{f = p(x) + sum_{[j,Dj,Hj] in l} sum_{Dj(a)=0} Hj(a)/(x - a)\^j}. + polyPart: $ -> UP + ++ polyPart(f) returns the polynomial part of f. + fracPart: $ -> List REC + ++ fracPart(f) returns the list of summands of the fractional part of f. + construct: List REC -> $ + ++ construct(l) is the inverse of fracPart. + differentiate: $ -> $ + ++ differentiate(f) returns the derivative of f. + D: $ -> $ + ++ D(f) returns the derivative of f. + differentiate: ($, N) -> $ + ++ differentiate(f, n) returns the n-th derivative of f. + D: ($, NonNegativeInteger) -> $ + ++ D(f, n) returns the n-th derivative of f. + + Implementation ==> add + Rep := FPF + + fullParFrac: (UP, UP, UP, N) -> List REC + outputexp : (O, N) -> O + output : (N, UP, UP) -> O + REC2RF : (UP, UP, N) -> RF + UP2SUP : UP -> SUP + diffrec : REC -> REC + FP2O : List REC -> O + +-- create a differential variable + u := new()$Symbol + u0 := makeVariable(u, 0)$ODV + alpha := u::O + x := monomial(1, 1)$UP + xx := x::O + zr := (0$N)::O + + construct l == [0, l] + D r == differentiate r + D(r, n) == differentiate(r,n) + polyPart f == f.polyPart + fracPart f == f.fracPart + p:UP + f:$ == [p + polyPart f, fracPart f] + + differentiate f == + differentiate(polyPart f) + construct [diffrec rec for rec in fracPart f] + + differentiate(r, n) == + for i in 1..n repeat r := differentiate r + r + +-- diffrec(sum_{rec.center(a) = 0} rec.num(a) / (x - a)^e) = +-- sum_{rec.center(a) = 0} -e rec.num(a) / (x - a)^{e+1} +-- where e = rec.exponent + diffrec rec == + e := rec.exponent + [e + 1, rec.center, - e * rec.num] + + convert(f:$):RF == + ans := polyPart(f)::RF + for rec in fracPart f repeat + ans := ans + REC2RF(rec.center, rec.num, rec.exponent) + ans + + UP2SUP p == + map(#1::UP::RF, p)$UnivariatePolynomialCategoryFunctions2(F, UP, RF, SUP) + + -- returns Trace_k^k(a) (h(a) / (x - a)^n) where d(a) = 0 + REC2RF(d, h, n) == +-- one?(m := degree d) => + ((m := degree d) = 1) => + a := - (leadingCoefficient reductum d) / (leadingCoefficient d) + h(a)::UP / (x - a::UP)**n + dd := UP2SUP d + hh := UP2SUP h + aa := monomial(1, 1)$SUP + p := (x::RF::SUP - aa)**n rem dd + rec := extendedEuclidean(p, dd, hh)::Record(coef1:SUP, coef2:SUP) + t := rec.coef1 -- we want Trace_k^k(a)(t) now + ans := coefficient(t, 0) + for i in 1..degree(d)-1 repeat + t := (t * aa) rem dd + ans := ans + coefficient(t, i) + ans + + fullPartialFraction f == + qr := divide(numer f, d := denom f) + qr.quotient + construct concat + [fullParFrac(qr.remainder, d, rec.factor, rec.exponent::N) + for rec in factors squareFree denom f] + + fullParFrac(a, d, q, n) == + ans:List REC := empty() + em := e := d quo (q ** n) + rec := extendedEuclidean(e, q, 1)::Record(coef1:UP,coef2:UP) + bm := b := rec.coef1 -- b = inverse of e modulo q + lvar:List(ODV) := [u0] + um := 1::ODP + un := (u1 := u0::ODP)**n + lval:List(UP) := [q1 := q := differentiate(q0 := q)] + h:ODF := a::ODP / (e * un) + rec := extendedEuclidean(q1, q0, 1)::Record(coef1:UP,coef2:UP) + c := rec.coef1 -- c = inverse of q' modulo q + cm := 1::UP + cn := (c ** n) rem q0 + for m in 1..n repeat + p := retract(em * un * um * h)@ODP + pp := retract(eval(p, lvar, lval))@UP + h := inv(m::Q) * differentiate h + q := differentiate q + lvar := concat(makeVariable(u, m), lvar) + lval := concat(inv((m+1)::F) * q, lval) + qq := q0 quo gcd(pp, q0) -- new center + if (degree(qq) > 0) then + ans := concat([(n + 1 - m)::N, qq, (pp * bm * cn * cm) rem qq], ans) + cm := (c * cm) rem q0 -- cm = c**m modulo q now + um := u1 * um -- um = u**m now + em := e * em -- em = e**{m+1} now + bm := (b * bm) rem q0 -- bm = b**{m+1} modulo q now + ans + + coerce(f:$):O == + ans := FP2O(l := fracPart f) + zero?(p := polyPart f) => + empty? l => (0$N)::O + ans + p::O + ans + + FP2O l == + empty? l => empty() + rec := first l + ans := output(rec.exponent, rec.center, rec.num) + for rec in rest l repeat + ans := ans + output(rec.exponent, rec.center, rec.num) + ans + + output(n, d, h) == +-- one? degree d => + (degree d) = 1 => + a := - leadingCoefficient(reductum d) / leadingCoefficient(d) + h(a)::O / outputexp((x - a::UP)::O, n) + sum(outputForm(makeSUP h, alpha) / outputexp(xx - alpha, n), + outputForm(makeSUP d, alpha) = zr) + + outputexp(f, n) == +-- one? n => f + (n = 1) => f + f ** (n::O) + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Chapter G} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -17782,6 +26232,86 @@ InnerAlgebraicNumber(): Exports == Implementation where @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain IFF InnerFiniteField} +\pagehead{InnerFiniteField}{IFF} +\pagepic{ps/v103innerfinitefield.ps}{IFF}{1.00} +See also:\\ +\refto{FiniteFieldExtensionByPolynomial}{FFP} +\refto{FiniteFieldExtension}{FFX} +\refto{FiniteField}{FF} +<>= +)abbrev domain IFF InnerFiniteField +++ Author: ??? +++ Date Created: ??? +++ Date Last Updated: 29 May 1990 +++ Basic Operations: +++ Related Constructors: FiniteFieldExtensionByPolynomial, +++ FiniteFieldPolynomialPackage +++ Also See: FiniteFieldCyclicGroup, FiniteFieldNormalBasis +++ AMS Classifications: +++ Keywords: field, extension field, algebraic extension, +++ finite extension, finite field, Galois field +++ Reference: +++ R.Lidl, H.Niederreiter: Finite Field, Encyclopedia of Mathematics an +++ Its Applications, Vol. 20, Cambridge Univ. Press, 1983, ISBN 0 521 30240 4 +++ J. Grabmeier, A. Scheerhorn: Finite Fields in AXIOM. +++ AXIOM Technical Report Series, ATR/5 NP2522. +++ Description: +++ InnerFiniteField(p,n) implements finite fields with \spad{p**n} elements +++ where p is assumed prime but does not check. +++ For a version which checks that p is prime, see \spadtype{FiniteField}. +InnerFiniteField(p:PositiveInteger, n:PositiveInteger) == + FiniteFieldExtension(InnerPrimeField p, n) + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain IFAMON InnerFreeAbelianMonoid} +\pagehead{InnerFreeAbelianMonoid}{IFAMON} +\pagepic{ps/v103innerfreeabelianmonoid.ps}{IFAMON}{1.00} +See also:\\ +\refto{ListMonoidOps}{LMOPS} +\refto{FreeMonoid}{FMONOID} +\refto{FreeGroup}{FGROUP} +\refto{FreeAbelianMonoid}{FAMONOID} +\refto{FreeAbelianGroup}{FAGROUP} +<>= +)abbrev domain IFAMON InnerFreeAbelianMonoid +++ Internal free abelian monoid on any set of generators +++ Author: Manuel Bronstein +++ Date Created: November 1989 +++ Date Last Updated: 6 June 1991 +++ Description: +++ Internal implementation of a free abelian monoid. +InnerFreeAbelianMonoid(S: SetCategory, E:CancellationAbelianMonoid, un:E): + FreeAbelianMonoidCategory(S, E) == ListMonoidOps(S, E, un) add + Rep := ListMonoidOps(S, E, un) + + 0 == makeUnit() + zero? f == empty? listOfMonoms f + terms f == copy listOfMonoms f + nthCoef(f, i) == nthExpon(f, i) + nthFactor(f, i) == nthFactor(f, i)$Rep + s:S + f:$ == plus(s, un, f) + f:$ + g:$ == plus(f, g) + (f:$ = g:$):Boolean == commutativeEquality(f,g) + n:E * s:S == makeTerm(s, n) + n:NonNegativeInteger * f:$ == mapExpon(n * #1, f) + coerce(f:$):OutputForm == outputForm(f, "+", #2 * #1, 0) + mapCoef(f, x) == mapExpon(f, x) + mapGen(f, x) == mapGen(f, x)$Rep + + coefficient(s, f) == + for x in terms f repeat + x.gen = s => return(x.exp) + 0 + + if E has OrderedAbelianMonoid then + highCommonTerms(f, g) == + makeMulti [[x.gen, min(x.exp, n)] for x in listOfMonoms f | + (n := coefficient(x.gen, g)) > 0] + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{domain IIARRAY2 InnerIndexedTwoDimensionalArray} This is an internal type which provides an implementation of 2-dimensional arrays as PrimitiveArray's of PrimitiveArray's. @@ -17884,6 +26414,98 @@ InnerIndexedTwoDimensionalArray(R,mnRow,mnCol,Row,Col):_ @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain ZMOD IntegerMod} +\pagehead{IntegerMod}{ZMOD} +\pagepic{ps/v103integermod.ps}{ZMOD}{1.00} +<>= +)abbrev domain ZMOD IntegerMod +++ Author: +++ Date Created: +++ Date Last Updated: +++ Basic Functions: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ IntegerMod(n) creates the ring of integers reduced modulo the integer +++ n. + +IntegerMod(p:PositiveInteger): + Join(CommutativeRing, Finite, ConvertibleTo Integer, StepThrough) == add + size() == p + characteristic() == p + lookup x == (zero? x => p; (convert(x)@Integer) :: PositiveInteger) + +-- Code is duplicated for the optimizer to kick in. + if p <= convert(max()$SingleInteger)@Integer then + Rep:= SingleInteger + q := p::SingleInteger + + bloodyCompiler: Integer -> % + bloodyCompiler n == positiveRemainder(n, p)$Integer :: Rep + + convert(x:%):Integer == convert(x)$Rep + coerce(x):OutputForm == coerce(x)$Rep + coerce(n:Integer):% == bloodyCompiler n + 0 == 0$Rep + 1 == 1$Rep + init == 0$Rep + nextItem(n) == + m:=n+1 + m=0 => "failed" + m + x = y == x =$Rep y + x:% * y:% == mulmod(x, y, q) + n:Integer * x:% == mulmod(bloodyCompiler n, x, q) + x + y == addmod(x, y, q) + x - y == submod(x, y, q) + random() == random(q)$Rep + index a == positiveRemainder(a::%, q) + - x == (zero? x => 0; q -$Rep x) + + x:% ** n:NonNegativeInteger == + n < p => powmod(x, n::Rep, q) + powmod(convert(x)@Integer, n, p)$Integer :: Rep + + recip x == + (c1, c2, g) := extendedEuclidean(x, q)$Rep +-- not one? g => "failed" + not (g = 1) => "failed" + positiveRemainder(c1, q) + + else + Rep:= Integer + + convert(x:%):Integer == convert(x)$Rep + coerce(n:Integer):% == positiveRemainder(n::Rep, p) + coerce(x):OutputForm == coerce(x)$Rep + 0 == 0$Rep + 1 == 1$Rep + init == 0$Rep + nextItem(n) == + m:=n+1 + m=0 => "failed" + m + x = y == x =$Rep y + x:% * y:% == mulmod(x, y, p) + n:Integer * x:% == mulmod(positiveRemainder(n::Rep, p), x, p) + x + y == addmod(x, y, p) + x - y == submod(x, y, p) + random() == random(p)$Rep + index a == positiveRemainder(a::Rep, p) + - x == (zero? x => 0; p -$Rep x) + x:% ** n:NonNegativeInteger == powmod(x, n::Rep, p) + + recip x == + (c1, c2, g) := extendedEuclidean(x, p)$Rep +-- not one? g => "failed" + not (g = 1) => "failed" + positiveRemainder(c1, p) + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{domain INTFTBL IntegrationFunctionsTable} \pagehead{IntegrationFunctionsTable}{INTFTBL} \pagepic{ps/v103integrationfunctionstable.ps}{INTFTBL}{1.00} @@ -17991,12 +26613,1085 @@ IntegrationFunctionsTable(): E == I where %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Chapter K} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain KAFILE KeyedAccessFile} +<>= +-- files.spad.pamphlet KeyedAccessFile.input +)spool KeyedAccessFile.output +)set message test on +)set message auto off +)clear all +ey: KeyedAccessFile(Integer) := open("editor.year", "output") +ey."Char":= 1986 +ey."Caviness" := 1985 +ey."Fitch" := 1984 +ey."Char" +ey("Char") +ey "Char" +search("Char", ey) +search("Smith", ey) +remove!("Char", ey) +keys ey +#ey +KE := Record(key: String, entry: Integer) +reopen!(ey, "output") +write!(ey, ["van Hulzen", 1983]$KE) +write!(ey, ["Calmet", 1982]$KE) +write!(ey, ["Wang", 1981]$KE) +close! ey +keys ey +members ey +)system rm -r editor.year +)spool +)lisp (bye) +@ +<>= +==================================================================== +KeyedAccessFile examples +==================================================================== + +The domain KeyedAccessFile(S) provides files which can be used +as associative tables. Data values are stored in these files and can +be retrieved according to their keys. The keys must be strings so +this type behaves very much like the StringTable(S) domain. The +difference is that keyed access files reside in secondary storage +while string tables are kept in memory. + +Before a keyed access file can be used, it must first be opened. +A new file can be created by opening it for output. + + ey: KeyedAccessFile(Integer) := open("editor.year", "output") + +Just as for vectors, tables or lists, values are saved in a keyed +access file by setting elements. + + ey."Char":= 1986 + + ey."Caviness" := 1985 + + ey."Fitch" := 1984 + +Values are retrieved using application, in any of its syntactic forms. + + ey."Char" + + ey("Char") + + ey "Char" + +Attempting to retrieve a non-existent element in this way causes an +error. If it is not known whether a key exists, you should use the +search operation. + + search("Char", ey) + + search("Smith", ey) + +When an entry is no longer needed, it can be removed from the file. + + remove!("Char", ey) + +The keys operation returns a list of all the keys for a given file. + + keys ey + +The # operation gives the number of entries. + + #ey + +The table view of keyed access files provides safe operations. That +is, if the Axiom program is terminated between file operations, the +file is left in a consistent, current state. This means, however, +that the operations are somewhat costly. For example, after each +update the file is closed. + +Here we add several more items to the file, then check its contents. + + KE := Record(key: String, entry: Integer) + + reopen!(ey, "output") + +If many items are to be added to a file at the same time, then it is +more efficient to use the write operation. + + write!(ey, ["van Hulzen", 1983]$KE) + + write!(ey, ["Calmet", 1982]$KE) + + write!(ey, ["Wang", 1981]$KE) + + close! ey + +The read operation is also available from the file view, but it +returns elements in a random order. It is generally clearer and more +efficient to use the keys operation and to extract elements by key. + + keys ey + + members ey + + )system rm -r editor.year + +See Also: +o )help Table +o )help StringTable +o )help File +o )help TextFile +o )help Library +o )show KeyedAccessFile +o $AXIOM/doc/src/algebra/files.spad.dvi + +@ +\pagehead{KeyedAccessFile}{KAFILE} +\pagepic{ps/v103keyedaccessfile.ps}{KAFILE}{1.00} +See also:\\ +\refto{File}{FILE} +\refto{TextFile}{TEXTFILE} +\refto{BinaryFile}{BINFILE} +\refto{Library}{LIB} +<>= +)abbrev domain KAFILE KeyedAccessFile +++ Author: Stephen M. Watt +++ Date Created: 1985 +++ Date Last Updated: June 4, 1991 +++ Basic Operations: +++ Related Domains: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ Examples: +++ References: +++ Description: +++ This domain allows a random access file to be viewed both as a table +++ and as a file object. + +KeyedAccessFile(Entry): KAFcategory == KAFcapsule where + Name ==> FileName + Key ==> String + Entry : SetCategory + + KAFcategory == + Join(FileCategory(Name, Record(key: Key, entry: Entry)), + TableAggregate(Key, Entry)) with + finiteAggregate + pack_!: % -> % + ++ pack!(f) reorganizes the file f on disk to recover + ++ unused space. + + KAFcapsule == add + + CLASS ==> 131 -- an arbitrary no. greater than 127 + FileState ==> SExpression + IOMode ==> String + + + Cons:= Record(car: SExpression, cdr: SExpression) + Rep := Record(fileName: Name, _ + fileState: FileState, _ + fileIOmode: IOMode) + + defstream(fn: Name, mode: IOMode): FileState == + mode = "input" => + not readable? fn => error ["File is not readable", fn] + RDEFINSTREAM(fn::String)$Lisp + mode = "output" => + not writable? fn => error ["File is not writable", fn] + RDEFOUTSTREAM(fn::String)$Lisp + error ["IO mode must be input or output", mode] + + ---- From Set ---- + f1 = f2 == + f1.fileName = f2.fileName + coerce(f: %): OutputForm == + f.fileName::OutputForm + + ---- From FileCategory ---- + open fname == + open(fname, "either") + open(fname, mode) == + mode = "either" => + exists? fname => + open(fname, "input") + writable? fname => + reopen_!(open(fname, "output"), "input") + error "File does not exist and cannot be created" + [fname, defstream(fname, mode), mode] + reopen_!(f, mode) == + close_! f + if mode ^= "closed" then + f.fileState := defstream(f.fileName, mode) + f.fileIOmode := mode + f + close_! f == + if f.fileIOmode ^= "closed" then + RSHUT(f.fileState)$Lisp + f.fileIOmode := "closed" + f + read_! f == + f.fileIOmode ^= "input" => error ["File not in read state",f] + ks: List Symbol := RKEYIDS(f.fileName)$Lisp + null ks => error ["Attempt to read empty file", f] + ix := random()$Integer rem #ks + k: String := PNAME(ks.ix)$Lisp + [k, SPADRREAD(k, f.fileState)$Lisp] + write_!(f, pr) == + f.fileIOmode ^= "output" => error ["File not in write state",f] + SPADRWRITE(pr.key, pr.entry, f.fileState)$Lisp + pr + name f == + f.fileName + iomode f == + f.fileIOmode + + ---- From TableAggregate ---- + empty() == + fn := new("", "kaf", "sdata")$Name + open fn + keys f == + close_! f + l: List SExpression := RKEYIDS(f.fileName)$Lisp + [PNAME(n)$Lisp for n in l] + # f == + # keys f + elt(f,k) == + reopen_!(f, "input") + SPADRREAD(k, f.fileState)$Lisp + setelt(f,k,e) == + -- Leaves f in a safe, closed state. For speed use "write". + reopen_!(f, "output") + UNWIND_-PROTECT(write_!(f, [k,e]), close_! f)$Lisp + close_! f + e + search(k,f) == + not member?(k, keys f) => "failed" -- can't trap RREAD error + reopen_!(f, "input") + (SPADRREAD(k, f.fileState)$Lisp)@Entry + remove_!(k:String,f:%) == + result := search(k,f) + result case "failed" => result + close_! f + RDROPITEMS(NAMESTRING(f.fileName)$Lisp, LIST(k)$Lisp)$Lisp + result + pack_! f == + close_! f + RPACKFILE(f.fileName)$Lisp + f + +@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Chapter L} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain LIB Library} +<>= +-- files.spad.pamphlet Library.input +)spool Library.output +)set message test on +)set message auto off +)clear all +stuff := library "Neat.stuff" +stuff.int := 32**2 +stuff."poly" := x**2 + 1 +stuff.str := "Hello" +keys stuff +stuff.poly +stuff("poly") +)system rm -rf Neat.stuff +)spool +)lisp (bye) +@ +<>= +==================================================================== +Library examples +==================================================================== + +The Library domain provides a simple way to store Axiom values +in a file. This domain is similar to KeyedAccessFile but fewer +declarations are needed and items of different types can be saved +together in the same file. + +To create a library, you supply a file name. + + stuff := library "Neat.stuff" + +Now values can be saved by key in the file. The keys should be +mnemonic, just as the field names are for records. They can be given +either as strings or symbols. + + stuff.int := 32**2 + + stuff."poly" := x**2 + 1 + + stuff.str := "Hello" + +You obtain the set of available keys using the keys operation. + + keys stuff + +You extract values by giving the desired key in this way. + + stuff.poly + + stuff("poly") + +When the file is no longer needed, you should remove it from the +file system. + + )system rm -rf Neat.stuff + +See Also: +o )help File +o )help TextFile +o )help KeyedAccessFile +o )show Library +o $AXIOM/doc/src/algebra/files.spad.dvi + +@ +\pagehead{Library}{LIB} +\pagepic{ps/v103library.ps}{LIB}{1.00} +See also:\\ +\refto{File}{FILE} +\refto{TextFile}{TEXTFILE} +\refto{BinaryFile}{BINFILE} +\refto{KeyedAccessFile}{KAFILE} +<>= +)abbrev domain LIB Library +++ Author: Stephen M. Watt +++ Date Created: 1985 +++ Date Last Updated: June 4, 1991 +++ Basic Operations: +++ Related Domains: KeyedAccessFile +++ Also See: +++ AMS Classifications: +++ Keywords: +++ Examples: +++ References: +++ Description: +++ This domain provides a simple way to save values in files. +Library(): TableAggregate(String, Any) with + library: FileName -> % + ++ library(ln) creates a new library file. + pack_!: % -> % + ++ pack!(f) reorganizes the file f on disk to recover + ++ unused space. + + elt : (%, Symbol) -> Any + ++ elt(lib,k) or lib.k extracts the value corresponding to the key \spad{k} + ++ from the library \spad{lib}. + + setelt : (%, Symbol, Any) -> Any + ++ \spad{lib.k := v} saves the value \spad{v} in the library + ++ \spad{lib}. It can later be extracted using the key \spad{k}. + + close_!: % -> % + ++ close!(f) returns the library f closed to input and output. + + == KeyedAccessFile(Any) add + Rep := KeyedAccessFile(Any) + library f == open f + elt(f:%,v:Symbol) == elt(f, string v) + setelt(f:%, v:Symbol, val:Any) == setelt(f, string v, val) + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain LMOPS ListMonoidOps} +\pagehead{ListMonoidOps}{LMOPS} +\pagepic{ps/v103listmonoidops.ps}{LMOPS}{1.00} +See also:\\ +\refto{FreeMonoid}{FMONOID} +\refto{FreeGroup}{FGROUP} +\refto{InnerFreeAbelianMonoid}{IFAMON} +\refto{FreeAbelianMonoid}{FAMONOID} +\refto{FreeAbelianGroup}{FAGROUP} +<>= +)abbrev domain LMOPS ListMonoidOps +++ Internal representation for monoids +++ Author: Manuel Bronstein +++ Date Created: November 1989 +++ Date Last Updated: 6 June 1991 +++ Description: +++ This internal package represents monoid (abelian or not, with or +++ without inverses) as lists and provides some common operations +++ to the various flavors of monoids. +ListMonoidOps(S, E, un): Exports == Implementation where + S : SetCategory + E : AbelianMonoid + un: E + + REC ==> Record(gen:S, exp: E) + O ==> OutputForm + + Exports ==> Join(SetCategory, RetractableTo S) with + outputForm : ($, (O, O) -> O, (O, O) -> O, Integer) -> O + ++ outputForm(l, fop, fexp, unit) converts the monoid element + ++ represented by l to an \spadtype{OutputForm}. + ++ Argument unit is the output form + ++ for the \spadignore{unit} of the monoid (e.g. 0 or 1), + ++ \spad{fop(a, b)} is the + ++ output form for the monoid operation applied to \spad{a} and b + ++ (e.g. \spad{a + b}, \spad{a * b}, \spad{ab}), + ++ and \spad{fexp(a, n)} is the output form + ++ for the exponentiation operation applied to \spad{a} and n + ++ (e.g. \spad{n a}, \spad{n * a}, \spad{a ** n}, \spad{a\^n}). + listOfMonoms : $ -> List REC + ++ listOfMonoms(l) returns the list of the monomials forming l. + makeTerm : (S, E) -> $ + ++ makeTerm(s, e) returns the monomial s exponentiated by e + ++ (e.g. s^e or e * s). + makeMulti : List REC -> $ + ++ makeMulti(l) returns the element whose list of monomials is l. + nthExpon : ($, Integer) -> E + ++ nthExpon(l, n) returns the exponent of the n^th monomial of l. + nthFactor : ($, Integer) -> S + ++ nthFactor(l, n) returns the factor of the n^th monomial of l. + reverse : $ -> $ + ++ reverse(l) reverses the list of monomials forming l. This + ++ has some effect if the monoid is non-abelian, i.e. + ++ \spad{reverse(a1\^e1 ... an\^en) = an\^en ... a1\^e1} which is different. + reverse_! : $ -> $ + ++ reverse!(l) reverses the list of monomials forming l, destroying + ++ the element l. + size : $ -> NonNegativeInteger + ++ size(l) returns the number of monomials forming l. + makeUnit : () -> $ + ++ makeUnit() returns the unit element of the monomial. + rightMult : ($, S) -> $ + ++ rightMult(a, s) returns \spad{a * s} where \spad{*} + ++ is the monoid operation, + ++ which is assumed non-commutative. + leftMult : (S, $) -> $ + ++ leftMult(s, a) returns \spad{s * a} where + ++ \spad{*} is the monoid operation, + ++ which is assumed non-commutative. + plus : (S, E, $) -> $ + ++ plus(s, e, x) returns \spad{e * s + x} where \spad{+} + ++ is the monoid operation, + ++ which is assumed commutative. + plus : ($, $) -> $ + ++ plus(x, y) returns \spad{x + y} where \spad{+} + ++ is the monoid operation, + ++ which is assumed commutative. + commutativeEquality: ($, $) -> Boolean + ++ commutativeEquality(x,y) returns true if x and y are equal + ++ assuming commutativity + mapExpon : (E -> E, $) -> $ + ++ mapExpon(f, a1\^e1 ... an\^en) returns \spad{a1\^f(e1) ... an\^f(en)}. + mapGen : (S -> S, $) -> $ + ++ mapGen(f, a1\^e1 ... an\^en) returns \spad{f(a1)\^e1 ... f(an)\^en}. + + Implementation ==> add + Rep := List REC + + localplus: ($, $) -> $ + + makeUnit() == empty()$Rep + size l == # listOfMonoms l + coerce(s:S):$ == [[s, un]] + coerce(l:$):O == coerce(l)$Rep + makeTerm(s, e) == (zero? e => makeUnit(); [[s, e]]) + makeMulti l == l + f = g == f =$Rep g + listOfMonoms l == l pretend List(REC) + nthExpon(f, i) == f.(i-1+minIndex f).exp + nthFactor(f, i) == f.(i-1+minIndex f).gen + reverse l == reverse(l)$Rep + reverse_! l == reverse_!(l)$Rep + mapGen(f, l) == [[f(x.gen), x.exp] for x in l] + + mapExpon(f, l) == + ans:List(REC) := empty() + for x in l repeat + if (a := f(x.exp)) ^= 0 then ans := concat([x.gen, a], ans) + reverse_! ans + + outputForm(l, op, opexp, id) == + empty? l => id::OutputForm + l:List(O) := + [(p.exp = un => p.gen::O; opexp(p.gen::O, p.exp::O)) for p in l] + reduce(op, l) + + retractIfCan(l:$):Union(S, "failed") == + not empty? l and empty? rest l and l.first.exp = un => l.first.gen + "failed" + + rightMult(f, s) == + empty? f => s::$ + s = f.last.gen => (setlast_!(h := copy f, [s, f.last.exp + un]); h) + concat(f, [s, un]) + + leftMult(s, f) == + empty? f => s::$ + s = f.first.gen => concat([s, f.first.exp + un], rest f) + concat([s, un], f) + + commutativeEquality(s1:$, s2:$):Boolean == + #s1 ^= #s2 => false + for t1 in s1 repeat + if not member?(t1,s2) then return false + true + + plus_!(s:S, n:E, f:$):$ == + h := g := concat([s, n], f) + h1 := rest h + while not empty? h1 repeat + s = h1.first.gen => + l := + zero?(m := n + h1.first.exp) => rest h1 + concat([s, m], rest h1) + setrest_!(h, l) + return rest g + h := h1 + h1 := rest h1 + g + + plus(s, n, f) == plus_!(s,n,copy f) + + plus(f, g) == + #f < #g => localplus(f, g) + localplus(g, f) + + localplus(f, g) == + g := copy g + for x in f repeat + g := plus(x.gen, x.exp, g) + g + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain LA LocalAlgebra} +\pagehead{LocalAlgebra}{LA} +\pagepic{ps/v103localalgebra.ps}{LA}{1.00} +See also:\\ +\refto{Localize}{LO} +\refto{Fraction}{FRAC} +<>= +)abbrev domain LA LocalAlgebra +++ Author: Dave Barton, Barry Trager +++ Date Created: +++ Date Last Updated: +++ Basic Functions: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: LocalAlgebra produces the localization of an algebra, i.e. +++ fractions whose numerators come from some R algebra. +LocalAlgebra(A: Algebra R, + R: CommutativeRing, + S: SubsetCategory(Monoid, R)): Algebra R with + if A has OrderedRing then OrderedRing + _/ : (%,S) -> % + ++ x / d divides the element x by d. + _/ : (A,S) -> % + ++ a / d divides the element \spad{a} by d. + numer: % -> A + ++ numer x returns the numerator of x. + denom: % -> S + ++ denom x returns the denominator of x. + == Localize(A, R, S) add + 1 == 1$A / 1$S + x:% * y:% == (numer(x) * numer(y)) / (denom(x) * denom(y)) + characteristic() == characteristic()$A + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain LO Localize} +<>= +\pagehead{Localize}{LO} +\pagepic{ps/v103localize.ps}{LO}{1.00} +See also:\\ +\refto{LocalAlgebra}{LA} +\refto{Fraction}{FRAC} +)abbrev domain LO Localize +++ Author: Dave Barton, Barry Trager +++ Date Created: +++ Date Last Updated: +++ Basic Functions: + - / numer denom +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: localization +++ References: +++ Description: Localize(M,R,S) produces fractions with numerators +++ from an R module M and denominators from some multiplicative subset +++ D of R. +Localize(M:Module R, + R:CommutativeRing, + S:SubsetCategory(Monoid, R)): Module R with + if M has OrderedAbelianGroup then OrderedAbelianGroup + _/ :(%,S) -> % + ++ x / d divides the element x by d. + _/ :(M,S) -> % + ++ m / d divides the element m by d. + numer: % -> M + ++ numer x returns the numerator of x. + denom: % -> S + ++ denom x returns the denominator of x. + == + add + --representation + Rep:= Record(num:M,den:S) + --declarations + x,y: % + n: Integer + m: M + r: R + d: S + --definitions + 0 == [0,1] + zero? x == zero? (x.num) + -x== [-x.num,x.den] + x=y == y.den*x.num = x.den*y.num + numer x == x.num + denom x == x.den + if M has OrderedAbelianGroup then + x < y == +-- if y.den::R < 0 then (x,y):=(y,x) +-- if x.den::R < 0 then (x,y):=(y,x) + y.den*x.num < x.den*y.num + x+y == [y.den*x.num+x.den*y.num, x.den*y.den] + n*x == [n*x.num,x.den] + r*x == if r=x.den then [x.num,1] else [r*x.num,x.den] + x/d == + zero?(u:S:=d*x.den) => error "division by zero" + [x.num,u] + m/d == if zero? d then error "division by zero" else [m,d] + coerce(x:%):OutputForm == +-- one?(xd:=x.den) => (x.num)::OutputForm + ((xd:=x.den) = 1) => (x.num)::OutputForm + (x.num)::OutputForm / (xd::OutputForm) + latex(x:%): String == +-- one?(xd:=x.den) => latex(x.num) + ((xd:=x.den) = 1) => latex(x.num) + nl : String := concat("{", concat(latex(x.num), "}")$String)$String + dl : String := concat("{", concat(latex(x.den), "}")$String)$String + concat("{ ", concat(nl, concat(" \over ", concat(dl, " }")$String)$String)$String)$String + +@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Chapter M} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain MCMPLX MachineComplex} +\pagehead{MachineComplex}{MCMPLX} +\pagepic{ps/v103machinecomplex.ps}{MCMPLX}{1.00} +See also:\\ +\refto{MachineInteger}{MINT} +\refto{MachineFloat}{MFLOAT} +<>= +)abbrev domain MCMPLX MachineComplex +++ Date Created: December 1993 +++ Date Last Updated: +++ Basic Operations: +++ Related Domains: +++ Also See: FortranExpression, FortranMachineTypeCategory, MachineInteger, +++ MachineFloat +++ AMS Classifications: +++ Keywords: +++ Examples: +++ References: +++ Description: A domain which models the complex number representation +++ used by machines in the AXIOM-NAG link. +MachineComplex():Exports == Implementation where + + Exports ==> Join (FortranMachineTypeCategory, + ComplexCategory(MachineFloat)) with + coerce : Complex Float -> $ + ++ coerce(u) transforms u into a MachineComplex + coerce : Complex Integer -> $ + ++ coerce(u) transforms u into a MachineComplex + coerce : Complex MachineFloat -> $ + ++ coerce(u) transforms u into a MachineComplex + coerce : Complex MachineInteger -> $ + ++ coerce(u) transforms u into a MachineComplex + coerce : $ -> Complex Float + ++ coerce(u) transforms u into a COmplex Float + + Implementation ==> Complex MachineFloat add + + coerce(u:Complex Float):$ == + complex(real(u)::MachineFloat,imag(u)::MachineFloat) + + coerce(u:Complex Integer):$ == + complex(real(u)::MachineFloat,imag(u)::MachineFloat) + + coerce(u:Complex MachineInteger):$ == + complex(real(u)::MachineFloat,imag(u)::MachineFloat) + + coerce(u:Complex MachineFloat):$ == + complex(real(u),imag(u)) + + coerce(u:$):Complex Float == + complex(real(u)::Float,imag(u)::Float) + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain MFLOAT MachineFloat} +\pagehead{MachineFloat}{MFLOAT} +\pagepic{ps/v103machinefloat.ps}{MFLOAT}{1.00} +See also:\\ +\refto{MachineInteger}{MINT} +\refto{MachineComplex}{MCMPLX} +<>= +)abbrev domain MFLOAT MachineFloat +++ Author: Mike Dewar +++ Date Created: December 1993 +++ Date Last Updated: +++ Basic Operations: +++ Related Domains: +++ Also See: FortranExpression, FortranMachineTypeCategory, MachineInteger, +++ MachineComplex +++ AMS Classifications: +++ Keywords: +++ Examples: +++ References: +++ Description: A domain which models the floating point representation +++ used by machines in the AXIOM-NAG link. +MachineFloat(): Exports == Implementation where + + PI ==> PositiveInteger + NNI ==> NonNegativeInteger + F ==> Float + I ==> Integer + S ==> String + FI ==> Fraction Integer + SUP ==> SparseUnivariatePolynomial + SF ==> DoubleFloat + + Exports ==> Join(FloatingPointSystem,FortranMachineTypeCategory,Field, + RetractableTo(Float),RetractableTo(Fraction(Integer)),CharacteristicZero) with + precision : PI -> PI + ++ precision(p) sets the number of digits in the model to p + precision : () -> PI + ++ precision() returns the number of digits in the model + base : PI -> PI + ++ base(b) sets the base of the model to b + base : () -> PI + ++ base() returns the base of the model + maximumExponent : I -> I + ++ maximumExponent(e) sets the maximum exponent in the model to e + maximumExponent : () -> I + ++ maximumExponent() returns the maximum exponent in the model + minimumExponent : I -> I + ++ minimumExponent(e) sets the minimum exponent in the model to e + minimumExponent : () -> I + ++ minimumExponent() returns the minimum exponent in the model + coerce : $ -> F + ++ coerce(u) transforms a MachineFloat to a standard Float + coerce : MachineInteger -> $ + ++ coerce(u) transforms a MachineInteger into a MachineFloat + mantissa : $ -> I + ++ mantissa(u) returns the mantissa of u + exponent : $ -> I + ++ exponent(u) returns the exponent of u + changeBase : (I,I,PI) -> $ + ++ changeBase(exp,man,base) \undocumented{} + + Implementation ==> add + + import F + import FI + + Rep := Record(mantissa:I,exponent:I) + + -- Parameters of the Floating Point Representation + P : PI := 16 -- Precision + B : PI := 2 -- Base + EMIN : I := -1021 -- Minimum Exponent + EMAX : I := 1024 -- Maximum Exponent + + -- Useful constants + POWER : PI := 53 -- The maximum power of B which will yield P + -- decimal digits. + MMAX : PI := B**POWER + + + -- locals + locRound:(FI)->I + checkExponent:($)->$ + normalise:($)->$ + newPower:(PI,PI)->Void + + retractIfCan(u:$):Union(FI,"failed") == + mantissa(u)*(B/1)**(exponent(u)) + + wholePart(u:$):Integer == + man:I:=mantissa u + exp:I:=exponent u + f:= + positive? exp => man*B**(exp pretend PI) + zero? exp => man + wholePart(man/B**((-exp) pretend PI)) + normalise(u:$):$ == + -- We want the largest possible mantissa, to ensure a canonical + -- representation. + exp : I := exponent u + man : I := mantissa u + BB : I := B pretend I + sgn : I := sign man ; man := abs man + zero? man => [0,0]$Rep + if man < MMAX then + while man < MMAX repeat + exp := exp - 1 + man := man * BB + if man > MMAX then + q1:FI:= man/1 + BBF:FI:=BB/1 + while wholePart(q1) > MMAX repeat + q1:= q1 / BBF + exp:=exp + 1 + man := locRound(q1) + positive?(sgn) => checkExponent [man,exp]$Rep + checkExponent [-man,exp]$Rep + + mantissa(u:$):I == elt(u,mantissa)$Rep + exponent(u:$):I == elt(u,exponent)$Rep + + newPower(base:PI,prec:PI):Void == + power : PI := 1 + target : PI := 10**prec + current : PI := base + while (current := current*base) < target repeat power := power+1 + POWER := power + MMAX := B**POWER + void() + + changeBase(exp:I,man:I,base:PI):$ == + newExp : I := 0 + f : FI := man*(base pretend I)::FI**exp + sign : I := sign f + f : FI := abs f + newMan : I := wholePart f + zero? f => [0,0]$Rep + BB : FI := (B pretend I)::FI + if newMan < MMAX then + while newMan < MMAX repeat + newExp := newExp - 1 + f := f*BB + newMan := wholePart f + if newMan > MMAX then + while newMan > MMAX repeat + newExp := newExp + 1 + f := f/BB + newMan := wholePart f + [sign*newMan,newExp]$Rep + + checkExponent(u:$):$ == + exponent(u) < EMIN or exponent(u) > EMAX => + message :S := concat(["Exponent out of range: ", + convert(EMIN)@S, "..", convert(EMAX)@S])$S + error message + u + + coerce(u:$):OutputForm == + coerce(u::F) + + coerce(u:MachineInteger):$ == + checkExponent changeBase(0,retract(u)@Integer,10) + + coerce(u:$):F == + oldDigits : PI := digits(P)$F + r : F := float(mantissa u,exponent u,B)$Float + digits(oldDigits)$F + r + + coerce(u:F):$ == + checkExponent changeBase(exponent(u)$F,mantissa(u)$F,base()$F) + + coerce(u:I):$ == + checkExponent changeBase(0,u,10) + + coerce(u:FI):$ == (numer u)::$/(denom u)::$ + + retract(u:$):FI == + value : Union(FI,"failed") := retractIfCan(u) + value case "failed" => error "Cannot retract to a Fraction Integer" + value::FI + + retract(u:$):F == u::F + + retractIfCan(u:$):Union(F,"failed") == u::F::Union(F,"failed") + + retractIfCan(u:$):Union(I,"failed") == + value:FI := mantissa(u)*(B pretend I)::FI**exponent(u) + zero? fractionPart(value) => wholePart(value)::Union(I,"failed") + "failed"::Union(I,"failed") + + retract(u:$):I == + result : Union(I,"failed") := retractIfCan u + result = "failed" => error "Not an Integer" + result::I + + precision(p: PI):PI == + old : PI := P + newPower(B,p) + P := p + old + + precision():PI == P + + base(b:PI):PI == + old : PI := b + newPower(b,P) + B := b + old + + base():PI == B + + maximumExponent(u:I):I == + old : I := EMAX + EMAX := u + old + + maximumExponent():I == EMAX + + minimumExponent(u:I):I == + old : I := EMIN + EMIN := u + old + + minimumExponent():I == EMIN + + 0 == [0,0]$Rep + 1 == changeBase(0,1,10) + + zero?(u:$):Boolean == u=[0,0]$Rep + + + + f1:$ + f2:$ + + + locRound(x:FI):I == + abs(fractionPart(x)) >= 1/2 => wholePart(x)+sign(x) + wholePart(x) + + recip f1 == + zero? f1 => "failed" + normalise [ locRound(B**(2*POWER)/mantissa f1),-(exponent f1 + 2*POWER)] + + f1 * f2 == + normalise [mantissa(f1)*mantissa(f2),exponent(f1)+exponent(f2)]$Rep + + f1 **(p:FI) == + ((f1::F)**p)::% + +--inline + f1 / f2 == + zero? f2 => error "division by zero" + zero? f1 => 0 + f1=f2 => 1 + normalise [locRound(mantissa(f1)*B**(2*POWER)/mantissa(f2)), + exponent(f1)-(exponent f2 + 2*POWER)] + + inv(f1) == 1/f1 + + f1 exquo f2 == f1/f2 + + divide(f1,f2) == [ f1/f2,0] + + f1 quo f2 == f1/f2 + f1 rem f2 == 0 + u:I * f1 == + normalise [u*mantissa(f1),exponent(f1)]$Rep + + f1 = f2 == mantissa(f1)=mantissa(f2) and exponent(f1)=exponent(f2) + + f1 + f2 == + m1 : I := mantissa f1 + m2 : I := mantissa f2 + e1 : I := exponent f1 + e2 : I := exponent f2 + e1 > e2 => +--insignificance + e1 > e2 + POWER + 2 => + zero? f1 => f2 + f1 + normalise [m1*(B pretend I)**((e1-e2) pretend NNI)+m2,e2]$Rep + e2 > e1 + POWER +2 => + zero? f2 => f1 + f2 + normalise [m2*(B pretend I)**((e2-e1) pretend NNI)+m1,e1]$Rep + + - f1 == [- mantissa f1,exponent f1]$Rep + + f1 - f2 == f1 + (-f2) + + f1 < f2 == + m1 : I := mantissa f1 + m2 : I := mantissa f2 + e1 : I := exponent f1 + e2 : I := exponent f2 + sign(m1) = sign(m2) => + e1 < e2 => true + e1 = e2 and m1 < m2 => true + false + sign(m1) = 1 => false + sign(m1) = 0 and sign(m2) = -1 => false + true + + characteristic():NNI == 0 + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain MINT MachineInteger} +\pagehead{MachineInteger}{MINT} +\pagepic{ps/v103machineinteger.ps}{MINT}{1.00} +See also:\\ +\refto{MachineFloat}{MFLOAT} +\refto{MachineComplex}{MCMPLX} +<>= +)abbrev domain MINT MachineInteger +++ Author: Mike Dewar +++ Date Created: December 1993 +++ Date Last Updated: +++ Basic Operations: +++ Related Domains: +++ Also See: FortranExpression, FortranMachineTypeCategory, MachineFloat, +++ MachineComplex +++ AMS Classifications: +++ Keywords: +++ Examples: +++ References: +++ Description: A domain which models the integer representation +++ used by machines in the AXIOM-NAG link. +MachineInteger(): Exports == Implementation where + + S ==> String + + Exports ==> Join(FortranMachineTypeCategory,IntegerNumberSystem) with + maxint : PositiveInteger -> PositiveInteger + ++ maxint(u) sets the maximum integer in the model to u + maxint : () -> PositiveInteger + ++ maxint() returns the maximum integer in the model + coerce : Expression Integer -> Expression $ + ++ coerce(x) returns x with coefficients in the domain + + Implementation ==> Integer add + + MAXINT : PositiveInteger := 2**32 + + maxint():PositiveInteger == MAXINT + + maxint(new:PositiveInteger):PositiveInteger == + old := MAXINT + MAXINT := new + old + + coerce(u:Expression Integer):Expression($) == + map(coerce,u)$ExpressionFunctions2(Integer,$) + + coerce(u:Integer):$ == + import S + abs(u) > MAXINT => + message: S := concat [convert(u)@S," > MAXINT(",convert(MAXINT)@S,")"] + error message + u pretend $ + + retract(u:$):Integer == u pretend Integer + + retractIfCan(u:$):Union(Integer,"failed") == u pretend Integer + +@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Chapter N} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -19621,6 +29316,47 @@ OrderlyDifferentialVariable(S:OrderedSet):DifferentialVariableCategory(S) @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain OSI OrdSetInts} +\pagehead{OrdSetInts}{OSI} +\pagepic{ps/v103ordsetints.ps}{OSI}{1.00} +See also:\\ +\refto{Commutator}{COMM} +\refto{FreeNilpotentLie}{FNLA} +<>= +)abbrev domain OSI OrdSetInts +++ Author : Larry Lambe +++ Date created : 14 August 1988 +++ Date Last Updated : 11 March 1991 +++ Description : A domain used in order to take the free R-module on the +++ Integers I. This is actually the forgetful functor from OrderedRings +++ to OrderedSets applied to I +OrdSetInts: Export == Implement where + I ==> Integer + L ==> List + O ==> OutputForm + + Export == OrderedSet with + coerce : Integer -> % + ++ coerce(i) returns the element corresponding to i + value : % -> I + ++ value(x) returns the integer associated with x + + Implement == add + Rep := Integer + x,y: % + + x = y == x =$Rep y + x < y == x <$Rep y + + coerce(i:Integer):% == i + + value(x) == x:Rep + + coerce(x):O == + sub(e::Symbol::O, coerce(x)$Rep)$O + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Chapter P} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{domain PALETTE Palette} @@ -21463,8 +31199,531 @@ Reference(S:Type): Type with @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain RESULT Result} +\pagehead{Result}{RESULT} +\pagepic{ps/v103result.ps}{RESULT}{1.00} +See also:\\ +\refto{FortranCode}{FC} +\refto{FortranProgram}{FORTRAN} +\refto{ThreeDimensionalMatrix}{M3D} +\refto{SimpleFortranProgram}{SFORT} +\refto{Switch}{SWITCH} +\refto{FortranTemplate}{FTEM} +\refto{FortranExpression}{FEXPR} +<>= +)abbrev domain RESULT Result +++ Author: Didier Pinchon and Mike Dewar +++ Date Created: 8 April 1994 +++ Date Last Updated: 28 June 1994 +++ Basic Operations: +++ Related Domains: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ Examples: +++ References: +++ Description: A domain used to return the results from a call to the NAG +++ Library. It prints as a list of names and types, though the user may +++ choose to display values automatically if he or she wishes. +Result():Exports==Implementation where + + O ==> OutputForm + + Exports ==> TableAggregate(Symbol,Any) with + showScalarValues : Boolean -> Boolean + ++ showScalarValues(true) forces the values of scalar components to be + ++ displayed rather than just their types. + showArrayValues : Boolean -> Boolean + ++ showArrayValues(true) forces the values of array components to be + ++ displayed rather than just their types. + finiteAggregate + + Implementation ==> Table(Symbol,Any) add + + -- Constant + colon := ": "::Symbol::O + elide := "..."::Symbol::O + + -- Flags + showScalarValuesFlag : Boolean := false + showArrayValuesFlag : Boolean := false + + cleanUpDomainForm(d:SExpression):O == + not list? d => d::O + #d=1 => (car d)::O + -- If the car is an atom then we have a domain constructor, if not + -- then we have some kind of value. Since we often can't print these + -- ****ers we just elide them. + not atom? car d => elide + prefix((car d)::O,[cleanUpDomainForm(u) for u in destruct cdr(d)]$List(O)) + + display(v:Any,d:SExpression):O == + not list? d => error "Domain form is non-list" + #d=1 => + showScalarValuesFlag => objectOf v + cleanUpDomainForm d + car(d) = convert("Complex"::Symbol)@SExpression => + showScalarValuesFlag => objectOf v + cleanUpDomainForm d + showArrayValuesFlag => objectOf v + cleanUpDomainForm d + + makeEntry(k:Symbol,v:Any):O == + hconcat [k::O,colon,display(v,dom v)] + + coerce(r:%):O == + bracket [makeEntry(key,r.key) for key in reverse! keys(r)] + + showArrayValues(b:Boolean):Boolean == showArrayValuesFlag := b + showScalarValues(b:Boolean):Boolean == showScalarValuesFlag := b + +@ +<>= +digraph pic { + fontsize=10; + bgcolor="#FFFF66"; + node [shape=box, color=white, style=filled]; + +"Result" + [color=lightblue,href="bookvol10.3.pdf#nameddest=RESULT"]; + +} +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Chapter S} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain FORMULA ScriptFormulaFormat} +\pagehead{ScriptFormulaFormat}{FORMULA} +\pagepic{ps/v103scriptformulaformat.ps}{FORMULA}{1.00} +<>= +)abbrev domain FORMULA ScriptFormulaFormat +++ Author: Robert S. Sutor +++ Date Created: 1987 through 1990 +++ Change History: +++ Basic Operations: coerce, convert, display, epilogue, +++ formula, new, prologue, setEpilogue!, setFormula!, setPrologue! +++ Related Constructors: ScriptFormulaFormat1 +++ Also See: TexFormat +++ AMS Classifications: +++ Keywords: output, format, SCRIPT, BookMaster, formula +++ References: +++ SCRIPT Mathematical Formula Formatter User's Guide, SH20-6453, +++ IBM Corporation, Publishing Systems Information Development, +++ Dept. G68, P.O. Box 1900, Boulder, Colorado, USA 80301-9191. +++ Description: +++ \spadtype{ScriptFormulaFormat} provides a coercion from +++ \spadtype{OutputForm} to IBM SCRIPT/VS Mathematical Formula Format. +++ The basic SCRIPT formula format object consists of three parts: a +++ prologue, a formula part and an epilogue. The functions +++ \spadfun{prologue}, \spadfun{formula} and \spadfun{epilogue} +++ extract these parts, respectively. The central parts of the expression +++ go into the formula part. The other parts can be set +++ (\spadfun{setPrologue!}, \spadfun{setEpilogue!}) so that contain the +++ appropriate tags for printing. For example, the prologue and +++ epilogue might simply contain ":df." and ":edf." so that the +++ formula section will be printed in display math mode. + +ScriptFormulaFormat(): public == private where + E ==> OutputForm + I ==> Integer + L ==> List + S ==> String + + public == SetCategory with + coerce: E -> % + ++ coerce(o) changes o in the standard output format to + ++ SCRIPT formula format. + convert: (E,I) -> % + ++ convert(o,step) changes o in standard output format to + ++ SCRIPT formula format and also adds the given step number. + ++ This is useful if you want to create equations with given numbers + ++ or have the equation numbers correspond to the interpreter step + ++ numbers. + display: (%, I) -> Void + ++ display(t,width) outputs the formatted code t so that each + ++ line has length less than or equal to \spadvar{width}. + display: % -> Void + ++ display(t) outputs the formatted code t so that each + ++ line has length less than or equal to the value set by + ++ the system command \spadsyscom{set output length}. + epilogue: % -> L S + ++ epilogue(t) extracts the epilogue section of a formatted object t. + formula: % -> L S + ++ formula(t) extracts the formula section of a formatted object t. + new: () -> % + ++ new() create a new, empty object. Use \spadfun{setPrologue!}, + ++ \spadfun{setFormula!} and \spadfun{setEpilogue!} to set the + ++ various components of this object. + prologue: % -> L S + ++ prologue(t) extracts the prologue section of a formatted object t. + setEpilogue!: (%, L S) -> L S + ++ setEpilogue!(t,strings) sets the epilogue section of a + ++ formatted object t to strings. + setFormula!: (%, L S) -> L S + ++ setFormula!(t,strings) sets the formula section of a + ++ formatted object t to strings. + setPrologue!: (%, L S) -> L S + ++ setPrologue!(t,strings) sets the prologue section of a + ++ formatted object t to strings. + + private == add + import OutputForm + import Character + import Integer + import List OutputForm + import List String + + Rep := Record(prolog : L S, formula : L S, epilog : L S) + + -- local variables declarations and definitions + + expr: E + prec,opPrec: I + str: S + blank : S := " @@ " + + maxPrec : I := 1000000 + minPrec : I := 0 + + splitChars : S := " <>[](){}+*=,-%" + + unaryOps : L S := ["-","^"]$(L S) + unaryPrecs : L I := [700,260]$(L I) + + -- the precedence of / in the following is relatively low because + -- the bar obviates the need for parentheses. + binaryOps : L S := ["+->","|","**","/","<",">","=","OVER"]$(L S) + binaryPrecs : L I := [0,0,900, 700,400,400,400, 700]$(L I) + + naryOps : L S := ["-","+","*",blank,",",";"," ","ROW","", + " habove "," here "," labove "]$(L S) + naryPrecs : L I := [700,700,800, 800,110,110, 0, 0, 0, + 0, 0, 0]$(L I) +-- naryNGOps : L S := ["ROW"," here "]$(L S) + naryNGOps : L S := nil$(L S) + + plexOps : L S := ["SIGMA","PI","INTSIGN","INDEFINTEGRAL"]$(L S) + plexPrecs : L I := [ 700, 800, 700, 700]$(L I) + + specialOps : L S := ["MATRIX","BRACKET","BRACE","CONCATB", _ + "AGGLST","CONCAT","OVERBAR","ROOT","SUB", _ + "SUPERSUB","ZAG","AGGSET","SC","PAREN"] + + -- the next two lists provide translations for some strings for + -- which the formula formatter provides special variables. + + specialStrings : L S := + ["5","..."] + specialStringsInFormula : L S := + [" alpha "," ellipsis "] + + -- local function signatures + + addBraces: S -> S + addBrackets: S -> S + group: S -> S + formatBinary: (S,L E, I) -> S + formatFunction: (S,L E, I) -> S + formatMatrix: L E -> S + formatNary: (S,L E, I) -> S + formatNaryNoGroup: (S,L E, I) -> S + formatNullary: S -> S + formatPlex: (S,L E, I) -> S + formatSpecial: (S,L E, I) -> S + formatUnary: (S, E, I) -> S + formatFormula: (E,I) -> S + parenthesize: S -> S + precondition: E -> E + postcondition: S -> S + splitLong: (S,I) -> L S + splitLong1: (S,I) -> L S + stringify: E -> S + + -- public function definitions + + new() : % == [[".eq set blank @",":df."]$(L S), + [""]$(L S), [":edf."]$(L S)]$Rep + + coerce(expr : E): % == + f : % := new()$% + f.formula := [postcondition + formatFormula(precondition expr, minPrec)]$(L S) + f + + convert(expr : E, stepNum : I): % == + f : % := new()$% + f.formula := concat([""], [postcondition + formatFormula(precondition expr, minPrec)]$(L S)) + f + + display(f : %, len : I) == + s,t : S + for s in f.prolog repeat sayFORMULA(s)$Lisp + for s in f.formula repeat + for t in splitLong(s, len) repeat sayFORMULA(t)$Lisp + for s in f.epilog repeat sayFORMULA(s)$Lisp + void()$Void + + display(f : %) == + display(f, _$LINELENGTH$Lisp pretend I) + + prologue(f : %) == f.prolog + formula(f : %) == f.formula + epilogue(f : %) == f.epilog + + setPrologue!(f : %, l : L S) == f.prolog := l + setFormula!(f : %, l : L S) == f.formula := l + setEpilogue!(f : %, l : L S) == f.epilog := l + + coerce(f : %): E == + s,t : S + l : L S := nil + for s in f.prolog repeat l := concat(s,l) + for s in f.formula repeat + for t in splitLong(s, (_$LINELENGTH$Lisp pretend Integer) - 4) repeat + l := concat(t,l) + for s in f.epilog repeat l := concat(s,l) + (reverse l) :: E + + -- local function definitions + + postcondition(str: S): S == + len : I := #str + len < 4 => str + plus : Character := char "+" + minus: Character := char "-" + for i in 1..(len-1) repeat + if (str.i =$Character plus) and (str.(i+1) =$Character minus) + then setelt(str,i,char " ")$S + str + + stringify expr == object2String(expr)$Lisp pretend S + + splitLong(str : S, len : I): L S == + -- this blocks into lines + if len < 20 then len := _$LINELENGTH$Lisp + splitLong1(str, len) + + splitLong1(str : S, len : I) == + l : List S := nil + s : S := "" + ls : I := 0 + ss : S + lss : I + for ss in split(str,char " ") repeat + lss := #ss + if ls + lss > len then + l := concat(s,l)$List(S) + s := "" + ls := 0 + lss > len => l := concat(ss,l)$List(S) + ls := ls + lss + 1 + s := concat(s,concat(ss," ")$S)$S + if ls > 0 then l := concat(s,l)$List(S) + reverse l + + group str == + concat ["<",str,">"] + + addBraces str == + concat ["left lbrace ",str," right rbrace"] + + addBrackets str == + concat ["left lb ",str," right rb"] + + parenthesize str == + concat ["left lparen ",str," right rparen"] + + precondition expr == + outputTran(expr)$Lisp + + formatSpecial(op : S, args : L E, prec : I) : S == + op = "AGGLST" => + formatNary(",",args,prec) + op = "AGGSET" => + formatNary(";",args,prec) + op = "CONCATB" => + formatNary(" ",args,prec) + op = "CONCAT" => + formatNary("",args,prec) + op = "BRACKET" => + group addBrackets formatFormula(first args, minPrec) + op = "BRACE" => + group addBraces formatFormula(first args, minPrec) + op = "PAREN" => + group parenthesize formatFormula(first args, minPrec) + op = "OVERBAR" => + null args => "" + group concat [formatFormula(first args, minPrec)," bar"] + op = "ROOT" => + null args => "" + tmp : S := formatFormula(first args, minPrec) + null rest args => group concat ["sqrt ",tmp] + group concat ["midsup adjust(u 1.5 r 9) ", + formatFormula(first rest args, minPrec)," sqrt ",tmp] + op = "SC" => + formatNary(" labove ",args,prec) + op = "SUB" => + group concat [formatFormula(first args, minPrec)," sub ", + formatSpecial("AGGLST",rest args,minPrec)] + op = "SUPERSUB" => + -- variable name + form : List S := [formatFormula(first args, minPrec)] + -- subscripts + args := rest args + null args => concat form + tmp : S := formatFormula(first args, minPrec) + if tmp ^= "" then form := append(form,[" sub ",tmp])$(List S) + -- superscripts + args := rest args + null args => group concat form + tmp : S := formatFormula(first args, minPrec) + if tmp ^= "" then form := append(form,[" sup ",tmp])$(List S) + -- presuperscripts + args := rest args + null args => group concat form + tmp : S := formatFormula(first args, minPrec) + if tmp ^= "" then form := append(form,[" presup ",tmp])$(List S) + -- presubscripts + args := rest args + null args => group concat form + tmp : S := formatFormula(first args, minPrec) + if tmp ^= "" then form := append(form,[" presub ",tmp])$(List S) + group concat form + op = "MATRIX" => formatMatrix rest args +-- op = "ZAG" => +-- concat ["\zag{",formatFormula(first args, minPrec),"}{", +-- formatFormula(first rest args,minPrec),"}"] + concat ["not done yet for ",op] + + formatPlex(op : S, args : L E, prec : I) : S == + hold : S + p : I := position(op,plexOps) + p < 1 => error "unknown Script Formula Formatter unary op" + opPrec := plexPrecs.p + n : I := #args + (n ^= 2) and (n ^= 3) => error "wrong number of arguments for plex" + s : S := + op = "SIGMA" => "sum" + op = "PI" => "product" + op = "INTSIGN" => "integral" + op = "INDEFINTEGRAL" => "integral" + "????" + hold := formatFormula(first args,minPrec) + args := rest args + if op ^= "INDEFINTEGRAL" then + if hold ^= "" then + s := concat [s," from",group concat ["\displaystyle ",hold]] + if not null rest args then + hold := formatFormula(first args,minPrec) + if hold ^= "" then + s := concat [s," to",group concat ["\displaystyle ",hold]] + args := rest args + s := concat [s," ",formatFormula(first args,minPrec)] + else + hold := group concat [hold," ",formatFormula(first args,minPrec)] + s := concat [s," ",hold] + if opPrec < prec then s := parenthesize s + group s + + formatMatrix(args : L E) : S == + -- format for args is [[ROW ...],[ROW ...],[ROW ...]] + group addBrackets formatNary(" habove ",args,minPrec) + + formatFunction(op : S, args : L E, prec : I) : S == + group concat [op, " ", parenthesize formatNary(",",args,minPrec)] + + formatNullary(op : S) == + op = "NOTHING" => "" + group concat [op,"()"] + + formatUnary(op : S, arg : E, prec : I) == + p : I := position(op,unaryOps) + p < 1 => error "unknown Script Formula Formatter unary op" + opPrec := unaryPrecs.p + s : S := concat [op,formatFormula(arg,opPrec)] + opPrec < prec => group parenthesize s + op = "-" => s + group s + + formatBinary(op : S, args : L E, prec : I) : S == + p : I := position(op,binaryOps) + p < 1 => error "unknown Script Formula Formatter binary op" + op := + op = "**" => " sup " + op = "/" => " over " + op = "OVER" => " over " + op + opPrec := binaryPrecs.p + s : S := formatFormula(first args, opPrec) + s := concat [s,op,formatFormula(first rest args, opPrec)] + group + op = " over " => s + opPrec < prec => parenthesize s + s + + formatNary(op : S, args : L E, prec : I) : S == + group formatNaryNoGroup(op, args, prec) + + formatNaryNoGroup(op : S, args : L E, prec : I) : S == + null args => "" + p : I := position(op,naryOps) + p < 1 => error "unknown Script Formula Formatter nary op" + op := + op = "," => ", @@ " + op = ";" => "; @@ " + op = "*" => blank + op = " " => blank + op = "ROW" => " here " + op + l : L S := nil + opPrec := naryPrecs.p + for a in args repeat + l := concat(op,concat(formatFormula(a,opPrec),l)$L(S))$L(S) + s : S := concat reverse rest l + opPrec < prec => parenthesize s + s + + formatFormula(expr,prec) == + i : Integer + ATOM(expr)$Lisp pretend Boolean => + str := stringify expr + FIXP(expr)$Lisp => + i := expr : Integer + if (i < 0) or (i > 9) then group str else str + (i := position(str,specialStrings)) > 0 => + specialStringsInFormula.i + str + l : L E := (expr pretend L E) + null l => blank + op : S := stringify first l + args : L E := rest l + nargs : I := #args + + -- special cases + member?(op, specialOps) => formatSpecial(op,args,prec) + member?(op, plexOps) => formatPlex(op,args,prec) + + -- nullary case + 0 = nargs => formatNullary op + + -- unary case + (1 = nargs) and member?(op, unaryOps) => + formatUnary(op, first args, prec) + + -- binary case + (2 = nargs) and member?(op, binaryOps) => + formatBinary(op, args, prec) + + -- nary case + member?(op,naryNGOps) => formatNaryNoGroup(op,args, prec) + member?(op,naryOps) => formatNary(op,args, prec) + op := formatFormula(first l,minPrec) + formatFunction(op,args,prec) + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{domain SDPOL SequentialDifferentialPolynomial} \pagehead{SequentialDifferentialPolynomial}{SDPOL} \pagepic{ps/v103sequentialdifferentialpolynomial.ps}{SDPOL}{1.00} @@ -21746,6 +32005,81 @@ SimpleAlgebraicExtension(R:CommutativeRing, @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain SFORT SimpleFortranProgram} +\pagehead{SimpleFortranProgram}{SFORT} +\pagepic{ps/v103simplefortranprogram.ps}{SFORT}{1.00} +See also:\\ +\refto{Result}{RESULT} +\refto{FortranCode}{FC} +\refto{FortranProgram}{FORTRAN} +\refto{ThreeDimensionalMatrix}{M3D} +\refto{Switch}{SWITCH} +\refto{FortranTemplate}{FTEM} +\refto{FortranExpression}{FEXPR} +<>= +)abbrev domain SFORT SimpleFortranProgram +-- Because of a bug in the compiler: +)bo $noSubsumption:=true + +++ Author: Mike Dewar +++ Date Created: November 1992 +++ Date Last Updated: +++ Basic Operations: +++ Related Constructors: FortranType, FortranCode, Switch +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ \axiomType{SimpleFortranProgram(f,type)} provides a simple model of some +++ FORTRAN subprograms, making it possible to coerce objects of various +++ domains into a FORTRAN subprogram called \axiom{f}. +++ These can then be translated into legal FORTRAN code. +SimpleFortranProgram(R,FS): Exports == Implementation where + R : OrderedSet + FS : FunctionSpace(R) + + FST ==> FortranScalarType + + Exports ==> FortranProgramCategory with + fortran : (Symbol,FST,FS) -> $ + ++fortran(fname,ftype,body) builds an object of type + ++\axiomType{FortranProgramCategory}. The three arguments specify + ++the name, the type and the body of the program. + + Implementation ==> add + + Rep := Record(name : Symbol, type : FST, body : FS ) + + fortran(fname, ftype, res) == + construct(fname,ftype,res)$Rep + + nameOf(u:$):Symbol == u . name + + typeOf(u:$):Union(FST,"void") == u . type + + bodyOf(u:$):FS == u . body + + argumentsOf(u:$):List Symbol == variables(bodyOf u)$FS + + coerce(u:$):OutputForm == + coerce(nameOf u)$Symbol + + outputAsFortran(u:$):Void == + ftype := (checkType(typeOf(u)::OutputForm)$Lisp)::OutputForm + fname := nameOf(u)::OutputForm + args := argumentsOf(u) + nargs:=args::OutputForm + val := bodyOf(u)::OutputForm + fortFormatHead(ftype,fname,nargs)$Lisp + fortFormatTypes(ftype,args)$Lisp + dispfortexp1$Lisp ["="::OutputForm, fname, val]@List(OutputForm) + dispfortexp1$Lisp "RETURN"::OutputForm + dispfortexp1$Lisp "END"::OutputForm + void()$Void + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{domain STACK Stack} <>= "STACK" -> "SKAGG" @@ -21807,8 +32141,1031 @@ Stack(S:SetCategory): StackAggregate S with @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain SWITCH Switch} +\pagehead{Switch}{SWITCH} +\pagepic{ps/v103switch.ps}{SWITCH}{1.00} +See also:\\ +\refto{Result}{RESULT} +\refto{FortranCode}{FC} +\refto{FortranProgram}{FORTRAN} +\refto{ThreeDimensionalMatrix}{M3D} +\refto{SimpleFortranProgram}{SFORT} +\refto{FortranTemplate}{FTEM} +\refto{FortranExpression}{FEXPR} +<>= +)abbrev domain SWITCH Switch +-- Because of a bug in the compiler: +)bo $noSubsumption:=false + +++ Author: Mike Dewar +++ Date Created: April 1991 +++ Date Last Updated: March 1994 +++ 30.6.94 Added coercion from Symbol MCD +++ Basic Operations: +++ Related Constructors: FortranProgram, FortranCode, FortranTypes +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ This domain builds representations of boolean expressions for use with +++ the \axiomType{FortranCode} domain. +Switch():public == private where + EXPR ==> Union(I:Expression Integer,F:Expression Float, + CF:Expression Complex Float,switch:%) + + public == CoercibleTo OutputForm with + coerce : Symbol -> $ + ++ coerce(s) \undocumented{} + LT : (EXPR,EXPR) -> $ + ++ LT(x,y) returns the \axiomType{Switch} expression representing \spad{x $ + ++ GT(x,y) returns the \axiomType{Switch} expression representing \spad{x>y}. + LE : (EXPR,EXPR) -> $ + ++ LE(x,y) returns the \axiomType{Switch} expression representing \spad{x<=y}. + GE : (EXPR,EXPR) -> $ + ++ GE(x,y) returns the \axiomType{Switch} expression representing \spad{x>=y}. + OR : (EXPR,EXPR) -> $ + ++ OR(x,y) returns the \axiomType{Switch} expression representing \spad{x or y}. + EQ : (EXPR,EXPR) -> $ + ++ EQ(x,y) returns the \axiomType{Switch} expression representing \spad{x = y}. + AND : (EXPR,EXPR) -> $ + ++ AND(x,y) returns the \axiomType{Switch} expression representing \spad{x and y}. + NOT : EXPR -> $ + ++ NOT(x) returns the \axiomType{Switch} expression representing \spad{\~~x}. + NOT : $ -> $ + ++ NOT(x) returns the \axiomType{Switch} expression representing \spad{\~~x}. + + private == add + Rep := Record(op:BasicOperator,rands:List EXPR) + + -- Public function definitions + + nullOp : BasicOperator := operator NULL + + coerce(s:%):OutputForm == + rat := (s . op)::OutputForm + ran := [u::OutputForm for u in s.rands] + (s . op) = nullOp => first ran + #ran = 1 => + prefix(rat,ran) + infix(rat,ran) + + coerce(s:Symbol):$ == [nullOp,[[s::Expression(Integer)]$EXPR]$List(EXPR)]$Rep + + NOT(r:EXPR):% == + [operator("~"::Symbol),[r]$List(EXPR)]$Rep + + NOT(r:%):% == + [operator("~"::Symbol),[[r]$EXPR]$List(EXPR)]$Rep + + LT(r1:EXPR,r2:EXPR):% == + [operator("<"::Symbol),[r1,r2]$List(EXPR)]$Rep + + GT(r1:EXPR,r2:EXPR):% == + [operator(">"::Symbol),[r1,r2]$List(EXPR)]$Rep + + LE(r1:EXPR,r2:EXPR):% == + [operator("<="::Symbol),[r1,r2]$List(EXPR)]$Rep + + GE(r1:EXPR,r2:EXPR):% == + [operator(">="::Symbol),[r1,r2]$List(EXPR)]$Rep + + AND(r1:EXPR,r2:EXPR):% == + [operator("and"::Symbol),[r1,r2]$List(EXPR)]$Rep + + OR(r1:EXPR,r2:EXPR):% == + [operator("or"::Symbol),[r1,r2]$List(EXPR)]$Rep + + EQ(r1:EXPR,r2:EXPR):% == + [operator("EQ"::Symbol),[r1,r2]$List(EXPR)]$Rep + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain SYMTAB SymbolTable} +\pagehead{SymbolTable}{SYMTAB} +\pagepic{ps/v103symboltable.ps}{SYMTAB}{1.00} +See also:\\ +\refto{FortranScalarType}{FST} +\refto{FortranType}{FT} +\refto{TheSymbolTable}{SYMS} +<>= +)abbrev domain SYMTAB SymbolTable +++ Author: Mike Dewar +++ Date Created: October 1992 +++ Date Last Updated: 12 July 1994 +++ Basic Operations: +++ Related Domains: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ Examples: +++ References: +++ Description: Create and manipulate a symbol table for generated FORTRAN code +SymbolTable() : exports == implementation where + + T ==> Union(S:Symbol,P:Polynomial Integer) + TL1 ==> List T + TU ==> Union(name:Symbol,bounds:TL1) + TL ==> List TU + SEX ==> SExpression + OFORM ==> OutputForm + L ==> List + FSTU ==> Union(fst:FortranScalarType,void:"void") + + exports ==> CoercibleTo OutputForm with + coerce : $ -> Table(Symbol,FortranType) + ++ coerce(x) returns a table view of x + empty : () -> $ + ++ empty() returns a new, empty symbol table + declare! : (L Symbol,FortranType,$) -> FortranType + ++ declare!(l,t,tab) creates new entrys in tab, declaring each of l + ++ to be of type t + declare! : (Symbol,FortranType,$) -> FortranType + ++ declare!(u,t,tab) creates a new entry in tab, declaring u to be of + ++ type t + fortranTypeOf : (Symbol,$) -> FortranType + ++ fortranTypeOf(u,tab) returns the type of u in tab + parametersOf: $ -> L Symbol + ++ parametersOf(tab) returns a list of all the symbols declared in tab + typeList : (FortranScalarType,$) -> TL + ++ typeList(t,tab) returns a list of all the objects of type t in tab + externalList : $ -> L Symbol + ++ externalList(tab) returns a list of all the external symbols in tab + typeLists : $ -> L TL + ++ typeLists(tab) returns a list of lists of types of objects in tab + newTypeLists : $ -> SEX + ++ newTypeLists(x) \undocumented + printTypes: $ -> Void + ++ printTypes(tab) produces FORTRAN type declarations from tab, on the + ++ current FORTRAN output stream + symbolTable: L Record(key:Symbol,entry:FortranType) -> $ + ++ symbolTable(l) creates a symbol table from the elements of l. + + implementation ==> add + + Rep := Table(Symbol,FortranType) + + coerce(t:$):OFORM == + coerce(t)$Rep + + coerce(t:$):Table(Symbol,FortranType) == + t pretend Table(Symbol,FortranType) + + symbolTable(l:L Record(key:Symbol,entry:FortranType)):$ == + table(l)$Rep + + empty():$ == + empty()$Rep + + parametersOf(tab:$):L(Symbol) == + keys(tab) + + declare!(name:Symbol,type:FortranType,tab:$):FortranType == + setelt(tab,name,type)$Rep + type + + declare!(names:L Symbol,type:FortranType,tab:$):FortranType == + for name in names repeat setelt(tab,name,type)$Rep + type + + fortranTypeOf(u:Symbol,tab:$):FortranType == + elt(tab,u)$Rep + + externalList(tab:$):L(Symbol) == + [u for u in keys(tab) | external? fortranTypeOf(u,tab)] + + typeList(type:FortranScalarType,tab:$):TL == + scalarList := []@TL + arrayList := []@TL + for u in keys(tab)$Rep repeat + uType : FortranType := fortranTypeOf(u,tab) + sType : FSTU := scalarTypeOf(uType) + if (sType case fst and (sType.fst)=type) then + uDim : TL1 := [[v]$T for v in dimensionsOf(uType)] + if empty? uDim then + scalarList := cons([u]$TU,scalarList) + else + arrayList := cons([cons([u],uDim)$TL1]$TU,arrayList) + -- Scalars come first in case they are integers which are later + -- used as an array dimension. + append(scalarList,arrayList) + + typeList2(type:FortranScalarType,tab:$):TL == + tl := []@TL + symbolType : Symbol := coerce(type)$FortranScalarType + for u in keys(tab)$Rep repeat + uType : FortranType := fortranTypeOf(u,tab) + sType : FSTU := scalarTypeOf(uType) + if (sType case fst and (sType.fst)=type) then + uDim : TL1 := [[v]$T for v in dimensionsOf(uType)] + tl := if empty? uDim then cons([u]$TU,tl) + else cons([cons([u],uDim)$TL1]$TU,tl) + empty? tl => tl + cons([symbolType]$TU,tl) + + updateList(sType:SEX,name:SEX,lDims:SEX,tl:SEX):SEX == + l : SEX := ASSOC(sType,tl)$Lisp + entry : SEX := if null?(lDims) then name else CONS(name,lDims)$Lisp + null?(l) => CONS([sType,entry]$Lisp,tl)$Lisp + RPLACD(l,CONS(entry,cdr l)$Lisp)$Lisp + tl + + newTypeLists(tab:$):SEX == + tl := []$Lisp + for u in keys(tab)$Rep repeat + uType : FortranType := fortranTypeOf(u,tab) + sType : FSTU := scalarTypeOf(uType) + dims : L Polynomial Integer := dimensionsOf uType + lDims : L SEX := [convert(convert(v)@InputForm)@SEX for v in dims] + lType : SEX := if sType case void + then convert(void::Symbol)@SEX + else coerce(sType.fst)$FortranScalarType + tl := updateList(lType,convert(u)@SEX,convert(lDims)@SEX,tl) + tl + + typeLists(tab:$):L(TL) == + fortranTypes := ["real"::FortranScalarType, _ + "double precision"::FortranScalarType, _ + "integer"::FortranScalarType, _ + "complex"::FortranScalarType, _ + "logical"::FortranScalarType, _ + "character"::FortranScalarType]@L(FortranScalarType) + tl := []@L TL + for u in fortranTypes repeat + types : TL := typeList2(u,tab) + if (not null types) then + tl := cons(types,tl)$(L TL) + tl + + oForm2(w:T):OFORM == + w case S => w.S::OFORM + w case P => w.P::OFORM + + oForm(v:TU):OFORM == + v case name => v.name::OFORM + v case bounds => + ll : L OFORM := [oForm2(uu) for uu in v.bounds] + ll :: OFORM + + outForm(t:TL):L OFORM == + [oForm(u) for u in t] + + printTypes(tab:$):Void == + -- It is important that INTEGER is the first element of this + -- list since INTEGER symbols used in type declarations must + -- be declared in advance. + ft := ["integer"::FortranScalarType, _ + "real"::FortranScalarType, _ + "double precision"::FortranScalarType, _ + "complex"::FortranScalarType, _ + "logical"::FortranScalarType, _ + "character"::FortranScalarType]@L(FortranScalarType) + for ty in ft repeat + tl : TL := typeList(ty,tab) + otl : L OFORM := outForm(tl) + fortFormatTypes(ty::OFORM,otl)$Lisp + el : L OFORM := [u::OFORM for u in externalList(tab)] + fortFormatTypes("EXTERNAL"::OFORM,el)$Lisp + void()$Void + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Chapter T} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain TEXTFILE TextFile} +<>= +-- files.spad.pamphlet TextFile.input +)spool TextFile.output +)set message test on +)set message auto off +)clear all +--S 1 of 10 +f1: TextFile := open("/etc/group", "input") +--R +--R +--R (1) "/etc/group" +--R Type: TextFile +--E 1 + +--S 2 of 10 +f2: TextFile := open("MOTD", "output") +--R +--R +--R (2) "MOTD" +--R Type: TextFile +--E 2 + +--S 3 of 10 +l := readLine! f1 +--R +--R +--R (3) "root:x:0:root" +--R Type: String +--E 3 + +--S 4 of 10 +writeLine!(f2, upperCase l) +--R +--R +--R (4) "ROOT:X:0:ROOT" +--R Type: String +--E 4 + +--S 5 of 10 +while not endOfFile? f1 repeat + s := readLine! f1 + writeLine!(f2, upperCase s) +--R +--R Type: Void +--E 5 + +--S 6 of 10 +close! f1 +--R +--R +--R (6) "/etc/group" +--R Type: TextFile +--E 6 + +--S 7 of 10 +write!(f2, "-The-") +--R +--R +--R (7) "-The-" +--R Type: String +--E 7 + +--S 8 of 10 +write!(f2, "-End-") +--R +--R +--R (8) "-End-" +--R Type: String +--E 8 + +--S 9 of 10 +writeLine! f2 +--R +--R +--R (9) "" +--R Type: String +--E 9 + +--S 10 of 10 +close! f2 +--R +--R +--R (10) "MOTD" +--R Type: TextFile +--E 10 +)system rm -f MOTD +)spool +)lisp (bye) +@ +<>= +==================================================================== +TextFile examples +==================================================================== + +The domain TextFile allows Axiom to read and write character data and +exchange text with other programs. This type behaves in Axiom much +like a File of strings, with additional operations to cause new lines. +We give an example of how to produce an upper case copy of a file. + +This is the file from which we read the text. + + f1: TextFile := open("/etc/group", "input") + "/etc/group" + Type: TextFile + +This is the file to which we write the text. + + f2: TextFile := open("/tmp/MOTD", "output") + "MOTD" + Type: TextFile + +Entire lines are handled using the readLine and writeLine operations. + + l := readLine! f1 + "root:x:0:root" + Type: String + + writeLine!(f2, upperCase l) + "ROOT:X:0:ROOT" + Type: String + +Use the endOfFile? operation to check if you have reached the end of the file. + + while not endOfFile? f1 repeat + s := readLine! f1 + writeLine!(f2, upperCase s) + Type: Void + +The file f1 is exhausted and should be closed. + + close! f1 + "/etc/group" + Type: TextFile + +It is sometimes useful to write lines a bit at a time. The write operation +allows this. + + write!(f2, "-The-") + "-The-" + Type: String + + write!(f2, "-End-") + "-End-" + Type: String + +This ends the line. This is done in a machine-dependent manner. + + writeLine! f2 + "" + Type: String + + close! f2 + "MOTD" + Type: TextFile + +Finally, clean up. + + )system rm /tmp/MOTD + +See Also: +o )help File +o )help KeyedAccessFile +o )help Library +o )show TextFile +o $AXIOM/doc/src/algebra/files.spad.dvi + +@ +\pagehead{TextFile}{TEXTFILE} +\pagepic{ps/v103textfile.ps}{TEXTFILE}{1.00} +See also:\\ +\refto{File}{FILE} +\refto{BinaryFile}{BINFILE} +\refto{KeyedAccessFile}{KAFILE} +\refto{Library}{LIB} +<>= +)abbrev domain TEXTFILE TextFile +++ Author: Stephen M. Watt +++ Date Created: 1985 +++ Date Last Updated: June 4, 1991 +++ Basic Operations: writeLine! readLine! readLineIfCan! readIfCan! endOfFile? +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ This domain provides an implementation of text files. Text is stored +++ in these files using the native character set of the computer. + +TextFile: Cat == Def where + StreamName ==> Union(FileName, "console") + + Cat == FileCategory(FileName, String) with + writeLine_!: (%, String) -> String + ++ writeLine!(f,s) writes the contents of the string s + ++ and finishes the current line in the file f. + ++ The value of s is returned. + + writeLine_!: % -> String + ++ writeLine!(f) finishes the current line in the file f. + ++ An empty string is returned. The call \spad{writeLine!(f)} is + ++ equivalent to \spad{writeLine!(f,"")}. + + readLine_!: % -> String + ++ readLine!(f) returns a string of the contents of a line from + ++ the file f. + + readLineIfCan_!: % -> Union(String, "failed") + ++ readLineIfCan!(f) returns a string of the contents of a line from + ++ file f, if possible. If f is not readable or if it is + ++ positioned at the end of file, then \spad{"failed"} is returned. + + readIfCan_!: % -> Union(String, "failed") + ++ readIfCan!(f) returns a string of the contents of a line from + ++ file f, if possible. If f is not readable or if it is + ++ positioned at the end of file, then \spad{"failed"} is returned. + + endOfFile?: % -> Boolean + ++ endOfFile?(f) tests whether the file f is positioned after the + ++ end of all text. If the file is open for output, then + ++ this test is always true. + + Def == File(String) add + FileState ==> SExpression + + Rep := Record(fileName: FileName, _ + fileState: FileState, _ + fileIOmode: String) + + read_! f == readLine_! f + readIfCan_! f == readLineIfCan_! f + + readLine_! f == + f.fileIOmode ^= "input" => error "File not in read state" + s: String := read_-line(f.fileState)$Lisp + PLACEP(s)$Lisp => error "End of file" + s + readLineIfCan_! f == + f.fileIOmode ^= "input" => error "File not in read state" + s: String := read_-line(f.fileState)$Lisp + PLACEP(s)$Lisp => "failed" + s + write_!(f, x) == + f.fileIOmode ^= "output" => error "File not in write state" + PRINTEXP(x, f.fileState)$Lisp + x + writeLine_! f == + f.fileIOmode ^= "output" => error "File not in write state" + TERPRI(f.fileState)$Lisp + "" + writeLine_!(f, x) == + f.fileIOmode ^= "output" => error "File not in write state" + PRINTEXP(x, f.fileState)$Lisp + TERPRI(f.fileState)$Lisp + x + endOfFile? f == + f.fileIOmode = "output" => false + (EOFP(f.fileState)$Lisp pretend Boolean) => true + false + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain SYMS TheSymbolTable} +\pagehead{TheSymbolTable}{SYMS} +\pagepic{ps/v103thesymboltable.ps}{SYMS}{1.00} +See also:\\ +\refto{FortranScalarType}{FST} +\refto{FortranType}{FT} +\refto{SymbolTable}{SYMTAB} +<>= +)abbrev domain SYMS TheSymbolTable +++ Author: Mike Dewar +++ Date Created: October 1992 +++ Date Last Updated: +++ Basic Operations: +++ Related Domains: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ Examples: +++ References: +++ Description: Creates and manipulates one global symbol table for FORTRAN +++ code generation, containing details of types, dimensions, and argument +++ lists. +TheSymbolTable() : Exports == Implementation where + + S ==> Symbol + FST ==> FortranScalarType + FSTU ==> Union(fst:FST,void:"void") + + Exports == CoercibleTo OutputForm with + showTheSymbolTable : () -> $ + ++ showTheSymbolTable() returns the current symbol table. + clearTheSymbolTable : () -> Void + ++ clearTheSymbolTable() clears the current symbol table. + clearTheSymbolTable : Symbol -> Void + ++ clearTheSymbolTable(x) removes the symbol x from the table + declare! : (Symbol,FortranType,Symbol,$) -> FortranType + ++ declare!(u,t,asp,tab) declares the parameter u of subprogram asp + ++ to have type t in symbol table tab. + declare! : (List Symbol,FortranType,Symbol,$) -> FortranType + ++ declare!(u,t,asp,tab) declares the parameters u of subprogram asp + ++ to have type t in symbol table tab. + declare! : (Symbol,FortranType) -> FortranType + ++ declare!(u,t) declares the parameter u to have type t in the + ++ current level of the symbol table. + declare! : (Symbol,FortranType,Symbol) -> FortranType + ++ declare!(u,t,asp) declares the parameter u to have type t in asp. + newSubProgram : Symbol -> Void + ++ newSubProgram(f) asserts that from now on type declarations are part + ++ of subprogram f. + currentSubProgram : () -> Symbol + ++ currentSubProgram() returns the name of the current subprogram being + ++ processed + endSubProgram : () -> Symbol + ++ endSubProgram() asserts that we are no longer processing the current + ++ subprogram. + argumentList! : (Symbol,List Symbol,$) -> Void + ++ argumentList!(f,l,tab) declares that the argument list for subprogram f + ++ in symbol table tab is l. + argumentList! : (Symbol,List Symbol) -> Void + ++ argumentList!(f,l) declares that the argument list for subprogram f in + ++ the global symbol table is l. + argumentList! : List Symbol -> Void + ++ argumentList!(l) declares that the argument list for the current + ++ subprogram in the global symbol table is l. + returnType! : (Symbol,FSTU,$) -> Void + ++ returnType!(f,t,tab) declares that the return type of subprogram f in + ++ symbol table tab is t. + returnType! : (Symbol,FSTU) -> Void + ++ returnType!(f,t) declares that the return type of subprogram f in + ++ the global symbol table is t. + returnType! : FSTU -> Void + ++ returnType!(t) declares that the return type of he current subprogram + ++ in the global symbol table is t. + printHeader : (Symbol,$) -> Void + ++ printHeader(f,tab) produces the FORTRAN header for subprogram f in + ++ symbol table tab on the current FORTRAN output stream. + printHeader : Symbol -> Void + ++ printHeader(f) produces the FORTRAN header for subprogram f in + ++ the global symbol table on the current FORTRAN output stream. + printHeader : () -> Void + ++ printHeader() produces the FORTRAN header for the current subprogram in + ++ the global symbol table on the current FORTRAN output stream. + printTypes: Symbol -> Void + ++ printTypes(tab) produces FORTRAN type declarations from tab, on the + ++ current FORTRAN output stream + empty : () -> $ + ++ empty() creates a new, empty symbol table. + returnTypeOf : (Symbol,$) -> FSTU + ++ returnTypeOf(f,tab) returns the type of the object returned by f + argumentListOf : (Symbol,$) -> List(Symbol) + ++ argumentListOf(f,tab) returns the argument list of f + symbolTableOf : (Symbol,$) -> SymbolTable + ++ symbolTableOf(f,tab) returns the symbol table of f + + Implementation == add + + Entry : Domain := Record(symtab:SymbolTable, _ + returnType:FSTU, _ + argList:List Symbol) + + Rep := Table(Symbol,Entry) + + -- These are the global variables we want to update: + theSymbolTable : $ := empty()$Rep + currentSubProgramName : Symbol := MAIN + + newEntry():Entry == + construct(empty()$SymbolTable,["void"]$FSTU,[]::List(Symbol))$Entry + + checkIfEntryExists(name:Symbol,tab:$) : Void == + key?(name,tab) => void()$Void + setelt(tab,name,newEntry())$Rep + void()$Void + + returnTypeOf(name:Symbol,tab:$):FSTU == + elt(elt(tab,name)$Rep,returnType)$Entry + + argumentListOf(name:Symbol,tab:$):List(Symbol) == + elt(elt(tab,name)$Rep,argList)$Entry + + symbolTableOf(name:Symbol,tab:$):SymbolTable == + elt(elt(tab,name)$Rep,symtab)$Entry + + coerce(u:$):OutputForm == + coerce(u)$Rep + + showTheSymbolTable():$ == + theSymbolTable + + clearTheSymbolTable():Void == + theSymbolTable := empty()$Rep + void()$Void + + clearTheSymbolTable(u:Symbol):Void == + remove!(u,theSymbolTable)$Rep + void()$Void + + empty():$ == + empty()$Rep + + currentSubProgram():Symbol == + currentSubProgramName + + endSubProgram():Symbol == + -- If we want to support more complex languages then we should keep + -- a list of subprograms / blocks - but for the moment lets stick with + -- Fortran. + currentSubProgramName := MAIN + + newSubProgram(u:Symbol):Void == + setelt(theSymbolTable,u,newEntry())$Rep + currentSubProgramName := u + void()$Void + + argumentList!(u:Symbol,args:List Symbol,symbols:$):Void == + checkIfEntryExists(u,symbols) + setelt(elt(symbols,u)$Rep,argList,args)$Entry + + argumentList!(u:Symbol,args:List Symbol):Void == + argumentList!(u,args,theSymbolTable) + + argumentList!(args:List Symbol):Void == + checkIfEntryExists(currentSubProgramName,theSymbolTable) + setelt(elt(theSymbolTable,currentSubProgramName)$Rep, _ + argList,args)$Entry + + returnType!(u:Symbol,type:FSTU,symbols:$):Void == + checkIfEntryExists(u,symbols) + setelt(elt(symbols,u)$Rep,returnType,type)$Entry + + returnType!(u:Symbol,type:FSTU):Void == + returnType!(u,type,theSymbolTable) + + returnType!(type:FSTU ):Void == + checkIfEntryExists(currentSubProgramName,theSymbolTable) + setelt(elt(theSymbolTable,currentSubProgramName)$Rep, _ + returnType,type)$Entry + + declare!(u:Symbol,type:FortranType):FortranType == + declare!(u,type,currentSubProgramName,theSymbolTable) + + declare!(u:Symbol,type:FortranType,asp:Symbol,symbols:$):FortranType == + checkIfEntryExists(asp,symbols) + declare!(u,type, elt(elt(symbols,asp)$Rep,symtab)$Entry)$SymbolTable + + declare!(u:List Symbol,type:FortranType,asp:Symbol,syms:$):FortranType == + checkIfEntryExists(asp,syms) + declare!(u,type, elt(elt(syms,asp)$Rep,symtab)$Entry)$SymbolTable + + declare!(u:Symbol,type:FortranType,asp:Symbol):FortranType == + checkIfEntryExists(asp,theSymbolTable) + declare!(u,type,elt(elt(theSymbolTable,asp)$Rep,symtab)$Entry)$SymbolTable + + printHeader(u:Symbol,symbols:$):Void == + entry := elt(symbols,u)$Rep + fortFormatHead(elt(entry,returnType)$Entry::OutputForm,u::OutputForm, _ + elt(entry,argList)$Entry::OutputForm)$Lisp + printTypes(elt(entry,symtab)$Entry)$SymbolTable + + printHeader(u:Symbol):Void == + printHeader(u,theSymbolTable) + + printHeader():Void == + printHeader(currentSubProgramName,theSymbolTable) + + printTypes(u:Symbol):Void == + printTypes(elt(elt(theSymbolTable,u)$Rep,symtab)$Entry)$SymbolTable + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain M3D ThreeDimensionalMatrix} +\pagehead{ThreeDimensionalMatrix}{M3D} +\pagepic{ps/v103threedimensionalmatrix.ps}{M3D}{1.00} +See also:\\ +\refto{Result}{RESULT} +\refto{FortranCode}{FC} +\refto{FortranProgram}{FORTRAN} +\refto{SimpleFortranProgram}{SFORT} +\refto{Switch}{SWITCH} +\refto{FortranTemplate}{FTEM} +\refto{FortranExpression}{FEXPR} +<>= +)abbrev domain M3D ThreeDimensionalMatrix +++ Author: William Naylor +++ Date Created: 20 October 1993 +++ Date Last Updated: 20 May 1994 +++ BasicFunctions: +++ Related Constructors: Matrix +++ Also See: PrimitiveArray +++ AMS Classification: +++ Keywords: +++ References: +++ Description: +++ This domain represents three dimensional matrices over a general object type +ThreeDimensionalMatrix(R) : Exports == Implementation where + + R : SetCategory + L ==> List + NNI ==> NonNegativeInteger + A1AGG ==> OneDimensionalArrayAggregate + ARRAY1 ==> OneDimensionalArray + PA ==> PrimitiveArray + INT ==> Integer + PI ==> PositiveInteger + + Exports ==> HomogeneousAggregate(R) with + + if R has Ring then + zeroMatrix : (NNI,NNI,NNI) -> $ + ++ zeroMatrix(i,j,k) create a matrix with all zero terms + identityMatrix : (NNI) -> $ + ++ identityMatrix(n) create an identity matrix + ++ we note that this must be square + plus : ($,$) -> $ + ++ plus(x,y) adds two matrices, term by term + ++ we note that they must be the same size + construct : (L L L R) -> $ + ++ construct(lll) creates a 3-D matrix from a List List List R lll + elt : ($,NNI,NNI,NNI) -> R + ++ elt(x,i,j,k) extract an element from the matrix x + setelt! :($,NNI,NNI,NNI,R) -> R + ++ setelt!(x,i,j,k,s) (or x.i.j.k:=s) sets a specific element of the array to some value of type R + coerce : (PA PA PA R) -> $ + ++ coerce(p) moves from the representation type + ++ (PrimitiveArray PrimitiveArray PrimitiveArray R) + ++ to the domain + coerce : $ -> (PA PA PA R) + ++ coerce(x) moves from the domain to the representation type + matrixConcat3D : (Symbol,$,$) -> $ + ++ matrixConcat3D(s,x,y) concatenates two 3-D matrices along a specified axis + matrixDimensions : $ -> Vector NNI + ++ matrixDimensions(x) returns the dimensions of a matrix + + Implementation ==> (PA PA PA R) add + + import (PA PA PA R) + import (PA PA R) + import (PA R) + import R + + matrix1,matrix2,resultMatrix : $ + + -- function to concatenate two matrices + -- the first argument must be a symbol, which is either i,j or k + -- to specify the direction in which the concatenation is to take place + matrixConcat3D(dir : Symbol,mat1 : $,mat2 : $) : $ == + ^((dir = (i::Symbol)) or (dir = (j::Symbol)) or (dir = (k::Symbol)))_ + => error "the axis of concatenation must be i,j or k" + mat1Dim := matrixDimensions(mat1) + mat2Dim := matrixDimensions(mat2) + iDim1 := mat1Dim.1 + jDim1 := mat1Dim.2 + kDim1 := mat1Dim.3 + iDim2 := mat2Dim.1 + jDim2 := mat2Dim.2 + kDim2 := mat2Dim.3 + matRep1 : (PA PA PA R) := copy(mat1 :: (PA PA PA R))$(PA PA PA R) + matRep2 : (PA PA PA R) := copy(mat2 :: (PA PA PA R))$(PA PA PA R) + retVal : $ + + if (dir = (i::Symbol)) then + -- j,k dimensions must agree + if (^((jDim1 = jDim2) and (kDim1=kDim2))) + then + error "jxk do not agree" + else + retVal := (coerce(concat(matRep1,matRep2)$(PA PA PA R))$$)@$ + + if (dir = (j::Symbol)) then + -- i,k dimensions must agree + if (^((iDim1 = iDim2) and (kDim1=kDim2))) + then + error "ixk do not agree" + else + for i in 0..(iDim1-1) repeat + setelt(matRep1,i,(concat(elt(matRep1,i)$(PA PA PA R)_ + ,elt(matRep2,i)$(PA PA PA R))$(PA PA R))@(PA PA R))$(PA PA PA R) + retVal := (coerce(matRep1)$$)@$ + + if (dir = (k::Symbol)) then + temp : (PA PA R) + -- i,j dimensions must agree + if (^((iDim1 = iDim2) and (jDim1=jDim2))) + then + error "ixj do not agree" + else + for i in 0..(iDim1-1) repeat + temp := copy(elt(matRep1,i)$(PA PA PA R))$(PA PA R) + for j in 0..(jDim1-1) repeat + setelt(temp,j,concat(elt(elt(matRep1,i)$(PA PA PA R)_ + ,j)$(PA PA R),elt(elt(matRep2,i)$(PA PA PA R),j)$(PA PA R)_ + )$(PA R))$(PA PA R) + setelt(matRep1,i,temp)$(PA PA PA R) + retVal := (coerce(matRep1)$$)@$ + + retVal + + matrixDimensions(mat : $) : Vector NNI == + matRep : (PA PA PA R) := mat :: (PA PA PA R) + iDim : NNI := (#matRep)$(PA PA PA R) + matRep2 : PA PA R := elt(matRep,0)$(PA PA PA R) + jDim : NNI := (#matRep2)$(PA PA R) + matRep3 : (PA R) := elt(matRep2,0)$(PA PA R) + kDim : NNI := (#matRep3)$(PA R) + retVal : Vector NNI := new(3,0)$(Vector NNI) + retVal.1 := iDim + retVal.2 := jDim + retVal.3 := kDim + retVal + + coerce(matrixRep : (PA PA PA R)) : $ == matrixRep pretend $ + + coerce(mat : $) : (PA PA PA R) == mat pretend (PA PA PA R) + + -- i,j,k must be with in the bounds of the matrix + elt(mat : $,i : NNI,j : NNI,k : NNI) : R == + matDims := matrixDimensions(mat) + iLength := matDims.1 + jLength := matDims.2 + kLength := matDims.3 + ((i > iLength) or (j > jLength) or (k > kLength) or (i=0) or (j=0) or_ +(k=0)) => error "coordinates must be within the bounds of the matrix" + matrixRep : PA PA PA R := mat :: (PA PA PA R) + elt(elt(elt(matrixRep,i-1)$(PA PA PA R),j-1)$(PA PA R),k-1)$(PA R) + + setelt!(mat : $,i : NNI,j : NNI,k : NNI,val : R)_ + : R == + matDims := matrixDimensions(mat) + iLength := matDims.1 + jLength := matDims.2 + kLength := matDims.3 + ((i > iLength) or (j > jLength) or (k > kLength) or (i=0) or (j=0) or_ +(k=0)) => error "coordinates must be within the bounds of the matrix" + matrixRep : PA PA PA R := mat :: (PA PA PA R) + row2 : PA PA R := copy(elt(matrixRep,i-1)$(PA PA PA R))$(PA PA R) + row1 : PA R := copy(elt(row2,j-1)$(PA PA R))$(PA R) + setelt(row1,k-1,val)$(PA R) + setelt(row2,j-1,row1)$(PA PA R) + setelt(matrixRep,i-1,row2)$(PA PA PA R) + val + + if R has Ring then + zeroMatrix(iLength:NNI,jLength:NNI,kLength:NNI) : $ == + (new(iLength,new(jLength,new(kLength,(0$R))$(PA R))$(PA PA R))$(PA PA PA R)) :: $ + + identityMatrix(iLength:NNI) : $ == + retValueRep : PA PA PA R := zeroMatrix(iLength,iLength,iLength)$$ :: (PA PA PA R) + row1 : PA R + row2 : PA PA R + row1empty : PA R := new(iLength,0$R)$(PA R) + row2empty : PA PA R := new(iLength,copy(row1empty)$(PA R))$(PA PA R) + for count in 0..(iLength-1) repeat + row1 := copy(row1empty)$(PA R) + setelt(row1,count,1$R)$(PA R) + row2 := copy(row2empty)$(PA PA R) + setelt(row2,count,copy(row1)$(PA R))$(PA PA R) + setelt(retValueRep,count,copy(row2)$(PA PA R))$(PA PA PA R) + retValueRep :: $ + + + plus(mat1 : $,mat2 :$) : $ == + + mat1Dims := matrixDimensions(mat1) + iLength1 := mat1Dims.1 + jLength1 := mat1Dims.2 + kLength1 := mat1Dims.3 + + mat2Dims := matrixDimensions(mat2) + iLength2 := mat2Dims.1 + jLength2 := mat2Dims.2 + kLength2 := mat2Dims.3 + + -- check that the dimensions are the same + (^(iLength1 = iLength2) or ^(jLength1 = jLength2) or ^(kLength1 = kLength2))_ + => error "error the matrices are different sizes" + + sum : R + row1 : (PA R) := new(kLength1,0$R)$(PA R) + row2 : (PA PA R) := new(jLength1,copy(row1)$(PA R))$(PA PA R) + row3 : (PA PA PA R) := new(iLength1,copy(row2)$(PA PA R))$(PA PA PA R) + + for i in 1..iLength1 repeat + for j in 1..jLength1 repeat + for k in 1..kLength1 repeat + sum := (elt(mat1,i,j,k)::R +$R_ + elt(mat2,i,j,k)::R) + setelt(row1,k-1,sum)$(PA R) + setelt(row2,j-1,copy(row1)$(PA R))$(PA PA R) + setelt(row3,i-1,copy(row2)$(PA PA R))$(PA PA PA R) + + resultMatrix := (row3 pretend $) + + resultMatrix + + construct(listRep : L L L R) : $ == + + (#listRep)$(L L L R) = 0 => error "empty list" + (#(listRep.1))$(L L R) = 0 => error "empty list" + (#((listRep.1).1))$(L R) = 0 => error "empty list" + iLength := (#listRep)$(L L L R) + jLength := (#(listRep.1))$(L L R) + kLength := (#((listRep.1).1))$(L R) + + --first check that the matrix is in the correct form + for subList in listRep repeat + ^((#subList)$(L L R) = jLength) => error_ + "can not have an irregular shaped matrix" + for subSubList in subList repeat + ^((#(subSubList))$(L R) = kLength) => error_ + "can not have an irregular shaped matrix" + + row1 : (PA R) := new(kLength,((listRep.1).1).1)$(PA R) + row2 : (PA PA R) := new(jLength,copy(row1)$(PA R))$(PA PA R) + row3 : (PA PA PA R) := new(iLength,copy(row2)$(PA PA R))$(PA PA PA R) + + for i in 1..iLength repeat + for j in 1..jLength repeat + for k in 1..kLength repeat + + element := elt(elt(elt(listRep,i)$(L L L R),j)$(L L R),k)$(L R) + setelt(row1,k-1,element)$(PA R) + setelt(row2,j-1,copy(row1)$(PA R))$(PA PA R) + setelt(row3,i-1,copy(row2)$(PA PA R))$(PA PA PA R) + + resultMatrix := (row3 pretend $) + + resultMatrix + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{domain TUPLE Tuple} <>= "TUPLE" -> "PRIMARR" @@ -23236,6 +34593,8 @@ Note that this code is not included in the generated catdef.spad file. <> <> +<> +<> <> <> @@ -23243,6 +34602,7 @@ Note that this code is not included in the generated catdef.spad file. <> <> <> +<> <> <> @@ -23283,10 +34643,38 @@ Note that this code is not included in the generated catdef.spad file. <> <> +<> +<> +<> <> <> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> <> <> +<> +<> +<> +<> +<> +<> <> <> @@ -23297,9 +34685,23 @@ Note that this code is not included in the generated catdef.spad file. <> <> <> +<> +<> <> +<> <> +<> + +<> +<> +<> +<> + +<> +<> +<> + <> <> @@ -23313,6 +34715,7 @@ Note that this code is not included in the generated catdef.spad file. <> <> <> +<> <> <> @@ -23325,12 +34728,20 @@ Note that this code is not included in the generated catdef.spad file. <> <> +<> +<> <> +<> <> <> <> +<> +<> +<> +<> +<> <> <> diff --git a/books/ps/v103basicfunctions.ps b/books/ps/v103basicfunctions.ps new file mode 100644 index 0000000..df2b09f --- /dev/null +++ b/books/ps/v103basicfunctions.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 148 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 148 80 +%%PageOrientation: Portrait +gsave +36 36 112 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 +110 42 lineto +110 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +110 42 lineto +110 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% BasicFunctions +[ /Rect [ 0 0 104 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=BFUNCT) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 104 36 moveto +0 36 lineto +0 0 lineto +104 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 104 36 moveto +0 36 lineto +0 0 lineto +104 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +8 13 moveto +(BasicFunctions) +[9.36 6.24 5.52 3.84 6.24 7.44 6.96 6.96 6.24 3.84 3.84 6.96 6.96 5.52] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103binaryfile.ps b/books/ps/v103binaryfile.ps new file mode 100644 index 0000000..abff678 --- /dev/null +++ b/books/ps/v103binaryfile.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 +% BinaryFile +[ /Rect [ 0 0 76 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=BINFILE) >> + /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 +7 13 moveto +(BinaryFile) +[9.36 3.84 6.96 6.24 5.04 6.96 7.44 3.84 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/v103commutator.ps b/books/ps/v103commutator.ps new file mode 100644 index 0000000..67974f7 --- /dev/null +++ b/books/ps/v103commutator.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 130 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 130 80 +%%PageOrientation: Portrait +gsave +36 36 94 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 +92 42 lineto +92 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +92 42 lineto +92 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% Commutator +[ /Rect [ 0 0 86 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=COMM) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 86 36 moveto +0 36 lineto +0 0 lineto +86 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 86 36 moveto +0 36 lineto +0 0 lineto +86 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +7 13 moveto +(Commutator) +[9.36 6.96 10.8 10.8 6.96 4.08 6.24 3.84 6.96 4.8] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103factored.ps b/books/ps/v103factored.ps new file mode 100644 index 0000000..0ca5452 --- /dev/null +++ b/books/ps/v103factored.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 108 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 108 80 +%%PageOrientation: Portrait +gsave +36 36 72 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 +70 42 lineto +70 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +70 42 lineto +70 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% Factored +[ /Rect [ 0 0 64 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=FR) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 64 36 moveto +0 36 lineto +0 0 lineto +64 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 64 36 moveto +0 36 lineto +0 0 lineto +64 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +7 13 moveto +(Factored) +[7.2 6.24 6.24 3.84 6.96 4.8 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/v103file.ps b/books/ps/v103file.ps new file mode 100644 index 0000000..92d4ff6 --- /dev/null +++ b/books/ps/v103file.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 +% File +[ /Rect [ 0 0 54 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=FILE) >> + /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 +16 13 moveto +(File) +[7.44 3.84 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/v103filename.ps b/books/ps/v103filename.ps new file mode 100644 index 0000000..533cf08 --- /dev/null +++ b/books/ps/v103filename.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 114 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 114 80 +%%PageOrientation: Portrait +gsave +36 36 78 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 +76 42 lineto +76 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +76 42 lineto +76 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% FileName +[ /Rect [ 0 0 70 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=FNAME) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 70 36 moveto +0 36 lineto +0 0 lineto +70 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 70 36 moveto +0 36 lineto +0 0 lineto +70 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +7 13 moveto +(FileName) +[7.44 3.84 3.84 6.24 9.6 6.24 10.8 6.24] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103finitefield.ps b/books/ps/v103finitefield.ps new file mode 100644 index 0000000..6da280d --- /dev/null +++ b/books/ps/v103finitefield.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 +% FiniteField +[ /Rect [ 0 0 76 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=FF) >> + /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 +7 13 moveto +(FiniteField) +[7.44 3.84 6.96 3.84 3.84 6.24 7.44 3.84 6.24 3.84 6.96] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103finitefieldcyclicgroup.ps b/books/ps/v103finitefieldcyclicgroup.ps new file mode 100644 index 0000000..08bfe69 --- /dev/null +++ b/books/ps/v103finitefieldcyclicgroup.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 192 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 192 80 +%%PageOrientation: Portrait +gsave +36 36 156 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 +154 42 lineto +154 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +154 42 lineto +154 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% FiniteFieldCyclicGroup +[ /Rect [ 0 0 148 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=FFCG) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 148 36 moveto +0 36 lineto +0 0 lineto +148 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 148 36 moveto +0 36 lineto +0 0 lineto +148 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +7 13 moveto +(FiniteFieldCyclicGroup) +[7.44 3.84 6.96 3.84 3.84 6.24 7.44 3.84 6.24 3.84 6.96 9.36 6.48 6.24 3.84 3.84 6.24 10.08 4.8 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/v103finitefieldcyclicgroupextension.ps b/books/ps/v103finitefieldcyclicgroupextension.ps new file mode 100644 index 0000000..8e7639a --- /dev/null +++ b/books/ps/v103finitefieldcyclicgroupextension.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 248 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 248 80 +%%PageOrientation: Portrait +gsave +36 36 212 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 +210 42 lineto +210 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +210 42 lineto +210 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% FiniteFieldCyclicGroupExtension +[ /Rect [ 0 0 204 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=FFCGX) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 204 36 moveto +0 36 lineto +0 0 lineto +204 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 204 36 moveto +0 36 lineto +0 0 lineto +204 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +7 13 moveto +(FiniteFieldCyclicGroupExtension) +[7.44 3.84 6.96 3.84 3.84 6.24 7.44 3.84 6.24 3.84 6.96 9.36 6.48 6.24 3.84 3.84 6.24 10.08 4.8 6.96 6.96 6.96 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/v103finitefieldcyclicgroupextensionbypolynomial.ps b/books/ps/v103finitefieldcyclicgroupextensionbypolynomial.ps new file mode 100644 index 0000000..88229dc --- /dev/null +++ b/books/ps/v103finitefieldcyclicgroupextensionbypolynomial.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 328 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 328 80 +%%PageOrientation: Portrait +gsave +36 36 292 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 +290 42 lineto +290 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +290 42 lineto +290 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% FiniteFieldCyclicGroupExtensionByPolynomial +[ /Rect [ 0 0 284 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=FFCGP) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 284 36 moveto +0 36 lineto +0 0 lineto +284 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 284 36 moveto +0 36 lineto +0 0 lineto +284 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +7 13 moveto +(FiniteFieldCyclicGroupExtensionByPolynomial) +[7.44 3.84 6.96 3.84 3.84 6.24 7.44 3.84 6.24 3.84 6.96 9.36 6.48 6.24 3.84 3.84 6.24 10.08 4.8 6.96 6.96 6.96 8.64 6.96 3.84 6.24 6.96 5.52 3.84 6.96 6.96 9.36 6.96 7.44 6.96 3.6 6.96 6.96 6.96 10.8 3.84 6.24 3.84] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103finitefieldextension.ps b/books/ps/v103finitefieldextension.ps new file mode 100644 index 0000000..692e392 --- /dev/null +++ b/books/ps/v103finitefieldextension.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 176 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 176 80 +%%PageOrientation: Portrait +gsave +36 36 140 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 +138 42 lineto +138 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +138 42 lineto +138 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% FiniteFieldExtension +[ /Rect [ 0 0 132 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=FFX) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 132 36 moveto +0 36 lineto +0 0 lineto +132 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 132 36 moveto +0 36 lineto +0 0 lineto +132 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +7 13 moveto +(FiniteFieldExtension) +[7.44 3.84 6.96 3.84 3.84 6.24 7.44 3.84 6.24 3.84 6.96 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/v103finitefieldextensionbypolynomial.ps b/books/ps/v103finitefieldextensionbypolynomial.ps new file mode 100644 index 0000000..26c59b4 --- /dev/null +++ b/books/ps/v103finitefieldextensionbypolynomial.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 256 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 256 80 +%%PageOrientation: Portrait +gsave +36 36 220 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 +218 42 lineto +218 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +218 42 lineto +218 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% FiniteFieldExtensionByPolynomial +[ /Rect [ 0 0 212 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=FFP) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 212 36 moveto +0 36 lineto +0 0 lineto +212 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 212 36 moveto +0 36 lineto +0 0 lineto +212 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +7 13 moveto +(FiniteFieldExtensionByPolynomial) +[7.44 3.84 6.96 3.84 3.84 6.24 7.44 3.84 6.24 3.84 6.96 8.64 6.96 3.84 6.24 6.96 5.52 3.84 6.96 6.96 9.36 6.96 7.44 6.96 3.6 6.96 6.96 6.96 10.8 3.84 6.24 3.84] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103finitefieldnormalbasis.ps b/books/ps/v103finitefieldnormalbasis.ps new file mode 100644 index 0000000..7e7b71a --- /dev/null +++ b/books/ps/v103finitefieldnormalbasis.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 +% FiniteFieldNormalBasis +[ /Rect [ 0 0 150 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=FFNB) >> + /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 +(FiniteFieldNormalBasis) +[7.44 3.84 6.96 3.84 3.84 6.24 7.44 3.84 6.24 3.84 6.96 9.84 6.96 5.04 10.8 6.24 3.84 9.36 6.24 5.52 3.84 5.52] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103finitefieldnormalbasisextension.ps b/books/ps/v103finitefieldnormalbasisextension.ps new file mode 100644 index 0000000..6cc2c3c --- /dev/null +++ b/books/ps/v103finitefieldnormalbasisextension.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 250 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 250 80 +%%PageOrientation: Portrait +gsave +36 36 214 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 +212 42 lineto +212 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +212 42 lineto +212 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% FiniteFieldNormalBasisExtension +[ /Rect [ 0 0 206 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=FFNBX) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 206 36 moveto +0 36 lineto +0 0 lineto +206 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 206 36 moveto +0 36 lineto +0 0 lineto +206 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +8 13 moveto +(FiniteFieldNormalBasisExtension) +[7.44 3.84 6.96 3.84 3.84 6.24 7.44 3.84 6.24 3.84 6.96 9.84 6.96 5.04 10.8 6.24 3.84 9.36 6.24 5.52 3.84 5.52 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/v103finitefieldnormalbasisextensionbypolynomial.ps b/books/ps/v103finitefieldnormalbasisextensionbypolynomial.ps new file mode 100644 index 0000000..2758524 --- /dev/null +++ b/books/ps/v103finitefieldnormalbasisextensionbypolynomial.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 330 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 330 80 +%%PageOrientation: Portrait +gsave +36 36 294 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 +292 42 lineto +292 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +292 42 lineto +292 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% FiniteFieldNormalBasisExtensionByPolynomial +[ /Rect [ 0 0 286 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=FFNBP) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 286 36 moveto +0 36 lineto +0 0 lineto +286 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 286 36 moveto +0 36 lineto +0 0 lineto +286 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +8 13 moveto +(FiniteFieldNormalBasisExtensionByPolynomial) +[7.44 3.84 6.96 3.84 3.84 6.24 7.44 3.84 6.24 3.84 6.96 9.84 6.96 5.04 10.8 6.24 3.84 9.36 6.24 5.52 3.84 5.52 8.64 6.96 3.84 6.24 6.96 5.52 3.84 6.96 6.96 9.36 6.96 7.44 6.96 3.6 6.96 6.96 6.96 10.8 3.84 6.24 3.84] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103float.ps b/books/ps/v103float.ps new file mode 100644 index 0000000..7ddd1e7 --- /dev/null +++ b/books/ps/v103float.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 +% Float +[ /Rect [ 0 0 54 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=FLOAT) >> + /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 +12 13 moveto +(Float) +[7.68 3.84 6.96 6.24 3.84] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103fortrancode.ps b/books/ps/v103fortrancode.ps new file mode 100644 index 0000000..2044c9f --- /dev/null +++ b/books/ps/v103fortrancode.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 130 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 130 80 +%%PageOrientation: Portrait +gsave +36 36 94 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 +92 42 lineto +92 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +92 42 lineto +92 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% FortranCode +[ /Rect [ 0 0 86 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=FC) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 86 36 moveto +0 36 lineto +0 0 lineto +86 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 86 36 moveto +0 36 lineto +0 0 lineto +86 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +7 13 moveto +(FortranCode) +[7.44 6.96 5.04 3.84 4.8 6.24 6.96 9.36 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/v103fortranexpression.ps b/books/ps/v103fortranexpression.ps new file mode 100644 index 0000000..89ca18b --- /dev/null +++ b/books/ps/v103fortranexpression.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 164 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 164 80 +%%PageOrientation: Portrait +gsave +36 36 128 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 +126 42 lineto +126 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +126 42 lineto +126 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% FortranExpression +[ /Rect [ 0 0 120 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=FEXPR) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 120 36 moveto +0 36 lineto +0 0 lineto +120 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 120 36 moveto +0 36 lineto +0 0 lineto +120 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +8 13 moveto +(FortranExpression) +[7.44 6.96 5.04 3.84 4.8 6.24 6.96 8.64 6.96 6.96 4.8 6.24 5.52 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/v103fortranprogram.ps b/books/ps/v103fortranprogram.ps new file mode 100644 index 0000000..edec25e --- /dev/null +++ b/books/ps/v103fortranprogram.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 150 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 150 80 +%%PageOrientation: Portrait +gsave +36 36 114 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 +112 42 lineto +112 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +112 42 lineto +112 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% FortranProgram +[ /Rect [ 0 0 106 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=FORTRAN) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 106 36 moveto +0 36 lineto +0 0 lineto +106 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 106 36 moveto +0 36 lineto +0 0 lineto +106 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +8 13 moveto +(FortranProgram) +[7.44 6.96 5.04 3.84 4.8 6.24 6.96 7.68 4.8 6.96 7.2 4.8 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/v103fortranscalartype.ps b/books/ps/v103fortranscalartype.ps new file mode 100644 index 0000000..6deb4d6 --- /dev/null +++ b/books/ps/v103fortranscalartype.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 164 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 164 80 +%%PageOrientation: Portrait +gsave +36 36 128 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 +126 42 lineto +126 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +126 42 lineto +126 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% FortranScalarType +[ /Rect [ 0 0 120 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=FST) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 120 36 moveto +0 36 lineto +0 0 lineto +120 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 120 36 moveto +0 36 lineto +0 0 lineto +120 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +8 13 moveto +(FortranScalarType) +[7.44 6.96 5.04 3.84 4.8 6.24 6.96 7.68 6.24 6.24 3.84 6.24 4.8 7.2 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/v103fortrantemplate.ps b/books/ps/v103fortrantemplate.ps new file mode 100644 index 0000000..f210678 --- /dev/null +++ b/books/ps/v103fortrantemplate.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 152 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 152 80 +%%PageOrientation: Portrait +gsave +36 36 116 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 +114 42 lineto +114 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +114 42 lineto +114 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% FortranTemplate +[ /Rect [ 0 0 108 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=FTEM) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 108 36 moveto +0 36 lineto +0 0 lineto +108 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 108 36 moveto +0 36 lineto +0 0 lineto +108 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +7 13 moveto +(FortranTemplate) +[7.44 6.96 5.04 3.84 4.8 6.24 6.24 7.44 6.24 10.56 6.96 3.84 6.24 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/v103fortrantype.ps b/books/ps/v103fortrantype.ps new file mode 100644 index 0000000..5785d9b --- /dev/null +++ b/books/ps/v103fortrantype.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 128 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 128 80 +%%PageOrientation: Portrait +gsave +36 36 92 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 +90 42 lineto +90 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +90 42 lineto +90 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% FortranType +[ /Rect [ 0 0 84 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=FT) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 84 36 moveto +0 36 lineto +0 0 lineto +84 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 84 36 moveto +0 36 lineto +0 0 lineto +84 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +7 13 moveto +(FortranType) +[7.44 6.96 5.04 3.84 4.8 6.24 6.24 7.2 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/v103fouriercomponent.ps b/books/ps/v103fouriercomponent.ps new file mode 100644 index 0000000..b1f3f42 --- /dev/null +++ b/books/ps/v103fouriercomponent.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 166 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 166 80 +%%PageOrientation: Portrait +gsave +36 36 130 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 +128 42 lineto +128 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +128 42 lineto +128 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% FourierComponent +[ /Rect [ 0 0 122 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=FCOMP) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 122 36 moveto +0 36 lineto +0 0 lineto +122 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 122 36 moveto +0 36 lineto +0 0 lineto +122 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +7 13 moveto +(FourierComponent) +[7.44 6.96 6.96 5.04 3.84 6.24 4.8 9.36 6.96 10.56 6.96 6.96 6.96 6.24 6.96 3.84] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103fourierseries.ps b/books/ps/v103fourierseries.ps new file mode 100644 index 0000000..3ffd804 --- /dev/null +++ b/books/ps/v103fourierseries.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 136 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 136 80 +%%PageOrientation: Portrait +gsave +36 36 100 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 +98 42 lineto +98 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +98 42 lineto +98 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% FourierSeries +[ /Rect [ 0 0 92 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=FSERIES) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 92 36 moveto +0 36 lineto +0 0 lineto +92 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 92 36 moveto +0 36 lineto +0 0 lineto +92 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +8 13 moveto +(FourierSeries) +[7.44 6.96 6.96 5.04 3.84 6.24 4.8 7.68 6.24 5.04 3.84 6.24 5.52] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103fraction.ps b/books/ps/v103fraction.ps new file mode 100644 index 0000000..3513e1b --- /dev/null +++ b/books/ps/v103fraction.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 106 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 106 80 +%%PageOrientation: Portrait +gsave +36 36 70 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 +68 42 lineto +68 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +68 42 lineto +68 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% Fraction +[ /Rect [ 0 0 62 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=FRAC) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 62 36 moveto +0 36 lineto +0 0 lineto +62 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 62 36 moveto +0 36 lineto +0 0 lineto +62 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +7 13 moveto +(Fraction) +[7.44 4.8 6.24 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/v103freeabeliangroup.ps b/books/ps/v103freeabeliangroup.ps new file mode 100644 index 0000000..a2cc920 --- /dev/null +++ b/books/ps/v103freeabeliangroup.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 164 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 164 80 +%%PageOrientation: Portrait +gsave +36 36 128 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 +126 42 lineto +126 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +126 42 lineto +126 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% FreeAbelianGroup +[ /Rect [ 0 0 120 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=FAGROUP) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 120 36 moveto +0 36 lineto +0 0 lineto +120 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 120 36 moveto +0 36 lineto +0 0 lineto +120 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +7 13 moveto +(FreeAbelianGroup) +[7.44 4.8 6.24 6.24 9.84 6.96 6.24 3.84 3.84 6.24 6.96 10.08 4.8 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/v103freeabelianmonoid.ps b/books/ps/v103freeabelianmonoid.ps new file mode 100644 index 0000000..10d5bac --- /dev/null +++ b/books/ps/v103freeabelianmonoid.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 172 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 172 80 +%%PageOrientation: Portrait +gsave +36 36 136 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 +134 42 lineto +134 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +134 42 lineto +134 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% FreeAbelianMonoid +[ /Rect [ 0 0 128 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=FAMONOID) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 128 36 moveto +0 36 lineto +0 0 lineto +128 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 128 36 moveto +0 36 lineto +0 0 lineto +128 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +7 13 moveto +(FreeAbelianMonoid) +[7.44 4.8 6.24 6.24 9.84 6.96 6.24 3.84 3.84 6.24 6.96 12.48 6.96 6.96 6.96 3.84 6.96] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103freegroup.ps b/books/ps/v103freegroup.ps new file mode 100644 index 0000000..61a685b --- /dev/null +++ b/books/ps/v103freegroup.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 +% FreeGroup +[ /Rect [ 0 0 76 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=FGROUP) >> + /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 +7 13 moveto +(FreeGroup) +[7.44 4.8 6.24 6.24 10.08 4.8 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/v103freemonoid.ps b/books/ps/v103freemonoid.ps new file mode 100644 index 0000000..056f71b --- /dev/null +++ b/books/ps/v103freemonoid.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 130 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 130 80 +%%PageOrientation: Portrait +gsave +36 36 94 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 +92 42 lineto +92 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +92 42 lineto +92 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% FreeMonoid +[ /Rect [ 0 0 86 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=FMONOID) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 86 36 moveto +0 36 lineto +0 0 lineto +86 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 86 36 moveto +0 36 lineto +0 0 lineto +86 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +8 13 moveto +(FreeMonoid) +[7.44 4.8 6.24 6.24 12.48 6.96 6.96 6.96 3.84 6.96] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103freenilpotentlie.ps b/books/ps/v103freenilpotentlie.ps new file mode 100644 index 0000000..8ba2781 --- /dev/null +++ b/books/ps/v103freenilpotentlie.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 156 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 156 80 +%%PageOrientation: Portrait +gsave +36 36 120 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 +118 42 lineto +118 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +118 42 lineto +118 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% FreeNilpotentLie +[ /Rect [ 0 0 112 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=FNLA) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 112 36 moveto +0 36 lineto +0 0 lineto +112 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 112 36 moveto +0 36 lineto +0 0 lineto +112 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +8 13 moveto +(FreeNilpotentLie) +[7.44 4.8 6.24 6.24 10.08 3.84 3.84 6.96 6.72 3.84 6.24 6.96 3.84 8.64 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/v103fullpartialfractionexpansion.ps b/books/ps/v103fullpartialfractionexpansion.ps new file mode 100644 index 0000000..0775c86 --- /dev/null +++ b/books/ps/v103fullpartialfractionexpansion.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 224 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 224 80 +%%PageOrientation: Portrait +gsave +36 36 188 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 +186 42 lineto +186 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +186 42 lineto +186 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% FullPartialFractionExpansion +[ /Rect [ 0 0 180 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=FPARFRAC) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 180 36 moveto +0 36 lineto +0 0 lineto +180 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 180 36 moveto +0 36 lineto +0 0 lineto +180 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +7 13 moveto +(FullPartialFractionExpansion) +[7.44 6.96 3.84 3.84 7.44 6.24 5.04 3.84 3.84 6.24 3.84 7.44 4.8 6.24 6.24 3.84 3.84 6.96 6.96 8.64 6.96 6.96 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/v103innerfinitefield.ps b/books/ps/v103innerfinitefield.ps new file mode 100644 index 0000000..e527f09 --- /dev/null +++ b/books/ps/v103innerfinitefield.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 152 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 152 80 +%%PageOrientation: Portrait +gsave +36 36 116 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 +114 42 lineto +114 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +114 42 lineto +114 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% InnerFiniteField +[ /Rect [ 0 0 108 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=IFF) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 108 36 moveto +0 36 lineto +0 0 lineto +108 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 108 36 moveto +0 36 lineto +0 0 lineto +108 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +8 13 moveto +(InnerFiniteField) +[4.56 6.96 6.96 6.24 4.8 7.44 3.84 6.96 3.84 3.84 6.24 7.44 3.84 6.24 3.84 6.96] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103innerfreeabelianmonoid.ps b/books/ps/v103innerfreeabelianmonoid.ps new file mode 100644 index 0000000..6e0a749 --- /dev/null +++ b/books/ps/v103innerfreeabelianmonoid.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 +% InnerFreeAbelianMonoid +[ /Rect [ 0 0 160 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=IFAMON) >> + /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 +(InnerFreeAbelianMonoid) +[4.56 6.96 6.96 6.24 4.8 7.44 4.8 6.24 6.24 9.84 6.96 6.24 3.84 3.84 6.24 6.96 12.48 6.96 6.96 6.96 3.84 6.96] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103innernormalbasisfieldfunctions.ps b/books/ps/v103innernormalbasisfieldfunctions.ps new file mode 100644 index 0000000..5fa4f16 --- /dev/null +++ b/books/ps/v103innernormalbasisfieldfunctions.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 246 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 246 80 +%%PageOrientation: Portrait +gsave +36 36 210 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 +208 42 lineto +208 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +208 42 lineto +208 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% InnerNormalBasisFieldFunctions +[ /Rect [ 0 0 202 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=INBFF) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 202 36 moveto +0 36 lineto +0 0 lineto +202 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 202 36 moveto +0 36 lineto +0 0 lineto +202 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +7 13 moveto +(InnerNormalBasisFieldFunctions) +[4.56 6.96 6.96 6.24 4.8 9.84 6.96 5.04 10.8 6.24 3.84 9.36 6.24 5.52 3.84 5.52 7.44 3.84 6.24 3.84 6.96 7.44 6.96 6.96 6.24 3.84 3.84 6.96 6.96 5.52] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103integermod.ps b/books/ps/v103integermod.ps new file mode 100644 index 0000000..9060ebf --- /dev/null +++ b/books/ps/v103integermod.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 126 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 126 80 +%%PageOrientation: Portrait +gsave +36 36 90 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 +88 42 lineto +88 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +88 42 lineto +88 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% IntegerMod +[ /Rect [ 0 0 82 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=ZMOD) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 82 36 moveto +0 36 lineto +0 0 lineto +82 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 82 36 moveto +0 36 lineto +0 0 lineto +82 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +7 13 moveto +(IntegerMod) +[4.56 6.96 3.84 6.24 6.72 6.24 4.8 12.48 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/v103keyedaccessfile.ps b/books/ps/v103keyedaccessfile.ps new file mode 100644 index 0000000..e831433 --- /dev/null +++ b/books/ps/v103keyedaccessfile.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 156 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 156 80 +%%PageOrientation: Portrait +gsave +36 36 120 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 +118 42 lineto +118 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +118 42 lineto +118 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% KeyedAccessFile +[ /Rect [ 0 0 112 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=KAFILE) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 112 36 moveto +0 36 lineto +0 0 lineto +112 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 112 36 moveto +0 36 lineto +0 0 lineto +112 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +7 13 moveto +(KeyedAccessFile) +[9.6 5.76 6.48 6.24 6.96 9.6 6.24 6.24 6.24 5.52 5.52 7.44 3.84 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/v103library.ps b/books/ps/v103library.ps new file mode 100644 index 0000000..6b88859 --- /dev/null +++ b/books/ps/v103library.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 102 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 102 80 +%%PageOrientation: Portrait +gsave +36 36 66 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 +64 42 lineto +64 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +64 42 lineto +64 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% Library +[ /Rect [ 0 0 58 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=LIB) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 58 36 moveto +0 36 lineto +0 0 lineto +58 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 58 36 moveto +0 36 lineto +0 0 lineto +58 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +7 13 moveto +(Library) +[8.64 3.84 6.96 4.8 6.24 5.04 6.96] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103listmonoidops.ps b/books/ps/v103listmonoidops.ps new file mode 100644 index 0000000..3e2cb9d --- /dev/null +++ b/books/ps/v103listmonoidops.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 148 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 148 80 +%%PageOrientation: Portrait +gsave +36 36 112 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 +110 42 lineto +110 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +110 42 lineto +110 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% ListMonoidOps +[ /Rect [ 0 0 104 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=LMOPS) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 104 36 moveto +0 36 lineto +0 0 lineto +104 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 104 36 moveto +0 36 lineto +0 0 lineto +104 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +7 13 moveto +(ListMonoidOps) +[8.64 3.84 5.28 3.84 12.48 6.96 6.96 6.96 3.84 6.96 10.08 6.96 5.52] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103localalgebra.ps b/books/ps/v103localalgebra.ps new file mode 100644 index 0000000..1fb6167 --- /dev/null +++ b/books/ps/v103localalgebra.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 136 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 136 80 +%%PageOrientation: Portrait +gsave +36 36 100 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 +98 42 lineto +98 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +98 42 lineto +98 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% LocalAlgebra +[ /Rect [ 0 0 92 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=LA) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 92 36 moveto +0 36 lineto +0 0 lineto +92 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 92 36 moveto +0 36 lineto +0 0 lineto +92 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +7 13 moveto +(LocalAlgebra) +[8.64 6.96 6.24 6.24 3.84 10.08 3.84 6.72 6.24 6.96 4.8 6.24] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103localize.ps b/books/ps/v103localize.ps new file mode 100644 index 0000000..456c7a5 --- /dev/null +++ b/books/ps/v103localize.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 108 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 108 80 +%%PageOrientation: Portrait +gsave +36 36 72 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 +70 42 lineto +70 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +70 42 lineto +70 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% Localize +[ /Rect [ 0 0 64 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=LO) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 64 36 moveto +0 36 lineto +0 0 lineto +64 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 64 36 moveto +0 36 lineto +0 0 lineto +64 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +7 13 moveto +(Localize) +[8.64 6.96 6.24 6.24 3.84 3.84 6.24 6.24] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103machinecomplex.ps b/books/ps/v103machinecomplex.ps new file mode 100644 index 0000000..731075a --- /dev/null +++ b/books/ps/v103machinecomplex.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 160 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 160 80 +%%PageOrientation: Portrait +gsave +36 36 124 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 +122 42 lineto +122 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +122 42 lineto +122 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% MachineComplex +[ /Rect [ 0 0 116 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=MCMPLX) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 116 36 moveto +0 36 lineto +0 0 lineto +116 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 116 36 moveto +0 36 lineto +0 0 lineto +116 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +7 13 moveto +(MachineComplex) +[12.48 6.24 6 6.96 3.84 6.96 6.24 9.36 6.96 10.56 6.96 3.84 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/v103machinefloat.ps b/books/ps/v103machinefloat.ps new file mode 100644 index 0000000..ef8f621 --- /dev/null +++ b/books/ps/v103machinefloat.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 +% MachineFloat +[ /Rect [ 0 0 94 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=MFLOAT) >> + /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 +(MachineFloat) +[12.48 6.24 6 6.96 3.84 6.96 6.24 7.68 3.84 6.96 6.24 3.84] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103machineinteger.ps b/books/ps/v103machineinteger.ps new file mode 100644 index 0000000..5ab8863 --- /dev/null +++ b/books/ps/v103machineinteger.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 150 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 150 80 +%%PageOrientation: Portrait +gsave +36 36 114 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 +112 42 lineto +112 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +112 42 lineto +112 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% MachineInteger +[ /Rect [ 0 0 106 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=MINT) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 106 36 moveto +0 36 lineto +0 0 lineto +106 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 106 36 moveto +0 36 lineto +0 0 lineto +106 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +8 13 moveto +(MachineInteger) +[12.48 6.24 6 6.96 3.84 6.96 6.24 4.56 6.96 3.84 6.24 6.72 6.24 4.8] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103ordsetints.ps b/books/ps/v103ordsetints.ps new file mode 100644 index 0000000..6ef63d6 --- /dev/null +++ b/books/ps/v103ordsetints.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 +% OrdSetInts +[ /Rect [ 0 0 76 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=OSI) >> + /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 +7 13 moveto +(OrdSetInts) +[10.08 4.56 6.96 7.68 6 3.84 4.56 6.96 3.84 5.52] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103result.ps b/books/ps/v103result.ps new file mode 100644 index 0000000..c335c4f --- /dev/null +++ b/books/ps/v103result.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 +% Result +[ /Rect [ 0 0 54 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=RESULT) >> + /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 +9 13 moveto +(Result) +[9.12 6.24 5.52 6.96 3.84 3.84] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103scriptformulaformat.ps b/books/ps/v103scriptformulaformat.ps new file mode 100644 index 0000000..b100602 --- /dev/null +++ b/books/ps/v103scriptformulaformat.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 182 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 182 80 +%%PageOrientation: Portrait +gsave +36 36 146 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 +144 42 lineto +144 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +144 42 lineto +144 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% ScriptFormulaFormat +[ /Rect [ 0 0 138 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=FORMULA) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 138 36 moveto +0 36 lineto +0 0 lineto +138 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 138 36 moveto +0 36 lineto +0 0 lineto +138 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +8 13 moveto +(ScriptFormulaFormat) +[7.68 6.24 5.04 3.84 6.96 3.84 7.44 6.96 5.04 10.8 6.96 3.84 6.24 7.44 6.96 5.04 10.8 6.24 3.84] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103simplefortranprogram.ps b/books/ps/v103simplefortranprogram.ps new file mode 100644 index 0000000..348a4f6 --- /dev/null +++ b/books/ps/v103simplefortranprogram.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 190 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 190 80 +%%PageOrientation: Portrait +gsave +36 36 154 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 +152 42 lineto +152 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +152 42 lineto +152 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% SimpleFortranProgram +[ /Rect [ 0 0 146 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=SFORT) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 146 36 moveto +0 36 lineto +0 0 lineto +146 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 146 36 moveto +0 36 lineto +0 0 lineto +146 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +8 13 moveto +(SimpleFortranProgram) +[7.68 3.84 10.56 6.96 3.84 6.24 7.44 6.96 5.04 3.84 4.8 6.24 6.96 7.68 4.8 6.96 7.2 4.8 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/v103switch.ps b/books/ps/v103switch.ps new file mode 100644 index 0000000..c3fd8ac --- /dev/null +++ b/books/ps/v103switch.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 +% Switch +[ /Rect [ 0 0 54 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=SWITCH) >> + /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 +7 13 moveto +(Switch) +[7.68 10.08 3.84 3.84 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/v103symboltable.ps b/books/ps/v103symboltable.ps new file mode 100644 index 0000000..c2dbf50 --- /dev/null +++ b/books/ps/v103symboltable.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 134 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 134 80 +%%PageOrientation: Portrait +gsave +36 36 98 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 +96 42 lineto +96 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +96 42 lineto +96 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% SymbolTable +[ /Rect [ 0 0 90 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=SYMTAB) >> + /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 +0 36 lineto +0 0 lineto +90 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 90 36 moveto +0 36 lineto +0 0 lineto +90 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +7 13 moveto +(SymbolTable) +[7.68 6.96 10.8 6.96 6.96 3.84 7.68 6.24 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/v103textfile.ps b/books/ps/v103textfile.ps new file mode 100644 index 0000000..9304f89 --- /dev/null +++ b/books/ps/v103textfile.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 106 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 106 80 +%%PageOrientation: Portrait +gsave +36 36 70 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 +68 42 lineto +68 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +68 42 lineto +68 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% TextFile +[ /Rect [ 0 0 62 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=TEXTFILE) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 62 36 moveto +0 36 lineto +0 0 lineto +62 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 62 36 moveto +0 36 lineto +0 0 lineto +62 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +8 13 moveto +(TextFile) +[7.44 5.76 6.96 3.84 7.44 3.84 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/v103thesymboltable.ps b/books/ps/v103thesymboltable.ps new file mode 100644 index 0000000..a79fcb4 --- /dev/null +++ b/books/ps/v103thesymboltable.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 156 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 156 80 +%%PageOrientation: Portrait +gsave +36 36 120 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 +118 42 lineto +118 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +118 42 lineto +118 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% TheSymbolTable +[ /Rect [ 0 0 112 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=SYMS) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 112 36 moveto +0 36 lineto +0 0 lineto +112 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 112 36 moveto +0 36 lineto +0 0 lineto +112 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +7 13 moveto +(TheSymbolTable) +[8.64 6.96 6.24 7.68 6.96 10.8 6.96 6.96 3.84 7.68 6.24 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/v103threedimensionalmatrix.ps b/books/ps/v103threedimensionalmatrix.ps new file mode 100644 index 0000000..ca8fc7a --- /dev/null +++ b/books/ps/v103threedimensionalmatrix.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 202 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 202 80 +%%PageOrientation: Portrait +gsave +36 36 166 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 +164 42 lineto +164 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +164 42 lineto +164 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% ThreeDimensionalMatrix +[ /Rect [ 0 0 158 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=M3D) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 158 36 moveto +0 36 lineto +0 0 lineto +158 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 158 36 moveto +0 36 lineto +0 0 lineto +158 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +7 13 moveto +(ThreeDimensionalMatrix) +[8.64 6.96 4.8 6.24 6.24 10.08 3.84 10.8 6.24 6.96 5.52 3.84 6.96 6.96 6.24 3.84 12.48 6.24 3.84 5.04 3.84 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 6a46d88..37bbd8b 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,88 @@ +20081203 tpd src/axiom-website/patches.html 20081203.01.tpd.patch +20081203 tpd books/bookvol10.3 add domains +20081203 tpd books/ps/v103finitefieldcyclicgroup.ps added +20081203 tpd books/ps/v103threedimensionalmatrix.ps added +20081203 tpd books/ps/v103thesymboltable.ps added +20081203 tpd books/ps/v103textfile.ps added +20081203 tpd books/ps/v103symboltable.ps added +20081203 tpd books/ps/v103switch.ps added +20081203 tpd books/ps/v103simplefortranprogram.ps added +20081203 tpd books/ps/v103scriptformulaformat.ps added +20081203 tpd books/ps/v103result.ps added +20081203 tpd books/ps/v103ordsetints.ps added +20081203 tpd books/ps/v103machineinteger.ps added +20081203 tpd books/ps/v103machinefloat.ps added +20081203 tpd books/ps/v103machinecomplex.ps added +20081203 tpd books/ps/v103localize.ps added +20081203 tpd books/ps/v103localalgebra.ps added +20081203 tpd books/ps/v103listmonoidops.ps added +20081203 tpd books/ps/v103library.ps added +20081203 tpd books/ps/v103keyedaccessfile.ps added +20081203 tpd books/ps/v103integermod.ps added +20081203 tpd books/ps/v103innernormalbasisfieldfunctions.ps added +20081203 tpd books/ps/v103innerfreeabelianmonoid.ps added +20081203 tpd books/ps/v103innerfinitefield.ps added +20081203 tpd books/ps/v103fullpartialfractionexpansion.ps added +20081203 tpd books/ps/v103freenilpotentlie.ps added +20081203 tpd books/ps/v103freemonoid.ps added +20081203 tpd books/ps/v103freegroup.ps added +20081203 tpd books/ps/v103freeabelianmonoid.ps added +20081203 tpd books/ps/v103freeabeliangroup.ps added +20081203 tpd books/ps/v103fraction.ps added +20081203 tpd books/ps/v103fourierseries.ps added +20081203 tpd books/ps/v103fouriercomponent.ps added +20081203 tpd books/ps/v103fortrantype.ps added +20081203 tpd books/ps/v103fortrantemplate.ps added +20081203 tpd books/ps/v103fortranscalartype.ps added +20081203 tpd books/ps/v103fortranprogram.ps added +20081203 tpd books/ps/v103fortranexpression.ps added +20081203 tpd books/ps/v103fortrancode.ps added +20081203 tpd books/ps/v103float.ps added +20081203 tpd books/ps/v103finitefieldnormalbasisextensionbypolynomial.ps added +20081203 tpd books/ps/v103finitefieldnormalbasisextension.ps added +20081203 tpd books/ps/v103finitefieldnormalbasis.ps added +20081203 tpd books/ps/v103finitefieldextensionbypolynomial.ps added +20081203 tpd books/ps/v103finitefieldextension.ps added +20081203 tpd books/ps/v103finitefieldcyclicgroupextensionbypolynomial.ps added +20081203 tpd books/ps/v103finitefieldcyclicgroupextension.ps added +20081203 tpd books/ps/v103finitefield.ps added +20081203 tpd books/ps/v103filename.ps added +20081203 tpd books/ps/v103file.ps added +20081203 tpd books/ps/v103factored.ps added +20081203 tpd books/ps/v103commutator.ps added +20081203 tpd books/ps/v103binaryfile.ps added +20081203 tpd books/ps/v103basicfunctions.ps added +20081203 tpd src/algebra/Makefile removed functions.spad +20081203 tpd src/algebra/functions.spad removed, moved domains to bookvol10.3 +20081203 tpd src/algebra/fr.spad moved domain to bookvol10.3 +20081203 tpd src/algebra/Makefile removed free.spad +20081203 tpd src/algebra/free.spad removed, moved domains to bookvol10.3 +20081203 tpd src/algebra/fraction.spad moved domains to bookvol10.3 +20081203 tpd src/algebra/Makefile removed fparfrac.spad +20081203 tpd src/algebra/fparfrac.spad removed, moved domains to bookvol10.3 +20081203 tpd src/algebra/Makefile removed fourier.spad +20081203 tpd src/algebra/fourier.spad removed, moved domains to bookvol10.3 +20081203 tpd src/algebra/Makefile removed forttyp.spad +20081203 tpd src/algebra/forttyp.spad removed, moved domains to bookvol10.3 +20081203 tpd src/algebra/Makefile removed fortran.spad +20081203 tpd src/algebra/fortran.spad removed, moved domains to bookvol10.3 +20081203 tpd src/algebra/Makefile removed fortmac.spad +20081203 tpd src/algebra/fortmac.spad removed, moved domains to bookvol10.3 +20081203 tpd src/algebra/formula.spad moved domains to bookvol10.3 +20081203 tpd src/algebra/fnla.spad moved domains to bookvol10.3 +20081203 tpd src/algebra/Makefile removed fname.spad +20081203 tpd src/algebra/fname.spad removed, moved domains to bookvol10.3 +20081203 tpd src/algebra/Makefile removed fmod.spad +20081203 tpd src/algebra/fmod.spad removed, moved domains to bookvol10.3 +20081203 tpd src/algebra/Makefile removed float.spad +20081203 tpd src/algebra/float.spad removed, moved domains to bookvol10.3 +20081203 tpd src/algebra/Makefile removed files.spad +20081203 tpd src/algebra/files.spad removed, moved domains to bookvol10.3 +20081203 tpd src/algebra/Makefile removed ffp.spad +20081203 tpd src/algebra/ffp.spad removed, moved domains to bookvol10.3 +20081203 tpd src/algebra/ffnb.spad move domains to bookvol10.3 +20081203 tpd src/algebra/Makefile removed ffcg.spad +20081203 tpd src/algebra/ffcg.spad removed, moved domains to bookvol10.3 20081202 tpd src/axiom-website/patches.html 20081202.02.tpd.patch 20081202 tpd src/axiom-website/download.html add doyen thumbdrive 20081202 tpd src/axiom-website/patches.html 20081202.01.tpd.patch diff --git a/src/algebra/Makefile.pamphlet b/src/algebra/Makefile.pamphlet index f098028..ea5d9cd 100644 --- a/src/algebra/Makefile.pamphlet +++ b/src/algebra/Makefile.pamphlet @@ -288,7 +288,6 @@ LAYER5=\ \subsection{Layer6} \subsubsection{Completed spad files} \begin{verbatim} -fmod.spad.pamphlet (ZMOD) sortpak.spad.pamphlet (SORTPAK) \end{verbatim} @@ -367,9 +366,6 @@ complet.spad.pamphlet (ORDCOMP ORDCOMP2 ONECOMP ONECOMP2 INFINITY) cra.spad.pamphlet (CRAPACK) defaults.spad.pamphlet (REPSQ REPDB FLASORT) drawpak.spad.pamphlet (DRAWCX) -free.spad.pamphlet (LMOPS FMONOID FGROUP FAMONC IFAMON FAMONOID FAGROUP) -fourier.spad.pamphlet (FCOMP FSERIES) -functions.spad.pamphlet (BFUNCT) mappkg.spad.pamphlet (MAPHACK1 MAPHACK2 MAPHACK3 MAPHACK4 MAPPKG1 MAPPKG2 MAPPKG3 MAPPKG4) mesh.spad.pamphlet (MESH) @@ -520,7 +516,6 @@ ffcat.spad.pamphlet (FPC XF FAXF DLP FFIELDC FFSLPE) fff.spad.pamphlet (FFF) ffhom.spad.pamphlet (FFHOM) ffpoly.spad.pamphlet (FFPOLY) -fname.spad.pamphlet (FNCAT FNAME) formula.spad.pamphlet (FORMULA FORMULA1) fraction.spad.pamphlet (LO LA QFCAT QFCAT2 FRAC LPEFRAC FRAC2) galfactu.spad.pamphlet (GALFACTU) @@ -755,14 +750,8 @@ e02.spad.pamphlet (NAGE02) e04.spad.pamphlet (NAGE04) e04agents.spad.pamphlet (E04AGNT) e04package.spad.pamphlet (OPTPACK) -ffcg.spad.pamphlet (FFCGP FFCGX FFCG) -ffp.spad.pamphlet (FFP FFX IFF FF) -files.spad.pamphlet (FILECAT FILE TEXTFILE BINFILE KAFILE LIB) -float.spad.pamphlet (FLOAT) fnla.spad.pamphlet (OSI COMM HB FNLA) fortpak.spad.pamphlet (FCPAK1 NAGSP FORT FOP TEMUTL MCALCFN) -forttyp.spad.pamphlet (FST FT SYMTAB SYMS) -fparfrac.spad.pamphlet (FPARFRAC) fr.spad.pamphlet (FR FRUTIL FR2) f07.spad.pamphlet (NAGF07) gdpoly.spad.pamphlet (GDMP DMP HDMP) @@ -852,8 +841,6 @@ exprode.spad.pamphlet (EXPRODE) f01.spad.pamphlet (NAGF01) f02.spad.pamphlet (NAGF02) f04.spad.pamphlet (NAGF04) -fortmac.spad.pamphlet (MINT MFLOAT MCMPLX) -fortran.spad.pamphlet (RESULT FC FORTRAN M3D SFORT SWITCH FTEM FEXPR) fspace.spad.pamphlet (ES ES1 ES2 FS FS2) fs2ups.spad.pamphlet (FS2UPS) funcpkgs.spad.pamphlet (FSUPFACT) @@ -1173,16 +1160,14 @@ SPADFILES= \ ${OUTSRC}/exprode.spad ${OUTSRC}/expr.spad \ ${OUTSRC}/f01.spad ${OUTSRC}/f02.spad ${OUTSRC}/f04.spad \ ${OUTSRC}/f07.spad ${OUTSRC}/facutil.spad ${OUTSRC}/ffcat.spad \ - ${OUTSRC}/ffcg.spad ${OUTSRC}/fff.spad ${OUTSRC}/ffhom.spad \ + ${OUTSRC}/fff.spad ${OUTSRC}/ffhom.spad \ ${OUTSRC}/ffnb.spad ${OUTSRC}/ffpoly2.spad ${OUTSRC}/ffpoly.spad \ - ${OUTSRC}/ffp.spad ${OUTSRC}/ffx.spad \ - ${OUTSRC}/files.spad ${OUTSRC}/float.spad ${OUTSRC}/fmod.spad \ - ${OUTSRC}/fname.spad ${OUTSRC}/fnla.spad ${OUTSRC}/formula.spad \ - ${OUTSRC}/fortmac.spad ${OUTSRC}/fortpak.spad \ - ${OUTSRC}/fortran.spad ${OUTSRC}/forttyp.spad ${OUTSRC}/fourier.spad \ - ${OUTSRC}/fparfrac.spad ${OUTSRC}/fraction.spad ${OUTSRC}/free.spad \ + ${OUTSRC}/ffx.spad \ + ${OUTSRC}/fnla.spad ${OUTSRC}/formula.spad \ + ${OUTSRC}/fortpak.spad \ + ${OUTSRC}/fraction.spad \ ${OUTSRC}/fr.spad ${OUTSRC}/fs2expxp.spad ${OUTSRC}/fs2ups.spad \ - ${OUTSRC}/fspace.spad ${OUTSRC}/funcpkgs.spad ${OUTSRC}/functions.spad \ + ${OUTSRC}/fspace.spad ${OUTSRC}/funcpkgs.spad \ ${OUTSRC}/galfact.spad ${OUTSRC}/galfactu.spad ${OUTSRC}/galpolyu.spad \ ${OUTSRC}/galutil.spad ${OUTSRC}/gaussfac.spad ${OUTSRC}/gaussian.spad \ ${OUTSRC}/gbeuclid.spad ${OUTSRC}/gbintern.spad ${OUTSRC}/gb.spad \ @@ -1331,16 +1316,14 @@ DOCFILES= \ ${DOC}/exprode.spad.dvi ${DOC}/expr.spad.dvi \ ${DOC}/f01.spad.dvi ${DOC}/f02.spad.dvi ${DOC}/f04.spad.dvi \ ${DOC}/f07.spad.dvi ${DOC}/facutil.spad.dvi ${DOC}/ffcat.spad.dvi \ - ${DOC}/ffcg.spad.dvi ${DOC}/fff.spad.dvi ${DOC}/ffhom.spad.dvi \ + ${DOC}/fff.spad.dvi ${DOC}/ffhom.spad.dvi \ ${DOC}/ffnb.spad.dvi ${DOC}/ffpoly2.spad.dvi ${DOC}/ffpoly.spad.dvi \ - ${DOC}/ffp.spad.dvi ${DOC}/ffrac.as.dvi ${DOC}/ffx.spad.dvi \ - ${DOC}/files.spad.dvi ${DOC}/float.spad.dvi ${DOC}/fmod.spad.dvi \ - ${DOC}/fname.spad.dvi ${DOC}/fnla.spad.dvi ${DOC}/formula.spad.dvi \ - ${DOC}/fortmac.spad.dvi ${DOC}/fortpak.spad.dvi \ - ${DOC}/fortran.spad.dvi ${DOC}/forttyp.spad.dvi ${DOC}/fourier.spad.dvi \ - ${DOC}/fparfrac.spad.dvi ${DOC}/fraction.spad.dvi ${DOC}/free.spad.dvi \ + ${DOC}/ffrac.as.dvi ${DOC}/ffx.spad.dvi \ + ${DOC}/fnla.spad.dvi ${DOC}/formula.spad.dvi \ + ${DOC}/fortpak.spad.dvi \ + ${DOC}/fraction.spad.dvi \ ${DOC}/fr.spad.dvi ${DOC}/fs2expxp.spad.dvi ${DOC}/fs2ups.spad.dvi \ - ${DOC}/fspace.spad.dvi ${DOC}/funcpkgs.spad.dvi ${DOC}/functions.spad.dvi \ + ${DOC}/fspace.spad.dvi ${DOC}/funcpkgs.spad.dvi \ ${DOC}/galfact.spad.dvi ${DOC}/galfactu.spad.dvi ${DOC}/galpolyu.spad.dvi \ ${DOC}/galutil.spad.dvi ${DOC}/gaussfac.spad.dvi ${DOC}/gaussian.spad.dvi \ ${DOC}/gbeuclid.spad.dvi ${DOC}/gbintern.spad.dvi ${DOC}/gb.spad.dvi \ @@ -2343,12 +2326,12 @@ ${HELP}/Expression.help: ${BOOKS}/bookvol10.3.pamphlet @${TANGLE} -R"Expression.input" ${BOOKS}/bookvol10.3.pamphlet \ >${INPUT}/Expression.input -${HELP}/Factored.help: ${IN}/fr.spad.pamphlet - @echo 7019 create Factored.help from ${IN}/fr.spad.pamphlet - @${TANGLE} -R"Factored.help" ${IN}/fr.spad.pamphlet \ +${HELP}/Factored.help: ${BOOKS}/bookvol10.3.pamphlet + @echo 7019 create Factored.help from ${BOOKS}/bookvol10.3.pamphlet + @${TANGLE} -R"Factored.help" ${BOOKS}/bookvol10.3.pamphlet \ >${HELP}/Factored.help @cp ${HELP}/Factored.help ${HELP}/FR.help - @${TANGLE} -R"Factored.input" ${IN}/fr.spad.pamphlet \ + @${TANGLE} -R"Factored.input" ${BOOKS}/bookvol10.3.pamphlet \ >${INPUT}/Factored.input ${HELP}/FactoredFunctions2.help: ${IN}/fr.spad.pamphlet @@ -2359,20 +2342,20 @@ ${HELP}/FactoredFunctions2.help: ${IN}/fr.spad.pamphlet @${TANGLE} -R"FactoredFunctions2.input" ${IN}/fr.spad.pamphlet \ >${INPUT}/FactoredFunctions2.input -${HELP}/File.help: ${IN}/files.spad.pamphlet - @echo 7021 create File.help from ${IN}/files.spad.pamphlet - @${TANGLE} -R"File.help" ${IN}/files.spad.pamphlet \ +${HELP}/File.help: ${BOOKS}/bookvol10.3.pamphlet + @echo 7021 create File.help from ${BOOKS}/bookvol10.3.pamphlet + @${TANGLE} -R"File.help" ${BOOKS}/bookvol10.3.pamphlet \ >${HELP}/File.help @-cp ${HELP}/File.help ${HELP}/FILE.help - @${TANGLE} -R"File.input" ${IN}/files.spad.pamphlet \ + @${TANGLE} -R"File.input" ${BOOKS}/bookvol10.3.pamphlet \ >${INPUT}/File.input -${HELP}/FileName.help: ${IN}/fname.spad.pamphlet - @echo 7022 create FileName.help from ${IN}/fname.spad.pamphlet - @${TANGLE} -R"FileName.help" ${IN}/fname.spad.pamphlet \ +${HELP}/FileName.help: ${BOOKS}/bookvol10.3.pamphlet + @echo 7022 create FileName.help from ${BOOKS}/bookvol10.3.pamphlet + @${TANGLE} -R"FileName.help" ${BOOKS}/bookvol10.3.pamphlet \ >${HELP}/FileName.help @cp ${HELP}/FileName.help ${HELP}/FNAME.help - @${TANGLE} -R"FileName.input" ${IN}/fname.spad.pamphlet \ + @${TANGLE} -R"FileName.input" ${BOOKS}/bookvol10.3.pamphlet \ >${INPUT}/FileName.input ${HELP}/FlexibleArray.help: ${BOOKS}/bookvol10.3.pamphlet @@ -2383,31 +2366,31 @@ ${HELP}/FlexibleArray.help: ${BOOKS}/bookvol10.3.pamphlet @${TANGLE} -R"FlexibleArray.input" ${BOOKS}/bookvol10.3.pamphlet \ >${INPUT}/FlexibleArray.input -${HELP}/Float.help: ${IN}/float.spad.pamphlet - @echo 7024 create Float.help from ${IN}/float.spad.pamphlet - @${TANGLE} -R"Float.help" ${IN}/float.spad.pamphlet \ +${HELP}/Float.help: ${BOOKS}/bookvol10.3.pamphlet + @echo 7024 create Float.help from ${BOOKS}/bookvol10.3.pamphlet + @${TANGLE} -R"Float.help" ${BOOKS}/bookvol10.3.pamphlet \ >${HELP}/Float.help @-cp ${HELP}/Float.help ${HELP}/FLOAT.help - @${TANGLE} -R"Float.input" ${IN}/float.spad.pamphlet \ + @${TANGLE} -R"Float.input" ${BOOKS}/bookvol10.3.pamphlet \ >${INPUT}/Float.input -${HELP}/Fraction.help: ${IN}/fraction.spad.pamphlet - @echo 7025 create Fraction.help from ${IN}/fraction.spad.pamphlet - @${TANGLE} -R"Fraction.help" ${IN}/fraction.spad.pamphlet \ +${HELP}/Fraction.help: ${BOOKS}/bookvol10.3.pamphlet + @echo 7025 create Fraction.help from ${BOOKS}/bookvol10.3.pamphlet + @${TANGLE} -R"Fraction.help" ${BOOKS}/bookvol10.3.pamphlet \ >${HELP}/Fraction.help @cp ${HELP}/Fraction.help ${HELP}/FR.help - @${TANGLE} -R"Fraction.input" ${IN}/fraction.spad.pamphlet \ + @${TANGLE} -R"Fraction.input" ${BOOKS}/bookvol10.3.pamphlet \ >${INPUT}/Fraction.input -${HELP}/FullPartialFractionExpansion.help: ${IN}/fparfrac.spad.pamphlet +${HELP}/FullPartialFractionExpansion.help: ${BOOKS}/bookvol10.3.pamphlet @echo 7026 create FullPartialFractionExpansion.help from \ - ${IN}/fparfrac.spad.pamphlet + ${BOOKS}/bookvol10.3.pamphlet @${TANGLE} -R"FullPartialFractionExpansion.help" \ - ${IN}/fparfrac.spad.pamphlet \ + ${BOOKS}/bookvol10.3.pamphlet \ >${HELP}/FullPartialFractionExpansion.help @cp ${HELP}/FullPartialFractionExpansion.help ${HELP}/FPARFRAC.help @${TANGLE} -R"FullPartialFractionExpansion.input" \ - ${IN}/fparfrac.spad.pamphlet \ + ${BOOKS}/bookvol10.3.pamphlet \ >${INPUT}/FullPartialFractionExpansion.input ${HELP}/GeneralDistributedMultivariatePolynomial.help: \ @@ -2512,12 +2495,13 @@ ${HELP}/Kernel.help: ${IN}/kl.spad.pamphlet @${TANGLE} -R"Kernel.input" ${IN}/kl.spad.pamphlet \ >${INPUT}/Kernel.input -${HELP}/KeyedAccessFile.help: ${IN}/files.spad.pamphlet - @echo 7037 create KeyedAccessFile.help from ${IN}/files.spad.pamphlet - @${TANGLE} -R"KeyedAccessFile.help" ${IN}/files.spad.pamphlet \ +${HELP}/KeyedAccessFile.help: ${BOOKS}/bookvol10.3.pamphlet + @echo 7037 create KeyedAccessFile.help from \ + ${BOOKS}/bookvol10.3.pamphlet + @${TANGLE} -R"KeyedAccessFile.help" ${BOOKS}/bookvol10.3.pamphlet \ >${HELP}/KeyedAccessFile.help @cp ${HELP}/KeyedAccessFile.help ${HELP}/KAFILE.help - @${TANGLE} -R"KeyedAccessFile.input" ${IN}/files.spad.pamphlet \ + @${TANGLE} -R"KeyedAccessFile.input" ${BOOKS}/bookvol10.3.pamphlet \ >${INPUT}/KeyedAccessFile.input ${HELP}/LexTriangularPackage.help: ${IN}/zerodim.spad.pamphlet @@ -2529,12 +2513,12 @@ ${HELP}/LexTriangularPackage.help: ${IN}/zerodim.spad.pamphlet @${TANGLE} -R"LexTriangularPackage.input" ${IN}/zerodim.spad.pamphlet \ >${INPUT}/LexTriangularPackage.input -${HELP}/Library.help: ${IN}/files.spad.pamphlet - @echo 7039 create Library.help from ${IN}/files.spad.pamphlet - @${TANGLE} -R"Library.help" ${IN}/files.spad.pamphlet \ +${HELP}/Library.help: ${BOOKS}/bookvol10.3.pamphlet + @echo 7039 create Library.help from ${BOOKS}/bookvol10.3.pamphlet + @${TANGLE} -R"Library.help" ${BOOKS}/bookvol10.3.pamphlet \ >${HELP}/Library.help @cp ${HELP}/Library.help ${HELP}/LIB.help - @${TANGLE} -R"Library.input" ${IN}/files.spad.pamphlet \ + @${TANGLE} -R"Library.input" ${BOOKS}/bookvol10.3.pamphlet \ >${INPUT}/Library.input ${HELP}/LieExponentials.help: ${IN}/xlpoly.spad.pamphlet @@ -2912,12 +2896,12 @@ ${HELP}/Table.help: ${IN}/table.spad.pamphlet @${TANGLE} -R"Table.input" ${IN}/table.spad.pamphlet \ >${INPUT}/Table.input -${HELP}/TextFile.help: ${IN}/files.spad.pamphlet - @echo 7083 create TextFile.help from ${IN}/files.spad.pamphlet - @${TANGLE} -R"TextFile.help" ${IN}/files.spad.pamphlet \ +${HELP}/TextFile.help: ${BOOKS}/bookvol10.3.pamphlet + @echo 7083 create TextFile.help from ${BOOKS}/bookvol10.3.pamphlet + @${TANGLE} -R"TextFile.help" ${BOOKS}/bookvol10.3.pamphlet \ >${HELP}/TextFile.help @-cp ${HELP}/TextFile.help ${HELP}/TEXTFILE.help - @${TANGLE} -R"TextFile.input" ${IN}/files.spad.pamphlet \ + @${TANGLE} -R"TextFile.input" ${BOOKS}/bookvol10.3.pamphlet \ >${INPUT}/TextFile.input ${HELP}/TwoDimensionalArray.help: ${BOOKS}/bookvol10.3.pamphlet diff --git a/src/algebra/ffcg.spad.pamphlet b/src/algebra/ffcg.spad.pamphlet deleted file mode 100644 index a2667c0..0000000 --- a/src/algebra/ffcg.spad.pamphlet +++ /dev/null @@ -1,467 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra ffcg.spad} -\author{Johannes Grabmeier, Alfred Scheerhorn} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\begin{verbatim} --- 28.01.93: AS and JG: setting of initzech? and initelt? flags in --- functions initializeZech and initializeElt put at the --- end to avoid errors with interruption. --- factorsOfCyclicGroupSize() changed. --- 12.05.92: JG: long lines --- 25.02.92: AS: added functions order and primitive? --- 19.02.92: AS: implementation of basis:PI -> Vector $ changed . --- 17.02.92: AS: implementation of coordinates corrected. --- 10.02.92: AS: implementation of coerce:GF -> $ corrected. --- 05.08.91: JG: AS implementation of missing functions in FFC and FAXF - - --- finite field represented by it's cyclic group and 'zero' as an --- extra element -\end{verbatim} -\section{domain FFCGP FiniteFieldCyclicGroupExtensionByPolynomial} -<>= -)abbrev domain FFCGP FiniteFieldCyclicGroupExtensionByPolynomial -++ Authors: J.Grabmeier, A.Scheerhorn -++ Date Created: 26.03.1991 -++ Date Last Updated: 31 March 1991 -++ Basic Operations: -++ Related Constructors: FiniteFieldFunctions -++ Also See: FiniteFieldExtensionByPolynomial, -++ FiniteFieldNormalBasisExtensionByPolynomial -++ AMS Classifications: -++ Keywords: finite field, primitive elements, cyclic group -++ References: -++ R.Lidl, H.Niederreiter: Finite Field, Encycoldia of Mathematics and -++ Its Applications, Vol. 20, Cambridge Univ. Press, 1983, ISBN 0 521 30240 4 -++ J. Grabmeier, A. Scheerhorn: Finite Fields in AXIOM. -++ AXIOM Technical Report Series, ATR/5 NP2522. -++ Description: -++ FiniteFieldCyclicGroupExtensionByPolynomial(GF,defpol) implements a -++ finite extension field of the ground field {\em GF}. Its elements are -++ represented by powers of a primitive element, i.e. a generator of the -++ multiplicative (cyclic) group. As primitive -++ element we choose the root of the extension polynomial {\em defpol}, -++ which MUST be primitive (user responsibility). Zech logarithms are stored -++ in a table of size half of the field size, and use \spadtype{SingleInteger} -++ for representing field elements, hence, there are restrictions -++ on the size of the field. - - -FiniteFieldCyclicGroupExtensionByPolynomial(GF,defpol):_ - Exports == Implementation where - GF : FiniteFieldCategory -- the ground field - defpol: SparseUnivariatePolynomial GF -- the extension polynomial - -- the root of defpol is used as the primitive element - - PI ==> PositiveInteger - NNI ==> NonNegativeInteger - I ==> Integer - SI ==> SingleInteger - SUP ==> SparseUnivariatePolynomial - SAE ==> SimpleAlgebraicExtension(GF,SUP GF,defpol) - V ==> Vector GF - FFP ==> FiniteFieldExtensionByPolynomial(GF,defpol) - FFF ==> FiniteFieldFunctions(GF) - OUT ==> OutputForm - ARR ==> PrimitiveArray(SI) - TBL ==> Table(PI,NNI) - - - Exports ==> FiniteAlgebraicExtensionField(GF) with - - getZechTable:() -> ARR - ++ getZechTable() returns the zech logarithm table of the field - ++ it is used to perform additions in the field quickly. - Implementation ==> add - --- global variables =================================================== - - Rep:= SI - -- elements are represented by small integers in the range - -- (-1)..(size()-2). The (-1) representing the field element zero, - -- the other small integers representing the corresponding power - -- of the primitive element, the root of the defining polynomial - - -- it would be very nice if we could use the representation - -- Rep:= Union("zero", IntegerMod(size()$GF ** degree(defpol) -1)), - -- why doesn't the compiler like this ? - - extdeg:NNI :=degree(defpol)$(SUP GF)::NNI - -- the extension degree - - sizeFF:NNI:=(size()$GF ** extdeg) pretend NNI - -- the size of the field - - if sizeFF > 2**20 then - error "field too large for this representation" - - sizeCG:SI:=(sizeFF - 1) pretend SI - -- the order of the cyclic group - - sizeFG:SI:=(sizeCG quo (size()$GF-1)) pretend SI - -- the order of the factor group - - - zechlog:ARR:=new(((sizeFF+1) quo 2)::NNI,-1::SI)$ARR - -- the table for the zech logarithm - - alpha :=new()$Symbol :: OutputForm - -- get a new symbol for the output representation of - -- the elements - - primEltGF:GF:= - odd?(extdeg)$I => -$GF coefficient(defpol,0)$(SUP GF) - coefficient(defpol,0)$(SUP GF) - -- the corresponding primitive element of the groundfield - -- equals the trace of the primitive element w.r.t. the groundfield - - facOfGroupSize := nil()$(List Record(factor:Integer,exponent:Integer)) - -- the factorization of sizeCG - - initzech?:Boolean:=true - -- gets false after initialization of the zech logarithm array - - initelt?:Boolean:=true - -- gets false after initialization of the normal element - - normalElt:SI:=0 - -- the global variable containing a normal element - --- functions ========================================================== - - -- for completeness we have to give a dummy implementation for - -- 'tableForDiscreteLogarithm', although this function is not - -- necessary in the cyclic group representation case - - tableForDiscreteLogarithm(fac) == table()$TBL - - - getZechTable() == zechlog - initializeZech:() -> Void - initializeElt: () -> Void - - order(x:$):PI == - zero?(x) => - error"order: order of zero undefined" - (sizeCG quo gcd(sizeCG,x pretend NNI))::PI - - primitive?(x:$) == --- zero?(x) or one?(x) => false - zero?(x) or (x = 1) => false - gcd(x::Rep,sizeCG)$Rep = 1$Rep => true - false - - coordinates(x:$) == - x=0 => new(extdeg,0)$(Vector GF) - primElement:SAE:=convert(monomial(1,1)$(SUP GF))$SAE --- the primitive element in the corresponding algebraic extension - coordinates(primElement **$SAE (x pretend SI))$SAE - - x:$ + y:$ == - if initzech? then initializeZech() - zero? x => y - zero? y => x - d:Rep:=positiveRemainder(y -$Rep x,sizeCG)$Rep - (d pretend SI) <= shift(sizeCG,-$SI (1$SI)) => - zechlog.(d pretend SI) =$SI -1::SI => 0 - addmod(x,zechlog.(d pretend SI) pretend Rep,sizeCG)$Rep - --d:Rep:=positiveRemainder(x -$Rep y,sizeCG)$Rep - d:Rep:=(sizeCG -$SI d)::Rep - addmod(y,zechlog.(d pretend SI) pretend Rep,sizeCG)$Rep - --positiveRemainder(x +$Rep zechlog.(d pretend SI) -$Rep d,sizeCG)$Rep - - - initializeZech() == - zechlog:=createZechTable(defpol)$FFF - -- set initialization flag - initzech? := false - void()$Void - - basis(n:PI) == - extensionDegree() rem n ^= 0 => - error("argument must divide extension degree") - m:=sizeCG quo (size()$GF**n-1) - [index((1+i*m) ::PI) for i in 0..(n-1)]::Vector $ - - n:I * x:$ == ((n::GF)::$) * x - - minimalPolynomial(a) == - f:SUP $:=monomial(1,1)$(SUP $) - monomial(a,0)$(SUP $) - u:$:=Frobenius(a) - while not(u = a) repeat - f:=f * (monomial(1,1)$(SUP $) - monomial(u,0)$(SUP $)) - u:=Frobenius(u) - p:SUP GF:=0$(SUP GF) - while not zero?(f)$(SUP $) repeat - g:GF:=retract(leadingCoefficient(f)$(SUP $)) - p:=p+monomial(g,_ - degree(f)$(SUP $))$(SUP GF) - f:=reductum(f)$(SUP $) - p - - factorsOfCyclicGroupSize() == - if empty? facOfGroupSize then initializeElt() - facOfGroupSize - - representationType() == "cyclic" - - definingPolynomial() == defpol - - random() == - positiveRemainder(random()$Rep,sizeFF pretend Rep)$Rep -$Rep 1$Rep - - represents(v) == - u:FFP:=represents(v)$FFP - u =$FFP 0$FFP => 0 - discreteLog(u)$FFP pretend Rep - - - - coerce(e:GF):$ == - zero?(e)$GF => 0 - log:I:=discreteLog(primEltGF,e)$GF::NNI *$I sizeFG - -- version before 10.20.92: log pretend Rep - -- 1$GF is coerced to sizeCG pretend Rep by old version - -- now 1$GF is coerced to 0$Rep which is correct. - positiveRemainder(log,sizeCG) pretend Rep - - - retractIfCan(x:$) == - zero? x => 0$GF - u:= (x::Rep) exquo$Rep (sizeFG pretend Rep) - u = "failed" => "failed" - primEltGF **$GF ((u::$) pretend SI) - - retract(x:$) == - a:=retractIfCan(x) - a="failed" => error "element not in groundfield" - a :: GF - - basis() == [index(i :: PI) for i in 1..extdeg]::Vector $ - - - inGroundField?(x) == - zero? x=> true - positiveRemainder(x::Rep,sizeFG pretend Rep)$Rep =$Rep 0$Rep => true - false - - discreteLog(b:$,x:$) == - zero? x => "failed" - e:= extendedEuclidean(b,sizeCG,x)$Rep - e = "failed" => "failed" - e1:Record(coef1:$,coef2:$) := e :: Record(coef1:$,coef2:$) - positiveRemainder(e1.coef1,sizeCG)$Rep pretend NNI - - - x:$ == - zero? x => 0 - characteristic() =$I 2 => x - addmod(x,shift(sizeCG,-1)$SI pretend Rep,sizeCG) - - generator() == 1$SI - createPrimitiveElement() == 1$SI - primitiveElement() == 1$SI - - discreteLog(x:$) == - zero? x => error "discrete logarithm error" - x pretend NNI - - normalElement() == - if initelt? then initializeElt() - normalElt::$ - - initializeElt() == - facOfGroupSize := factors(factor(sizeCG)$Integer) - normalElt:=createNormalElement() pretend SI - initelt?:=false - void()$Void - - extensionDegree() == extdeg pretend PI - - characteristic() == characteristic()$GF - - lookup(x:$) == - x =$Rep (-$Rep 1$Rep) => sizeFF pretend PI - (x +$Rep 1$Rep) pretend PI - - index(a:PI) == - positiveRemainder(a,sizeFF)$I pretend Rep -$Rep 1$Rep - - 0 == (-$Rep 1$Rep) - - 1 == 0$Rep - --- to get a "exponent like" output form - coerce(x:$):OUT == - x =$Rep (-$Rep 1$Rep) => "0"::OUT - x =$Rep 0$Rep => "1"::OUT - y:I:=lookup(x)-1 - alpha **$OUT (y::OUT) - - x:$ = y:$ == x =$Rep y - - x:$ * y:$ == - x = 0 => 0 - y = 0 => 0 - addmod(x,y,sizeCG)$Rep - - a:GF * x:$ == coerce(a)@$ * x - x:$/a:GF == x/coerce(a)@$ - --- x:$ / a:GF == --- a = 0$GF => error "division by zero" --- x * inv(coerce(a)) - - inv(x:$) == - zero?(x) => error "inv: not invertible" --- one?(x) => 1 - (x = 1) => 1 - sizeCG -$Rep x - - x:$ ** n:PI == x ** n::I - - x:$ ** n:NNI == x ** n::I - - x:$ ** n:I == - m:Rep:=positiveRemainder(n,sizeCG)$I pretend Rep - m =$Rep 0$Rep => 1 - x = 0 => 0 - mulmod(m,x,sizeCG::Rep)$Rep - -@ -\section{domain FFCGX FiniteFieldCyclicGroupExtension} -<>= -)abbrev domain FFCGX FiniteFieldCyclicGroupExtension -++ Authors: J.Grabmeier, A.Scheerhorn -++ Date Created: 04.04.1991 -++ Date Last Updated: -++ Basic Operations: -++ Related Constructors: FiniteFieldCyclicGroupExtensionByPolynomial, -++ FiniteFieldPolynomialPackage -++ Also See: FiniteFieldExtension, FiniteFieldNormalBasisExtension -++ AMS Classifications: -++ Keywords: finite field, primitive elements, cyclic group -++ References: -++ R.Lidl, H.Niederreiter: Finite Field, Encycoldia of Mathematics and -++ Its Applications, Vol. 20, Cambridge Univ. Press, 1983, ISBN 0 521 30240 4 -++ J. Grabmeier, A. Scheerhorn: Finite Fields in AXIOM. -++ AXIOM Technical Report Series, ATR/5 NP2522. -++ Description: -++ FiniteFieldCyclicGroupExtension(GF,n) implements a extension of degree n -++ over the ground field {\em GF}. Its elements are represented by powers of -++ a primitive element, i.e. a generator of the multiplicative (cyclic) group. -++ As primitive element we choose the root of the extension polynomial, which -++ is created by {\em createPrimitivePoly} from -++ \spadtype{FiniteFieldPolynomialPackage}. Zech logarithms are stored -++ in a table of size half of the field size, and use \spadtype{SingleInteger} -++ for representing field elements, hence, there are restrictions -++ on the size of the field. - - -FiniteFieldCyclicGroupExtension(GF,extdeg):_ - Exports == Implementation where - GF : FiniteFieldCategory - extdeg : PositiveInteger - PI ==> PositiveInteger - FFPOLY ==> FiniteFieldPolynomialPackage(GF) - SI ==> SingleInteger - Exports ==> FiniteAlgebraicExtensionField(GF) with - getZechTable:() -> PrimitiveArray(SingleInteger) - ++ getZechTable() returns the zech logarithm table of the field. - ++ This table is used to perform additions in the field quickly. - Implementation ==> FiniteFieldCyclicGroupExtensionByPolynomial(GF,_ - createPrimitivePoly(extdeg)$FFPOLY) - -@ -\section{domain FFCG FiniteFieldCyclicGroup} -<>= -)abbrev domain FFCG FiniteFieldCyclicGroup -++ Authors: J.Grabmeier, A.Scheerhorn -++ Date Created: 04.04.1991 -++ Date Last Updated: -++ Basic Operations: -++ Related Constructors: FiniteFieldCyclicGroupExtensionByPolynomial, -++ FiniteFieldPolynomialPackage -++ Also See: FiniteField, FiniteFieldNormalBasis -++ AMS Classifications: -++ Keywords: finite field, primitive elements, cyclic group -++ References: -++ R.Lidl, H.Niederreiter: Finite Field, Encycoldia of Mathematics and -++ Its Applications, Vol. 20, Cambridge Univ. Press, 1983, ISBN 0 521 30240 4 -++ Description: -++ FiniteFieldCyclicGroup(p,n) implements a finite field extension of degee n -++ over the prime field with p elements. Its elements are represented by -++ powers of a primitive element, i.e. a generator of the multiplicative -++ (cyclic) group. As primitive element we choose the root of the extension -++ polynomial, which is created by {\em createPrimitivePoly} from -++ \spadtype{FiniteFieldPolynomialPackage}. The Zech logarithms are stored -++ in a table of size half of the field size, and use \spadtype{SingleInteger} -++ for representing field elements, hence, there are restrictions -++ on the size of the field. - -FiniteFieldCyclicGroup(p,extdeg):_ - Exports == Implementation where - p : PositiveInteger - extdeg : PositiveInteger - PI ==> PositiveInteger - FFPOLY ==> FiniteFieldPolynomialPackage(PrimeField(p)) - SI ==> SingleInteger - Exports ==> FiniteAlgebraicExtensionField(PrimeField(p)) with - getZechTable:() -> PrimitiveArray(SingleInteger) - ++ getZechTable() returns the zech logarithm table of the field. - ++ This table is used to perform additions in the field quickly. - Implementation ==> FiniteFieldCyclicGroupExtensionByPolynomial(PrimeField(p),_ - createPrimitivePoly(extdeg)$FFPOLY) - -@ -\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/ffnb.spad.pamphlet b/src/algebra/ffnb.spad.pamphlet index 032c350..b9321b8 100644 --- a/src/algebra/ffnb.spad.pamphlet +++ b/src/algebra/ffnb.spad.pamphlet @@ -27,6 +27,7 @@ -- 18.02.92: AS: INBFF normalElement corrected. The old one returned a wrong -- result for a FFNBP(FFNBP(..)) domain. \end{verbatim} +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{package INBFF InnerNormalBasisFieldFunctions} <>= )abbrev package INBFF InnerNormalBasisFieldFunctions @@ -379,466 +380,6 @@ InnerNormalBasisFieldFunctions(GF): Exports == Implementation where +/[monomial(x.i,(i-1)::NNI)$(SUP GF) for i in 1..(#x)::I] @ -\section{domain FFNBP FiniteFieldNormalBasisExtensionByPolynomial} -<>= -)abbrev domain FFNBP FiniteFieldNormalBasisExtensionByPolynomial -++ Authors: J.Grabmeier, A.Scheerhorn -++ Date Created: 26.03.1991 -++ Date Last Updated: 08 May 1991 -++ Basic Operations: -++ Related Constructors: InnerNormalBasisFieldFunctions, FiniteFieldFunctions, -++ Also See: FiniteFieldExtensionByPolynomial, -++ FiniteFieldCyclicGroupExtensionByPolynomial -++ AMS Classifications: -++ Keywords: finite field, normal basis -++ References: -++ R.Lidl, H.Niederreiter: Finite Field, Encyclopedia of Mathematics and -++ Its Applications, Vol. 20, Cambridge Univ. Press, 1983, ISBN 0 521 30240 4 -++ J. Grabmeier, A. Scheerhorn: Finite Fields in AXIOM . -++ AXIOM Technical Report Series, ATR/5 NP2522. -++ Description: -++ FiniteFieldNormalBasisExtensionByPolynomial(GF,uni) implements a -++ finite extension of the ground field {\em GF}. The elements are -++ represented by coordinate vectors with respect to. a normal basis, -++ i.e. a basis -++ consisting of the conjugates (q-powers) of an element, in this case -++ called normal element, where q is the size of {\em GF}. -++ The normal element is chosen as a root of the extension -++ polynomial, which MUST be normal over {\em GF} (user responsibility) -FiniteFieldNormalBasisExtensionByPolynomial(GF,uni): Exports == _ - Implementation where - GF : FiniteFieldCategory -- the ground field - uni : Union(SparseUnivariatePolynomial GF,_ - Vector List Record(value:GF,index:SingleInteger)) - - PI ==> PositiveInteger - NNI ==> NonNegativeInteger - I ==> Integer - SI ==> SingleInteger - SUP ==> SparseUnivariatePolynomial - V ==> Vector GF - M ==> Matrix GF - OUT ==> OutputForm - TERM ==> Record(value:GF,index:SI) - R ==> Record(key:PI,entry:NNI) - TBL ==> Table(PI,NNI) - FFF ==> FiniteFieldFunctions(GF) - INBFF ==> InnerNormalBasisFieldFunctions(GF) - - Exports ==> FiniteAlgebraicExtensionField(GF) with - - getMultiplicationTable: () -> Vector List TERM - ++ getMultiplicationTable() returns the multiplication - ++ table for the normal basis of the field. - ++ This table is used to perform multiplications between field elements. - getMultiplicationMatrix:() -> M - ++ getMultiplicationMatrix() returns the multiplication table in - ++ form of a matrix. - sizeMultiplication:() -> NNI - ++ sizeMultiplication() returns the number of entries in the - ++ multiplication table of the field. - ++ Note: the time of multiplication - ++ of field elements depends on this size. - Implementation ==> add - --- global variables =================================================== - - Rep:= V -- elements are represented by vectors over GF - - alpha :=new()$Symbol :: OutputForm - -- get a new Symbol for the output representation of the elements - - initlog?:Boolean:=true - -- gets false after initialization of the logarithm table - - initelt?:Boolean:=true - -- gets false after initialization of the primitive element - - initmult?:Boolean:=true - -- gets false after initialization of the multiplication - -- table or the primitive element - - extdeg:PI :=1 - - defpol:SUP(GF):=0$SUP(GF) - -- the defining polynomial - - multTable:Vector List TERM:=new(1,nil()$(List TERM)) - -- global variable containing the multiplication table - - if uni case (Vector List TERM) then - multTable:=uni :: (Vector List TERM) - extdeg:= (#multTable) pretend PI - vv:V:=new(extdeg,0)$V - vv.1:=1$GF - setFieldInfo(multTable,1$GF)$INBFF - defpol:=minimalPolynomial(vv)$INBFF - initmult?:=false - else - defpol:=uni :: SUP(GF) - extdeg:=degree(defpol)$(SUP GF) pretend PI - multTable:Vector List TERM:=new(extdeg,nil()$(List TERM)) - - basisOutput : List OUT := - qs:OUT:=(q::Symbol)::OUT - append([alpha, alpha **$OUT qs],_ - [alpha **$OUT (qs **$OUT i::OUT) for i in 2..extdeg-1] ) - - - facOfGroupSize :=nil()$(List Record(factor:Integer,exponent:Integer)) - -- the factorization of the cyclic group size - - - traceAlpha:GF:=-$GF coefficient(defpol,(degree(defpol)-1)::NNI) - -- the inverse of the trace of the normalElt - -- is computed here. It defines the imbedding of - -- GF in the extension field - - primitiveElt:PI:=1 - -- for the lookup the primitive Element computed by createPrimitiveElement() - - discLogTable:Table(PI,TBL):=table()$Table(PI,TBL) - -- tables indexed by the factors of sizeCG, - -- discLogTable(factor) is a table with keys - -- primitiveElement() ** (i * (sizeCG quo factor)) and entries i for - -- i in 0..n-1, n computed in initialize() in order to use - -- the minimal size limit 'limit' optimal. - --- functions =========================================================== - - initializeLog: () -> Void - initializeElt: () -> Void - initializeMult: () -> Void - - - coerce(v:GF):$ == new(extdeg,v /$GF traceAlpha)$Rep - represents(v) == v::$ - - degree(a) == - d:PI:=1 - b:= qPot(a::Rep,1)$INBFF - while (b^=a) repeat - b:= qPot(b::Rep,1)$INBFF - d:=d+1 - d - - linearAssociatedExp(x,f) == - xm:SUP(GF):=monomial(1$GF,extdeg)$(SUP GF) - 1$(SUP GF) - r:= (f * pol(x::Rep)$INBFF) rem xm - vectorise(r,extdeg)$(SUP GF) - linearAssociatedLog(x) == pol(x::Rep)$INBFF - linearAssociatedOrder(x) == - xm:SUP(GF):=monomial(1$GF,extdeg)$(SUP GF) - 1$(SUP GF) - xm quo gcd(xm,pol(x::Rep)$INBFF) - linearAssociatedLog(b,x) == - zero? x => 0 - xm:SUP(GF):=monomial(1$GF,extdeg)$(SUP GF) - 1$(SUP GF) - e:= extendedEuclidean(pol(b::Rep)$INBFF,xm,pol(x::Rep)$INBFF)$(SUP GF) - e = "failed" => "failed" - e1:= e :: Record(coef1:(SUP GF),coef2:(SUP GF)) - e1.coef1 - - getMultiplicationTable() == - if initmult? then initializeMult() - multTable - getMultiplicationMatrix() == - if initmult? then initializeMult() - createMultiplicationMatrix(multTable)$FFF - sizeMultiplication() == - if initmult? then initializeMult() - sizeMultiplication(multTable)$FFF - - trace(a:$) == retract trace(a,1) - norm(a:$) == retract norm(a,1) - generator() == normalElement(extdeg)$INBFF - basis(n:PI) == - (extdeg rem n) ^= 0 => error "argument must divide extension degree" - [Frobenius(trace(normalElement,n),i) for i in 0..(n-1)]::(Vector $) - - a:GF * x:$ == a *$Rep x - - x:$/a:GF == x/coerce(a) --- x:$ / a:GF == --- a = 0$GF => error "division by zero" --- x * inv(coerce(a)) - - - coordinates(x:$) == x::Rep - - Frobenius(e) == qPot(e::Rep,1)$INBFF - Frobenius(e,n) == qPot(e::Rep,n)$INBFF - - retractIfCan(x) == - inGroundField?(x) => - x.1 *$GF traceAlpha - "failed" - - retract(x) == - inGroundField?(x) => - x.1 *$GF traceAlpha - error("element not in ground field") - --- to get a "normal basis like" output form - coerce(x:$):OUT == - l:List OUT:=nil()$(List OUT) - n : PI := extdeg --- one? n => (x.1) :: OUT - (n = 1) => (x.1) :: OUT - for i in 1..n for b in basisOutput repeat - if not zero? x.i then - mon : OUT := --- one? x.i => b - (x.i = 1) => b - ((x.i)::OUT) *$OUT b - l:=cons(mon,l)$(List OUT) - null(l)$(List OUT) => (0::OUT) - r:=reduce("+",l)$(List OUT) - r - - initializeElt() == - facOfGroupSize := factors factor(size()$GF**extdeg-1)$I - -- get a primitive element - primitiveElt:=lookup(createPrimitiveElement()) - initelt?:=false - void()$Void - - initializeMult() == - multTable:=createMultiplicationTable(defpol)$FFF - setFieldInfo(multTable,traceAlpha)$INBFF - -- reset initialize flag - initmult?:=false - void()$Void - - initializeLog() == - if initelt? then initializeElt() - -- set up tables for discrete logarithm - limit:Integer:=30 - -- the minimum size for the discrete logarithm table - for f in facOfGroupSize repeat - fac:=f.factor - base:$:=index(primitiveElt)**((size()$GF**extdeg -$I 1$I) quo$I fac) - l:Integer:=length(fac)$Integer - n:Integer:=0 - if odd?(l)$I then n:=shift(fac,-$I (l quo$I 2))$I - else n:=shift(1,l quo$I 2)$I - if n <$I limit then - d:=(fac -$I 1$I) quo$I limit +$I 1$I - n:=(fac -$I 1$I) quo$I d +$I 1$I - tbl:TBL:=table()$TBL - a:$:=1 - for i in (0::NNI)..(n-1)::NNI repeat - insert_!([lookup(a),i::NNI]$R,tbl)$TBL - a:=a*base - insert_!([fac::PI,copy(tbl)$TBL]_ - $Record(key:PI,entry:TBL),discLogTable)$Table(PI,TBL) - initlog?:=false - -- tell user about initialization - --print("discrete logarithm table initialized"::OUT) - void()$Void - - tableForDiscreteLogarithm(fac) == - if initlog? then initializeLog() - tbl:=search(fac::PI,discLogTable)$Table(PI,TBL) - tbl case "failed" => - error "tableForDiscreteLogarithm: argument must be prime _ -divisor of the order of the multiplicative group" - tbl :: TBL - - primitiveElement() == - if initelt? then initializeElt() - index(primitiveElt) - - factorsOfCyclicGroupSize() == - if empty? facOfGroupSize then initializeElt() - facOfGroupSize - - extensionDegree() == extdeg - - sizeOfGroundField() == size()$GF pretend NNI - - definingPolynomial() == defpol - - trace(a,d) == - v:=trace(a::Rep,d)$INBFF - erg:=v - for i in 2..(extdeg quo d) repeat - erg:=concat(erg,v)$Rep - erg - - characteristic() == characteristic()$GF - - random() == random(extdeg)$INBFF - - x:$ * y:$ == - if initmult? then initializeMult() - setFieldInfo(multTable,traceAlpha)$INBFF - x::Rep *$INBFF y::Rep - - - 1 == new(extdeg,inv(traceAlpha)$GF)$Rep - - 0 == zero(extdeg)$Rep - - size() == size()$GF ** extdeg - - index(n:PI) == index(extdeg,n)$INBFF - - lookup(x:$) == lookup(x::Rep)$INBFF - - - basis() == - a:=basis(extdeg)$INBFF - vector([e::$ for e in entries a]) - - - x:$ ** e:I == - if initmult? then initializeMult() - setFieldInfo(multTable,traceAlpha)$INBFF - (x::Rep) **$INBFF e - - normal?(x) == normal?(x::Rep)$INBFF - - -(x:$) == -$Rep x - x:$ + y:$ == x +$Rep y - x:$ - y:$ == x -$Rep y - x:$ = y:$ == x =$Rep y - n:I * x:$ == x *$Rep (n::GF) - - - - - representationType() == "normal" - - minimalPolynomial(a) == - if initmult? then initializeMult() - setFieldInfo(multTable,traceAlpha)$INBFF - minimalPolynomial(a::Rep)$INBFF - --- is x an element of the ground field GF ? - inGroundField?(x) == - erg:=true - for i in 2..extdeg repeat - not(x.i =$GF x.1) => erg:=false - erg - - x:$ / y:$ == - if initmult? then initializeMult() - setFieldInfo(multTable,traceAlpha)$INBFF - x::Rep /$INBFF y::Rep - - inv(a) == - if initmult? then initializeMult() - setFieldInfo(multTable,traceAlpha)$INBFF - inv(a::Rep)$INBFF - - norm(a,d) == - if initmult? then initializeMult() - setFieldInfo(multTable,traceAlpha)$INBFF - norm(a::Rep,d)$INBFF - - normalElement() == normalElement(extdeg)$INBFF - -@ -\section{domain FFNBX FiniteFieldNormalBasisExtension} -<>= -)abbrev domain FFNBX FiniteFieldNormalBasisExtension -++ Authors: J.Grabmeier, A.Scheerhorn -++ Date Created: 26.03.1991 -++ Date Last Updated: -++ Basic Operations: -++ Related Constructors: FiniteFieldNormalBasisExtensionByPolynomial, -++ FiniteFieldPolynomialPackage -++ Also See: FiniteFieldExtension, FiniteFieldCyclicGroupExtension -++ AMS Classifications: -++ Keywords: finite field, normal basis -++ References: -++ R.Lidl, H.Niederreiter: Finite Field, Encyclopedia of Mathematics and -++ Its Applications, Vol. 20, Cambridge Univ. Press, 1983, ISBN 0 521 30240 4 -++ J. Grabmeier, A. Scheerhorn: Finite Fields in AXIOM. -++ AXIOM Technical Report Series, ATR/5 NP2522. -++ Description: -++ FiniteFieldNormalBasisExtensionByPolynomial(GF,n) implements a -++ finite extension field of degree n over the ground field {\em GF}. -++ The elements are represented by coordinate vectors with respect -++ to a normal basis, -++ i.e. a basis consisting of the conjugates (q-powers) of an element, in -++ this case called normal element. This is chosen as a root of the extension -++ polynomial, created by {\em createNormalPoly} from -++ \spadtype{FiniteFieldPolynomialPackage} -FiniteFieldNormalBasisExtension(GF,extdeg):_ - Exports == Implementation where - GF : FiniteFieldCategory -- the ground field - extdeg: PositiveInteger -- the extension degree - NNI ==> NonNegativeInteger - FFF ==> FiniteFieldFunctions(GF) - TERM ==> Record(value:GF,index:SingleInteger) - Exports ==> FiniteAlgebraicExtensionField(GF) with - getMultiplicationTable: () -> Vector List TERM - ++ getMultiplicationTable() returns the multiplication - ++ table for the normal basis of the field. - ++ This table is used to perform multiplications between field elements. - getMultiplicationMatrix: () -> Matrix GF - ++ getMultiplicationMatrix() returns the multiplication table in - ++ form of a matrix. - sizeMultiplication:() -> NNI - ++ sizeMultiplication() returns the number of entries in the - ++ multiplication table of the field. Note: the time of multiplication - ++ of field elements depends on this size. - - Implementation ==> FiniteFieldNormalBasisExtensionByPolynomial(GF,_ - createLowComplexityNormalBasis(extdeg)$FFF) - -@ -\section{domain FFNB FiniteFieldNormalBasis} -<>= -)abbrev domain FFNB FiniteFieldNormalBasis -++ Authors: J.Grabmeier, A.Scheerhorn -++ Date Created: 26.03.1991 -++ Date Last Updated: -++ Basic Operations: -++ Related Constructors: FiniteFieldNormalBasisExtensionByPolynomial, -++ FiniteFieldPolynomialPackage -++ Also See: FiniteField, FiniteFieldCyclicGroup -++ AMS Classifications: -++ Keywords: finite field, normal basis -++ References: -++ R.Lidl, H.Niederreiter: Finite Field, Encyclopedia of Mathematics and -++ Its Applications, Vol. 20, Cambridge Univ. Press, 1983, ISBN 0 521 30240 4 -++ J. Grabmeier, A. Scheerhorn: Finite Fields in AXIOM. -++ AXIOM Technical Report Series, ATR/5 NP2522. -++ Description: -++ FiniteFieldNormalBasis(p,n) implements a -++ finite extension field of degree n over the prime field with p elements. -++ The elements are represented by coordinate vectors with respect to -++ a normal basis, -++ i.e. a basis consisting of the conjugates (q-powers) of an element, in -++ this case called normal element. -++ This is chosen as a root of the extension polynomial -++ created by \spadfunFrom{createNormalPoly}{FiniteFieldPolynomialPackage}. -FiniteFieldNormalBasis(p,extdeg):_ - Exports == Implementation where - p : PositiveInteger - extdeg: PositiveInteger -- the extension degree - NNI ==> NonNegativeInteger - FFF ==> FiniteFieldFunctions(PrimeField(p)) - TERM ==> Record(value:PrimeField(p),index:SingleInteger) - Exports ==> FiniteAlgebraicExtensionField(PrimeField(p)) with - getMultiplicationTable: () -> Vector List TERM - ++ getMultiplicationTable() returns the multiplication - ++ table for the normal basis of the field. - ++ This table is used to perform multiplications between field elements. - getMultiplicationMatrix: () -> Matrix PrimeField(p) - ++ getMultiplicationMatrix() returns the multiplication table in - ++ form of a matrix. - sizeMultiplication:() -> NNI - ++ sizeMultiplication() returns the number of entries in the - ++ multiplication table of the field. Note: The time of multiplication - ++ of field elements depends on this size. - - Implementation ==> FiniteFieldNormalBasisExtensionByPolynomial(PrimeField(p),_ - createLowComplexityNormalBasis(extdeg)$FFF) - -@ \section{License} <>= --Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. @@ -876,9 +417,6 @@ FiniteFieldNormalBasis(p,extdeg):_ <> <> -<> -<> -<> @ \eject \begin{thebibliography}{99} diff --git a/src/algebra/ffp.spad.pamphlet b/src/algebra/ffp.spad.pamphlet deleted file mode 100644 index 2d97d79..0000000 --- a/src/algebra/ffp.spad.pamphlet +++ /dev/null @@ -1,403 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra ffp.spad} -\author{Johannes Grabmeier, Alfred Scheerhorn, Robert Sutor, Oswald Gschnitzer} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\begin{verbatim} --- 28.01.93: AS and JG: setting of initlog? and initelt? flags in --- functions initializeLog and initializeElt put at the --- end to avoid errors with interruption. createNormalElement() --- included in function initializeElt. Function createNormalElement() set --- into comments. factorsOfCyclicGroupSize() changed. --- 12.05.92: JG: long lines --- 18.02.92: AS: degree: $ -> PI added, faster then category version --- 18.06.91: AS: createNormalElement added: --- the version in ffcat.spad needs too long --- for finding a normal element, because of the "correlation" between --- the "additive" structure of the index function and the additive --- structure of the field. Our experiments show that this version is --- much faster. --- 05.04.91 JG: comments, IFF --- 04.04.91 JG: error message in function tablesOfDiscreteLogarithm changed --- 04.04.91 JG: comment of FFP was changed - -\end{verbatim} -\section{domain FFP FiniteFieldExtensionByPolynomial} -<>= -)abbrev domain FFP FiniteFieldExtensionByPolynomial -++ Authors: R.Sutor, J. Grabmeier, O. Gschnitzer, A. Scheerhorn -++ Date Created: -++ Date Last Updated: 31 March 1991 -++ Basic Operations: -++ Related Constructors: -++ Also See: FiniteFieldCyclicGroupExtensionByPolynomial, -++ FiniteFieldNormalBasisExtensionByPolynomial -++ AMS Classifications: -++ Keywords: field, extension field, algebraic extension, -++ finite extension, finite field, Galois field -++ Reference: -++ R.Lidl, H.Niederreiter: Finite Field, Encyclopedia of Mathematics an -++ Its Applications, Vol. 20, Cambridge Univ. Press, 1983, ISBN 0 521 30240 4 -++ J. Grabmeier, A. Scheerhorn: Finite Fields in AXIOM. -++ AXIOM Technical Report Series, ATR/5 NP2522. -++ Description: -++ FiniteFieldExtensionByPolynomial(GF, defpol) implements the extension -++ of the finite field {\em GF} generated by the extension polynomial -++ {\em defpol} which MUST be irreducible. -++ Note: the user has the responsibility to ensure that -++ {\em defpol} is irreducible. - -FiniteFieldExtensionByPolynomial(GF:FiniteFieldCategory,_ - defpol:SparseUnivariatePolynomial GF): Exports == Implementation where --- GF : FiniteFieldCategory --- defpol : SparseUnivariatePolynomial GF - - PI ==> PositiveInteger - NNI ==> NonNegativeInteger - SUP ==> SparseUnivariatePolynomial - I ==> Integer - R ==> Record(key:PI,entry:NNI) - TBL ==> Table(PI,NNI) - SAE ==> SimpleAlgebraicExtension(GF,SUP GF,defpol) - OUT ==> OutputForm - - Exports ==> FiniteAlgebraicExtensionField(GF) - - Implementation ==> add - --- global variables ==================================================== - - Rep:=SAE - - extdeg:PI := degree(defpol)$(SUP GF) pretend PI - -- the extension degree - - alpha := new()$Symbol :: OutputForm - -- a new symbol for the output form of field elements - - sizeCG:Integer := size()$GF**extdeg - 1 - -- the order of the multiplicative group - - facOfGroupSize := nil()$(List Record(factor:Integer,exponent:Integer)) - -- the factorization of sizeCG - - normalElt:PI:=1 - -- for the lookup of the normal Element computed by - -- createNormalElement - - primitiveElt:PI:=1 - -- for the lookup of the primitive Element computed by - -- createPrimitiveElement() - - initlog?:Boolean:=true - -- gets false after initialization of the discrete logarithm table - - initelt?:Boolean:=true - -- gets false after initialization of the primitive and the - -- normal element - - - discLogTable:Table(PI,TBL):=table()$Table(PI,TBL) - -- tables indexed by the factors of sizeCG, - -- discLogTable(factor) is a table with keys - -- primitiveElement() ** (i * (sizeCG quo factor)) and entries i for - -- i in 0..n-1, n computed in initialize() in order to use - -- the minimal size limit 'limit' optimal. - --- functions =========================================================== - --- createNormalElement() == --- a:=primitiveElement() --- nElt:=generator() --- for i in 1.. repeat --- normal? nElt => return nElt --- nElt:=nElt*a --- nElt - - generator() == reduce(monomial(1,1)$SUP(GF))$Rep - norm x == resultant(defpol, lift x) - - initializeElt: () -> Void - initializeLog: () -> Void - basis(n:PI) == - (extdeg rem n) ^= 0 => error "argument must divide extension degree" - a:$:=norm(primitiveElement(),n) - vector [a**i for i in 0..n-1] - - degree(x) == - y:$:=1 - m:=zero(extdeg,extdeg+1)$(Matrix GF) - for i in 1..extdeg+1 repeat - setColumn_!(m,i,coordinates(y))$(Matrix GF) - y:=y*x - rank(m)::PI - - minimalPolynomial(x:$) == - y:$:=1 - m:=zero(extdeg,extdeg+1)$(Matrix GF) - for i in 1..extdeg+1 repeat - setColumn_!(m,i,coordinates(y))$(Matrix GF) - y:=y*x - v:=first nullSpace(m)$(Matrix GF) - +/[monomial(v.(i+1),i)$(SUP GF) for i in 0..extdeg] - - - normal?(x) == - l:List List GF:=[entries coordinates x] - a:=x - for i in 2..extdeg repeat - a:=Frobenius(a) - l:=concat(l,entries coordinates a)$(List List GF) - ((rank matrix(l)$(Matrix GF)) = extdeg::NNI) => true - false - - - a:GF * x:$ == a *$Rep x - n:I * x:$ == n *$Rep x - -x == -$Rep x - random() == random()$Rep - coordinates(x:$) == coordinates(x)$Rep - represents(v) == represents(v)$Rep - coerce(x:GF):$ == coerce(x)$Rep - definingPolynomial() == defpol - retract(x) == retract(x)$Rep - retractIfCan(x) == retractIfCan(x)$Rep - index(x) == index(x)$Rep - lookup(x) == lookup(x)$Rep - x:$/y:$ == x /$Rep y - x:$/a:GF == x/coerce(a) --- x:$ / a:GF == --- a = 0$GF => error "division by zero" --- x * inv(coerce(a)) - x:$ * y:$ == x *$Rep y - x:$ + y:$ == x +$Rep y - x:$ - y:$ == x -$Rep y - x:$ = y:$ == x =$Rep y - basis() == basis()$Rep - 0 == 0$Rep - 1 == 1$Rep - - factorsOfCyclicGroupSize() == - if empty? facOfGroupSize then initializeElt() - facOfGroupSize - - representationType() == "polynomial" - - tableForDiscreteLogarithm(fac) == - if initlog? then initializeLog() - tbl:=search(fac::PI,discLogTable)$Table(PI,TBL) - tbl case "failed" => - error "tableForDiscreteLogarithm: argument must be prime divisor_ - of the order of the multiplicative group" - tbl pretend TBL - - primitiveElement() == - if initelt? then initializeElt() - index(primitiveElt) - - normalElement() == - if initelt? then initializeElt() - index(normalElt) - - initializeElt() == - facOfGroupSize:=factors(factor(sizeCG)$Integer) - -- get a primitive element - pE:=createPrimitiveElement() - primitiveElt:=lookup(pE) - -- create a normal element - nElt:=generator() - while not normal? nElt repeat - nElt:=nElt*pE - normalElt:=lookup(nElt) - -- set elements initialization flag - initelt? := false - void()$Void - - initializeLog() == - if initelt? then initializeElt() --- set up tables for discrete logarithm - limit:Integer:=30 - -- the minimum size for the discrete logarithm table - for f in facOfGroupSize repeat - fac:=f.factor - base:$:=primitiveElement() ** (sizeCG quo fac) - l:Integer:=length(fac)$Integer - n:Integer:=0 - if odd?(l)$Integer then n:=shift(fac,-(l quo 2)) - else n:=shift(1,(l quo 2)) - if n < limit then - d:=(fac-1) quo limit + 1 - n:=(fac-1) quo d + 1 - tbl:TBL:=table()$TBL - a:$:=1 - for i in (0::NNI)..(n-1)::NNI repeat - insert_!([lookup(a),i::NNI]$R,tbl)$TBL - a:=a*base - insert_!([fac::PI,copy(tbl)$TBL]_ - $Record(key:PI,entry:TBL),discLogTable)$Table(PI,TBL) - -- set logarithm initialization flag - initlog? := false - -- tell user about initialization - --print("discrete logarithm tables initialized"::OUT) - void()$Void - - coerce(e:$):OutputForm == outputForm(lift(e),alpha) - - extensionDegree() == extdeg - - size() == (sizeCG + 1) pretend NNI - --- sizeOfGroundField() == size()$GF - - inGroundField?(x) == - retractIfCan(x) = "failed" => false - true - - characteristic() == characteristic()$GF - -@ -\section{domain FFX FiniteFieldExtension} -<>= -)abbrev domain FFX FiniteFieldExtension -++ Authors: R.Sutor, J. Grabmeier, A. Scheerhorn -++ Date Created: -++ Date Last Updated: 31 March 1991 -++ Basic Operations: -++ Related Constructors: FiniteFieldExtensionByPolynomial, -++ FiniteFieldPolynomialPackage -++ Also See: FiniteFieldCyclicGroupExtension, -++ FiniteFieldNormalBasisExtension -++ AMS Classifications: -++ Keywords: field, extension field, algebraic extension, -++ finite extension, finite field, Galois field -++ Reference: -++ R.Lidl, H.Niederreiter: Finite Field, Encyclopedia of Mathematics an -++ Its Applications, Vol. 20, Cambridge Univ. Press, 1983, ISBN 0 521 30240 4 -++ J. Grabmeier, A. Scheerhorn: Finite Fields in AXIOM. -++ AXIOM Technical Report Series, ATR/5 NP2522. -++ Description: -++ FiniteFieldExtensionByPolynomial(GF, n) implements an extension -++ of the finite field {\em GF} of degree n generated by the extension -++ polynomial constructed by -++ \spadfunFrom{createIrreduciblePoly}{FiniteFieldPolynomialPackage} from -++ \spadtype{FiniteFieldPolynomialPackage}. -FiniteFieldExtension(GF, n): Exports == Implementation where - GF: FiniteFieldCategory - n : PositiveInteger - Exports ==> FiniteAlgebraicExtensionField(GF) - -- MonogenicAlgebra(GF, SUP) with -- have to check this - Implementation ==> FiniteFieldExtensionByPolynomial(GF, - createIrreduciblePoly(n)$FiniteFieldPolynomialPackage(GF)) - -- old code for generating irreducible polynomials: - -- now "better" order (sparse polys first) - -- generateIrredPoly(n)$IrredPolyOverFiniteField(GF)) - -@ -\section{domain IFF InnerFiniteField} -<>= -)abbrev domain IFF InnerFiniteField -++ Author: ??? -++ Date Created: ??? -++ Date Last Updated: 29 May 1990 -++ Basic Operations: -++ Related Constructors: FiniteFieldExtensionByPolynomial, -++ FiniteFieldPolynomialPackage -++ Also See: FiniteFieldCyclicGroup, FiniteFieldNormalBasis -++ AMS Classifications: -++ Keywords: field, extension field, algebraic extension, -++ finite extension, finite field, Galois field -++ Reference: -++ R.Lidl, H.Niederreiter: Finite Field, Encyclopedia of Mathematics an -++ Its Applications, Vol. 20, Cambridge Univ. Press, 1983, ISBN 0 521 30240 4 -++ J. Grabmeier, A. Scheerhorn: Finite Fields in AXIOM. -++ AXIOM Technical Report Series, ATR/5 NP2522. -++ Description: -++ InnerFiniteField(p,n) implements finite fields with \spad{p**n} elements -++ where p is assumed prime but does not check. -++ For a version which checks that p is prime, see \spadtype{FiniteField}. -InnerFiniteField(p:PositiveInteger, n:PositiveInteger) == - FiniteFieldExtension(InnerPrimeField p, n) - -@ -\section{domain FF FiniteField} -<>= -)abbrev domain FF FiniteField -++ Author: ??? -++ Date Created: ??? -++ Date Last Updated: 29 May 1990 -++ Basic Operations: -++ Related Constructors: -++ Also See: -++ AMS Classifications: -++ Keywords: field, extension field, algebraic extension, -++ finite extension, finite field, Galois field -++ Reference: -++ R.Lidl, H.Niederreiter: Finite Field, Encyclopedia of Mathematics an -++ Its Applications, Vol. 20, Cambridge Univ. Press, 1983, ISBN 0 521 30240 4 -++ J. Grabmeier, A. Scheerhorn: Finite Fields in AXIOM. -++ AXIOM Technical Report Series, ATR/5 NP2522. -++ Description: -++ FiniteField(p,n) implements finite fields with p**n elements. -++ This packages checks that p is prime. -++ For a non-checking version, see \spadtype{InnerFiniteField}. -FiniteField(p:PositiveInteger, n:PositiveInteger): _ - FiniteAlgebraicExtensionField(PrimeField p) ==_ - FiniteFieldExtensionByPolynomial(PrimeField p,_ - createIrreduciblePoly(n)$FiniteFieldPolynomialPackage(PrimeField p)) - -- old code for generating irreducible polynomials: - -- now "better" order (sparse polys first) - -- generateIrredPoly(n)$IrredPolyOverFiniteField(GF)) - -@ -\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/files.spad.pamphlet b/src/algebra/files.spad.pamphlet deleted file mode 100644 index f896b96..0000000 --- a/src/algebra/files.spad.pamphlet +++ /dev/null @@ -1,1061 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra files.spad} -\author{Stephen M. Watt, Victor Miller, Barry Trager} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{domain FILE File} -<>= --- files.spad.pamphlet File.input -)spool File.output -)set message test on -)set message auto off -)clear all ---S 1 -ifile:File List Integer:=open("jazz1","output") ---R ---R ---R (1) "jazz1" ---R Type: File List Integer ---E 1 - ---S 2 -write!(ifile, [-1,2,3]) ---R ---R ---R (2) [- 1,2,3] ---R Type: List Integer ---E 2 - ---S 3 -write!(ifile, [10,-10,0,111]) ---R ---R ---R (3) [10,- 10,0,111] ---R Type: List Integer ---E 3 - ---S 4 -write!(ifile, [7]) ---R ---R ---R (4) [7] ---R Type: List Integer ---E 4 - ---S 5 -reopen!(ifile, "input") ---R ---R ---R (5) "jazz1" ---R Type: File List Integer ---E 5 - ---S 6 -read! ifile ---R ---R ---R (6) [- 1,2,3] ---R Type: List Integer ---E 6 - ---S 7 -read! ifile ---R ---R ---R (7) [10,- 10,0,111] ---R Type: List Integer ---E 7 - ---S 8 -readIfCan! ifile ---R ---R ---R (8) [7] ---R Type: Union(List Integer,...) ---E 8 - ---S 9 -readIfCan! ifile ---R ---R ---R (9) "failed" ---R Type: Union("failed",...) ---E 9 - ---S 10 -iomode ifile ---R ---R ---R (10) "input" ---R Type: String ---E 10 - ---S 11 -name ifile ---R ---R ---R (11) "jazz1" ---R Type: FileName ---E 11 - ---S 12 -close! ifile ---R ---R ---R (12) "jazz1" ---R Type: File List Integer ---E 12 -)system rm jazz1 -)spool -)lisp (bye) -@ -<>= -==================================================================== -File examples -==================================================================== - -The File(S) domain provides a basic interface to read and write values -of type S in files. - -Before working with a file, it must be made accessible to Axiom with -the open operation. - - ifile:File List Integer:=open("/tmp/jazz1","output") - "jazz1" - Type: File List Integer - -The open function arguments are a FileNam} and a String specifying the -mode. If a full pathname is not specified, the current default -directory is assumed. The mode must be one of "input" or "output". -If it is not specified, "input" is assumed. Once the file has been -opened, you can read or write data. - -The operations read and write are provided. - - write!(ifile, [-1,2,3]) - [- 1,2,3] - Type: List Integer - - write!(ifile, [10,-10,0,111]) - [10,- 10,0,111] - Type: List Integer - - write!(ifile, [7]) - [7] - Type: List Integer - -You can change from writing to reading (or vice versa) by reopening a file. - - reopen!(ifile, "input") - "jazz1" - Type: File List Integer - - read! ifile - [- 1,2,3] - Type: List Integer - - read! ifile - [10,- 10,0,111] - Type: List Integer - -The read operation can cause an error if one tries to read more data -than is in the file. To guard against this possibility the readIfCan -operation should be used. - - readIfCan! ifile - [7] - Type: Union(List Integer,...) - - readIfCan! ifile - "failed" - Type: Union("failed",...) - -You can find the current mode of the file, and the file's name. - - iomode ifile - "input" - Type: String - - name ifile - "jazz1" - Type: FileName - -When you are finished with a file, you should close it. - - close! ifile - "jazz1" - Type: File List Integer - - )system rm /tmp/jazz1 - -A limitation of the underlying LISP system is that not all values can -be represented in a file. In particular, delayed values containing -compiled functions cannot be saved. - -See Also: -o )help TextFile -o )help KeyedAccessFile -o )help Library -o )help Filename -o )show File -o $AXIOM/doc/src/algebra/files.spad.dvi - -@ -<>= -)abbrev domain FILE File -++ Author: Stephen M. Watt, Victor Miller -++ Date Created: 1984 -++ Date Last Updated: June 4, 1991 -++ Basic Operations: -++ Related Domains: -++ Also See: -++ AMS Classifications: -++ Keywords: -++ Examples: -++ References: -++ Description: -++ This domain provides a basic model of files to save arbitrary values. -++ The operations provide sequential access to the contents. - -File(S:SetCategory): FileCategory(FileName, S) with - readIfCan_!: % -> Union(S, "failed") - ++ readIfCan!(f) returns a value from the file f, if possible. - ++ If f is not open for reading, or if f is at the end of file - ++ then \spad{"failed"} is the result. - == add - FileState ==> SExpression - IOMode ==> String - - Rep:=Record(fileName: FileName, _ - fileState: FileState, _ - fileIOmode: IOMode) - - defstream(fn: FileName, mode: IOMode): FileState == - mode = "input" => - not readable? fn => error ["File is not readable", fn] - MAKE_-INSTREAM(fn::String)$Lisp - mode = "output" => - not writable? fn => error ["File is not writable", fn] - MAKE_-OUTSTREAM(fn::String)$Lisp - error ["IO mode must be input or output", mode] - - f1 = f2 == - f1.fileName = f2.fileName - coerce(f: %): OutputForm == - f.fileName::OutputForm - - open fname == - open(fname, "input") - open(fname, mode) == - fstream := defstream(fname, mode) - [fname, fstream, mode] - reopen_!(f, mode) == - fname := f.fileName - f.fileState := defstream(fname, mode) - f.fileIOmode:= mode - f - close_! f == - SHUT(f.fileState)$Lisp - f.fileIOmode := "closed" - f - name f == - f.fileName - iomode f == - f.fileIOmode - read_! f == - f.fileIOmode ^= "input" => - error "File not in read state" - x := VMREAD(f.fileState)$Lisp - PLACEP(x)$Lisp => - error "End of file" - x - readIfCan_! f == - f.fileIOmode ^= "input" => - error "File not in read state" - x: S := VMREAD(f.fileState)$Lisp - PLACEP(x)$Lisp => "failed" - x - write_!(f, x) == - f.fileIOmode ^= "output" => - error "File not in write state" - z := PRINT_-FULL(x, f.fileState)$Lisp - TERPRI(f.fileState)$Lisp - x - -@ -\section{domain TEXTFILE TextFile} -<>= --- files.spad.pamphlet TextFile.input -)spool TextFile.output -)set message test on -)set message auto off -)clear all ---S 1 of 10 -f1: TextFile := open("/etc/group", "input") ---R ---R ---R (1) "/etc/group" ---R Type: TextFile ---E 1 - ---S 2 of 10 -f2: TextFile := open("MOTD", "output") ---R ---R ---R (2) "MOTD" ---R Type: TextFile ---E 2 - ---S 3 of 10 -l := readLine! f1 ---R ---R ---R (3) "root:x:0:root" ---R Type: String ---E 3 - ---S 4 of 10 -writeLine!(f2, upperCase l) ---R ---R ---R (4) "ROOT:X:0:ROOT" ---R Type: String ---E 4 - ---S 5 of 10 -while not endOfFile? f1 repeat - s := readLine! f1 - writeLine!(f2, upperCase s) ---R ---R Type: Void ---E 5 - ---S 6 of 10 -close! f1 ---R ---R ---R (6) "/etc/group" ---R Type: TextFile ---E 6 - ---S 7 of 10 -write!(f2, "-The-") ---R ---R ---R (7) "-The-" ---R Type: String ---E 7 - ---S 8 of 10 -write!(f2, "-End-") ---R ---R ---R (8) "-End-" ---R Type: String ---E 8 - ---S 9 of 10 -writeLine! f2 ---R ---R ---R (9) "" ---R Type: String ---E 9 - ---S 10 of 10 -close! f2 ---R ---R ---R (10) "MOTD" ---R Type: TextFile ---E 10 -)system rm -f MOTD -)spool -)lisp (bye) -@ -<>= -==================================================================== -TextFile examples -==================================================================== - -The domain TextFile allows Axiom to read and write character data and -exchange text with other programs. This type behaves in Axiom much -like a File of strings, with additional operations to cause new lines. -We give an example of how to produce an upper case copy of a file. - -This is the file from which we read the text. - - f1: TextFile := open("/etc/group", "input") - "/etc/group" - Type: TextFile - -This is the file to which we write the text. - - f2: TextFile := open("/tmp/MOTD", "output") - "MOTD" - Type: TextFile - -Entire lines are handled using the readLine and writeLine operations. - - l := readLine! f1 - "root:x:0:root" - Type: String - - writeLine!(f2, upperCase l) - "ROOT:X:0:ROOT" - Type: String - -Use the endOfFile? operation to check if you have reached the end of the file. - - while not endOfFile? f1 repeat - s := readLine! f1 - writeLine!(f2, upperCase s) - Type: Void - -The file f1 is exhausted and should be closed. - - close! f1 - "/etc/group" - Type: TextFile - -It is sometimes useful to write lines a bit at a time. The write operation -allows this. - - write!(f2, "-The-") - "-The-" - Type: String - - write!(f2, "-End-") - "-End-" - Type: String - -This ends the line. This is done in a machine-dependent manner. - - writeLine! f2 - "" - Type: String - - close! f2 - "MOTD" - Type: TextFile - -Finally, clean up. - - )system rm /tmp/MOTD - -See Also: -o )help File -o )help KeyedAccessFile -o )help Library -o )show TextFile -o $AXIOM/doc/src/algebra/files.spad.dvi - -@ -<>= -)abbrev domain TEXTFILE TextFile -++ Author: Stephen M. Watt -++ Date Created: 1985 -++ Date Last Updated: June 4, 1991 -++ Basic Operations: writeLine! readLine! readLineIfCan! readIfCan! endOfFile? -++ Related Constructors: -++ Also See: -++ AMS Classifications: -++ Keywords: -++ References: -++ Description: -++ This domain provides an implementation of text files. Text is stored -++ in these files using the native character set of the computer. - -TextFile: Cat == Def where - StreamName ==> Union(FileName, "console") - - Cat == FileCategory(FileName, String) with - writeLine_!: (%, String) -> String - ++ writeLine!(f,s) writes the contents of the string s - ++ and finishes the current line in the file f. - ++ The value of s is returned. - - writeLine_!: % -> String - ++ writeLine!(f) finishes the current line in the file f. - ++ An empty string is returned. The call \spad{writeLine!(f)} is - ++ equivalent to \spad{writeLine!(f,"")}. - - readLine_!: % -> String - ++ readLine!(f) returns a string of the contents of a line from - ++ the file f. - - readLineIfCan_!: % -> Union(String, "failed") - ++ readLineIfCan!(f) returns a string of the contents of a line from - ++ file f, if possible. If f is not readable or if it is - ++ positioned at the end of file, then \spad{"failed"} is returned. - - readIfCan_!: % -> Union(String, "failed") - ++ readIfCan!(f) returns a string of the contents of a line from - ++ file f, if possible. If f is not readable or if it is - ++ positioned at the end of file, then \spad{"failed"} is returned. - - endOfFile?: % -> Boolean - ++ endOfFile?(f) tests whether the file f is positioned after the - ++ end of all text. If the file is open for output, then - ++ this test is always true. - - Def == File(String) add - FileState ==> SExpression - - Rep := Record(fileName: FileName, _ - fileState: FileState, _ - fileIOmode: String) - - read_! f == readLine_! f - readIfCan_! f == readLineIfCan_! f - - readLine_! f == - f.fileIOmode ^= "input" => error "File not in read state" - s: String := read_-line(f.fileState)$Lisp - PLACEP(s)$Lisp => error "End of file" - s - readLineIfCan_! f == - f.fileIOmode ^= "input" => error "File not in read state" - s: String := read_-line(f.fileState)$Lisp - PLACEP(s)$Lisp => "failed" - s - write_!(f, x) == - f.fileIOmode ^= "output" => error "File not in write state" - PRINTEXP(x, f.fileState)$Lisp - x - writeLine_! f == - f.fileIOmode ^= "output" => error "File not in write state" - TERPRI(f.fileState)$Lisp - "" - writeLine_!(f, x) == - f.fileIOmode ^= "output" => error "File not in write state" - PRINTEXP(x, f.fileState)$Lisp - TERPRI(f.fileState)$Lisp - x - endOfFile? f == - f.fileIOmode = "output" => false - (EOFP(f.fileState)$Lisp pretend Boolean) => true - false - -@ -\section{domain BINFILE BinaryFile} -<>= -)abbrev domain BINFILE BinaryFile -++ Author: Barry M. Trager -++ Date Created: 1993 -++ Date Last Updated: -++ Basic Operations: writeByte! readByte! readByteIfCan! -++ Related Constructors: -++ Also See: -++ AMS Classifications: -++ Keywords: -++ References: -++ Description: -++ This domain provides an implementation of binary files. Data is -++ accessed one byte at a time as a small integer. - -BinaryFile: Cat == Def where - - Cat == FileCategory(FileName, SingleInteger) with - readIfCan_!: % -> Union(SingleInteger, "failed") - ++ readIfCan!(f) returns a value from the file f, if possible. - ++ If f is not open for reading, or if f is at the end of file - ++ then \spad{"failed"} is the result. - --- "#": % -> SingleInteger --- ++ #(f) returns the length of the file f in bytes. - - position: % -> SingleInteger - ++ position(f) returns the current byte-position in the file f. - - position_!: (%, SingleInteger) -> SingleInteger - ++ position!(f, i) sets the current byte-position to i. - - Def == File(SingleInteger) add - FileState ==> SExpression - - Rep := Record(fileName: FileName, _ - fileState: FileState, _ - fileIOmode: String) - --- direc : Symbol := INTERN("DIRECTION","KEYWORD")$Lisp --- input : Symbol := INTERN("INPUT","KEYWORD")$Lisp --- output : Symbol := INTERN("OUTPUT","KEYWORD")$Lisp --- eltype : Symbol := INTERN("ELEMENT-TYPE","KEYWORD")$Lisp --- bytesize : SExpression := LIST(QUOTE(UNSIGNED$Lisp)$Lisp,8)$Lisp - - - defstream(fn: FileName, mode: String): FileState == - mode = "input" => - not readable? fn => error ["File is not readable", fn] - BINARY__OPEN__INPUT(fn::String)$Lisp --- OPEN(fn::String, direc, input, eltype, bytesize)$Lisp - mode = "output" => - not writable? fn => error ["File is not writable", fn] - BINARY__OPEN__OUTPUT(fn::String)$Lisp --- OPEN(fn::String, direc, output, eltype, bytesize)$Lisp - error ["IO mode must be input or output", mode] - - open(fname, mode) == - fstream := defstream(fname, mode) - [fname, fstream, mode] - - reopen_!(f, mode) == - fname := f.fileName - f.fileState := defstream(fname, mode) - f.fileIOmode:= mode - f - - close_! f == - f.fileIOmode = "output" => - BINARY__CLOSE__OUTPUT()$Lisp - f - f.fileIOmode = "input" => - BINARY__CLOSE__INPUT()$Lisp - f - error "file must be in read or write state" - - read! f == - f.fileIOmode ^= "input" => error "File not in read state" - BINARY__SELECT__INPUT(f.fileState)$Lisp - BINARY__READBYTE()$Lisp --- READ_-BYTE(f.fileState)$Lisp - readIfCan_! f == - f.fileIOmode ^= "input" => error "File not in read state" - BINARY__SELECT__INPUT(f.fileState)$Lisp - n:SingleInteger:=BINARY__READBYTE()$Lisp - n = -1 => "failed" - n::Union(SingleInteger,"failed") --- READ_-BYTE(f.fileState,NIL$Lisp, --- "failed"::Union(SingleInteger,"failed"))$Lisp - write_!(f, x) == - f.fileIOmode ^= "output" => error "File not in write state" - x < 0 or x>255 => error "integer cannot be represented as a byte" - BINARY__PRINBYTE(x)$Lisp --- WRITE_-BYTE(x, f.fileState)$Lisp - x - --- # f == FILE_-LENGTH(f.fileState)$Lisp - position f == - f.fileIOmode ^= "input" => error "file must be in read state" - FILE_-POSITION(f.fileState)$Lisp - position_!(f,i) == - f.fileIOmode ^= "input" => error "file must be in read state" - (FILE_-POSITION(f.fileState,i)$Lisp ; i) - -@ -\section{domain KAFILE KeyedAccessFile} -<>= --- files.spad.pamphlet KeyedAccessFile.input -)spool KeyedAccessFile.output -)set message test on -)set message auto off -)clear all -ey: KeyedAccessFile(Integer) := open("editor.year", "output") -ey."Char":= 1986 -ey."Caviness" := 1985 -ey."Fitch" := 1984 -ey."Char" -ey("Char") -ey "Char" -search("Char", ey) -search("Smith", ey) -remove!("Char", ey) -keys ey -#ey -KE := Record(key: String, entry: Integer) -reopen!(ey, "output") -write!(ey, ["van Hulzen", 1983]$KE) -write!(ey, ["Calmet", 1982]$KE) -write!(ey, ["Wang", 1981]$KE) -close! ey -keys ey -members ey -)system rm -r editor.year -)spool -)lisp (bye) -@ -<>= -==================================================================== -KeyedAccessFile examples -==================================================================== - -The domain KeyedAccessFile(S) provides files which can be used -as associative tables. Data values are stored in these files and can -be retrieved according to their keys. The keys must be strings so -this type behaves very much like the StringTable(S) domain. The -difference is that keyed access files reside in secondary storage -while string tables are kept in memory. - -Before a keyed access file can be used, it must first be opened. -A new file can be created by opening it for output. - - ey: KeyedAccessFile(Integer) := open("editor.year", "output") - -Just as for vectors, tables or lists, values are saved in a keyed -access file by setting elements. - - ey."Char":= 1986 - - ey."Caviness" := 1985 - - ey."Fitch" := 1984 - -Values are retrieved using application, in any of its syntactic forms. - - ey."Char" - - ey("Char") - - ey "Char" - -Attempting to retrieve a non-existent element in this way causes an -error. If it is not known whether a key exists, you should use the -search operation. - - search("Char", ey) - - search("Smith", ey) - -When an entry is no longer needed, it can be removed from the file. - - remove!("Char", ey) - -The keys operation returns a list of all the keys for a given file. - - keys ey - -The # operation gives the number of entries. - - #ey - -The table view of keyed access files provides safe operations. That -is, if the Axiom program is terminated between file operations, the -file is left in a consistent, current state. This means, however, -that the operations are somewhat costly. For example, after each -update the file is closed. - -Here we add several more items to the file, then check its contents. - - KE := Record(key: String, entry: Integer) - - reopen!(ey, "output") - -If many items are to be added to a file at the same time, then it is -more efficient to use the write operation. - - write!(ey, ["van Hulzen", 1983]$KE) - - write!(ey, ["Calmet", 1982]$KE) - - write!(ey, ["Wang", 1981]$KE) - - close! ey - -The read operation is also available from the file view, but it -returns elements in a random order. It is generally clearer and more -efficient to use the keys operation and to extract elements by key. - - keys ey - - members ey - - )system rm -r editor.year - -See Also: -o )help Table -o )help StringTable -o )help File -o )help TextFile -o )help Library -o )show KeyedAccessFile -o $AXIOM/doc/src/algebra/files.spad.dvi - -@ -<>= -)abbrev domain KAFILE KeyedAccessFile -++ Author: Stephen M. Watt -++ Date Created: 1985 -++ Date Last Updated: June 4, 1991 -++ Basic Operations: -++ Related Domains: -++ Also See: -++ AMS Classifications: -++ Keywords: -++ Examples: -++ References: -++ Description: -++ This domain allows a random access file to be viewed both as a table -++ and as a file object. - - -KeyedAccessFile(Entry): KAFcategory == KAFcapsule where - Name ==> FileName - Key ==> String - Entry : SetCategory - - KAFcategory == - Join(FileCategory(Name, Record(key: Key, entry: Entry)), - TableAggregate(Key, Entry)) with - finiteAggregate - pack_!: % -> % - ++ pack!(f) reorganizes the file f on disk to recover - ++ unused space. - - KAFcapsule == add - - CLASS ==> 131 -- an arbitrary no. greater than 127 - FileState ==> SExpression - IOMode ==> String - - - Cons:= Record(car: SExpression, cdr: SExpression) - Rep := Record(fileName: Name, _ - fileState: FileState, _ - fileIOmode: IOMode) - - defstream(fn: Name, mode: IOMode): FileState == - mode = "input" => - not readable? fn => error ["File is not readable", fn] - RDEFINSTREAM(fn::String)$Lisp - mode = "output" => - not writable? fn => error ["File is not writable", fn] - RDEFOUTSTREAM(fn::String)$Lisp - error ["IO mode must be input or output", mode] - - ---- From Set ---- - f1 = f2 == - f1.fileName = f2.fileName - coerce(f: %): OutputForm == - f.fileName::OutputForm - - ---- From FileCategory ---- - open fname == - open(fname, "either") - open(fname, mode) == - mode = "either" => - exists? fname => - open(fname, "input") - writable? fname => - reopen_!(open(fname, "output"), "input") - error "File does not exist and cannot be created" - [fname, defstream(fname, mode), mode] - reopen_!(f, mode) == - close_! f - if mode ^= "closed" then - f.fileState := defstream(f.fileName, mode) - f.fileIOmode := mode - f - close_! f == - if f.fileIOmode ^= "closed" then - RSHUT(f.fileState)$Lisp - f.fileIOmode := "closed" - f - read_! f == - f.fileIOmode ^= "input" => error ["File not in read state",f] - ks: List Symbol := RKEYIDS(f.fileName)$Lisp - null ks => error ["Attempt to read empty file", f] - ix := random()$Integer rem #ks - k: String := PNAME(ks.ix)$Lisp - [k, SPADRREAD(k, f.fileState)$Lisp] - write_!(f, pr) == - f.fileIOmode ^= "output" => error ["File not in write state",f] - SPADRWRITE(pr.key, pr.entry, f.fileState)$Lisp - pr - name f == - f.fileName - iomode f == - f.fileIOmode - - ---- From TableAggregate ---- - empty() == - fn := new("", "kaf", "sdata")$Name - open fn - keys f == - close_! f - l: List SExpression := RKEYIDS(f.fileName)$Lisp - [PNAME(n)$Lisp for n in l] - # f == - # keys f - elt(f,k) == - reopen_!(f, "input") - SPADRREAD(k, f.fileState)$Lisp - setelt(f,k,e) == - -- Leaves f in a safe, closed state. For speed use "write". - reopen_!(f, "output") - UNWIND_-PROTECT(write_!(f, [k,e]), close_! f)$Lisp - close_! f - e - search(k,f) == - not member?(k, keys f) => "failed" -- can't trap RREAD error - reopen_!(f, "input") - (SPADRREAD(k, f.fileState)$Lisp)@Entry - remove_!(k:String,f:%) == - result := search(k,f) - result case "failed" => result - close_! f - RDROPITEMS(NAMESTRING(f.fileName)$Lisp, LIST(k)$Lisp)$Lisp - result - pack_! f == - close_! f - RPACKFILE(f.fileName)$Lisp - f - -@ -\section{domain LIB Library} -<>= --- files.spad.pamphlet Library.input -)spool Library.output -)set message test on -)set message auto off -)clear all -stuff := library "Neat.stuff" -stuff.int := 32**2 -stuff."poly" := x**2 + 1 -stuff.str := "Hello" -keys stuff -stuff.poly -stuff("poly") -)system rm -rf Neat.stuff -)spool -)lisp (bye) -@ -<>= -==================================================================== -Library examples -==================================================================== - -The Library domain provides a simple way to store Axiom values -in a file. This domain is similar to KeyedAccessFile but fewer -declarations are needed and items of different types can be saved -together in the same file. - -To create a library, you supply a file name. - - stuff := library "Neat.stuff" - -Now values can be saved by key in the file. The keys should be -mnemonic, just as the field names are for records. They can be given -either as strings or symbols. - - stuff.int := 32**2 - - stuff."poly" := x**2 + 1 - - stuff.str := "Hello" - -You obtain the set of available keys using the keys operation. - - keys stuff - -You extract values by giving the desired key in this way. - - stuff.poly - - stuff("poly") - -When the file is no longer needed, you should remove it from the -file system. - - )system rm -rf Neat.stuff - -See Also: -o )help File -o )help TextFile -o )help KeyedAccessFile -o )show Library -o $AXIOM/doc/src/algebra/files.spad.dvi - -@ -<>= -)abbrev domain LIB Library -++ Author: Stephen M. Watt -++ Date Created: 1985 -++ Date Last Updated: June 4, 1991 -++ Basic Operations: -++ Related Domains: KeyedAccessFile -++ Also See: -++ AMS Classifications: -++ Keywords: -++ Examples: -++ References: -++ Description: -++ This domain provides a simple way to save values in files. -Library(): TableAggregate(String, Any) with - library: FileName -> % - ++ library(ln) creates a new library file. - pack_!: % -> % - ++ pack!(f) reorganizes the file f on disk to recover - ++ unused space. - - elt : (%, Symbol) -> Any - ++ elt(lib,k) or lib.k extracts the value corresponding to the key \spad{k} - ++ from the library \spad{lib}. - - setelt : (%, Symbol, Any) -> Any - ++ \spad{lib.k := v} saves the value \spad{v} in the library - ++ \spad{lib}. It can later be extracted using the key \spad{k}. - - close_!: % -> % - ++ close!(f) returns the library f closed to input and output. - - == KeyedAccessFile(Any) add - Rep := KeyedAccessFile(Any) - library f == open f - elt(f:%,v:Symbol) == elt(f, string v) - setelt(f:%, v:Symbol, val:Any) == setelt(f, string v, val) - -@ -\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/float.spad.pamphlet b/src/algebra/float.spad.pamphlet deleted file mode 100644 index 6dae1d2..0000000 --- a/src/algebra/float.spad.pamphlet +++ /dev/null @@ -1,1877 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra float.spad} -\author{Michael Monagan} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{domain FLOAT Float} -As reported in bug number 4733 (rounding of negative numbers) -errors were observed in operations such as -\begin{verbatim} - -> round(-3.9) - -> truncate(-3.9) -\end{verbatim} -The problem is the unexpected behaviour of the shift -with negative integer arguments. -\begin{verbatim} - -> shift(-7,-1) -\end{verbatim} -returns -4 while the code here in float expects the -value to be -3. shift uses the lisp function ASH -'arithmetic shift left' but the spad code expects -an unsigned 'logical' shift. See -\begin{verbatim} - http://www.lispworks.com/reference/HyperSpec/Body/f_ash.htm#ash -\end{verbatim} -A new internal function shift2 is defined in terms of -shift to compensate for the use of ASH and provide the -required function. - -It is currently unknown whether the unexpected behaviour -of shift for negative arguments will cause bugs in other -parts of Axiom. -<>= --- float.spad.pamphlet Float.input -)spool Float.output -)set message test on -)set message auto off -)clear all ---S 1 of 37 -1.234 ---R ---R ---R (1) 1.234 ---R Type: Float ---E 1 - ---S 2 of 37 -1.234E2 ---R ---R ---R (2) 123.4 ---R Type: Float ---E 2 - ---S 3 of 37 -sqrt(1.2 + 2.3 / 3.4 ** 4.5) ---R ---R ---R (3) 1.0996972790 671286226 ---R Type: Float ---E 3 - ---S 4 of 37 -i := 3 :: Float ---R ---R ---R (4) 3.0 ---R Type: Float ---E 4 - ---S 5 of 37 -i :: Integer ---R ---R ---R (5) 3 ---R Type: Integer ---E 5 - ---S 6 of 37 -i :: Fraction Integer ---R ---R ---R (6) 3 ---R Type: Fraction Integer ---E 6 - ---S 7 of 37 -r := 3/7 :: Float ---R ---R ---R (7) 0.4285714285 7142857143 ---R Type: Float ---E 7 - ---S 8 of 37 -r :: Fraction Integer ---R ---R ---R 3 ---R (8) - ---R 7 ---R Type: Fraction Integer ---E 8 - ---S 9 of 37 -r :: Integer ---R ---R ---RDaly Bug ---R Cannot convert from type Float to Integer for value ---R 0.4285714285 7142857143 ---R ---E 9 - ---S 10 of 37 -truncate 3.6 ---R ---R ---R (9) 3.0 ---R Type: Float ---E 10 - ---S 11 of 37 -round 3.6 ---R ---R ---R (10) 4.0 ---R Type: Float ---E 11 - ---S 12 of 37 -truncate(-3.6) ---R ---R ---R (11) - 3.0 ---R Type: Float ---E 12 - ---S 13 of 37 -round(-3.6) ---R ---R ---R (12) - 4.0 ---R Type: Float ---E 13 - ---S 14 of 37 -fractionPart 3.6 ---R ---R ---R (13) 0.6 ---R Type: Float ---E 14 - ---S 15 of 37 -digits 40 ---R ---R ---R (14) 20 ---R Type: PositiveInteger ---E 15 - ---S 16 of 37 -sqrt 0.2 ---R ---R ---R (15) 0.4472135954 9995793928 1834733746 2552470881 ---R Type: Float ---E 16 - ---S 17 of 37 -pi()$Float ---R ---R ---R (16) 3.1415926535 8979323846 2643383279 502884197 ---R Type: Float ---E 17 - ---S 18 of 37 -digits 500 ---R ---R ---R (17) 40 ---R Type: PositiveInteger ---E 18 - ---S 19 of 37 -pi()$Float ---R ---R ---R (18) ---R 3.1415926535 8979323846 2643383279 5028841971 6939937510 5820974944 592307816 ---R 4 0628620899 8628034825 3421170679 8214808651 3282306647 0938446095 505822317 ---R 2 5359408128 4811174502 8410270193 8521105559 6446229489 5493038196 442881097 ---R 5 6659334461 2847564823 3786783165 2712019091 4564856692 3460348610 454326648 ---R 2 1339360726 0249141273 7245870066 0631558817 4881520920 9628292540 917153643 ---R 6 7892590360 0113305305 4882046652 1384146951 9415116094 3305727036 575959195 ---R 3 0921861173 8193261179 3105118548 0744623799 6274956735 1885752724 891227938 ---R 1 830119491 ---R Type: Float ---E 19 - ---S 20 of 37 -digits 20 ---R ---R ---R (19) 500 ---R Type: PositiveInteger ---E 20 - ---S 21 of 37 -outputSpacing 0; x := sqrt 0.2 ---R ---R ---R (20) 0.44721359549995793928 ---R Type: Float ---E 21 - ---S 22 of 37 -outputSpacing 5; x ---R ---R ---R (21) 0.44721 35954 99957 93928 ---R Type: Float ---E 22 - ---S 23 of 37 -y := x/10**10 ---R ---R ---R (22) 0.44721 35954 99957 93928 E -10 ---R Type: Float ---E 23 - ---S 24 of 37 -outputFloating(); x ---R ---R ---R (23) 0.44721 35954 99957 93928 E 0 ---R Type: Float ---E 24 - ---S 25 of 37 -outputFixed(); y ---R ---R ---R (24) 0.00000 00000 44721 35954 99957 93928 ---R Type: Float ---E 25 - ---S 26 of 37 -outputFloating 2; y ---R ---R ---R (25) 0.45 E -10 ---R Type: Float ---E 26 - ---S 27 of 37 -outputFixed 2; x ---R ---R ---R (26) 0.45 ---R Type: Float ---E 27 - ---S 28 of 37 -outputGeneral() ---R ---R Type: Void ---E 28 - ---S 29 of 37 -a: Matrix Fraction Integer := matrix [ [1/(i+j+1) for j in 0..9] for i in 0..9] ---R ---R ---R + 1 1 1 1 1 1 1 1 1+ ---R |1 - - - - - - - - --| ---R | 2 3 4 5 6 7 8 9 10| ---R | | ---R |1 1 1 1 1 1 1 1 1 1| ---R |- - - - - - - - -- --| ---R |2 3 4 5 6 7 8 9 10 11| ---R | | ---R |1 1 1 1 1 1 1 1 1 1| ---R |- - - - - - - -- -- --| ---R |3 4 5 6 7 8 9 10 11 12| ---R | | ---R |1 1 1 1 1 1 1 1 1 1| ---R |- - - - - - -- -- -- --| ---R |4 5 6 7 8 9 10 11 12 13| ---R | | ---R |1 1 1 1 1 1 1 1 1 1| ---R |- - - - - -- -- -- -- --| ---R |5 6 7 8 9 10 11 12 13 14| ---R (28) | | ---R |1 1 1 1 1 1 1 1 1 1| ---R |- - - - -- -- -- -- -- --| ---R |6 7 8 9 10 11 12 13 14 15| ---R | | ---R |1 1 1 1 1 1 1 1 1 1| ---R |- - - -- -- -- -- -- -- --| ---R |7 8 9 10 11 12 13 14 15 16| ---R | | ---R |1 1 1 1 1 1 1 1 1 1| ---R |- - -- -- -- -- -- -- -- --| ---R |8 9 10 11 12 13 14 15 16 17| ---R | | ---R |1 1 1 1 1 1 1 1 1 1| ---R |- -- -- -- -- -- -- -- -- --| ---R |9 10 11 12 13 14 15 16 17 18| ---R | | ---R | 1 1 1 1 1 1 1 1 1 1| ---R |-- -- -- -- -- -- -- -- -- --| ---R +10 11 12 13 14 15 16 17 18 19+ ---R Type: Matrix Fraction Integer ---E 29 - ---S 30 of 37 -d:= determinant a ---R ---R ---R 1 ---R (29) ----------------------------------------------------- ---R 46206893947914691316295628839036278726983680000000000 ---R Type: Fraction Integer ---E 30 - ---S 31 of 37 -d :: Float ---R ---R ---R (30) 0.21641 79226 43149 18691 E -52 ---R Type: Float ---E 31 - ---S 32 of 37 -b: Matrix DoubleFloat := matrix [ [1/(i+j+1$DoubleFloat) for j in 0..9] for i in 0..9] ---R ---R ---R (31) ---R [ ---R [1., 0.5, 0.33333333333333331, 0.25, 0.20000000000000001, ---R 0.16666666666666666, 0.14285714285714285, 0.125, 0.1111111111111111, ---R 0.10000000000000001] ---R , ---R ---R [0.5, 0.33333333333333331, 0.25, 0.20000000000000001, 0.16666666666666666, ---R 0.14285714285714285, 0.125, 0.1111111111111111, 0.10000000000000001, ---R 9.0909090909090912E-2] ---R , ---R ---R [0.33333333333333331, 0.25, 0.20000000000000001, 0.16666666666666666, ---R 0.14285714285714285, 0.125, 0.1111111111111111, 0.10000000000000001, ---R 9.0909090909090912E-2, 8.3333333333333329E-2] ---R , ---R ---R [0.25, 0.20000000000000001, 0.16666666666666666, 0.14285714285714285, ---R 0.125, 0.1111111111111111, 0.10000000000000001, 9.0909090909090912E-2, ---R 8.3333333333333329E-2, 7.6923076923076927E-2] ---R , ---R ---R [0.20000000000000001, 0.16666666666666666, 0.14285714285714285, 0.125, ---R 0.1111111111111111, 0.10000000000000001, 9.0909090909090912E-2, ---R 8.3333333333333329E-2, 7.6923076923076927E-2, 7.1428571428571425E-2] ---R , ---R ---R [0.16666666666666666, 0.14285714285714285, 0.125, 0.1111111111111111, ---R 0.10000000000000001, 9.0909090909090912E-2, 8.3333333333333329E-2, ---R 7.6923076923076927E-2, 7.1428571428571425E-2, 6.6666666666666666E-2] ---R , ---R ---R [0.14285714285714285, 0.125, 0.1111111111111111, 0.10000000000000001, ---R 9.0909090909090912E-2, 8.3333333333333329E-2, 7.6923076923076927E-2, ---R 7.1428571428571425E-2, 6.6666666666666666E-2, 6.25E-2] ---R , ---R ---R [0.125, 0.1111111111111111, 0.10000000000000001, 9.0909090909090912E-2, ---R 8.3333333333333329E-2, 7.6923076923076927E-2, 7.1428571428571425E-2, ---R 6.6666666666666666E-2, 6.25E-2, 5.8823529411764705E-2] ---R , ---R ---R [0.1111111111111111, 0.10000000000000001, 9.0909090909090912E-2, ---R 8.3333333333333329E-2, 7.6923076923076927E-2, 7.1428571428571425E-2, ---R 6.6666666666666666E-2, 6.25E-2, 5.8823529411764705E-2, ---R 5.5555555555555552E-2] ---R , ---R ---R [0.10000000000000001, 9.0909090909090912E-2, 8.3333333333333329E-2, ---R 7.6923076923076927E-2, 7.1428571428571425E-2, 6.6666666666666666E-2, ---R 6.25E-2, 5.8823529411764705E-2, 5.5555555555555552E-2, ---R 5.2631578947368418E-2] ---R ] ---R Type: Matrix DoubleFloat ---E 32 - ---S 33 of 37 -determinant b ---R ---R ---R (32) 2.1643677945721411E-53 ---R Type: DoubleFloat ---E 33 - ---S 34 of 37 -digits 40 ---R ---R ---R (33) 20 ---R Type: PositiveInteger ---E 34 - ---S 35 of 37 -c: Matrix Float := matrix [ [1/(i+j+1$Float) for j in 0..9] for i in 0..9] ---R ---R ---R (34) ---R [ ---R [1.0, 0.5, 0.33333 33333 33333 33333 33333 33333 33333 33333, 0.25, 0.2, ---R 0.16666 66666 66666 66666 66666 66666 66666 66667, ---R 0.14285 71428 57142 85714 28571 42857 14285 71429, 0.125, ---R 0.11111 11111 11111 11111 11111 11111 11111 11111, 0.1] ---R , ---R ---R [0.5, 0.33333 33333 33333 33333 33333 33333 33333 33333, 0.25, 0.2, ---R 0.16666 66666 66666 66666 66666 66666 66666 66667, ---R 0.14285 71428 57142 85714 28571 42857 14285 71429, 0.125, ---R 0.11111 11111 11111 11111 11111 11111 11111 11111, 0.1, ---R 0.09090 90909 09090 90909 09090 90909 09090 90909 1] ---R , ---R ---R [0.33333 33333 33333 33333 33333 33333 33333 33333, 0.25, 0.2, ---R 0.16666 66666 66666 66666 66666 66666 66666 66667, ---R 0.14285 71428 57142 85714 28571 42857 14285 71429, 0.125, ---R 0.11111 11111 11111 11111 11111 11111 11111 11111, 0.1, ---R 0.09090 90909 09090 90909 09090 90909 09090 90909 1, ---R 0.08333 33333 33333 33333 33333 33333 33333 33333 4] ---R , ---R ---R [0.25, 0.2, 0.16666 66666 66666 66666 66666 66666 66666 66667, ---R 0.14285 71428 57142 85714 28571 42857 14285 71429, 0.125, ---R 0.11111 11111 11111 11111 11111 11111 11111 11111, 0.1, ---R 0.09090 90909 09090 90909 09090 90909 09090 90909 1, ---R 0.08333 33333 33333 33333 33333 33333 33333 33333 4, ---R 0.07692 30769 23076 92307 69230 76923 07692 30769 2] ---R , ---R ---R [0.2, 0.16666 66666 66666 66666 66666 66666 66666 66667, ---R 0.14285 71428 57142 85714 28571 42857 14285 71429, 0.125, ---R 0.11111 11111 11111 11111 11111 11111 11111 11111, 0.1, ---R 0.09090 90909 09090 90909 09090 90909 09090 90909 1, ---R 0.08333 33333 33333 33333 33333 33333 33333 33333 4, ---R 0.07692 30769 23076 92307 69230 76923 07692 30769 2, ---R 0.07142 85714 28571 42857 14285 71428 57142 85714 3] ---R , ---R ---R [0.16666 66666 66666 66666 66666 66666 66666 66667, ---R 0.14285 71428 57142 85714 28571 42857 14285 71429, 0.125, ---R 0.11111 11111 11111 11111 11111 11111 11111 11111, 0.1, ---R 0.09090 90909 09090 90909 09090 90909 09090 90909 1, ---R 0.08333 33333 33333 33333 33333 33333 33333 33333 4, ---R 0.07692 30769 23076 92307 69230 76923 07692 30769 2, ---R 0.07142 85714 28571 42857 14285 71428 57142 85714 3, ---R 0.06666 66666 66666 66666 66666 66666 66666 66666 7] ---R , ---R ---R [0.14285 71428 57142 85714 28571 42857 14285 71429, 0.125, ---R 0.11111 11111 11111 11111 11111 11111 11111 11111, 0.1, ---R 0.09090 90909 09090 90909 09090 90909 09090 90909 1, ---R 0.08333 33333 33333 33333 33333 33333 33333 33333 4, ---R 0.07692 30769 23076 92307 69230 76923 07692 30769 2, ---R 0.07142 85714 28571 42857 14285 71428 57142 85714 3, ---R 0.06666 66666 66666 66666 66666 66666 66666 66666 7, 0.0625] ---R , ---R ---R [0.125, 0.11111 11111 11111 11111 11111 11111 11111 11111, 0.1, ---R 0.09090 90909 09090 90909 09090 90909 09090 90909 1, ---R 0.08333 33333 33333 33333 33333 33333 33333 33333 4, ---R 0.07692 30769 23076 92307 69230 76923 07692 30769 2, ---R 0.07142 85714 28571 42857 14285 71428 57142 85714 3, ---R 0.06666 66666 66666 66666 66666 66666 66666 66666 7, 0.0625, ---R 0.05882 35294 11764 70588 23529 41176 47058 82352 9] ---R , ---R ---R [0.11111 11111 11111 11111 11111 11111 11111 11111, 0.1, ---R 0.09090 90909 09090 90909 09090 90909 09090 90909 1, ---R 0.08333 33333 33333 33333 33333 33333 33333 33333 4, ---R 0.07692 30769 23076 92307 69230 76923 07692 30769 2, ---R 0.07142 85714 28571 42857 14285 71428 57142 85714 3, ---R 0.06666 66666 66666 66666 66666 66666 66666 66666 7, 0.0625, ---R 0.05882 35294 11764 70588 23529 41176 47058 82352 9, ---R 0.05555 55555 55555 55555 55555 55555 55555 55555 6] ---R , ---R ---R [0.1, 0.09090 90909 09090 90909 09090 90909 09090 90909 1, ---R 0.08333 33333 33333 33333 33333 33333 33333 33333 4, ---R 0.07692 30769 23076 92307 69230 76923 07692 30769 2, ---R 0.07142 85714 28571 42857 14285 71428 57142 85714 3, ---R 0.06666 66666 66666 66666 66666 66666 66666 66666 7, 0.0625, ---R 0.05882 35294 11764 70588 23529 41176 47058 82352 9, ---R 0.05555 55555 55555 55555 55555 55555 55555 55555 6, ---R 0.05263 15789 47368 42105 26315 78947 36842 10526 3] ---R ] ---R Type: Matrix Float ---E 35 - ---S 36 of 37 -determinant c ---R ---R ---R (35) 0.21641 79226 43149 18690 60594 98362 26174 36159 E -52 ---R Type: Float ---E 36 - ---S 37 of 37 -digits 20 ---R ---R ---R (36) 40 ---R Type: PositiveInteger ---E 37 -)spool -)lisp (bye) -@ -<>= -==================================================================== -Float -==================================================================== - -Axiom provides two kinds of floating point numbers. The domain Float -implements a model of arbitrary precision floating point numbers. The -domain DoubleFloat is intended to make available hardware floating -point arithmetic in Axiom. The actual model of floating point that -DoubleFloat provides is system-dependent. For example, on the IBM -system 370 Axiom uses IBM double precision which has fourteen -hexadecimal digits of precision or roughly sixteen decimal digits. -Arbitrary precision floats allow the user to specify the precision at -which arithmetic operations are computed. Although this is an -attractive facility, it comes at a cost. Arbitrary-precision -floating-point arithmetic typically takes twenty to two hundred times -more time than hardware floating point. - -==================================================================== -Introduction to Float -==================================================================== - -Scientific notation is supported for input and output of floating -point numbers. A floating point number is written as a string of -digits containing a decimal point optionally followed by the letter -"E", and then the exponent. - -We begin by doing some calculations using arbitrary precision floats. -The default precision is twenty decimal digits. - - 1.234 - 1.234 - Type: Float - -A decimal base for the exponent is assumed, so the number -1.234E2 denotes 1.234x10^2. - - 1.234E2 - 123.4 - Type: Float -The normal arithmetic operations are available for floating point numbers. - - sqrt(1.2 + 2.3 / 3.4 ** 4.5) - 1.0996972790 671286226 - Type: Float - -==================================================================== -Conversion Functions -==================================================================== - -You can use conversion to go back and forth between Integer, Fraction -Integer and Float, as appropriate. - - i := 3 :: Float - 3.0 - Type: Float - - i :: Integer - 3 - Type: Integer - - i :: Fraction Integer - 3 - Type: Fraction Integer - -Since you are explicitly asking for a conversion, you must take -responsibility for any loss of exactness. - - r := 3/7 :: Float - 0.4285714285 7142857143 - Type: Float - - r :: Fraction Integer - 3 - - - 7 - Type: Fraction Integer - -This conversion cannot be performed: use truncate or round if that is -what you intend. - - r :: Integer - Cannot convert from type Float to Integer for value - 0.4285714285 7142857143 - -The operations truncate and round truncate ... - - truncate 3.6 - 3.0 - Type: Float - -and round to the nearest integral Float respectively. - - round 3.6 - 4.0 - Type: Float - - truncate(-3.6) - - 3.0 - Type: Float - - round(-3.6) - - 4.0 - Type: Float - -The operation fractionPart computes the fractional part of x, that is, -x - truncate x. - - fractionPart 3.6 - 0.6 - Type: Float - -The operation digits allows the user to set the precision. It returns -the previous value it was using. - - digits 40 - 20 - Type: PositiveInteger - - sqrt 0.2 - 0.4472135954 9995793928 1834733746 2552470881 - Type: Float - - pi()$Float - 3.1415926535 8979323846 2643383279 502884197 - Type: Float - -The precision is only limited by the computer memory available. -Calculations at 500 or more digits of precision are not difficult. - - digits 500 - 40 - Type: PositiveInteger - - pi()$Float - 3.1415926535 8979323846 2643383279 5028841971 6939937510 5820974944 592307816 - 4 0628620899 8628034825 3421170679 8214808651 3282306647 0938446095 505822317 - 2 5359408128 4811174502 8410270193 8521105559 6446229489 5493038196 442881097 - 5 6659334461 2847564823 3786783165 2712019091 4564856692 3460348610 454326648 - 2 1339360726 0249141273 7245870066 0631558817 4881520920 9628292540 917153643 - 6 7892590360 0113305305 4882046652 1384146951 9415116094 3305727036 575959195 - 3 0921861173 8193261179 3105118548 0744623799 6274956735 1885752724 891227938 - 1 830119491 - Type: Float - -Reset digits to its default value. - - digits 20 - 500 - Type: PositiveInteger - -Numbers of type Float are represented as a record of two -integers, namely, the mantissa and the exponent where the base of the -exponent is binary. That is, the floating point number (m,e) -represents the number m x 2^e. A consequence of using a binary -base is that decimal numbers can not, in general, be represented -exactly. - -==================================================================== -Output Functions -==================================================================== - -A number of operations exist for specifying how numbers of type Float -are to be displayed. By default, spaces are inserted every ten digits -in the output for readability. Note that you cannot include spaces in -the input form of a floating point number, though you can use -underscores. - -Output spacing can be modified with the outputSpacing operation. This -inserts no spaces and then displays the value of x. - - outputSpacing 0; x := sqrt 0.2 - 0.44721359549995793928 - Type: Float - -Issue this to have the spaces inserted every 5 digits. - - outputSpacing 5; x - 0.44721 35954 99957 93928 - Type: Float - -By default, the system displays floats in either fixed format -or scientific format, depending on the magnitude of the number. - - y := x/10**10 - 0.44721 35954 99957 93928 E -10 - Type: Float - -A particular format may be requested with the operations -outputFloating and outputFixed. - - outputFloating(); x - 0.44721 35954 99957 93928 E 0 - Type: Float - - outputFixed(); y - 0.00000 00000 44721 35954 99957 93928 - Type: Float - -Additionally, you can ask for n digits to be displayed after the -decimal point. - - outputFloating 2; y - 0.45 E -10 - Type: Float - - outputFixed 2; x - 0.45 - Type: Float - -This resets the output printing to the default behavior. - - outputGeneral() - Type: Void - -==================================================================== -An Example: Determinant of a Hilbert Matrix -==================================================================== - -Consider the problem of computing the determinant of a 10 by 10 -Hilbert matrix. The (i,j)-th entry of a Hilbert matrix is given -by 1/(i+j+1). - -First do the computation using rational numbers to obtain the -exact result. - - a: Matrix Fraction Integer:=matrix[ [1/(i+j+1) for j in 0..9] for i in 0..9] - + 1 1 1 1 1 1 1 1 1+ - |1 - - - - - - - - --| - | 2 3 4 5 6 7 8 9 10| - | | - |1 1 1 1 1 1 1 1 1 1| - |- - - - - - - - -- --| - |2 3 4 5 6 7 8 9 10 11| - | | - |1 1 1 1 1 1 1 1 1 1| - |- - - - - - - -- -- --| - |3 4 5 6 7 8 9 10 11 12| - | | - |1 1 1 1 1 1 1 1 1 1| - |- - - - - - -- -- -- --| - |4 5 6 7 8 9 10 11 12 13| - | | - |1 1 1 1 1 1 1 1 1 1| - |- - - - - -- -- -- -- --| - |5 6 7 8 9 10 11 12 13 14| - | | - |1 1 1 1 1 1 1 1 1 1| - |- - - - -- -- -- -- -- --| - |6 7 8 9 10 11 12 13 14 15| - | | - |1 1 1 1 1 1 1 1 1 1| - |- - - -- -- -- -- -- -- --| - |7 8 9 10 11 12 13 14 15 16| - | | - |1 1 1 1 1 1 1 1 1 1| - |- - -- -- -- -- -- -- -- --| - |8 9 10 11 12 13 14 15 16 17| - | | - |1 1 1 1 1 1 1 1 1 1| - |- -- -- -- -- -- -- -- -- --| - |9 10 11 12 13 14 15 16 17 18| - | | - | 1 1 1 1 1 1 1 1 1 1| - |-- -- -- -- -- -- -- -- -- --| - +10 11 12 13 14 15 16 17 18 19+ - Type: Matrix Fraction Integer - -This version of determinant uses Gaussian elimination. - - d:= determinant a - 1 - ----------------------------------------------------- - 46206893947914691316295628839036278726983680000000000 - Type: Fraction Integer - - d :: Float - 0.21641 79226 43149 18691 E -52 - Type: Float - -Now use hardware floats. Note that a semicolon (;) is used to prevent -the display of the matrix. - - b: Matrix DoubleFloat:=matrix[ [1/(i+j+1\$DoubleFloat) for j in 0..9] for i in 0..9]; - - - Type: Matrix DoubleFloat - -The result given by hardware floats is correct only to four -significant digits of precision. In the jargon of numerical analysis, -the Hilbert matrix is said to be "ill-conditioned." - - determinant b - 2.1643677945721411E-53 - Type: DoubleFloat - -Now repeat the computation at a higher precision using Float. - - digits 40 - 20 - Type: PositiveInteger - - c: Matrix Float := matrix [ [1/(i+j+1\$Float) for j in 0..9] for i in 0..9]; - Type: Matrix Float - - determinant c - 0.21641 79226 43149 18690 60594 98362 26174 36159 E -52 - Type: Float - -Reset digits to its default value. - - digits 20 - 40 - Type: PositiveInteger - -See Also: -o )help DoubleFloat -o )show Float -o $AXIOM/doc/src/algebra/float.spad.dvi - -@ -<>= -)abbrev domain FLOAT Float - -B ==> Boolean -I ==> Integer -S ==> String -PI ==> PositiveInteger -RN ==> Fraction Integer -SF ==> DoubleFloat -N ==> NonNegativeInteger - -++ Author: Michael Monagan -++ Date Created: -++ December 1987 -++ Change History: -++ 19 Jun 1990 -++ Basic Operations: outputFloating, outputFixed, outputGeneral, outputSpacing, -++ atan, convert, exp1, log2, log10, normalize, rationalApproximation, -++ relerror, shift, / , ** -++ Keywords: float, floating point, number -++ Description: \spadtype{Float} implements arbitrary precision floating -++ point arithmetic. -++ The number of significant digits of each operation can be set -++ to an arbitrary value (the default is 20 decimal digits). -++ The operation \spad{float(mantissa,exponent,\spadfunFrom{base}{FloatingPointSystem})} for integer -++ \spad{mantissa}, \spad{exponent} specifies the number -++ \spad{mantissa * \spadfunFrom{base}{FloatingPointSystem} ** exponent} -++ The underlying representation for floats is binary -++ not decimal. The implications of this are described below. -++ -++ The model adopted is that arithmetic operations are rounded to -++ to nearest unit in the last place, that is, accurate to within -++ \spad{2**(-\spadfunFrom{bits}{FloatingPointSystem})}. -++ Also, the elementary functions and constants are -++ accurate to one unit in the last place. -++ A float is represented as a record of two integers, the mantissa -++ and the exponent. The \spadfunFrom{base}{FloatingPointSystem} -++ of the representation is binary, hence -++ a \spad{Record(m:mantissa,e:exponent)} represents the number \spad{m * 2 ** e}. -++ Though it is not assumed that the underlying integers are represented -++ with a binary \spadfunFrom{base}{FloatingPointSystem}, -++ the code will be most efficient when this is the -++ the case (this is true in most implementations of Lisp). -++ The decision to choose the \spadfunFrom{base}{FloatingPointSystem} to be -++ binary has some unfortunate -++ consequences. First, decimal numbers like 0.3 cannot be represented -++ exactly. Second, there is a further loss of accuracy during -++ conversion to decimal for output. To compensate for this, if d -++ digits of precision are specified, \spad{1 + ceiling(log2 d)} bits are used. -++ Two numbers that are displayed identically may therefore be -++ not equal. On the other hand, a significant efficiency loss would -++ be incurred if we chose to use a decimal \spadfunFrom{base}{FloatingPointSystem} when the underlying -++ integer base is binary. -++ -++ Algorithms used: -++ For the elementary functions, the general approach is to apply -++ identities so that the taylor series can be used, and, so -++ that it will converge within \spad{O( sqrt n )} steps. For example, -++ using the identity \spad{exp(x) = exp(x/2)**2}, we can compute -++ \spad{exp(1/3)} to n digits of precision as follows. We have -++ \spad{exp(1/3) = exp(2 ** (-sqrt s) / 3) ** (2 ** sqrt s)}. -++ The taylor series will converge in less than sqrt n steps and the -++ exponentiation requires sqrt n multiplications for a total of -++ \spad{2 sqrt n} multiplications. Assuming integer multiplication costs -++ \spad{O( n**2 )} the overall running time is \spad{O( sqrt(n) n**2 )}. -++ This approach is the best known approach for precisions up to -++ about 10,000 digits at which point the methods of Brent -++ which are \spad{O( log(n) n**2 )} become competitive. Note also that -++ summing the terms of the taylor series for the elementary -++ functions is done using integer operations. This avoids the -++ overhead of floating point operations and results in efficient -++ code at low precisions. This implementation makes no attempt -++ to reuse storage, relying on the underlying system to do -++ \spadgloss{garbage collection}. I estimate that the efficiency of this -++ package at low precisions could be improved by a factor of 2 -++ if in-place operations were available. -++ -++ Running times: in the following, n is the number of bits of precision -++ \spad{*}, \spad{/}, \spad{sqrt}, \spad{pi}, \spad{exp1}, \spad{log2}, \spad{log10}: \spad{ O( n**2 )} -++ \spad{exp}, \spad{log}, \spad{sin}, \spad{atan}: \spad{ O( sqrt(n) n**2 )} -++ The other elementary functions are coded in terms of the ones above. - - -Float(): - Join(FloatingPointSystem, DifferentialRing, ConvertibleTo String, OpenMath,_ - CoercibleTo DoubleFloat, TranscendentalFunctionCategory, ConvertibleTo InputForm) with - _/ : (%, I) -> % - ++ x / i computes the division from x by an integer i. - _*_*: (%, %) -> % - ++ x ** y computes \spad{exp(y log x)} where \spad{x >= 0}. - normalize: % -> % - ++ normalize(x) normalizes x at current precision. - relerror : (%, %) -> I - ++ relerror(x,y) computes the absolute value of \spad{x - y} divided by - ++ y, when \spad{y \^= 0}. - shift: (%, I) -> % - ++ shift(x,n) adds n to the exponent of float x. - rationalApproximation: (%, N) -> RN - ++ rationalApproximation(f, n) computes a rational approximation - ++ r to f with relative error \spad{< 10**(-n)}. - rationalApproximation: (%, N, N) -> RN - ++ rationalApproximation(f, n, b) computes a rational - ++ approximation r to f with relative error \spad{< b**(-n)}, that is - ++ \spad{|(r-f)/f| < b**(-n)}. - log2 : () -> % - ++ log2() returns \spad{ln 2}, i.e. \spad{0.6931471805...}. - log10: () -> % - ++ log10() returns \spad{ln 10}: \spad{2.3025809299...}. - exp1 : () -> % - ++ exp1() returns exp 1: \spad{2.7182818284...}. - atan : (%,%) -> % - ++ atan(x,y) computes the arc tangent from x with phase y. - log2 : % -> % - ++ log2(x) computes the logarithm for x to base 2. - log10: % -> % - ++ log10(x) computes the logarithm for x to base 10. - convert: SF -> % - ++ convert(x) converts a \spadtype{DoubleFloat} x to a \spadtype{Float}. - outputFloating: () -> Void - ++ outputFloating() sets the output mode to floating (scientific) notation, i.e. - ++ \spad{mantissa * 10 exponent} is displayed as \spad{0.mantissa E exponent}. - outputFloating: N -> Void - ++ outputFloating(n) sets the output mode to floating (scientific) notation - ++ with n significant digits displayed after the decimal point. - outputFixed: () -> Void - ++ outputFixed() sets the output mode to fixed point notation; - ++ the output will contain a decimal point. - outputFixed: N -> Void - ++ outputFixed(n) sets the output mode to fixed point notation, - ++ with n digits displayed after the decimal point. - outputGeneral: () -> Void - ++ outputGeneral() sets the output mode (default mode) to general - ++ notation; numbers will be displayed in either fixed or floating - ++ (scientific) notation depending on the magnitude. - outputGeneral: N -> Void - ++ outputGeneral(n) sets the output mode to general notation - ++ with n significant digits displayed. - outputSpacing: N -> Void - ++ outputSpacing(n) inserts a space after n (default 10) digits on output; - ++ outputSpacing(0) means no spaces are inserted. - arbitraryPrecision - arbitraryExponent - == add - BASE ==> 2 - BITS:Reference(PI) := ref 68 -- 20 digits - LENGTH ==> INTEGER_-LENGTH$Lisp - ISQRT ==> approxSqrt$IntegerRoots(I) - Rep := Record( mantissa:I, exponent:I ) - StoredConstant ==> Record( precision:PI, value:% ) - UCA ==> Record( unit:%, coef:%, associate:% ) - inc ==> increasePrecision - dec ==> decreasePrecision - - -- local utility operations - shift2 : (I,I) -> I -- WSP: fix bug in shift - times : (%,%) -> % -- multiply x and y with no rounding - itimes: (I,%) -> % -- multiply by a small integer - chop: (%,PI) -> % -- chop x at p bits of precision - dvide: (%,%) -> % -- divide x by y with no rounding - square: (%,I) -> % -- repeated squaring with chopping - power: (%,I) -> % -- x ** n with chopping - plus: (%,%) -> % -- addition with no rounding - sub: (%,%) -> % -- subtraction with no rounding - negate: % -> % -- negation with no rounding - ceillog10base2: PI -> PI -- rational approximation - floorln2: PI -> PI -- rational approximation - - atanSeries: % -> % -- atan(x) by taylor series |x| < 1/2 - atanInverse: I -> % -- atan(1/n) for n an integer > 1 - expInverse: I -> % -- exp(1/n) for n an integer - expSeries: % -> % -- exp(x) by taylor series |x| < 1/2 - logSeries: % -> % -- log(x) by taylor series 1/2 < x < 2 - sinSeries: % -> % -- sin(x) by taylor series |x| < 1/2 - cosSeries: % -> % -- cos(x) by taylor series |x| < 1/2 - piRamanujan: () -> % -- pi using Ramanujans series - - writeOMFloat(dev: OpenMathDevice, x: %): Void == - OMputApp(dev) - OMputSymbol(dev, "bigfloat1", "bigfloat") - OMputInteger(dev, mantissa x) - OMputInteger(dev, 2) - OMputInteger(dev, exponent x) - OMputEndApp(dev) - - OMwrite(x: %): String == - s: String := "" - sp := OM_-STRINGTOSTRINGPTR(s)$Lisp - dev: OpenMathDevice := OMopenString(sp pretend String, OMencodingXML) - OMputObject(dev) - writeOMFloat(dev, x) - OMputEndObject(dev) - OMclose(dev) - s := OM_-STRINGPTRTOSTRING(sp)$Lisp pretend String - s - - OMwrite(x: %, wholeObj: Boolean): String == - s: String := "" - sp := OM_-STRINGTOSTRINGPTR(s)$Lisp - dev: OpenMathDevice := OMopenString(sp pretend String, OMencodingXML) - if wholeObj then - OMputObject(dev) - writeOMFloat(dev, x) - if wholeObj then - OMputEndObject(dev) - OMclose(dev) - s := OM_-STRINGPTRTOSTRING(sp)$Lisp pretend String - s - - OMwrite(dev: OpenMathDevice, x: %): Void == - OMputObject(dev) - writeOMFloat(dev, x) - OMputEndObject(dev) - - OMwrite(dev: OpenMathDevice, x: %, wholeObj: Boolean): Void == - if wholeObj then - OMputObject(dev) - writeOMFloat(dev, x) - if wholeObj then - OMputEndObject(dev) - - shift2(x,y) == sign(x)*shift(sign(x)*x,y) - - asin x == - zero? x => 0 - negative? x => -asin(-x) --- one? x => pi()/2 - (x = 1) => pi()/2 - x > 1 => error "asin: argument > 1 in magnitude" - inc 5; r := atan(x/sqrt(sub(1,times(x,x)))); dec 5 - normalize r - - acos x == - zero? x => pi()/2 - negative? x => (inc 3; r := pi()-acos(-x); dec 3; normalize r) --- one? x => 0 - (x = 1) => 0 - x > 1 => error "acos: argument > 1 in magnitude" - inc 5; r := atan(sqrt(sub(1,times(x,x)))/x); dec 5 - normalize r - - atan(x,y) == - x = 0 => - y > 0 => pi()/2 - y < 0 => -pi()/2 - 0 - -- Only count on first quadrant being on principal branch. - theta := atan abs(y/x) - if x < 0 then theta := pi() - theta - if y < 0 then theta := - theta - theta - - atan x == - zero? x => 0 - negative? x => -atan(-x) - if x > 1 then - inc 4 - r := if zero? fractionPart x and x < [bits(),0] then atanInverse wholePart x - else atan(1/x) - r := pi/2 - r - dec 4 - return normalize r - -- make |x| < O( 2**(-sqrt p) ) < 1/2 to speed series convergence - -- by using the formula atan(x) = 2*atan(x/(1+sqrt(1+x**2))) - k := ISQRT (bits()-100)::I quo 5 - k := max(0,2 + k + order x) - inc(2*k) - for i in 1..k repeat x := x/(1+sqrt(1+x*x)) - t := atanSeries x - dec(2*k) - t := shift(t,k) - normalize t - - atanSeries x == - -- atan(x) = x (1 - x**2/3 + x**4/5 - x**6/7 + ...) |x| < 1 - p := bits() + LENGTH bits() + 2 - s:I := d:I := shift(1,p) - y := times(x,x) - t := m := - shift2(y.mantissa,y.exponent+p) - for i in 3.. by 2 while t ^= 0 repeat - s := s + t quo i - t := (m * t) quo d - x * [s,-p] - - atanInverse n == - -- compute atan(1/n) for an integer n > 1 - -- atan n = 1/n - 1/n**3/3 + 1/n**5/4 - ... - -- pi = 16 atan(1/5) - 4 atan(1/239) - n2 := -n*n - e:I := bits() + LENGTH bits() + LENGTH n + 1 - s:I := shift(1,e) quo n - t:I := s quo n2 - for k in 3.. by 2 while t ^= 0 repeat - s := s + t quo k - t := t quo n2 - normalize [s,-e] - - sin x == - s := sign x; x := abs x; p := bits(); inc 4 - if x > [6,0] then (inc p; x := 2*pi*fractionPart(x/pi/2); bits p) - if x > [3,0] then (inc p; s := -s; x := x - pi; bits p) - if x > [3,-1] then (inc p; x := pi - x; dec p) - -- make |x| < O( 2**(-sqrt p) ) < 1/2 to speed series convergence - -- by using the formula sin(3*x/3) = 3 sin(x/3) - 4 sin(x/3)**3 - -- the running time is O( sqrt p M(p) ) assuming |x| < 1 - k := ISQRT (bits()-100)::I quo 4 - k := max(0,2 + k + order x) - if k > 0 then (inc k; x := x / 3**k::N) - r := sinSeries x - for i in 1..k repeat r := itimes(3,r)-shift(r**3,2) - bits p - s * r - - sinSeries x == - -- sin(x) = x (1 - x**2/3! + x**4/5! - x**6/7! + ... |x| < 1/2 - p := bits() + LENGTH bits() + 2 - y := times(x,x) - s:I := d:I := shift(1,p) - m:I := - shift2(y.mantissa,y.exponent+p) - t:I := m quo 6 - for i in 4.. by 2 while t ^= 0 repeat - s := s + t - t := (m * t) quo (i*(i+1)) - t := t quo d - x * [s,-p] - - cos x == - s:I := 1; x := abs x; p := bits(); inc 4 - if x > [6,0] then (inc p; x := 2*pi*fractionPart(x/pi/2); dec p) - if x > [3,0] then (inc p; s := -s; x := x-pi; dec p) - if x > [1,0] then - -- take care of the accuracy problem near pi/2 - inc p; x := pi/2-x; bits p; x := normalize x - return (s * sin x) - -- make |x| < O( 2**(-sqrt p) ) < 1/2 to speed series convergence - -- by using the formula cos(2*x/2) = 2 cos(x/2)**2 - 1 - -- the running time is O( sqrt p M(p) ) assuming |x| < 1 - k := ISQRT (bits()-100)::I quo 3 - k := max(0,2 + k + order x) - -- need to increase precision by more than k, otherwise recursion - -- causes loss of accuracy. - -- Michael Monagan suggests adding a factor of log(k) - if k > 0 then (inc(k+length(k)**2); x := shift(x,-k)) - r := cosSeries x - for i in 1..k repeat r := shift(r*r,1)-1 - bits p - s * r - - - - cosSeries x == - -- cos(x) = 1 - x**2/2! + x**4/4! - x**6/6! + ... |x| < 1/2 - p := bits() + LENGTH bits() + 1 - y := times(x,x) - s:I := d:I := shift(1,p) - m:I := - shift2(y.mantissa,y.exponent+p) - t:I := m quo 2 - for i in 3.. by 2 while t ^= 0 repeat - s := s + t - t := (m * t) quo (i*(i+1)) - t := t quo d - normalize [s,-p] - - tan x == - s := sign x; x := abs x; p := bits(); inc 6 - if x > [3,0] then (inc p; x := pi()*fractionPart(x/pi()); dec p) - if x > [3,-1] then (inc p; x := pi()-x; s := -s; dec p) - if x > 1 then (c := cos x; t := sqrt(1-c*c)/c) - else (c := sin x; t := c/sqrt(1-c*c)) - bits p - s * t - - P:StoredConstant := [1,[1,2]] - pi() == - -- We use Ramanujan's identity to compute pi. - -- The running time is quadratic in the precision. - -- This is about twice as fast as Machin's identity on Lisp/VM - -- pi = 16 atan(1/5) - 4 atan(1/239) - bits() <= P.precision => normalize P.value - (P := [bits(), piRamanujan()]) value - - piRamanujan() == - -- Ramanujans identity for 1/pi - -- Reference: Shanks and Wrench, Math Comp, 1962 - -- "Calculation of pi to 100,000 Decimals". - n := bits() + LENGTH bits() + 11 - t:I := shift(1,n) quo 882 - d:I := 4*882**2 - s:I := 0 - for i in 2.. by 2 for j in 1123.. by 21460 while t ^= 0 repeat - s := s + j*t - m := -(i-1)*(2*i-1)*(2*i-3) - t := (m*t) quo (d*i**3) - 1 / [s,-n-2] - - sinh x == - zero? x => 0 - lost:I := max(- order x,0) - 2*lost > bits() => x - inc(5+lost); e := exp x; s := (e-1/e)/2; dec(5+lost) - normalize s - - cosh x == - (inc 5; e := exp x; c := (e+1/e)/2; dec 5; normalize c) - - tanh x == - zero? x => 0 - lost:I := max(- order x,0) - 2*lost > bits() => x - inc(6+lost); e := exp x; e := e*e; t := (e-1)/(e+1); dec(6+lost) - normalize t - - asinh x == - p := min(0,order x) - if zero? x or 2*p < -bits() then return x - inc(5-p); r := log(x+sqrt(1+x*x)); dec(5-p) - normalize r - - acosh x == - if x < 1 then error "invalid argument to acosh" - inc 5; r := log(x+sqrt(sub(times(x,x),1))); dec 5 - normalize r - - atanh x == - if x > 1 or x < -1 then error "invalid argument to atanh" - p := min(0,order x) - if zero? x or 2*p < -bits() then return x - inc(5-p); r := log((x+1)/(1-x))/2; dec(5-p) - normalize r - - log x == - negative? x => error "negative log" - zero? x => error "log 0 generated" - p := bits(); inc 5 - -- apply log(x) = n log 2 + log(x/2**n) so that 1/2 < x < 2 - if (n := order x) < 0 then n := n+1 - l := if n = 0 then 0 else (x := shift(x,-n); n * log2) - -- speed the series convergence by finding m and k such that - -- | exp(m/2**k) x - 1 | < 1 / 2 ** O(sqrt p) - -- write log(exp(m/2**k) x) as m/2**k + log x - k := ISQRT (p-100)::I quo 3 - if k > 1 then - k := max(1,k+order(x-1)) - inc k - ek := expInverse (2**k::N) - dec(p quo 2); m := order square(x,k); inc(p quo 2) - m := (6847196937 * m) quo 9878417065 -- m := m log 2 - x := x * ek ** (-m) - l := l + [m,-k] - l := l + logSeries x - bits p - normalize l - - logSeries x == - -- log(x) = 2 y (1 + y**2/3 + y**4/5 ...) for y = (x-1) / (x+1) - -- given 1/2 < x < 2 on input we have -1/3 < y < 1/3 - p := bits() + (g := LENGTH bits() + 3) - inc g; y := (x-1)/(x+1); dec g - s:I := d:I := shift(1,p) - z := times(y,y) - t := m := shift2(z.mantissa,z.exponent+p) - for i in 3.. by 2 while t ^= 0 repeat - s := s + t quo i - t := m * t quo d - y * [s,1-p] - - L2:StoredConstant := [1,1] - log2() == - -- log x = 2 * sum( ((x-1)/(x+1))**(2*k+1)/(2*k+1), k=1.. ) - -- log 2 = 2 * sum( 1/9**k / (2*k+1), k=0..n ) / 3 - n := bits() :: N - n <= L2.precision => normalize L2.value - n := n + LENGTH n + 3 -- guard bits - s:I := shift(1,n+1) quo 3 - t:I := s quo 9 - for k in 3.. by 2 while t ^= 0 repeat - s := s + t quo k - t := t quo 9 - L2 := [bits(),[s,-n]] - normalize L2.value - - L10:StoredConstant := [1,[1,1]] - log10() == - -- log x = 2 * sum( ((x-1)/(x+1))**(2*k+1)/(2*k+1), k=0.. ) - -- log 5/4 = 2 * sum( 1/81**k / (2*k+1), k=0.. ) / 9 - n := bits() :: N - n <= L10.precision => normalize L10.value - n := n + LENGTH n + 5 -- guard bits - s:I := shift(1,n+1) quo 9 - t:I := s quo 81 - for k in 3.. by 2 while t ^= 0 repeat - s := s + t quo k - t := t quo 81 - -- We have log 10 = log 5 + log 2 and log 5/4 = log 5 - 2 log 2 - inc 2; L10 := [bits(),[s,-n] + 3*log2]; dec 2 - normalize L10.value - - log2(x) == (inc 2; r := log(x)/log2; dec 2; normalize r) - log10(x) == (inc 2; r := log(x)/log10; dec 2; normalize r) - - exp(x) == - -- exp(n+x) = exp(1)**n exp(x) for n such that |x| < 1 - p := bits(); inc 5; e1:% := 1 - if (n := wholePart x) ^= 0 then - inc LENGTH n; e1 := exp1 ** n; dec LENGTH n - x := fractionPart x - if zero? x then (bits p; return normalize e1) - -- make |x| < O( 2**(-sqrt p) ) < 1/2 to speed series convergence - -- by repeated use of the formula exp(2*x/2) = exp(x/2)**2 - -- results in an overall running time of O( sqrt p M(p) ) - k := ISQRT (p-100)::I quo 3 - k := max(0,2 + k + order x) - if k > 0 then (inc k; x := shift(x,-k)) - e := expSeries x - if k > 0 then e := square(e,k) - bits p - e * e1 - - expSeries x == - -- exp(x) = 1 + x + x**2/2 + ... + x**i/i! valid for all x - p := bits() + LENGTH bits() + 1 - s:I := d:I := shift(1,p) - t:I := n:I := shift2(x.mantissa,x.exponent+p) - for i in 2.. while t ^= 0 repeat - s := s + t - t := (n * t) quo i - t := t quo d - normalize [s,-p] - - expInverse k == - -- computes exp(1/k) via continued fraction - p0:I := 2*k+1; p1:I := 6*k*p0+1 - q0:I := 2*k-1; q1:I := 6*k*q0+1 - for i in 10*k.. by 4*k while 2 * LENGTH p0 < bits() repeat - (p0,p1) := (p1,i*p1+p0) - (q0,q1) := (q1,i*q1+q0) - dvide([p1,0],[q1,0]) - - E:StoredConstant := [1,[1,1]] - exp1() == - if bits() > E.precision then E := [bits(),expInverse 1] - normalize E.value - - sqrt x == - negative? x => error "negative sqrt" - m := x.mantissa; e := x.exponent - l := LENGTH m - p := 2 * bits() - l + 2 - if odd?(e-l) then p := p - 1 - i := shift2(x.mantissa,p) - -- ISQRT uses a variable precision newton iteration - i := ISQRT i - normalize [i,(e-p) quo 2] - - bits() == BITS() - bits(n) == (t := bits(); BITS() := n; t) - precision() == bits() - precision(n) == bits(n) - increasePrecision n == (b := bits(); bits((b + n)::PI); b) - decreasePrecision n == (b := bits(); bits((b - n)::PI); b) - ceillog10base2 n == ((13301 * n + 4003) quo 4004) :: PI - digits() == max(1,4004 * (bits()-1) quo 13301)::PI - digits(n) == (t := digits(); bits (1 + ceillog10base2 n); t) - - order(a) == LENGTH a.mantissa + a.exponent - 1 - relerror(a,b) == order((a-b)/b) - 0 == [0,0] - 1 == [1,0] - base() == BASE - mantissa x == x.mantissa - exponent x == x.exponent - one? a == a = 1 - zero? a == zero?(a.mantissa) - negative? a == negative?(a.mantissa) - positive? a == positive?(a.mantissa) - - chop(x,p) == - e : I := LENGTH x.mantissa - p - if e > 0 then x := [shift2(x.mantissa,-e),x.exponent+e] - x - float(m,e) == normalize [m,e] - float(m,e,b) == - m = 0 => 0 - inc 4; r := m * [b,0] ** e; dec 4 - normalize r - normalize x == - m := x.mantissa - m = 0 => 0 - e : I := LENGTH m - bits() - if e > 0 then - y := shift2(m,1-e) - if odd? y then - y := (if y>0 then y+1 else y-1) quo 2 - if LENGTH y > bits() then - y := y quo 2 - e := e+1 - else y := y quo 2 - x := [y,x.exponent+e] - x - shift(x:%,n:I) == [x.mantissa,x.exponent+n] - - x = y == - order x = order y and sign x = sign y and zero? (x - y) - x < y == - y.mantissa = 0 => x.mantissa < 0 - x.mantissa = 0 => y.mantissa > 0 - negative? x and positive? y => true - negative? y and positive? x => false - order x < order y => positive? x - order x > order y => negative? x - negative? (x-y) - - abs x == if negative? x then -x else normalize x - ceiling x == - if negative? x then return (-floor(-x)) - if zero? fractionPart x then x else truncate x + 1 - wholePart x == shift2(x.mantissa,x.exponent) - floor x == if negative? x then -ceiling(-x) else truncate x - round x == (half := [sign x,-1]; truncate(x + half)) - sign x == if x.mantissa < 0 then -1 else 1 - truncate x == - if x.exponent >= 0 then return x - normalize [shift2(x.mantissa,x.exponent),0] - recip(x) == if x=0 then "failed" else 1/x - differentiate x == 0 - - - x == normalize negate x - negate x == [-x.mantissa,x.exponent] - x + y == normalize plus(x,y) - x - y == normalize plus(x,negate y) - sub(x,y) == plus(x,negate y) - plus(x,y) == - mx := x.mantissa; my := y.mantissa - mx = 0 => y - my = 0 => x - ex := x.exponent; ey := y.exponent - ex = ey => [mx+my,ex] - de := ex + LENGTH mx - ey - LENGTH my - de > bits()+1 => x - de < -(bits()+1) => y - if ex < ey then (mx,my,ex,ey) := (my,mx,ey,ex) - mw := my + shift2(mx,ex-ey) - [mw,ey] - - x:% * y:% == normalize times (x,y) - x:I * y:% == - if LENGTH x > bits() then normalize [x,0] * y - else normalize [x * y.mantissa,y.exponent] - x:% / y:% == normalize dvide(x,y) - x:% / y:I == - if LENGTH y > bits() then x / normalize [y,0] else x / [y,0] - inv x == 1 / x - - times(x:%,y:%) == [x.mantissa * y.mantissa, x.exponent + y.exponent] - itimes(n:I,y:%) == [n * y.mantissa,y.exponent] - - dvide(x,y) == - ew := LENGTH y.mantissa - LENGTH x.mantissa + bits() + 1 - mw := shift2(x.mantissa,ew) quo y.mantissa - ew := x.exponent - y.exponent - ew - [mw,ew] - - square(x,n) == - ma := x.mantissa; ex := x.exponent - for k in 1..n repeat - ma := ma * ma; ex := ex + ex - l:I := bits()::I - LENGTH ma - ma := shift2(ma,l); ex := ex - l - [ma,ex] - - power(x,n) == - y:% := 1; z:% := x - repeat - if odd? n then y := chop( times(y,z), bits() ) - if (n := n quo 2) = 0 then return y - z := chop( times(z,z), bits() ) - - x:% ** y:% == - x = 0 => - y = 0 => error "0**0 is undefined" - y < 0 => error "division by 0" - y > 0 => 0 - y = 0 => 1 - y = 1 => x - x = 1 => 1 - p := abs order y + 5 - inc p; r := exp(y*log(x)); dec p - normalize r - - x:% ** r:RN == - x = 0 => - r = 0 => error "0**0 is undefined" - r < 0 => error "division by 0" - r > 0 => 0 - r = 0 => 1 - r = 1 => x - x = 1 => 1 - n := numer r - d := denom r - negative? x => - odd? d => - odd? n => return -((-x)**r) - return ((-x)**r) - error "negative root" - if d = 2 then - inc LENGTH n; y := sqrt(x); y := y**n; dec LENGTH n - return normalize y - y := [n,0]/[d,0] - x ** y - - x:% ** n:I == - x = 0 => - n = 0 => error "0**0 is undefined" - n < 0 => error "division by 0" - n > 0 => 0 - n = 0 => 1 - n = 1 => x - x = 1 => 1 - p := bits() - bits(p + LENGTH n + 2) - y := power(x,abs n) - if n < 0 then y := dvide(1,y) - bits p - normalize y - - -- Utility routines for conversion to decimal - ceilLength10: I -> I - chop10: (%,I) -> % - convert10:(%,I) -> % - floorLength10: I -> I - length10: I -> I - normalize10: (%,I) -> % - quotient10: (%,%,I) -> % - power10: (%,I,I) -> % - times10: (%,%,I) -> % - - convert10(x,d) == - m := x.mantissa; e := x.exponent - --!! deal with bits here - b := bits(); (q,r) := divide(abs e, b) - b := 2**b::N; r := 2**r::N - -- compute 2**e = b**q * r - h := power10([b,0],q,d+5) - h := chop10([r*h.mantissa,h.exponent],d+5) - if e < 0 then h := quotient10([m,0],h,d) - else times10([m,0],h,d) - - ceilLength10 n == 146 * LENGTH n quo 485 + 1 - floorLength10 n == 643 * LENGTH n quo 2136 --- length10 n == DECIMAL_-LENGTH(n)$Lisp - length10 n == - ln := LENGTH(n:=abs n) - upper := 76573 * ln quo 254370 - lower := 21306 * (ln-1) quo 70777 - upper = lower => upper + 1 - n := n quo (10**lower::N) - while n >= 10 repeat - n:= n quo 10 - lower := lower + 1 - lower + 1 - - chop10(x,p) == - e : I := floorLength10 x.mantissa - p - if e > 0 then x := [x.mantissa quo 10**e::N,x.exponent+e] - x - normalize10(x,p) == - ma := x.mantissa - ex := x.exponent - e : I := length10 ma - p - if e > 0 then - ma := ma quo 10**(e-1)::N - ex := ex + e - (ma,r) := divide(ma, 10) - if r > 4 then - ma := ma + 1 - if ma = 10**p::N then (ma := 1; ex := ex + p) - [ma,ex] - times10(x,y,p) == normalize10(times(x,y),p) - quotient10(x,y,p) == - ew := floorLength10 y.mantissa - ceilLength10 x.mantissa + p + 2 - if ew < 0 then ew := 0 - mw := (x.mantissa * 10**ew::N) quo y.mantissa - ew := x.exponent - y.exponent - ew - normalize10([mw,ew],p) - power10(x,n,d) == - x = 0 => 0 - n = 0 => 1 - n = 1 => x - x = 1 => 1 - p:I := d + LENGTH n + 1 - e:I := n - y:% := 1 - z:% := x - repeat - if odd? e then y := chop10(times(y,z),p) - if (e := e quo 2) = 0 then return y - z := chop10(times(z,z),p) - - -------------------------------- - -- Output routines for Floats -- - -------------------------------- - zero ==> char("0") - separator ==> space()$Character - - SPACING : Reference(N) := ref 10 - OUTMODE : Reference(S) := ref "general" - OUTPREC : Reference(I) := ref(-1) - - fixed : % -> S - floating : % -> S - general : % -> S - - padFromLeft(s:S):S == - zero? SPACING() => s - n:I := #s - 1 - t := new( (n + 1 + n quo SPACING()) :: N , separator ) - for i in 0..n for j in minIndex t .. repeat - t.j := s.(i + minIndex s) - if (i+1) rem SPACING() = 0 then j := j+1 - t - padFromRight(s:S):S == - SPACING() = 0 => s - n:I := #s - 1 - t := new( (n + 1 + n quo SPACING()) :: N , separator ) - for i in n..0 by -1 for j in maxIndex t .. by -1 repeat - t.j := s.(i + minIndex s) - if (n-i+1) rem SPACING() = 0 then j := j-1 - t - - fixed f == - zero? f => "0.0" - zero? exponent f => - padFromRight concat(convert(mantissa f)@S, ".0") - negative? f => concat("-", fixed abs f) - d := if OUTPREC() = -1 then digits::I else OUTPREC() --- g := convert10(abs f,digits); m := g.mantissa; e := g.exponent - g := convert10(abs f,d); m := g.mantissa; e := g.exponent - if OUTPREC() ^= -1 then - -- round g to OUTPREC digits after the decimal point - l := length10 m - if -e > OUTPREC() and -e < 2*digits::I then - g := normalize10(g,l+e+OUTPREC()) - m := g.mantissa; e := g.exponent - s := convert(m)@S; n := #s; o := e+n - p := if OUTPREC() = -1 then n::I else OUTPREC() - t:S - if e >= 0 then - s := concat(s, new(e::N, zero)) - t := "" - else if o <= 0 then - t := concat(new((-o)::N,zero), s) - s := "0" - else - t := s(o + minIndex s .. n + minIndex s - 1) - s := s(minIndex s .. o + minIndex s - 1) - n := #t - if OUTPREC() = -1 then - t := rightTrim(t,zero) - if t = "" then t := "0" - else if n > p then t := t(minIndex t .. p + minIndex t- 1) - else t := concat(t, new((p-n)::N,zero)) - concat(padFromRight s, concat(".", padFromLeft t)) - - floating f == - zero? f => "0.0" - negative? f => concat("-", floating abs f) - t:S := if zero? SPACING() then "E" else " E " - zero? exponent f => - s := convert(mantissa f)@S - concat ["0.", padFromLeft s, t, convert(#s)@S] - -- base conversion to decimal rounded to the requested precision - d := if OUTPREC() = -1 then digits::I else OUTPREC() - g := convert10(f,d); m := g.mantissa; e := g.exponent - -- I'm assuming that length10 m = # s given n > 0 - s := convert(m)@S; n := #s; o := e+n - s := padFromLeft s - concat ["0.", s, t, convert(o)@S] - - general(f) == - zero? f => "0.0" - negative? f => concat("-", general abs f) - d := if OUTPREC() = -1 then digits::I else OUTPREC() - zero? exponent f => - d := d + 1 - s := convert(mantissa f)@S - OUTPREC() ^= -1 and (e := #s) > d => - t:S := if zero? SPACING() then "E" else " E " - concat ["0.", padFromLeft s, t, convert(e)@S] - padFromRight concat(s, ".0") - -- base conversion to decimal rounded to the requested precision - g := convert10(f,d); m := g.mantissa; e := g.exponent - -- I'm assuming that length10 m = # s given n > 0 - s := convert(m)@S; n := #s; o := n + e - -- Note: at least one digit is displayed after the decimal point - -- and trailing zeroes after the decimal point are dropped - if o > 0 and o <= max(n,d) then - -- fixed format: add trailing zeroes before the decimal point - if o > n then s := concat(s, new((o-n)::N,zero)) - t := rightTrim(s(o + minIndex s .. n + minIndex s - 1), zero) - if t = "" then t := "0" else t := padFromLeft t - s := padFromRight s(minIndex s .. o + minIndex s - 1) - concat(s, concat(".", t)) - else if o <= 0 and o >= -5 then - -- fixed format: up to 5 leading zeroes after the decimal point - concat("0.",padFromLeft concat(new((-o)::N,zero),rightTrim(s,zero))) - else - -- print using E format written 0.mantissa E exponent - t := padFromLeft rightTrim(s,zero) - s := if zero? SPACING() then "E" else " E " - concat ["0.", t, s, convert(e+n)@S] - - outputSpacing n == SPACING() := n - outputFixed() == (OUTMODE() := "fixed"; OUTPREC() := -1) - outputFixed n == (OUTMODE() := "fixed"; OUTPREC() := n::I) - outputGeneral() == (OUTMODE() := "general"; OUTPREC() := -1) - outputGeneral n == (OUTMODE() := "general"; OUTPREC() := n::I) - outputFloating() == (OUTMODE() := "floating"; OUTPREC() := -1) - outputFloating n == (OUTMODE() := "floating"; OUTPREC() := n::I) - - convert(f):S == - b:Integer := - OUTPREC() = -1 and not zero? f => - bits(length(abs mantissa f)::PositiveInteger) - 0 - s := - OUTMODE() = "fixed" => fixed f - OUTMODE() = "floating" => floating f - OUTMODE() = "general" => general f - empty()$String - if b > 0 then bits(b::PositiveInteger) - s = empty()$String => error "bad output mode" - s - - coerce(f):OutputForm == - f >= 0 => message(convert(f)@S) - - (coerce(-f)@OutputForm) - - convert(f):InputForm == - convert [convert("float"::Symbol), convert mantissa f, - convert exponent f, convert base()]$List(InputForm) - - -- Conversion routines - convert(x:%):Float == x pretend Float - convert(x:%):SF == makeSF(x.mantissa,x.exponent)$Lisp - coerce(x:%):SF == convert(x)@SF - convert(sf:SF):% == float(mantissa sf,exponent sf,base()$SF) - - retract(f:%):RN == rationalApproximation(f,(bits()-1)::N,BASE) - - retractIfCan(f:%):Union(RN, "failed") == - rationalApproximation(f,(bits()-1)::N,BASE) - - retract(f:%):I == - (f = (n := wholePart f)::%) => n - error "Not an integer" - - retractIfCan(f:%):Union(I, "failed") == - (f = (n := wholePart f)::%) => n - "failed" - - rationalApproximation(f,d) == rationalApproximation(f,d,10) - - rationalApproximation(f,d,b) == - t: Integer - nu := f.mantissa; ex := f.exponent - if ex >= 0 then return ((nu*BASE**(ex::N))/1) - de := BASE**((-ex)::N) - if b < 2 then error "base must be > 1" - tol := b**d - s := nu; t := de - p0,p1,q0,q1 : Integer - p0 := 0; p1 := 1; q0 := 1; q1 := 0 - repeat - (q,r) := divide(s, t) - p2 := q*p1+p0 - q2 := q*q1+q0 - if r = 0 or tol*abs(nu*q2-de*p2) < de*abs(p2) then return (p2/q2) - (p0,p1) := (p1,p2) - (q0,q1) := (q1,q2) - (s,t) := (t,r) - -@ - ---% Float: arbitrary precision floating point arithmetic domain - -\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/fmod.spad.pamphlet b/src/algebra/fmod.spad.pamphlet deleted file mode 100644 index 57e6f20..0000000 --- a/src/algebra/fmod.spad.pamphlet +++ /dev/null @@ -1,143 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra fmod.spad} -\author{The Axiom Team} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{domain ZMOD IntegerMod} -<>= -)abbrev domain ZMOD IntegerMod -++ Author: -++ Date Created: -++ Date Last Updated: -++ Basic Functions: -++ Related Constructors: -++ Also See: -++ AMS Classifications: -++ Keywords: -++ References: -++ Description: -++ IntegerMod(n) creates the ring of integers reduced modulo the integer -++ n. - -IntegerMod(p:PositiveInteger): - Join(CommutativeRing, Finite, ConvertibleTo Integer, StepThrough) == add - size() == p - characteristic() == p - lookup x == (zero? x => p; (convert(x)@Integer) :: PositiveInteger) - --- Code is duplicated for the optimizer to kick in. - if p <= convert(max()$SingleInteger)@Integer then - Rep:= SingleInteger - q := p::SingleInteger - - bloodyCompiler: Integer -> % - bloodyCompiler n == positiveRemainder(n, p)$Integer :: Rep - - convert(x:%):Integer == convert(x)$Rep - coerce(x):OutputForm == coerce(x)$Rep - coerce(n:Integer):% == bloodyCompiler n - 0 == 0$Rep - 1 == 1$Rep - init == 0$Rep - nextItem(n) == - m:=n+1 - m=0 => "failed" - m - x = y == x =$Rep y - x:% * y:% == mulmod(x, y, q) - n:Integer * x:% == mulmod(bloodyCompiler n, x, q) - x + y == addmod(x, y, q) - x - y == submod(x, y, q) - random() == random(q)$Rep - index a == positiveRemainder(a::%, q) - - x == (zero? x => 0; q -$Rep x) - - x:% ** n:NonNegativeInteger == - n < p => powmod(x, n::Rep, q) - powmod(convert(x)@Integer, n, p)$Integer :: Rep - - recip x == - (c1, c2, g) := extendedEuclidean(x, q)$Rep --- not one? g => "failed" - not (g = 1) => "failed" - positiveRemainder(c1, q) - - else - Rep:= Integer - - convert(x:%):Integer == convert(x)$Rep - coerce(n:Integer):% == positiveRemainder(n::Rep, p) - coerce(x):OutputForm == coerce(x)$Rep - 0 == 0$Rep - 1 == 1$Rep - init == 0$Rep - nextItem(n) == - m:=n+1 - m=0 => "failed" - m - x = y == x =$Rep y - x:% * y:% == mulmod(x, y, p) - n:Integer * x:% == mulmod(positiveRemainder(n::Rep, p), x, p) - x + y == addmod(x, y, p) - x - y == submod(x, y, p) - random() == random(p)$Rep - index a == positiveRemainder(a::Rep, p) - - x == (zero? x => 0; p -$Rep x) - x:% ** n:NonNegativeInteger == powmod(x, n::Rep, p) - - recip x == - (c1, c2, g) := extendedEuclidean(x, p)$Rep --- not one? g => "failed" - not (g = 1) => "failed" - positiveRemainder(c1, p) - -@ -\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/fname.spad.pamphlet b/src/algebra/fname.spad.pamphlet deleted file mode 100644 index 8468638..0000000 --- a/src/algebra/fname.spad.pamphlet +++ /dev/null @@ -1,370 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra fname.spad} -\author{Stephen M. Watt} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{domain FNAME FileName} -<>= --- fname.spad.pamphlet FileName.input -)spool FileName.output -)set message test on -)set message auto off -)clear all ---S 1 of 18 -fn: FileName ---R ---R Type: Void ---E 1 - ---S 2 of 18 -fn := "fname.input" ---R ---R ---R (2) "fname.input" ---R Type: FileName ---E 2 - ---S 3 of 18 -directory fn ---R ---R ---R (3) "" ---R Type: String ---E 3 - ---S 4 of 18 -name fn ---R ---R ---R (4) "fname" ---R Type: String ---E 4 - ---S 5 of 18 -extension fn ---R ---R ---R (5) "input" ---R Type: String ---E 5 - ---S 6 of 18 -fn := filename("/tmp", "fname", "input") ---R ---R ---R (6) "/tmp/fname.input" ---R Type: FileName ---E 6 - ---S 7 of 18 -objdir := "/tmp" ---R ---R ---R (7) "/tmp" ---R Type: String ---E 7 - ---S 8 of 18 -fn := filename(objdir, "table", "spad") ---R ---R ---R (8) "/tmp/table.spad" ---R Type: FileName ---E 8 - ---S 9 of 18 -fn := filename("", "letter", "") ---R ---R ---R (9) "letter" ---R Type: FileName ---E 9 - ---S 10 of 18 -exists? "/etc/passwd" ---R ---R ---R (10) true ---R Type: Boolean ---E 10 - ---S 11 of 18 -readable? "/etc/passwd" ---R ---R ---R (11) true ---R Type: Boolean ---E 11 - ---S 12 of 18 -readable? "/etc/security/passwd" ---R ---R ---R (12) false ---R Type: Boolean ---E 12 - ---S 13 of 18 -readable? "/ect/passwd" ---R ---R ---R (13) false ---R Type: Boolean ---E 13 - ---S 14 of 18 -writable? "/etc/passwd" ---R ---R ---R (14) true ---R Type: Boolean ---E 14 - ---S 15 of 18 -writable? "/dev/null" ---R ---R ---R (15) true ---R Type: Boolean ---E 15 - ---S 16 of 18 -writable? "/etc/DoesNotExist" ---R ---R ---R (16) true ---R Type: Boolean ---E 16 - ---S 17 of 18 -writable? "/tmp/DoesNotExist" ---R ---R ---R (17) true ---R Type: Boolean ---E 17 - ---S 18 of 18 -fn := new(objdir, "xxx", "yy") ---R ---R ---I (18) "/tmp/xxx1419.yy" ---R Type: FileName ---E 18 -)spool -)lisp (bye) -@ -<>= -==================================================================== -FileName examples -==================================================================== - -The FileName domain provides an interface to the computer's file -system. Functions are provided to manipulate file names and to test -properties of files. - -The simplest way to use file names in the Axiom interpreter is to rely -on conversion to and from strings. The syntax of these strings -depends on the operating system. - - fn: FileName - Type: Void - -On Linux, this is a proper file syntax: - - fn := "fname.input" - "fname.input" - Type: FileName - -Although it is very convenient to be able to use string notation -for file names in the interpreter, it is desirable to have a portable -way of creating and manipulating file names from within programs. - -A measure of portability is obtained by considering a file name to -consist of three parts: the directory, the name, and the extension. - - directory fn - "" - Type: String - - name fn - "fname" - Type: String - - extension fn - "input" - Type: String - -The meaning of these three parts depends on the operating system. -For example, on CMS the file "SPADPROF INPUT M" would have directory -"M", name "SPADPROF" and extension "INPUT". - -It is possible to create a filename from its parts. - - fn := filename("/tmp", "fname", "input") - "/tmp/fname.input" - Type: FileName - -When writing programs, it is helpful to refer to directories via -variables. - - objdir := "/tmp" - "/tmp" - Type: String - - fn := filename(objdir, "table", "spad") - "/tmp/table.spad" - Type: FileName - -If the directory or the extension is given as an empty string, then -a default is used. On AIX, the defaults are the current directory -and no extension. - - fn := filename("", "letter", "") - "letter" - Type: FileName - -Three tests provide information about names in the file system. - -The exists? operation tests whether the named file exists. - - exists? "/etc/passwd" - true - Type: Boolean - -The operation readable? tells whether the named file can be read. If -the file does not exist, then it cannot be read. - - readable? "/etc/passwd" - true - Type: Boolean - - readable? "/etc/security/passwd" - false - Type: Boolean - - readable? "/ect/passwd" - false - Type: Boolean - -Likewise, the operation writable? tells whether the named file can be -written. If the file does not exist, the test is determined by the -properties of the directory. - - writable? "/etc/passwd" - true - Type: Boolean - - writable? "/dev/null" - true - Type: Boolean - - writable? "/etc/DoesNotExist" - true - Type: Boolean - - writable? "/tmp/DoesNotExist" - true - Type: Boolean - -The new operation constructs the name of a new writable file. The -argument sequence is the same as for filename, except that the name -part is actually a prefix for a constructed unique name. - -The resulting file is in the specified directory with the given -extension, and the same defaults are used. - - fn := new(objdir, "xxx", "yy") - "/tmp/xxx1419.yy" - Type: FileName - -See Also: -o )show FileName -o $AXIOM/doc/src/algebra/fname.spad.dvi - -@ -<>= -)abbrev domain FNAME FileName -++ Author: Stephen M. Watt -++ Date Created: 1985 -++ Date Last Updated: June 20, 1991 -++ Basic Operations: -++ Related Domains: -++ Also See: -++ AMS Classifications: -++ Keywords: -++ Examples: -++ References: -++ Description: -++ This domain provides an interface to names in the file system. - -FileName(): FileNameCategory == add - - f1 = f2 == EQUAL(f1, f2)$Lisp - coerce(f: %): OutputForm == f::String::OutputForm - - coerce(f: %): String == NAMESTRING(f)$Lisp - coerce(s: String): % == PARSE_-NAMESTRING(s)$Lisp - - filename(d,n,e) == fnameMake(d,n,e)$Lisp - - directory(f:%): String == fnameDirectory(f)$Lisp - name(f:%): String == fnameName(f)$Lisp - extension(f:%): String == fnameType(f)$Lisp - - exists? f == fnameExists?(f)$Lisp - readable? f == fnameReadable?(f)$Lisp - writable? f == fnameWritable?(f)$Lisp - - new(d,pref,e) == fnameNew(d,pref,e)$Lisp - -@ -\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/fnla.spad.pamphlet b/src/algebra/fnla.spad.pamphlet index e56534e..3336490 100644 --- a/src/algebra/fnla.spad.pamphlet +++ b/src/algebra/fnla.spad.pamphlet @@ -9,82 +9,6 @@ \eject \tableofcontents \eject -\section{domain OSI OrdSetInts} -<>= -)abbrev domain OSI OrdSetInts -++ Author : Larry Lambe -++ Date created : 14 August 1988 -++ Date Last Updated : 11 March 1991 -++ Description : A domain used in order to take the free R-module on the -++ Integers I. This is actually the forgetful functor from OrderedRings -++ to OrderedSets applied to I -OrdSetInts: Export == Implement where - I ==> Integer - L ==> List - O ==> OutputForm - - Export == OrderedSet with - coerce : Integer -> % - ++ coerce(i) returns the element corresponding to i - value : % -> I - ++ value(x) returns the integer associated with x - - Implement == add - Rep := Integer - x,y: % - - x = y == x =$Rep y - x < y == x <$Rep y - - coerce(i:Integer):% == i - - value(x) == x:Rep - - coerce(x):O == - sub(e::Symbol::O, coerce(x)$Rep)$O - -@ -\section{domain COMM Commutator} -<>= -)abbrev domain COMM Commutator -++ Author : Larry Lambe -++ Date created: 30 June 1988. -++ Updated : 10 March 1991 -++ Description: A type for basic commutators -Commutator: Export == Implement where - I ==> Integer - OSI ==> OrdSetInts - O ==> OutputForm - - Export == SetCategory with - mkcomm : I -> % - ++ mkcomm(i) \undocumented{} - mkcomm : (%,%) -> % - ++ mkcomm(i,j) \undocumented{} - - Implement == add - P := Record(left:%,right:%) - Rep := Union(OSI,P) - x,y: % - i : I - - x = y == - (x case OSI) and (y case OSI) => x::OSI = y::OSI - (x case P) and (y case P) => - xx:P := x::P - yy:P := y::P - (xx.right = yy.right) and (xx.left = yy.left) - false - - mkcomm(i) == i::OSI - mkcomm(x,y) == construct(x,y)$P - - coerce(x: %): O == - x case OSI => x::OSI::O - xx := x::P - bracket([xx.left::O,xx.right::O])$O - -@ \section{package HB HallBasis} <>= )abbrev package HB HallBasis @@ -178,124 +102,6 @@ HallBasis() : Export == Implement where v @ -\section{domain FNLA FreeNilpotentLie} -<>= -)abbrev domain FNLA FreeNilpotentLie -++ Author: Larry Lambe -++ Date Created: July 1988 -++ Date Last Updated: March 13 1991 -++ Related Constructors: OrderedSetInts, Commutator -++ AMS Classification: Primary 17B05, 17B30; Secondary 17A50 -++ Keywords: free Lie algebra, Hall basis, basic commutators -++ Related Constructors: HallBasis, FreeMod, Commutator, OrdSetInts -++ Description: Generate the Free Lie Algebra over a ring R with identity; -++ A P. Hall basis is generated by a package call to HallBasis. - -FreeNilpotentLie(n:NNI,class:NNI,R: CommutativeRing): Export == Implement where - B ==> Boolean - Com ==> Commutator - HB ==> HallBasis - I ==> Integer - NNI ==> NonNegativeInteger - O ==> OutputForm - OSI ==> OrdSetInts - FM ==> FreeModule(R,OSI) - VI ==> Vector Integer - VLI ==> Vector List Integer - lC ==> leadingCoefficient - lS ==> leadingSupport - - Export ==> NonAssociativeAlgebra(R) with - dimension : () -> NNI - ++ dimension() is the rank of this Lie algebra - deepExpand : % -> O - ++ deepExpand(x) \undocumented{} - shallowExpand : % -> O - ++ shallowExpand(x) \undocumented{} - generator : NNI -> % - ++ generator(i) is the ith Hall Basis element - - Implement ==> FM add - Rep := FM - f,g : % - - coms:VLI - coms := generate(n,class)$HB - - dimension == #coms - - have : (I,I) -> % - -- have(left,right) is a lookup function for basic commutators - -- already generated; if the nth basic commutator is - -- [left,wt,right], then have(left,right) = n - have(i,j) == - wt:I := coms(i).2 + coms(j).2 - wt > class => 0 - lo:I := 1 - hi:I := dimension - while hi-lo > 1 repeat - mid:I := (hi+lo) quo 2 - if coms(mid).2 < wt then lo := mid else hi := mid - while coms(hi).1 < i repeat hi := hi + 1 - while coms(hi).3 < j repeat hi := hi + 1 - monomial(1,hi::OSI)$FM - - generator(i) == - i > dimension => 0$Rep - monomial(1,i::OSI)$FM - - putIn : I -> % - putIn(i) == - monomial(1$R,i::OSI)$FM - - brkt : (I,%) -> % - brkt(k,f) == - f = 0 => 0 - dg:I := value lS f - reductum(f) = 0 => - k = dg => 0 - k > dg => -lC(f)*brkt(dg, putIn(k)) - inHallBasis?(n,k,dg,coms(dg).1) => lC(f)*have(k, dg) - lC(f)*( brkt(coms(dg).1, _ - brkt(k,putIn coms(dg).3)) - brkt(coms(dg).3, _ - brkt(k,putIn coms(dg).1) )) - brkt(k,monomial(lC f,lS f)$FM)+brkt(k,reductum f) - - f*g == - reductum(f) = 0 => - lC(f)*brkt(value(lS f),g) - monomial(lC f,lS f)$FM*g + reductum(f)*g - - Fac : I -> Com - -- an auxilliary function used for output of Free Lie algebra - -- elements (see expand) - Fac(m) == - coms(m).1 = 0 => mkcomm(m)$Com - mkcomm(Fac coms(m).1, Fac coms(m).3) - - shallowE : (R,OSI) -> O - shallowE(r,s) == - k := value s - r = 1 => - k <= n => s::O - mkcomm(mkcomm(coms(k).1)$Com,mkcomm(coms(k).3)$Com)$Com::O - k <= n => r::O * s::O - r::O * mkcomm(mkcomm(coms(k).1)$Com,mkcomm(coms(k).3)$Com)$Com::O - - shallowExpand(f) == - f = 0 => 0::O - reductum(f) = 0 => shallowE(lC f,lS f) - shallowE(lC f,lS f) + shallowExpand(reductum f) - - deepExpand(f) == - f = 0 => 0::O - reductum(f) = 0 => - lC(f)=1 => Fac(value(lS f))::O - lC(f)::O * Fac(value(lS f))::O - lC(f)=1 => Fac(value(lS f))::O + deepExpand(reductum f) - lC(f)::O * Fac(value(lS f))::O + deepExpand(reductum f) - -@ \section{License} <>= --Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. @@ -332,10 +138,7 @@ FreeNilpotentLie(n:NNI,class:NNI,R: CommutativeRing): Export == Implement where <<*>>= <> -<> -<> <> -<> @ \eject \begin{thebibliography}{99} diff --git a/src/algebra/formula.spad.pamphlet b/src/algebra/formula.spad.pamphlet index b566863..9298bb7 100644 --- a/src/algebra/formula.spad.pamphlet +++ b/src/algebra/formula.spad.pamphlet @@ -9,435 +9,6 @@ \eject \tableofcontents \eject -\section{domain FORMULA ScriptFormulaFormat} -<>= -)abbrev domain FORMULA ScriptFormulaFormat -++ Author: Robert S. Sutor -++ Date Created: 1987 through 1990 -++ Change History: -++ Basic Operations: coerce, convert, display, epilogue, -++ formula, new, prologue, setEpilogue!, setFormula!, setPrologue! -++ Related Constructors: ScriptFormulaFormat1 -++ Also See: TexFormat -++ AMS Classifications: -++ Keywords: output, format, SCRIPT, BookMaster, formula -++ References: -++ SCRIPT Mathematical Formula Formatter User's Guide, SH20-6453, -++ IBM Corporation, Publishing Systems Information Development, -++ Dept. G68, P.O. Box 1900, Boulder, Colorado, USA 80301-9191. -++ Description: -++ \spadtype{ScriptFormulaFormat} provides a coercion from -++ \spadtype{OutputForm} to IBM SCRIPT/VS Mathematical Formula Format. -++ The basic SCRIPT formula format object consists of three parts: a -++ prologue, a formula part and an epilogue. The functions -++ \spadfun{prologue}, \spadfun{formula} and \spadfun{epilogue} -++ extract these parts, respectively. The central parts of the expression -++ go into the formula part. The other parts can be set -++ (\spadfun{setPrologue!}, \spadfun{setEpilogue!}) so that contain the -++ appropriate tags for printing. For example, the prologue and -++ epilogue might simply contain ":df." and ":edf." so that the -++ formula section will be printed in display math mode. - -ScriptFormulaFormat(): public == private where - E ==> OutputForm - I ==> Integer - L ==> List - S ==> String - - public == SetCategory with - coerce: E -> % - ++ coerce(o) changes o in the standard output format to - ++ SCRIPT formula format. - convert: (E,I) -> % - ++ convert(o,step) changes o in standard output format to - ++ SCRIPT formula format and also adds the given step number. - ++ This is useful if you want to create equations with given numbers - ++ or have the equation numbers correspond to the interpreter step - ++ numbers. - display: (%, I) -> Void - ++ display(t,width) outputs the formatted code t so that each - ++ line has length less than or equal to \spadvar{width}. - display: % -> Void - ++ display(t) outputs the formatted code t so that each - ++ line has length less than or equal to the value set by - ++ the system command \spadsyscom{set output length}. - epilogue: % -> L S - ++ epilogue(t) extracts the epilogue section of a formatted object t. - formula: % -> L S - ++ formula(t) extracts the formula section of a formatted object t. - new: () -> % - ++ new() create a new, empty object. Use \spadfun{setPrologue!}, - ++ \spadfun{setFormula!} and \spadfun{setEpilogue!} to set the - ++ various components of this object. - prologue: % -> L S - ++ prologue(t) extracts the prologue section of a formatted object t. - setEpilogue!: (%, L S) -> L S - ++ setEpilogue!(t,strings) sets the epilogue section of a - ++ formatted object t to strings. - setFormula!: (%, L S) -> L S - ++ setFormula!(t,strings) sets the formula section of a - ++ formatted object t to strings. - setPrologue!: (%, L S) -> L S - ++ setPrologue!(t,strings) sets the prologue section of a - ++ formatted object t to strings. - - private == add - import OutputForm - import Character - import Integer - import List OutputForm - import List String - - Rep := Record(prolog : L S, formula : L S, epilog : L S) - - -- local variables declarations and definitions - - expr: E - prec,opPrec: I - str: S - blank : S := " @@ " - - maxPrec : I := 1000000 - minPrec : I := 0 - - splitChars : S := " <>[](){}+*=,-%" - - unaryOps : L S := ["-","^"]$(L S) - unaryPrecs : L I := [700,260]$(L I) - - -- the precedence of / in the following is relatively low because - -- the bar obviates the need for parentheses. - binaryOps : L S := ["+->","|","**","/","<",">","=","OVER"]$(L S) - binaryPrecs : L I := [0,0,900, 700,400,400,400, 700]$(L I) - - naryOps : L S := ["-","+","*",blank,",",";"," ","ROW","", - " habove "," here "," labove "]$(L S) - naryPrecs : L I := [700,700,800, 800,110,110, 0, 0, 0, - 0, 0, 0]$(L I) --- naryNGOps : L S := ["ROW"," here "]$(L S) - naryNGOps : L S := nil$(L S) - - plexOps : L S := ["SIGMA","PI","INTSIGN","INDEFINTEGRAL"]$(L S) - plexPrecs : L I := [ 700, 800, 700, 700]$(L I) - - specialOps : L S := ["MATRIX","BRACKET","BRACE","CONCATB", _ - "AGGLST","CONCAT","OVERBAR","ROOT","SUB", _ - "SUPERSUB","ZAG","AGGSET","SC","PAREN"] - - -- the next two lists provide translations for some strings for - -- which the formula formatter provides special variables. - - specialStrings : L S := - ["5","..."] - specialStringsInFormula : L S := - [" alpha "," ellipsis "] - - -- local function signatures - - addBraces: S -> S - addBrackets: S -> S - group: S -> S - formatBinary: (S,L E, I) -> S - formatFunction: (S,L E, I) -> S - formatMatrix: L E -> S - formatNary: (S,L E, I) -> S - formatNaryNoGroup: (S,L E, I) -> S - formatNullary: S -> S - formatPlex: (S,L E, I) -> S - formatSpecial: (S,L E, I) -> S - formatUnary: (S, E, I) -> S - formatFormula: (E,I) -> S - parenthesize: S -> S - precondition: E -> E - postcondition: S -> S - splitLong: (S,I) -> L S - splitLong1: (S,I) -> L S - stringify: E -> S - - -- public function definitions - - new() : % == [[".eq set blank @",":df."]$(L S), - [""]$(L S), [":edf."]$(L S)]$Rep - - coerce(expr : E): % == - f : % := new()$% - f.formula := [postcondition - formatFormula(precondition expr, minPrec)]$(L S) - f - - convert(expr : E, stepNum : I): % == - f : % := new()$% - f.formula := concat([""], [postcondition - formatFormula(precondition expr, minPrec)]$(L S)) - f - - display(f : %, len : I) == - s,t : S - for s in f.prolog repeat sayFORMULA(s)$Lisp - for s in f.formula repeat - for t in splitLong(s, len) repeat sayFORMULA(t)$Lisp - for s in f.epilog repeat sayFORMULA(s)$Lisp - void()$Void - - display(f : %) == - display(f, _$LINELENGTH$Lisp pretend I) - - prologue(f : %) == f.prolog - formula(f : %) == f.formula - epilogue(f : %) == f.epilog - - setPrologue!(f : %, l : L S) == f.prolog := l - setFormula!(f : %, l : L S) == f.formula := l - setEpilogue!(f : %, l : L S) == f.epilog := l - - coerce(f : %): E == - s,t : S - l : L S := nil - for s in f.prolog repeat l := concat(s,l) - for s in f.formula repeat - for t in splitLong(s, (_$LINELENGTH$Lisp pretend Integer) - 4) repeat - l := concat(t,l) - for s in f.epilog repeat l := concat(s,l) - (reverse l) :: E - - -- local function definitions - - postcondition(str: S): S == - len : I := #str - len < 4 => str - plus : Character := char "+" - minus: Character := char "-" - for i in 1..(len-1) repeat - if (str.i =$Character plus) and (str.(i+1) =$Character minus) - then setelt(str,i,char " ")$S - str - - stringify expr == object2String(expr)$Lisp pretend S - - splitLong(str : S, len : I): L S == - -- this blocks into lines - if len < 20 then len := _$LINELENGTH$Lisp - splitLong1(str, len) - - splitLong1(str : S, len : I) == - l : List S := nil - s : S := "" - ls : I := 0 - ss : S - lss : I - for ss in split(str,char " ") repeat - lss := #ss - if ls + lss > len then - l := concat(s,l)$List(S) - s := "" - ls := 0 - lss > len => l := concat(ss,l)$List(S) - ls := ls + lss + 1 - s := concat(s,concat(ss," ")$S)$S - if ls > 0 then l := concat(s,l)$List(S) - reverse l - - group str == - concat ["<",str,">"] - - addBraces str == - concat ["left lbrace ",str," right rbrace"] - - addBrackets str == - concat ["left lb ",str," right rb"] - - parenthesize str == - concat ["left lparen ",str," right rparen"] - - precondition expr == - outputTran(expr)$Lisp - - formatSpecial(op : S, args : L E, prec : I) : S == - op = "AGGLST" => - formatNary(",",args,prec) - op = "AGGSET" => - formatNary(";",args,prec) - op = "CONCATB" => - formatNary(" ",args,prec) - op = "CONCAT" => - formatNary("",args,prec) - op = "BRACKET" => - group addBrackets formatFormula(first args, minPrec) - op = "BRACE" => - group addBraces formatFormula(first args, minPrec) - op = "PAREN" => - group parenthesize formatFormula(first args, minPrec) - op = "OVERBAR" => - null args => "" - group concat [formatFormula(first args, minPrec)," bar"] - op = "ROOT" => - null args => "" - tmp : S := formatFormula(first args, minPrec) - null rest args => group concat ["sqrt ",tmp] - group concat ["midsup adjust(u 1.5 r 9) ", - formatFormula(first rest args, minPrec)," sqrt ",tmp] - op = "SC" => - formatNary(" labove ",args,prec) - op = "SUB" => - group concat [formatFormula(first args, minPrec)," sub ", - formatSpecial("AGGLST",rest args,minPrec)] - op = "SUPERSUB" => - -- variable name - form : List S := [formatFormula(first args, minPrec)] - -- subscripts - args := rest args - null args => concat form - tmp : S := formatFormula(first args, minPrec) - if tmp ^= "" then form := append(form,[" sub ",tmp])$(List S) - -- superscripts - args := rest args - null args => group concat form - tmp : S := formatFormula(first args, minPrec) - if tmp ^= "" then form := append(form,[" sup ",tmp])$(List S) - -- presuperscripts - args := rest args - null args => group concat form - tmp : S := formatFormula(first args, minPrec) - if tmp ^= "" then form := append(form,[" presup ",tmp])$(List S) - -- presubscripts - args := rest args - null args => group concat form - tmp : S := formatFormula(first args, minPrec) - if tmp ^= "" then form := append(form,[" presub ",tmp])$(List S) - group concat form - op = "MATRIX" => formatMatrix rest args --- op = "ZAG" => --- concat ["\zag{",formatFormula(first args, minPrec),"}{", --- formatFormula(first rest args,minPrec),"}"] - concat ["not done yet for ",op] - - formatPlex(op : S, args : L E, prec : I) : S == - hold : S - p : I := position(op,plexOps) - p < 1 => error "unknown Script Formula Formatter unary op" - opPrec := plexPrecs.p - n : I := #args - (n ^= 2) and (n ^= 3) => error "wrong number of arguments for plex" - s : S := - op = "SIGMA" => "sum" - op = "PI" => "product" - op = "INTSIGN" => "integral" - op = "INDEFINTEGRAL" => "integral" - "????" - hold := formatFormula(first args,minPrec) - args := rest args - if op ^= "INDEFINTEGRAL" then - if hold ^= "" then - s := concat [s," from",group concat ["\displaystyle ",hold]] - if not null rest args then - hold := formatFormula(first args,minPrec) - if hold ^= "" then - s := concat [s," to",group concat ["\displaystyle ",hold]] - args := rest args - s := concat [s," ",formatFormula(first args,minPrec)] - else - hold := group concat [hold," ",formatFormula(first args,minPrec)] - s := concat [s," ",hold] - if opPrec < prec then s := parenthesize s - group s - - formatMatrix(args : L E) : S == - -- format for args is [[ROW ...],[ROW ...],[ROW ...]] - group addBrackets formatNary(" habove ",args,minPrec) - - formatFunction(op : S, args : L E, prec : I) : S == - group concat [op, " ", parenthesize formatNary(",",args,minPrec)] - - formatNullary(op : S) == - op = "NOTHING" => "" - group concat [op,"()"] - - formatUnary(op : S, arg : E, prec : I) == - p : I := position(op,unaryOps) - p < 1 => error "unknown Script Formula Formatter unary op" - opPrec := unaryPrecs.p - s : S := concat [op,formatFormula(arg,opPrec)] - opPrec < prec => group parenthesize s - op = "-" => s - group s - - formatBinary(op : S, args : L E, prec : I) : S == - p : I := position(op,binaryOps) - p < 1 => error "unknown Script Formula Formatter binary op" - op := - op = "**" => " sup " - op = "/" => " over " - op = "OVER" => " over " - op - opPrec := binaryPrecs.p - s : S := formatFormula(first args, opPrec) - s := concat [s,op,formatFormula(first rest args, opPrec)] - group - op = " over " => s - opPrec < prec => parenthesize s - s - - formatNary(op : S, args : L E, prec : I) : S == - group formatNaryNoGroup(op, args, prec) - - formatNaryNoGroup(op : S, args : L E, prec : I) : S == - null args => "" - p : I := position(op,naryOps) - p < 1 => error "unknown Script Formula Formatter nary op" - op := - op = "," => ", @@ " - op = ";" => "; @@ " - op = "*" => blank - op = " " => blank - op = "ROW" => " here " - op - l : L S := nil - opPrec := naryPrecs.p - for a in args repeat - l := concat(op,concat(formatFormula(a,opPrec),l)$L(S))$L(S) - s : S := concat reverse rest l - opPrec < prec => parenthesize s - s - - formatFormula(expr,prec) == - i : Integer - ATOM(expr)$Lisp pretend Boolean => - str := stringify expr - FIXP(expr)$Lisp => - i := expr : Integer - if (i < 0) or (i > 9) then group str else str - (i := position(str,specialStrings)) > 0 => - specialStringsInFormula.i - str - l : L E := (expr pretend L E) - null l => blank - op : S := stringify first l - args : L E := rest l - nargs : I := #args - - -- special cases - member?(op, specialOps) => formatSpecial(op,args,prec) - member?(op, plexOps) => formatPlex(op,args,prec) - - -- nullary case - 0 = nargs => formatNullary op - - -- unary case - (1 = nargs) and member?(op, unaryOps) => - formatUnary(op, first args, prec) - - -- binary case - (2 = nargs) and member?(op, binaryOps) => - formatBinary(op, args, prec) - - -- nary case - member?(op,naryNGOps) => formatNaryNoGroup(op,args, prec) - member?(op,naryOps) => formatNary(op,args, prec) - op := formatFormula(first l,minPrec) - formatFunction(op,args,prec) - -@ \section{package FORMULA1 ScriptFormulaFormat1} <>= )abbrev package FORMULA1 ScriptFormulaFormat1 @@ -509,7 +80,6 @@ ScriptFormulaFormat1(S : SetCategory): public == private where <<*>>= <> -<> <> @ \eject diff --git a/src/algebra/fortmac.spad.pamphlet b/src/algebra/fortmac.spad.pamphlet deleted file mode 100644 index 8c23f9a..0000000 --- a/src/algebra/fortmac.spad.pamphlet +++ /dev/null @@ -1,461 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra fortmac.spad} -\author{Mike Dewar} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{domain MINT MachineInteger} -<>= -)abbrev domain MINT MachineInteger -++ Author: Mike Dewar -++ Date Created: December 1993 -++ Date Last Updated: -++ Basic Operations: -++ Related Domains: -++ Also See: FortranExpression, FortranMachineTypeCategory, MachineFloat, -++ MachineComplex -++ AMS Classifications: -++ Keywords: -++ Examples: -++ References: -++ Description: A domain which models the integer representation -++ used by machines in the AXIOM-NAG link. -MachineInteger(): Exports == Implementation where - - S ==> String - - Exports ==> Join(FortranMachineTypeCategory,IntegerNumberSystem) with - maxint : PositiveInteger -> PositiveInteger - ++ maxint(u) sets the maximum integer in the model to u - maxint : () -> PositiveInteger - ++ maxint() returns the maximum integer in the model - coerce : Expression Integer -> Expression $ - ++ coerce(x) returns x with coefficients in the domain - - Implementation ==> Integer add - - MAXINT : PositiveInteger := 2**32 - - maxint():PositiveInteger == MAXINT - - maxint(new:PositiveInteger):PositiveInteger == - old := MAXINT - MAXINT := new - old - - coerce(u:Expression Integer):Expression($) == - map(coerce,u)$ExpressionFunctions2(Integer,$) - - coerce(u:Integer):$ == - import S - abs(u) > MAXINT => - message: S := concat [convert(u)@S," > MAXINT(",convert(MAXINT)@S,")"] - error message - u pretend $ - - retract(u:$):Integer == u pretend Integer - - retractIfCan(u:$):Union(Integer,"failed") == u pretend Integer - -@ -\section{domain MFLOAT MachineFloat} -<>= -)abbrev domain MFLOAT MachineFloat -++ Author: Mike Dewar -++ Date Created: December 1993 -++ Date Last Updated: -++ Basic Operations: -++ Related Domains: -++ Also See: FortranExpression, FortranMachineTypeCategory, MachineInteger, -++ MachineComplex -++ AMS Classifications: -++ Keywords: -++ Examples: -++ References: -++ Description: A domain which models the floating point representation -++ used by machines in the AXIOM-NAG link. -MachineFloat(): Exports == Implementation where - - PI ==> PositiveInteger - NNI ==> NonNegativeInteger - F ==> Float - I ==> Integer - S ==> String - FI ==> Fraction Integer - SUP ==> SparseUnivariatePolynomial - SF ==> DoubleFloat - - Exports ==> Join(FloatingPointSystem,FortranMachineTypeCategory,Field, - RetractableTo(Float),RetractableTo(Fraction(Integer)),CharacteristicZero) with - precision : PI -> PI - ++ precision(p) sets the number of digits in the model to p - precision : () -> PI - ++ precision() returns the number of digits in the model - base : PI -> PI - ++ base(b) sets the base of the model to b - base : () -> PI - ++ base() returns the base of the model - maximumExponent : I -> I - ++ maximumExponent(e) sets the maximum exponent in the model to e - maximumExponent : () -> I - ++ maximumExponent() returns the maximum exponent in the model - minimumExponent : I -> I - ++ minimumExponent(e) sets the minimum exponent in the model to e - minimumExponent : () -> I - ++ minimumExponent() returns the minimum exponent in the model - coerce : $ -> F - ++ coerce(u) transforms a MachineFloat to a standard Float - coerce : MachineInteger -> $ - ++ coerce(u) transforms a MachineInteger into a MachineFloat - mantissa : $ -> I - ++ mantissa(u) returns the mantissa of u - exponent : $ -> I - ++ exponent(u) returns the exponent of u - changeBase : (I,I,PI) -> $ - ++ changeBase(exp,man,base) \undocumented{} - - Implementation ==> add - - import F - import FI - - Rep := Record(mantissa:I,exponent:I) - - -- Parameters of the Floating Point Representation - P : PI := 16 -- Precision - B : PI := 2 -- Base - EMIN : I := -1021 -- Minimum Exponent - EMAX : I := 1024 -- Maximum Exponent - - -- Useful constants - POWER : PI := 53 -- The maximum power of B which will yield P - -- decimal digits. - MMAX : PI := B**POWER - - - -- locals - locRound:(FI)->I - checkExponent:($)->$ - normalise:($)->$ - newPower:(PI,PI)->Void - - retractIfCan(u:$):Union(FI,"failed") == - mantissa(u)*(B/1)**(exponent(u)) - - wholePart(u:$):Integer == - man:I:=mantissa u - exp:I:=exponent u - f:= - positive? exp => man*B**(exp pretend PI) - zero? exp => man - wholePart(man/B**((-exp) pretend PI)) - normalise(u:$):$ == - -- We want the largest possible mantissa, to ensure a canonical - -- representation. - exp : I := exponent u - man : I := mantissa u - BB : I := B pretend I - sgn : I := sign man ; man := abs man - zero? man => [0,0]$Rep - if man < MMAX then - while man < MMAX repeat - exp := exp - 1 - man := man * BB - if man > MMAX then - q1:FI:= man/1 - BBF:FI:=BB/1 - while wholePart(q1) > MMAX repeat - q1:= q1 / BBF - exp:=exp + 1 - man := locRound(q1) - positive?(sgn) => checkExponent [man,exp]$Rep - checkExponent [-man,exp]$Rep - - mantissa(u:$):I == elt(u,mantissa)$Rep - exponent(u:$):I == elt(u,exponent)$Rep - - newPower(base:PI,prec:PI):Void == - power : PI := 1 - target : PI := 10**prec - current : PI := base - while (current := current*base) < target repeat power := power+1 - POWER := power - MMAX := B**POWER - void() - - changeBase(exp:I,man:I,base:PI):$ == - newExp : I := 0 - f : FI := man*(base pretend I)::FI**exp - sign : I := sign f - f : FI := abs f - newMan : I := wholePart f - zero? f => [0,0]$Rep - BB : FI := (B pretend I)::FI - if newMan < MMAX then - while newMan < MMAX repeat - newExp := newExp - 1 - f := f*BB - newMan := wholePart f - if newMan > MMAX then - while newMan > MMAX repeat - newExp := newExp + 1 - f := f/BB - newMan := wholePart f - [sign*newMan,newExp]$Rep - - checkExponent(u:$):$ == - exponent(u) < EMIN or exponent(u) > EMAX => - message :S := concat(["Exponent out of range: ", - convert(EMIN)@S, "..", convert(EMAX)@S])$S - error message - u - - coerce(u:$):OutputForm == - coerce(u::F) - - coerce(u:MachineInteger):$ == - checkExponent changeBase(0,retract(u)@Integer,10) - - coerce(u:$):F == - oldDigits : PI := digits(P)$F - r : F := float(mantissa u,exponent u,B)$Float - digits(oldDigits)$F - r - - coerce(u:F):$ == - checkExponent changeBase(exponent(u)$F,mantissa(u)$F,base()$F) - - coerce(u:I):$ == - checkExponent changeBase(0,u,10) - - coerce(u:FI):$ == (numer u)::$/(denom u)::$ - - retract(u:$):FI == - value : Union(FI,"failed") := retractIfCan(u) - value case "failed" => error "Cannot retract to a Fraction Integer" - value::FI - - retract(u:$):F == u::F - - retractIfCan(u:$):Union(F,"failed") == u::F::Union(F,"failed") - - retractIfCan(u:$):Union(I,"failed") == - value:FI := mantissa(u)*(B pretend I)::FI**exponent(u) - zero? fractionPart(value) => wholePart(value)::Union(I,"failed") - "failed"::Union(I,"failed") - - retract(u:$):I == - result : Union(I,"failed") := retractIfCan u - result = "failed" => error "Not an Integer" - result::I - - precision(p: PI):PI == - old : PI := P - newPower(B,p) - P := p - old - - precision():PI == P - - base(b:PI):PI == - old : PI := b - newPower(b,P) - B := b - old - - base():PI == B - - maximumExponent(u:I):I == - old : I := EMAX - EMAX := u - old - - maximumExponent():I == EMAX - - minimumExponent(u:I):I == - old : I := EMIN - EMIN := u - old - - minimumExponent():I == EMIN - - 0 == [0,0]$Rep - 1 == changeBase(0,1,10) - - zero?(u:$):Boolean == u=[0,0]$Rep - - - - f1:$ - f2:$ - - - locRound(x:FI):I == - abs(fractionPart(x)) >= 1/2 => wholePart(x)+sign(x) - wholePart(x) - - recip f1 == - zero? f1 => "failed" - normalise [ locRound(B**(2*POWER)/mantissa f1),-(exponent f1 + 2*POWER)] - - f1 * f2 == - normalise [mantissa(f1)*mantissa(f2),exponent(f1)+exponent(f2)]$Rep - - f1 **(p:FI) == - ((f1::F)**p)::% - ---inline - f1 / f2 == - zero? f2 => error "division by zero" - zero? f1 => 0 - f1=f2 => 1 - normalise [locRound(mantissa(f1)*B**(2*POWER)/mantissa(f2)), - exponent(f1)-(exponent f2 + 2*POWER)] - - inv(f1) == 1/f1 - - f1 exquo f2 == f1/f2 - - divide(f1,f2) == [ f1/f2,0] - - f1 quo f2 == f1/f2 - f1 rem f2 == 0 - u:I * f1 == - normalise [u*mantissa(f1),exponent(f1)]$Rep - - f1 = f2 == mantissa(f1)=mantissa(f2) and exponent(f1)=exponent(f2) - - f1 + f2 == - m1 : I := mantissa f1 - m2 : I := mantissa f2 - e1 : I := exponent f1 - e2 : I := exponent f2 - e1 > e2 => ---insignificance - e1 > e2 + POWER + 2 => - zero? f1 => f2 - f1 - normalise [m1*(B pretend I)**((e1-e2) pretend NNI)+m2,e2]$Rep - e2 > e1 + POWER +2 => - zero? f2 => f1 - f2 - normalise [m2*(B pretend I)**((e2-e1) pretend NNI)+m1,e1]$Rep - - - f1 == [- mantissa f1,exponent f1]$Rep - - f1 - f2 == f1 + (-f2) - - f1 < f2 == - m1 : I := mantissa f1 - m2 : I := mantissa f2 - e1 : I := exponent f1 - e2 : I := exponent f2 - sign(m1) = sign(m2) => - e1 < e2 => true - e1 = e2 and m1 < m2 => true - false - sign(m1) = 1 => false - sign(m1) = 0 and sign(m2) = -1 => false - true - - characteristic():NNI == 0 - -@ -\section{domain MCMPLX MachineComplex} -<>= -)abbrev domain MCMPLX MachineComplex -++ Date Created: December 1993 -++ Date Last Updated: -++ Basic Operations: -++ Related Domains: -++ Also See: FortranExpression, FortranMachineTypeCategory, MachineInteger, -++ MachineFloat -++ AMS Classifications: -++ Keywords: -++ Examples: -++ References: -++ Description: A domain which models the complex number representation -++ used by machines in the AXIOM-NAG link. -MachineComplex():Exports == Implementation where - - Exports ==> Join (FortranMachineTypeCategory, - ComplexCategory(MachineFloat)) with - coerce : Complex Float -> $ - ++ coerce(u) transforms u into a MachineComplex - coerce : Complex Integer -> $ - ++ coerce(u) transforms u into a MachineComplex - coerce : Complex MachineFloat -> $ - ++ coerce(u) transforms u into a MachineComplex - coerce : Complex MachineInteger -> $ - ++ coerce(u) transforms u into a MachineComplex - coerce : $ -> Complex Float - ++ coerce(u) transforms u into a COmplex Float - - Implementation ==> Complex MachineFloat add - - coerce(u:Complex Float):$ == - complex(real(u)::MachineFloat,imag(u)::MachineFloat) - - coerce(u:Complex Integer):$ == - complex(real(u)::MachineFloat,imag(u)::MachineFloat) - - coerce(u:Complex MachineInteger):$ == - complex(real(u)::MachineFloat,imag(u)::MachineFloat) - - coerce(u:Complex MachineFloat):$ == - complex(real(u),imag(u)) - - coerce(u:$):Complex Float == - complex(real(u)::Float,imag(u)::Float) - -@ -\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/fortran.spad.pamphlet b/src/algebra/fortran.spad.pamphlet deleted file mode 100644 index c8d73e9..0000000 --- a/src/algebra/fortran.spad.pamphlet +++ /dev/null @@ -1,1787 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra fortran.spad} -\author{Didier Pinchon, Mike Dewar, William Naylor} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{domain RESULT Result} -<>= -)abbrev domain RESULT Result -++ Author: Didier Pinchon and Mike Dewar -++ Date Created: 8 April 1994 -++ Date Last Updated: 28 June 1994 -++ Basic Operations: -++ Related Domains: -++ Also See: -++ AMS Classifications: -++ Keywords: -++ Examples: -++ References: -++ Description: A domain used to return the results from a call to the NAG -++ Library. It prints as a list of names and types, though the user may -++ choose to display values automatically if he or she wishes. -Result():Exports==Implementation where - - O ==> OutputForm - - Exports ==> TableAggregate(Symbol,Any) with - showScalarValues : Boolean -> Boolean - ++ showScalarValues(true) forces the values of scalar components to be - ++ displayed rather than just their types. - showArrayValues : Boolean -> Boolean - ++ showArrayValues(true) forces the values of array components to be - ++ displayed rather than just their types. - finiteAggregate - - Implementation ==> Table(Symbol,Any) add - - -- Constant - colon := ": "::Symbol::O - elide := "..."::Symbol::O - - -- Flags - showScalarValuesFlag : Boolean := false - showArrayValuesFlag : Boolean := false - - cleanUpDomainForm(d:SExpression):O == - not list? d => d::O - #d=1 => (car d)::O - -- If the car is an atom then we have a domain constructor, if not - -- then we have some kind of value. Since we often can't print these - -- ****ers we just elide them. - not atom? car d => elide - prefix((car d)::O,[cleanUpDomainForm(u) for u in destruct cdr(d)]$List(O)) - - display(v:Any,d:SExpression):O == - not list? d => error "Domain form is non-list" - #d=1 => - showScalarValuesFlag => objectOf v - cleanUpDomainForm d - car(d) = convert("Complex"::Symbol)@SExpression => - showScalarValuesFlag => objectOf v - cleanUpDomainForm d - showArrayValuesFlag => objectOf v - cleanUpDomainForm d - - makeEntry(k:Symbol,v:Any):O == - hconcat [k::O,colon,display(v,dom v)] - - coerce(r:%):O == - bracket [makeEntry(key,r.key) for key in reverse! keys(r)] - - showArrayValues(b:Boolean):Boolean == showArrayValuesFlag := b - showScalarValues(b:Boolean):Boolean == showScalarValuesFlag := b - -@ -\section{domain FC FortranCode} -<>= -)abbrev domain FC FortranCode --- The FortranCode domain is used to represent operations which are to be --- translated into FORTRAN. -++ Author: Mike Dewar -++ Date Created: April 1991 -++ Date Last Updated: 22 March 1994 -++ 26 May 1994 Added common, MCD -++ 21 June 1994 Changed print to printStatement, MCD -++ 30 June 1994 Added stop, MCD -++ 12 July 1994 Added assign for String, MCD -++ 9 January 1995 Added fortran2Lines to getCall, MCD -++ Basic Operations: -++ Related Constructors: FortranProgram, Switch, FortranType -++ Also See: -++ AMS Classifications: -++ Keywords: -++ References: -++ Description: -++ This domain builds representations of program code segments for use with -++ the FortranProgram domain. -FortranCode(): public == private where - L ==> List - PI ==> PositiveInteger - PIN ==> Polynomial Integer - SEX ==> SExpression - O ==> OutputForm - OP ==> Union(Null:"null", - Assignment:"assignment", - Conditional:"conditional", - Return:"return", - Block:"block", - Comment:"comment", - Call:"call", - For:"for", - While:"while", - Repeat:"repeat", - Goto:"goto", - Continue:"continue", - ArrayAssignment:"arrayAssignment", - Save:"save", - Stop:"stop", - Common:"common", - Print:"print") - ARRAYASS ==> Record(var:Symbol, rand:O, ints2Floats?:Boolean) - EXPRESSION ==> Record(ints2Floats?:Boolean,expr:O) - ASS ==> Record(var:Symbol, - arrayIndex:L PIN, - rand:EXPRESSION - ) - COND ==> Record(switch: Switch(), - thenClause: $, - elseClause: $ - ) - RETURN ==> Record(empty?:Boolean,value:EXPRESSION) - BLOCK ==> List $ - COMMENT ==> List String - COMMON ==> Record(name:Symbol,contents:List Symbol) - CALL ==> String - FOR ==> Record(range:SegmentBinding PIN, span:PIN, body:$) - LABEL ==> SingleInteger - LOOP ==> Record(switch:Switch(),body:$) - PRINTLIST ==> List O - OPREC ==> Union(nullBranch:"null", assignmentBranch:ASS, - arrayAssignmentBranch:ARRAYASS, - conditionalBranch:COND, returnBranch:RETURN, - blockBranch:BLOCK, commentBranch:COMMENT, callBranch:CALL, - forBranch:FOR, labelBranch:LABEL, loopBranch:LOOP, - commonBranch:COMMON, printBranch:PRINTLIST) - - public == SetCategory with - coerce: $ -> O - ++ coerce(f) returns an object of type OutputForm. - forLoop: (SegmentBinding PIN,$) -> $ - ++ forLoop(i=1..10,c) creates a representation of a FORTRAN DO loop with - ++ \spad{i} ranging over the values 1 to 10. - forLoop: (SegmentBinding PIN,PIN,$) -> $ - ++ forLoop(i=1..10,n,c) creates a representation of a FORTRAN DO loop with - ++ \spad{i} ranging over the values 1 to 10 by n. - whileLoop: (Switch,$) -> $ - ++ whileLoop(s,c) creates a while loop in FORTRAN. - repeatUntilLoop: (Switch,$) -> $ - ++ repeatUntilLoop(s,c) creates a repeat ... until loop in FORTRAN. - goto: SingleInteger -> $ - ++ goto(l) creates a representation of a FORTRAN GOTO statement - continue: SingleInteger -> $ - ++ continue(l) creates a representation of a FORTRAN CONTINUE labelled - ++ with l - comment: String -> $ - ++ comment(s) creates a representation of the String s as a single FORTRAN - ++ comment. - comment: List String -> $ - ++ comment(s) creates a representation of the Strings s as a multi-line - ++ FORTRAN comment. - call: String -> $ - ++ call(s) creates a representation of a FORTRAN CALL statement - returns: () -> $ - ++ returns() creates a representation of a FORTRAN RETURN statement. - returns: Expression MachineFloat -> $ - ++ returns(e) creates a representation of a FORTRAN RETURN statement - ++ with a returned value. - returns: Expression MachineInteger -> $ - ++ returns(e) creates a representation of a FORTRAN RETURN statement - ++ with a returned value. - returns: Expression MachineComplex -> $ - ++ returns(e) creates a representation of a FORTRAN RETURN statement - ++ with a returned value. - returns: Expression Float -> $ - ++ returns(e) creates a representation of a FORTRAN RETURN statement - ++ with a returned value. - returns: Expression Integer -> $ - ++ returns(e) creates a representation of a FORTRAN RETURN statement - ++ with a returned value. - returns: Expression Complex Float -> $ - ++ returns(e) creates a representation of a FORTRAN RETURN statement - ++ with a returned value. - cond: (Switch,$) -> $ - ++ cond(s,e) creates a representation of the FORTRAN expression - ++ IF (s) THEN e. - cond: (Switch,$,$) -> $ - ++ cond(s,e,f) creates a representation of the FORTRAN expression - ++ IF (s) THEN e ELSE f. - assign: (Symbol,String) -> $ - ++ assign(x,y) creates a representation of the FORTRAN expression - ++ x=y. - assign: (Symbol,Expression MachineInteger) -> $ - ++ assign(x,y) creates a representation of the FORTRAN expression - ++ x=y. - assign: (Symbol,Expression MachineFloat) -> $ - ++ assign(x,y) creates a representation of the FORTRAN expression - ++ x=y. - assign: (Symbol,Expression MachineComplex) -> $ - ++ assign(x,y) creates a representation of the FORTRAN expression - ++ x=y. - assign: (Symbol,Matrix MachineInteger) -> $ - ++ assign(x,y) creates a representation of the FORTRAN expression - ++ x=y. - assign: (Symbol,Matrix MachineFloat) -> $ - ++ assign(x,y) creates a representation of the FORTRAN expression - ++ x=y. - assign: (Symbol,Matrix MachineComplex) -> $ - ++ assign(x,y) creates a representation of the FORTRAN expression - ++ x=y. - assign: (Symbol,Vector MachineInteger) -> $ - ++ assign(x,y) creates a representation of the FORTRAN expression - ++ x=y. - assign: (Symbol,Vector MachineFloat) -> $ - ++ assign(x,y) creates a representation of the FORTRAN expression - ++ x=y. - assign: (Symbol,Vector MachineComplex) -> $ - ++ assign(x,y) creates a representation of the FORTRAN expression - ++ x=y. - assign: (Symbol,Matrix Expression MachineInteger) -> $ - ++ assign(x,y) creates a representation of the FORTRAN expression - ++ x=y. - assign: (Symbol,Matrix Expression MachineFloat) -> $ - ++ assign(x,y) creates a representation of the FORTRAN expression - ++ x=y. - assign: (Symbol,Matrix Expression MachineComplex) -> $ - ++ assign(x,y) creates a representation of the FORTRAN expression - ++ x=y. - assign: (Symbol,Vector Expression MachineInteger) -> $ - ++ assign(x,y) creates a representation of the FORTRAN expression - ++ x=y. - assign: (Symbol,Vector Expression MachineFloat) -> $ - ++ assign(x,y) creates a representation of the FORTRAN expression - ++ x=y. - assign: (Symbol,Vector Expression MachineComplex) -> $ - ++ assign(x,y) creates a representation of the FORTRAN expression - ++ x=y. - assign: (Symbol,L PIN,Expression MachineInteger) -> $ - ++ assign(x,l,y) creates a representation of the assignment of \spad{y} - ++ to the \spad{l}'th element of array \spad{x} (\spad{l} is a list of - ++ indices). - assign: (Symbol,L PIN,Expression MachineFloat) -> $ - ++ assign(x,l,y) creates a representation of the assignment of \spad{y} - ++ to the \spad{l}'th element of array \spad{x} (\spad{l} is a list of - ++ indices). - assign: (Symbol,L PIN,Expression MachineComplex) -> $ - ++ assign(x,l,y) creates a representation of the assignment of \spad{y} - ++ to the \spad{l}'th element of array \spad{x} (\spad{l} is a list of - ++ indices). - assign: (Symbol,Expression Integer) -> $ - ++ assign(x,y) creates a representation of the FORTRAN expression - ++ x=y. - assign: (Symbol,Expression Float) -> $ - ++ assign(x,y) creates a representation of the FORTRAN expression - ++ x=y. - assign: (Symbol,Expression Complex Float) -> $ - ++ assign(x,y) creates a representation of the FORTRAN expression - ++ x=y. - assign: (Symbol,Matrix Expression Integer) -> $ - ++ assign(x,y) creates a representation of the FORTRAN expression - ++ x=y. - assign: (Symbol,Matrix Expression Float) -> $ - ++ assign(x,y) creates a representation of the FORTRAN expression - ++ x=y. - assign: (Symbol,Matrix Expression Complex Float) -> $ - ++ assign(x,y) creates a representation of the FORTRAN expression - ++ x=y. - assign: (Symbol,Vector Expression Integer) -> $ - ++ assign(x,y) creates a representation of the FORTRAN expression - ++ x=y. - assign: (Symbol,Vector Expression Float) -> $ - ++ assign(x,y) creates a representation of the FORTRAN expression - ++ x=y. - assign: (Symbol,Vector Expression Complex Float) -> $ - ++ assign(x,y) creates a representation of the FORTRAN expression - ++ x=y. - assign: (Symbol,L PIN,Expression Integer) -> $ - ++ assign(x,l,y) creates a representation of the assignment of \spad{y} - ++ to the \spad{l}'th element of array \spad{x} (\spad{l} is a list of - ++ indices). - assign: (Symbol,L PIN,Expression Float) -> $ - ++ assign(x,l,y) creates a representation of the assignment of \spad{y} - ++ to the \spad{l}'th element of array \spad{x} (\spad{l} is a list of - ++ indices). - assign: (Symbol,L PIN,Expression Complex Float) -> $ - ++ assign(x,l,y) creates a representation of the assignment of \spad{y} - ++ to the \spad{l}'th element of array \spad{x} (\spad{l} is a list of - ++ indices). - block: List($) -> $ - ++ block(l) creates a representation of the statements in l as a block. - stop: () -> $ - ++ stop() creates a representation of a STOP statement. - save: () -> $ - ++ save() creates a representation of a SAVE statement. - printStatement: List O -> $ - ++ printStatement(l) creates a representation of a PRINT statement. - common: (Symbol,List Symbol) -> $ - ++ common(name,contents) creates a representation a named common block. - operation: $ -> OP - ++ operation(f) returns the name of the operation represented by \spad{f}. - code: $ -> OPREC - ++ code(f) returns the internal representation of the object represented - ++ by \spad{f}. - printCode: $ -> Void - ++ printCode(f) prints out \spad{f} in FORTRAN notation. - getCode: $ -> SEX - ++ getCode(f) returns a Lisp list of strings representing \spad{f} - ++ in Fortran notation. This is used by the FortranProgram domain. - setLabelValue:SingleInteger -> SingleInteger - ++ setLabelValue(i) resets the counter which produces labels to i - - private == add - import Void - import ASS - import COND - import RETURN - import L PIN - import O - import SEX - import FortranType - import TheSymbolTable - - Rep := Record(op: OP, data: OPREC) - - -- We need to be able to generate unique labels - labelValue:SingleInteger := 25000::SingleInteger - setLabelValue(u:SingleInteger):SingleInteger == labelValue := u - newLabel():SingleInteger == - labelValue := labelValue + 1$SingleInteger - labelValue - - commaSep(l:List String):List(String) == - [(l.1),:[:[",",u] for u in rest(l)]] - - getReturn(rec:RETURN):SEX == - returnToken : SEX := convert("RETURN"::Symbol::O)$SEX - elt(rec,empty?)$RETURN => - getStatement(returnToken,NIL$Lisp)$Lisp - rt : EXPRESSION := elt(rec,value)$RETURN - rv : O := elt(rt,expr)$EXPRESSION - getStatement([returnToken,convert(rv)$SEX]$Lisp, - elt(rt,ints2Floats?)$EXPRESSION )$Lisp - - getStop():SEX == - fortran2Lines(LIST("STOP")$Lisp)$Lisp - - getSave():SEX == - fortran2Lines(LIST("SAVE")$Lisp)$Lisp - - getCommon(u:COMMON):SEX == - fortran2Lines(APPEND(LIST("COMMON"," /",string (u.name),"/ ")$Lisp,_ - addCommas(u.contents)$Lisp)$Lisp)$Lisp - - getPrint(l:PRINTLIST):SEX == - ll : SEX := LIST("PRINT*")$Lisp - for i in l repeat - ll := APPEND(ll,CONS(",",expression2Fortran(i)$Lisp)$Lisp)$Lisp - fortran2Lines(ll)$Lisp - - getBlock(rec:BLOCK):SEX == - indentFortLevel(convert(1@Integer)$SEX)$Lisp - expr : SEX := LIST()$Lisp - for u in rec repeat - expr := APPEND(expr,getCode(u))$Lisp - indentFortLevel(convert(-1@Integer)$SEX)$Lisp - expr - - getBody(f:$):SEX == - operation(f) case Block => getCode f - indentFortLevel(convert(1@Integer)$SEX)$Lisp - expr := getCode f - indentFortLevel(convert(-1@Integer)$SEX)$Lisp - expr - - getElseIf(f:$):SEX == - rec := code f - expr := - fortFormatElseIf(elt(rec.conditionalBranch,switch)$COND::O)$Lisp - expr := - APPEND(expr,getBody elt(rec.conditionalBranch,thenClause)$COND)$Lisp - elseBranch := elt(rec.conditionalBranch,elseClause)$COND - not(operation(elseBranch) case Null) => - operation(elseBranch) case Conditional => - APPEND(expr,getElseIf elseBranch)$Lisp - expr := APPEND(expr, getStatement(ELSE::O,NIL$Lisp)$Lisp)$Lisp - expr := APPEND(expr, getBody elseBranch)$Lisp - expr - - getContinue(label:SingleInteger):SEX == - lab : O := label::O - if (width(lab) > 6) then error "Label too big" - cnt : O := "CONTINUE"::O - --sp : O := hspace(6-width lab) - sp : O := hspace(_$fortIndent$Lisp -width lab) - LIST(STRCONC(STRINGIMAGE(lab)$Lisp,sp,cnt)$Lisp)$Lisp - - getGoto(label:SingleInteger):SEX == - fortran2Lines( - LIST(STRCONC("GOTO ",STRINGIMAGE(label::O)$Lisp)$Lisp)$Lisp)$Lisp - - getRepeat(repRec:LOOP):SEX == - sw : Switch := NOT elt(repRec,switch)$LOOP - lab := newLabel() - bod := elt(repRec,body)$LOOP - APPEND(getContinue lab,getBody bod, - fortFormatIfGoto(sw::O,lab)$Lisp)$Lisp - - getWhile(whileRec:LOOP):SEX == - sw := NOT elt(whileRec,switch)$LOOP - lab1 := newLabel() - lab2 := newLabel() - bod := elt(whileRec,body)$LOOP - APPEND(fortFormatLabelledIfGoto(sw::O,lab1,lab2)$Lisp, - getBody bod, getBody goto(lab1), getContinue lab2)$Lisp - - getArrayAssign(rec:ARRAYASS):SEX == - getfortarrayexp((rec.var)::O,rec.rand,rec.ints2Floats?)$Lisp - - getAssign(rec:ASS):SEX == - indices : L PIN := elt(rec,arrayIndex)$ASS - if indices = []::(L PIN) then - lhs := elt(rec,var)$ASS::O - else - lhs := cons(elt(rec,var)$ASS::PIN,indices)::O - -- Must get the index brackets correct: - lhs := (cdr car cdr convert(lhs)$SEX::SEX)::O -- Yuck! - elt(elt(rec,rand)$ASS,ints2Floats?)$EXPRESSION => - assignment2Fortran1(lhs,elt(elt(rec,rand)$ASS,expr)$EXPRESSION)$Lisp - integerAssignment2Fortran1(lhs,elt(elt(rec,rand)$ASS,expr)$EXPRESSION)$Lisp - - getCond(rec:COND):SEX == - expr := APPEND(fortFormatIf(elt(rec,switch)$COND::O)$Lisp, - getBody elt(rec,thenClause)$COND)$Lisp - elseBranch := elt(rec,elseClause)$COND - if not(operation(elseBranch) case Null) then - operation(elseBranch) case Conditional => - expr := APPEND(expr,getElseIf elseBranch)$Lisp - expr := APPEND(expr,getStatement(ELSE::O,NIL$Lisp)$Lisp, - getBody elseBranch)$Lisp - APPEND(expr,getStatement(ENDIF::O,NIL$Lisp)$Lisp)$Lisp - - getComment(rec:COMMENT):SEX == - convert([convert(concat("C ",c)$String)@SEX for c in rec])@SEX - - getCall(rec:CALL):SEX == - expr := concat("CALL ",rec)$String - #expr > 1320 => error "Fortran CALL too large" - fortran2Lines(convert([convert(expr)@SEX ])@SEX)$Lisp - - getFor(rec:FOR):SEX == - rnge : SegmentBinding PIN := elt(rec,range)$FOR - increment : PIN := elt(rec,span)$FOR - lab : SingleInteger := newLabel() - declare!(variable rnge,fortranInteger()) - expr := fortFormatDo(variable rnge, (lo segment rnge)::O,_ - (hi segment rnge)::O,increment::O,lab)$Lisp - APPEND(expr, getBody elt(rec,body)$FOR, getContinue(lab))$Lisp - - getCode(f:$):SEX == - opp:OP := operation f - rec:OPREC:= code f - opp case Assignment => getAssign(rec.assignmentBranch) - opp case ArrayAssignment => getArrayAssign(rec.arrayAssignmentBranch) - opp case Conditional => getCond(rec.conditionalBranch) - opp case Return => getReturn(rec.returnBranch) - opp case Block => getBlock(rec.blockBranch) - opp case Comment => getComment(rec.commentBranch) - opp case Call => getCall(rec.callBranch) - opp case For => getFor(rec.forBranch) - opp case Continue => getContinue(rec.labelBranch) - opp case Goto => getGoto(rec.labelBranch) - opp case Repeat => getRepeat(rec.loopBranch) - opp case While => getWhile(rec.loopBranch) - opp case Save => getSave() - opp case Stop => getStop() - opp case Print => getPrint(rec.printBranch) - opp case Common => getCommon(rec.commonBranch) - error "Unsupported program construct." - convert(0)@SEX - - printCode(f:$):Void == - displayLines1$Lisp getCode f - void()$Void - - code (f:$):OPREC == - elt(f,data)$Rep - - operation (f:$):OP == - elt(f,op)$Rep - - common(name:Symbol,contents:List Symbol):$ == - [["common"]$OP,[[name,contents]$COMMON]$OPREC]$Rep - - stop():$ == - [["stop"]$OP,["null"]$OPREC]$Rep - - save():$ == - [["save"]$OP,["null"]$OPREC]$Rep - - printStatement(l:List O):$ == - [["print"]$OP,[l]$OPREC]$Rep - - comment(s:List String):$ == - [["comment"]$OP,[s]$OPREC]$Rep - - comment(s:String):$ == - [["comment"]$OP,[list s]$OPREC]$Rep - - forLoop(r:SegmentBinding PIN,body:$):$ == - [["for"]$OP,[[r,(incr segment r)::PIN,body]$FOR]$OPREC]$Rep - - forLoop(r:SegmentBinding PIN,increment:PIN,body:$):$ == - [["for"]$OP,[[r,increment,body]$FOR]$OPREC]$Rep - - goto(l:SingleInteger):$ == - [["goto"]$OP,[l]$OPREC]$Rep - - continue(l:SingleInteger):$ == - [["continue"]$OP,[l]$OPREC]$Rep - - whileLoop(sw:Switch,b:$):$ == - [["while"]$OP,[[sw,b]$LOOP]$OPREC]$Rep - - repeatUntilLoop(sw:Switch,b:$):$ == - [["repeat"]$OP,[[sw,b]$LOOP]$OPREC]$Rep - - returns():$ == - v := [false,0::O]$EXPRESSION - [["return"]$OP,[[true,v]$RETURN]$OPREC]$Rep - - returns(v:Expression MachineInteger):$ == - [["return"]$OP,[[false,[false,v::O]$EXPRESSION]$RETURN]$OPREC]$Rep - - returns(v:Expression MachineFloat):$ == - [["return"]$OP,[[false,[false,v::O]$EXPRESSION]$RETURN]$OPREC]$Rep - - returns(v:Expression MachineComplex):$ == - [["return"]$OP,[[false,[false,v::O]$EXPRESSION]$RETURN]$OPREC]$Rep - - returns(v:Expression Integer):$ == - [["return"]$OP,[[false,[false,v::O]$EXPRESSION]$RETURN]$OPREC]$Rep - - returns(v:Expression Float):$ == - [["return"]$OP,[[false,[false,v::O]$EXPRESSION]$RETURN]$OPREC]$Rep - - returns(v:Expression Complex Float):$ == - [["return"]$OP,[[false,[false,v::O]$EXPRESSION]$RETURN]$OPREC]$Rep - - block(l:List $):$ == - [["block"]$OP,[l]$OPREC]$Rep - - cond(sw:Switch,thenC:$):$ == - [["conditional"]$OP, - [[sw,thenC,[["null"]$OP,["null"]$OPREC]$Rep]$COND]$OPREC]$Rep - - cond(sw:Switch,thenC:$,elseC:$):$ == - [["conditional"]$OP,[[sw,thenC,elseC]$COND]$OPREC]$Rep - - coerce(f : $):O == - (f.op)::O - - assign(v:Symbol,rhs:String):$ == - [["assignment"]$OP,[[v,nil()::L PIN,[false,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep - - assign(v:Symbol,rhs:Matrix MachineInteger):$ == - [["arrayAssignment"]$OP,[[v,rhs::O,false]$ARRAYASS]$OPREC]$Rep - - assign(v:Symbol,rhs:Matrix MachineFloat):$ == - [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep - - assign(v:Symbol,rhs:Matrix MachineComplex):$ == - [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep - - assign(v:Symbol,rhs:Vector MachineInteger):$ == - [["arrayAssignment"]$OP,[[v,rhs::O,false]$ARRAYASS]$OPREC]$Rep - - assign(v:Symbol,rhs:Vector MachineFloat):$ == - [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep - - assign(v:Symbol,rhs:Vector MachineComplex):$ == - [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep - - assign(v:Symbol,rhs:Matrix Expression MachineInteger):$ == - [["arrayAssignment"]$OP,[[v,rhs::O,false]$ARRAYASS]$OPREC]$Rep - - assign(v:Symbol,rhs:Matrix Expression MachineFloat):$ == - [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep - - assign(v:Symbol,rhs:Matrix Expression MachineComplex):$ == - [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep - - assign(v:Symbol,rhs:Vector Expression MachineInteger):$ == - [["arrayAssignment"]$OP,[[v,rhs::O,false]$ARRAYASS]$OPREC]$Rep - - assign(v:Symbol,rhs:Vector Expression MachineFloat):$ == - [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep - - assign(v:Symbol,rhs:Vector Expression MachineComplex):$ == - [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep - - assign(v:Symbol,index:L PIN,rhs:Expression MachineInteger):$ == - [["assignment"]$OP,[[v,index,[false,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep - - assign(v:Symbol,index:L PIN,rhs:Expression MachineFloat):$ == - [["assignment"]$OP,[[v,index,[true,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep - - assign(v:Symbol,index:L PIN,rhs:Expression MachineComplex):$ == - [["assignment"]$OP,[[v,index,[true,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep - - assign(v:Symbol,rhs:Expression MachineInteger):$ == - [["assignment"]$OP,[[v,nil()::L PIN,[false,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep - - assign(v:Symbol,rhs:Expression MachineFloat):$ == - [["assignment"]$OP,[[v,nil()::L PIN,[true,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep - - assign(v:Symbol,rhs:Expression MachineComplex):$ == - [["assignment"]$OP,[[v,nil()::L PIN,[true,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep - - assign(v:Symbol,rhs:Matrix Expression Integer):$ == - [["arrayAssignment"]$OP,[[v,rhs::O,false]$ARRAYASS]$OPREC]$Rep - - assign(v:Symbol,rhs:Matrix Expression Float):$ == - [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep - - assign(v:Symbol,rhs:Matrix Expression Complex Float):$ == - [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep - - assign(v:Symbol,rhs:Vector Expression Integer):$ == - [["arrayAssignment"]$OP,[[v,rhs::O,false]$ARRAYASS]$OPREC]$Rep - - assign(v:Symbol,rhs:Vector Expression Float):$ == - [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep - - assign(v:Symbol,rhs:Vector Expression Complex Float):$ == - [["arrayAssignment"]$OP,[[v,rhs::O,true]$ARRAYASS]$OPREC]$Rep - - assign(v:Symbol,index:L PIN,rhs:Expression Integer):$ == - [["assignment"]$OP,[[v,index,[false,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep - - assign(v:Symbol,index:L PIN,rhs:Expression Float):$ == - [["assignment"]$OP,[[v,index,[true,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep - - assign(v:Symbol,index:L PIN,rhs:Expression Complex Float):$ == - [["assignment"]$OP,[[v,index,[true,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep - - assign(v:Symbol,rhs:Expression Integer):$ == - [["assignment"]$OP,[[v,nil()::L PIN,[false,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep - - assign(v:Symbol,rhs:Expression Float):$ == - [["assignment"]$OP,[[v,nil()::L PIN,[true,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep - - assign(v:Symbol,rhs:Expression Complex Float):$ == - [["assignment"]$OP,[[v,nil()::L PIN,[true,rhs::O]$EXPRESSION]$ASS]$OPREC]$Rep - - call(s:String):$ == - [["call"]$OP,[s]$OPREC]$Rep - -@ -\section{domain FORTRAN FortranProgram} -<>= -)abbrev domain FORTRAN FortranProgram -++ Author: Mike Dewar -++ Date Created: October 1992 -++ Date Last Updated: 13 January 1994 -++ 23 January 1995 Added support for intrinsic functions -++ Basic Operations: -++ Related Constructors: FortranType, FortranCode, Switch -++ Also See: -++ AMS Classifications: -++ Keywords: -++ References: -++ Description: \axiomType{FortranProgram} allows the user to build and manipulate simple -++ models of FORTRAN subprograms. These can then be transformed into actual FORTRAN -++ notation. -FortranProgram(name,returnType,arguments,symbols): Exports == Implement where - name : Symbol - returnType : Union(fst:FortranScalarType,void:"void") - arguments : List Symbol - symbols : SymbolTable - - FC ==> FortranCode - EXPR ==> Expression - INT ==> Integer - CMPX ==> Complex - MINT ==> MachineInteger - MFLOAT ==> MachineFloat - MCMPLX ==> MachineComplex - REP ==> Record(localSymbols : SymbolTable, code : List FortranCode) - - Exports ==> FortranProgramCategory with - coerce : FortranCode -> $ - ++ coerce(fc) \undocumented{} - coerce : List FortranCode -> $ - ++ coerce(lfc) \undocumented{} - coerce : REP -> $ - ++ coerce(r) \undocumented{} - coerce : EXPR MINT -> $ - ++ coerce(e) \undocumented{} - coerce : EXPR MFLOAT -> $ - ++ coerce(e) \undocumented{} - coerce : EXPR MCMPLX -> $ - ++ coerce(e) \undocumented{} - coerce : Equation EXPR MINT -> $ - ++ coerce(eq) \undocumented{} - coerce : Equation EXPR MFLOAT -> $ - ++ coerce(eq) \undocumented{} - coerce : Equation EXPR MCMPLX -> $ - ++ coerce(eq) \undocumented{} - coerce : EXPR INT -> $ - ++ coerce(e) \undocumented{} - coerce : EXPR Float -> $ - ++ coerce(e) \undocumented{} - coerce : EXPR CMPX Float -> $ - ++ coerce(e) \undocumented{} - coerce : Equation EXPR INT -> $ - ++ coerce(eq) \undocumented{} - coerce : Equation EXPR Float -> $ - ++ coerce(eq) \undocumented{} - coerce : Equation EXPR CMPX Float -> $ - ++ coerce(eq) \undocumented{} - - Implement ==> add - - Rep := REP - - import SExpression - import TheSymbolTable - import FortranCode - - makeRep(b:List FortranCode):$ == - construct(empty()$SymbolTable,b)$REP - - codeFrom(u:$):List FortranCode == - elt(u::Rep,code)$REP - - outputAsFortran(p:$):Void == - setLabelValue(25000::SingleInteger)$FC - -- Do this first to catch any extra type declarations: - tempName := "FPTEMP"::Symbol - newSubProgram(tempName) - initialiseIntrinsicList()$Lisp - body : List SExpression := [getCode(l)$FortranCode for l in codeFrom(p)] - intrinsics : SExpression := getIntrinsicList()$Lisp - endSubProgram() - fortFormatHead(returnType::OutputForm, name::OutputForm, _ - arguments::OutputForm)$Lisp - printTypes(symbols)$SymbolTable - printTypes((p::Rep).localSymbols)$SymbolTable - printTypes(tempName)$TheSymbolTable - fortFormatIntrinsics(intrinsics)$Lisp - clearTheSymbolTable(tempName) - for expr in body repeat displayLines1(expr)$Lisp - dispStatement(END::OutputForm)$Lisp - void()$Void - - mkString(l:List Symbol):String == - unparse(convert(l::OutputForm)@InputForm)$InputForm - - checkVariables(user:List Symbol,target:List Symbol):Void == - -- We don't worry about whether the user has subscripted the - -- variables or not. - setDifference(map(name$Symbol,user),target) ^= empty()$List(Symbol) => - s1 : String := mkString(user) - s2 : String := mkString(target) - error ["Incompatible variable lists:", s1, s2] - void()$Void - - coerce(u:EXPR MINT) : $ == - checkVariables(variables(u)$EXPR(MINT),arguments) - l : List(FC) := [assign(name,u)$FC,returns()$FC] - makeRep l - - coerce(u:Equation EXPR MINT) : $ == - retractIfCan(lhs u)@Union(Kernel(EXPR MINT),"failed") case "failed" => - error "left hand side is not a kernel" - vList : List Symbol := variables lhs u - #vList ^= #arguments => - error "Incorrect number of arguments" - veList : List EXPR MINT := [w::EXPR(MINT) for w in vList] - aeList : List EXPR MINT := [w::EXPR(MINT) for w in arguments] - eList : List Equation EXPR MINT := - [equation(w,v) for w in veList for v in aeList] - (subst(rhs u,eList))::$ - - coerce(u:EXPR MFLOAT) : $ == - checkVariables(variables(u)$EXPR(MFLOAT),arguments) - l : List(FC) := [assign(name,u)$FC,returns()$FC] - makeRep l - - coerce(u:Equation EXPR MFLOAT) : $ == - retractIfCan(lhs u)@Union(Kernel(EXPR MFLOAT),"failed") case "failed" => - error "left hand side is not a kernel" - vList : List Symbol := variables lhs u - #vList ^= #arguments => - error "Incorrect number of arguments" - veList : List EXPR MFLOAT := [w::EXPR(MFLOAT) for w in vList] - aeList : List EXPR MFLOAT := [w::EXPR(MFLOAT) for w in arguments] - eList : List Equation EXPR MFLOAT := - [equation(w,v) for w in veList for v in aeList] - (subst(rhs u,eList))::$ - - coerce(u:EXPR MCMPLX) : $ == - checkVariables(variables(u)$EXPR(MCMPLX),arguments) - l : List(FC) := [assign(name,u)$FC,returns()$FC] - makeRep l - - coerce(u:Equation EXPR MCMPLX) : $ == - retractIfCan(lhs u)@Union(Kernel EXPR MCMPLX,"failed") case "failed"=> - error "left hand side is not a kernel" - vList : List Symbol := variables lhs u - #vList ^= #arguments => - error "Incorrect number of arguments" - veList : List EXPR MCMPLX := [w::EXPR(MCMPLX) for w in vList] - aeList : List EXPR MCMPLX := [w::EXPR(MCMPLX) for w in arguments] - eList : List Equation EXPR MCMPLX := - [equation(w,v) for w in veList for v in aeList] - (subst(rhs u,eList))::$ - - - coerce(u:REP):$ == - u@Rep - - coerce(u:$):OutputForm == - coerce(name)$Symbol - - coerce(c:List FortranCode):$ == - makeRep c - - coerce(c:FortranCode):$ == - makeRep [c] - - coerce(u:EXPR INT) : $ == - checkVariables(variables(u)$EXPR(INT),arguments) - l : List(FC) := [assign(name,u)$FC,returns()$FC] - makeRep l - - coerce(u:Equation EXPR INT) : $ == - retractIfCan(lhs u)@Union(Kernel(EXPR INT),"failed") case "failed" => - error "left hand side is not a kernel" - vList : List Symbol := variables lhs u - #vList ^= #arguments => - error "Incorrect number of arguments" - veList : List EXPR INT := [w::EXPR(INT) for w in vList] - aeList : List EXPR INT := [w::EXPR(INT) for w in arguments] - eList : List Equation EXPR INT := - [equation(w,v) for w in veList for v in aeList] - (subst(rhs u,eList))::$ - - coerce(u:EXPR Float) : $ == - checkVariables(variables(u)$EXPR(Float),arguments) - l : List(FC) := [assign(name,u)$FC,returns()$FC] - makeRep l - - coerce(u:Equation EXPR Float) : $ == - retractIfCan(lhs u)@Union(Kernel(EXPR Float),"failed") case "failed" => - error "left hand side is not a kernel" - vList : List Symbol := variables lhs u - #vList ^= #arguments => - error "Incorrect number of arguments" - veList : List EXPR Float := [w::EXPR(Float) for w in vList] - aeList : List EXPR Float := [w::EXPR(Float) for w in arguments] - eList : List Equation EXPR Float := - [equation(w,v) for w in veList for v in aeList] - (subst(rhs u,eList))::$ - - coerce(u:EXPR Complex Float) : $ == - checkVariables(variables(u)$EXPR(Complex Float),arguments) - l : List(FC) := [assign(name,u)$FC,returns()$FC] - makeRep l - - coerce(u:Equation EXPR CMPX Float) : $ == - retractIfCan(lhs u)@Union(Kernel EXPR CMPX Float,"failed") case "failed"=> - error "left hand side is not a kernel" - vList : List Symbol := variables lhs u - #vList ^= #arguments => - error "Incorrect number of arguments" - veList : List EXPR CMPX Float := [w::EXPR(CMPX Float) for w in vList] - aeList : List EXPR CMPX Float := [w::EXPR(CMPX Float) for w in arguments] - eList : List Equation EXPR CMPX Float := - [equation(w,v) for w in veList for v in aeList] - (subst(rhs u,eList))::$ - -@ -\section{domain M3D ThreeDimensionalMatrix} -<>= -)abbrev domain M3D ThreeDimensionalMatrix -++ Author: William Naylor -++ Date Created: 20 October 1993 -++ Date Last Updated: 20 May 1994 -++ BasicFunctions: -++ Related Constructors: Matrix -++ Also See: PrimitiveArray -++ AMS Classification: -++ Keywords: -++ References: -++ Description: -++ This domain represents three dimensional matrices over a general object type -ThreeDimensionalMatrix(R) : Exports == Implementation where - - R : SetCategory - L ==> List - NNI ==> NonNegativeInteger - A1AGG ==> OneDimensionalArrayAggregate - ARRAY1 ==> OneDimensionalArray - PA ==> PrimitiveArray - INT ==> Integer - PI ==> PositiveInteger - - Exports ==> HomogeneousAggregate(R) with - - if R has Ring then - zeroMatrix : (NNI,NNI,NNI) -> $ - ++ zeroMatrix(i,j,k) create a matrix with all zero terms - identityMatrix : (NNI) -> $ - ++ identityMatrix(n) create an identity matrix - ++ we note that this must be square - plus : ($,$) -> $ - ++ plus(x,y) adds two matrices, term by term - ++ we note that they must be the same size - construct : (L L L R) -> $ - ++ construct(lll) creates a 3-D matrix from a List List List R lll - elt : ($,NNI,NNI,NNI) -> R - ++ elt(x,i,j,k) extract an element from the matrix x - setelt! :($,NNI,NNI,NNI,R) -> R - ++ setelt!(x,i,j,k,s) (or x.i.j.k:=s) sets a specific element of the array to some value of type R - coerce : (PA PA PA R) -> $ - ++ coerce(p) moves from the representation type - ++ (PrimitiveArray PrimitiveArray PrimitiveArray R) - ++ to the domain - coerce : $ -> (PA PA PA R) - ++ coerce(x) moves from the domain to the representation type - matrixConcat3D : (Symbol,$,$) -> $ - ++ matrixConcat3D(s,x,y) concatenates two 3-D matrices along a specified axis - matrixDimensions : $ -> Vector NNI - ++ matrixDimensions(x) returns the dimensions of a matrix - - Implementation ==> (PA PA PA R) add - - import (PA PA PA R) - import (PA PA R) - import (PA R) - import R - - matrix1,matrix2,resultMatrix : $ - - -- function to concatenate two matrices - -- the first argument must be a symbol, which is either i,j or k - -- to specify the direction in which the concatenation is to take place - matrixConcat3D(dir : Symbol,mat1 : $,mat2 : $) : $ == - ^((dir = (i::Symbol)) or (dir = (j::Symbol)) or (dir = (k::Symbol)))_ - => error "the axis of concatenation must be i,j or k" - mat1Dim := matrixDimensions(mat1) - mat2Dim := matrixDimensions(mat2) - iDim1 := mat1Dim.1 - jDim1 := mat1Dim.2 - kDim1 := mat1Dim.3 - iDim2 := mat2Dim.1 - jDim2 := mat2Dim.2 - kDim2 := mat2Dim.3 - matRep1 : (PA PA PA R) := copy(mat1 :: (PA PA PA R))$(PA PA PA R) - matRep2 : (PA PA PA R) := copy(mat2 :: (PA PA PA R))$(PA PA PA R) - retVal : $ - - if (dir = (i::Symbol)) then - -- j,k dimensions must agree - if (^((jDim1 = jDim2) and (kDim1=kDim2))) - then - error "jxk do not agree" - else - retVal := (coerce(concat(matRep1,matRep2)$(PA PA PA R))$$)@$ - - if (dir = (j::Symbol)) then - -- i,k dimensions must agree - if (^((iDim1 = iDim2) and (kDim1=kDim2))) - then - error "ixk do not agree" - else - for i in 0..(iDim1-1) repeat - setelt(matRep1,i,(concat(elt(matRep1,i)$(PA PA PA R)_ - ,elt(matRep2,i)$(PA PA PA R))$(PA PA R))@(PA PA R))$(PA PA PA R) - retVal := (coerce(matRep1)$$)@$ - - if (dir = (k::Symbol)) then - temp : (PA PA R) - -- i,j dimensions must agree - if (^((iDim1 = iDim2) and (jDim1=jDim2))) - then - error "ixj do not agree" - else - for i in 0..(iDim1-1) repeat - temp := copy(elt(matRep1,i)$(PA PA PA R))$(PA PA R) - for j in 0..(jDim1-1) repeat - setelt(temp,j,concat(elt(elt(matRep1,i)$(PA PA PA R)_ - ,j)$(PA PA R),elt(elt(matRep2,i)$(PA PA PA R),j)$(PA PA R)_ - )$(PA R))$(PA PA R) - setelt(matRep1,i,temp)$(PA PA PA R) - retVal := (coerce(matRep1)$$)@$ - - retVal - - matrixDimensions(mat : $) : Vector NNI == - matRep : (PA PA PA R) := mat :: (PA PA PA R) - iDim : NNI := (#matRep)$(PA PA PA R) - matRep2 : PA PA R := elt(matRep,0)$(PA PA PA R) - jDim : NNI := (#matRep2)$(PA PA R) - matRep3 : (PA R) := elt(matRep2,0)$(PA PA R) - kDim : NNI := (#matRep3)$(PA R) - retVal : Vector NNI := new(3,0)$(Vector NNI) - retVal.1 := iDim - retVal.2 := jDim - retVal.3 := kDim - retVal - - coerce(matrixRep : (PA PA PA R)) : $ == matrixRep pretend $ - - coerce(mat : $) : (PA PA PA R) == mat pretend (PA PA PA R) - - -- i,j,k must be with in the bounds of the matrix - elt(mat : $,i : NNI,j : NNI,k : NNI) : R == - matDims := matrixDimensions(mat) - iLength := matDims.1 - jLength := matDims.2 - kLength := matDims.3 - ((i > iLength) or (j > jLength) or (k > kLength) or (i=0) or (j=0) or_ -(k=0)) => error "coordinates must be within the bounds of the matrix" - matrixRep : PA PA PA R := mat :: (PA PA PA R) - elt(elt(elt(matrixRep,i-1)$(PA PA PA R),j-1)$(PA PA R),k-1)$(PA R) - - setelt!(mat : $,i : NNI,j : NNI,k : NNI,val : R)_ - : R == - matDims := matrixDimensions(mat) - iLength := matDims.1 - jLength := matDims.2 - kLength := matDims.3 - ((i > iLength) or (j > jLength) or (k > kLength) or (i=0) or (j=0) or_ -(k=0)) => error "coordinates must be within the bounds of the matrix" - matrixRep : PA PA PA R := mat :: (PA PA PA R) - row2 : PA PA R := copy(elt(matrixRep,i-1)$(PA PA PA R))$(PA PA R) - row1 : PA R := copy(elt(row2,j-1)$(PA PA R))$(PA R) - setelt(row1,k-1,val)$(PA R) - setelt(row2,j-1,row1)$(PA PA R) - setelt(matrixRep,i-1,row2)$(PA PA PA R) - val - - if R has Ring then - zeroMatrix(iLength:NNI,jLength:NNI,kLength:NNI) : $ == - (new(iLength,new(jLength,new(kLength,(0$R))$(PA R))$(PA PA R))$(PA PA PA R)) :: $ - - identityMatrix(iLength:NNI) : $ == - retValueRep : PA PA PA R := zeroMatrix(iLength,iLength,iLength)$$ :: (PA PA PA R) - row1 : PA R - row2 : PA PA R - row1empty : PA R := new(iLength,0$R)$(PA R) - row2empty : PA PA R := new(iLength,copy(row1empty)$(PA R))$(PA PA R) - for count in 0..(iLength-1) repeat - row1 := copy(row1empty)$(PA R) - setelt(row1,count,1$R)$(PA R) - row2 := copy(row2empty)$(PA PA R) - setelt(row2,count,copy(row1)$(PA R))$(PA PA R) - setelt(retValueRep,count,copy(row2)$(PA PA R))$(PA PA PA R) - retValueRep :: $ - - - plus(mat1 : $,mat2 :$) : $ == - - mat1Dims := matrixDimensions(mat1) - iLength1 := mat1Dims.1 - jLength1 := mat1Dims.2 - kLength1 := mat1Dims.3 - - mat2Dims := matrixDimensions(mat2) - iLength2 := mat2Dims.1 - jLength2 := mat2Dims.2 - kLength2 := mat2Dims.3 - - -- check that the dimensions are the same - (^(iLength1 = iLength2) or ^(jLength1 = jLength2) or ^(kLength1 = kLength2))_ - => error "error the matrices are different sizes" - - sum : R - row1 : (PA R) := new(kLength1,0$R)$(PA R) - row2 : (PA PA R) := new(jLength1,copy(row1)$(PA R))$(PA PA R) - row3 : (PA PA PA R) := new(iLength1,copy(row2)$(PA PA R))$(PA PA PA R) - - for i in 1..iLength1 repeat - for j in 1..jLength1 repeat - for k in 1..kLength1 repeat - sum := (elt(mat1,i,j,k)::R +$R_ - elt(mat2,i,j,k)::R) - setelt(row1,k-1,sum)$(PA R) - setelt(row2,j-1,copy(row1)$(PA R))$(PA PA R) - setelt(row3,i-1,copy(row2)$(PA PA R))$(PA PA PA R) - - resultMatrix := (row3 pretend $) - - resultMatrix - - construct(listRep : L L L R) : $ == - - (#listRep)$(L L L R) = 0 => error "empty list" - (#(listRep.1))$(L L R) = 0 => error "empty list" - (#((listRep.1).1))$(L R) = 0 => error "empty list" - iLength := (#listRep)$(L L L R) - jLength := (#(listRep.1))$(L L R) - kLength := (#((listRep.1).1))$(L R) - - --first check that the matrix is in the correct form - for subList in listRep repeat - ^((#subList)$(L L R) = jLength) => error_ - "can not have an irregular shaped matrix" - for subSubList in subList repeat - ^((#(subSubList))$(L R) = kLength) => error_ - "can not have an irregular shaped matrix" - - row1 : (PA R) := new(kLength,((listRep.1).1).1)$(PA R) - row2 : (PA PA R) := new(jLength,copy(row1)$(PA R))$(PA PA R) - row3 : (PA PA PA R) := new(iLength,copy(row2)$(PA PA R))$(PA PA PA R) - - for i in 1..iLength repeat - for j in 1..jLength repeat - for k in 1..kLength repeat - - element := elt(elt(elt(listRep,i)$(L L L R),j)$(L L R),k)$(L R) - setelt(row1,k-1,element)$(PA R) - setelt(row2,j-1,copy(row1)$(PA R))$(PA PA R) - setelt(row3,i-1,copy(row2)$(PA PA R))$(PA PA PA R) - - resultMatrix := (row3 pretend $) - - resultMatrix - -@ -\section{domain SFORT SimpleFortranProgram} -<>= -)abbrev domain SFORT SimpleFortranProgram --- Because of a bug in the compiler: -)bo $noSubsumption:=true - -++ Author: Mike Dewar -++ Date Created: November 1992 -++ Date Last Updated: -++ Basic Operations: -++ Related Constructors: FortranType, FortranCode, Switch -++ Also See: -++ AMS Classifications: -++ Keywords: -++ References: -++ Description: -++ \axiomType{SimpleFortranProgram(f,type)} provides a simple model of some -++ FORTRAN subprograms, making it possible to coerce objects of various -++ domains into a FORTRAN subprogram called \axiom{f}. -++ These can then be translated into legal FORTRAN code. -SimpleFortranProgram(R,FS): Exports == Implementation where - R : OrderedSet - FS : FunctionSpace(R) - - FST ==> FortranScalarType - - Exports ==> FortranProgramCategory with - fortran : (Symbol,FST,FS) -> $ - ++fortran(fname,ftype,body) builds an object of type - ++\axiomType{FortranProgramCategory}. The three arguments specify - ++the name, the type and the body of the program. - - Implementation ==> add - - Rep := Record(name : Symbol, type : FST, body : FS ) - - fortran(fname, ftype, res) == - construct(fname,ftype,res)$Rep - - nameOf(u:$):Symbol == u . name - - typeOf(u:$):Union(FST,"void") == u . type - - bodyOf(u:$):FS == u . body - - argumentsOf(u:$):List Symbol == variables(bodyOf u)$FS - - coerce(u:$):OutputForm == - coerce(nameOf u)$Symbol - - outputAsFortran(u:$):Void == - ftype := (checkType(typeOf(u)::OutputForm)$Lisp)::OutputForm - fname := nameOf(u)::OutputForm - args := argumentsOf(u) - nargs:=args::OutputForm - val := bodyOf(u)::OutputForm - fortFormatHead(ftype,fname,nargs)$Lisp - fortFormatTypes(ftype,args)$Lisp - dispfortexp1$Lisp ["="::OutputForm, fname, val]@List(OutputForm) - dispfortexp1$Lisp "RETURN"::OutputForm - dispfortexp1$Lisp "END"::OutputForm - void()$Void - -@ -\section{domain SWITCH Switch} -<>= -)abbrev domain SWITCH Switch --- Because of a bug in the compiler: -)bo $noSubsumption:=false - -++ Author: Mike Dewar -++ Date Created: April 1991 -++ Date Last Updated: March 1994 -++ 30.6.94 Added coercion from Symbol MCD -++ Basic Operations: -++ Related Constructors: FortranProgram, FortranCode, FortranTypes -++ Also See: -++ AMS Classifications: -++ Keywords: -++ References: -++ Description: -++ This domain builds representations of boolean expressions for use with -++ the \axiomType{FortranCode} domain. -Switch():public == private where - EXPR ==> Union(I:Expression Integer,F:Expression Float, - CF:Expression Complex Float,switch:%) - - public == CoercibleTo OutputForm with - coerce : Symbol -> $ - ++ coerce(s) \undocumented{} - LT : (EXPR,EXPR) -> $ - ++ LT(x,y) returns the \axiomType{Switch} expression representing \spad{x $ - ++ GT(x,y) returns the \axiomType{Switch} expression representing \spad{x>y}. - LE : (EXPR,EXPR) -> $ - ++ LE(x,y) returns the \axiomType{Switch} expression representing \spad{x<=y}. - GE : (EXPR,EXPR) -> $ - ++ GE(x,y) returns the \axiomType{Switch} expression representing \spad{x>=y}. - OR : (EXPR,EXPR) -> $ - ++ OR(x,y) returns the \axiomType{Switch} expression representing \spad{x or y}. - EQ : (EXPR,EXPR) -> $ - ++ EQ(x,y) returns the \axiomType{Switch} expression representing \spad{x = y}. - AND : (EXPR,EXPR) -> $ - ++ AND(x,y) returns the \axiomType{Switch} expression representing \spad{x and y}. - NOT : EXPR -> $ - ++ NOT(x) returns the \axiomType{Switch} expression representing \spad{\~~x}. - NOT : $ -> $ - ++ NOT(x) returns the \axiomType{Switch} expression representing \spad{\~~x}. - - private == add - Rep := Record(op:BasicOperator,rands:List EXPR) - - -- Public function definitions - - nullOp : BasicOperator := operator NULL - - coerce(s:%):OutputForm == - rat := (s . op)::OutputForm - ran := [u::OutputForm for u in s.rands] - (s . op) = nullOp => first ran - #ran = 1 => - prefix(rat,ran) - infix(rat,ran) - - coerce(s:Symbol):$ == [nullOp,[[s::Expression(Integer)]$EXPR]$List(EXPR)]$Rep - - NOT(r:EXPR):% == - [operator("~"::Symbol),[r]$List(EXPR)]$Rep - - NOT(r:%):% == - [operator("~"::Symbol),[[r]$EXPR]$List(EXPR)]$Rep - - LT(r1:EXPR,r2:EXPR):% == - [operator("<"::Symbol),[r1,r2]$List(EXPR)]$Rep - - GT(r1:EXPR,r2:EXPR):% == - [operator(">"::Symbol),[r1,r2]$List(EXPR)]$Rep - - LE(r1:EXPR,r2:EXPR):% == - [operator("<="::Symbol),[r1,r2]$List(EXPR)]$Rep - - GE(r1:EXPR,r2:EXPR):% == - [operator(">="::Symbol),[r1,r2]$List(EXPR)]$Rep - - AND(r1:EXPR,r2:EXPR):% == - [operator("and"::Symbol),[r1,r2]$List(EXPR)]$Rep - - OR(r1:EXPR,r2:EXPR):% == - [operator("or"::Symbol),[r1,r2]$List(EXPR)]$Rep - - EQ(r1:EXPR,r2:EXPR):% == - [operator("EQ"::Symbol),[r1,r2]$List(EXPR)]$Rep - -@ -\section{domain FTEM FortranTemplate} -<>= -)abbrev domain FTEM FortranTemplate -++ Author: Mike Dewar -++ Date Created: October 1992 -++ Date Last Updated: -++ Basic Operations: -++ Related Domains: -++ Also See: -++ AMS Classifications: -++ Keywords: -++ Examples: -++ References: -++ Description: Code to manipulate Fortran templates -FortranTemplate() : specification == implementation where - - specification == FileCategory(FileName, String) with - - processTemplate : (FileName, FileName) -> FileName - ++ processTemplate(tp,fn) processes the template tp, writing the - ++ result out to fn. - processTemplate : (FileName) -> FileName - ++ processTemplate(tp) processes the template tp, writing the - ++ result to the current FORTRAN output stream. - fortranLiteralLine : String -> Void - ++ fortranLiteralLine(s) writes s to the current Fortran output stream, - ++ followed by a carriage return - fortranLiteral : String -> Void - ++ fortranLiteral(s) writes s to the current Fortran output stream - fortranCarriageReturn : () -> Void - ++ fortranCarriageReturn() produces a carriage return on the current - ++ Fortran output stream - - implementation == TextFile add - - import TemplateUtilities - import FortranOutputStackPackage - - Rep := TextFile - - fortranLiteralLine(s:String):Void == - PRINTEXP(s,_$fortranOutputStream$Lisp)$Lisp - TERPRI(_$fortranOutputStream$Lisp)$Lisp - - fortranLiteral(s:String):Void == - PRINTEXP(s,_$fortranOutputStream$Lisp)$Lisp - - fortranCarriageReturn():Void == - TERPRI(_$fortranOutputStream$Lisp)$Lisp - - writePassiveLine!(line:String):Void == - -- We might want to be a bit clever here and look for new SubPrograms etc. - fortranLiteralLine line - - processTemplate(tp:FileName, fn:FileName):FileName == - pushFortranOutputStack(fn) - processTemplate(tp) - popFortranOutputStack() - fn - - getLine(fp:TextFile):String == - line : String := stripCommentsAndBlanks readLine!(fp) - while not empty?(line) and elt(line,maxIndex line) = char "__" repeat - setelt(line,maxIndex line,char " ") - line := concat(line, stripCommentsAndBlanks readLine!(fp))$String - line - - processTemplate(tp:FileName):FileName == - fp : TextFile := open(tp,"input") - active : Boolean := true - line : String - endInput : Boolean := false - while not (endInput or endOfFile? fp) repeat - if active then - line := getLine fp - line = "endInput" => endInput := true - if line = "beginVerbatim" then - active := false - else - not empty? line => interpretString line - else - line := readLine!(fp) - if line = "endVerbatim" then - active := true - else - writePassiveLine! line - close!(fp) - if not active then - error concat(["Missing `endVerbatim' line in ",tp::String])$String - string(_$fortranOutputFile$Lisp)::FileName - -@ -\section{domain FEXPR FortranExpression} -<>= -)abbrev domain FEXPR FortranExpression -++ Author: Mike Dewar -++ Date Created: December 1993 -++ Date Last Updated: 19 May 1994 -++ 7 July 1994 added %power to f77Functions -++ 12 July 1994 added RetractableTo(R) -++ Basic Operations: -++ Related Domains: -++ Also See: FortranMachineTypeCategory, MachineInteger, MachineFloat, -++ MachineComplex -++ AMS Classifications: -++ Keywords: -++ Examples: -++ References: -++ Description: A domain of expressions involving functions which can be -++ translated into standard Fortran-77, with some extra extensions from -++ the NAG Fortran Library. -FortranExpression(basicSymbols,subscriptedSymbols,R): - Exports==Implementation where - basicSymbols : List Symbol - subscriptedSymbols : List Symbol - R : FortranMachineTypeCategory - - EXPR ==> Expression - EXF2 ==> ExpressionFunctions2 - S ==> Symbol - L ==> List - BO ==> BasicOperator - FRAC ==> Fraction - POLY ==> Polynomial - - Exports ==> Join(ExpressionSpace,Algebra(R),RetractableTo(R), - PartialDifferentialRing(Symbol)) with - retract : EXPR R -> $ - ++ retract(e) takes e and transforms it into a - ++ FortranExpression checking that it contains no non-Fortran - ++ functions, and that it only contains the given basic symbols - ++ and subscripted symbols which correspond to scalar and array - ++ parameters respectively. - retractIfCan : EXPR R -> Union($,"failed") - ++ retractIfCan(e) takes e and tries to transform it into a - ++ FortranExpression checking that it contains no non-Fortran - ++ functions, and that it only contains the given basic symbols - ++ and subscripted symbols which correspond to scalar and array - ++ parameters respectively. - retract : S -> $ - ++ retract(e) takes e and transforms it into a FortranExpression - ++ checking that it is one of the given basic symbols - ++ or subscripted symbols which correspond to scalar and array - ++ parameters respectively. - retractIfCan : S -> Union($,"failed") - ++ retractIfCan(e) takes e and tries to transform it into a FortranExpression - ++ checking that it is one of the given basic symbols - ++ or subscripted symbols which correspond to scalar and array - ++ parameters respectively. - coerce : $ -> EXPR R - ++ coerce(x) \undocumented{} - if (R has RetractableTo(Integer)) then - retract : EXPR Integer -> $ - ++ retract(e) takes e and transforms it into a - ++ FortranExpression checking that it contains no non-Fortran - ++ functions, and that it only contains the given basic symbols - ++ and subscripted symbols which correspond to scalar and array - ++ parameters respectively. - retractIfCan : EXPR Integer -> Union($,"failed") - ++ retractIfCan(e) takes e and tries to transform it into a - ++ FortranExpression checking that it contains no non-Fortran - ++ functions, and that it only contains the given basic symbols - ++ and subscripted symbols which correspond to scalar and array - ++ parameters respectively. - retract : FRAC POLY Integer -> $ - ++ retract(e) takes e and transforms it into a - ++ FortranExpression checking that it contains no non-Fortran - ++ functions, and that it only contains the given basic symbols - ++ and subscripted symbols which correspond to scalar and array - ++ parameters respectively. - retractIfCan : FRAC POLY Integer -> Union($,"failed") - ++ retractIfCan(e) takes e and tries to transform it into a - ++ FortranExpression checking that it contains no non-Fortran - ++ functions, and that it only contains the given basic symbols - ++ and subscripted symbols which correspond to scalar and array - ++ parameters respectively. - retract : POLY Integer -> $ - ++ retract(e) takes e and transforms it into a - ++ FortranExpression checking that it contains no non-Fortran - ++ functions, and that it only contains the given basic symbols - ++ and subscripted symbols which correspond to scalar and array - ++ parameters respectively. - retractIfCan : POLY Integer -> Union($,"failed") - ++ retractIfCan(e) takes e and tries to transform it into a - ++ FortranExpression checking that it contains no non-Fortran - ++ functions, and that it only contains the given basic symbols - ++ and subscripted symbols which correspond to scalar and array - ++ parameters respectively. - if (R has RetractableTo(Float)) then - retract : EXPR Float -> $ - ++ retract(e) takes e and transforms it into a - ++ FortranExpression checking that it contains no non-Fortran - ++ functions, and that it only contains the given basic symbols - ++ and subscripted symbols which correspond to scalar and array - ++ parameters respectively. - retractIfCan : EXPR Float -> Union($,"failed") - ++ retractIfCan(e) takes e and tries to transform it into a - ++ FortranExpression checking that it contains no non-Fortran - ++ functions, and that it only contains the given basic symbols - ++ and subscripted symbols which correspond to scalar and array - ++ parameters respectively. - retract : FRAC POLY Float -> $ - ++ retract(e) takes e and transforms it into a - ++ FortranExpression checking that it contains no non-Fortran - ++ functions, and that it only contains the given basic symbols - ++ and subscripted symbols which correspond to scalar and array - ++ parameters respectively. - retractIfCan : FRAC POLY Float -> Union($,"failed") - ++ retractIfCan(e) takes e and tries to transform it into a - ++ FortranExpression checking that it contains no non-Fortran - ++ functions, and that it only contains the given basic symbols - ++ and subscripted symbols which correspond to scalar and array - ++ parameters respectively. - retract : POLY Float -> $ - ++ retract(e) takes e and transforms it into a - ++ FortranExpression checking that it contains no non-Fortran - ++ functions, and that it only contains the given basic symbols - ++ and subscripted symbols which correspond to scalar and array - ++ parameters respectively. - retractIfCan : POLY Float -> Union($,"failed") - ++ retractIfCan(e) takes e and tries to transform it into a - ++ FortranExpression checking that it contains no non-Fortran - ++ functions, and that it only contains the given basic symbols - ++ and subscripted symbols which correspond to scalar and array - ++ parameters respectively. - abs : $ -> $ - ++ abs(x) represents the Fortran intrinsic function ABS - sqrt : $ -> $ - ++ sqrt(x) represents the Fortran intrinsic function SQRT - exp : $ -> $ - ++ exp(x) represents the Fortran intrinsic function EXP - log : $ -> $ - ++ log(x) represents the Fortran intrinsic function LOG - log10 : $ -> $ - ++ log10(x) represents the Fortran intrinsic function LOG10 - sin : $ -> $ - ++ sin(x) represents the Fortran intrinsic function SIN - cos : $ -> $ - ++ cos(x) represents the Fortran intrinsic function COS - tan : $ -> $ - ++ tan(x) represents the Fortran intrinsic function TAN - asin : $ -> $ - ++ asin(x) represents the Fortran intrinsic function ASIN - acos : $ -> $ - ++ acos(x) represents the Fortran intrinsic function ACOS - atan : $ -> $ - ++ atan(x) represents the Fortran intrinsic function ATAN - sinh : $ -> $ - ++ sinh(x) represents the Fortran intrinsic function SINH - cosh : $ -> $ - ++ cosh(x) represents the Fortran intrinsic function COSH - tanh : $ -> $ - ++ tanh(x) represents the Fortran intrinsic function TANH - pi : () -> $ - ++ pi(x) represents the NAG Library function X01AAF which returns - ++ an approximation to the value of pi - variables : $ -> L S - ++ variables(e) return a list of all the variables in \spad{e}. - useNagFunctions : () -> Boolean - ++ useNagFunctions() indicates whether NAG functions are being used - ++ for mathematical and machine constants. - useNagFunctions : Boolean -> Boolean - ++ useNagFunctions(v) sets the flag which controls whether NAG functions - ++ are being used for mathematical and machine constants. The previous - ++ value is returned. - - Implementation ==> EXPR R add - - -- The standard FORTRAN-77 intrinsic functions, plus nthRoot which - -- can be translated into an arithmetic expression: - f77Functions : L S := [abs,sqrt,exp,log,log10,sin,cos,tan,asin,acos, - atan,sinh,cosh,tanh,nthRoot,%power] - nagFunctions : L S := [pi, X01AAF] - useNagFunctionsFlag : Boolean := true - - -- Local functions to check for "unassigned" symbols etc. - - mkEqn(s1:Symbol,s2:Symbol):Equation EXPR(R) == - equation(s2::EXPR(R),script(s1,scripts(s2))::EXPR(R)) - - fixUpSymbols(u:EXPR R):Union(EXPR R,"failed") == - -- If its a univariate expression then just fix it up: - syms : L S := variables(u) --- one?(#basicSymbols) and zero?(#subscriptedSymbols) => - (#basicSymbols = 1) and zero?(#subscriptedSymbols) => --- not one?(#syms) => "failed" - not (#syms = 1) => "failed" - subst(u,equation(first(syms)::EXPR(R),first(basicSymbols)::EXPR(R))) - -- We have one variable but it is subscripted: --- zero?(#basicSymbols) and one?(#subscriptedSymbols) => - zero?(#basicSymbols) and (#subscriptedSymbols = 1) => - -- Make sure we don't have both X and X_i - for s in syms repeat - not scripted?(s) => return "failed" --- not one?(#(syms:=removeDuplicates! [name(s) for s in syms]))=> "failed" - not ((#(syms:=removeDuplicates! [name(s) for s in syms])) = 1)=> "failed" - sym : Symbol := first subscriptedSymbols - subst(u,[mkEqn(sym,i) for i in variables(u)]) - "failed" - - extraSymbols?(u:EXPR R):Boolean == - syms : L S := [name(v) for v in variables(u)] - extras : L S := setDifference(syms, - setUnion(basicSymbols,subscriptedSymbols)) - not empty? extras - - checkSymbols(u:EXPR R):EXPR(R) == - syms : L S := [name(v) for v in variables(u)] - extras : L S := setDifference(syms, - setUnion(basicSymbols,subscriptedSymbols)) - not empty? extras => - m := fixUpSymbols(u) - m case EXPR(R) => m::EXPR(R) - error("Extra symbols detected:",[string(v) for v in extras]$L(String)) - u - - notSymbol?(v:BO):Boolean == - s : S := name v - member?(s,basicSymbols) or - scripted?(s) and member?(name s,subscriptedSymbols) => false - true - - extraOperators?(u:EXPR R):Boolean == - ops : L S := [name v for v in operators(u) | notSymbol?(v)] - if useNagFunctionsFlag then - fortranFunctions : L S := append(f77Functions,nagFunctions) - else - fortranFunctions : L S := f77Functions - extras : L S := setDifference(ops,fortranFunctions) - not empty? extras - - checkOperators(u:EXPR R):Void == - ops : L S := [name v for v in operators(u) | notSymbol?(v)] - if useNagFunctionsFlag then - fortranFunctions : L S := append(f77Functions,nagFunctions) - else - fortranFunctions : L S := f77Functions - extras : L S := setDifference(ops,fortranFunctions) - not empty? extras => - error("Non FORTRAN-77 functions detected:",[string(v) for v in extras]) - void() - - checkForNagOperators(u:EXPR R):$ == - useNagFunctionsFlag => - import Pi - import PiCoercions(R) - piOp : BasicOperator := operator X01AAF - piSub : Equation EXPR R := - equation(pi()$Pi::EXPR(R),kernel(piOp,0::EXPR(R))$EXPR(R)) - subst(u,piSub) pretend $ - u pretend $ - - -- Conditional retractions: - - if R has RetractableTo(Integer) then - - retractIfCan(u:POLY Integer):Union($,"failed") == - retractIfCan((u::EXPR Integer)$EXPR(Integer))@Union($,"failed") - - retract(u:POLY Integer):$ == - retract((u::EXPR Integer)$EXPR(Integer))@$ - - retractIfCan(u:FRAC POLY Integer):Union($,"failed") == - retractIfCan((u::EXPR Integer)$EXPR(Integer))@Union($,"failed") - - retract(u:FRAC POLY Integer):$ == - retract((u::EXPR Integer)$EXPR(Integer))@$ - - int2R(u:Integer):R == u::R - - retractIfCan(u:EXPR Integer):Union($,"failed") == - retractIfCan(map(int2R,u)$EXF2(Integer,R))@Union($,"failed") - - retract(u:EXPR Integer):$ == - retract(map(int2R,u)$EXF2(Integer,R))@$ - - if R has RetractableTo(Float) then - - retractIfCan(u:POLY Float):Union($,"failed") == - retractIfCan((u::EXPR Float)$EXPR(Float))@Union($,"failed") - - retract(u:POLY Float):$ == - retract((u::EXPR Float)$EXPR(Float))@$ - - retractIfCan(u:FRAC POLY Float):Union($,"failed") == - retractIfCan((u::EXPR Float)$EXPR(Float))@Union($,"failed") - - retract(u:FRAC POLY Float):$ == - retract((u::EXPR Float)$EXPR(Float))@$ - - float2R(u:Float):R == (u::R) - - retractIfCan(u:EXPR Float):Union($,"failed") == - retractIfCan(map(float2R,u)$EXF2(Float,R))@Union($,"failed") - - retract(u:EXPR Float):$ == - retract(map(float2R,u)$EXF2(Float,R))@$ - - -- Exported Functions - - useNagFunctions():Boolean == useNagFunctionsFlag - useNagFunctions(v:Boolean):Boolean == - old := useNagFunctionsFlag - useNagFunctionsFlag := v - old - - log10(x:$):$ == - kernel(operator log10,x) - - pi():$ == kernel(operator X01AAF,0) - - coerce(u:$):EXPR R == u pretend EXPR(R) - - retractIfCan(u:EXPR R):Union($,"failed") == - if (extraSymbols? u) then - m := fixUpSymbols(u) - m case "failed" => return "failed" - u := m::EXPR(R) - extraOperators? u => "failed" - checkForNagOperators(u) - - retract(u:EXPR R):$ == - u:=checkSymbols(u) - checkOperators(u) - checkForNagOperators(u) - - retractIfCan(u:Symbol):Union($,"failed") == - not (member?(u,basicSymbols) or - scripted?(u) and member?(name u,subscriptedSymbols)) => "failed" - (((u::EXPR(R))$(EXPR R))pretend Rep)::$ - - retract(u:Symbol):$ == - res : Union($,"failed") := retractIfCan(u) - res case "failed" => error("Illegal Symbol Detected:",u::String) - res::$ - -@ -\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/forttyp.spad.pamphlet b/src/algebra/forttyp.spad.pamphlet deleted file mode 100644 index 334b236..0000000 --- a/src/algebra/forttyp.spad.pamphlet +++ /dev/null @@ -1,703 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra forttyp.spad} -\author{Mike Dewar} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{domain FST FortranScalarType} -<>= -)abbrev domain FST FortranScalarType -++ Author: Mike Dewar -++ Date Created: October 1992 -++ Date Last Updated: -++ Basic Operations: -++ Related Domains: -++ Also See: -++ AMS Classifications: -++ Keywords: -++ Examples: -++ References: -++ Description: Creates and manipulates objects which correspond to the -++ basic FORTRAN data types: REAL, INTEGER, COMPLEX, LOGICAL and CHARACTER -FortranScalarType() : exports == implementation where - - exports == CoercibleTo OutputForm with - coerce : String -> $ - ++ coerce(s) transforms the string s into an element of - ++ FortranScalarType provided s is one of "real", "double precision", - ++ "complex", "logical", "integer", "character", "REAL", - ++ "COMPLEX", "LOGICAL", "INTEGER", "CHARACTER", - ++ "DOUBLE PRECISION" - coerce : Symbol -> $ - ++ coerce(s) transforms the symbol s into an element of - ++ FortranScalarType provided s is one of real, complex,double precision, - ++ logical, integer, character, REAL, COMPLEX, LOGICAL, - ++ INTEGER, CHARACTER, DOUBLE PRECISION - coerce : $ -> Symbol - ++ coerce(x) returns the symbol associated with x - coerce : $ -> SExpression - ++ coerce(x) returns the s-expression associated with x - real? : $ -> Boolean - ++ real?(t) tests whether t is equivalent to the FORTRAN type REAL. - double? : $ -> Boolean - ++ double?(t) tests whether t is equivalent to the FORTRAN type - ++ DOUBLE PRECISION - integer? : $ -> Boolean - ++ integer?(t) tests whether t is equivalent to the FORTRAN type INTEGER. - complex? : $ -> Boolean - ++ complex?(t) tests whether t is equivalent to the FORTRAN type COMPLEX. - doubleComplex? : $ -> Boolean - ++ doubleComplex?(t) tests whether t is equivalent to the (non-standard) - ++ FORTRAN type DOUBLE COMPLEX. - character? : $ -> Boolean - ++ character?(t) tests whether t is equivalent to the FORTRAN type - ++ CHARACTER. - logical? : $ -> Boolean - ++ logical?(t) tests whether t is equivalent to the FORTRAN type LOGICAL. - "=" : ($,$) -> Boolean - ++ x=y tests for equality - - implementation == add - - U == Union(RealThing:"real", - IntegerThing:"integer", - ComplexThing:"complex", - CharacterThing:"character", - LogicalThing:"logical", - DoublePrecisionThing:"double precision", - DoubleComplexThing:"double complex") - Rep := U - - doubleSymbol : Symbol := "double precision"::Symbol - upperDoubleSymbol : Symbol := "DOUBLE PRECISION"::Symbol - doubleComplexSymbol : Symbol := "double complex"::Symbol - upperDoubleComplexSymbol : Symbol := "DOUBLE COMPLEX"::Symbol - - u = v == - u case RealThing and v case RealThing => true - u case IntegerThing and v case IntegerThing => true - u case ComplexThing and v case ComplexThing => true - u case LogicalThing and v case LogicalThing => true - u case CharacterThing and v case CharacterThing => true - u case DoublePrecisionThing and v case DoublePrecisionThing => true - u case DoubleComplexThing and v case DoubleComplexThing => true - false - - coerce(t:$):OutputForm == - t case RealThing => coerce(REAL)$Symbol - t case IntegerThing => coerce(INTEGER)$Symbol - t case ComplexThing => coerce(COMPLEX)$Symbol - t case CharacterThing => coerce(CHARACTER)$Symbol - t case DoublePrecisionThing => coerce(upperDoubleSymbol)$Symbol - t case DoubleComplexThing => coerce(upperDoubleComplexSymbol)$Symbol - coerce(LOGICAL)$Symbol - - coerce(t:$):SExpression == - t case RealThing => convert(real::Symbol)@SExpression - t case IntegerThing => convert(integer::Symbol)@SExpression - t case ComplexThing => convert(complex::Symbol)@SExpression - t case CharacterThing => convert(character::Symbol)@SExpression - t case DoublePrecisionThing => convert(doubleSymbol)@SExpression - t case DoubleComplexThing => convert(doubleComplexSymbol)@SExpression - convert(logical::Symbol)@SExpression - - coerce(t:$):Symbol == - t case RealThing => real::Symbol - t case IntegerThing => integer::Symbol - t case ComplexThing => complex::Symbol - t case CharacterThing => character::Symbol - t case DoublePrecisionThing => doubleSymbol - t case DoublePrecisionThing => doubleComplexSymbol - logical::Symbol - - coerce(s:Symbol):$ == - s = real => ["real"]$Rep - s = REAL => ["real"]$Rep - s = integer => ["integer"]$Rep - s = INTEGER => ["integer"]$Rep - s = complex => ["complex"]$Rep - s = COMPLEX => ["complex"]$Rep - s = character => ["character"]$Rep - s = CHARACTER => ["character"]$Rep - s = logical => ["logical"]$Rep - s = LOGICAL => ["logical"]$Rep - s = doubleSymbol => ["double precision"]$Rep - s = upperDoubleSymbol => ["double precision"]$Rep - s = doubleComplexSymbol => ["double complex"]$Rep - s = upperDoubleCOmplexSymbol => ["double complex"]$Rep - - coerce(s:String):$ == - s = "real" => ["real"]$Rep - s = "integer" => ["integer"]$Rep - s = "complex" => ["complex"]$Rep - s = "character" => ["character"]$Rep - s = "logical" => ["logical"]$Rep - s = "double precision" => ["double precision"]$Rep - s = "double complex" => ["double complex"]$Rep - s = "REAL" => ["real"]$Rep - s = "INTEGER" => ["integer"]$Rep - s = "COMPLEX" => ["complex"]$Rep - s = "CHARACTER" => ["character"]$Rep - s = "LOGICAL" => ["logical"]$Rep - s = "DOUBLE PRECISION" => ["double precision"]$Rep - s = "DOUBLE COMPLEX" => ["double complex"]$Rep - error concat([s," is invalid as a Fortran Type"])$String - - real?(t:$):Boolean == t case RealThing - - double?(t:$):Boolean == t case DoublePrecisionThing - - logical?(t:$):Boolean == t case LogicalThing - - integer?(t:$):Boolean == t case IntegerThing - - character?(t:$):Boolean == t case CharacterThing - - complex?(t:$):Boolean == t case ComplexThing - - doubleComplex?(t:$):Boolean == t case DoubleComplexThing - -@ -\section{domain FT FortranType} -<>= -)abbrev domain FT FortranType -++ Author: Mike Dewar -++ Date Created: October 1992 -++ Date Last Updated: -++ Basic Operations: -++ Related Domains: -++ Also See: -++ AMS Classifications: -++ Keywords: -++ Examples: -++ References: -++ Description: Creates and manipulates objects which correspond to FORTRAN -++ data types, including array dimensions. -FortranType() : exports == implementation where - - FST ==> FortranScalarType - FSTU ==> Union(fst:FST,void:"void") - - exports == SetCategory with - coerce : $ -> OutputForm - ++ coerce(x) provides a printable form for x - coerce : FST -> $ - ++ coerce(t) creates an element from a scalar type - scalarTypeOf : $ -> FSTU - ++ scalarTypeOf(t) returns the FORTRAN data type of t - dimensionsOf : $ -> List Polynomial Integer - ++ dimensionsOf(t) returns the dimensions of t - external? : $ -> Boolean - ++ external?(u) returns true if u is declared to be EXTERNAL - construct : (FSTU,List Symbol,Boolean) -> $ - ++ construct(type,dims) creates an element of FortranType - construct : (FSTU,List Polynomial Integer,Boolean) -> $ - ++ construct(type,dims) creates an element of FortranType - fortranReal : () -> $ - ++ fortranReal() returns REAL, an element of FortranType - fortranDouble : () -> $ - ++ fortranDouble() returns DOUBLE PRECISION, an element of FortranType - fortranInteger : () -> $ - ++ fortranInteger() returns INTEGER, an element of FortranType - fortranLogical : () -> $ - ++ fortranLogical() returns LOGICAL, an element of FortranType - fortranComplex : () -> $ - ++ fortranComplex() returns COMPLEX, an element of FortranType - fortranDoubleComplex: () -> $ - ++ fortranDoubleComplex() returns DOUBLE COMPLEX, an element of - ++ FortranType - fortranCharacter : () -> $ - ++ fortranCharacter() returns CHARACTER, an element of FortranType - - implementation == add - - Dims == List Polynomial Integer - Rep := Record(type : FSTU, dimensions : Dims, external : Boolean) - - coerce(a:$):OutputForm == - t : OutputForm - if external?(a) then - if scalarTypeOf(a) case void then - t := "EXTERNAL"::OutputForm - else - t := blankSeparate(["EXTERNAL"::OutputForm, - coerce(scalarTypeOf a)$FSTU])$OutputForm - else - t := coerce(scalarTypeOf a)$FSTU - empty? dimensionsOf(a) => t - sub(t, - paren([u::OutputForm for u in dimensionsOf(a)])$OutputForm)$OutputForm - - scalarTypeOf(u:$):FSTU == - u.type - - dimensionsOf(u:$):Dims == - u.dimensions - - external?(u:$):Boolean == - u.external - - construct(t:FSTU, d:List Symbol, e:Boolean):$ == - e and not empty? d => error "EXTERNAL objects cannot have dimensions" - not(e) and t case void => error "VOID objects must be EXTERNAL" - construct(t,[l::Polynomial(Integer) for l in d],e)$Rep - - construct(t:FSTU, d:List Polynomial Integer, e:Boolean):$ == - e and not empty? d => error "EXTERNAL objects cannot have dimensions" - not(e) and t case void => error "VOID objects must be EXTERNAL" - construct(t,d,e)$Rep - - coerce(u:FST):$ == - construct([u]$FSTU,[]@List Polynomial Integer,false) - - fortranReal():$ == ("real"::FST)::$ - - fortranDouble():$ == ("double precision"::FST)::$ - - fortranInteger():$ == ("integer"::FST)::$ - - fortranComplex():$ == ("complex"::FST)::$ - - fortranDoubleComplex():$ == ("double complex"::FST)::$ - - fortranCharacter():$ == ("character"::FST)::$ - - fortranLogical():$ == ("logical"::FST)::$ - -@ -\section{domain SYMTAB SymbolTable} -<>= -)abbrev domain SYMTAB SymbolTable -++ Author: Mike Dewar -++ Date Created: October 1992 -++ Date Last Updated: 12 July 1994 -++ Basic Operations: -++ Related Domains: -++ Also See: -++ AMS Classifications: -++ Keywords: -++ Examples: -++ References: -++ Description: Create and manipulate a symbol table for generated FORTRAN code -SymbolTable() : exports == implementation where - - T ==> Union(S:Symbol,P:Polynomial Integer) - TL1 ==> List T - TU ==> Union(name:Symbol,bounds:TL1) - TL ==> List TU - SEX ==> SExpression - OFORM ==> OutputForm - L ==> List - FSTU ==> Union(fst:FortranScalarType,void:"void") - - exports ==> CoercibleTo OutputForm with - coerce : $ -> Table(Symbol,FortranType) - ++ coerce(x) returns a table view of x - empty : () -> $ - ++ empty() returns a new, empty symbol table - declare! : (L Symbol,FortranType,$) -> FortranType - ++ declare!(l,t,tab) creates new entrys in tab, declaring each of l - ++ to be of type t - declare! : (Symbol,FortranType,$) -> FortranType - ++ declare!(u,t,tab) creates a new entry in tab, declaring u to be of - ++ type t - fortranTypeOf : (Symbol,$) -> FortranType - ++ fortranTypeOf(u,tab) returns the type of u in tab - parametersOf: $ -> L Symbol - ++ parametersOf(tab) returns a list of all the symbols declared in tab - typeList : (FortranScalarType,$) -> TL - ++ typeList(t,tab) returns a list of all the objects of type t in tab - externalList : $ -> L Symbol - ++ externalList(tab) returns a list of all the external symbols in tab - typeLists : $ -> L TL - ++ typeLists(tab) returns a list of lists of types of objects in tab - newTypeLists : $ -> SEX - ++ newTypeLists(x) \undocumented - printTypes: $ -> Void - ++ printTypes(tab) produces FORTRAN type declarations from tab, on the - ++ current FORTRAN output stream - symbolTable: L Record(key:Symbol,entry:FortranType) -> $ - ++ symbolTable(l) creates a symbol table from the elements of l. - - implementation ==> add - - Rep := Table(Symbol,FortranType) - - coerce(t:$):OFORM == - coerce(t)$Rep - - coerce(t:$):Table(Symbol,FortranType) == - t pretend Table(Symbol,FortranType) - - symbolTable(l:L Record(key:Symbol,entry:FortranType)):$ == - table(l)$Rep - - empty():$ == - empty()$Rep - - parametersOf(tab:$):L(Symbol) == - keys(tab) - - declare!(name:Symbol,type:FortranType,tab:$):FortranType == - setelt(tab,name,type)$Rep - type - - declare!(names:L Symbol,type:FortranType,tab:$):FortranType == - for name in names repeat setelt(tab,name,type)$Rep - type - - fortranTypeOf(u:Symbol,tab:$):FortranType == - elt(tab,u)$Rep - - externalList(tab:$):L(Symbol) == - [u for u in keys(tab) | external? fortranTypeOf(u,tab)] - - typeList(type:FortranScalarType,tab:$):TL == - scalarList := []@TL - arrayList := []@TL - for u in keys(tab)$Rep repeat - uType : FortranType := fortranTypeOf(u,tab) - sType : FSTU := scalarTypeOf(uType) - if (sType case fst and (sType.fst)=type) then - uDim : TL1 := [[v]$T for v in dimensionsOf(uType)] - if empty? uDim then - scalarList := cons([u]$TU,scalarList) - else - arrayList := cons([cons([u],uDim)$TL1]$TU,arrayList) - -- Scalars come first in case they are integers which are later - -- used as an array dimension. - append(scalarList,arrayList) - - typeList2(type:FortranScalarType,tab:$):TL == - tl := []@TL - symbolType : Symbol := coerce(type)$FortranScalarType - for u in keys(tab)$Rep repeat - uType : FortranType := fortranTypeOf(u,tab) - sType : FSTU := scalarTypeOf(uType) - if (sType case fst and (sType.fst)=type) then - uDim : TL1 := [[v]$T for v in dimensionsOf(uType)] - tl := if empty? uDim then cons([u]$TU,tl) - else cons([cons([u],uDim)$TL1]$TU,tl) - empty? tl => tl - cons([symbolType]$TU,tl) - - updateList(sType:SEX,name:SEX,lDims:SEX,tl:SEX):SEX == - l : SEX := ASSOC(sType,tl)$Lisp - entry : SEX := if null?(lDims) then name else CONS(name,lDims)$Lisp - null?(l) => CONS([sType,entry]$Lisp,tl)$Lisp - RPLACD(l,CONS(entry,cdr l)$Lisp)$Lisp - tl - - newTypeLists(tab:$):SEX == - tl := []$Lisp - for u in keys(tab)$Rep repeat - uType : FortranType := fortranTypeOf(u,tab) - sType : FSTU := scalarTypeOf(uType) - dims : L Polynomial Integer := dimensionsOf uType - lDims : L SEX := [convert(convert(v)@InputForm)@SEX for v in dims] - lType : SEX := if sType case void - then convert(void::Symbol)@SEX - else coerce(sType.fst)$FortranScalarType - tl := updateList(lType,convert(u)@SEX,convert(lDims)@SEX,tl) - tl - - typeLists(tab:$):L(TL) == - fortranTypes := ["real"::FortranScalarType, _ - "double precision"::FortranScalarType, _ - "integer"::FortranScalarType, _ - "complex"::FortranScalarType, _ - "logical"::FortranScalarType, _ - "character"::FortranScalarType]@L(FortranScalarType) - tl := []@L TL - for u in fortranTypes repeat - types : TL := typeList2(u,tab) - if (not null types) then - tl := cons(types,tl)$(L TL) - tl - - oForm2(w:T):OFORM == - w case S => w.S::OFORM - w case P => w.P::OFORM - - oForm(v:TU):OFORM == - v case name => v.name::OFORM - v case bounds => - ll : L OFORM := [oForm2(uu) for uu in v.bounds] - ll :: OFORM - - outForm(t:TL):L OFORM == - [oForm(u) for u in t] - - printTypes(tab:$):Void == - -- It is important that INTEGER is the first element of this - -- list since INTEGER symbols used in type declarations must - -- be declared in advance. - ft := ["integer"::FortranScalarType, _ - "real"::FortranScalarType, _ - "double precision"::FortranScalarType, _ - "complex"::FortranScalarType, _ - "logical"::FortranScalarType, _ - "character"::FortranScalarType]@L(FortranScalarType) - for ty in ft repeat - tl : TL := typeList(ty,tab) - otl : L OFORM := outForm(tl) - fortFormatTypes(ty::OFORM,otl)$Lisp - el : L OFORM := [u::OFORM for u in externalList(tab)] - fortFormatTypes("EXTERNAL"::OFORM,el)$Lisp - void()$Void - -@ -\section{domain SYMS TheSymbolTable} -<>= -)abbrev domain SYMS TheSymbolTable -++ Author: Mike Dewar -++ Date Created: October 1992 -++ Date Last Updated: -++ Basic Operations: -++ Related Domains: -++ Also See: -++ AMS Classifications: -++ Keywords: -++ Examples: -++ References: -++ Description: Creates and manipulates one global symbol table for FORTRAN -++ code generation, containing details of types, dimensions, and argument -++ lists. -TheSymbolTable() : Exports == Implementation where - - S ==> Symbol - FST ==> FortranScalarType - FSTU ==> Union(fst:FST,void:"void") - - Exports == CoercibleTo OutputForm with - showTheSymbolTable : () -> $ - ++ showTheSymbolTable() returns the current symbol table. - clearTheSymbolTable : () -> Void - ++ clearTheSymbolTable() clears the current symbol table. - clearTheSymbolTable : Symbol -> Void - ++ clearTheSymbolTable(x) removes the symbol x from the table - declare! : (Symbol,FortranType,Symbol,$) -> FortranType - ++ declare!(u,t,asp,tab) declares the parameter u of subprogram asp - ++ to have type t in symbol table tab. - declare! : (List Symbol,FortranType,Symbol,$) -> FortranType - ++ declare!(u,t,asp,tab) declares the parameters u of subprogram asp - ++ to have type t in symbol table tab. - declare! : (Symbol,FortranType) -> FortranType - ++ declare!(u,t) declares the parameter u to have type t in the - ++ current level of the symbol table. - declare! : (Symbol,FortranType,Symbol) -> FortranType - ++ declare!(u,t,asp) declares the parameter u to have type t in asp. - newSubProgram : Symbol -> Void - ++ newSubProgram(f) asserts that from now on type declarations are part - ++ of subprogram f. - currentSubProgram : () -> Symbol - ++ currentSubProgram() returns the name of the current subprogram being - ++ processed - endSubProgram : () -> Symbol - ++ endSubProgram() asserts that we are no longer processing the current - ++ subprogram. - argumentList! : (Symbol,List Symbol,$) -> Void - ++ argumentList!(f,l,tab) declares that the argument list for subprogram f - ++ in symbol table tab is l. - argumentList! : (Symbol,List Symbol) -> Void - ++ argumentList!(f,l) declares that the argument list for subprogram f in - ++ the global symbol table is l. - argumentList! : List Symbol -> Void - ++ argumentList!(l) declares that the argument list for the current - ++ subprogram in the global symbol table is l. - returnType! : (Symbol,FSTU,$) -> Void - ++ returnType!(f,t,tab) declares that the return type of subprogram f in - ++ symbol table tab is t. - returnType! : (Symbol,FSTU) -> Void - ++ returnType!(f,t) declares that the return type of subprogram f in - ++ the global symbol table is t. - returnType! : FSTU -> Void - ++ returnType!(t) declares that the return type of he current subprogram - ++ in the global symbol table is t. - printHeader : (Symbol,$) -> Void - ++ printHeader(f,tab) produces the FORTRAN header for subprogram f in - ++ symbol table tab on the current FORTRAN output stream. - printHeader : Symbol -> Void - ++ printHeader(f) produces the FORTRAN header for subprogram f in - ++ the global symbol table on the current FORTRAN output stream. - printHeader : () -> Void - ++ printHeader() produces the FORTRAN header for the current subprogram in - ++ the global symbol table on the current FORTRAN output stream. - printTypes: Symbol -> Void - ++ printTypes(tab) produces FORTRAN type declarations from tab, on the - ++ current FORTRAN output stream - empty : () -> $ - ++ empty() creates a new, empty symbol table. - returnTypeOf : (Symbol,$) -> FSTU - ++ returnTypeOf(f,tab) returns the type of the object returned by f - argumentListOf : (Symbol,$) -> List(Symbol) - ++ argumentListOf(f,tab) returns the argument list of f - symbolTableOf : (Symbol,$) -> SymbolTable - ++ symbolTableOf(f,tab) returns the symbol table of f - - Implementation == add - - Entry : Domain := Record(symtab:SymbolTable, _ - returnType:FSTU, _ - argList:List Symbol) - - Rep := Table(Symbol,Entry) - - -- These are the global variables we want to update: - theSymbolTable : $ := empty()$Rep - currentSubProgramName : Symbol := MAIN - - newEntry():Entry == - construct(empty()$SymbolTable,["void"]$FSTU,[]::List(Symbol))$Entry - - checkIfEntryExists(name:Symbol,tab:$) : Void == - key?(name,tab) => void()$Void - setelt(tab,name,newEntry())$Rep - void()$Void - - returnTypeOf(name:Symbol,tab:$):FSTU == - elt(elt(tab,name)$Rep,returnType)$Entry - - argumentListOf(name:Symbol,tab:$):List(Symbol) == - elt(elt(tab,name)$Rep,argList)$Entry - - symbolTableOf(name:Symbol,tab:$):SymbolTable == - elt(elt(tab,name)$Rep,symtab)$Entry - - coerce(u:$):OutputForm == - coerce(u)$Rep - - showTheSymbolTable():$ == - theSymbolTable - - clearTheSymbolTable():Void == - theSymbolTable := empty()$Rep - void()$Void - - clearTheSymbolTable(u:Symbol):Void == - remove!(u,theSymbolTable)$Rep - void()$Void - - empty():$ == - empty()$Rep - - currentSubProgram():Symbol == - currentSubProgramName - - endSubProgram():Symbol == - -- If we want to support more complex languages then we should keep - -- a list of subprograms / blocks - but for the moment lets stick with - -- Fortran. - currentSubProgramName := MAIN - - newSubProgram(u:Symbol):Void == - setelt(theSymbolTable,u,newEntry())$Rep - currentSubProgramName := u - void()$Void - - argumentList!(u:Symbol,args:List Symbol,symbols:$):Void == - checkIfEntryExists(u,symbols) - setelt(elt(symbols,u)$Rep,argList,args)$Entry - - argumentList!(u:Symbol,args:List Symbol):Void == - argumentList!(u,args,theSymbolTable) - - argumentList!(args:List Symbol):Void == - checkIfEntryExists(currentSubProgramName,theSymbolTable) - setelt(elt(theSymbolTable,currentSubProgramName)$Rep, _ - argList,args)$Entry - - returnType!(u:Symbol,type:FSTU,symbols:$):Void == - checkIfEntryExists(u,symbols) - setelt(elt(symbols,u)$Rep,returnType,type)$Entry - - returnType!(u:Symbol,type:FSTU):Void == - returnType!(u,type,theSymbolTable) - - returnType!(type:FSTU ):Void == - checkIfEntryExists(currentSubProgramName,theSymbolTable) - setelt(elt(theSymbolTable,currentSubProgramName)$Rep, _ - returnType,type)$Entry - - declare!(u:Symbol,type:FortranType):FortranType == - declare!(u,type,currentSubProgramName,theSymbolTable) - - declare!(u:Symbol,type:FortranType,asp:Symbol,symbols:$):FortranType == - checkIfEntryExists(asp,symbols) - declare!(u,type, elt(elt(symbols,asp)$Rep,symtab)$Entry)$SymbolTable - - declare!(u:List Symbol,type:FortranType,asp:Symbol,syms:$):FortranType == - checkIfEntryExists(asp,syms) - declare!(u,type, elt(elt(syms,asp)$Rep,symtab)$Entry)$SymbolTable - - declare!(u:Symbol,type:FortranType,asp:Symbol):FortranType == - checkIfEntryExists(asp,theSymbolTable) - declare!(u,type,elt(elt(theSymbolTable,asp)$Rep,symtab)$Entry)$SymbolTable - - printHeader(u:Symbol,symbols:$):Void == - entry := elt(symbols,u)$Rep - fortFormatHead(elt(entry,returnType)$Entry::OutputForm,u::OutputForm, _ - elt(entry,argList)$Entry::OutputForm)$Lisp - printTypes(elt(entry,symtab)$Entry)$SymbolTable - - printHeader(u:Symbol):Void == - printHeader(u,theSymbolTable) - - printHeader():Void == - printHeader(currentSubProgramName,theSymbolTable) - - printTypes(u:Symbol):Void == - printTypes(elt(elt(theSymbolTable,u)$Rep,symtab)$Entry)$SymbolTable - -@ -\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/fourier.spad.pamphlet b/src/algebra/fourier.spad.pamphlet deleted file mode 100644 index 798723c..0000000 --- a/src/algebra/fourier.spad.pamphlet +++ /dev/null @@ -1,169 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra fourier.spad} -\author{James Davenport} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{domain FCOMP FourierComponent} -<>= -)abbrev domain FCOMP FourierComponent -++ Author: James Davenport -++ Date Created: 17 April 1992 -++ Date Last Updated: 12 June 1992 -++ Basic Functions: -++ Related Constructors: -++ Also See: -++ AMS Classifications: -++ Keywords: -++ References: -++ Description: -FourierComponent(E:OrderedSet): - OrderedSet with - sin: E -> $ - ++ sin(x) makes a sin kernel for use in Fourier series - cos: E -> $ - ++ cos(x) makes a cos kernel for use in Fourier series - sin?: $ -> Boolean - ++ sin?(x) returns true if term is a sin, otherwise false - argument: $ -> E - ++ argument(x) returns the argument of a given sin/cos expressions - == - add - --representations - Rep:=Record(SinIfTrue:Boolean, arg:E) - e:E - x,y:$ - sin e == [true,e] - cos e == [false,e] - sin? x == x.SinIfTrue - argument x == x.arg - coerce(x):OutputForm == - hconcat((if x.SinIfTrue then "sin" else "cos")::OutputForm, - bracket((x.arg)::OutputForm)) - x true - y.arg < x.arg => false - x.SinIfTrue => false - y.SinIfTrue - -@ -\section{domain FSERIES FourierSeries} -<>= -)abbrev domain FSERIES FourierSeries -++ Author: James Davenport -++ Date Created: 17 April 1992 -++ Date Last Updated: -++ Basic Functions: -++ Related Constructors: -++ Also See: -++ AMS Classifications: -++ Keywords: -++ References: -++ Description: -FourierSeries(R:Join(CommutativeRing,Algebra(Fraction Integer)), - E:Join(OrderedSet,AbelianGroup)): - Algebra(R) with - if E has canonical and R has canonical then canonical - coerce: R -> $ - ++ coerce(r) converts coefficients into Fourier Series - coerce: FourierComponent(E) -> $ - ++ coerce(c) converts sin/cos terms into Fourier Series - makeSin: (E,R) -> $ - ++ makeSin(e,r) makes a sin expression with given argument and coefficient - makeCos: (E,R) -> $ - ++ makeCos(e,r) makes a sin expression with given argument and coefficient - == FreeModule(R,FourierComponent(E)) - add - --representations - Term := Record(k:FourierComponent(E),c:R) - Rep := List Term - multiply : (Term,Term) -> $ - w,x1,x2:$ - t1,t2:Term - n:NonNegativeInteger - z:Integer - e:FourierComponent(E) - a:E - r:R - 1 == [[cos 0,1]] - coerce e == - sin? e and zero? argument e => 0 - if argument e < 0 then - not sin? e => e:=cos(- argument e) - return [[sin(- argument e),-1]] - [[e,1]] - multiply(t1,t2) == - r:=(t1.c*t2.c)*(1/2) - s1:=argument t1.k - s2:=argument t2.k - sum:=s1+s2 - diff:=s1-s2 - sin? t1.k => - sin? t2.k => - makeCos(diff,r) + makeCos(sum,-r) - makeSin(sum,r) + makeSin(diff,r) - sin? t2.k => - makeSin(sum,r) + makeSin(diff,r) - makeCos(diff,r) + makeCos(sum,r) - x1*x2 == - null x1 => 0 - null x2 => 0 - +/[+/[multiply(t1,t2) for t2 in x2] for t1 in x1] - makeCos(a,r) == - a<0 => [[cos(-a),r]] - [[cos a,r]] - makeSin(a,r) == - zero? a => [] - a<0 => [[sin(-a),-r]] - [[sin a,r]] - -@ -\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/fparfrac.spad.pamphlet b/src/algebra/fparfrac.spad.pamphlet deleted file mode 100644 index a5ad5b3..0000000 --- a/src/algebra/fparfrac.spad.pamphlet +++ /dev/null @@ -1,706 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra fparfrac.spad} -\author{Manuel Bronstein} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{domain FPARFRAC FullPartialFractionExpansion} -<>= --- fparfrac.spad.pamphlet FullPartialFractionExpansion.input -)spool FullPartialFractionExpansion.output -)set message test on -)set message auto off -)clear all ---S 1 of 16 -Fx := FRAC UP(x, FRAC INT) ---R ---R ---R (1) Fraction UnivariatePolynomial(x,Fraction Integer) ---R Type: Domain ---E 1 - ---S 2 of 16 -f : Fx := 36 / (x**5-2*x**4-2*x**3+4*x**2+x-2) ---R ---R ---R 36 ---R (2) ---------------------------- ---R 5 4 3 2 ---R x - 2x - 2x + 4x + x - 2 ---R Type: Fraction UnivariatePolynomial(x,Fraction Integer) ---E 2 - ---S 3 of 16 -g := fullPartialFraction f ---R ---R ---R 4 4 --+ - 3%A - 6 ---R (3) ----- - ----- + > --------- ---R x - 2 x + 1 --+ 2 ---R 2 (x - %A) ---R %A - 1= 0 ---RType: FullPartialFractionExpansion(Fraction Integer,UnivariatePolynomial(x,Fraction Integer)) ---E 3 - ---S 4 of 16 -g :: Fx ---R ---R ---R 36 ---R (4) ---------------------------- ---R 5 4 3 2 ---R x - 2x - 2x + 4x + x - 2 ---R Type: Fraction UnivariatePolynomial(x,Fraction Integer) ---E 4 - ---S 5 of 16 -g5 := D(g, 5) ---R ---R ---R 480 480 --+ 2160%A + 4320 ---R (5) - -------- + -------- + > ------------- ---R 6 6 --+ 7 ---R (x - 2) (x + 1) 2 (x - %A) ---R %A - 1= 0 ---RType: FullPartialFractionExpansion(Fraction Integer,UnivariatePolynomial(x,Fraction Integer)) ---E 5 - ---S 6 of 16 -f5 := D(f, 5) ---R ---R ---R (6) ---R 10 9 8 7 6 ---R - 544320x + 4354560x - 14696640x + 28615680x - 40085280x ---R + ---R 5 4 3 2 ---R 46656000x - 39411360x + 18247680x - 5870880x + 3317760x + 246240 ---R / ---R 20 19 18 17 16 15 14 13 ---R x - 12x + 53x - 76x - 159x + 676x - 391x - 1596x ---R + ---R 12 11 10 9 8 7 6 5 ---R 2527x + 1148x - 4977x + 1372x + 4907x - 3444x - 2381x + 2924x ---R + ---R 4 3 2 ---R 276x - 1184x + 208x + 192x - 64 ---R Type: Fraction UnivariatePolynomial(x,Fraction Integer) ---E 6 - ---S 7 of 16 -g5::Fx - f5 ---R ---R ---R (7) 0 ---R Type: Fraction UnivariatePolynomial(x,Fraction Integer) ---E 7 - ---S 8 of 16 -f : Fx := (x**5 * (x-1)) / ((x**2 + x + 1)**2 * (x-2)**3) ---R ---R ---R 6 5 ---R x - x ---R (8) ----------------------------------- ---R 7 6 5 3 2 ---R x - 4x + 3x + 9x - 6x - 4x - 8 ---R Type: Fraction UnivariatePolynomial(x,Fraction Integer) ---E 8 - ---S 9 of 16 -g := fullPartialFraction f ---R ---R ---R (9) ---R 1952 464 32 179 135 ---R ---- --- -- - ---- %A + ---- ---R 2401 343 49 --+ 2401 2401 ---R ------ + -------- + -------- + > ---------------- ---R x - 2 2 3 --+ x - %A ---R (x - 2) (x - 2) 2 ---R %A + %A + 1= 0 ---R + ---R 37 20 ---R ---- %A + ---- ---R --+ 1029 1029 ---R > -------------- ---R --+ 2 ---R 2 (x - %A) ---R %A + %A + 1= 0 ---RType: FullPartialFractionExpansion(Fraction Integer,UnivariatePolynomial(x,Fraction Integer)) ---E 9 - ---S 10 of 16 -g :: Fx - f ---R ---R ---R (10) 0 ---R Type: Fraction UnivariatePolynomial(x,Fraction Integer) ---E 10 - ---S 11 of 16 -f : Fx := (2*x**7-7*x**5+26*x**3+8*x) / (x**8-5*x**6+6*x**4+4*x**2-8) ---R ---R ---R 7 5 3 ---R 2x - 7x + 26x + 8x ---R (11) ------------------------ ---R 8 6 4 2 ---R x - 5x + 6x + 4x - 8 ---R Type: Fraction UnivariatePolynomial(x,Fraction Integer) ---E 11 - ---S 12 of 16 -g := fullPartialFraction f ---R ---R ---R 1 1 ---R - - ---R --+ 2 --+ 1 --+ 2 ---R (12) > ------ + > --------- + > ------ ---R --+ x - %A --+ 3 --+ x - %A ---R 2 2 (x - %A) 2 ---R %A - 2= 0 %A - 2= 0 %A + 1= 0 ---RType: FullPartialFractionExpansion(Fraction Integer,UnivariatePolynomial(x,Fraction Integer)) ---E 12 - ---S 13 of 16 -g :: Fx - f ---R ---R ---R (13) 0 ---R Type: Fraction UnivariatePolynomial(x,Fraction Integer) ---E 13 - ---S 14 of 16 -f:Fx := x**3 / (x**21 + 2*x**20 + 4*x**19 + 7*x**18 + 10*x**17 + 17*x**16 + 22*x**15 + 30*x**14 + 36*x**13 + 40*x**12 + 47*x**11 + 46*x**10 + 49*x**9 + 43*x**8 + 38*x**7 + 32*x**6 + 23*x**5 + 19*x**4 + 10*x**3 + 7*x**2 + 2*x + 1) ---R ---R ---R (14) ---R 3 ---R x ---R / ---R 21 20 19 18 17 16 15 14 13 12 ---R x + 2x + 4x + 7x + 10x + 17x + 22x + 30x + 36x + 40x ---R + ---R 11 10 9 8 7 6 5 4 3 2 ---R 47x + 46x + 49x + 43x + 38x + 32x + 23x + 19x + 10x + 7x + 2x ---R + ---R 1 ---R Type: Fraction UnivariatePolynomial(x,Fraction Integer) ---E 14 - ---S 15 of 16 -g := fullPartialFraction f ---R ---R ---R (15) ---R 1 1 19 ---R - %A - %A - -- ---R --+ 2 --+ 9 27 ---R > ------ + > --------- ---R --+ x - %A --+ x - %A ---R 2 2 ---R %A + 1= 0 %A + %A + 1= 0 ---R + ---R 1 1 ---R -- %A - -- ---R --+ 27 27 ---R > ---------- ---R --+ 2 ---R 2 (x - %A) ---R %A + %A + 1= 0 ---R + ---R SIGMA ---R 5 2 ---R %A + %A + 1= 0 ---R , ---R 96556567040 4 420961732891 3 59101056149 2 ---R - ------------ %A + ------------ %A - ------------ %A ---R 912390759099 912390759099 912390759099 ---R + ---R 373545875923 529673492498 ---R - ------------ %A + ------------ ---R 912390759099 912390759099 ---R / ---R x - %A ---R + ---R SIGMA ---R 5 2 ---R %A + %A + 1= 0 ---R , ---R 5580868 4 2024443 3 4321919 2 84614 5070620 ---R - -------- %A - -------- %A + -------- %A - ------- %A - -------- ---R 94070601 94070601 94070601 1542141 94070601 ---R -------------------------------------------------------------------- ---R 2 ---R (x - %A) ---R + ---R SIGMA ---R 5 2 ---R %A + %A + 1= 0 ---R , ---R 1610957 4 2763014 3 2016775 2 266953 4529359 ---R -------- %A + -------- %A - -------- %A + -------- %A + -------- ---R 94070601 94070601 94070601 94070601 94070601 ---R ------------------------------------------------------------------- ---R 3 ---R (x - %A) ---RType: FullPartialFractionExpansion(Fraction Integer,UnivariatePolynomial(x,Fraction Integer)) ---E 15 - ---S 16 of 16 -g :: Fx - f ---R ---R ---R (16) 0 ---R Type: Fraction UnivariatePolynomial(x,Fraction Integer) ---E 16 -)spool -)lisp (bye) -@ -<>= -==================================================================== -FullPartialFractionExpansion expansion -==================================================================== - -The domain FullPartialFractionExpansion implements factor-free -conversion of quotients to full partial fractions. - -Our examples will all involve quotients of univariate polynomials -with rational number coefficients. - - Fx := FRAC UP(x, FRAC INT) - Fraction UnivariatePolynomial(x,Fraction Integer) - Type: Domain - -Here is a simple-looking rational function. - - f : Fx := 36 / (x**5-2*x**4-2*x**3+4*x**2+x-2) - 36 - ---------------------------- - 5 4 3 2 - x - 2x - 2x + 4x + x - 2 - Type: Fraction UnivariatePolynomial(x,Fraction Integer) - -We use fullPartialFraction to convert it to an object of type -FullPartialFractionExpansion. - - g := fullPartialFraction f - 4 4 --+ - 3%A - 6 - ----- - ----- + > --------- - x - 2 x + 1 --+ 2 - 2 (x - %A) - %A - 1= 0 -Type: FullPartialFractionExpansion(Fraction Integer, - UnivariatePolynomial(x,Fraction Integer)) - -Use a coercion to change it back into a quotient. - - g :: Fx - 36 - ---------------------------- - 5 4 3 2 - x - 2x - 2x + 4x + x - 2 - Type: Fraction UnivariatePolynomial(x,Fraction Integer) - -Full partial fractions differentiate faster than rational functions. - - g5 := D(g, 5) - 480 480 --+ 2160%A + 4320 - - -------- + -------- + > ------------- - 6 6 --+ 7 - (x - 2) (x + 1) 2 (x - %A) - %A - 1= 0 -Type: FullPartialFractionExpansion(Fraction Integer, - UnivariatePolynomial(x,Fraction Integer)) - - f5 := D(f, 5) - 10 9 8 7 6 - - 544320x + 4354560x - 14696640x + 28615680x - 40085280x - + - 5 4 3 2 - 46656000x - 39411360x + 18247680x - 5870880x + 3317760x + 246240 - / - 20 19 18 17 16 15 14 13 - x - 12x + 53x - 76x - 159x + 676x - 391x - 1596x - + - 12 11 10 9 8 7 6 5 - 2527x + 1148x - 4977x + 1372x + 4907x - 3444x - 2381x + 2924x - + - 4 3 2 - 276x - 1184x + 208x + 192x - 64 - Type: Fraction UnivariatePolynomial(x,Fraction Integer) - -We can check that the two forms represent the same function. - - g5::Fx - f5 - 0 - Type: Fraction UnivariatePolynomial(x,Fraction Integer) - -Here are some examples that are more complicated. - - f : Fx := (x**5 * (x-1)) / ((x**2 + x + 1)**2 * (x-2)**3) - 6 5 - x - x - ----------------------------------- - 7 6 5 3 2 - x - 4x + 3x + 9x - 6x - 4x - 8 - Type: Fraction UnivariatePolynomial(x,Fraction Integer) - - g := fullPartialFraction f - 1952 464 32 179 135 - ---- --- -- - ---- %A + ---- - 2401 343 49 --+ 2401 2401 - ------ + -------- + -------- + > ---------------- - x - 2 2 3 --+ x - %A - (x - 2) (x - 2) 2 - %A + %A + 1= 0 - + - 37 20 - ---- %A + ---- - --+ 1029 1029 - > -------------- - --+ 2 - 2 (x - %A) - %A + %A + 1= 0 -Type: FullPartialFractionExpansion(Fraction Integer, - UnivariatePolynomial(x,Fraction Integer)) - - g :: Fx - f - 0 - Type: Fraction UnivariatePolynomial(x,Fraction Integer) - - f : Fx := (2*x**7-7*x**5+26*x**3+8*x) / (x**8-5*x**6+6*x**4+4*x**2-8) - 7 5 3 - 2x - 7x + 26x + 8x - ------------------------ - 8 6 4 2 - x - 5x + 6x + 4x - 8 - Type: Fraction UnivariatePolynomial(x,Fraction Integer) - - g := fullPartialFraction f - 1 1 - - - - --+ 2 --+ 1 --+ 2 - > ------ + > --------- + > ------ - --+ x - %A --+ 3 --+ x - %A - 2 2 (x - %A) 2 - %A - 2= 0 %A - 2= 0 %A + 1= 0 -Type: FullPartialFractionExpansion(Fraction Integer, - UnivariatePolynomial(x,Fraction Integer)) - - g :: Fx - f - 0 - Type: Fraction UnivariatePolynomial(x,Fraction Integer) - - f:Fx := x**3 / (x**21 + 2*x**20 + 4*x**19 + 7*x**18 + 10*x**17 + 17*x**16 + 22*x**15 + 30*x**14 + 36*x**13 + 40*x**12 + 47*x**11 + 46*x**10 + 49*x**9 + 43*x**8 + 38*x**7 + 32*x**6 + 23*x**5 + 19*x**4 + 10*x**3 + 7*x**2 + 2*x + 1) - 3 - x - / - 21 20 19 18 17 16 15 14 13 12 - x + 2x + 4x + 7x + 10x + 17x + 22x + 30x + 36x + 40x - + - 11 10 9 8 7 6 5 4 3 2 - 47x + 46x + 49x + 43x + 38x + 32x + 23x + 19x + 10x + 7x + 2x - + - 1 - Type: Fraction UnivariatePolynomial(x,Fraction Integer) - - g := fullPartialFraction f - 1 1 19 - - %A - %A - -- - --+ 2 --+ 9 27 - > ------ + > --------- - --+ x - %A --+ x - %A - 2 2 - %A + 1= 0 %A + %A + 1= 0 - + - 1 1 - -- %A - -- - --+ 27 27 - > ---------- - --+ 2 - 2 (x - %A) - %A + %A + 1= 0 - + - SIGMA - 5 2 - %A + %A + 1= 0 - , - 96556567040 4 420961732891 3 59101056149 2 - - ------------ %A + ------------ %A - ------------ %A - 912390759099 912390759099 912390759099 - + - 373545875923 529673492498 - - ------------ %A + ------------ - 912390759099 912390759099 - / - x - %A - + - SIGMA - 5 2 - %A + %A + 1= 0 - , - 5580868 4 2024443 3 4321919 2 84614 5070620 - - -------- %A - -------- %A + -------- %A - ------- %A - -------- - 94070601 94070601 94070601 1542141 94070601 - -------------------------------------------------------------------- - 2 - (x - %A) - + - SIGMA - 5 2 - %A + %A + 1= 0 - , - 1610957 4 2763014 3 2016775 2 266953 4529359 - -------- %A + -------- %A - -------- %A + -------- %A + -------- - 94070601 94070601 94070601 94070601 94070601 - ------------------------------------------------------------------- - 3 - (x - %A) -Type: FullPartialFractionExpansion(Fraction Integer,UnivariatePolynomial(x,Fraction Integer)) - -This verification takes much longer than the conversion to partial fractions. - - g :: Fx - f - 0 - Type: Fraction UnivariatePolynomial(x,Fraction Integer) - -Use PartialFraction for standard partial fraction decompositions. - -For more information, see the paper: Bronstein, M and Salvy, B. -"Full Partial Fraction Decomposition of Rational Functions," -Proceedings of ISSAC'93, Kiev, ACM Press. - -See Also: -o )help PartialFraction -o )show FullPartialFractionExpansion -o $AXIOM/doc/src/algebra/fparfrac.spad.dvi - -@ -<>= -)abbrev domain FPARFRAC FullPartialFractionExpansion -++ Full partial fraction expansion of rational functions -++ Author: Manuel Bronstein -++ Date Created: 9 December 1992 -++ Date Last Updated: 6 October 1993 -++ References: M.Bronstein & B.Salvy, -++ Full Partial Fraction Decomposition of Rational Functions, -++ in Proceedings of ISSAC'93, Kiev, ACM Press. -FullPartialFractionExpansion(F, UP): Exports == Implementation where - F : Join(Field, CharacteristicZero) - UP : UnivariatePolynomialCategory F - - N ==> NonNegativeInteger - Q ==> Fraction Integer - O ==> OutputForm - RF ==> Fraction UP - SUP ==> SparseUnivariatePolynomial RF - REC ==> Record(exponent: N, center: UP, num: UP) - ODV ==> OrderlyDifferentialVariable Symbol - ODP ==> OrderlyDifferentialPolynomial UP - ODF ==> Fraction ODP - FPF ==> Record(polyPart: UP, fracPart: List REC) - - Exports ==> Join(SetCategory, ConvertibleTo RF) with - "+": (UP, $) -> $ - ++ p + x returns the sum of p and x - fullPartialFraction: RF -> $ - ++ fullPartialFraction(f) returns \spad{[p, [[j, Dj, Hj]...]]} such that - ++ \spad{f = p(x) + sum_{[j,Dj,Hj] in l} sum_{Dj(a)=0} Hj(a)/(x - a)\^j}. - polyPart: $ -> UP - ++ polyPart(f) returns the polynomial part of f. - fracPart: $ -> List REC - ++ fracPart(f) returns the list of summands of the fractional part of f. - construct: List REC -> $ - ++ construct(l) is the inverse of fracPart. - differentiate: $ -> $ - ++ differentiate(f) returns the derivative of f. - D: $ -> $ - ++ D(f) returns the derivative of f. - differentiate: ($, N) -> $ - ++ differentiate(f, n) returns the n-th derivative of f. - D: ($, NonNegativeInteger) -> $ - ++ D(f, n) returns the n-th derivative of f. - - Implementation ==> add - Rep := FPF - - fullParFrac: (UP, UP, UP, N) -> List REC - outputexp : (O, N) -> O - output : (N, UP, UP) -> O - REC2RF : (UP, UP, N) -> RF - UP2SUP : UP -> SUP - diffrec : REC -> REC - FP2O : List REC -> O - --- create a differential variable - u := new()$Symbol - u0 := makeVariable(u, 0)$ODV - alpha := u::O - x := monomial(1, 1)$UP - xx := x::O - zr := (0$N)::O - - construct l == [0, l] - D r == differentiate r - D(r, n) == differentiate(r,n) - polyPart f == f.polyPart - fracPart f == f.fracPart - p:UP + f:$ == [p + polyPart f, fracPart f] - - differentiate f == - differentiate(polyPart f) + construct [diffrec rec for rec in fracPart f] - - differentiate(r, n) == - for i in 1..n repeat r := differentiate r - r - --- diffrec(sum_{rec.center(a) = 0} rec.num(a) / (x - a)^e) = --- sum_{rec.center(a) = 0} -e rec.num(a) / (x - a)^{e+1} --- where e = rec.exponent - diffrec rec == - e := rec.exponent - [e + 1, rec.center, - e * rec.num] - - convert(f:$):RF == - ans := polyPart(f)::RF - for rec in fracPart f repeat - ans := ans + REC2RF(rec.center, rec.num, rec.exponent) - ans - - UP2SUP p == - map(#1::UP::RF, p)$UnivariatePolynomialCategoryFunctions2(F, UP, RF, SUP) - - -- returns Trace_k^k(a) (h(a) / (x - a)^n) where d(a) = 0 - REC2RF(d, h, n) == --- one?(m := degree d) => - ((m := degree d) = 1) => - a := - (leadingCoefficient reductum d) / (leadingCoefficient d) - h(a)::UP / (x - a::UP)**n - dd := UP2SUP d - hh := UP2SUP h - aa := monomial(1, 1)$SUP - p := (x::RF::SUP - aa)**n rem dd - rec := extendedEuclidean(p, dd, hh)::Record(coef1:SUP, coef2:SUP) - t := rec.coef1 -- we want Trace_k^k(a)(t) now - ans := coefficient(t, 0) - for i in 1..degree(d)-1 repeat - t := (t * aa) rem dd - ans := ans + coefficient(t, i) - ans - - fullPartialFraction f == - qr := divide(numer f, d := denom f) - qr.quotient + construct concat - [fullParFrac(qr.remainder, d, rec.factor, rec.exponent::N) - for rec in factors squareFree denom f] - - fullParFrac(a, d, q, n) == - ans:List REC := empty() - em := e := d quo (q ** n) - rec := extendedEuclidean(e, q, 1)::Record(coef1:UP,coef2:UP) - bm := b := rec.coef1 -- b = inverse of e modulo q - lvar:List(ODV) := [u0] - um := 1::ODP - un := (u1 := u0::ODP)**n - lval:List(UP) := [q1 := q := differentiate(q0 := q)] - h:ODF := a::ODP / (e * un) - rec := extendedEuclidean(q1, q0, 1)::Record(coef1:UP,coef2:UP) - c := rec.coef1 -- c = inverse of q' modulo q - cm := 1::UP - cn := (c ** n) rem q0 - for m in 1..n repeat - p := retract(em * un * um * h)@ODP - pp := retract(eval(p, lvar, lval))@UP - h := inv(m::Q) * differentiate h - q := differentiate q - lvar := concat(makeVariable(u, m), lvar) - lval := concat(inv((m+1)::F) * q, lval) - qq := q0 quo gcd(pp, q0) -- new center - if (degree(qq) > 0) then - ans := concat([(n + 1 - m)::N, qq, (pp * bm * cn * cm) rem qq], ans) - cm := (c * cm) rem q0 -- cm = c**m modulo q now - um := u1 * um -- um = u**m now - em := e * em -- em = e**{m+1} now - bm := (b * bm) rem q0 -- bm = b**{m+1} modulo q now - ans - - coerce(f:$):O == - ans := FP2O(l := fracPart f) - zero?(p := polyPart f) => - empty? l => (0$N)::O - ans - p::O + ans - - FP2O l == - empty? l => empty() - rec := first l - ans := output(rec.exponent, rec.center, rec.num) - for rec in rest l repeat - ans := ans + output(rec.exponent, rec.center, rec.num) - ans - - output(n, d, h) == --- one? degree d => - (degree d) = 1 => - a := - leadingCoefficient(reductum d) / leadingCoefficient(d) - h(a)::O / outputexp((x - a::UP)::O, n) - sum(outputForm(makeSUP h, alpha) / outputexp(xx - alpha, n), - outputForm(makeSUP d, alpha) = zr) - - outputexp(f, n) == --- one? n => f - (n = 1) => f - f ** (n::O) - -@ -\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/fr.spad.pamphlet b/src/algebra/fr.spad.pamphlet index d03f159..21d9687 100644 --- a/src/algebra/fr.spad.pamphlet +++ b/src/algebra/fr.spad.pamphlet @@ -9,1206 +9,6 @@ \eject \tableofcontents \eject -<>= --- fr.spad.pamphlet Factored.input -)spool Factored.output -)set message test on -)set message auto off -)clear all ---S 1 of 38 -g := factor(4312) ---R ---R ---R 3 2 ---R (1) 2 7 11 ---R Type: Factored Integer ---E 1 - ---S 2 of 38 -unit(g) ---R ---R ---R (2) 1 ---R Type: PositiveInteger ---E 2 - ---S 3 of 38 -numberOfFactors(g) ---R ---R ---R (3) 3 ---R Type: PositiveInteger ---E 3 - ---S 4 of 38 -[nthFactor(g,i) for i in 1..numberOfFactors(g)] ---R ---R ---R (4) [2,7,11] ---R Type: List Integer ---E 4 - ---S 5 of 38 -[nthExponent(g,i) for i in 1..numberOfFactors(g)] ---R ---R ---R (5) [3,2,1] ---R Type: List Integer ---E 5 - ---S 6 of 38 -[nthFlag(g,i) for i in 1..numberOfFactors(g)] ---R ---R ---R (6) ["prime","prime","prime"] ---R Type: List Union("nil","sqfr","irred","prime") ---E 6 - ---S 7 of 38 -factorList(g) ---R ---R ---R (7) ---R [[flg= "prime",fctr= 2,xpnt= 3], [flg= "prime",fctr= 7,xpnt= 2], ---R [flg= "prime",fctr= 11,xpnt= 1]] ---RType: List Record(flg: Union("nil","sqfr","irred","prime"),fctr: Integer,xpnt: Integer) ---E 7 - ---S 8 of 38 -factors(g) ---R ---R ---R (8) ---R [[factor= 2,exponent= 3],[factor= 7,exponent= 2],[factor= 11,exponent= 1]] ---R Type: List Record(factor: Integer,exponent: Integer) ---E 8 - ---S 9 of 38 -first(%).factor ---R ---R ---R (9) 2 ---R Type: PositiveInteger ---E 9 - ---S 10 of 38 -g := factor(4312) ---R ---R ---R 3 2 ---R (10) 2 7 11 ---R Type: Factored Integer ---E 10 - ---S 11 of 38 -expand(g) ---R ---R ---R (11) 4312 ---R Type: PositiveInteger ---E 11 - ---S 12 of 38 -reduce(*,[t.factor for t in factors(g)]) ---R ---R ---R (12) 154 ---R Type: PositiveInteger ---E 12 - ---S 13 of 38 -g := factor(4312) ---R ---R ---R 3 2 ---R (13) 2 7 11 ---R Type: Factored Integer ---E 13 - ---S 14 of 38 -f := factor(246960) ---R ---R ---R 4 2 3 ---R (14) 2 3 5 7 ---R Type: Factored Integer ---E 14 - ---S 15 of 38 -f * g ---R ---R ---R 7 2 5 ---R (15) 2 3 5 7 11 ---R Type: Factored Integer ---E 15 - ---S 16 of 38 -f**500 ---R ---R ---R 2000 1000 500 1500 ---R (16) 2 3 5 7 ---R Type: Factored Integer ---E 16 - ---S 17 of 38 -gcd(f,g) ---R ---R ---R 3 2 ---R (17) 2 7 ---R Type: Factored Integer ---E 17 - ---S 18 of 38 -lcm(f,g) ---R ---R ---R 4 2 3 ---R (18) 2 3 5 7 11 ---R Type: Factored Integer ---E 18 - ---S 19 of 38 -f + g ---R ---R ---R 3 2 ---R (19) 2 7 641 ---R Type: Factored Integer ---E 19 - ---S 20 of 38 -f - g ---R ---R ---R 3 2 ---R (20) 2 7 619 ---R Type: Factored Integer ---E 20 - ---S 21 of 38 -zero?(factor(0)) ---R ---R ---R (21) true ---R Type: Boolean ---E 21 - ---S 22 of 38 -zero?(g) ---R ---R ---R (22) false ---R Type: Boolean ---E 22 - ---S 23 of 38 -one?(factor(1)) ---R ---R ---R (23) true ---R Type: Boolean ---E 23 - ---S 24 of 38 -one?(f) ---R ---R ---R (24) false ---R Type: Boolean ---E 24 - ---S 25 of 38 -0$Factored(Integer) ---R ---R ---R (25) 0 ---R Type: Factored Integer ---E 25 - ---S 26 of 38 -1$Factored(Integer) ---R ---R ---R (26) 1 ---R Type: Factored Integer ---E 26 - ---S 27 of 38 -nilFactor(24,2) ---R ---R ---R 2 ---R (27) 24 ---R Type: Factored Integer ---E 27 - ---S 28 of 38 -nthFlag(%,1) ---R ---R ---R (28) "nil" ---R Type: Union("nil",...) ---E 28 - ---S 29 of 38 -sqfrFactor(30,2) ---R ---R ---R 2 ---R (29) 30 ---R Type: Factored Integer ---E 29 - ---S 30 of 38 -irreducibleFactor(13,10) ---R ---R ---R 10 ---R (30) 13 ---R Type: Factored Integer ---E 30 - ---S 31 of 38 -primeFactor(11,5) ---R ---R ---R 5 ---R (31) 11 ---R Type: Factored Integer ---E 31 - ---S 32 of 38 -h := factor(-720) ---R ---R ---R 4 2 ---R (32) - 2 3 5 ---R Type: Factored Integer ---E 32 - ---S 33 of 38 -h - makeFR(unit(h),factorList(h)) ---R ---R ---R (33) 0 ---R Type: Factored Integer ---E 33 - ---S 34 of 38 -p := (4*x*x-12*x+9)*y*y + (4*x*x-12*x+9)*y + 28*x*x - 84*x + 63 ---R ---R ---R 2 2 2 2 ---R (34) (4x - 12x + 9)y + (4x - 12x + 9)y + 28x - 84x + 63 ---R Type: Polynomial Integer ---E 34 - ---S 35 of 38 -fp := factor(p) ---R ---R ---R 2 2 ---R (35) (2x - 3) (y + y + 7) ---R Type: Factored Polynomial Integer ---E 35 - ---S 36 of 38 -D(p,x) ---R ---R ---R 2 ---R (36) (8x - 12)y + (8x - 12)y + 56x - 84 ---R Type: Polynomial Integer ---E 36 - ---S 37 of 38 -D(fp,x) ---R ---R ---R 2 ---R (37) 4(2x - 3)(y + y + 7) ---R Type: Factored Polynomial Integer ---E 37 - ---S 38 of 38 -numberOfFactors(%) ---R ---R ---R (38) 3 ---R Type: PositiveInteger ---E 38 -)spool -)lisp (bye) -@ - --- This file contains a domain and packages for manipulating objects --- in factored form. -\section{domain FR Factored} -<>= -==================================================================== -Factored examples -==================================================================== - -Factored creates a domain whose objects are kept in factored form as -long as possible. Thus certain operations like * (multiplication) and -gcd are relatively easy to do. Others, such as addition, require -somewhat more work, and the result may not be completely factored -unless the argument domain R provides a factor operation. Each object -consists of a unit and a list of factors, where each factor consists -of a member of R (the base), an exponent, and a flag indicating what -is known about the base. A flag may be one of "nil", "sqfr", "irred" -or "prime", which mean that nothing is known about the base, it is -square-free, it is irreducible, or it is prime, respectively. The -current restriction to factored objects of integral domains allows -simplification to be performed without worrying about multiplication -order. - -==================================================================== -Decomposing Factored Objects -==================================================================== - -In this section we will work with a factored integer. - - g := factor(4312) - 3 2 - 2 7 11 - Type: Factored Integer - -Let's begin by decomposing g into pieces. The only possible -units for integers are 1 and -1. - - unit(g) - 1 - Type: PositiveInteger - -There are three factors. - - numberOfFactors(g) - 3 - Type: PositiveInteger - -We can make a list of the bases, ... - - [nthFactor(g,i) for i in 1..numberOfFactors(g)] - [2,7,11] - Type: List Integer - -and the exponents, ... - - [nthExponent(g,i) for i in 1..numberOfFactors(g)] - [3,2,1] - Type: List Integer - -and the flags. You can see that all the bases (factors) are prime. - - [nthFlag(g,i) for i in 1..numberOfFactors(g)] - ["prime","prime","prime"] - Type: List Union("nil","sqfr","irred","prime") - -A useful operation for pulling apart a factored object into a list -of records of the components is factorList. - - factorList(g) - [[flg= "prime",fctr= 2,xpnt= 3], [flg= "prime",fctr= 7,xpnt= 2], - [flg= "prime",fctr= 11,xpnt= 1]] - Type: List Record(flg: Union("nil","sqfr","irred","prime"), - fctr: Integer,xpnt: Integer) - -If you don't care about the flags, use factors. - - factors(g) - [[factor= 2,exponent= 3],[factor= 7,exponent= 2],[factor= 11,exponent= 1]] - Type: List Record(factor: Integer,exponent: Integer) - -Neither of these operations returns the unit. - - first(%).factor - 2 - Type: PositiveInteger - -==================================================================== -Expanding Factored Objects -==================================================================== - -Recall that we are working with this factored integer. - - g := factor(4312) - 3 2 - 2 7 11 - Type: Factored Integer - -To multiply out the factors with their multiplicities, use expand. - - expand(g) - 4312 - Type: PositiveInteger - -If you would like, say, the distinct factors multiplied together but -with multiplicity one, you could do it this way. - - reduce(*,[t.factor for t in factors(g)]) - 154 - Type: PositiveInteger - -==================================================================== -Arithmetic with Factored Objects -==================================================================== - -We're still working with this factored integer. - - g := factor(4312) - 3 2 - 2 7 11 - Type: Factored Integer - -We'll also define this factored integer. - - f := factor(246960) - 4 2 3 - 2 3 5 7 - Type: Factored Integer - -Operations involving multiplication and division are particularly -easy with factored objects. - - f * g - 7 2 5 - 2 3 5 7 11 - Type: Factored Integer - - f**500 - 2000 1000 500 1500 - 2 3 5 7 - Type: Factored Integer - - gcd(f,g) - 3 2 - 2 7 - Type: Factored Integer - - lcm(f,g) - 4 2 3 - 2 3 5 7 11 - Type: Factored Integer - -If we use addition and subtraction things can slow down because -we may need to compute greatest common divisors. - - f + g - 3 2 - 2 7 641 - Type: Factored Integer - - f - g - 3 2 - 2 7 619 - Type: Factored Integer - -Test for equality with 0 and 1 by using zero? and one?, respectively. - - zero?(factor(0)) - true - Type: Boolean - - zero?(g) - false - Type: Boolean - - one?(factor(1)) - true - Type: Boolean - - one?(f) - false - Type: Boolean - -Another way to get the zero and one factored objects is to use -package calling. - - 0$Factored(Integer) - 0 - Type: Factored Integer - - 1$Factored(Integer) - 1 - Type: Factored Integer - -==================================================================== -Creating New Factored Objects -==================================================================== - -The map operation is used to iterate across the unit and bases of a -factored object. - -The following four operations take a base and an exponent and create a -factored object. They differ in handling the flag component. - - nilFactor(24,2) - 2 - 24 - Type: Factored Integer - -This factor has no associated information. - - nthFlag(%,1) - "nil" - Type: Union("nil",...) - -This factor is asserted to be square-free. - - sqfrFactor(30,2) - 2 - 30 - Type: Factored Integer - -This factor is asserted to be irreducible. - - irreducibleFactor(13,10) - 10 - 13 - Type: Factored Integer - -This factor is asserted to be prime. - - primeFactor(11,5) - 5 - 11 - Type: Factored Integer - -A partial inverse to factorList is makeFR. - - h := factor(-720) - 4 2 - - 2 3 5 - Type: Factored Integer - -The first argument is the unit and the second is a list of records as -returned by factorList. - - h - makeFR(unit(h),factorList(h)) - 0 - Type: Factored Integer - -==================================================================== -Factored Objects with Variables -==================================================================== - -Some of the operations available for polynomials are also available -for factored polynomials. - - p := (4*x*x-12*x+9)*y*y + (4*x*x-12*x+9)*y + 28*x*x - 84*x + 63 - 2 2 2 2 - (4x - 12x + 9)y + (4x - 12x + 9)y + 28x - 84x + 63 - Type: Polynomial Integer - - fp := factor(p) - 2 2 - (2x - 3) (y + y + 7) - Type: Factored Polynomial Integer - -You can differentiate with respect to a variable. - - D(p,x) - 2 - (8x - 12)y + (8x - 12)y + 56x - 84 - Type: Polynomial Integer - - D(fp,x) - 2 - 4(2x - 3)(y + y + 7) - Type: Factored Polynomial Integer - - numberOfFactors(%) - 3 - Type: PositiveInteger - -See Also: -o )help FactoredFunctions2 -o )show Factored -o $AXIOM/doc/src/algebra/fr.spad.dvi - -@ -<>= -)abbrev domain FR Factored -++ Author: Robert S. Sutor -++ Date Created: 1985 -++ Change History: -++ 21 Jan 1991 J Grabmeier Corrected a bug in exquo. -++ 16 Aug 1994 R S Sutor Improved convert to InputForm -++ Basic Operations: -++ expand, exponent, factorList, factors, flagFactor, irreducibleFactor, -++ makeFR, map, nilFactor, nthFactor, nthFlag, numberOfFactors, -++ primeFactor, sqfrFactor, unit, unitNormalize, -++ Related Constructors: FactoredFunctionUtilities, FactoredFunctions2 -++ Also See: -++ AMS Classifications: 11A51, 11Y05 -++ Keywords: factorization, prime, square-free, irreducible, factor -++ References: -++ Description: -++ \spadtype{Factored} creates a domain whose objects are kept in -++ factored form as long as possible. Thus certain operations like -++ multiplication and gcd are relatively easy to do. Others, like -++ addition require somewhat more work, and unless the argument -++ domain provides a factor function, the result may not be -++ completely factored. Each object consists of a unit and a list of -++ factors, where a factor has a member of R (the "base"), and -++ exponent and a flag indicating what is known about the base. A -++ flag may be one of "nil", "sqfr", "irred" or "prime", which respectively mean -++ that nothing is known about the base, it is square-free, it is -++ irreducible, or it is prime. The current -++ restriction to integral domains allows simplification to be -++ performed without worrying about multiplication order. - -Factored(R: IntegralDomain): Exports == Implementation where - fUnion ==> Union("nil", "sqfr", "irred", "prime") - FF ==> Record(flg: fUnion, fctr: R, xpnt: Integer) - SRFE ==> Set(Record(factor:R, exponent:Integer)) - - Exports ==> Join(IntegralDomain, DifferentialExtension R, Algebra R, - FullyEvalableOver R, FullyRetractableTo R) with - expand: % -> R - ++ expand(f) multiplies the unit and factors together, yielding an - ++ "unfactored" object. Note: this is purposely not called - ++ \spadfun{coerce} which would cause the interpreter to do this - ++ automatically. - ++ - ++X f:=nilFactor(y-x,3) - ++X expand(f) - - exponent: % -> Integer - ++ exponent(u) returns the exponent of the first factor of - ++ \spadvar{u}, or 0 if the factored form consists solely of a unit. - ++ - ++X f:=nilFactor(y-x,3) - ++X exponent(f) - - makeFR : (R, List FF) -> % - ++ makeFR(unit,listOfFactors) creates a factored object (for - ++ use by factoring code). - ++ - ++X f:=nilFactor(x-y,3) - ++X g:=factorList f - ++X makeFR(z,g) - - factorList : % -> List FF - ++ factorList(u) returns the list of factors with flags (for - ++ use by factoring code). - ++ - ++X f:=nilFactor(x-y,3) - ++X factorList f - - nilFactor: (R, Integer) -> % - ++ nilFactor(base,exponent) creates a factored object with - ++ a single factor with no information about the kind of - ++ base (flag = "nil"). - ++ - ++X nilFactor(24,2) - ++X nilFactor(x-y,3) - - factors: % -> List Record(factor:R, exponent:Integer) - ++ factors(u) returns a list of the factors in a form suitable - ++ for iteration. That is, it returns a list where each element - ++ is a record containing a base and exponent. The original - ++ object is the product of all the factors and the unit (which - ++ can be extracted by \axiom{unit(u)}). - ++ - ++X f:=x*y^3-3*x^2*y^2+3*x^3*y-x^4 - ++X factors f - ++X g:=makeFR(z,factorList f) - ++X factors g - - irreducibleFactor: (R, Integer) -> % - ++ irreducibleFactor(base,exponent) creates a factored object with - ++ a single factor whose base is asserted to be irreducible - ++ (flag = "irred"). - ++ - ++X a:=irreducibleFactor(3,1) - ++X nthFlag(a,1) - - nthExponent: (%, Integer) -> Integer - ++ nthExponent(u,n) returns the exponent of the nth factor of - ++ \spadvar{u}. If \spadvar{n} is not a valid index for a factor - ++ (for example, less than 1 or too big), 0 is returned. - ++ - ++X a:=factor 9720000 - ++X nthExponent(a,2) - - nthFactor: (%,Integer) -> R - ++ nthFactor(u,n) returns the base of the nth factor of - ++ \spadvar{u}. If \spadvar{n} is not a valid index for a factor - ++ (for example, less than 1 or too big), 1 is returned. If - ++ \spadvar{u} consists only of a unit, the unit is returned. - ++ - ++X a:=factor 9720000 - ++X nthFactor(a,2) - - nthFlag: (%,Integer) -> fUnion - ++ nthFlag(u,n) returns the information flag of the nth factor of - ++ \spadvar{u}. If \spadvar{n} is not a valid index for a factor - ++ (for example, less than 1 or too big), "nil" is returned. - ++ - ++X a:=factor 9720000 - ++X nthFlag(a,2) - - numberOfFactors : % -> NonNegativeInteger - ++ numberOfFactors(u) returns the number of factors in \spadvar{u}. - ++ - ++X a:=factor 9720000 - ++X numberOfFactors a - - primeFactor: (R,Integer) -> % - ++ primeFactor(base,exponent) creates a factored object with - ++ a single factor whose base is asserted to be prime - ++ (flag = "prime"). - ++ - ++X a:=primeFactor(3,4) - ++X nthFlag(a,1) - - sqfrFactor: (R,Integer) -> % - ++ sqfrFactor(base,exponent) creates a factored object with - ++ a single factor whose base is asserted to be square-free - ++ (flag = "sqfr"). - ++ - ++X a:=sqfrFactor(3,5) - ++X nthFlag(a,1) - - flagFactor: (R,Integer, fUnion) -> % - ++ flagFactor(base,exponent,flag) creates a factored object with - ++ a single factor whose base is asserted to be properly - ++ described by the information flag. - - unit: % -> R - ++ unit(u) extracts the unit part of the factorization. - ++ - ++X f:=x*y^3-3*x^2*y^2+3*x^3*y-x^4 - ++X unit f - ++X g:=makeFR(z,factorList f) - ++X unit g - - unitNormalize: % -> % - ++ unitNormalize(u) normalizes the unit part of the factorization. - ++ For example, when working with factored integers, this operation will - ++ ensure that the bases are all positive integers. - - map: (R -> R, %) -> % - ++ map(fn,u) maps the function \userfun{fn} across the factors of - ++ \spadvar{u} and creates a new factored object. Note: this clears - ++ the information flags (sets them to "nil") because the effect of - ++ \userfun{fn} is clearly not known in general. - ++ - ++X m(a:Factored Polynomial Integer):Factored Polynomial Integer == a^2 - ++X f:=x*y^3-3*x^2*y^2+3*x^3*y-x^4 - ++X map(m,f) - ++X g:=makeFR(z,factorList f) - ++X map(m,g) - - -- the following operations are conditional on R - - if R has GcdDomain then GcdDomain - if R has RealConstant then RealConstant - if R has UniqueFactorizationDomain then UniqueFactorizationDomain - - if R has ConvertibleTo InputForm then ConvertibleTo InputForm - - if R has IntegerNumberSystem then - rational? : % -> Boolean - ++ rational?(u) tests if \spadvar{u} is actually a - ++ rational number (see \spadtype{Fraction Integer}). - rational : % -> Fraction Integer - ++ rational(u) assumes spadvar{u} is actually a rational number - ++ and does the conversion to rational number - ++ (see \spadtype{Fraction Integer}). - rationalIfCan: % -> Union(Fraction Integer, "failed") - ++ rationalIfCan(u) returns a rational number if u - ++ really is one, and "failed" otherwise. - - if R has Eltable(%, %) then Eltable(%, %) - if R has Evalable(%) then Evalable(%) - if R has InnerEvalable(Symbol, %) then InnerEvalable(Symbol, %) - - Implementation ==> add - - -- Representation: - -- Note: exponents are allowed to be integers so that some special cases - -- may be used in simplications - Rep := Record(unt:R, fct:List FF) - - if R has ConvertibleTo InputForm then - convert(x:%):InputForm == - empty?(lf := reverse factorList x) => convert(unit x)@InputForm - l := empty()$List(InputForm) - for rec in lf repeat --- one?(rec.fctr) => l - ((rec.fctr) = 1) => l - iFactor : InputForm := binary( convert("::" :: Symbol)@InputForm, [convert(rec.fctr)@InputForm, (devaluate R)$Lisp :: InputForm ]$List(InputForm) ) - iExpon : InputForm := convert(rec.xpnt)@InputForm - iFun : List InputForm := - rec.flg case "nil" => - [convert("nilFactor" :: Symbol)@InputForm, iFactor, iExpon]$List(InputForm) - rec.flg case "sqfr" => - [convert("sqfrFactor" :: Symbol)@InputForm, iFactor, iExpon]$List(InputForm) - rec.flg case "prime" => - [convert("primeFactor" :: Symbol)@InputForm, iFactor, iExpon]$List(InputForm) - rec.flg case "irred" => - [convert("irreducibleFactor" :: Symbol)@InputForm, iFactor, iExpon]$List(InputForm) - nil$List(InputForm) - l := concat( iFun pretend InputForm, l ) --- one?(rec.xpnt) => --- l := concat(convert(rec.fctr)@InputForm, l) --- l := concat(convert(rec.fctr)@InputForm ** rec.xpnt, l) - empty? l => convert(unit x)@InputForm - if unit x ^= 1 then l := concat(convert(unit x)@InputForm,l) - empty? rest l => first l - binary(convert(_*::Symbol)@InputForm, l)@InputForm - - orderedR? := R has OrderedSet - - -- Private function signatures: - reciprocal : % -> % - qexpand : % -> R - negexp? : % -> Boolean - SimplifyFactorization : List FF -> List FF - LispLessP : (FF, FF) -> Boolean - mkFF : (R, List FF) -> % - SimplifyFactorization1 : (FF, List FF) -> List FF - stricterFlag : (fUnion, fUnion) -> fUnion - - nilFactor(r, i) == flagFactor(r, i, "nil") - sqfrFactor(r, i) == flagFactor(r, i, "sqfr") - irreducibleFactor(r, i) == flagFactor(r, i, "irred") - primeFactor(r, i) == flagFactor(r, i, "prime") - unit? u == (empty? u.fct) and (not zero? u.unt) - factorList u == u.fct - unit u == u.unt - numberOfFactors u == # u.fct - 0 == [1, [["nil", 0, 1]$FF]] - zero? u == # u.fct = 1 and - (first u.fct).flg case "nil" and - zero? (first u.fct).fctr and --- one? u.unt - (u.unt = 1) - 1 == [1, empty()] - one? u == empty? u.fct and u.unt = 1 - mkFF(r, x) == [r, x] - coerce(j:Integer):% == (j::R)::% - characteristic() == characteristic()$R - i:Integer * u:% == (i :: %) * u - r:R * u:% == (r :: %) * u - factors u == [[fe.fctr, fe.xpnt] for fe in factorList u] - expand u == retract u - negexp? x == "or"/[negative?(y.xpnt) for y in factorList x] - - makeFR(u, l) == --- normalizing code to be installed when contents are handled better --- current squareFree returns the content as a unit part. --- if (not unit?(u)) then --- l := cons(["nil", u, 1]$FF,l) --- u := 1 - unitNormalize mkFF(u, SimplifyFactorization l) - - if R has IntegerNumberSystem then - rational? x == true - rationalIfCan x == rational x - - rational x == - convert(unit x)@Integer * - _*/[(convert(f.fctr)@Integer)::Fraction(Integer) - ** f.xpnt for f in factorList x] - - if R has Eltable(R, R) then - elt(x:%, v:%) == x(expand v) - - if R has Evalable(R) then - eval(x:%, l:List Equation %) == - eval(x,[expand lhs e = expand rhs e for e in l]$List(Equation R)) - - if R has InnerEvalable(Symbol, R) then - eval(x:%, ls:List Symbol, lv:List %) == - eval(x, ls, [expand v for v in lv]$List(R)) - - if R has RealConstant then - --! negcount and rest commented out since RealConstant doesn't support - --! positive? or negative? - -- negcount: % -> Integer - -- positive?(x:%):Boolean == not(zero? x) and even?(negcount x) - -- negative?(x:%):Boolean == not(zero? x) and odd?(negcount x) - -- negcount x == - -- n := count(negative?(#1.fctr), factorList x)$List(FF) - -- negative? unit x => n + 1 - -- n - - convert(x:%):Float == - convert(unit x)@Float * - _*/[convert(f.fctr)@Float ** f.xpnt for f in factorList x] - - convert(x:%):DoubleFloat == - convert(unit x)@DoubleFloat * - _*/[convert(f.fctr)@DoubleFloat ** f.xpnt for f in factorList x] - - u:% * v:% == - zero? u or zero? v => 0 --- one? u => v - (u = 1) => v --- one? v => u - (v = 1) => u - mkFF(unit u * unit v, - SimplifyFactorization concat(factorList u, copy factorList v)) - - u:% ** n:NonNegativeInteger == - mkFF(unit(u)**n, [[x.flg, x.fctr, n * x.xpnt] for x in factorList u]) - - SimplifyFactorization x == - empty? x => empty() - x := sort_!(LispLessP, x) - x := SimplifyFactorization1(first x, rest x) - if orderedR? then x := sort_!(LispLessP, x) - x - - SimplifyFactorization1(f, x) == - empty? x => - zero?(f.xpnt) => empty() - list f - f1 := first x - f.fctr = f1.fctr => - SimplifyFactorization1([stricterFlag(f.flg, f1.flg), - f.fctr, f.xpnt + f1.xpnt], rest x) - l := SimplifyFactorization1(first x, rest x) - zero?(f.xpnt) => l - concat(f, l) - - - coerce(x:%):OutputForm == - empty?(lf := reverse factorList x) => (unit x)::OutputForm - l := empty()$List(OutputForm) - for rec in lf repeat --- one?(rec.fctr) => l - ((rec.fctr) = 1) => l --- one?(rec.xpnt) => - ((rec.xpnt) = 1) => - l := concat(rec.fctr :: OutputForm, l) - l := concat(rec.fctr::OutputForm ** rec.xpnt::OutputForm, l) - empty? l => (unit x) :: OutputForm - e := - empty? rest l => first l - reduce(_*, l) - 1 = unit x => e - (unit x)::OutputForm * e - - retract(u:%):R == - negexp? u => error "Negative exponent in factored object" - qexpand u - - qexpand u == - unit u * - _*/[y.fctr ** (y.xpnt::NonNegativeInteger) for y in factorList u] - - retractIfCan(u:%):Union(R, "failed") == - negexp? u => "failed" - qexpand u - - LispLessP(y, y1) == - orderedR? => y.fctr < y1.fctr - GGREATERP(y.fctr, y1.fctr)$Lisp => false - true - - stricterFlag(fl1, fl2) == - fl1 case "prime" => fl1 - fl1 case "irred" => - fl2 case "prime" => fl2 - fl1 - fl1 case "sqfr" => - fl2 case "nil" => fl1 - fl2 - fl2 - - if R has IntegerNumberSystem - then - coerce(r:R):% == - factor(r)$IntegerFactorizationPackage(R) pretend % - else - if R has UniqueFactorizationDomain - then - coerce(r:R):% == - zero? r => 0 - unit? r => mkFF(r, empty()) - unitNormalize(squareFree(r) pretend %) - else - coerce(r:R):% == --- one? r => 1 - (r = 1) => 1 - unitNormalize mkFF(1, [["nil", r, 1]$FF]) - - u = v == - (unit u = unit v) and # u.fct = # v.fct and - set(factors u)$SRFE =$SRFE set(factors v)$SRFE - - - u == - zero? u => u - mkFF(- unit u, factorList u) - - recip u == - not empty? factorList u => "failed" - (r := recip unit u) case "failed" => "failed" - mkFF(r::R, empty()) - - reciprocal u == - mkFF((recip unit u)::R, - [[y.flg, y.fctr, - y.xpnt]$FF for y in factorList u]) - - exponent u == -- exponent of first factor - empty?(fl := factorList u) or zero? u => 0 - first(fl).xpnt - - nthExponent(u, i) == - l := factorList u - zero? u or i < 1 or i > #l => 0 - (l.(minIndex(l) + i - 1)).xpnt - - nthFactor(u, i) == - zero? u => 0 - zero? i => unit u - l := factorList u - negative? i or i > #l => 1 - (l.(minIndex(l) + i - 1)).fctr - - nthFlag(u, i) == - l := factorList u - zero? u or i < 1 or i > #l => "nil" - (l.(minIndex(l) + i - 1)).flg - - flagFactor(r, i, fl) == - zero? i => 1 - zero? r => 0 - unitNormalize mkFF(1, [[fl, r, i]$FF]) - - differentiate(u:%, deriv: R -> R) == - ans := deriv(unit u) * ((u exquo unit(u)::%)::%) - ans + (_+/[fact.xpnt * deriv(fact.fctr) * - ((u exquo nilFactor(fact.fctr, 1))::%) for fact in factorList u]) - -@ - -This operation provides an implementation of [[differentiate]] from the -category [[DifferentialExtension]]. It uses the formula - -$$\frac{d}{dx} f(x) = \sum_{i=1}^n \frac{f(x)}{f_i(x)}\frac{d}{dx}f_i(x),$$ - -where - -$$f(x)=\prod_{i=1}^n f_i(x).$$ - -Note that up to [[patch--40]] the following wrong definition was used: - -\begin{verbatim} - differentiate(u:%, deriv: R -> R) == - ans := deriv(unit u) * ((u exquo (fr := unit(u)::%))::%) - ans + fr * (_+/[fact.xpnt * deriv(fact.fctr) * - ((u exquo nilFactor(fact.fctr, 1))::%) for fact in factorList u]) -\end{verbatim} - -which causes wrong results as soon as units are involved, for example in -\begin{verbatim} - D(factor (-x), x) -\end{verbatim} - -(Issue~\#176) - -<>= - map(fn, u) == - fn(unit u) * _*/[irreducibleFactor(fn(f.fctr),f.xpnt) for f in factorList u] - - u exquo v == - empty?(x1 := factorList v) => unitNormal(retract v).associate * u - empty? factorList u => "failed" - v1 := u * reciprocal v - goodQuotient:Boolean := true - while (goodQuotient and (not empty? x1)) repeat - if x1.first.xpnt < 0 - then goodQuotient := false - else x1 := rest x1 - goodQuotient => v1 - "failed" - - unitNormal u == -- does a bunch of work, but more canonical - (ur := recip(un := unit u)) case "failed" => [1, u, 1] - as := ur::R - vl := empty()$List(FF) - for x in factorList u repeat - ucar := unitNormal(x.fctr) - e := abs(x.xpnt)::NonNegativeInteger - if x.xpnt < 0 - then -- associate is recip of unit - un := un * (ucar.associate ** e) - as := as * (ucar.unit ** e) - else - un := un * (ucar.unit ** e) - as := as * (ucar.associate ** e) --- if not one?(ucar.canonical) then - if not ((ucar.canonical) = 1) then - vl := concat([x.flg, ucar.canonical, x.xpnt], vl) - [mkFF(un, empty()), mkFF(1, reverse_! vl), mkFF(as, empty())] - - unitNormalize u == - uca := unitNormal u - mkFF(unit(uca.unit)*unit(uca.canonical),factorList(uca.canonical)) - - if R has GcdDomain then - u + v == - zero? u => v - zero? v => u - v1 := reciprocal(u1 := gcd(u, v)) - (expand(u * v1) + expand(v * v1)) * u1 - - gcd(u, v) == --- one? u or one? v => 1 - (u = 1) or (v = 1) => 1 - zero? u => v - zero? v => u - f1 := empty()$List(Integer) -- list of used factor indices in x - f2 := f1 -- list of indices corresponding to a given factor - f3 := empty()$List(List Integer) -- list of f2-like lists - x := concat(factorList u, factorList v) - for i in minIndex x .. maxIndex x repeat - if not member?(i, f1) then - f1 := concat(i, f1) - f2 := [i] - for j in i+1..maxIndex x repeat - if x.i.fctr = x.j.fctr then - f1 := concat(j, f1) - f2 := concat(j, f2) - f3 := concat(f2, f3) - x1 := empty()$List(FF) - while not empty? f3 repeat - f1 := first f3 - if #f1 > 1 then - i := first f1 - y := copy x.i - f1 := rest f1 - while not empty? f1 repeat - i := first f1 - if x.i.xpnt < y.xpnt then y.xpnt := x.i.xpnt - f1 := rest f1 - x1 := concat(y, x1) - f3 := rest f3 - if orderedR? then x1 := sort_!(LispLessP, x1) - mkFF(1, x1) - - else -- R not a GCD domain - u + v == - zero? u => v - zero? v => u - irreducibleFactor(expand u + expand v, 1) - - if R has UniqueFactorizationDomain then - prime? u == - not(empty?(l := factorList u)) and (empty? rest l) and --- one?(l.first.xpnt) and (l.first.flg case "prime") - ((l.first.xpnt) = 1) and (l.first.flg case "prime") - -@ \section{package FRUTIL FactoredFunctionUtilities} <>= )abbrev package FRUTIL FactoredFunctionUtilities @@ -1450,7 +250,6 @@ FactoredFunctions2(R, S): Exports == Implementation where <<*>>= <> -<> <> <> @ diff --git a/src/algebra/fraction.spad.pamphlet b/src/algebra/fraction.spad.pamphlet index 2ac8ed3..47c7743 100644 --- a/src/algebra/fraction.spad.pamphlet +++ b/src/algebra/fraction.spad.pamphlet @@ -9,106 +9,6 @@ \eject \tableofcontents \eject -\section{domain LO Localize} -<>= -)abbrev domain LO Localize -++ Author: Dave Barton, Barry Trager -++ Date Created: -++ Date Last Updated: -++ Basic Functions: + - / numer denom -++ Related Constructors: -++ Also See: -++ AMS Classifications: -++ Keywords: localization -++ References: -++ Description: Localize(M,R,S) produces fractions with numerators -++ from an R module M and denominators from some multiplicative subset -++ D of R. -Localize(M:Module R, - R:CommutativeRing, - S:SubsetCategory(Monoid, R)): Module R with - if M has OrderedAbelianGroup then OrderedAbelianGroup - _/ :(%,S) -> % - ++ x / d divides the element x by d. - _/ :(M,S) -> % - ++ m / d divides the element m by d. - numer: % -> M - ++ numer x returns the numerator of x. - denom: % -> S - ++ denom x returns the denominator of x. - == - add - --representation - Rep:= Record(num:M,den:S) - --declarations - x,y: % - n: Integer - m: M - r: R - d: S - --definitions - 0 == [0,1] - zero? x == zero? (x.num) - -x== [-x.num,x.den] - x=y == y.den*x.num = x.den*y.num - numer x == x.num - denom x == x.den - if M has OrderedAbelianGroup then - x < y == --- if y.den::R < 0 then (x,y):=(y,x) --- if x.den::R < 0 then (x,y):=(y,x) - y.den*x.num < x.den*y.num - x+y == [y.den*x.num+x.den*y.num, x.den*y.den] - n*x == [n*x.num,x.den] - r*x == if r=x.den then [x.num,1] else [r*x.num,x.den] - x/d == - zero?(u:S:=d*x.den) => error "division by zero" - [x.num,u] - m/d == if zero? d then error "division by zero" else [m,d] - coerce(x:%):OutputForm == --- one?(xd:=x.den) => (x.num)::OutputForm - ((xd:=x.den) = 1) => (x.num)::OutputForm - (x.num)::OutputForm / (xd::OutputForm) - latex(x:%): String == --- one?(xd:=x.den) => latex(x.num) - ((xd:=x.den) = 1) => latex(x.num) - nl : String := concat("{", concat(latex(x.num), "}")$String)$String - dl : String := concat("{", concat(latex(x.den), "}")$String)$String - concat("{ ", concat(nl, concat(" \over ", concat(dl, " }")$String)$String)$String)$String - -@ -\section{domain LA LocalAlgebra} -<>= -)abbrev domain LA LocalAlgebra -++ Author: Dave Barton, Barry Trager -++ Date Created: -++ Date Last Updated: -++ Basic Functions: -++ Related Constructors: -++ Also See: -++ AMS Classifications: -++ Keywords: -++ References: -++ Description: LocalAlgebra produces the localization of an algebra, i.e. -++ fractions whose numerators come from some R algebra. -LocalAlgebra(A: Algebra R, - R: CommutativeRing, - S: SubsetCategory(Monoid, R)): Algebra R with - if A has OrderedRing then OrderedRing - _/ : (%,S) -> % - ++ x / d divides the element x by d. - _/ : (A,S) -> % - ++ a / d divides the element \spad{a} by d. - numer: % -> A - ++ numer x returns the numerator of x. - denom: % -> S - ++ denom x returns the denominator of x. - == Localize(A, R, S) add - 1 == 1$A / 1$S - x:% * y:% == (numer(x) * numer(y)) / (denom(x) * denom(y)) - characteristic() == characteristic()$A - -@ \section{package QFCAT2 QuotientFieldCategoryFunctions2} <>= )abbrev package QFCAT2 QuotientFieldCategoryFunctions2 @@ -138,588 +38,6 @@ QuotientFieldCategoryFunctions2(A, B, R, S): Exports == Impl where map(f, r) == f(numer r) / f(denom r) @ -\section{domain FRAC Fraction} -<>= --- fraction.spad.pamphlet Fraction.input -)spool Fraction.output -)set message test on -)set message auto off -)clear all ---S 1 of 12 -a := 11/12 ---R ---R ---R 11 ---R (1) -- ---R 12 ---R Type: Fraction Integer ---E 1 - ---S 2 of 12 -b := 23/24 ---R ---R ---R 23 ---R (2) -- ---R 24 ---R Type: Fraction Integer ---E 2 - ---S 3 of 12 -3 - a*b**2 + a + b/a ---R ---R ---R 313271 ---R (3) ------ ---R 76032 ---R Type: Fraction Integer ---E 3 - ---S 4 of 12 -numer(a) ---R ---R ---R (4) 11 ---R Type: PositiveInteger ---E 4 - ---S 5 of 12 -denom(b) ---R ---R ---R (5) 24 ---R Type: PositiveInteger ---E 5 - ---S 6 of 12 -r := (x**2 + 2*x + 1)/(x**2 - 2*x + 1) ---R ---R ---R 2 ---R x + 2x + 1 ---R (6) ----------- ---R 2 ---R x - 2x + 1 ---R Type: Fraction Polynomial Integer ---E 6 - ---S 7 of 12 -factor(r) ---R ---R ---R 2 ---R x + 2x + 1 ---R (7) ----------- ---R 2 ---R x - 2x + 1 ---R Type: Factored Fraction Polynomial Integer ---E 7 - ---S 8 of 12 -map(factor,r) ---R ---R ---R 2 ---R (x + 1) ---R (8) -------- ---R 2 ---R (x - 1) ---R Type: Fraction Factored Polynomial Integer ---E 8 - ---S 9 of 12 -continuedFraction(7/12) ---R ---R ---R 1 | 1 | 1 | 1 | ---R (9) +---+ + +---+ + +---+ + +---+ ---R | 1 | 1 | 2 | 2 ---R Type: ContinuedFraction Integer ---E 9 - ---S 10 of 12 -partialFraction(7,12) ---R ---R ---R 3 1 ---R (10) 1 - -- + - ---R 2 3 ---R 2 ---R Type: PartialFraction Integer ---E 10 - ---S 11 of 12 -g := 2/3 + 4/5*%i ---R ---R ---R 2 4 ---R (11) - + - %i ---R 3 5 ---R Type: Complex Fraction Integer ---E 11 - ---S 12 of 12 -g :: FRAC COMPLEX INT ---R ---R ---R 10 + 12%i ---R (12) --------- ---R 15 ---R Type: Fraction Complex Integer ---E 12 -)spool -)lisp (bye) -@ -<>= -==================================================================== -Fraction examples -==================================================================== - -The Fraction domain implements quotients. The elements must -belong to a domain of category IntegralDomain: multiplication -must be commutative and the product of two non-zero elements must not -be zero. This allows you to make fractions of most things you would -think of, but don't expect to create a fraction of two matrices! The -abbreviation for Fraction is FRAC. - -Use / to create a fraction. - - a := 11/12 - 11 - -- - 12 - Type: Fraction Integer - - b := 23/24 - 23 - -- - 24 - Type: Fraction Integer - -The standard arithmetic operations are available. - - 3 - a*b**2 + a + b/a - 313271 - ------ - 76032 - Type: Fraction Integer - -Extract the numerator and denominator by using numer and denom, -respectively. - - numer(a) - 11 - Type: PositiveInteger - - denom(b) - 24 - Type: PositiveInteger - -Operations like max, min, negative?, positive? and zero? -are all available if they are provided for the numerators and -denominators. - -Don't expect a useful answer from factor, gcd or lcm if you apply -them to fractions. - - r := (x**2 + 2*x + 1)/(x**2 - 2*x + 1) - 2 - x + 2x + 1 - ----------- - 2 - x - 2x + 1 - Type: Fraction Polynomial Integer - -Since all non-zero fractions are invertible, these operations have trivial -definitions. - - factor(r) - 2 - x + 2x + 1 - ----------- - 2 - x - 2x + 1 - Type: Factored Fraction Polynomial Integer - -Use map to apply factor to the numerator and denominator, which is -probably what you mean. - - map(factor,r) - 2 - (x + 1) - -------- - 2 - (x - 1) - Type: Fraction Factored Polynomial Integer - -Other forms of fractions are available. Use continuedFraction to -create a continued fraction. - - continuedFraction(7/12) - 1 | 1 | 1 | 1 | - +---+ + +---+ + +---+ + +---+ - | 1 | 1 | 2 | 2 - Type: ContinuedFraction Integer - -Use partialFraction to create a partial fraction. - - partialFraction(7,12) - 3 1 - 1 - -- + - - 2 3 - 2 - Type: PartialFraction Integer - -Use conversion to create alternative views of fractions with objects -moved in and out of the numerator and denominator. - - g := 2/3 + 4/5*%i - 2 4 - - + - %i - 3 5 - Type: Complex Fraction Integer - - g :: FRAC COMPLEX INT - 10 + 12%i - --------- - 15 - Type: Fraction Complex Integer - -See Also: -o )help ContinuedFraction -o )help PartialFraction -o )help Integer -o )show Fraction -o $AXIOM/doc/src/algebra/fraction.spad.dvi - -@ -<>= -)abbrev domain FRAC Fraction -++ Author: -++ Date Created: -++ Date Last Updated: 12 February 1992 -++ Basic Functions: Field, numer, denom -++ Related Constructors: -++ Also See: -++ AMS Classifications: -++ Keywords: fraction, localization -++ References: -++ Description: Fraction takes an IntegralDomain S and produces -++ the domain of Fractions with numerators and denominators from S. -++ If S is also a GcdDomain, then gcd's between numerator and -++ denominator will be cancelled during all operations. -Fraction(S: IntegralDomain): QuotientFieldCategory S with - if S has IntegerNumberSystem and S has OpenMath then OpenMath - if S has canonical and S has GcdDomain and S has canonicalUnitNormal - then canonical - ++ \spad{canonical} means that equal elements are in fact identical. - == LocalAlgebra(S, S, S) add - Rep:= Record(num:S, den:S) - coerce(d:S):% == [d,1] - zero?(x:%) == zero? x.num - - - if S has GcdDomain and S has canonicalUnitNormal then - retract(x:%):S == --- one?(x.den) => x.num - ((x.den) = 1) => x.num - error "Denominator not equal to 1" - - retractIfCan(x:%):Union(S, "failed") == --- one?(x.den) => x.num - ((x.den) = 1) => x.num - "failed" - else - retract(x:%):S == - (a:= x.num exquo x.den) case "failed" => - error "Denominator not equal to 1" - a - retractIfCan(x:%):Union(S,"failed") == x.num exquo x.den - - if S has EuclideanDomain then - wholePart x == --- one?(x.den) => x.num - ((x.den) = 1) => x.num - x.num quo x.den - - if S has IntegerNumberSystem then - - floor x == --- one?(x.den) => x.num - ((x.den) = 1) => x.num - x < 0 => -ceiling(-x) - wholePart x - - ceiling x == --- one?(x.den) => x.num - ((x.den) = 1) => x.num - x < 0 => -floor(-x) - 1 + wholePart x - - if S has OpenMath then - -- TODO: somwhere this file does something which redefines the division - -- operator. Doh! - - writeOMFrac(dev: OpenMathDevice, x: %): Void == - OMputApp(dev) - OMputSymbol(dev, "nums1", "rational") - OMwrite(dev, x.num, false) - OMwrite(dev, x.den, false) - OMputEndApp(dev) - - OMwrite(x: %): String == - s: String := "" - sp := OM_-STRINGTOSTRINGPTR(s)$Lisp - dev: OpenMathDevice := _ - OMopenString(sp pretend String, OMencodingXML) - OMputObject(dev) - writeOMFrac(dev, x) - OMputEndObject(dev) - OMclose(dev) - s := OM_-STRINGPTRTOSTRING(sp)$Lisp pretend String - s - - OMwrite(x: %, wholeObj: Boolean): String == - s: String := "" - sp := OM_-STRINGTOSTRINGPTR(s)$Lisp - dev: OpenMathDevice := _ - OMopenString(sp pretend String, OMencodingXML) - if wholeObj then - OMputObject(dev) - writeOMFrac(dev, x) - if wholeObj then - OMputEndObject(dev) - OMclose(dev) - s := OM_-STRINGPTRTOSTRING(sp)$Lisp pretend String - s - - OMwrite(dev: OpenMathDevice, x: %): Void == - OMputObject(dev) - writeOMFrac(dev, x) - OMputEndObject(dev) - - OMwrite(dev: OpenMathDevice, x: %, wholeObj: Boolean): Void == - if wholeObj then - OMputObject(dev) - writeOMFrac(dev, x) - if wholeObj then - OMputEndObject(dev) - - if S has GcdDomain then - cancelGcd: % -> S - normalize: % -> % - - normalize x == - zero?(x.num) => 0 --- one?(x.den) => x - ((x.den) = 1) => x - uca := unitNormal(x.den) - zero?(x.den := uca.canonical) => error "division by zero" - x.num := x.num * uca.associate - x - - recip x == - zero?(x.num) => "failed" - normalize [x.den, x.num] - - cancelGcd x == --- one?(x.den) => x.den - ((x.den) = 1) => x.den - d := gcd(x.num, x.den) - xn := x.num exquo d - xn case "failed" => - error "gcd not gcd in QF cancelGcd (numerator)" - xd := x.den exquo d - xd case "failed" => - error "gcd not gcd in QF cancelGcd (denominator)" - x.num := xn :: S - x.den := xd :: S - d - - nn:S / dd:S == - zero? dd => error "division by zero" - cancelGcd(z := [nn, dd]) - normalize z - - x + y == - zero? y => x - zero? x => y - z := [x.den,y.den] - d := cancelGcd z - g := [z.den * x.num + z.num * y.num, d] - cancelGcd g - g.den := g.den * z.num * z.den - normalize g - - -- We can not rely on the defaulting mechanism - -- to supply a definition for -, even though this - -- definition would do, for thefollowing reasons: - -- 1) The user could have defined a subtraction - -- in Localize, which would not work for - -- QuotientField; - -- 2) even if he doesn't, the system currently - -- places a default definition in Localize, - -- which uses Localize's +, which does not - -- cancel gcds - x - y == - zero? y => x - z := [x.den, y.den] - d := cancelGcd z - g := [z.den * x.num - z.num * y.num, d] - cancelGcd g - g.den := g.den * z.num * z.den - normalize g - - x:% * y:% == - zero? x or zero? y => 0 --- one? x => y - (x = 1) => y --- one? y => x - (y = 1) => x - (x, y) := ([x.num, y.den], [y.num, x.den]) - cancelGcd x; cancelGcd y; - normalize [x.num * y.num, x.den * y.den] - - n:Integer * x:% == - y := [n::S, x.den] - cancelGcd y - normalize [x.num * y.num, y.den] - - nn:S * x:% == - y := [nn, x.den] - cancelGcd y - normalize [x.num * y.num, y.den] - - differentiate(x:%, deriv:S -> S) == - y := [deriv(x.den), x.den] - d := cancelGcd(y) - y.num := deriv(x.num) * y.den - x.num * y.num - (d, y.den) := (y.den, d) - cancelGcd y - y.den := y.den * d * d - normalize y - - if S has canonicalUnitNormal then - x = y == (x.num = y.num) and (x.den = y.den) - --x / dd == (cancelGcd (z:=[x.num,dd*x.den]); normalize z) - --- one? x == one? (x.num) and one? (x.den) - one? x == ((x.num) = 1) and ((x.den) = 1) - -- again assuming canonical nature of representation - - else - nn:S/dd:S == if zero? dd then error "division by zero" else [nn,dd] - - recip x == - zero?(x.num) => "failed" - [x.den, x.num] - - if (S has RetractableTo Fraction Integer) then - retract(x:%):Fraction(Integer) == retract(retract(x)@S) - - retractIfCan(x:%):Union(Fraction Integer, "failed") == - (u := retractIfCan(x)@Union(S, "failed")) case "failed" => "failed" - retractIfCan(u::S) - - else if (S has RetractableTo Integer) then - retract(x:%):Fraction(Integer) == - retract(numer x) / retract(denom x) - - retractIfCan(x:%):Union(Fraction Integer, "failed") == - (n := retractIfCan numer x) case "failed" => "failed" - (d := retractIfCan denom x) case "failed" => "failed" - (n::Integer) / (d::Integer) - - QFP ==> SparseUnivariatePolynomial % - DP ==> SparseUnivariatePolynomial S - import UnivariatePolynomialCategoryFunctions2(%,QFP,S,DP) - import UnivariatePolynomialCategoryFunctions2(S,DP,%,QFP) - - if S has GcdDomain then - gcdPolynomial(pp,qq) == - zero? pp => qq - zero? qq => pp - zero? degree pp or zero? degree qq => 1 - denpp:="lcm"/[denom u for u in coefficients pp] - ppD:DP:=map(retract(#1*denpp),pp) - denqq:="lcm"/[denom u for u in coefficients qq] - qqD:DP:=map(retract(#1*denqq),qq) - g:=gcdPolynomial(ppD,qqD) - zero? degree g => 1 --- one? (lc:=leadingCoefficient g) => map(#1::%,g) - ((lc:=leadingCoefficient g) = 1) => map(#1::%,g) - map(#1 / lc,g) - - if (S has PolynomialFactorizationExplicit) then - -- we'll let the solveLinearPolynomialEquations operator - -- default from Field - pp,qq: QFP - lpp: List QFP - import Factored SparseUnivariatePolynomial % - if S has CharacteristicNonZero then - if S has canonicalUnitNormal and S has GcdDomain then - charthRoot x == - n:= charthRoot x.num - n case "failed" => "failed" - d:=charthRoot x.den - d case "failed" => "failed" - n/d - else - charthRoot x == - -- to find x = p-th root of n/d - -- observe that xd is p-th root of n*d**(p-1) - ans:=charthRoot(x.num * - (x.den)**(characteristic()$%-1)::NonNegativeInteger) - ans case "failed" => "failed" - ans / x.den - clear: List % -> List S - clear l == - d:="lcm"/[x.den for x in l] - [ x.num * (d exquo x.den)::S for x in l] - mat: Matrix % - conditionP mat == - matD: Matrix S - matD:= matrix [ clear l for l in listOfLists mat ] - ansD := conditionP matD - ansD case "failed" => "failed" - ansDD:=ansD :: Vector(S) - [ ansDD(i)::% for i in 1..#ansDD]$Vector(%) - - factorPolynomial(pp) == - zero? pp => 0 - denpp:="lcm"/[denom u for u in coefficients pp] - ppD:DP:=map(retract(#1*denpp),pp) - ff:=factorPolynomial ppD - den1:%:=denpp::% - lfact:List Record(flg:Union("nil", "sqfr", "irred", "prime"), - fctr:QFP, xpnt:Integer) - lfact:= [[w.flg, - if leadingCoefficient w.fctr =1 then map(#1::%,w.fctr) - else (lc:=(leadingCoefficient w.fctr)::%; - den1:=den1/lc**w.xpnt; - map(#1::%/lc,w.fctr)), - w.xpnt] for w in factorList ff] - makeFR(map(#1::%/den1,unit(ff)),lfact) - factorSquareFreePolynomial(pp) == - zero? pp => 0 - degree pp = 0 => makeFR(pp,empty()) - lcpp:=leadingCoefficient pp - pp:=pp/lcpp - denpp:="lcm"/[denom u for u in coefficients pp] - ppD:DP:=map(retract(#1*denpp),pp) - ff:=factorSquareFreePolynomial ppD - den1:%:=denpp::%/lcpp - lfact:List Record(flg:Union("nil", "sqfr", "irred", "prime"), - fctr:QFP, xpnt:Integer) - lfact:= [[w.flg, - if leadingCoefficient w.fctr =1 then map(#1::%,w.fctr) - else (lc:=(leadingCoefficient w.fctr)::%; - den1:=den1/lc**w.xpnt; - map(#1::%/lc,w.fctr)), - w.xpnt] for w in factorList ff] - makeFR(map(#1::%/den1,unit(ff)),lfact) - -@ \section{package LPEFRAC LinearPolynomialEquationByFractions} <>= )abbrev package LPEFRAC LinearPolynomialEquationByFractions @@ -840,10 +158,7 @@ FractionFunctions2(A, B): Exports == Impl where <<*>>= <> -<> -<> <> -<> <> <> @ diff --git a/src/algebra/free.spad.pamphlet b/src/algebra/free.spad.pamphlet deleted file mode 100644 index ac84705..0000000 --- a/src/algebra/free.spad.pamphlet +++ /dev/null @@ -1,557 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra free.spad} -\author{Manuel Bronstein, Stephen M. Watt} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{domain LMOPS ListMonoidOps} -<>= -)abbrev domain LMOPS ListMonoidOps -++ Internal representation for monoids -++ Author: Manuel Bronstein -++ Date Created: November 1989 -++ Date Last Updated: 6 June 1991 -++ Description: -++ This internal package represents monoid (abelian or not, with or -++ without inverses) as lists and provides some common operations -++ to the various flavors of monoids. -ListMonoidOps(S, E, un): Exports == Implementation where - S : SetCategory - E : AbelianMonoid - un: E - - REC ==> Record(gen:S, exp: E) - O ==> OutputForm - - Exports ==> Join(SetCategory, RetractableTo S) with - outputForm : ($, (O, O) -> O, (O, O) -> O, Integer) -> O - ++ outputForm(l, fop, fexp, unit) converts the monoid element - ++ represented by l to an \spadtype{OutputForm}. - ++ Argument unit is the output form - ++ for the \spadignore{unit} of the monoid (e.g. 0 or 1), - ++ \spad{fop(a, b)} is the - ++ output form for the monoid operation applied to \spad{a} and b - ++ (e.g. \spad{a + b}, \spad{a * b}, \spad{ab}), - ++ and \spad{fexp(a, n)} is the output form - ++ for the exponentiation operation applied to \spad{a} and n - ++ (e.g. \spad{n a}, \spad{n * a}, \spad{a ** n}, \spad{a\^n}). - listOfMonoms : $ -> List REC - ++ listOfMonoms(l) returns the list of the monomials forming l. - makeTerm : (S, E) -> $ - ++ makeTerm(s, e) returns the monomial s exponentiated by e - ++ (e.g. s^e or e * s). - makeMulti : List REC -> $ - ++ makeMulti(l) returns the element whose list of monomials is l. - nthExpon : ($, Integer) -> E - ++ nthExpon(l, n) returns the exponent of the n^th monomial of l. - nthFactor : ($, Integer) -> S - ++ nthFactor(l, n) returns the factor of the n^th monomial of l. - reverse : $ -> $ - ++ reverse(l) reverses the list of monomials forming l. This - ++ has some effect if the monoid is non-abelian, i.e. - ++ \spad{reverse(a1\^e1 ... an\^en) = an\^en ... a1\^e1} which is different. - reverse_! : $ -> $ - ++ reverse!(l) reverses the list of monomials forming l, destroying - ++ the element l. - size : $ -> NonNegativeInteger - ++ size(l) returns the number of monomials forming l. - makeUnit : () -> $ - ++ makeUnit() returns the unit element of the monomial. - rightMult : ($, S) -> $ - ++ rightMult(a, s) returns \spad{a * s} where \spad{*} - ++ is the monoid operation, - ++ which is assumed non-commutative. - leftMult : (S, $) -> $ - ++ leftMult(s, a) returns \spad{s * a} where - ++ \spad{*} is the monoid operation, - ++ which is assumed non-commutative. - plus : (S, E, $) -> $ - ++ plus(s, e, x) returns \spad{e * s + x} where \spad{+} - ++ is the monoid operation, - ++ which is assumed commutative. - plus : ($, $) -> $ - ++ plus(x, y) returns \spad{x + y} where \spad{+} - ++ is the monoid operation, - ++ which is assumed commutative. - commutativeEquality: ($, $) -> Boolean - ++ commutativeEquality(x,y) returns true if x and y are equal - ++ assuming commutativity - mapExpon : (E -> E, $) -> $ - ++ mapExpon(f, a1\^e1 ... an\^en) returns \spad{a1\^f(e1) ... an\^f(en)}. - mapGen : (S -> S, $) -> $ - ++ mapGen(f, a1\^e1 ... an\^en) returns \spad{f(a1)\^e1 ... f(an)\^en}. - - Implementation ==> add - Rep := List REC - - localplus: ($, $) -> $ - - makeUnit() == empty()$Rep - size l == # listOfMonoms l - coerce(s:S):$ == [[s, un]] - coerce(l:$):O == coerce(l)$Rep - makeTerm(s, e) == (zero? e => makeUnit(); [[s, e]]) - makeMulti l == l - f = g == f =$Rep g - listOfMonoms l == l pretend List(REC) - nthExpon(f, i) == f.(i-1+minIndex f).exp - nthFactor(f, i) == f.(i-1+minIndex f).gen - reverse l == reverse(l)$Rep - reverse_! l == reverse_!(l)$Rep - mapGen(f, l) == [[f(x.gen), x.exp] for x in l] - - mapExpon(f, l) == - ans:List(REC) := empty() - for x in l repeat - if (a := f(x.exp)) ^= 0 then ans := concat([x.gen, a], ans) - reverse_! ans - - outputForm(l, op, opexp, id) == - empty? l => id::OutputForm - l:List(O) := - [(p.exp = un => p.gen::O; opexp(p.gen::O, p.exp::O)) for p in l] - reduce(op, l) - - retractIfCan(l:$):Union(S, "failed") == - not empty? l and empty? rest l and l.first.exp = un => l.first.gen - "failed" - - rightMult(f, s) == - empty? f => s::$ - s = f.last.gen => (setlast_!(h := copy f, [s, f.last.exp + un]); h) - concat(f, [s, un]) - - leftMult(s, f) == - empty? f => s::$ - s = f.first.gen => concat([s, f.first.exp + un], rest f) - concat([s, un], f) - - commutativeEquality(s1:$, s2:$):Boolean == - #s1 ^= #s2 => false - for t1 in s1 repeat - if not member?(t1,s2) then return false - true - - plus_!(s:S, n:E, f:$):$ == - h := g := concat([s, n], f) - h1 := rest h - while not empty? h1 repeat - s = h1.first.gen => - l := - zero?(m := n + h1.first.exp) => rest h1 - concat([s, m], rest h1) - setrest_!(h, l) - return rest g - h := h1 - h1 := rest h1 - g - - plus(s, n, f) == plus_!(s,n,copy f) - - plus(f, g) == - #f < #g => localplus(f, g) - localplus(g, f) - - localplus(f, g) == - g := copy g - for x in f repeat - g := plus(x.gen, x.exp, g) - g - -@ -\section{domain FMONOID FreeMonoid} -<>= -)abbrev domain FMONOID FreeMonoid -++ Free monoid on any set of generators -++ Author: Stephen M. Watt -++ Date Created: ??? -++ Date Last Updated: 6 June 1991 -++ Description: -++ The free monoid on a set S is the monoid of finite products of -++ the form \spad{reduce(*,[si ** ni])} where the si's are in S, and the ni's -++ are nonnegative integers. The multiplication is not commutative. -FreeMonoid(S: SetCategory): FMcategory == FMdefinition where - NNI ==> NonNegativeInteger - REC ==> Record(gen: S, exp: NonNegativeInteger) - Ex ==> OutputForm - - FMcategory ==> Join(Monoid, RetractableTo S) with - "*": (S, $) -> $ - ++ s * x returns the product of x by s on the left. - "*": ($, S) -> $ - ++ x * s returns the product of x by s on the right. - "**": (S, NonNegativeInteger) -> $ - ++ s ** n returns the product of s by itself n times. - hclf: ($, $) -> $ - ++ hclf(x, y) returns the highest common left factor of x and y, - ++ i.e. the largest d such that \spad{x = d a} and \spad{y = d b}. - hcrf: ($, $) -> $ - ++ hcrf(x, y) returns the highest common right factor of x and y, - ++ i.e. the largest d such that \spad{x = a d} and \spad{y = b d}. - lquo: ($, $) -> Union($, "failed") - ++ lquo(x, y) returns the exact left quotient of x by y i.e. - ++ q such that \spad{x = y * q}, - ++ "failed" if x is not of the form \spad{y * q}. - rquo: ($, $) -> Union($, "failed") - ++ rquo(x, y) returns the exact right quotient of x by y i.e. - ++ q such that \spad{x = q * y}, - ++ "failed" if x is not of the form \spad{q * y}. - divide: ($, $) -> Union(Record(lm: $, rm: $), "failed") - ++ divide(x, y) returns the left and right exact quotients of - ++ x by y, i.e. \spad{[l, r]} such that \spad{x = l * y * r}, - ++ "failed" if x is not of the form \spad{l * y * r}. - overlap: ($, $) -> Record(lm: $, mm: $, rm: $) - ++ overlap(x, y) returns \spad{[l, m, r]} such that - ++ \spad{x = l * m}, \spad{y = m * r} and l and r have no overlap, - ++ i.e. \spad{overlap(l, r) = [l, 1, r]}. - size : $ -> NNI - ++ size(x) returns the number of monomials in x. - factors : $ -> List Record(gen: S, exp: NonNegativeInteger) - ++ factors(a1\^e1,...,an\^en) returns \spad{[[a1, e1],...,[an, en]]}. - nthExpon : ($, Integer) -> NonNegativeInteger - ++ nthExpon(x, n) returns the exponent of the n^th monomial of x. - nthFactor : ($, Integer) -> S - ++ nthFactor(x, n) returns the factor of the n^th monomial of x. - mapExpon : (NNI -> NNI, $) -> $ - ++ mapExpon(f, a1\^e1 ... an\^en) returns \spad{a1\^f(e1) ... an\^f(en)}. - mapGen : (S -> S, $) -> $ - ++ mapGen(f, a1\^e1 ... an\^en) returns \spad{f(a1)\^e1 ... f(an)\^en}. - if S has OrderedSet then OrderedSet - - FMdefinition ==> ListMonoidOps(S, NonNegativeInteger, 1) add - Rep := ListMonoidOps(S, NonNegativeInteger, 1) - - 1 == makeUnit() - one? f == empty? listOfMonoms f - coerce(f:$): Ex == outputForm(f, "*", "**", 1) - hcrf(f, g) == reverse_! hclf(reverse f, reverse g) - f:$ * s:S == rightMult(f, s) - s:S * f:$ == leftMult(s, f) - factors f == copy listOfMonoms f - mapExpon(f, x) == mapExpon(f, x)$Rep - mapGen(f, x) == mapGen(f, x)$Rep - s:S ** n:NonNegativeInteger == makeTerm(s, n) - - f:$ * g:$ == --- one? f => g - (f = 1) => g --- one? g => f - (g = 1) => f - lg := listOfMonoms g - ls := last(lf := listOfMonoms f) - ls.gen = lg.first.gen => - setlast_!(h := copy lf,[lg.first.gen,lg.first.exp+ls.exp]) - makeMulti concat(h, rest lg) - makeMulti concat(lf, lg) - - overlap(la, ar) == --- one? la or one? ar => [la, 1, ar] - (la = 1) or (ar = 1) => [la, 1, ar] - lla := la0 := listOfMonoms la - lar := listOfMonoms ar - l:List(REC) := empty() - while not empty? lla repeat - if lla.first.gen = lar.first.gen then - if lla.first.exp < lar.first.exp and empty? rest lla then - return [makeMulti l, - makeTerm(lla.first.gen, lla.first.exp), - makeMulti concat([lar.first.gen, - (lar.first.exp - lla.first.exp)::NNI], - rest lar)] - if lla.first.exp >= lar.first.exp then - if (ru:= lquo(makeMulti rest lar, - makeMulti rest lla)) case $ then - if lla.first.exp > lar.first.exp then - l := concat_!(l, [lla.first.gen, - (lla.first.exp - lar.first.exp)::NNI]) - m := concat([lla.first.gen, lar.first.exp], - rest lla) - else m := lla - return [makeMulti l, makeMulti m, ru::$] - l := concat_!(l, lla.first) - lla := rest lla - [makeMulti la0, 1, makeMulti lar] - - divide(lar, a) == --- one? a => [lar, 1] - (a = 1) => [lar, 1] - Na : Integer := #(la := listOfMonoms a) - Nlar : Integer := #(llar := listOfMonoms lar) - l:List(REC) := empty() - while Na <= Nlar repeat - if llar.first.gen = la.first.gen and - llar.first.exp >= la.first.exp then - -- Can match a portion of this lar factor. - -- Now match tail. - (q:=lquo(makeMulti rest llar,makeMulti rest la))case $ => - if llar.first.exp > la.first.exp then - l := concat_!(l, [la.first.gen, - (llar.first.exp - la.first.exp)::NNI]) - return [makeMulti l, q::$] - l := concat_!(l, first llar) - llar := rest llar - Nlar := Nlar - 1 - "failed" - - hclf(f, g) == - h:List(REC) := empty() - for f0 in listOfMonoms f for g0 in listOfMonoms g repeat - f0.gen ^= g0.gen => return makeMulti h - h := concat_!(h, [f0.gen, min(f0.exp, g0.exp)]) - f0.exp ^= g0.exp => return makeMulti h - makeMulti h - - lquo(aq, a) == - size a > #(laq := copy listOfMonoms aq) => "failed" - for a0 in listOfMonoms a repeat - a0.gen ^= laq.first.gen or a0.exp > laq.first.exp => - return "failed" - if a0.exp = laq.first.exp then laq := rest laq - else setfirst_!(laq, [laq.first.gen, - (laq.first.exp - a0.exp)::NNI]) - makeMulti laq - - rquo(qa, a) == - (u := lquo(reverse qa, reverse a)) case "failed" => "failed" - reverse_!(u::$) - - if S has OrderedSet then - a < b == - la := listOfMonoms a - lb := listOfMonoms b - na: Integer := #la - nb: Integer := #lb - while na > 0 and nb > 0 repeat - la.first.gen > lb.first.gen => return false - la.first.gen < lb.first.gen => return true - if la.first.exp = lb.first.exp then - la:=rest la - lb:=rest lb - na:=na - 1 - nb:=nb - 1 - else if la.first.exp > lb.first.exp then - la:=concat([la.first.gen, - (la.first.exp - lb.first.exp)::NNI], rest lb) - lb:=rest lb - nb:=nb - 1 - else - lb:=concat([lb.first.gen, - (lb.first.exp-la.first.exp)::NNI], rest la) - la:=rest la - na:=na-1 - empty? la and not empty? lb - -@ -\section{domain FGROUP FreeGroup} -<>= -)abbrev domain FGROUP FreeGroup -++ Free group on any set of generators -++ Author: Stephen M. Watt -++ Date Created: ??? -++ Date Last Updated: 6 June 1991 -++ Description: -++ The free group on a set S is the group of finite products of -++ the form \spad{reduce(*,[si ** ni])} where the si's are in S, and the ni's -++ are integers. The multiplication is not commutative. -FreeGroup(S: SetCategory): Join(Group, RetractableTo S) with - "*": (S, $) -> $ - ++ s * x returns the product of x by s on the left. - "*": ($, S) -> $ - ++ x * s returns the product of x by s on the right. - "**" : (S, Integer) -> $ - ++ s ** n returns the product of s by itself n times. - size : $ -> NonNegativeInteger - ++ size(x) returns the number of monomials in x. - nthExpon : ($, Integer) -> Integer - ++ nthExpon(x, n) returns the exponent of the n^th monomial of x. - nthFactor : ($, Integer) -> S - ++ nthFactor(x, n) returns the factor of the n^th monomial of x. - mapExpon : (Integer -> Integer, $) -> $ - ++ mapExpon(f, a1\^e1 ... an\^en) returns \spad{a1\^f(e1) ... an\^f(en)}. - mapGen : (S -> S, $) -> $ - ++ mapGen(f, a1\^e1 ... an\^en) returns \spad{f(a1)\^e1 ... f(an)\^en}. - factors : $ -> List Record(gen: S, exp: Integer) - ++ factors(a1\^e1,...,an\^en) returns \spad{[[a1, e1],...,[an, en]]}. - == ListMonoidOps(S, Integer, 1) add - Rep := ListMonoidOps(S, Integer, 1) - - 1 == makeUnit() - one? f == empty? listOfMonoms f - s:S ** n:Integer == makeTerm(s, n) - f:$ * s:S == rightMult(f, s) - s:S * f:$ == leftMult(s, f) - inv f == reverse_! mapExpon("-", f) - factors f == copy listOfMonoms f - mapExpon(f, x) == mapExpon(f, x)$Rep - mapGen(f, x) == mapGen(f, x)$Rep - coerce(f:$):OutputForm == outputForm(f, "*", "**", 1) - - f:$ * g:$ == - one? f => g - one? g => f - r := reverse listOfMonoms f - q := copy listOfMonoms g - while not empty? r and not empty? q and r.first.gen = q.first.gen - and r.first.exp = -q.first.exp repeat - r := rest r - q := rest q - empty? r => makeMulti q - empty? q => makeMulti reverse_! r - r.first.gen = q.first.gen => - setlast_!(h := reverse_! r, - [q.first.gen, q.first.exp + r.first.exp]) - makeMulti concat_!(h, rest q) - makeMulti concat_!(reverse_! r, q) - -@ -\section{domain IFAMON InnerFreeAbelianMonoid} -<>= -)abbrev domain IFAMON InnerFreeAbelianMonoid -++ Internal free abelian monoid on any set of generators -++ Author: Manuel Bronstein -++ Date Created: November 1989 -++ Date Last Updated: 6 June 1991 -++ Description: -++ Internal implementation of a free abelian monoid. -InnerFreeAbelianMonoid(S: SetCategory, E:CancellationAbelianMonoid, un:E): - FreeAbelianMonoidCategory(S, E) == ListMonoidOps(S, E, un) add - Rep := ListMonoidOps(S, E, un) - - 0 == makeUnit() - zero? f == empty? listOfMonoms f - terms f == copy listOfMonoms f - nthCoef(f, i) == nthExpon(f, i) - nthFactor(f, i) == nthFactor(f, i)$Rep - s:S + f:$ == plus(s, un, f) - f:$ + g:$ == plus(f, g) - (f:$ = g:$):Boolean == commutativeEquality(f,g) - n:E * s:S == makeTerm(s, n) - n:NonNegativeInteger * f:$ == mapExpon(n * #1, f) - coerce(f:$):OutputForm == outputForm(f, "+", #2 * #1, 0) - mapCoef(f, x) == mapExpon(f, x) - mapGen(f, x) == mapGen(f, x)$Rep - - coefficient(s, f) == - for x in terms f repeat - x.gen = s => return(x.exp) - 0 - - if E has OrderedAbelianMonoid then - highCommonTerms(f, g) == - makeMulti [[x.gen, min(x.exp, n)] for x in listOfMonoms f | - (n := coefficient(x.gen, g)) > 0] - -@ -\section{domain FAMONOID FreeAbelianMonoid} -<>= -)abbrev domain FAMONOID FreeAbelianMonoid -++ Free abelian monoid on any set of generators -++ Author: Manuel Bronstein -++ Date Created: November 1989 -++ Date Last Updated: 6 June 1991 -++ Description: -++ The free abelian monoid on a set S is the monoid of finite sums of -++ the form \spad{reduce(+,[ni * si])} where the si's are in S, and the ni's -++ are non-negative integers. The operation is commutative. -FreeAbelianMonoid(S: SetCategory): - FreeAbelianMonoidCategory(S, NonNegativeInteger) - == InnerFreeAbelianMonoid(S, NonNegativeInteger, 1) - -@ -\section{domain FAGROUP FreeAbelianGroup} -<>= -)abbrev domain FAGROUP FreeAbelianGroup -++ Free abelian group on any set of generators -++ Author: Manuel Bronstein -++ Date Created: November 1989 -++ Date Last Updated: 6 June 1991 -++ Description: -++ The free abelian group on a set S is the monoid of finite sums of -++ the form \spad{reduce(+,[ni * si])} where the si's are in S, and the ni's -++ are integers. The operation is commutative. -FreeAbelianGroup(S:SetCategory): Exports == Implementation where - Exports ==> Join(AbelianGroup, Module Integer, - FreeAbelianMonoidCategory(S, Integer)) with - if S has OrderedSet then OrderedSet - - Implementation ==> InnerFreeAbelianMonoid(S, Integer, 1) add - - f == mapCoef("-", f) - - if S has OrderedSet then - inmax: List Record(gen: S, exp: Integer) -> Record(gen: S, exp:Integer) - - inmax l == - mx := first l - for t in rest l repeat - if mx.gen < t.gen then mx := t - mx - - -- lexicographic order - a < b == - zero? a => - zero? b => false - 0 < (inmax terms b).exp - ta := inmax terms a - zero? b => ta.exp < 0 - tb := inmax terms b - ta.gen < tb.gen => 0 < tb.exp - tb.gen < ta.gen => ta.exp < 0 - ta.exp < tb.exp => true - tb.exp < ta.exp => false - lc := ta.exp * ta.gen - (a - lc) < (b - lc) - -@ -\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/functions.spad.pamphlet b/src/algebra/functions.spad.pamphlet deleted file mode 100644 index 5dff2a1..0000000 --- a/src/algebra/functions.spad.pamphlet +++ /dev/null @@ -1,120 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra functions.spad} -\author{Brian Dupee} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{domain BFUNCT BasicFunctions} -<>= -)abbrev domain BFUNCT BasicFunctions -++ Author: Brian Dupee -++ Date Created: August 1994 -++ Date Last Updated: April 1996 -++ Basic Operations: bfKeys, bfEntry -++ Description: A Domain which implements a table containing details of -++ points at which particular functions have evaluation problems. -DF ==> DoubleFloat -SDF ==> Stream DoubleFloat -RS ==> Record(zeros: SDF, ones: SDF, singularities: SDF) - -BasicFunctions(): E == I where - E ==> SetCategory with - bfKeys:() -> List Symbol - ++ bfKeys() returns the names of each function in the - ++ \axiomType{BasicFunctions} table - bfEntry:Symbol -> RS - ++ bfEntry(k) returns the entry in the \axiomType{BasicFunctions} table - ++ corresponding to \spad{k} - finiteAggregate - - I ==> add - - Rep := Table(Symbol,RS) - import Rep, SDF - - f(x:DF):DF == - positive?(x) => -x - -x+1 - - bf():$ == - import RS - dpi := pi()$DF - ndpi:SDF := map(#1*dpi,(z := generate(f,0))) -- [n pi for n in Z] - n1dpi:SDF := map(-(2*(#1)-1)*dpi/2,z) -- [(n+1) pi /2] - n2dpi:SDF := map(2*#1*dpi,z) -- [2 n pi for n in Z] - n3dpi:SDF := map(-(4*(#1)-1)*dpi/4,z) - n4dpi:SDF := map(-(4*(#1)-1)*dpi/2,z) - sinEntry:RS := [ndpi, n4dpi, empty()$SDF] - cosEntry:RS := [n1dpi, n2dpi, esdf := empty()$SDF] - tanEntry:RS := [ndpi, n3dpi, n1dpi] - asinEntry:RS := [construct([0$DF])$SDF, - construct([float(8414709848078965,-16,10)$DF]), esdf] - acosEntry:RS := [construct([1$DF])$SDF, - construct([float(54030230586813977,-17,10)$DF]), esdf] - atanEntry:RS := [construct([0$DF])$SDF, - construct([float(15574077246549023,-16,10)$DF]), esdf] - secEntry:RS := [esdf, n2dpi, n1dpi] - cscEntry:RS := [esdf, n4dpi, ndpi] - cotEntry:RS := [n1dpi, n3dpi, ndpi] - logEntry:RS := [construct([1$DF])$SDF,esdf, construct([0$DF])$SDF] - entryList:List(Record(key:Symbol,entry:RS)) := - [[sin@Symbol, sinEntry], [cos@Symbol, cosEntry], - [tan@Symbol, tanEntry], [sec@Symbol, secEntry], - [csc@Symbol, cscEntry], [cot@Symbol, cotEntry], - [asin@Symbol, asinEntry], [acos@Symbol, acosEntry], - [atan@Symbol, atanEntry], [log@Symbol, logEntry]] - construct(entryList)$Rep - - bfKeys():List Symbol == keys(bf())$Rep - - bfEntry(k:Symbol):RS == qelt(bf(),k)$Rep - -@ -\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 fa77512..8115d1e 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -775,6 +775,8 @@ website add wmv, pdf to video page
browser lighten background image
20081202.02.tpd.patch website download.html add Doyen Thumbdrive
+20081203.01.tpd.patch +bookvol10.3 add domains
\ No newline at end of file