diff --git a/books/bookvol10.3.pamphlet b/books/bookvol10.3.pamphlet index 05cda8d..45a1be9 100644 --- a/books/bookvol10.3.pamphlet +++ b/books/bookvol10.3.pamphlet @@ -7036,6 +7036,10 @@ o $AXIOM/doc/src/algebra/radix.spad.dvi @ \pagehead{BinaryExpansion}{BINARY} \pagepic{ps/v103binaryexpansion.ps}{BINARY}{1.00} +See also:\\ +\refto{RadixExpansion}{RADIX} +\refto{DecimalExpansion}{DECIMAL} +\refto{HexadecimalExpansion}{HEXADEC} <>= )abbrev domain BINARY BinaryExpansion ++ Author: Clifton J. Williamson @@ -9399,6 +9403,708 @@ CartesianTensor(minix, dim, R): Exports == Implementation where @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain CHAR Character} +<>= +-- string.spad.pamphlet Character.input +)spool Character.output +)set message test on +)set message auto off +)clear all +--S 1 +chars := [char "a", char "A", char "X", char "8", char "+"] +--R +--R +--R (1) [a,A,X,8,+] +--R Type: List Character +--E 1 + +--S 2 +space() +--R +--R +--R (2) +--R Type: Character +--E 2 + +--S 3 +quote() +--R +--R +--R (3) " +--R Type: Character +--E 3 + +--S 4 +escape() +--R +--R +--R (4) _ +--R Type: Character +--E 4 + +--S 5 +[ord c for c in chars] +--R +--R +--R (5) [97,65,88,56,43] +--R Type: List Integer +--E 5 + +--S 6 +[upperCase c for c in chars] +--R +--R +--R (6) [A,A,X,8,+] +--R Type: List Character +--E 6 + +--S 7 +[lowerCase c for c in chars] +--R +--R +--R (7) [a,a,x,8,+] +--R Type: List Character +--E 7 + +--S 8 +[alphabetic? c for c in chars] +--R +--R +--R (8) [true,true,true,false,false] +--R Type: List Boolean +--E 8 + +--S 9 +[upperCase? c for c in chars] +--R +--R +--R (9) [false,true,true,false,false] +--R Type: List Boolean +--E 9 + +--S 10 +[lowerCase? c for c in chars] +--R +--R +--R (10) [true,false,false,false,false] +--R Type: List Boolean +--E 10 + +--S 11 +[digit? c for c in chars] +--R +--R +--R (11) [false,false,false,true,false] +--R Type: List Boolean +--E 11 + +--S 12 +[hexDigit? c for c in chars] +--R +--R +--R (12) [true,true,false,true,false] +--R Type: List Boolean +--E 12 + +--S 13 +[alphanumeric? c for c in chars] +--R +--R +--R (13) [true,true,true,true,false] +--R Type: List Boolean +--E 13 +)spool +)lisp (bye) +@ +<>= +==================================================================== +Character examples +==================================================================== + +The members of the domain Character are values representing letters, +numerals and other text elements. + +Characters can be obtained using String notation. + + chars := [char "a", char "A", char "X", char "8", char "+"] + [a,A,X,8,+] + Type: List Character + +Certain characters are available by name. This is the blank character. + + space() + + Type: Character + +This is the quote that is used in strings. + + quote() + " + Type: Character + +This is the escape character that allows quotes and other characters +within strings. + + escape() + _ + Type: Character + +Characters are represented as integers in a machine-dependent way. +The integer value can be obtained using the ord operation. It is +always true that char(ord c) = c and ord(char i) = i, provided that i +is in the range 0..size()$Character-1. + + [ord c for c in chars] + [97,65,88,56,43] + Type: List Integer + +The lowerCase operation converts an upper case letter to the +corresponding lower case letter. If the argument is not an upper case +letter, then it is returned unchanged. + + [upperCase c for c in chars] + [A,A,X,8,+] + Type: List Character + +The upperCase operation converts lower case letters to upper case. + + [lowerCase c for c in chars] + [a,a,x,8,+] + Type: List Character + +A number of tests are available to determine whether characters +belong to certain families. + + [alphabetic? c for c in chars] + [true,true,true,false,false] + Type: List Boolean + + [upperCase? c for c in chars] + [false,true,true,false,false] + Type: List Boolean + + [lowerCase? c for c in chars] + [true,false,false,false,false] + Type: List Boolean + + [digit? c for c in chars] + [false,false,false,true,false] + Type: List Boolean + + [hexDigit? c for c in chars] + [true,true,false,true,false] + Type: List Boolean + + [alphanumeric? c for c in chars] + [true,true,true,true,false] + Type: List Boolean + +See Also: +o )help CharacterClass +o )help String +o )show Character +o $AXIOM/doc/src/algebra/string.spad.dvi + +@ +\pagehead{Character}{CHAR} +\pagepic{ps/v103character.ps}{CHAR}{1.00} +See also:\\ +\refto{CharacterClass}{CCLASS} +\refto{IndexedString}{ISTRING} +\refto{String}{STRING} +<>= +)abbrev domain CHAR Character +++ Author: Stephen M. Watt +++ Date Created: July 1986 +++ Date Last Updated: June 20, 1991 +++ Basic Operations: char +++ Related Domains: +++ Also See: +++ AMS Classifications: +++ Keywords: character, string +++ Examples: +++ References: +++ Description: +++ This domain provides the basic character data type. + +Character: OrderedFinite() with + ord: % -> Integer + ++ ord(c) provides an integral code corresponding to the + ++ character c. It is always true that \spad{char ord c = c}. + ++ + ++X chars := [char "a", char "A", char "X", char "8", char "+"] + ++X [ord c for c in chars] + char: Integer -> % + ++ char(i) provides a character corresponding to the integer + ++ code i. It is always true that \spad{ord char i = i}. + ++ + ++X [char c for c in [97,65,88,56,43]] + char: String -> % + ++ char(s) provides a character from a string s of length one. + ++ + ++X [char c for c in ["a","A","X","8","+"]] + space: () -> % + ++ space() provides the blank character. + ++ + ++X space() + quote: () -> % + ++ quote() provides the string quote character, \spad{"}. + ++ + ++X quote() + escape: () -> % + ++ escape() provides the escape character, \spad{_}, which + ++ is used to allow quotes and other characters {\em within} + ++ strings. + ++ + ++X escape() + upperCase: % -> % + ++ upperCase(c) converts a lower case letter to the corresponding + ++ upper case letter. If c is not a lower case letter, then + ++ it is returned unchanged. + ++ + ++X chars := [char "a", char "A", char "X", char "8", char "+"] + ++X [upperCase c for c in chars] + lowerCase: % -> % + ++ lowerCase(c) converts an upper case letter to the corresponding + ++ lower case letter. If c is not an upper case letter, then + ++ it is returned unchanged. + ++ + ++X chars := [char "a", char "A", char "X", char "8", char "+"] + ++X [lowerCase c for c in chars] + digit?: % -> Boolean + ++ digit?(c) tests if c is a digit character, + ++ i.e. one of 0..9. + ++ + ++X chars := [char "a", char "A", char "X", char "8", char "+"] + ++X [digit? c for c in chars] + hexDigit?: % -> Boolean + ++ hexDigit?(c) tests if c is a hexadecimal numeral, + ++ i.e. one of 0..9, a..f or A..F. + ++ + ++X chars := [char "a", char "A", char "X", char "8", char "+"] + ++X [hexDigit? c for c in chars] + alphabetic?: % -> Boolean + ++ alphabetic?(c) tests if c is a letter, + ++ i.e. one of a..z or A..Z. + ++ + ++X chars := [char "a", char "A", char "X", char "8", char "+"] + ++X [alphabetic? c for c in chars] + upperCase?: % -> Boolean + ++ upperCase?(c) tests if c is an upper case letter, + ++ i.e. one of A..Z. + ++ + ++X chars := [char "a", char "A", char "X", char "8", char "+"] + ++X [upperCase? c for c in chars] + lowerCase?: % -> Boolean + ++ lowerCase?(c) tests if c is an lower case letter, + ++ i.e. one of a..z. + ++ + ++X chars := [char "a", char "A", char "X", char "8", char "+"] + ++X [lowerCase? c for c in chars] + alphanumeric?: % -> Boolean + ++ alphanumeric?(c) tests if c is either a letter or number, + ++ i.e. one of 0..9, a..z or A..Z. + ++ + ++X chars := [char "a", char "A", char "X", char "8", char "+"] + ++X [alphanumeric? c for c in chars] + + == add + + Rep := SingleInteger -- 0..255 + + CC ==> CharacterClass() + import CC + + OutChars:PrimitiveArray(OutputForm) := + construct [NUM2CHAR(i)$Lisp for i in 0..255] + + minChar := minIndex OutChars + + a = b == a =$Rep b + a < b == a <$Rep b + size() == 256 + index n == char((n - 1)::Integer) + lookup c == (1 + ord c)::PositiveInteger + char(n:Integer) == n::% + ord c == convert(c)$Rep + random() == char(random()$Integer rem size()) + space == QENUM(" ", 0$Lisp)$Lisp + quote == QENUM("_" ", 0$Lisp)$Lisp + escape == QENUM("__ ", 0$Lisp)$Lisp + coerce(c:%):OutputForm == OutChars(minChar + ord c) + digit? c == member?(c pretend Character, digit()) + hexDigit? c == member?(c pretend Character, hexDigit()) + upperCase? c == member?(c pretend Character, upperCase()) + lowerCase? c == member?(c pretend Character, lowerCase()) + alphabetic? c == member?(c pretend Character, alphabetic()) + alphanumeric? c == member?(c pretend Character, alphanumeric()) + + latex c == + concat("\mbox{`", concat(new(1,c pretend Character)$String, "'}")_ + $String)$String + + char(s:String) == + (#s) = 1 => s(minIndex s) pretend % + error "String is not a single character" + + upperCase c == + QENUM(PNAME(UPCASE(NUM2CHAR(ord c)$Lisp)$Lisp)$Lisp,0$Lisp)$Lisp + + lowerCase c == + QENUM(PNAME(DOWNCASE(NUM2CHAR(ord c)$Lisp)$Lisp)$Lisp,0$Lisp)$Lisp + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain CCLASS CharacterClass} +<>= +-- string.spad.pamphlet CharacterClass.input +)spool CharacterClass.output +)set message test on +)set message auto off +)clear all +--S 1 of 16 +cl1:=charClass[char "a",char "e",char "i",char "o",char "u",char "y"] +--R +--R +--R (1) "aeiouy" +--R Type: CharacterClass +--E 1 + +--S 2 of 16 +cl2 := charClass "bcdfghjklmnpqrstvwxyz" +--R +--R +--R (2) "bcdfghjklmnpqrstvwxyz" +--R Type: CharacterClass +--E 2 + +--S 3 of 16 +digit() +--R +--R +--R (3) "0123456789" +--R Type: CharacterClass +--E 3 + +--S 4 of 16 +hexDigit() +--R +--R +--R (4) "0123456789ABCDEFabcdef" +--R Type: CharacterClass +--E 4 + +--S 5 of 16 +upperCase() +--R +--R +--R (5) "ABCDEFGHIJKLMNOPQRSTUVWXYZ" +--R Type: CharacterClass +--E 5 + +--S 6 of 16 +lowerCase() +--R +--R +--R (6) "abcdefghijklmnopqrstuvwxyz" +--R Type: CharacterClass +--E 6 + +--S 7 of 16 +alphabetic() +--R +--R +--R (7) "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" +--R Type: CharacterClass +--E 7 + +--S 8 of 16 +alphanumeric() +--R +--R +--R (8) "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" +--R Type: CharacterClass +--E 8 + +--S 9 of 16 +member?(char "a", cl1) +--R +--R +--R (9) true +--R Type: Boolean +--E 9 + +--S 10 of 16 +member?(char "a", cl2) +--R +--R +--R (10) false +--R Type: Boolean +--E 10 + +--S 11 of 16 +intersect(cl1, cl2) +--R +--R +--R (11) "y" +--R Type: CharacterClass +--E 11 + +--S 12 of 16 +union(cl1,cl2) +--R +--R +--R (12) "abcdefghijklmnopqrstuvwxyz" +--R Type: CharacterClass +--E 12 + +--S 13 of 16 +difference(cl1,cl2) +--R +--R +--R (13) "aeiou" +--R Type: CharacterClass +--E 13 + +--S 14 of 16 +intersect(complement(cl1),cl2) +--R +--R +--R (14) "bcdfghjklmnpqrstvwxz" +--R Type: CharacterClass +--E 14 + +--S 15 of 16 +insert!(char "a", cl2) +--R +--R +--R (15) "abcdfghjklmnpqrstvwxyz" +--R Type: CharacterClass +--E 15 + +--S 16 of 16 +remove!(char "b", cl2) +--R +--R +--R (16) "acdfghjklmnpqrstvwxyz" +--R Type: CharacterClass +--E 16 +)spool +)lisp (bye) +@ +<>= +==================================================================== +CharacterClass examples +==================================================================== + +The CharacterClass domain allows classes of characters to be defined +and manipulated efficiently. + +Character classes can be created by giving either a string or a list +of characters. + + cl1:=charClass[char "a",char "e",char "i",char "o",char "u",char "y"] + "aeiouy" + Type: CharacterClass + + cl2 := charClass "bcdfghjklmnpqrstvwxyz" + "bcdfghjklmnpqrstvwxyz" + Type: CharacterClass + +A number of character classes are predefined for convenience. + + digit() + "0123456789" + Type: CharacterClass + + hexDigit() + "0123456789ABCDEFabcdef" + Type: CharacterClass + + upperCase() + "ABCDEFGHIJKLMNOPQRSTUVWXYZ" + Type: CharacterClass + + lowerCase() + "abcdefghijklmnopqrstuvwxyz" + Type: CharacterClass + + alphabetic() + "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" + Type: CharacterClass + + alphanumeric() + "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" + Type: CharacterClass + +You can quickly test whether a character belongs to a class. + + member?(char "a", cl1) + true + Type: Boolean + + member?(char "a", cl2) + false + Type: Boolean + +Classes have the usual set operations because the CharacterClass +domain belongs to the category FiniteSetAggregate(Character). + + intersect(cl1, cl2) + "y" + Type: CharacterClass + + union(cl1,cl2) + "abcdefghijklmnopqrstuvwxyz" + Type: CharacterClass + + difference(cl1,cl2) + "aeiou" + Type: CharacterClass + + intersect(complement(cl1),cl2) + "bcdfghjklmnpqrstvwxz" + Type: CharacterClass + +You can modify character classes by adding or removing characters. + + insert!(char "a", cl2) + "abcdfghjklmnpqrstvwxyz" + Type: CharacterClass + + remove!(char "b", cl2) + "acdfghjklmnpqrstvwxyz" + Type: CharacterClass + +See Also: +o )help Character +o )help String +o )show CharacterClass +o $AXIOM/doc/src/algebra/string.spad.dvi + +@ +\pagehead{CharacterClass}{CCLASS} +\pagepic{ps/v103characterclass.ps}{CCLASS}{1.00} +See also:\\ +\refto{Character}{CHAR} +\refto{IndexedString}{ISTRING} +\refto{String}{STRING} +<>= +)abbrev domain CCLASS CharacterClass +++ Author: Stephen M. Watt +++ Date Created: July 1986 +++ Date Last Updated: June 20, 1991 +++ Basic Operations: charClass +++ Related Domains: Character, Bits +++ Also See: +++ AMS Classifications: +++ Keywords: +++ Examples: +++ References: +++ Description: +++ This domain allows classes of characters to be defined and manipulated +++ efficiently. + + +CharacterClass: Join(SetCategory, ConvertibleTo String, + FiniteSetAggregate Character, ConvertibleTo List Character) with + charClass: String -> % + ++ charClass(s) creates a character class which contains + ++ exactly the characters given in the string s. + charClass: List Character -> % + ++ charClass(l) creates a character class which contains + ++ exactly the characters given in the list l. + digit: constant -> % + ++ digit() returns the class of all characters + ++ for which \spadfunFrom{digit?}{Character} is true. + hexDigit: constant -> % + ++ hexDigit() returns the class of all characters for which + ++ \spadfunFrom{hexDigit?}{Character} is true. + upperCase: constant -> % + ++ upperCase() returns the class of all characters for which + ++ \spadfunFrom{upperCase?}{Character} is true. + lowerCase: constant -> % + ++ lowerCase() returns the class of all characters for which + ++ \spadfunFrom{lowerCase?}{Character} is true. + alphabetic : constant -> % + ++ alphabetic() returns the class of all characters for which + ++ \spadfunFrom{alphabetic?}{Character} is true. + alphanumeric: constant -> % + ++ alphanumeric() returns the class of all characters for which + ++ \spadfunFrom{alphanumeric?}{Character} is true. + + == add + Rep := IndexedBits(0) + N := size()$Character + + a, b: % + + digit() == charClass "0123456789" + hexDigit() == charClass "0123456789abcdefABCDEF" + upperCase() == charClass "ABCDEFGHIJKLMNOPQRSTUVWXYZ" + lowerCase() == charClass "abcdefghijklmnopqrstuvwxyz" + alphabetic() == union(upperCase(), lowerCase()) + alphanumeric() == union(alphabetic(), digit()) + + a = b == a =$Rep b + + member?(c, a) == a(ord c) + union(a,b) == Or(a, b) + intersect (a,b) == And(a, b) + difference(a,b) == And(a, Not b) + complement a == Not a + + convert(cl):String == + construct(convert(cl)@List(Character)) + convert(cl:%):List(Character) == + [char(i) for i in 0..N-1 | cl.i] + + charClass(s: String) == + cl := new(N, false) + for i in minIndex(s)..maxIndex(s) repeat cl(ord s.i) := true + cl + + charClass(l: List Character) == + cl := new(N, false) + for c in l repeat cl(ord c) := true + cl + + coerce(cl):OutputForm == (convert(cl)@String)::OutputForm + + -- Stuff to make a legal SetAggregate view + # a == (n := 0; for i in 0..N-1 | a.i repeat n := n+1; n) + empty():% == charClass [] + brace():% == charClass [] + + insert_!(c, a) == (a(ord c) := true; a) + remove_!(c, a) == (a(ord c) := false; a) + + inspect(a) == + for i in 0..N-1 | a.i repeat + return char i + error "Cannot take a character from an empty class." + extract_!(a) == + for i in 0..N-1 | a.i repeat + a.i := false + return char i + error "Cannot take a character from an empty class." + + map(f, a) == + b := new(N, false) + for i in 0..N-1 | a.i repeat b(ord f char i) := true + b + + temp: % := new(N, false)$Rep + map_!(f, a) == + fill_!(temp, false) + for i in 0..N-1 | a.i repeat temp(ord f char i) := true + copyInto_!(a, temp, 0) + + parts a == + [char i for i in 0..N-1 | a.i] + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{domain CLIF CliffordAlgebra\cite{7,12}} \subsection{Vector (linear) spaces} This information is originally from Paul Leopardi's presentation on @@ -12078,6 +12784,10 @@ o $AXIOM/doc/src/algebra/radix.spad.dvi @ \pagehead{DecimalExpansion}{DECIMAL} \pagepic{ps/v103decimalexpansion.ps}{DECIMAL}{1.00} +See also:\\ +\refto{RadixExpansion}{RADIX} +\refto{BinaryExpansion}{BINARY} +\refto{HexadecimalExpansion}{HEXADEC} <>= )abbrev domain DECIMAL DecimalExpansion ++ Author: Stephen M. Watt @@ -14943,6 +15653,664 @@ DistributedMultivariatePolynomial(vl,R): public == private where @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain DFLOAT DoubleFloat} +Greg Vanuxem has added some functionality to allow the user to modify +the printed format of floating point numbers. The format of the numbers +follows the common lisp format specification for floats. First we include +Greg's email to show the use of this feature: +\begin{verbatim} +PS: For those who use the Doublefloat domain + there is an another (undocumented) patch that adds a + lisp format to the DoubleFloat output routine. Copy + int/algebra/DFLOAT.spad to your working directory, + patch it, compile it and ")lib" it when necessary. + + +(1) -> )boot $useBFasDefault:=false + +(SPADLET |$useBFasDefault| NIL) +Value = NIL +(1) -> a:= matrix [ [0.5978,0.2356], [0.4512,0.2355] ] + + + 0.5978 0.2356 + + (1) | | + +0.45119999999999999 0.23549999999999999+ + Type: Matrix DoubleFloat +(2) -> )lib DFLOAT + DoubleFloat is now explicitly exposed in frame initial + DoubleFloat will be automatically loaded when needed +from /home/greg/Axiom/DFLOAT.nrlib/code +(2) -> doubleFloatFormat("~,4,,F") + + (2) "~G" + Type: String +(3) -> a + + +0.5978 0.2356+ + (3) | | + +0.4512 0.2355+ + Type: Matrix DoubleFloat + +\end{verbatim} +So it is clear that he has added a new function called +{\tt doubleFloatFormat} which takes a string argument that +specifies the common lisp format control string (\"{}\~{},4,,F\"{}). +For reference we quote from the common lisp manual \cite{1}. +On page 582 we find: + +\begin{quote} +A format directive consists of a tilde (\~{}), optional prefix +parameters separated by commas, optional colon (:) and at-sign (@) +modifiers, and a single character indicating what kind of directive this is. +The alphabetic case of the directive character is ignored. The prefix +parameters are generally integers, notated as optionally signed decimal +numbers. + +X3J13 voted in June 1987 (80) to specify that if both colon and at-sign +modifiers are present, they may appear in either order; thus \~{}:@R +and \~{}@:R mean the same thing. However, it is traditional to put the +colon first, and all examples in the book put colon before at-signs. +\end{quote} + +\noindent +On page 588 we find: + +\begin{quote} +\~{}F + +{\sl Fixed-format floating-point}. The next {\sl arg} is printed as a +floating point number. + +The full form is {\sl \~{}w,d,k,overfowchar,padchar}F. The parameter +{\sl w} is the width of the filed to be printed; {\sl d} is the number +of digits to print after the decimal point; {\sl k} is a scale factor +that defaults to zero. + +Exactly {\sl w} characters will be output. First, leading copies of the +character {\sl padchar} (which defaults to a space) are printed, if +necessary, to pad the field on the left. If the {\sl arg} is negative, +then a minus sign is printed; if the {\sl arg} is not negative, then +a plus signed is printed if and only if the @ modifier was specified. +Then a sequence of digits, containing a single embedded decimal point, +is printed; this represents the magnitude of the value of {\sl arg} +times $10^k$, rounded to {\sl d} fractional digits. (When rounding up +and rounding down would produce printed values equidistant from the +scaled value of {\sl arg}, then the implementation is free to use +either one. For example, printing the argument 6.375 using the format +\~{}4.2F may correctly produce either 6.37 or 6.38.) Leading zeros are +not permitted, except that a single zero digit is output before the +decimal point if the printed value is less than 1, and this single zero +digit is not output after all if $w = d + 1$. + +If it is impossible to print the value in the required format in the +field of width {\sl w}, then one of two actions is taken. If the +parameter {\sl overflowchar} is specified, then {\sl w} copies of that +parameter are printed instead of the scaled value of {\sl arg}. If the +{\sl overflowchar} parameter is omitted, then the scaled value is +printed using more than {\sl w} characters, as many more as may be +needed. + +If the {\sl w} parameter is omitted, then the field is of variable width. +In effect, a value is chosen for {\sl w} in such a way that no leading pad +characters need to be printed and exactly {\sl d} characters will follow +the decimal point. For example, the directive \~{},2F will print exactly +two digits after the decimal point and as many as necessary before the +decimal point. + +If the parameter {\sl d} is omitted, then there is no constraint on the +number of digits to appear after the decimal point. A value is chosen +for {\sl d} in such a way that as many digits as possible may be printed +subject to the width constraint imposed by the parameter {\sl w} and the +constraint that no trailing zero digits may appear in the fraction, except +that if the fraction to be printed is zero, then a single zero digit should +appear after the decimal point if permitted by the width constraint. + +If both {\sl w} and {\sl d} are omitted, then the effect is to print the +value using ordinary free-format output; {\tt prin1} uses this format +for any number whose magnitude is either zero or between $10^{-3}$ +(inclusive) and $10^7$ (exclusive). + +If {\sl w} is omitted, then if the magnitude of {\sl arg} is so large +(or, if {\sl d} is also omitted, so small) that more than 100 digits +would have to be printed, then an implementation is free, at its +discretion, to print the number using exponential notation instead, +as if by the directive \~{}E (with all parameters of \~{}E defaulted, +not taking their valued from the \~{}F directive). + +If {\sl arg} is a rational number, then it is coerced to be a +{\tt single-float} and then printed. (Alternatively, an implementation +is permitted to process a rational number by any other method that has +essentially the same behavior but avoids such hazards as loss of +precision or overflow because of the coercion. However, note that if +{\sl w} and {\sl d} are unspecified and the number has no exact decimal +representation, for example 1/3, some precision cutoff must be chosen +by the implementation; only a finite number of digits may be printed.) + +If {\sl arg} is a complex number or some non-numeric object, then it +is printed using the format directive {\sl \~{}w}D, thereby printing +it in decimal radix and a minimum field width of {\sl w}. (If it is +desired to print each of the real part and imaginary part of a +complex number using a \~{}F directive, then this must be done explicitly +with two \~{}F directives and code to extract the two parts of the +complex number.) + + +\end{quote} +<>= +-- sf.spad.pamphlet DoubleFloat.input +)spool DoubleFloat.output +)set message test on +)set message auto off +)clear all +--S 1 of 10 +2.71828 +--R +--R +--R (1) 2.71828 +--R Type: Float +--E 1 + +--S 2 of 10 +2.71828@DoubleFloat +--R +--R +--R (2) 2.71828 +--R Type: DoubleFloat +--E 2 + +--S 3 of 10 +2.71828 :: DoubleFloat +--R +--R +--R (3) 2.71828 +--R Type: DoubleFloat +--E 3 + +--S 4 of 10 +eApprox : DoubleFloat := 2.71828 +--R +--R +--R (4) 2.71828 +--R Type: DoubleFloat +--E 4 + +--S 5 of 10 +avg : List DoubleFloat -> DoubleFloat +--R +--R Type: Void +--E 5 + +--S 6 of 10 +avg l == + empty? l => 0 :: DoubleFloat + reduce(_+,l) / #l +--R +--R Type: Void +--E 6 + +--S 7 of 10 +avg [] +--R +--R Compiling function avg with type List DoubleFloat -> DoubleFloat +--R +--R (7) 0. +--R Type: DoubleFloat +--E 7 + +--S 8 of 10 +avg [3.4,9.7,-6.8] +--R +--R +--R (8) 2.1000000000000001 +--R Type: DoubleFloat +--E 8 + +--S 9 of 10 +cos(3.1415926)$DoubleFloat +--R +--R +--R (9) - 0.99999999999999856 +--R Type: DoubleFloat +--E 9 + +--S 10 of 10 +cos(3.1415926 :: DoubleFloat) +--R +--R +--R (10) - 0.99999999999999856 +--R Type: DoubleFloat +--E 10 +)spool +)lisp (bye) +@ + +<>= +==================================================================== +DoubleFloat examples +==================================================================== + +Axiom provides two kinds of floating point numbers. The domain Float +(abbreviation FLOAT) implements a model of arbitrary precision +floating point numbers. The domain DoubleFloat (abbreviation DFLOAT) +is intended to make available hardware floating point arithmetic in +Axiom. The actual model of floating point DoubleFloat that 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. + +The usual arithmetic and elementary functions are available for +DoubleFloat. By default, floating point numbers that you enter into +Axiom are of type Float. + + 2.71828 + 2.71828 + Type: Float + +You must therefore tell Axiom that you want to use DoubleFloat values +and operations. The following are some conservative guidelines for +getting Axiom to use DoubleFloat. + +To get a value of type DoubleFloat, use a target with @, ... + + 2.71828@DoubleFloat + 2.71828 + Type: DoubleFloat + +a conversion, ... + + 2.71828 :: DoubleFloat + 2.71828 + Type: DoubleFloat + +or an assignment to a declared variable. It is more efficient if you +use a target rather than an explicit or implicit conversion. + + eApprox : DoubleFloat := 2.71828 + 2.71828 + Type: DoubleFloat + +You also need to declare functions that work with DoubleFloat. + + avg : List DoubleFloat -> DoubleFloat + Type: Void + + avg l == + empty? l => 0 :: DoubleFloat + reduce(_+,l) / #l + Type: Void + + avg [] + 0. + Type: DoubleFloat + + avg [3.4,9.7,-6.8] + 2.1000000000000001 + Type: DoubleFloat + +Use package-calling for operations from DoubleFloat unless the +arguments themselves are already of type DoubleFloat. + + cos(3.1415926)$DoubleFloat + -0.99999999999999856 + Type: DoubleFloat + + cos(3.1415926 :: DoubleFloat) + -0.99999999999999856 + Type: DoubleFloat + +By far, the most common usage of DoubleFloat is for functions to be +graphed. + + +See Also: +0 )help Float +o )show DoubleFloat +o $AXIOM/doc/src/algebra/sf.spad.dvi + +@ +<>= +"DFLOAT" -> "FPS" +"DoubleFloat()" -> "FloatingPointSystem()" +"DFLOAT" -> "DIFRING" +"DoubleFloat()" -> "DifferentialRing()" +"DFLOAT" -> "OM" +"DoubleFloat()" -> "OpenMath()" +"DFLOAT" -> "TRANFUN" +"DoubleFloat()" -> "TranscendentalFunctionCategory()" +"DFLOAT" -> "SPFCAT" +"DoubleFloat()" -> "SpecialFunctionCategory()" +"DFLOAT" -> "KONVERT" +"DoubleFloat()" -> "ConvertibleTo(InputForm)" +@ +\pagehead{DoubleFloat}{DFLOAT} +\pagepic{ps/v103doublefloat.ps}{DFLOAT}{1.00} +<>= +)abbrev domain DFLOAT DoubleFloat +++ Author: Michael Monagan +++ Date Created: +++ January 1988 +++ Change History: +++ Basic Operations: exp1, hash, log2, log10, rationalApproximation, / , ** +++ Related Constructors: +++ Keywords: small float +++ Description: \spadtype{DoubleFloat} is intended to make accessible +++ hardware floating point arithmetic in \Language{}, either native double +++ precision, or IEEE. On most machines, there will be hardware support for +++ the arithmetic operations: +++ \spadfunFrom{+}{DoubleFloat}, \spadfunFrom{*}{DoubleFloat}, +++ \spadfunFrom{/}{DoubleFloat} and possibly also the +++ \spadfunFrom{sqrt}{DoubleFloat} operation. +++ The operations \spadfunFrom{exp}{DoubleFloat}, +++ \spadfunFrom{log}{DoubleFloat}, \spadfunFrom{sin}{DoubleFloat}, +++ \spadfunFrom{cos}{DoubleFloat}, +++ \spadfunFrom{atan}{DoubleFloat} are normally coded in +++ software based on minimax polynomial/rational approximations. +++ Note that under Lisp/VM, \spadfunFrom{atan}{DoubleFloat} +++ is not available at this time. +++ Some general comments about the accuracy of the operations: +++ the operations \spadfunFrom{+}{DoubleFloat}, +++ \spadfunFrom{*}{DoubleFloat}, \spadfunFrom{/}{DoubleFloat} and +++ \spadfunFrom{sqrt}{DoubleFloat} are expected to be fully accurate. +++ The operations \spadfunFrom{exp}{DoubleFloat}, +++ \spadfunFrom{log}{DoubleFloat}, \spadfunFrom{sin}{DoubleFloat}, +++ \spadfunFrom{cos}{DoubleFloat} and +++ \spadfunFrom{atan}{DoubleFloat} are not expected to be +++ fully accurate. In particular, \spadfunFrom{sin}{DoubleFloat} +++ and \spadfunFrom{cos}{DoubleFloat} +++ will lose all precision for large arguments. +++ +++ The \spadtype{Float} domain provides an alternative to the +++ \spad{DoubleFloat} domain. +++ It provides an arbitrary precision model of floating point arithmetic. +++ This means that accuracy problems like those above are eliminated +++ by increasing the working precision where necessary. \spadtype{Float} +++ provides some special functions such as \spadfunFrom{erf}{DoubleFloat}, +++ the error function +++ in addition to the elementary functions. The disadvantage of +++ \spadtype{Float} is that it is much more expensive than small floats when the latter can be used. +-- I've put some timing comparisons in the notes for the Float +-- domain about the difference in speed between the two domains. +DoubleFloat(): Join(FloatingPointSystem, DifferentialRing, OpenMath, + TranscendentalFunctionCategory, SpecialFunctionCategory, _ + ConvertibleTo InputForm) with + _/ : (%, Integer) -> % + ++ x / i computes the division from x by an integer i. + _*_* : (%,%) -> % + ++ x ** y returns the yth power of x (equal to \spad{exp(y log x)}). + exp1 : () -> % + ++ exp1() returns the natural log base \spad{2.718281828...}. + hash : % -> Integer + ++ hash(x) returns the hash key for x + log2 : % -> % + ++ log2(x) computes the logarithm with base 2 for x. + log10: % -> % + ++ log10(x) computes the logarithm with base 10 for x. + atan : (%,%) -> % + ++ atan(x,y) computes the arc tangent from x with phase y. + Gamma: % -> % + ++ Gamma(x) is the Euler Gamma function. + Beta : (%,%) -> % + ++ Beta(x,y) is \spad{Gamma(x) * Gamma(y)/Gamma(x+y)}. + doubleFloatFormat : String -> String + ++ change the output format for doublefloats using lisp format strings + rationalApproximation: (%, NonNegativeInteger) -> Fraction Integer + ++ rationalApproximation(f, n) computes a rational approximation + ++ r to f with relative error \spad{< 10**(-n)}. + rationalApproximation: (%, NonNegativeInteger, NonNegativeInteger) -> Fraction Integer + ++ 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)}). + + == add + format: String := "~G" + MER ==> Record(MANTISSA:Integer,EXPONENT:Integer) + + manexp: % -> MER + + doubleFloatFormat(s:String): String == + ss: String := format + format := s + ss + + OMwrite(x: %): String == + s: String := "" + sp := OM_-STRINGTOSTRINGPTR(s)$Lisp + dev: OpenMathDevice := OMopenString(sp pretend String, OMencodingXML) + OMputObject(dev) + OMputFloat(dev, convert 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) + OMputFloat(dev, convert x) + if wholeObj then + OMputEndObject(dev) + OMclose(dev) + s := OM_-STRINGPTRTOSTRING(sp)$Lisp pretend String + s + + OMwrite(dev: OpenMathDevice, x: %): Void == + OMputObject(dev) + OMputFloat(dev, convert x) + OMputEndObject(dev) + + OMwrite(dev: OpenMathDevice, x: %, wholeObj: Boolean): Void == + if wholeObj then + OMputObject(dev) + OMputFloat(dev, convert x) + if wholeObj then + OMputEndObject(dev) + + checkComplex(x:%):% == C_-TO_-R(x)$Lisp + -- In AKCL we used to have to make the arguments to ASIN ACOS ACOSH ATANH + -- complex to get the correct behaviour. + --makeComplex(x: %):% == COMPLEX(x, 0$%)$Lisp + + base() == FLOAT_-RADIX(0$%)$Lisp + mantissa x == manexp(x).MANTISSA + exponent x == manexp(x).EXPONENT + precision() == FLOAT_-DIGITS(0$%)$Lisp + bits() == + base() = 2 => precision() + base() = 16 => 4*precision() + wholePart(precision()*log2(base()::%))::PositiveInteger + max() == MOST_-POSITIVE_-DOUBLE_-FLOAT$Lisp + min() == MOST_-NEGATIVE_-DOUBLE_-FLOAT$Lisp + order(a) == precision() + exponent a - 1 + 0 == FLOAT(0$Lisp,MOST_-POSITIVE_-DOUBLE_-FLOAT$Lisp)$Lisp + 1 == FLOAT(1$Lisp,MOST_-POSITIVE_-DOUBLE_-FLOAT$Lisp)$Lisp + -- rational approximation to e accurate to 23 digits + exp1() == FLOAT(534625820200,MOST_-POSITIVE_-DOUBLE_-FLOAT$Lisp)$Lisp / _ + FLOAT(196677847971,MOST_-POSITIVE_-DOUBLE_-FLOAT$Lisp)$Lisp + pi() == FLOAT(PI$Lisp,MOST_-POSITIVE_-DOUBLE_-FLOAT$Lisp)$Lisp + coerce(x:%):OutputForm == + x >= 0 => message(FORMAT(NIL$Lisp,format,x)$Lisp pretend String) + - (message(FORMAT(NIL$Lisp,format,-x)$Lisp pretend String)) + convert(x:%):InputForm == convert(x pretend DoubleFloat)$InputForm + x < y == (x "failed"; 1 / x) + differentiate x == 0 + + SFSFUN ==> DoubleFloatSpecialFunctions() + sfx ==> x pretend DoubleFloat + sfy ==> y pretend DoubleFloat + airyAi x == airyAi(sfx)$SFSFUN pretend % + airyBi x == airyBi(sfx)$SFSFUN pretend % + besselI(x,y) == besselI(sfx,sfy)$SFSFUN pretend % + besselJ(x,y) == besselJ(sfx,sfy)$SFSFUN pretend % + besselK(x,y) == besselK(sfx,sfy)$SFSFUN pretend % + besselY(x,y) == besselY(sfx,sfy)$SFSFUN pretend % + Beta(x,y) == Beta(sfx,sfy)$SFSFUN pretend % + digamma x == digamma(sfx)$SFSFUN pretend % + Gamma x == Gamma(sfx)$SFSFUN pretend % +-- not implemented in SFSFUN +-- Gamma(x,y) == Gamma(sfx,sfy)$SFSFUN pretend % + polygamma(x,y) == + if (n := retractIfCan(x:%):Union(Integer, "failed")) case Integer _ + and n >= 0 + then polygamma(n::Integer::NonNegativeInteger,sfy)$SFSFUN pretend % + else error "polygamma: first argument should be a nonnegative integer" + + wholePart x == FIX(x)$Lisp + float(ma,ex,b) == ma*(b::%)**ex + convert(x:%):DoubleFloat == x pretend DoubleFloat + convert(x:%):Float == convert(x pretend DoubleFloat)$Float + rationalApproximation(x, d) == rationalApproximation(x, d, 10) + + 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 + + retract(x:%):Fraction(Integer) == + rationalApproximation(x, (precision() - 1)::NonNegativeInteger, base()) + + retractIfCan(x:%):Union(Fraction Integer, "failed") == + rationalApproximation(x, (precision() - 1)::NonNegativeInteger, base()) + + retract(x:%):Integer == + x = ((n := wholePart x)::%) => n + error "Not an integer" + + retractIfCan(x:%):Union(Integer, "failed") == + x = ((n := wholePart x)::%) => n + "failed" + + sign(x) == retract FLOAT_-SIGN(x,1)$Lisp + abs x == FLOAT_-SIGN(1,x)$Lisp + + + + manexp(x) == + zero? x => [0,0] + s := sign x; x := abs x + if x > max()$% then return [s*mantissa(max())+1,exponent max()] + me:Record(man:%,exp:Integer) := MANEXP(x)$Lisp + two53:= base()**precision() + [s*wholePart(two53 * me.man ),me.exp-precision()] + +-- rationalApproximation(y,d,b) == +-- this is the quotient remainder algorithm (requires wholePart operation) +-- x := y +-- if b < 2 then error "base must be > 1" +-- tol := (b::%)**d +-- p0,p1,q0,q1 : Integer +-- p0 := 0; p1 := 1; q0 := 1; q1 := 0 +-- repeat +-- a := wholePart x +-- x := fractionPart x +-- p2 := p0+a*p1 +-- q2 := q0+a*q1 +-- if x = 0 or tol*abs(q2*y-(p2::%)) < abs(q2*y) then +-- return (p2/q2) +-- (p0,p1) := (p1,p2) +-- (q0,q1) := (q1,q2) +-- x := 1/x + + rationalApproximation(f,d,b) == + -- this algorithm expresses f as n / d where d = BASE ** k + -- then all arithmetic operations are done over the integers + (nu, ex) := manexp f + BASE := base() + ex >= 0 => (nu * BASE ** (ex::NonNegativeInteger))::Fraction(Integer) + de :Integer := BASE**((-ex)::NonNegativeInteger) + b < 2 => error "base must be > 1" + tol := b**d + s := nu; t := de + p0:Integer := 0; p1:Integer := 1; q0:Integer := 1; q1:Integer := 0 + repeat + (q,r) := divide(s, t) + p2 := q*p1+p0 + q2 := q*q1+q0 + r = 0 or tol*abs(nu*q2-de*p2) < de*abs(p2) => return(p2/q2) + (p0,p1) := (p1,p2) + (q0,q1) := (q1,q2) + (s,t) := (t,r) + + x:% ** r:Fraction Integer == + zero? x => + zero? r => error "0**0 is undefined" + negative? r => error "division by 0" + 0 +-- zero? r or one? x => 1 + zero? r or (x = 1) => 1 +-- one? r => x + (r = 1) => x + n := numer r + d := denom r + negative? x => + odd? d => + odd? n => return -((-x)**r) + return ((-x)**r) + error "negative root" + d = 2 => sqrt(x) ** n + x ** (n::% / d::%) + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{domain DROPT DrawOption} \pagehead{DrawOption}{DROPT} \pagepic{ps/v103drawoption.ps}{DROPT}{1.00} @@ -29443,6 +30811,10 @@ o $AXIOM/doc/src/algebra/radix.spad.dvi @ \pagehead{HexadecimalExpansion}{HEXADEC} \pagepic{ps/v103hexadecimalexpansion.ps}{HEXADEC}{1.00} +See also:\\ +\refto{RadixExpansion}{RADIX} +\refto{BinaryExpansion}{BINARY} +\refto{DecimalExpansion}{DECIMAL} <>= )abbrev domain HEXADEC HexadecimalExpansion ++ Author: Clifton J. Williamson @@ -31057,6 +32429,218 @@ IndexedOneDimensionalArray(S:Type, mn:Integer): @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain ISTRING IndexedString} +\pagehead{IndexedString}{ISTRING} +\pagepic{ps/v103indexedstring.ps}{ISTRING}{1.00} +See also:\\ +\refto{Character}{CHAR} +\refto{CharacterClass}{CCLASS} +\refto{String}{STRING} +<>= +)abbrev domain ISTRING IndexedString +++ Authors: Stephen Watt, Michael Monagan, Manuel Bronstein 1986 .. 1991 +-- The following Lisp dependencies are divided into two groups +-- Those that are required +-- QENUM QESET QCSIZE MAKE-FULL-CVEC EQ QSLESSP QSGREATERP +-- Those that can are included for efficiency only +-- COPY STRCONC SUBSTRING STRPOS RPLACSTR DOWNCASE UPCASE CGREATERP +++ Description: +++ This domain implements low-level strings + +IndexedString(mn:Integer): Export == Implementation where + B ==> Boolean + C ==> Character + I ==> Integer + N ==> NonNegativeInteger + U ==> UniversalSegment Integer + + Export ==> StringAggregate() with + hash: % -> I + ++ hash(x) provides a hashing function for strings + + Implementation ==> add + -- These assume Character's Rep is Small I + Qelt ==> QENUM$Lisp + Qequal ==> EQUAL$Lisp + Qsetelt ==> QESET$Lisp + Qsize ==> QCSIZE$Lisp + Cheq ==> EQL$Lisp + Chlt ==> QSLESSP$Lisp + Chgt ==> QSGREATERP$Lisp + + c: Character + cc: CharacterClass + +-- new n == MAKE_-FULL_-CVEC(n, space$C)$Lisp + new(n, c) == MAKE_-FULL_-CVEC(n, c)$Lisp + empty() == MAKE_-FULL_-CVEC(0$Lisp)$Lisp + empty?(s) == Qsize(s) = 0 + #s == Qsize(s) + s = t == Qequal(s, t) + s < t == CGREATERP(t,s)$Lisp + concat(s:%,t:%) == STRCONC(s,t)$Lisp + copy s == COPY_-SEQ(s)$Lisp + insert(s:%, t:%, i:I) == concat(concat(s(mn..i-1), t), s(i..)) + coerce(s:%):OutputForm == outputForm(s pretend String) + minIndex s == mn + upperCase_! s == map_!(upperCase, s) + lowerCase_! s == map_!(lowerCase, s) + + latex s == concat("\mbox{``", concat(s pretend String, "''}")) + + replace(s, sg, t) == + l := lo(sg) - mn + m := #s + n := #t + h:I := if hasHi sg then hi(sg) - mn else maxIndex s - mn + l < 0 or h >= m or h < l-1 => error "index out of range" + r := new((m-(h-l+1)+n)::N, space$C) + for k in 0.. for i in 0..l-1 repeat Qsetelt(r, k, Qelt(s, i)) + for k in k.. for i in 0..n-1 repeat Qsetelt(r, k, Qelt(t, i)) + for k in k.. for i in h+1..m-1 repeat Qsetelt(r, k, Qelt(s, i)) + r + + setelt(s:%, i:I, c:C) == + i < mn or i > maxIndex(s) => error "index out of range" + Qsetelt(s, i - mn, c) + c + + substring?(part, whole, startpos) == + np:I := Qsize part + nw:I := Qsize whole + (startpos := startpos - mn) < 0 => error "index out of bounds" + np > nw - startpos => false + for ip in 0..np-1 for iw in startpos.. repeat + not Cheq(Qelt(part, ip), Qelt(whole, iw)) => return false + true + + position(s:%, t:%, startpos:I) == + (startpos := startpos - mn) < 0 => error "index out of bounds" + startpos >= Qsize t => mn - 1 + r:I := STRPOS(s, t, startpos, NIL$Lisp)$Lisp + EQ(r, NIL$Lisp)$Lisp => mn - 1 + r + mn + position(c: Character, t: %, startpos: I) == + (startpos := startpos - mn) < 0 => error "index out of bounds" + startpos >= Qsize t => mn - 1 + for r in startpos..Qsize t - 1 repeat + if Cheq(Qelt(t, r), c) then return r + mn + mn - 1 + position(cc: CharacterClass, t: %, startpos: I) == + (startpos := startpos - mn) < 0 => error "index out of bounds" + startpos >= Qsize t => mn - 1 + for r in startpos..Qsize t - 1 repeat + if member?(Qelt(t,r), cc) then return r + mn + mn - 1 + + suffix?(s, t) == + (m := maxIndex s) > (n := maxIndex t) => false + substring?(s, t, mn + n - m) + + split(s, c) == + n := maxIndex s + for i in mn..n while s.i = c repeat 0 + l := empty()$List(%) + j:Integer -- j is conditionally intialized + while i <= n and (j := position(c, s, i)) >= mn repeat + l := concat(s(i..j-1), l) + for i in j..n while s.i = c repeat 0 + if i <= n then l := concat(s(i..n), l) + reverse_! l + split(s, cc) == + n := maxIndex s + for i in mn..n while member?(s.i,cc) repeat 0 + l := empty()$List(%) + j:Integer -- j is conditionally intialized + while i <= n and (j := position(cc, s, i)) >= mn repeat + l := concat(s(i..j-1), l) + for i in j..n while member?(s.i,cc) repeat 0 + if i <= n then l := concat(s(i..n), l) + reverse_! l + + leftTrim(s, c) == + n := maxIndex s + for i in mn .. n while s.i = c repeat 0 + s(i..n) + leftTrim(s, cc) == + n := maxIndex s + for i in mn .. n while member?(s.i,cc) repeat 0 + s(i..n) + + rightTrim(s, c) == + for j in maxIndex s .. mn by -1 while s.j = c repeat 0 + s(minIndex(s)..j) + rightTrim(s, cc) == + for j in maxIndex s .. mn by -1 while member?(s.j, cc) repeat 0 + s(minIndex(s)..j) + + concat l == + t := new(+/[#s for s in l], space$C) + i := mn + for s in l repeat + copyInto_!(t, s, i) + i := i + #s + t + + copyInto_!(y, x, s) == + m := #x + n := #y + s := s - mn + s < 0 or s+m > n => error "index out of range" + RPLACSTR(y, s, m, x, 0, m)$Lisp + y + + elt(s:%, i:I) == + i < mn or i > maxIndex(s) => error "index out of range" + Qelt(s, i - mn) + + elt(s:%, sg:U) == + l := lo(sg) - mn + h := if hasHi sg then hi(sg) - mn else maxIndex s - mn + l < 0 or h >= #s => error "index out of bound" + SUBSTRING(s, l, max(0, h-l+1))$Lisp + + hash(s:$):Integer == + n:I := Qsize s + zero? n => 0 +-- one? n => ord(s.mn) + (n = 1) => ord(s.mn) + ord(s.mn) * ord s(mn+n-1) * ord s(mn + n quo 2) + + match(pattern,target,wildcard) == stringMatch(pattern,target,CHARACTER(wildcard)$Lisp)$Lisp + +@ + +Up to [[patch--40]] this read + +\begin{verbatim} + match(pattern,target,wildcard) == stringMatch(pattern,target,wildcard)$Lisp +\end{verbatim} + +which did not work (Issue~\#97), since [[wildcard]] is an Axiom-[[Character]], +not a Lisp-[[Character]]. The operation [[CHARACTER]] from [[Lisp]] performs +the coercion. + +<>= + match?(pattern, target, dontcare) == + n := maxIndex pattern + p := position(dontcare, pattern, m := minIndex pattern)::N + p = m-1 => pattern = target + (p ^= m) and not prefix?(pattern(m..p-1), target) => false + i := p -- index into target + q := position(dontcare, pattern, p + 1)::N + while q ^= m-1 repeat + s := pattern(p+1..q-1) + i := position(s, target, i)::N + i = m-1 => return false + i := i + #s + p := q + q := position(dontcare, pattern, q + 1)::N + (p ^= n) and not suffix?(pattern(p+1..n), target) => false + true + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{domain IARRAY2 IndexedTwoDimensionalArray} An IndexedTwoDimensionalArray is a 2-dimensional array where the minimal row and column indices are parameters of the type. @@ -31934,6 +33518,1069 @@ InnerPrimeField(p:PositiveInteger): Exports == Implementation where @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain ISUPS InnerSparseUnivariatePowerSeries} +\pagehead{InnerSparseUnivariatePowerSeries}{ISUPS} +\pagepic{ps/v103innersparseunivariatepowerseries.ps}{ISUPS}{1.00} +<>= +)abbrev domain ISUPS InnerSparseUnivariatePowerSeries +++ Author: Clifton J. Williamson +++ Date Created: 28 October 1994 +++ Date Last Updated: 9 March 1995 +++ Basic Operations: +++ Related Domains: SparseUnivariateTaylorSeries, SparseUnivariateLaurentSeries +++ SparseUnivariatePuiseuxSeries +++ Also See: +++ AMS Classifications: +++ Keywords: sparse, series +++ Examples: +++ References: +++ Description: InnerSparseUnivariatePowerSeries is an internal domain +++ used for creating sparse Taylor and Laurent series. +InnerSparseUnivariatePowerSeries(Coef): Exports == Implementation where + Coef : Ring + B ==> Boolean + COM ==> OrderedCompletion Integer + I ==> Integer + L ==> List + NNI ==> NonNegativeInteger + OUT ==> OutputForm + PI ==> PositiveInteger + REF ==> Reference OrderedCompletion Integer + RN ==> Fraction Integer + Term ==> Record(k:Integer,c:Coef) + SG ==> String + ST ==> Stream Term + + Exports ==> UnivariatePowerSeriesCategory(Coef,Integer) with + makeSeries: (REF,ST) -> % + ++ makeSeries(refer,str) creates a power series from the reference + ++ \spad{refer} and the stream \spad{str}. + getRef: % -> REF + ++ getRef(f) returns a reference containing the order to which the + ++ terms of f have been computed. + getStream: % -> ST + ++ getStream(f) returns the stream of terms representing the series f. + series: ST -> % + ++ series(st) creates a series from a stream of non-zero terms, + ++ where a term is an exponent-coefficient pair. The terms in the + ++ stream should be ordered by increasing order of exponents. + monomial?: % -> B + ++ monomial?(f) tests if f is a single monomial. + multiplyCoefficients: (I -> Coef,%) -> % + ++ multiplyCoefficients(fn,f) returns the series + ++ \spad{sum(fn(n) * an * x^n,n = n0..)}, + ++ where f is the series \spad{sum(an * x^n,n = n0..)}. + iExquo: (%,%,B) -> Union(%,"failed") + ++ iExquo(f,g,taylor?) is the quotient of the power series f and g. + ++ If \spad{taylor?} is \spad{true}, then we must have + ++ \spad{order(f) >= order(g)}. + taylorQuoByVar: % -> % + ++ taylorQuoByVar(a0 + a1 x + a2 x**2 + ...) + ++ returns \spad{a1 + a2 x + a3 x**2 + ...} + iCompose: (%,%) -> % + ++ iCompose(f,g) returns \spad{f(g(x))}. This is an internal function + ++ which should only be called for Taylor series \spad{f(x)} and + ++ \spad{g(x)} such that the constant coefficient of \spad{g(x)} is zero. + seriesToOutputForm: (ST,REF,Symbol,Coef,RN) -> OutputForm + ++ seriesToOutputForm(st,refer,var,cen,r) prints the series + ++ \spad{f((var - cen)^r)}. + if Coef has Algebra Fraction Integer then + integrate: % -> % + ++ integrate(f(x)) returns an anti-derivative of the power series + ++ \spad{f(x)} with constant coefficient 0. + ++ Warning: function does not check for a term of degree -1. + cPower: (%,Coef) -> % + ++ cPower(f,r) computes \spad{f^r}, where f has constant coefficient 1. + ++ For use when the coefficient ring is commutative. + cRationalPower: (%,RN) -> % + ++ cRationalPower(f,r) computes \spad{f^r}. + ++ For use when the coefficient ring is commutative. + cExp: % -> % + ++ cExp(f) computes the exponential of the power series f. + ++ For use when the coefficient ring is commutative. + cLog: % -> % + ++ cLog(f) computes the logarithm of the power series f. + ++ For use when the coefficient ring is commutative. + cSin: % -> % + ++ cSin(f) computes the sine of the power series f. + ++ For use when the coefficient ring is commutative. + cCos: % -> % + ++ cCos(f) computes the cosine of the power series f. + ++ For use when the coefficient ring is commutative. + cTan: % -> % + ++ cTan(f) computes the tangent of the power series f. + ++ For use when the coefficient ring is commutative. + cCot: % -> % + ++ cCot(f) computes the cotangent of the power series f. + ++ For use when the coefficient ring is commutative. + cSec: % -> % + ++ cSec(f) computes the secant of the power series f. + ++ For use when the coefficient ring is commutative. + cCsc: % -> % + ++ cCsc(f) computes the cosecant of the power series f. + ++ For use when the coefficient ring is commutative. + cAsin: % -> % + ++ cAsin(f) computes the arcsine of the power series f. + ++ For use when the coefficient ring is commutative. + cAcos: % -> % + ++ cAcos(f) computes the arccosine of the power series f. + ++ For use when the coefficient ring is commutative. + cAtan: % -> % + ++ cAtan(f) computes the arctangent of the power series f. + ++ For use when the coefficient ring is commutative. + cAcot: % -> % + ++ cAcot(f) computes the arccotangent of the power series f. + ++ For use when the coefficient ring is commutative. + cAsec: % -> % + ++ cAsec(f) computes the arcsecant of the power series f. + ++ For use when the coefficient ring is commutative. + cAcsc: % -> % + ++ cAcsc(f) computes the arccosecant of the power series f. + ++ For use when the coefficient ring is commutative. + cSinh: % -> % + ++ cSinh(f) computes the hyperbolic sine of the power series f. + ++ For use when the coefficient ring is commutative. + cCosh: % -> % + ++ cCosh(f) computes the hyperbolic cosine of the power series f. + ++ For use when the coefficient ring is commutative. + cTanh: % -> % + ++ cTanh(f) computes the hyperbolic tangent of the power series f. + ++ For use when the coefficient ring is commutative. + cCoth: % -> % + ++ cCoth(f) computes the hyperbolic cotangent of the power series f. + ++ For use when the coefficient ring is commutative. + cSech: % -> % + ++ cSech(f) computes the hyperbolic secant of the power series f. + ++ For use when the coefficient ring is commutative. + cCsch: % -> % + ++ cCsch(f) computes the hyperbolic cosecant of the power series f. + ++ For use when the coefficient ring is commutative. + cAsinh: % -> % + ++ cAsinh(f) computes the inverse hyperbolic sine of the power + ++ series f. For use when the coefficient ring is commutative. + cAcosh: % -> % + ++ cAcosh(f) computes the inverse hyperbolic cosine of the power + ++ series f. For use when the coefficient ring is commutative. + cAtanh: % -> % + ++ cAtanh(f) computes the inverse hyperbolic tangent of the power + ++ series f. For use when the coefficient ring is commutative. + cAcoth: % -> % + ++ cAcoth(f) computes the inverse hyperbolic cotangent of the power + ++ series f. For use when the coefficient ring is commutative. + cAsech: % -> % + ++ cAsech(f) computes the inverse hyperbolic secant of the power + ++ series f. For use when the coefficient ring is commutative. + cAcsch: % -> % + ++ cAcsch(f) computes the inverse hyperbolic cosecant of the power + ++ series f. For use when the coefficient ring is commutative. + + Implementation ==> add + import REF + + Rep := Record(%ord: REF,%str: Stream Term) + -- when the value of 'ord' is n, this indicates that all non-zero + -- terms of order up to and including n have been computed; + -- when 'ord' is plusInfinity, all terms have been computed; + -- lazy evaluation of 'str' has the side-effect of modifying the value + -- of 'ord' + +--% Local functions + + makeTerm: (Integer,Coef) -> Term + getCoef: Term -> Coef + getExpon: Term -> Integer + iSeries: (ST,REF) -> ST + iExtend: (ST,COM,REF) -> ST + iTruncate0: (ST,REF,REF,COM,I,I) -> ST + iTruncate: (%,COM,I) -> % + iCoefficient: (ST,Integer) -> Coef + iOrder: (ST,COM,REF) -> I + iMap1: ((Coef,I) -> Coef,I -> I,B,ST,REF,REF,Integer) -> ST + iMap2: ((Coef,I) -> Coef,I -> I,B,%) -> % + iPlus1: ((Coef,Coef) -> Coef,ST,REF,ST,REF,REF,I) -> ST + iPlus2: ((Coef,Coef) -> Coef,%,%) -> % + productByTerm: (Coef,I,ST,REF,REF,I) -> ST + productLazyEval: (ST,REF,ST,REF,COM) -> Void + iTimes: (ST,REF,ST,REF,REF,I) -> ST + iDivide: (ST,REF,ST,REF,Coef,I,REF,I) -> ST + divide: (%,I,%,I,Coef) -> % + compose0: (ST,REF,ST,REF,I,%,%,I,REF,I) -> ST + factorials?: () -> Boolean + termOutput: (RN,Coef,OUT) -> OUT + showAll?: () -> Boolean + +--% macros + + makeTerm(exp,coef) == [exp,coef] + getCoef term == term.c + getExpon term == term.k + + makeSeries(refer,x) == [refer,x] + getRef ups == ups.%ord + getStream ups == ups.%str + +--% creation and destruction of series + + monomial(coef,expon) == + nix : ST := empty() + st := + zero? coef => nix + concat(makeTerm(expon,coef),nix) + makeSeries(ref plusInfinity(),st) + + monomial? ups == (not empty? getStream ups) and (empty? rst getStream ups) + + coerce(n:I) == n :: Coef :: % + coerce(r:Coef) == monomial(r,0) + + iSeries(x,refer) == + empty? x => (setelt(refer,plusInfinity()); empty()) + setelt(refer,(getExpon frst x) :: COM) + concat(frst x,iSeries(rst x,refer)) + + series(x:ST) == + empty? x => 0 + n := getExpon frst x; refer := ref(n :: COM) + makeSeries(refer,iSeries(x,refer)) + +--% values + + characteristic() == characteristic()$Coef + + 0 == monomial(0,0) + 1 == monomial(1,0) + + iExtend(st,n,refer) == + (elt refer) < n => + explicitlyEmpty? st => (setelt(refer,plusInfinity()); st) + explicitEntries? st => iExtend(rst st,n,refer) + iExtend(lazyEvaluate st,n,refer) + st + + extend(x,n) == (iExtend(getStream x,n :: COM,getRef x); x) + complete x == (iExtend(getStream x,plusInfinity(),getRef x); x) + + iTruncate0(x,xRefer,refer,minExp,maxExp,n) == delay + explicitlyEmpty? x => (setelt(refer,plusInfinity()); empty()) + nn := n :: COM + while (elt xRefer) < nn repeat lazyEvaluate x + explicitEntries? x => + (nx := getExpon(xTerm := frst x)) > maxExp => + (setelt(refer,plusInfinity()); empty()) + setelt(refer,nx :: COM) + (nx :: COM) >= minExp => + concat(makeTerm(nx,getCoef xTerm),_ + iTruncate0(rst x,xRefer,refer,minExp,maxExp,nx + 1)) + iTruncate0(rst x,xRefer,refer,minExp,maxExp,nx + 1) + -- can't have elt(xRefer) = infty unless all terms have been computed + degr := retract(elt xRefer)@I + setelt(refer,degr :: COM) + iTruncate0(x,xRefer,refer,minExp,maxExp,degr + 1) + + iTruncate(ups,minExp,maxExp) == + x := getStream ups; xRefer := getRef ups + explicitlyEmpty? x => 0 + explicitEntries? x => + deg := getExpon frst x + refer := ref((deg - 1) :: COM) + makeSeries(refer,iTruncate0(x,xRefer,refer,minExp,maxExp,deg)) + -- can't have elt(xRefer) = infty unless all terms have been computed + degr := retract(elt xRefer)@I + refer := ref(degr :: COM) + makeSeries(refer,iTruncate0(x,xRefer,refer,minExp,maxExp,degr + 1)) + + truncate(ups,n) == iTruncate(ups,minusInfinity(),n) + truncate(ups,n1,n2) == + if n1 > n2 then (n1,n2) := (n2,n1) + iTruncate(ups,n1 :: COM,n2) + + iCoefficient(st,n) == + explicitEntries? st => + term := frst st + (expon := getExpon term) > n => 0 + expon = n => getCoef term + iCoefficient(rst st,n) + 0 + + coefficient(x,n) == (extend(x,n); iCoefficient(getStream x,n)) + elt(x:%,n:Integer) == coefficient(x,n) + + iOrder(st,n,refer) == + explicitlyEmpty? st => error "order: series has infinite order" + explicitEntries? st => + ((r := getExpon frst st) :: COM) >= n => retract(n)@Integer + r + -- can't have elt(xRefer) = infty unless all terms have been computed + degr := retract(elt refer)@I + (degr :: COM) >= n => retract(n)@Integer + iOrder(lazyEvaluate st,n,refer) + + order x == iOrder(getStream x,plusInfinity(),getRef x) + order(x,n) == iOrder(getStream x,n :: COM,getRef x) + + terms x == getStream x + +--% predicates + + zero? ups == + x := getStream ups; ref := getRef ups + whatInfinity(n := elt ref) = 1 => explicitlyEmpty? x + count : NNI := _$streamCount$Lisp + for i in 1..count repeat + explicitlyEmpty? x => return true + explicitEntries? x => return false + lazyEvaluate x + false + + ups1 = ups2 == zero?(ups1 - ups2) + +--% arithmetic + + iMap1(cFcn,eFcn,check?,x,xRefer,refer,n) == delay + -- when this function is called, all terms in 'x' of order < n have been + -- computed and we compute the eFcn(n)th order coefficient of the result + explicitlyEmpty? x => (setelt(refer,plusInfinity()); empty()) + -- if terms in 'x' up to order n have not been computed, + -- apply lazy evaluation + nn := n :: COM + while (elt xRefer) < nn repeat lazyEvaluate x + -- 'x' may now be empty: retest + explicitlyEmpty? x => (setelt(refer,plusInfinity()); empty()) + -- must have nx >= n + explicitEntries? x => + xCoef := getCoef(xTerm := frst x); nx := getExpon xTerm + newCoef := cFcn(xCoef,nx); m := eFcn nx + setelt(refer,m :: COM) + not check? => + concat(makeTerm(m,newCoef),_ + iMap1(cFcn,eFcn,check?,rst x,xRefer,refer,nx + 1)) + zero? newCoef => iMap1(cFcn,eFcn,check?,rst x,xRefer,refer,nx + 1) + concat(makeTerm(m,newCoef),_ + iMap1(cFcn,eFcn,check?,rst x,xRefer,refer,nx + 1)) + -- can't have elt(xRefer) = infty unless all terms have been computed + degr := retract(elt xRefer)@I + setelt(refer,eFcn(degr) :: COM) + iMap1(cFcn,eFcn,check?,x,xRefer,refer,degr + 1) + + iMap2(cFcn,eFcn,check?,ups) == + -- 'eFcn' must be a strictly increasing function, + -- i.e. i < j => eFcn(i) < eFcn(j) + xRefer := getRef ups; x := getStream ups + explicitlyEmpty? x => 0 + explicitEntries? x => + deg := getExpon frst x + refer := ref(eFcn(deg - 1) :: COM) + makeSeries(refer,iMap1(cFcn,eFcn,check?,x,xRefer,refer,deg)) + -- can't have elt(xRefer) = infty unless all terms have been computed + degr := retract(elt xRefer)@I + refer := ref(eFcn(degr) :: COM) + makeSeries(refer,iMap1(cFcn,eFcn,check?,x,xRefer,refer,degr + 1)) + + map(fcn,x) == iMap2(fcn(#1),#1,true,x) + differentiate x == iMap2(#2 * #1,#1 - 1,true,x) + multiplyCoefficients(f,x) == iMap2(f(#2) * #1,#1,true,x) + multiplyExponents(x,n) == iMap2(#1,n * #1,false,x) + + iPlus1(op,x,xRefer,y,yRefer,refer,n) == delay + -- when this function is called, all terms in 'x' and 'y' of order < n + -- have been computed and we are computing the nth order coefficient of + -- the result; note the 'op' is either '+' or '-' + explicitlyEmpty? x => iMap1(op(0,#1),#1,false,y,yRefer,refer,n) + explicitlyEmpty? y => iMap1(op(#1,0),#1,false,x,xRefer,refer,n) + -- if terms up to order n have not been computed, + -- apply lazy evaluation + nn := n :: COM + while (elt xRefer) < nn repeat lazyEvaluate x + while (elt yRefer) < nn repeat lazyEvaluate y + -- 'x' or 'y' may now be empty: retest + explicitlyEmpty? x => iMap1(op(0,#1),#1,false,y,yRefer,refer,n) + explicitlyEmpty? y => iMap1(op(#1,0),#1,false,x,xRefer,refer,n) + -- must have nx >= n, ny >= n + -- both x and y have explicit terms + explicitEntries?(x) and explicitEntries?(y) => + xCoef := getCoef(xTerm := frst x); nx := getExpon xTerm + yCoef := getCoef(yTerm := frst y); ny := getExpon yTerm + nx = ny => + setelt(refer,nx :: COM) + zero? (coef := op(xCoef,yCoef)) => + iPlus1(op,rst x,xRefer,rst y,yRefer,refer,nx + 1) + concat(makeTerm(nx,coef),_ + iPlus1(op,rst x,xRefer,rst y,yRefer,refer,nx + 1)) + nx < ny => + setelt(refer,nx :: COM) + concat(makeTerm(nx,op(xCoef,0)),_ + iPlus1(op,rst x,xRefer,y,yRefer,refer,nx + 1)) + setelt(refer,ny :: COM) + concat(makeTerm(ny,op(0,yCoef)),_ + iPlus1(op,x,xRefer,rst y,yRefer,refer,ny + 1)) + -- y has no term of degree n + explicitEntries? x => + xCoef := getCoef(xTerm := frst x); nx := getExpon xTerm + -- can't have elt(yRefer) = infty unless all terms have been computed + (degr := retract(elt yRefer)@I) < nx => + setelt(refer,elt yRefer) + iPlus1(op,x,xRefer,y,yRefer,refer,degr + 1) + setelt(refer,nx :: COM) + concat(makeTerm(nx,op(xCoef,0)),_ + iPlus1(op,rst x,xRefer,y,yRefer,refer,nx + 1)) + -- x has no term of degree n + explicitEntries? y => + yCoef := getCoef(yTerm := frst y); ny := getExpon yTerm + -- can't have elt(xRefer) = infty unless all terms have been computed + (degr := retract(elt xRefer)@I) < ny => + setelt(refer,elt xRefer) + iPlus1(op,x,xRefer,y,yRefer,refer,degr + 1) + setelt(refer,ny :: COM) + concat(makeTerm(ny,op(0,yCoef)),_ + iPlus1(op,x,xRefer,rst y,yRefer,refer,ny + 1)) + -- neither x nor y has a term of degree n + setelt(refer,xyRef := min(elt xRefer,elt yRefer)) + -- can't have xyRef = infty unless all terms have been computed + iPlus1(op,x,xRefer,y,yRefer,refer,retract(xyRef)@I + 1) + + iPlus2(op,ups1,ups2) == + xRefer := getRef ups1; x := getStream ups1 + xDeg := + explicitlyEmpty? x => return map(op(0$Coef,#1),ups2) + explicitEntries? x => (getExpon frst x) - 1 + -- can't have elt(xRefer) = infty unless all terms have been computed + retract(elt xRefer)@I + yRefer := getRef ups2; y := getStream ups2 + yDeg := + explicitlyEmpty? y => return map(op(#1,0$Coef),ups1) + explicitEntries? y => (getExpon frst y) - 1 + -- can't have elt(yRefer) = infty unless all terms have been computed + retract(elt yRefer)@I + deg := min(xDeg,yDeg); refer := ref(deg :: COM) + makeSeries(refer,iPlus1(op,x,xRefer,y,yRefer,refer,deg + 1)) + + x + y == iPlus2(#1 + #2,x,y) + x - y == iPlus2(#1 - #2,x,y) + - y == iMap2(_-#1,#1,false,y) + + -- gives correct defaults for I, NNI and PI + n:I * x:% == (zero? n => 0; map(n * #1,x)) + n:NNI * x:% == (zero? n => 0; map(n * #1,x)) + n:PI * x:% == (zero? n => 0; map(n * #1,x)) + + productByTerm(coef,expon,x,xRefer,refer,n) == + iMap1(coef * #1,#1 + expon,true,x,xRefer,refer,n) + + productLazyEval(x,xRefer,y,yRefer,nn) == + explicitlyEmpty?(x) or explicitlyEmpty?(y) => void() + explicitEntries? x => + explicitEntries? y => void() + xDeg := (getExpon frst x) :: COM + while (xDeg + elt(yRefer)) < nn repeat lazyEvaluate y + void() + explicitEntries? y => + yDeg := (getExpon frst y) :: COM + while (yDeg + elt(xRefer)) < nn repeat lazyEvaluate x + void() + lazyEvaluate x + -- if x = y, then y may now have explicit entries + if lazy? y then lazyEvaluate y + productLazyEval(x,xRefer,y,yRefer,nn) + + iTimes(x,xRefer,y,yRefer,refer,n) == delay + -- when this function is called, we are computing the nth order + -- coefficient of the product + productLazyEval(x,xRefer,y,yRefer,n :: COM) + explicitlyEmpty?(x) or explicitlyEmpty?(y) => + (setelt(refer,plusInfinity()); empty()) + -- must have nx + ny >= n + explicitEntries?(x) and explicitEntries?(y) => + xCoef := getCoef(xTerm := frst x); xExpon := getExpon xTerm + yCoef := getCoef(yTerm := frst y); yExpon := getExpon yTerm + expon := xExpon + yExpon + setelt(refer,expon :: COM) + scRefer := ref(expon :: COM) + scMult := productByTerm(xCoef,xExpon,rst y,yRefer,scRefer,yExpon + 1) + prRefer := ref(expon :: COM) + pr := iTimes(rst x,xRefer,y,yRefer,prRefer,expon + 1) + sm := iPlus1(#1 + #2,scMult,scRefer,pr,prRefer,refer,expon + 1) + zero?(coef := xCoef * yCoef) => sm + concat(makeTerm(expon,coef),sm) + explicitEntries? x => + xExpon := getExpon frst x + -- can't have elt(yRefer) = infty unless all terms have been computed + degr := retract(elt yRefer)@I + setelt(refer,(xExpon + degr) :: COM) + iTimes(x,xRefer,y,yRefer,refer,xExpon + degr + 1) + explicitEntries? y => + yExpon := getExpon frst y + -- can't have elt(xRefer) = infty unless all terms have been computed + degr := retract(elt xRefer)@I + setelt(refer,(yExpon + degr) :: COM) + iTimes(x,xRefer,y,yRefer,refer,yExpon + degr + 1) + -- can't have elt(xRefer) = infty unless all terms have been computed + xDegr := retract(elt xRefer)@I + yDegr := retract(elt yRefer)@I + setelt(refer,(xDegr + yDegr) :: COM) + iTimes(x,xRefer,y,yRefer,refer,xDegr + yDegr + 1) + + ups1:% * ups2:% == + xRefer := getRef ups1; x := getStream ups1 + xDeg := + explicitlyEmpty? x => return 0 + explicitEntries? x => (getExpon frst x) - 1 + -- can't have elt(xRefer) = infty unless all terms have been computed + retract(elt xRefer)@I + yRefer := getRef ups2; y := getStream ups2 + yDeg := + explicitlyEmpty? y => return 0 + explicitEntries? y => (getExpon frst y) - 1 + -- can't have elt(yRefer) = infty unless all terms have been computed + retract(elt yRefer)@I + deg := xDeg + yDeg + 1; refer := ref(deg :: COM) + makeSeries(refer,iTimes(x,xRefer,y,yRefer,refer,deg + 1)) + + iDivide(x,xRefer,y,yRefer,rym,m,refer,n) == delay + -- when this function is called, we are computing the nth order + -- coefficient of the result + explicitlyEmpty? x => (setelt(refer,plusInfinity()); empty()) + -- if terms up to order n - m have not been computed, + -- apply lazy evaluation + nm := (n + m) :: COM + while (elt xRefer) < nm repeat lazyEvaluate x + -- 'x' may now be empty: retest + explicitlyEmpty? x => (setelt(refer,plusInfinity()); empty()) + -- must have nx >= n + m + explicitEntries? x => + newCoef := getCoef(xTerm := frst x) * rym; nx := getExpon xTerm + prodRefer := ref(nx :: COM) + prod := productByTerm(-newCoef,nx - m,rst y,yRefer,prodRefer,1) + sumRefer := ref(nx :: COM) + sum := iPlus1(#1 + #2,rst x,xRefer,prod,prodRefer,sumRefer,nx + 1) + setelt(refer,(nx - m) :: COM); term := makeTerm(nx - m,newCoef) + concat(term,iDivide(sum,sumRefer,y,yRefer,rym,m,refer,nx - m + 1)) + -- can't have elt(xRefer) = infty unless all terms have been computed + degr := retract(elt xRefer)@I + setelt(refer,(degr - m) :: COM) + iDivide(x,xRefer,y,yRefer,rym,m,refer,degr - m + 1) + + divide(ups1,deg1,ups2,deg2,r) == + xRefer := getRef ups1; x := getStream ups1 + yRefer := getRef ups2; y := getStream ups2 + refer := ref((deg1 - deg2) :: COM) + makeSeries(refer,iDivide(x,xRefer,y,yRefer,r,deg2,refer,deg1 - deg2 + 1)) + + iExquo(ups1,ups2,taylor?) == + xRefer := getRef ups1; x := getStream ups1 + yRefer := getRef ups2; y := getStream ups2 + n : I := 0 + -- try to find first non-zero term in y + -- give up after 1000 lazy evaluations + while not explicitEntries? y repeat + explicitlyEmpty? y => return "failed" + lazyEvaluate y + (n := n + 1) > 1000 => return "failed" + yCoef := getCoef(yTerm := frst y); ny := getExpon yTerm + (ry := recip yCoef) case "failed" => "failed" + nn := ny :: COM + if taylor? then + while (elt(xRefer) < nn) repeat + explicitlyEmpty? x => return 0 + explicitEntries? x => return "failed" + lazyEvaluate x + -- check if ups2 is a monomial + empty? rst y => iMap2(#1 * (ry :: Coef),#1 - ny,false,ups1) + explicitlyEmpty? x => 0 + nx := + explicitEntries? x => + ((deg := getExpon frst x) < ny) and taylor? => return "failed" + deg - 1 + -- can't have elt(xRefer) = infty unless all terms have been computed + retract(elt xRefer)@I + divide(ups1,nx,ups2,ny,ry :: Coef) + + taylorQuoByVar ups == + iMap2(#1,#1 - 1,false,ups - monomial(coefficient(ups,0),0)) + + compose0(x,xRefer,y,yRefer,yOrd,y1,yn0,n0,refer,n) == delay + -- when this function is called, we are computing the nth order + -- coefficient of the composite + explicitlyEmpty? x => (setelt(refer,plusInfinity()); empty()) + -- if terms in 'x' up to order n have not been computed, + -- apply lazy evaluation + nn := n :: COM; yyOrd := yOrd :: COM + while (yyOrd * elt(xRefer)) < nn repeat lazyEvaluate x + explicitEntries? x => + xCoef := getCoef(xTerm := frst x); n1 := getExpon xTerm + zero? n1 => + setelt(refer,n1 :: COM) + concat(makeTerm(n1,xCoef),_ + compose0(rst x,xRefer,y,yRefer,yOrd,y1,yn0,n0,refer,n1 + 1)) + yn1 := yn0 * y1 ** ((n1 - n0) :: NNI) + z := getStream yn1; zRefer := getRef yn1 + degr := yOrd * n1; prodRefer := ref((degr - 1) :: COM) + prod := iMap1(xCoef * #1,#1,true,z,zRefer,prodRefer,degr) + coRefer := ref((degr + yOrd - 1) :: COM) + co := compose0(rst x,xRefer,y,yRefer,yOrd,y1,yn1,n1,coRefer,degr + yOrd) + setelt(refer,(degr - 1) :: COM) + iPlus1(#1 + #2,prod,prodRefer,co,coRefer,refer,degr) + -- can't have elt(xRefer) = infty unless all terms have been computed + degr := yOrd * (retract(elt xRefer)@I + 1) + setelt(refer,(degr - 1) :: COM) + compose0(x,xRefer,y,yRefer,yOrd,y1,yn0,n0,refer,degr) + + iCompose(ups1,ups2) == + x := getStream ups1; xRefer := getRef ups1 + y := getStream ups2; yRefer := getRef ups2 + -- try to compute the order of 'ups2' + n : I := _$streamCount$Lisp + for i in 1..n while not explicitEntries? y repeat + explicitlyEmpty? y => coefficient(ups1,0) :: % + lazyEvaluate y + explicitlyEmpty? y => coefficient(ups1,0) :: % + yOrd : I := + explicitEntries? y => getExpon frst y + retract(elt yRefer)@I + compRefer := ref((-1) :: COM) + makeSeries(compRefer,_ + compose0(x,xRefer,y,yRefer,yOrd,ups2,1,0,compRefer,0)) + + if Coef has Algebra Fraction Integer then + + integrate x == iMap2(1/(#2 + 1) * #1,#1 + 1,true,x) + +--% Fixed point computations + + Ys ==> Y$ParadoxicalCombinatorsForStreams(Term) + + integ0: (ST,REF,REF,I) -> ST + integ0(x,intRef,ansRef,n) == delay + nLess1 := (n - 1) :: COM + while (elt intRef) < nLess1 repeat lazyEvaluate x + explicitlyEmpty? x => (setelt(ansRef,plusInfinity()); empty()) + explicitEntries? x => + xCoef := getCoef(xTerm := frst x); nx := getExpon xTerm + setelt(ansRef,(n1 := (nx + 1)) :: COM) + concat(makeTerm(n1,inv(n1 :: RN) * xCoef),_ + integ0(rst x,intRef,ansRef,n1)) + -- can't have elt(intRef) = infty unless all terms have been computed + degr := retract(elt intRef)@I; setelt(ansRef,(degr + 1) :: COM) + integ0(x,intRef,ansRef,degr + 2) + + integ1: (ST,REF,REF) -> ST + integ1(x,intRef,ansRef) == integ0(x,intRef,ansRef,1) + + lazyInteg: (Coef,() -> ST,REF,REF) -> ST + lazyInteg(a,xf,intRef,ansRef) == + ansStr : ST := integ1(delay xf,intRef,ansRef) + concat(makeTerm(0,a),ansStr) + + cPower(f,r) == + -- computes f^r. f should have constant coefficient 1. + fp := differentiate f + fInv := iExquo(1,f,false) :: %; y := r * fp * fInv + yRef := getRef y; yStr := getStream y + intRef := ref((-1) :: COM); ansRef := ref(0 :: COM) + ansStr := Ys lazyInteg(1,iTimes(#1,ansRef,yStr,yRef,intRef,0),_ + intRef,ansRef) + makeSeries(ansRef,ansStr) + + iExp: (%,Coef) -> % + iExp(f,cc) == + -- computes exp(f). cc = exp coefficient(f,0) + fp := differentiate f + fpRef := getRef fp; fpStr := getStream fp + intRef := ref((-1) :: COM); ansRef := ref(0 :: COM) + ansStr := Ys lazyInteg(cc,iTimes(#1,ansRef,fpStr,fpRef,intRef,0),_ + intRef,ansRef) + makeSeries(ansRef,ansStr) + + sincos0: (Coef,Coef,L ST,REF,REF,ST,REF,ST,REF) -> L ST + sincos0(sinc,cosc,list,sinRef,cosRef,fpStr,fpRef,fpStr2,fpRef2) == + sinStr := first list; cosStr := second list + prodRef1 := ref((-1) :: COM); prodRef2 := ref((-1) :: COM) + prodStr1 := iTimes(cosStr,cosRef,fpStr,fpRef,prodRef1,0) + prodStr2 := iTimes(sinStr,sinRef,fpStr2,fpRef2,prodRef2,0) + [lazyInteg(sinc,prodStr1,prodRef1,sinRef),_ + lazyInteg(cosc,prodStr2,prodRef2,cosRef)] + + iSincos: (%,Coef,Coef,I) -> Record(%sin: %, %cos: %) + iSincos(f,sinc,cosc,sign) == + fp := differentiate f + fpRef := getRef fp; fpStr := getStream fp +-- fp2 := (one? sign => fp; -fp) + fp2 := ((sign = 1) => fp; -fp) + fpRef2 := getRef fp2; fpStr2 := getStream fp2 + sinRef := ref(0 :: COM); cosRef := ref(0 :: COM) + sincos := + Ys(sincos0(sinc,cosc,#1,sinRef,cosRef,fpStr,fpRef,fpStr2,fpRef2),2) + sinStr := (zero? sinc => rst first sincos; first sincos) + cosStr := (zero? cosc => rst second sincos; second sincos) + [makeSeries(sinRef,sinStr),makeSeries(cosRef,cosStr)] + + tan0: (Coef,ST,REF,ST,REF,I) -> ST + tan0(cc,ansStr,ansRef,fpStr,fpRef,sign) == + sqRef := ref((-1) :: COM) + sqStr := iTimes(ansStr,ansRef,ansStr,ansRef,sqRef,0) + one : % := 1; oneStr := getStream one; oneRef := getRef one + yRef := ref((-1) :: COM) + yStr : ST := +-- one? sign => iPlus1(#1 + #2,oneStr,oneRef,sqStr,sqRef,yRef,0) + (sign = 1) => iPlus1(#1 + #2,oneStr,oneRef,sqStr,sqRef,yRef,0) + iPlus1(#1 - #2,oneStr,oneRef,sqStr,sqRef,yRef,0) + intRef := ref((-1) :: COM) + lazyInteg(cc,iTimes(yStr,yRef,fpStr,fpRef,intRef,0),intRef,ansRef) + + iTan: (%,%,Coef,I) -> % + iTan(f,fp,cc,sign) == + -- computes the tangent (and related functions) of f. + fpRef := getRef fp; fpStr := getStream fp + ansRef := ref(0 :: COM) + ansStr := Ys tan0(cc,#1,ansRef,fpStr,fpRef,sign) + zero? cc => makeSeries(ansRef,rst ansStr) + makeSeries(ansRef,ansStr) + +--% Error Reporting + + TRCONST : SG := "series expansion involves transcendental constants" + NPOWERS : SG := "series expansion has terms of negative degree" + FPOWERS : SG := "series expansion has terms of fractional degree" + MAYFPOW : SG := "series expansion may have terms of fractional degree" + LOGS : SG := "series expansion has logarithmic term" + NPOWLOG : SG := + "series expansion has terms of negative degree or logarithmic term" + NOTINV : SG := "leading coefficient not invertible" + +--% Rational powers and transcendental functions + + orderOrFailed : % -> Union(I,"failed") + orderOrFailed uts == + -- returns the order of x or "failed" + -- if -1 is returned, the series is identically zero + x := getStream uts + for n in 0..1000 repeat + explicitlyEmpty? x => return -1 + explicitEntries? x => return getExpon frst x + lazyEvaluate x + "failed" + + RATPOWERS : Boolean := Coef has "**": (Coef,RN) -> Coef + TRANSFCN : Boolean := Coef has TranscendentalFunctionCategory + + cRationalPower(uts,r) == + (ord0 := orderOrFailed uts) case "failed" => + error "**: series with many leading zero coefficients" + order := ord0 :: I + (n := order exquo denom(r)) case "failed" => + error "**: rational power does not exist" + cc := coefficient(uts,order) + (ccInv := recip cc) case "failed" => error concat("**: ",NOTINV) + ccPow := +-- one? cc => cc + (cc = 1) => cc +-- one? denom r => + (denom r) = 1 => + not negative?(num := numer r) => cc ** (num :: NNI) + (ccInv :: Coef) ** ((-num) :: NNI) + RATPOWERS => cc ** r + error "** rational power of coefficient undefined" + uts1 := (ccInv :: Coef) * uts + uts2 := uts1 * monomial(1,-order) + monomial(ccPow,(n :: I) * numer(r)) * cPower(uts2,r :: Coef) + + cExp uts == + zero?(cc := coefficient(uts,0)) => iExp(uts,1) + TRANSFCN => iExp(uts,exp cc) + error concat("exp: ",TRCONST) + + cLog uts == + zero?(cc := coefficient(uts,0)) => + error "log: constant coefficient should not be 0" +-- one? cc => integrate(differentiate(uts) * (iExquo(1,uts,true) :: %)) + (cc = 1) => integrate(differentiate(uts) * (iExquo(1,uts,true) :: %)) + TRANSFCN => + y := iExquo(1,uts,true) :: % + (log(cc) :: %) + integrate(y * differentiate(uts)) + error concat("log: ",TRCONST) + + sincos: % -> Record(%sin: %, %cos: %) + sincos uts == + zero?(cc := coefficient(uts,0)) => iSincos(uts,0,1,-1) + TRANSFCN => iSincos(uts,sin cc,cos cc,-1) + error concat("sincos: ",TRCONST) + + cSin uts == sincos(uts).%sin + cCos uts == sincos(uts).%cos + + cTan uts == + zero?(cc := coefficient(uts,0)) => iTan(uts,differentiate uts,0,1) + TRANSFCN => iTan(uts,differentiate uts,tan cc,1) + error concat("tan: ",TRCONST) + + cCot uts == + zero? uts => error "cot: cot(0) is undefined" + zero?(cc := coefficient(uts,0)) => error error concat("cot: ",NPOWERS) + TRANSFCN => iTan(uts,-differentiate uts,cot cc,1) + error concat("cot: ",TRCONST) + + cSec uts == + zero?(cc := coefficient(uts,0)) => iExquo(1,cCos uts,true) :: % + TRANSFCN => + cosUts := cCos uts + zero? coefficient(cosUts,0) => error concat("sec: ",NPOWERS) + iExquo(1,cosUts,true) :: % + error concat("sec: ",TRCONST) + + cCsc uts == + zero? uts => error "csc: csc(0) is undefined" + TRANSFCN => + sinUts := cSin uts + zero? coefficient(sinUts,0) => error concat("csc: ",NPOWERS) + iExquo(1,sinUts,true) :: % + error concat("csc: ",TRCONST) + + cAsin uts == + zero?(cc := coefficient(uts,0)) => + integrate(cRationalPower(1 - uts*uts,-1/2) * differentiate(uts)) + TRANSFCN => + x := 1 - uts * uts + cc = 1 or cc = -1 => + -- compute order of 'x' + (ord := orderOrFailed x) case "failed" => + error concat("asin: ",MAYFPOW) + (order := ord :: I) = -1 => return asin(cc) :: % + odd? order => error concat("asin: ",FPOWERS) + c0 := asin(cc) :: % + c0 + integrate(cRationalPower(x,-1/2) * differentiate(uts)) + c0 := asin(cc) :: % + c0 + integrate(cRationalPower(x,-1/2) * differentiate(uts)) + error concat("asin: ",TRCONST) + + cAcos uts == + zero? uts => + TRANSFCN => acos(0)$Coef :: % + error concat("acos: ",TRCONST) + TRANSFCN => + x := 1 - uts * uts + cc := coefficient(uts,0) + cc = 1 or cc = -1 => + -- compute order of 'x' + (ord := orderOrFailed x) case "failed" => + error concat("acos: ",MAYFPOW) + (order := ord :: I) = -1 => return acos(cc) :: % + odd? order => error concat("acos: ",FPOWERS) + c0 := acos(cc) :: % + c0 + integrate(-cRationalPower(x,-1/2) * differentiate(uts)) + c0 := acos(cc) :: % + c0 + integrate(-cRationalPower(x,-1/2) * differentiate(uts)) + error concat("acos: ",TRCONST) + + cAtan uts == + zero?(cc := coefficient(uts,0)) => + y := iExquo(1,(1 :: %) + uts*uts,true) :: % + integrate(y * (differentiate uts)) + TRANSFCN => + (y := iExquo(1,(1 :: %) + uts*uts,true)) case "failed" => + error concat("atan: ",LOGS) + (atan(cc) :: %) + integrate((y :: %) * (differentiate uts)) + error concat("atan: ",TRCONST) + + cAcot uts == + TRANSFCN => + (y := iExquo(1,(1 :: %) + uts*uts,true)) case "failed" => + error concat("acot: ",LOGS) + cc := coefficient(uts,0) + (acot(cc) :: %) + integrate(-(y :: %) * (differentiate uts)) + error concat("acot: ",TRCONST) + + cAsec uts == + zero?(cc := coefficient(uts,0)) => + error "asec: constant coefficient should not be 0" + TRANSFCN => + x := uts * uts - 1 + y := + cc = 1 or cc = -1 => + -- compute order of 'x' + (ord := orderOrFailed x) case "failed" => + error concat("asec: ",MAYFPOW) + (order := ord :: I) = -1 => return asec(cc) :: % + odd? order => error concat("asec: ",FPOWERS) + cRationalPower(x,-1/2) * differentiate(uts) + cRationalPower(x,-1/2) * differentiate(uts) + (z := iExquo(y,uts,true)) case "failed" => + error concat("asec: ",NOTINV) + (asec(cc) :: %) + integrate(z :: %) + error concat("asec: ",TRCONST) + + cAcsc uts == + zero?(cc := coefficient(uts,0)) => + error "acsc: constant coefficient should not be 0" + TRANSFCN => + x := uts * uts - 1 + y := + cc = 1 or cc = -1 => + -- compute order of 'x' + (ord := orderOrFailed x) case "failed" => + error concat("acsc: ",MAYFPOW) + (order := ord :: I) = -1 => return acsc(cc) :: % + odd? order => error concat("acsc: ",FPOWERS) + -cRationalPower(x,-1/2) * differentiate(uts) + -cRationalPower(x,-1/2) * differentiate(uts) + (z := iExquo(y,uts,true)) case "failed" => + error concat("asec: ",NOTINV) + (acsc(cc) :: %) + integrate(z :: %) + error concat("acsc: ",TRCONST) + + sinhcosh: % -> Record(%sinh: %, %cosh: %) + sinhcosh uts == + zero?(cc := coefficient(uts,0)) => + tmp := iSincos(uts,0,1,1) + [tmp.%sin,tmp.%cos] + TRANSFCN => + tmp := iSincos(uts,sinh cc,cosh cc,1) + [tmp.%sin,tmp.%cos] + error concat("sinhcosh: ",TRCONST) + + cSinh uts == sinhcosh(uts).%sinh + cCosh uts == sinhcosh(uts).%cosh + + cTanh uts == + zero?(cc := coefficient(uts,0)) => iTan(uts,differentiate uts,0,-1) + TRANSFCN => iTan(uts,differentiate uts,tanh cc,-1) + error concat("tanh: ",TRCONST) + + cCoth uts == + tanhUts := cTanh uts + zero? tanhUts => error "coth: coth(0) is undefined" + zero? coefficient(tanhUts,0) => error concat("coth: ",NPOWERS) + iExquo(1,tanhUts,true) :: % + + cSech uts == + coshUts := cCosh uts + zero? coefficient(coshUts,0) => error concat("sech: ",NPOWERS) + iExquo(1,coshUts,true) :: % + + cCsch uts == + sinhUts := cSinh uts + zero? coefficient(sinhUts,0) => error concat("csch: ",NPOWERS) + iExquo(1,sinhUts,true) :: % + + cAsinh uts == + x := 1 + uts * uts + zero?(cc := coefficient(uts,0)) => cLog(uts + cRationalPower(x,1/2)) + TRANSFCN => + (ord := orderOrFailed x) case "failed" => + error concat("asinh: ",MAYFPOW) + (order := ord :: I) = -1 => return asinh(cc) :: % + odd? order => error concat("asinh: ",FPOWERS) + -- the argument to 'log' must have a non-zero constant term + cLog(uts + cRationalPower(x,1/2)) + error concat("asinh: ",TRCONST) + + cAcosh uts == + zero? uts => + TRANSFCN => acosh(0)$Coef :: % + error concat("acosh: ",TRCONST) + TRANSFCN => + cc := coefficient(uts,0); x := uts*uts - 1 + cc = 1 or cc = -1 => + -- compute order of 'x' + (ord := orderOrFailed x) case "failed" => + error concat("acosh: ",MAYFPOW) + (order := ord :: I) = -1 => return acosh(cc) :: % + odd? order => error concat("acosh: ",FPOWERS) + -- the argument to 'log' must have a non-zero constant term + cLog(uts + cRationalPower(x,1/2)) + cLog(uts + cRationalPower(x,1/2)) + error concat("acosh: ",TRCONST) + + cAtanh uts == + half := inv(2 :: RN) :: Coef + zero?(cc := coefficient(uts,0)) => + half * (cLog(1 + uts) - cLog(1 - uts)) + TRANSFCN => + cc = 1 or cc = -1 => error concat("atanh: ",LOGS) + half * (cLog(1 + uts) - cLog(1 - uts)) + error concat("atanh: ",TRCONST) + + cAcoth uts == + zero? uts => + TRANSFCN => acoth(0)$Coef :: % + error concat("acoth: ",TRCONST) + TRANSFCN => + cc := coefficient(uts,0); half := inv(2 :: RN) :: Coef + cc = 1 or cc = -1 => error concat("acoth: ",LOGS) + half * (cLog(uts + 1) - cLog(uts - 1)) + error concat("acoth: ",TRCONST) + + cAsech uts == + zero? uts => error "asech: asech(0) is undefined" + TRANSFCN => + zero?(cc := coefficient(uts,0)) => + error concat("asech: ",NPOWLOG) + x := 1 - uts * uts + cc = 1 or cc = -1 => + -- compute order of 'x' + (ord := orderOrFailed x) case "failed" => + error concat("asech: ",MAYFPOW) + (order := ord :: I) = -1 => return asech(cc) :: % + odd? order => error concat("asech: ",FPOWERS) + (utsInv := iExquo(1,uts,true)) case "failed" => + error concat("asech: ",NOTINV) + cLog((1 + cRationalPower(x,1/2)) * (utsInv :: %)) + (utsInv := iExquo(1,uts,true)) case "failed" => + error concat("asech: ",NOTINV) + cLog((1 + cRationalPower(x,1/2)) * (utsInv :: %)) + error concat("asech: ",TRCONST) + + cAcsch uts == + zero? uts => error "acsch: acsch(0) is undefined" + TRANSFCN => + zero?(cc := coefficient(uts,0)) => error concat("acsch: ",NPOWLOG) + x := uts * uts + 1 + -- compute order of 'x' + (ord := orderOrFailed x) case "failed" => + error concat("acsc: ",MAYFPOW) + (order := ord :: I) = -1 => return acsch(cc) :: % + odd? order => error concat("acsch: ",FPOWERS) + (utsInv := iExquo(1,uts,true)) case "failed" => + error concat("acsch: ",NOTINV) + cLog((1 + cRationalPower(x,1/2)) * (utsInv :: %)) + error concat("acsch: ",TRCONST) + +--% Output forms + + -- check a global Lisp variable + factorials?() == false + + termOutput(k,c,vv) == + -- creates a term c * vv ** k + k = 0 => c :: OUT + mon := (k = 1 => vv; vv ** (k :: OUT)) +-- if factorials?() and k > 1 then +-- c := factorial(k)$IntegerCombinatoricFunctions * c +-- mon := mon / hconcat(k :: OUT,"!" :: OUT) + c = 1 => mon + c = -1 => -mon + (c :: OUT) * mon + + -- check a global Lisp variable + showAll?() == true + + seriesToOutputForm(st,refer,var,cen,r) == + vv := + zero? cen => var :: OUT + paren(var :: OUT - cen :: OUT) + l : L OUT := empty() + while explicitEntries? st repeat + term := frst st + l := concat(termOutput(getExpon(term) * r,getCoef term,vv),l) + st := rst st + l := + explicitlyEmpty? st => l + (deg := retractIfCan(elt refer)@Union(I,"failed")) case I => + concat(prefix("O" :: OUT,[vv ** ((((deg :: I) + 1) * r) :: OUT)]),l) + l + empty? l => (0$Coef) :: OUT + reduce("+",reverse_! l) + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{domain INFORM InputForm} \pagehead{InputForm}{INFORM} \pagepic{ps/v103inputform.ps}{INFORM}{1.00} @@ -53359,6 +56006,10 @@ o $AXIOM/doc/src/algebra/radix.spad.dvi @ \pagehead{RadixExpansion}{RADIX} \pagepic{ps/v103radixexpansion.ps}{RADIX}{1.00} +See also:\\ +\refto{BinaryExpansion}{BINARY} +\refto{DecimalExpansion}{DECIMAL} +\refto{HexadecimalExpansion}{HEXADEC} <>= )abbrev domain RADIX RadixExpansion ++ Author: Stephen M. Watt @@ -54833,6 +57484,8 @@ o $AXIOM/doc/src/algebra/reclos.spad.dvi @ \pagehead{RealClosure}{RECLOS} \pagepic{ps/v103realclosure.ps}{RECLOS}{1.00} +See also:\\ +\refto{RightOpenIntervalRootCharacterization}{ROIRC} <>= )abbrev domain RECLOS RealClosure ++ Author: Renaud Rioboo @@ -57217,6 +59870,8 @@ digraph pic { \section{domain RULE RewriteRule} \pagehead{RewriteRule}{RULE} \pagepic{ps/v103rewriterule.ps}{RULE}{1.00} +See also:\\ +\refto{Ruleset}{RULESET} <>= )abbrev domain RULE RewriteRule ++ Rules for the pattern matcher @@ -57386,6 +60041,8 @@ computations are done excatly. They can thus be quite time consuming when depending on several "real roots". \pagehead{RightOpenIntervalRootCharacterization}{ROIRC} \pagepic{ps/v103rightopenintervalrootcharacterization.ps}{ROIRC}{1.00} +See also:\\ +\refto{RealClosure}{RECLOS} <>= )abbrev domain ROIRC RightOpenIntervalRootCharacterization ++ Author: Renaud Rioboo @@ -58565,6 +61222,8 @@ RoutinesTable(): E == I where \section{domain RULESET Ruleset} \pagehead{Ruleset}{RULESET} \pagepic{ps/v103ruleset.ps}{RULESET}{1.00} +See also:\\ +\refto{RewriteRule}{RULE} <>= )abbrev domain RULESET Ruleset ++ Sets of rules for the pattern matcher @@ -59039,6 +61698,913 @@ ScriptFormulaFormat(): public == private where @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain SEG Segment} +<>= +-- seg.spad.pamphlet Segment.input +)spool Segment.output +)set message test on +)set message auto off +)clear all +--S 1 of 10 +s := 3..10 +--R +--R +--R (1) 3..10 +--R Type: Segment PositiveInteger +--E 1 + +--S 2 of 10 +lo s +--R +--R +--R (2) 3 +--R Type: PositiveInteger +--E 2 + +--S 3 of 10 +hi s +--R +--R +--R (3) 10 +--R Type: PositiveInteger +--E 3 + +--S 4 of 10 +t := 10..3 by -2 +--R +--R +--R (4) 10..3 by - 2 +--R Type: Segment PositiveInteger +--E 4 + +--S 5 of 10 +incr s +--R +--R +--R (5) 1 +--R Type: PositiveInteger +--E 5 + +--S 6 of 10 +incr t +--R +--R +--R (6) - 2 +--R Type: Integer +--E 6 + +--S 7 of 10 +l := [1..3, 5, 9, 15..11 by -1] +--R +--R +--R (7) [1..3,5..5,9..9,15..11 by - 1] +--R Type: List Segment PositiveInteger +--E 7 + +--S 8 of 10 +expand s +--R +--R +--R (8) [3,4,5,6,7,8,9,10] +--R Type: List Integer +--E 8 + +--S 9 of 10 +expand t +--R +--R +--R (9) [10,8,6,4] +--R Type: List Integer +--E 9 + +--S 10 of 10 +expand l +--R +--R +--R (10) [1,2,3,5,9,15,14,13,12,11] +--R Type: List Integer +--E 10 +)spool +)lisp (bye) +@ +<>= +==================================================================== +Segment examples +==================================================================== + +The Segment domain provides a generalized interval type. + +Segments are created using the .. construct by indicating the +(included) end points. + + s := 3..10 + 3..10 + Type: Segment PositiveInteger + +The first end point is called the lo and the second is called hi. + + lo s + 3 + Type: PositiveInteger + +These names are used even though the end points might belong to an +unordered set. + + hi s + 10 + Type: PositiveInteger + +In addition to the end points, each segment has an integer "increment". +An increment can be specified using the "by" construct. + + t := 10..3 by -2 + 10..3 by - 2 + Type: Segment PositiveInteger + +This part can be obtained using the incr function. + + incr s + 1 + Type: PositiveInteger + +Unless otherwise specified, the increment is 1. + + incr t + - 2 + Type: Integer + +A single value can be converted to a segment with equal end points. +This happens if segments and single values are mixed in a list. + + l := [1..3, 5, 9, 15..11 by -1] + [1..3,5..5,9..9,15..11 by - 1] + Type: List Segment PositiveInteger + +If the underlying type is an ordered ring, it is possible to perform +additional operations. The expand operation creates a list of points +in a segment. + + expand s + [3,4,5,6,7,8,9,10] + Type: List Integer + +If k > 0, then expand(l..h by k) creates the list [l, l+k, ..., lN] +where lN <= h < lN+k. If k < 0, then lN >= h > lN+k. + + expand t + [10,8,6,4] + Type: List Integer + +It is also possible to expand a list of segments. This is equivalent +to appending lists obtained by expanding each segment individually. + + expand l + [1,2,3,5,9,15,14,13,12,11] + Type: List Integer + +See Also: +o )help UniversalSegment +o )help SegmentBinding +o )show Segment +o $AXIOM/doc/src/algebra/seg.spad.dvi + +@ +\pagehead{Segment}{SEG} +\pagepic{ps/v103segment.ps}{SEG}{1.00} +See also:\\ +\refto{SegmentBinding}{SEGBIND} +\refto{UniversalSegment}{UNISEG} +<>= +)abbrev domain SEG Segment +++ Author: Stephen M. Watt +++ Date Created: December 1986 +++ Date Last Updated: June 3, 1991 +++ Basic Operations: +++ Related Domains: +++ Also See: +++ AMS Classifications: +++ Keywords: range, segment +++ Examples: +++ References: +++ Description: +++ This type is used to specify a range of values from type \spad{S}. + +Segment(S:Type): SegmentCategory(S) with + if S has SetCategory then SetCategory + if S has OrderedRing then SegmentExpansionCategory(S, List S) + == add + + Rep := Record(low: S, high: S, incr: Integer) + + a..b == [a,b,1] + lo s == s.low + low s == s.low + hi s == s.high + high s == s.high + incr s == s.incr + segment(a,b) == [a,b,1] + BY(s, r) == [lo s, hi s, r] + + if S has SetCategory then + (s1:%) = (s2:%) == + s1.low = s2.low and s1.high=s2.high and s1.incr = s2.incr + + coerce(s:%):OutputForm == + seg := SEGMENT(s.low::OutputForm, s.high::OutputForm) + s.incr = 1 => seg + infix(" by "::OutputForm, seg, s.incr::OutputForm) + + convert a == [a,a,1] + + if S has OrderedRing then + expand(ls: List %):List S == + lr := nil()$List(S) + for s in ls repeat + l := lo s + h := hi s + inc := (incr s)::S + zero? inc => error "Cannot expand a segment with an increment of zero" + if inc > 0 then + while l <= h repeat + lr := concat(l, lr) + l := l + inc + else + while l >= h repeat + lr := concat(l, lr) + l := l + inc + reverse_! lr + + expand(s : %) == expand([s]$List(%))$% + map(f : S->S, s : %): List S == + lr := nil()$List(S) + l := lo s + h := hi s + inc := (incr s)::S + if inc > 0 then + while l <= h repeat + lr := concat(f l, lr) + l := l + inc + else + while l >= h repeat + lr := concat(f l, lr) + l := l + inc + reverse_! lr + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain SEGBIND SegmentBinding} +<>= +-- seg.spad.pamphlet SegmentBinding.input +)spool SegmentBinding.output +)set message test on +)set message auto off +)clear all +--S 1 of 5 +x = a..b +--R +--R +--R (1) x= a..b +--R Type: SegmentBinding Symbol +--E 1 + +--S 2 of 5 +sum(i**2, i = 0..n) +--R +--R +--R 3 2 +--R 2n + 3n + n +--R (2) ------------- +--R 6 +--R Type: Fraction Polynomial Integer +--E 2 + +--S 3 of 5 +sb := y = 1/2..3/2 +--R +--R +--R 1 3 +--R (3) y= (-)..(-) +--R 2 2 +--R Type: SegmentBinding Fraction Integer +--E 3 + +--S 4 of 5 +variable(sb) +--R +--R +--R (4) y +--R Type: Symbol +--E 4 + +--S 5 of 5 +segment(sb) +--R +--R +--R 1 3 +--R (5) (-)..(-) +--R 2 2 +--R Type: Segment Fraction Integer +--E 5 +)spool +)lisp (bye) +@ +<>= +==================================================================== +SegmentBinding examples +==================================================================== + +The SegmentBinding type is used to indicate a range for a named symbol. + +First give the symbol, then an = and finally a segment of values. + + x = a..b + x= a..b + Type: SegmentBinding Symbol + +This is used to provide a convenient syntax for arguments to certain +operations. + + sum(i**2, i = 0..n) + 3 2 + 2n + 3n + n + ------------- + 6 + Type: Fraction Polynomial Integer + + draw(x**2, x = -2..2) + TwoDimensionalViewport: "x*x" + Type: TwoDimensionalViewport + + +The left-hand side must be of type Symbol but the right-hand side can +be a segment over any type. + + sb := y = 1/2..3/2 + 1 3 + y= (-)..(-) + 2 2 + Type: SegmentBinding Fraction Integer + +The left- and right-hand sides can be obtained using the variable and +segment operations. + + variable(sb) + y + Type: Symbol + + segment(sb) + 1 3 + (-)..(-) + 2 2 + Type: Segment Fraction Integer + +See Also: +o )help Segment +o )help UniversalSegment +o )show SegmentBinding +o $AXIOM/doc/src/algebra/seg.spad.dvi + +@ +\pagehead{SegmentBinding}{SEGBIND} +\pagepic{ps/v103segmentbinding.ps}{SEGBIND}{1.00} +See also:\\ +\refto{Segment}{SEG} +\refto{UniversalSegment}{UNISEG} +<>= +)abbrev domain SEGBIND SegmentBinding +++ Author: +++ Date Created: +++ Date Last Updated: June 4, 1991 +++ Basic Operations: +++ Related Domains: Equation, Segment, Symbol +++ Also See: +++ AMS Classifications: +++ Keywords: equation +++ Examples: +++ References: +++ Description: +++ This domain is used to provide the function argument syntax \spad{v=a..b}. +++ This is used, for example, by the top-level \spadfun{draw} functions. +SegmentBinding(S:Type): Type with + equation: (Symbol, Segment S) -> % + ++ equation(v,a..b) creates a segment binding value with variable + ++ \spad{v} and segment \spad{a..b}. Note that the interpreter parses + ++ \spad{v=a..b} to this form. + variable: % -> Symbol + ++ variable(segb) returns the variable from the left hand side of + ++ the \spadtype{SegmentBinding}. For example, if \spad{segb} is + ++ \spad{v=a..b}, then \spad{variable(segb)} returns \spad{v}. + segment : % -> Segment S + ++ segment(segb) returns the segment from the right hand side of + ++ the \spadtype{SegmentBinding}. For example, if \spad{segb} is + ++ \spad{v=a..b}, then \spad{segment(segb)} returns \spad{a..b}. + + if S has SetCategory then SetCategory + == add + Rep := Record(var:Symbol, seg:Segment S) + equation(x,s) == [x, s] + variable b == b.var + segment b == b.seg + + if S has SetCategory then + + b1 = b2 == variable b1 = variable b2 and segment b1 = segment b2 + + coerce(b:%):OutputForm == + variable(b)::OutputForm = segment(b)::OutputForm + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain SET Set} +<>= +-- sets.spad.pamphlet Set.input +)spool Set.output +)set message test on +)set message auto off +)clear all +--S 1 of 20 +s := set [x**2-1, y**2-1, z**2-1] +--R +--R +--R 2 2 2 +--R (1) {x - 1,y - 1,z - 1} +--R Type: Set Polynomial Integer +--E 1 + +--S 2 of 20 +t := set [x**i - i+1 for i in 2..10 | prime? i] +--R +--R +--R 2 3 5 7 +--R (2) {x - 1,x - 2,x - 4,x - 6} +--R Type: Set Polynomial Integer +--E 2 + +--S 3 of 20 +i := intersect(s,t) +--R +--R +--R 2 +--R (3) {x - 1} +--R Type: Set Polynomial Integer +--E 3 + +--S 4 of 20 +u := union(s,t) +--R +--R +--R 2 3 5 7 2 2 +--R (4) {x - 1,x - 2,x - 4,x - 6,y - 1,z - 1} +--R Type: Set Polynomial Integer +--E 4 + +--S 5 of 20 +difference(s,t) +--R +--R +--R 2 2 +--R (5) {y - 1,z - 1} +--R Type: Set Polynomial Integer +--E 5 + +--S 6 of 20 +symmetricDifference(s,t) +--R +--R +--R 3 5 7 2 2 +--R (6) {x - 2,x - 4,x - 6,y - 1,z - 1} +--R Type: Set Polynomial Integer +--E 6 + +--S 7 of 20 +member?(y, s) +--R +--R +--R (7) false +--R Type: Boolean +--E 7 + +--S 8 of 20 +member?((y+1)*(y-1), s) +--R +--R +--R (8) true +--R Type: Boolean +--E 8 + +--S 9 of 20 +subset?(i, s) +--R +--R +--R (9) true +--R Type: Boolean +--E 9 + +--S 10 of 20 +subset?(u, s) +--R +--R +--R (10) false +--R Type: Boolean +--E 10 + +--S 11 of 20 +gs := set [g for i in 1..11 | primitive?(g := i::PF 11)] +--R +--R +--R (11) {2,6,7,8} +--R Type: Set PrimeField 11 +--E 11 + +--S 12 of 20 +complement gs +--R +--R +--R (12) {1,3,4,5,9,10,0} +--R Type: Set PrimeField 11 +--E 12 + +--S 13 of 20 +a := set [i**2 for i in 1..5] +--R +--R +--R (13) {1,4,9,16,25} +--R Type: Set PositiveInteger +--E 13 + +--S 14 of 20 +insert!(32, a) +--R +--R +--R (14) {1,4,9,16,25,32} +--R Type: Set PositiveInteger +--E 14 + +--S 15 of 20 +remove!(25, a) +--R +--R +--R (15) {1,4,9,16,32} +--R Type: Set PositiveInteger +--E 15 + +--S 16 of 20 +a +--R +--R +--R (16) {1,4,9,16,32} +--R Type: Set PositiveInteger +--E 16 + +--S 17 of 20 +b := b0 := set [i**2 for i in 1..5] +--R +--R +--R (17) {1,4,9,16,25} +--R Type: Set PositiveInteger +--E 17 + +--S 18 of 20 +b := union(b, {32}) +--R +--R +--R (18) {1,4,9,16,25,32} +--R Type: Set PositiveInteger +--E 18 + +--S 19 of 20 +b := difference(b, {25}) +--R +--R +--R (19) {1,4,9,16,32} +--R Type: Set PositiveInteger +--E 19 + +--S 20 of 20 +b0 +--R +--R +--R (20) {1,4,9,16,25} +--R Type: Set PositiveInteger +--E 20 +)spool +)lisp (bye) +@ +<>= +==================================================================== +Set examples +==================================================================== + +The Set domain allows one to represent explicit finite sets of values. +These are similar to lists, but duplicate elements are not allowed. + +Sets can be created by giving a fixed set of values ... + + s := set [x**2-1, y**2-1, z**2-1] + 2 2 2 + {x - 1,y - 1,z - 1} + Type: Set Polynomial Integer + +or by using a collect form, just as for lists. In either case, the +set is formed from a finite collection of values. + + t := set [x**i - i+1 for i in 2..10 | prime? i] + 2 3 5 7 + {x - 1,x - 2,x - 4,x - 6} + Type: Set Polynomial Integer + +The basic operations on sets are intersect, union, difference, and +symmetricDifference. + + i := intersect(s,t) + 2 + {x - 1} + Type: Set Polynomial Integer + + u := union(s,t) + 2 3 5 7 2 2 + {x - 1,x - 2,x - 4,x - 6,y - 1,z - 1} + Type: Set Polynomial Integer + +The set difference(s,t) contains those members of s which are not in t. + + difference(s,t) + 2 2 + {y - 1,z - 1} + Type: Set Polynomial Integer + +The set symmetricDifference(s,t) contains those elements which are +in s or t but not in both. + + symmetricDifference(s,t) + 3 5 7 2 2 + {x - 2,x - 4,x - 6,y - 1,z - 1} + Type: Set Polynomial Integer + +Set membership is tested using the member? operation. + + member?(y, s) + false + Type: Boolean + + member?((y+1)*(y-1), s) + true + Type: Boolean + +The subset? function determines whether one set is a subset of another. + + subset?(i, s) + true + Type: Boolean + + subset?(u, s) + false + Type: Boolean + +When the base type is finite, the absolute complement of a set is +defined. This finds the set of all multiplicative generators of +PrimeField 11---the integers mod 11. + + gs := set [g for i in 1..11 | primitive?(g := i::PF 11)] + {2,6,7,8} + Type: Set PrimeField 11 + +The following values are not generators. + + complement gs + {1,3,4,5,9,10,0} + Type: Set PrimeField 11 + +Often the members of a set are computed individually; in addition, +values can be inserted or removed from a set over the course of a +computation. + +There are two ways to do this: + + a := set [i**2 for i in 1..5] + {1,4,9,16,25} + Type: Set PositiveInteger + +One is to view a set as a data structure and to apply updating operations. + + insert!(32, a) + {1,4,9,16,25,32} + Type: Set PositiveInteger + + remove!(25, a) + {1,4,9,16,32} + Type: Set PositiveInteger + + a + {1,4,9,16,32} + Type: Set PositiveInteger + +The other way is to view a set as a mathematical entity and to +create new sets from old. + + b := b0 := set [i**2 for i in 1..5] + {1,4,9,16,25} + Type: Set PositiveInteger + + b := union(b, {32}) + {1,4,9,16,25,32} + Type: Set PositiveInteger + + b := difference(b, {25}) + {1,4,9,16,32} + Type: Set PositiveInteger + + b0 + {1,4,9,16,25} + Type: Set PositiveInteger + +See Also: +o )help List +o )show Set +o $AXIOM/doc/src/algebra/sets.spad.dvi + +@ +\pagehead{Set}{SET} +\pagepic{ps/v103set.ps}{SET}{1.00} +<>= +)abbrev domain SET Set +++ Author: Michael Monagan; revised by Richard Jenks +++ Date Created: August 87 through August 88 +++ Date Last Updated: May 1991 +++ Basic Operations: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ A set over a domain D models the usual mathematical notion of a finite set +++ of elements from D. +++ Sets are unordered collections of distinct elements +++ (that is, order and duplication does not matter). +++ The notation \spad{set [a,b,c]} can be used to create +++ a set and the usual operations such as union and intersection are available +++ to form new sets. +++ In our implementation, \Language{} maintains the entries in +++ sorted order. Specifically, the parts function returns the entries +++ as a list in ascending order and +++ the extract operation returns the maximum entry. +++ Given two sets s and t where \spad{#s = m} and \spad{#t = n}, +++ the complexity of +++ \spad{s = t} is \spad{O(min(n,m))} +++ \spad{s < t} is \spad{O(max(n,m))} +++ \spad{union(s,t)}, \spad{intersect(s,t)}, \spad{minus(s,t)}, \spad{symmetricDifference(s,t)} is \spad{O(max(n,m))} +++ \spad{member(x,t)} is \spad{O(n log n)} +++ \spad{insert(x,t)} and \spad{remove(x,t)} is \spad{O(n)} +Set(S:SetCategory): FiniteSetAggregate S == add + Rep := FlexibleArray(S) + # s == _#$Rep s + brace() == empty() + set() == empty() + empty() == empty()$Rep + copy s == copy(s)$Rep + parts s == parts(s)$Rep + inspect s == (empty? s => error "Empty set"; s(maxIndex s)) + + extract_! s == + x := inspect s + delete_!(s, maxIndex s) + x + + find(f, s) == find(f, s)$Rep + + map(f, s) == map_!(f,copy s) + + map_!(f,s) == + map_!(f,s)$Rep + removeDuplicates_! s + + reduce(f, s) == reduce(f, s)$Rep + + reduce(f, s, x) == reduce(f, s, x)$Rep + + reduce(f, s, x, y) == reduce(f, s, x, y)$Rep + + if S has ConvertibleTo InputForm then + convert(x:%):InputForm == + convert [convert("set"::Symbol)@InputForm, + convert(parts x)@InputForm] + + if S has OrderedSet then + s = t == s =$Rep t + max s == inspect s + min s == (empty? s => error "Empty set"; s(minIndex s)) + + construct l == + zero?(n := #l) => empty() + a := new(n, first l) + for i in minIndex(a).. for x in l repeat a.i := x + removeDuplicates_! sort_! a + + insert_!(x, s) == + n := inc maxIndex s + k := minIndex s + while k < n and x > s.k repeat k := inc k + k < n and s.k = x => s + insert_!(x, s, k) + + member?(x, s) == -- binary search + empty? s => false + t := maxIndex s + b := minIndex s + while b < t repeat + m := (b+t) quo 2 + if x > s.m then b := m+1 else t := m + x = s.t + + remove_!(x:S, s:%) == + n := inc maxIndex s + k := minIndex s + while k < n and x > s.k repeat k := inc k + k < n and x = s.k => delete_!(s, k) + s + + -- the set operations are implemented as variations of merging + intersect(s, t) == + m := maxIndex s + n := maxIndex t + i := minIndex s + j := minIndex t + r := empty() + while i <= m and j <= n repeat + s.i = t.j => (concat_!(r, s.i); i := i+1; j := j+1) + if s.i < t.j then i := i+1 else j := j+1 + r + + difference(s:%, t:%) == + m := maxIndex s + n := maxIndex t + i := minIndex s + j := minIndex t + r := empty() + while i <= m and j <= n repeat + s.i = t.j => (i := i+1; j := j+1) + s.i < t.j => (concat_!(r, s.i); i := i+1) + j := j+1 + while i <= m repeat (concat_!(r, s.i); i := i+1) + r + + symmetricDifference(s, t) == + m := maxIndex s + n := maxIndex t + i := minIndex s + j := minIndex t + r := empty() + while i <= m and j <= n repeat + s.i < t.j => (concat_!(r, s.i); i := i+1) + s.i > t.j => (concat_!(r, t.j); j := j+1) + i := i+1; j := j+1 + while i <= m repeat (concat_!(r, s.i); i := i+1) + while j <= n repeat (concat_!(r, t.j); j := j+1) + r + + subset?(s, t) == + m := maxIndex s + n := maxIndex t + m > n => false + i := minIndex s + j := minIndex t + while i <= m and j <= n repeat + s.i = t.j => (i := i+1; j := j+1) + s.i > t.j => j := j+1 + return false + i > m + + union(s:%, t:%) == + m := maxIndex s + n := maxIndex t + i := minIndex s + j := minIndex t + r := empty() + while i <= m and j <= n repeat + s.i = t.j => (concat_!(r, s.i); i := i+1; j := j+1) + s.i < t.j => (concat_!(r, s.i); i := i+1) + (concat_!(r, t.j); j := j+1) + while i <= m repeat (concat_!(r, s.i); i := i+1) + while j <= n repeat (concat_!(r, t.j); j := j+1) + r + + else + insert_!(x, s) == + for k in minIndex s .. maxIndex s repeat + s.k = x => return s + insert_!(x, s, inc maxIndex s) + + remove_!(x:S, s:%) == + n := inc maxIndex s + k := minIndex s + while k < n repeat + x = s.k => return delete_!(s, k) + k := inc k + s + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{domain SETMN SetOfMIntegersInOneToN} \pagehead{SetOfMIntegersInOneToN}{SETMN} \pagepic{ps/v103setofmintegersinoneton.ps}{SETMN}{1.00} @@ -59276,6 +62842,99 @@ SequentialDifferentialVariable(S:OrderedSet):DifferentialVariableCategory(S) @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain SEX SExpression} +\pagehead{SExpression}{SEX} +\pagepic{ps/v103sexpression.ps}{SEX}{1.00} +See also:\\ +\refto{SExpressionOf}{SEXOF} +<>= +)abbrev domain SEX SExpression +++ Domain for the standard Lisp values +++ Author: S.M.Watt +++ Date Created: July 1987 +++ Date Last Modified: 23 May 1991 +++ Description: +++ This domain allows the manipulation of the usual Lisp values; +SExpression() + == SExpressionOf(String, Symbol, Integer, DoubleFloat, OutputForm) + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain SEXOF SExpressionOf} +\pagehead{SExpressionOf}{SEXOF} +\pagepic{ps/v103sexpressionof.ps}{SEXOF}{1.00} +See also:\\ +\refto{SExpression}{SEX} +<>= +)abbrev domain SEXOF SExpressionOf +++ Domain for Lisp values over arbitrary atomic types +++ Author: S.M.Watt +++ Date Created: July 1987 +++ Date Last Modified: 23 May 1991 +++ Description: +++ This domain allows the manipulation of Lisp values over +++ arbitrary atomic types. +-- Allows the names of the atomic types to be chosen. +-- *** Warning *** Although the parameters are declared only to be Sets, +-- *** Warning *** they must have the appropriate representations. +SExpressionOf(Str, Sym, Int, Flt, Expr): Decl == Body where + Str, Sym, Int, Flt, Expr: SetCategory + + Decl ==> SExpressionCategory(Str, Sym, Int, Flt, Expr) + + Body ==> add + Rep := Expr + + dotex:OutputForm := INTERN(".")$Lisp + + coerce(b:%):OutputForm == + null? b => paren empty() + atom? b => coerce(b)$Rep + r := b + while not atom? r repeat r := cdr r + l1 := [b1::OutputForm for b1 in (l := destruct b)] + not null? r => + paren blankSeparate concat_!(l1, [dotex, r::OutputForm]) + #l = 2 and (first(l1) = QUOTE)@Boolean => quote first rest l1 + paren blankSeparate l1 + + b1 = b2 == EQUAL(b1,b2)$Lisp + eq(b1, b2) == EQ(b1,b2)$Lisp + + null? b == NULL(b)$Lisp + atom? b == ATOM(b)$Lisp + pair? b == PAIRP(b)$Lisp + + list? b == PAIRP(b)$Lisp or NULL(b)$Lisp + string? b == STRINGP(b)$Lisp + symbol? b == IDENTP(b)$Lisp + integer? b == INTP(b)$Lisp + float? b == RNUMP(b)$Lisp + + destruct b == (list? b => b pretend List %; error "Non-list") + string b == (STRINGP(b)$Lisp=> b pretend Str;error "Non-string") + symbol b == (IDENTP(b)$Lisp => b pretend Sym;error "Non-symbol") + float b == (RNUMP(b)$Lisp => b pretend Flt;error "Non-float") + integer b == (INTP(b)$Lisp => b pretend Int;error "Non-integer") + expr b == b pretend Expr + + convert(l: List %) == l pretend % + convert(st: Str) == st pretend % + convert(sy: Sym) == sy pretend % + convert(n: Int) == n pretend % + convert(f: Flt) == f pretend % + convert(e: Expr) == e pretend % + + car b == CAR(b)$Lisp + cdr b == CDR(b)$Lisp + # b == LENGTH(b)$Lisp + elt(b:%, i:Integer) == destruct(b).i + elt(b:%, li:List Integer) == + for i in li repeat b := destruct(b).i + b + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{domain SAE SimpleAlgebraicExtension} <>= "SimpleAlgebraicExtension(a:FRAC(UPOLYC(UFD)),b:UPOLYC(FRAC(UPOLYC(UFD))))" @@ -59545,421 +63204,427 @@ SimpleFortranProgram(R,FS): Exports == Implementation where @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\section{domain SAOS SingletonAsOrderedSet} -<>= -"SAOS" -> "ORDSET" -"SingletonAsOrderedSet()" -> "OrderedSet()" -@ -\pagehead{SingletonAsOrderedSet}{SAOS} -\pagepic{ps/v103singletonasorderedset.ps}{SAOS}{1.00} -<>= -)abbrev domain SAOS SingletonAsOrderedSet -++ This trivial domain lets us build Univariate Polynomials -++ in an anonymous variable -SingletonAsOrderedSet(): OrderedSet with - create:() -> % - convert:% -> Symbol - == add - create() == "?" pretend % - a>= +-- si.spad.pamphlet SingleInteger.input +)spool SingleInteger.output +)set message test on +)set message auto off +)clear all +--S 1 of 11 +min()$SingleInteger +--R +--R +--R (1) - 2147483648 +--R Type: SingleInteger +--E 1 +--S 2 of 11 +max()$SingleInteger +--R +--R +--R (2) 2147483647 +--R Type: SingleInteger +--E 2 + +--S 3 of 11 +a := 1234 :: SingleInteger +--R +--R +--R (3) 1234 +--R Type: SingleInteger +--E 3 + +--S 4 of 11 +b := 124$SingleInteger +--R +--R +--R (4) 124 +--R Type: SingleInteger +--E 4 + +--S 5 of 11 +gcd(a,b) +--R +--R +--R (5) 2 +--R Type: SingleInteger +--E 5 + +--S 6 of 11 +lcm(a,b) +--R +--R +--R (6) 76508 +--R Type: SingleInteger +--E 6 + +--S 7 of 11 +mulmod(5,6,13)$SingleInteger +--R +--R +--R (7) 4 +--R Type: SingleInteger +--E 7 + +--S 8 of 11 +positiveRemainder(37,13)$SingleInteger +--R +--R +--R (8) 11 +--R Type: SingleInteger +--E 8 + +--S 9 of 11 +And(3,4)$SingleInteger +--R +--R +--R (9) 0 +--R Type: SingleInteger +--E 9 + +--S 10 of 11 +shift(1,4)$SingleInteger +--R +--R +--R (10) 16 +--R Type: SingleInteger +--E 10 + +--S 11 of 11 +shift(31,-1)$SingleInteger +--R +--R +--R (11) 15 +--R Type: SingleInteger +--E 11 +)spool +)lisp (bye) @ -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\section{domain SUP SparseUnivariatePolynomial} -\pagehead{SparseUnivariatePolynomial}{SUP} -\pagepic{ps/v103sparseunivariatepolynomial.ps}{SUP}{1.00} -See also:\\ -\refto{FreeModule}{FM} -\refto{PolynomialRing}{PR} -\refto{UnivariatePolynomial}{UP} -<>= -)abbrev domain SUP SparseUnivariatePolynomial -++ Author: Dave Barton, Barry Trager -++ Date Created: -++ Date Last Updated: -++ Basic Functions: Ring, monomial, coefficient, reductum, differentiate, -++ elt, map, resultant, discriminant -++ Related Constructors: UnivariatePolynomial, Polynomial -++ Also See: -++ AMS Classifications: -++ Keywords: -++ References: -++ Description: -++ This domain represents univariate polynomials over arbitrary -++ (not necessarily commutative) coefficient rings. The variable is -++ unspecified so that the variable displays as \spad{?} on output. -++ If it is necessary to specify the variable name, use type \spadtype{UnivariatePolynomial}. -++ The representation is sparse -++ in the sense that only non-zero terms are represented. -++ Note: if the coefficient ring is a field, this domain forms a euclidean domain. +<>= +==================================================================== +SingleInteger examples +==================================================================== -SparseUnivariatePolynomial(R:Ring): UnivariatePolynomialCategory(R) with - outputForm : (%,OutputForm) -> OutputForm - ++ outputForm(p,var) converts the SparseUnivariatePolynomial p to - ++ an output form (see \spadtype{OutputForm}) printed as a polynomial in the - ++ output form variable. - fmecg: (%,NonNegativeInteger,R,%) -> % - ++ fmecg(p1,e,r,p2) finds X : p1 - r * X**e * p2 - == PolynomialRing(R,NonNegativeInteger) - add - --representations - Term := Record(k:NonNegativeInteger,c:R) - Rep := List Term - p:% - n:NonNegativeInteger - np: PositiveInteger - FP ==> SparseUnivariatePolynomial % - pp,qq: FP - lpp:List FP +The SingleInteger domain is intended to provide support in Axiom +for machine integer arithmetic. It is generally much faster than +(bignum) Integer arithmetic but suffers from a limited range of +values. Since Axiom can be implemented on top of various dialects of +Lisp, the actual representation of small integers may not correspond +exactly to the host machines integer representation. - -- for karatsuba - kBound: NonNegativeInteger := 63 - upmp := UnivariatePolynomialMultiplicationPackage(R,%) +You can discover the minimum and maximum values in your implementation +by using min and max. + min()$SingleInteger + - 2147483648 + Type: SingleInteger - if R has FieldOfPrimeCharacteristic then - p ** np == p ** (np pretend NonNegativeInteger) - p ^ np == p ** (np pretend NonNegativeInteger) - p ^ n == p ** n - p ** n == - null p => 0 - zero? n => 1 --- one? n => p - (n = 1) => p - empty? p.rest => - zero?(cc:=p.first.c ** n) => 0 - [[n * p.first.k, cc]] - -- not worth doing special trick if characteristic is too small - if characteristic()$R < 3 then return expt(p,n pretend PositiveInteger)$RepeatedSquaring(%) - y:%:=1 - -- break up exponent in qn * characteristic + rn - -- exponentiating by the characteristic is fast - rec := divide(n, characteristic()$R) - qn:= rec.quotient - rn:= rec.remainder - repeat - if rn = 1 then y := y * p - if rn > 1 then y:= y * binomThmExpt([p.first], p.rest, rn) - zero? qn => return y - -- raise to the characteristic power - p:= [[t.k * characteristic()$R , primeFrobenius(t.c)$R ]$Term for t in p] - rec := divide(qn, characteristic()$R) - qn:= rec.quotient - rn:= rec.remainder - y + max()$SingleInteger + 2147483647 + Type: SingleInteger +To avoid confusion with Integer, which is the default type for +integers, you usually need to work with declared variables. + a := 1234 :: SingleInteger + 1234 + Type: SingleInteger - zero?(p): Boolean == empty?(p) --- one?(p):Boolean == not empty? p and (empty? rest p and zero? first(p).k and one? first(p).c) - one?(p):Boolean == not empty? p and (empty? rest p and zero? first(p).k and (first(p).c = 1)) - ground?(p): Boolean == empty? p or (empty? rest p and zero? first(p).k) - multiplyExponents(p,n) == [ [u.k*n,u.c] for u in p] - divideExponents(p,n) == - null p => p - m:= (p.first.k :: Integer exquo n::Integer) - m case "failed" => "failed" - u:= divideExponents(p.rest,n) - u case "failed" => "failed" - [[m::Integer::NonNegativeInteger,p.first.c],:u] - karatsubaDivide(p, n) == - zero? n => [p, 0] - lowp: Rep := p - highp: Rep := [] - repeat - if empty? lowp then break - t := first lowp - if t.k < n then break - lowp := rest lowp - highp := cons([subtractIfCan(t.k,n)::NonNegativeInteger,t.c]$Term,highp) - [ reverse highp, lowp] - shiftRight(p, n) == - [[subtractIfCan(t.k,n)::NonNegativeInteger,t.c]$Term for t in p] - shiftLeft(p, n) == - [[t.k + n,t.c]$Term for t in p] - pomopo!(p1,r,e,p2) == - rout:%:= [] - for tm in p2 repeat - e2:= e + tm.k - c2:= r * tm.c - c2 = 0 => "next term" - while not null p1 and p1.first.k > e2 repeat - (rout:=[p1.first,:rout]; p1:=p1.rest) --use PUSH and POP? - null p1 or p1.first.k < e2 => rout:=[[e2,c2],:rout] - if (u:=p1.first.c + c2) ^= 0 then rout:=[[e2, u],:rout] - p1:=p1.rest - NRECONC(rout,p1)$Lisp +or use package calling --- implementation using karatsuba algorithm conditionally --- --- p1 * p2 == --- xx := p1::Rep --- empty? xx => p1 --- yy := p2::Rep --- empty? yy => p2 --- zero? first(xx).k => first(xx).c * p2 --- zero? first(yy).k => p1 * first(yy).c --- (first(xx).k > kBound) and (first(yy).k > kBound) and (#xx > kBound) and (#yy > kBound) => --- karatsubaOnce(p1,p2)$upmp --- xx := reverse xx --- res : Rep := empty() --- for tx in xx repeat res:= rep pomopo!( res,tx.c,tx.k,p2) --- res + b := 124$SingleInteger + 124 + Type: SingleInteger +You can add, multiply and subtract SingleInteger objects, and ask for +the greatest common divisor (gcd). - univariate(p:%) == p pretend SparseUnivariatePolynomial(R) - multivariate(sup:SparseUnivariatePolynomial(R),v:SingletonAsOrderedSet) == - sup pretend % - univariate(p:%,v:SingletonAsOrderedSet) == - zero? p => 0 - monomial(leadingCoefficient(p)::%,degree p) + - univariate(reductum p,v) - multivariate(supp:SparseUnivariatePolynomial(%),v:SingletonAsOrderedSet) == - zero? supp => 0 - lc:=leadingCoefficient supp - degree lc > 0 => error "bad form polynomial" - monomial(leadingCoefficient lc,degree supp) + - multivariate(reductum supp,v) - if R has FiniteFieldCategory and R has PolynomialFactorizationExplicit then - RXY ==> SparseUnivariatePolynomial SparseUnivariatePolynomial R - squareFreePolynomial pp == - squareFree(pp)$UnivariatePolynomialSquareFree(%,FP) - factorPolynomial pp == - (generalTwoFactor(pp pretend RXY)$TwoFactorize(R)) - pretend Factored SparseUnivariatePolynomial % - factorSquareFreePolynomial pp == - (generalTwoFactor(pp pretend RXY)$TwoFactorize(R)) - pretend Factored SparseUnivariatePolynomial % - gcdPolynomial(pp,qq) == gcd(pp,qq)$FP - factor p == factor(p)$DistinctDegreeFactorize(R,%) - solveLinearPolynomialEquation(lpp,pp) == - solveLinearPolynomialEquation(lpp, pp)$FiniteFieldSolveLinearPolynomialEquation(R,%,FP) - else if R has PolynomialFactorizationExplicit then - import PolynomialFactorizationByRecursionUnivariate(R,%) - solveLinearPolynomialEquation(lpp,pp)== - solveLinearPolynomialEquationByRecursion(lpp,pp) - factorPolynomial(pp) == - factorByRecursion(pp) - factorSquareFreePolynomial(pp) == - factorSquareFreeByRecursion(pp) + gcd(a,b) + 2 + Type: SingleInteger - if R has IntegralDomain then - if R has approximate then - p1 exquo p2 == - null p2 => error "Division by 0" - p2 = 1 => p1 - p1=p2 => 1 - --(p1.lastElt.c exquo p2.lastElt.c) case "failed" => "failed" - rout:= []@List(Term) - while not null p1 repeat - (a:= p1.first.c exquo p2.first.c) - a case "failed" => return "failed" - ee:= subtractIfCan(p1.first.k, p2.first.k) - ee case "failed" => return "failed" - p1:= fmecg(p1.rest, ee, a, p2.rest) - rout:= [[ee,a], :rout] - null p1 => reverse(rout)::% -- nreverse? - "failed" - else -- R not approximate - p1 exquo p2 == - null p2 => error "Division by 0" - p2 = 1 => p1 - --(p1.lastElt.c exquo p2.lastElt.c) case "failed" => "failed" - rout:= []@List(Term) - while not null p1 repeat - (a:= p1.first.c exquo p2.first.c) - a case "failed" => return "failed" - ee:= subtractIfCan(p1.first.k, p2.first.k) - ee case "failed" => return "failed" - p1:= fmecg(p1.rest, ee, a, p2.rest) - rout:= [[ee,a], :rout] - null p1 => reverse(rout)::% -- nreverse? - "failed" - fmecg(p1,e,r,p2) == -- p1 - r * X**e * p2 - rout:%:= [] - r:= - r - for tm in p2 repeat - e2:= e + tm.k - c2:= r * tm.c - c2 = 0 => "next term" - while not null p1 and p1.first.k > e2 repeat - (rout:=[p1.first,:rout]; p1:=p1.rest) --use PUSH and POP? - null p1 or p1.first.k < e2 => rout:=[[e2,c2],:rout] - if (u:=p1.first.c + c2) ^= 0 then rout:=[[e2, u],:rout] - p1:=p1.rest - NRECONC(rout,p1)$Lisp - pseudoRemainder(p1,p2) == - null p2 => error "PseudoDivision by Zero" - null p1 => 0 - co:=p2.first.c; - e:=p2.first.k; - p2:=p2.rest; - e1:=max(p1.first.k:Integer-e+1,0):NonNegativeInteger - while not null p1 repeat - if (u:=subtractIfCan(p1.first.k,e)) case "failed" then leave - p1:=fmecg(co * p1.rest, u, p1.first.c, p2) - e1:= (e1 - 1):NonNegativeInteger - e1 = 0 => p1 - co ** e1 * p1 - toutput(t1:Term,v:OutputForm):OutputForm == - t1.k = 0 => t1.c :: OutputForm - if t1.k = 1 - then mon:= v - else mon := v ** t1.k::OutputForm - t1.c = 1 => mon - t1.c = -1 and - ((t1.c :: OutputForm) = (-1$Integer)::OutputForm)@Boolean => - mon - t1.c::OutputForm * mon - outputForm(p:%,v:OutputForm) == - l: List(OutputForm) - l:=[toutput(t,v) for t in p] - null l => (0$Integer)::OutputForm -- else FreeModule 0 problems - reduce("+",l) +The least common multiple (lcm) is also available. - coerce(p:%):OutputForm == outputForm(p, "?"::OutputForm) - elt(p:%,val:R) == - null p => 0$R - co:=p.first.c - n:=p.first.k - for tm in p.rest repeat - co:= co * val ** (n - (n:=tm.k)):NonNegativeInteger + tm.c - n = 0 => co - co * val ** n - elt(p:%,val:%) == - null p => 0$% - coef:% := p.first.c :: % - n:=p.first.k - for tm in p.rest repeat - coef:= coef * val ** (n-(n:=tm.k)):NonNegativeInteger+(tm.c::%) - n = 0 => coef - coef * val ** n + lcm(a,b) + 76508 + Type: SingleInteger - monicDivide(p1:%,p2:%) == - null p2 => error "monicDivide: division by 0" - leadingCoefficient p2 ^= 1 => error "Divisor Not Monic" - p2 = 1 => [p1,0] - null p1 => [0,0] - degree p1 < (n:=degree p2) => [0,p1] - rout:Rep := [] - p2 := p2.rest - while not null p1 repeat - (u:=subtractIfCan(p1.first.k, n)) case "failed" => leave - rout:=[[u, p1.first.c], :rout] - p1:=fmecg(p1.rest, rout.first.k, rout.first.c, p2) - [reverse_!(rout),p1] +Operations mulmod, addmod, submod, and invmod are similar - they provide +arithmetic modulo a given small integer. +Here is 5 * 6 mod 13. - if R has IntegralDomain then - discriminant(p) == discriminant(p)$PseudoRemainderSequence(R,%) --- discriminant(p) == --- null p or zero?(p.first.k) => error "cannot take discriminant of constants" --- dp:=differentiate p --- corr:= p.first.c ** ((degree p - 1 - degree dp)::NonNegativeInteger) --- (-1)**((p.first.k*(p.first.k-1)) quo 2):NonNegativeInteger --- * (corr * resultant(p,dp) exquo p.first.c)::R + mulmod(5,6,13)$SingleInteger + 4 + Type: SingleInteger - subResultantGcd(p1,p2) == subResultantGcd(p1,p2)$PseudoRemainderSequence(R,%) --- subResultantGcd(p1,p2) == --args # 0, non-coef, prim, ans not prim --- --see algorithm 1 (p. 4) of Brown's latest (unpublished) paper --- if p1.first.k < p2.first.k then (p1,p2):=(p2,p1) --- p:=pseudoRemainder(p1,p2) --- co:=1$R; --- e:= (p1.first.k - p2.first.k):NonNegativeInteger --- while not null p and p.first.k ^= 0 repeat --- p1:=p2; p2:=p; p:=pseudoRemainder(p1,p2) --- null p or p.first.k = 0 => "enuf" --- co:=(p1.first.c ** e exquo co ** max(0, (e-1))::NonNegativeInteger)::R --- e:= (p1.first.k - p2.first.k):NonNegativeInteger; c1:=co**e --- p:=[[tm.k,((tm.c exquo p1.first.c)::R exquo c1)::R] for tm in p] --- if null p then p2 else 1$% +To reduce a small integer modulo a prime, use positiveRemainder. - resultant(p1,p2) == resultant(p1,p2)$PseudoRemainderSequence(R,%) --- resultant(p1,p2) == --SubResultant PRS Algorithm --- null p1 or null p2 => 0$R --- 0 = degree(p1) => ((first p1).c)**degree(p2) --- 0 = degree(p2) => ((first p2).c)**degree(p1) --- if p1.first.k < p2.first.k then --- (if odd?(p1.first.k) then p1:=-p1; (p1,p2):=(p2,p1)) --- p:=pseudoRemainder(p1,p2) --- co:=1$R; e:=(p1.first.k-p2.first.k):NonNegativeInteger --- while not null p repeat --- if not odd?(e) then p:=-p --- p1:=p2; p2:=p; p:=pseudoRemainder(p1,p2) --- co:=(p1.first.c ** e exquo co ** max(e:Integer-1,0):NonNegativeInteger)::R --- e:= (p1.first.k - p2.first.k):NonNegativeInteger; c1:=co**e --- p:=(p exquo ((leadingCoefficient p1) * c1))::% --- degree p2 > 0 => 0$R --- (p2.first.c**e exquo co**((e-1)::NonNegativeInteger))::R - if R has GcdDomain then - content(p) == if null p then 0$R else "gcd"/[tm.c for tm in p] - --make CONTENT more efficient? + positiveRemainder(37,13)$SingleInteger + 11 + Type: SingleInteger - primitivePart(p) == - null p => p - ct :=content(p) - unitCanonical((p exquo ct)::%) - -- exquo present since % is now an IntegralDomain +Operations And, Or, xor, and Not provide bit level operations on small +integers. - gcd(p1,p2) == - gcdPolynomial(p1 pretend SparseUnivariatePolynomial R, - p2 pretend SparseUnivariatePolynomial R) pretend % + And(3,4)$SingleInteger + 0 + Type: SingleInteger - if R has Field then - divide( p1, p2) == - zero? p2 => error "Division by 0" --- one? p2 => [p1,0] - (p2 = 1) => [p1,0] - ct:=inv(p2.first.c) - n:=p2.first.k - p2:=p2.rest - rout:=empty()$List(Term) - while p1 ^= 0 repeat - (u:=subtractIfCan(p1.first.k, n)) case "failed" => leave - rout:=[[u, ct * p1.first.c], :rout] - p1:=fmecg(p1.rest, rout.first.k, rout.first.c, p2) - [reverse_!(rout),p1] +Use shift(int,numToShift) to shift bits, where i is shifted left if +numToShift is positive, right if negative. - p / co == inv(co) * p + shift(1,4)$SingleInteger + 16 + Type: SingleInteger + + shift(31,-1)$SingleInteger + 15 + Type: SingleInteger + +Many other operations are available for small integers, including many +of those provided for Integer. + +See Also: +o )help Integer +o )show SingleInteger +o $AXIOM/doc/src/algebra/si.spad.dvi + +@ +<>= +"SINT" -> "INS" +"SingleInteger()" -> "IntegerNumberSystem()" +"SINT" -> "LOGIC" +"SingleInteger()" -> "Logic()" +"SINT" -> "OM" +"SingleInteger()" -> "OpenMath()" +@ +\pagehead{SingleInteger}{SINT} +\pagepic{ps/v103singleinteger.ps}{SINT}{1.00} +<>= +)abbrev domain SINT SingleInteger + +-- following patch needed to deal with *:(I,%) -> % +-- affects behavior of SourceLevelSubset +--)bo $noSubsets := true +-- No longer - JHD !! still needed 5/3/91 BMT + +++ Author: Michael Monagan +++ Date Created: +++ January 1988 +++ Change History: +++ Basic Operations: max, min, +++ not, and, or, xor, Not, And, Or +++ Related Constructors: +++ Keywords: single integer +++ Description: SingleInteger is intended to support machine integer +++ arithmetic. + +-- MAXINT, BASE (machine integer constants) +-- MODULUS, MULTIPLIER (random number generator constants) + + +-- Lisp dependencies +-- EQ, ABSVAL, TIMES, INTEGER-LENGTH, HASHEQ, REMAINDER +-- QSLESSP, QSGREATERP, QSADD1, QSSUB1, QSMINUS, QSPLUS, QSDIFFERENCE +-- QSTIMES, QSREMAINDER, QSODDP, QSZEROP, QSMAX, QSMIN, QSNOT, QSAND +-- QSOR, QSXOR, QSLEFTSHIFT, QSADDMOD, QSDIFMOD, QSMULTMOD + + +SingleInteger(): Join(IntegerNumberSystem,Logic,OpenMath) with + canonical + ++ \spad{canonical} means that mathematical equality is + ++ implied by data structure equality. + canonicalsClosed + ++ \spad{canonicalClosed} means two positives multiply to + ++ give positive. + noetherian + ++ \spad{noetherian} all ideals are finitely generated + ++ (in fact principal). + + max : () -> % + ++ max() returns the largest single integer. + min : () -> % + ++ min() returns the smallest single integer. + + -- bit operations + "not": % -> % + ++ not(n) returns the bit-by-bit logical {\em not} of the single integer n. + "~" : % -> % + ++ ~ n returns the bit-by-bit logical {\em not } of the single integer n. + "/\": (%, %) -> % + ++ n /\ m returns the bit-by-bit logical {\em and} of + ++ the single integers n and m. + "\/" : (%, %) -> % + ++ n \/ m returns the bit-by-bit logical {\em or} of + ++ the single integers n and m. + "xor": (%, %) -> % + ++ xor(n,m) returns the bit-by-bit logical {\em xor} of + ++ the single integers n and m. + Not : % -> % + ++ Not(n) returns the bit-by-bit logical {\em not} of the single integer n. + And : (%,%) -> % + ++ And(n,m) returns the bit-by-bit logical {\em and} of + ++ the single integers n and m. + Or : (%,%) -> % + ++ Or(n,m) returns the bit-by-bit logical {\em or} of + ++ the single integers n and m. + + == add + + seed : % := 1$Lisp -- for random() + MAXINT ==> MOST_-POSITIVE_-FIXNUM$Lisp + MININT ==> MOST_-NEGATIVE_-FIXNUM$Lisp + BASE ==> 67108864$Lisp -- 2**26 + MULTIPLIER ==> 314159269$Lisp -- from Knuth's table + MODULUS ==> 2147483647$Lisp -- 2**31-1 + + writeOMSingleInt(dev: OpenMathDevice, x: %): Void == + if x < 0 then + OMputApp(dev) + OMputSymbol(dev, "arith1", "unary_minus") + OMputInteger(dev, convert(-x)) + OMputEndApp(dev) + else + OMputInteger(dev, convert(x)) + + OMwrite(x: %): String == + s: String := "" + sp := OM_-STRINGTOSTRINGPTR(s)$Lisp + dev: OpenMathDevice := OMopenString(sp pretend String, OMencodingXML) + OMputObject(dev) + writeOMSingleInt(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) + writeOMSingleInt(dev, x) + if wholeObj then + OMputEndObject(dev) + OMclose(dev) + s := OM_-STRINGPTRTOSTRING(sp)$Lisp pretend String + s + + OMwrite(dev: OpenMathDevice, x: %): Void == + OMputObject(dev) + writeOMSingleInt(dev, x) + OMputEndObject(dev) + + OMwrite(dev: OpenMathDevice, x: %, wholeObj: Boolean): Void == + if wholeObj then + OMputObject(dev) + writeOMSingleInt(dev, x) + if wholeObj then + OMputEndObject(dev) + + reducedSystem m == m pretend Matrix(Integer) + coerce(x):OutputForm == (convert(x)@Integer)::OutputForm + convert(x:%):Integer == x pretend Integer + i:Integer * y:% == i::% * y + 0 == 0$Lisp + 1 == 1$Lisp + base() == 2$Lisp + max() == MAXINT + min() == MININT + x = y == EQL(x,y)$Lisp + _~ x == LOGNOT(x)$Lisp + not(x) == LOGNOT(x)$Lisp + _/_\(x,y) == LOGAND(x,y)$Lisp + _\_/(x,y) == LOGIOR(x,y)$Lisp + Not(x) == LOGNOT(x)$Lisp + And(x,y) == LOGAND(x,y)$Lisp + Or(x,y) == LOGIOR(x,y)$Lisp + xor(x,y) == LOGXOR(x,y)$Lisp + x < y == QSLESSP(x,y)$Lisp + inc x == QSADD1(x)$Lisp + dec x == QSSUB1(x)$Lisp + - x == QSMINUS(x)$Lisp + x + y == QSPLUS(x,y)$Lisp + x:% - y:% == QSDIFFERENCE(x,y)$Lisp + x:% * y:% == QSTIMES(x,y)$Lisp + x:% ** n:NonNegativeInteger == ((EXPT(x, n)$Lisp) pretend Integer)::% + x quo y == QSQUOTIENT(x,y)$Lisp + x rem y == QSREMAINDER(x,y)$Lisp + divide(x, y) == CONS(QSQUOTIENT(x,y)$Lisp,QSREMAINDER(x,y)$Lisp)$Lisp + gcd(x,y) == GCD(x,y)$Lisp + abs(x) == QSABSVAL(x)$Lisp + odd?(x) == QSODDP(x)$Lisp + zero?(x) == QSZEROP(x)$Lisp +-- one?(x) == ONEP(x)$Lisp + one?(x) == x = 1 + max(x,y) == QSMAX(x,y)$Lisp + min(x,y) == QSMIN(x,y)$Lisp + hash(x) == HASHEQ(x)$Lisp + length(x) == INTEGER_-LENGTH(x)$Lisp + shift(x,n) == QSLEFTSHIFT(x,n)$Lisp + mulmod(a,b,p) == QSMULTMOD(a,b,p)$Lisp + addmod(a,b,p) == QSADDMOD(a,b,p)$Lisp + submod(a,b,p) == QSDIFMOD(a,b,p)$Lisp + negative?(x) == QSMINUSP$Lisp x + + + reducedSystem(m, v) == + [m pretend Matrix(Integer), v pretend Vector(Integer)] + + positiveRemainder(x,n) == + r := QSREMAINDER(x,n)$Lisp + QSMINUSP(r)$Lisp => + QSMINUSP(n)$Lisp => QSDIFFERENCE(x, n)$Lisp + QSPLUS(r, n)$Lisp + r + + coerce(x:Integer):% == + (x <= max pretend Integer) and (x >= min pretend Integer) => + x pretend % + error "integer too large to represent in a machine word" + + random() == + seed := REMAINDER(TIMES(MULTIPLIER,seed)$Lisp,MODULUS)$Lisp + REMAINDER(seed,BASE)$Lisp + + random(n) == RANDOM(n)$Lisp + + UCA ==> Record(unit:%,canonical:%,associate:%) + unitNormal x == + x < 0 => [-1,-x,-1]$UCA + [1,x,1]$UCA + +)bo $noSubsets := false @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -\section{domain ORESUP SparseUnivariateSkewPolynomial} -\pagehead{SparseUnivariateSkewPolynomial}{ORESUP} -\pagepic{ps/v103sparseunivariateskewpolynomial.ps}{ORESUP}{1.00} -See also:\\ -\refto{Automorphism}{AUTOMOR} -\refto{UnivariateSkewPolynomial}{OREUP} -<>= -)abbrev domain ORESUP SparseUnivariateSkewPolynomial -++ Author: Manuel Bronstein -++ Date Created: 19 October 1993 -++ Date Last Updated: 1 February 1994 -++ Description: -++ This is the domain of sparse univariate skew polynomials over an Ore -++ coefficient field. -++ The multiplication is given by \spad{x a = \sigma(a) x + \delta a}. -SparseUnivariateSkewPolynomial(R:Ring, sigma:Automorphism R, delta: R -> R): - UnivariateSkewPolynomialCategory R with - outputForm: (%, OutputForm) -> OutputForm - ++ outputForm(p, x) returns the output form of p using x for the - ++ otherwise anonymous variable. - == SparseUnivariatePolynomial R add - import UnivariateSkewPolynomialCategoryOps(R, %) - - x:% * y:% == times(x, y, sigma, delta) - apply(p, c, r) == apply(p, c, r, sigma, delta) - - if R has IntegralDomain then - monicLeftDivide(a, b) == monicLeftDivide(a, b, sigma) - monicRightDivide(a, b) == monicRightDivide(a, b, sigma) - - if R has Field then - leftDivide(a, b) == leftDivide(a, b, sigma) - rightDivide(a, b) == rightDivide(a, b, sigma) +\section{domain SAOS SingletonAsOrderedSet} +<>= +"SAOS" -> "ORDSET" +"SingletonAsOrderedSet()" -> "OrderedSet()" +@ +\pagehead{SingletonAsOrderedSet}{SAOS} +\pagepic{ps/v103singletonasorderedset.ps}{SAOS}{1.00} +<>= +)abbrev domain SAOS SingletonAsOrderedSet +++ This trivial domain lets us build Univariate Polynomials +++ in an anonymous variable +SingletonAsOrderedSet(): OrderedSet with + create:() -> % + convert:% -> Symbol + == add + create() == "?" pretend % + a>= +)abbrev domain SULS SparseUnivariateLaurentSeries +++ Author: Clifton J. Williamson +++ Date Created: 11 November 1994 +++ Date Last Updated: 10 March 1995 +++ Basic Operations: +++ Related Domains: InnerSparseUnivariatePowerSeries, +++ SparseUnivariateTaylorSeries, SparseUnivariatePuiseuxSeries +++ Also See: +++ AMS Classifications: +++ Keywords: sparse, series +++ Examples: +++ References: +++ Description: Sparse Laurent series in one variable +++ \spadtype{SparseUnivariateLaurentSeries} is a domain representing Laurent +++ series in one variable with coefficients in an arbitrary ring. The +++ parameters of the type specify the coefficient ring, the power series +++ variable, and the center of the power series expansion. For example, +++ \spad{SparseUnivariateLaurentSeries(Integer,x,3)} represents Laurent +++ series in \spad{(x - 3)} with integer coefficients. +SparseUnivariateLaurentSeries(Coef,var,cen): Exports == Implementation where + Coef : Ring + var : Symbol + cen : Coef + I ==> Integer + NNI ==> NonNegativeInteger + OUT ==> OutputForm + P ==> Polynomial Coef + RF ==> Fraction Polynomial Coef + RN ==> Fraction Integer + S ==> String + SUTS ==> SparseUnivariateTaylorSeries(Coef,var,cen) + EFULS ==> ElementaryFunctionsUnivariateLaurentSeries(Coef,SUTS,%) + + Exports ==> UnivariateLaurentSeriesConstructorCategory(Coef,SUTS) with + coerce: Variable(var) -> % + ++ \spad{coerce(var)} converts the series variable \spad{var} into a + ++ Laurent series. + differentiate: (%,Variable(var)) -> % + ++ \spad{differentiate(f(x),x)} returns the derivative of + ++ \spad{f(x)} with respect to \spad{x}. + if Coef has Algebra Fraction Integer then + integrate: (%,Variable(var)) -> % + ++ \spad{integrate(f(x))} returns an anti-derivative of the power + ++ series \spad{f(x)} with constant coefficient 0. + ++ We may integrate a series when we can divide coefficients + ++ by integers. + + Implementation ==> InnerSparseUnivariatePowerSeries(Coef) add + + Rep := InnerSparseUnivariatePowerSeries(Coef) + + variable x == var + center x == cen + + coerce(v: Variable(var)) == + zero? cen => monomial(1,1) + monomial(1,1) + monomial(cen,0) + + pole? x == negative? order(x,0) + +--% operations with Taylor series + + coerce(uts:SUTS) == uts pretend % + + taylorIfCan uls == + pole? uls => "failed" + uls pretend SUTS + + taylor uls == + (uts := taylorIfCan uls) case "failed" => + error "taylor: Laurent series has a pole" + uts :: SUTS + + retractIfCan(x:%):Union(SUTS,"failed") == taylorIfCan x + + laurent(n,uts) == monomial(1,n) * (uts :: %) + + removeZeroes uls == uls + removeZeroes(n,uls) == uls + + taylorRep uls == taylor(monomial(1,-order(uls,0)) * uls) + degree uls == order(uls,0) + + numer uls == taylorRep uls + denom uls == monomial(1,(-order(uls,0)) :: NNI)$SUTS + + (uts:SUTS) * (uls:%) == (uts :: %) * uls + (uls:%) * (uts:SUTS) == uls * (uts :: %) + + if Coef has Field then + (uts1:SUTS) / (uts2:SUTS) == (uts1 :: %) / (uts2 :: %) + + recip(uls) == iExquo(1,uls,false) + + if Coef has IntegralDomain then + uls1 exquo uls2 == iExquo(uls1,uls2,false) + + if Coef has Field then + uls1:% / uls2:% == + (q := uls1 exquo uls2) case "failed" => + error "quotient cannot be computed" + q :: % + + differentiate(uls:%,v:Variable(var)) == differentiate uls + + elt(uls1:%,uls2:%) == + order(uls2,1) < 1 => + error "elt: second argument must have positive order" + negative?(ord := order(uls1,0)) => + (recipr := recip uls2) case "failed" => + error "elt: second argument not invertible" + uls3 := uls1 * monomial(1,-ord) + iCompose(uls3,uls2) * (recipr :: %) ** ((-ord) :: NNI) + iCompose(uls1,uls2) + + if Coef has IntegralDomain then + rationalFunction(uls,n) == + zero?(e := order(uls,0)) => + negative? n => 0 + polynomial(taylor uls,n :: NNI) :: RF + negative?(m := n - e) => 0 + poly := polynomial(taylor(monomial(1,-e) * uls),m :: NNI) :: RF + v := variable(uls) :: RF; c := center(uls) :: P :: RF + poly / (v - c) ** ((-e) :: NNI) + + rationalFunction(uls,n1,n2) == rationalFunction(truncate(uls,n1,n2),n2) + + if Coef has Algebra Fraction Integer then + + integrate uls == + zero? coefficient(uls,-1) => + error "integrate: series has term of order -1" + integrate(uls)$Rep + + integrate(uls:%,v:Variable(var)) == integrate uls + + (uls1:%) ** (uls2:%) == exp(log(uls1) * uls2) + + exp uls == exp(uls)$EFULS + log uls == log(uls)$EFULS + sin uls == sin(uls)$EFULS + cos uls == cos(uls)$EFULS + tan uls == tan(uls)$EFULS + cot uls == cot(uls)$EFULS + sec uls == sec(uls)$EFULS + csc uls == csc(uls)$EFULS + asin uls == asin(uls)$EFULS + acos uls == acos(uls)$EFULS + atan uls == atan(uls)$EFULS + acot uls == acot(uls)$EFULS + asec uls == asec(uls)$EFULS + acsc uls == acsc(uls)$EFULS + sinh uls == sinh(uls)$EFULS + cosh uls == cosh(uls)$EFULS + tanh uls == tanh(uls)$EFULS + coth uls == coth(uls)$EFULS + sech uls == sech(uls)$EFULS + csch uls == csch(uls)$EFULS + asinh uls == asinh(uls)$EFULS + acosh uls == acosh(uls)$EFULS + atanh uls == atanh(uls)$EFULS + acoth uls == acoth(uls)$EFULS + asech uls == asech(uls)$EFULS + acsch uls == acsch(uls)$EFULS + + if Coef has CommutativeRing then + + (uls:%) ** (r:RN) == cRationalPower(uls,r) + + else + + (uls:%) ** (r:RN) == + negative?(ord0 := order(uls,0)) => + order := ord0 :: I + (n := order exquo denom(r)) case "failed" => + error "**: rational power does not exist" + uts := retract(uls * monomial(1,-order))@SUTS + utsPow := (uts ** r) :: % + monomial(1,(n :: I) * numer(r)) * utsPow + uts := retract(uls)@SUTS + (uts ** r) :: % + +--% OutputForms + + coerce(uls:%): OUT == + st := getStream uls + if not(explicitlyEmpty? st or explicitEntries? st) _ + and (nx := retractIfCan(elt getRef uls))@Union(I,"failed") case I then + count : NNI := _$streamCount$Lisp + degr := min(count,(nx :: I) + count + 1) + extend(uls,degr) + seriesToOutputForm(st,getRef uls,variable uls,center uls,1) + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain SUP SparseUnivariatePolynomial} +\pagehead{SparseUnivariatePolynomial}{SUP} +\pagepic{ps/v103sparseunivariatepolynomial.ps}{SUP}{1.00} +See also:\\ +\refto{FreeModule}{FM} +\refto{PolynomialRing}{PR} +\refto{UnivariatePolynomial}{UP} +<>= +)abbrev domain SUP SparseUnivariatePolynomial +++ Author: Dave Barton, Barry Trager +++ Date Created: +++ Date Last Updated: +++ Basic Functions: Ring, monomial, coefficient, reductum, differentiate, +++ elt, map, resultant, discriminant +++ Related Constructors: UnivariatePolynomial, Polynomial +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ This domain represents univariate polynomials over arbitrary +++ (not necessarily commutative) coefficient rings. The variable is +++ unspecified so that the variable displays as \spad{?} on output. +++ If it is necessary to specify the variable name, use type \spadtype{UnivariatePolynomial}. +++ The representation is sparse +++ in the sense that only non-zero terms are represented. +++ Note: if the coefficient ring is a field, this domain forms a euclidean domain. + +SparseUnivariatePolynomial(R:Ring): UnivariatePolynomialCategory(R) with + outputForm : (%,OutputForm) -> OutputForm + ++ outputForm(p,var) converts the SparseUnivariatePolynomial p to + ++ an output form (see \spadtype{OutputForm}) printed as a polynomial in the + ++ output form variable. + fmecg: (%,NonNegativeInteger,R,%) -> % + ++ fmecg(p1,e,r,p2) finds X : p1 - r * X**e * p2 + == PolynomialRing(R,NonNegativeInteger) + add + --representations + Term := Record(k:NonNegativeInteger,c:R) + Rep := List Term + p:% + n:NonNegativeInteger + np: PositiveInteger + FP ==> SparseUnivariatePolynomial % + pp,qq: FP + lpp:List FP + + -- for karatsuba + kBound: NonNegativeInteger := 63 + upmp := UnivariatePolynomialMultiplicationPackage(R,%) + + + if R has FieldOfPrimeCharacteristic then + p ** np == p ** (np pretend NonNegativeInteger) + p ^ np == p ** (np pretend NonNegativeInteger) + p ^ n == p ** n + p ** n == + null p => 0 + zero? n => 1 +-- one? n => p + (n = 1) => p + empty? p.rest => + zero?(cc:=p.first.c ** n) => 0 + [[n * p.first.k, cc]] + -- not worth doing special trick if characteristic is too small + if characteristic()$R < 3 then return expt(p,n pretend PositiveInteger)$RepeatedSquaring(%) + y:%:=1 + -- break up exponent in qn * characteristic + rn + -- exponentiating by the characteristic is fast + rec := divide(n, characteristic()$R) + qn:= rec.quotient + rn:= rec.remainder + repeat + if rn = 1 then y := y * p + if rn > 1 then y:= y * binomThmExpt([p.first], p.rest, rn) + zero? qn => return y + -- raise to the characteristic power + p:= [[t.k * characteristic()$R , primeFrobenius(t.c)$R ]$Term for t in p] + rec := divide(qn, characteristic()$R) + qn:= rec.quotient + rn:= rec.remainder + y + + + + zero?(p): Boolean == empty?(p) +-- one?(p):Boolean == not empty? p and (empty? rest p and zero? first(p).k and one? first(p).c) + one?(p):Boolean == not empty? p and (empty? rest p and zero? first(p).k and (first(p).c = 1)) + ground?(p): Boolean == empty? p or (empty? rest p and zero? first(p).k) + multiplyExponents(p,n) == [ [u.k*n,u.c] for u in p] + divideExponents(p,n) == + null p => p + m:= (p.first.k :: Integer exquo n::Integer) + m case "failed" => "failed" + u:= divideExponents(p.rest,n) + u case "failed" => "failed" + [[m::Integer::NonNegativeInteger,p.first.c],:u] + karatsubaDivide(p, n) == + zero? n => [p, 0] + lowp: Rep := p + highp: Rep := [] + repeat + if empty? lowp then break + t := first lowp + if t.k < n then break + lowp := rest lowp + highp := cons([subtractIfCan(t.k,n)::NonNegativeInteger,t.c]$Term,highp) + [ reverse highp, lowp] + shiftRight(p, n) == + [[subtractIfCan(t.k,n)::NonNegativeInteger,t.c]$Term for t in p] + shiftLeft(p, n) == + [[t.k + n,t.c]$Term for t in p] + pomopo!(p1,r,e,p2) == + rout:%:= [] + for tm in p2 repeat + e2:= e + tm.k + c2:= r * tm.c + c2 = 0 => "next term" + while not null p1 and p1.first.k > e2 repeat + (rout:=[p1.first,:rout]; p1:=p1.rest) --use PUSH and POP? + null p1 or p1.first.k < e2 => rout:=[[e2,c2],:rout] + if (u:=p1.first.c + c2) ^= 0 then rout:=[[e2, u],:rout] + p1:=p1.rest + NRECONC(rout,p1)$Lisp + +-- implementation using karatsuba algorithm conditionally +-- +-- p1 * p2 == +-- xx := p1::Rep +-- empty? xx => p1 +-- yy := p2::Rep +-- empty? yy => p2 +-- zero? first(xx).k => first(xx).c * p2 +-- zero? first(yy).k => p1 * first(yy).c +-- (first(xx).k > kBound) and (first(yy).k > kBound) and (#xx > kBound) and (#yy > kBound) => +-- karatsubaOnce(p1,p2)$upmp +-- xx := reverse xx +-- res : Rep := empty() +-- for tx in xx repeat res:= rep pomopo!( res,tx.c,tx.k,p2) +-- res + + + univariate(p:%) == p pretend SparseUnivariatePolynomial(R) + multivariate(sup:SparseUnivariatePolynomial(R),v:SingletonAsOrderedSet) == + sup pretend % + univariate(p:%,v:SingletonAsOrderedSet) == + zero? p => 0 + monomial(leadingCoefficient(p)::%,degree p) + + univariate(reductum p,v) + multivariate(supp:SparseUnivariatePolynomial(%),v:SingletonAsOrderedSet) == + zero? supp => 0 + lc:=leadingCoefficient supp + degree lc > 0 => error "bad form polynomial" + monomial(leadingCoefficient lc,degree supp) + + multivariate(reductum supp,v) + if R has FiniteFieldCategory and R has PolynomialFactorizationExplicit then + RXY ==> SparseUnivariatePolynomial SparseUnivariatePolynomial R + squareFreePolynomial pp == + squareFree(pp)$UnivariatePolynomialSquareFree(%,FP) + factorPolynomial pp == + (generalTwoFactor(pp pretend RXY)$TwoFactorize(R)) + pretend Factored SparseUnivariatePolynomial % + factorSquareFreePolynomial pp == + (generalTwoFactor(pp pretend RXY)$TwoFactorize(R)) + pretend Factored SparseUnivariatePolynomial % + gcdPolynomial(pp,qq) == gcd(pp,qq)$FP + factor p == factor(p)$DistinctDegreeFactorize(R,%) + solveLinearPolynomialEquation(lpp,pp) == + solveLinearPolynomialEquation(lpp, pp)$FiniteFieldSolveLinearPolynomialEquation(R,%,FP) + else if R has PolynomialFactorizationExplicit then + import PolynomialFactorizationByRecursionUnivariate(R,%) + solveLinearPolynomialEquation(lpp,pp)== + solveLinearPolynomialEquationByRecursion(lpp,pp) + factorPolynomial(pp) == + factorByRecursion(pp) + factorSquareFreePolynomial(pp) == + factorSquareFreeByRecursion(pp) + + if R has IntegralDomain then + if R has approximate then + p1 exquo p2 == + null p2 => error "Division by 0" + p2 = 1 => p1 + p1=p2 => 1 + --(p1.lastElt.c exquo p2.lastElt.c) case "failed" => "failed" + rout:= []@List(Term) + while not null p1 repeat + (a:= p1.first.c exquo p2.first.c) + a case "failed" => return "failed" + ee:= subtractIfCan(p1.first.k, p2.first.k) + ee case "failed" => return "failed" + p1:= fmecg(p1.rest, ee, a, p2.rest) + rout:= [[ee,a], :rout] + null p1 => reverse(rout)::% -- nreverse? + "failed" + else -- R not approximate + p1 exquo p2 == + null p2 => error "Division by 0" + p2 = 1 => p1 + --(p1.lastElt.c exquo p2.lastElt.c) case "failed" => "failed" + rout:= []@List(Term) + while not null p1 repeat + (a:= p1.first.c exquo p2.first.c) + a case "failed" => return "failed" + ee:= subtractIfCan(p1.first.k, p2.first.k) + ee case "failed" => return "failed" + p1:= fmecg(p1.rest, ee, a, p2.rest) + rout:= [[ee,a], :rout] + null p1 => reverse(rout)::% -- nreverse? + "failed" + fmecg(p1,e,r,p2) == -- p1 - r * X**e * p2 + rout:%:= [] + r:= - r + for tm in p2 repeat + e2:= e + tm.k + c2:= r * tm.c + c2 = 0 => "next term" + while not null p1 and p1.first.k > e2 repeat + (rout:=[p1.first,:rout]; p1:=p1.rest) --use PUSH and POP? + null p1 or p1.first.k < e2 => rout:=[[e2,c2],:rout] + if (u:=p1.first.c + c2) ^= 0 then rout:=[[e2, u],:rout] + p1:=p1.rest + NRECONC(rout,p1)$Lisp + pseudoRemainder(p1,p2) == + null p2 => error "PseudoDivision by Zero" + null p1 => 0 + co:=p2.first.c; + e:=p2.first.k; + p2:=p2.rest; + e1:=max(p1.first.k:Integer-e+1,0):NonNegativeInteger + while not null p1 repeat + if (u:=subtractIfCan(p1.first.k,e)) case "failed" then leave + p1:=fmecg(co * p1.rest, u, p1.first.c, p2) + e1:= (e1 - 1):NonNegativeInteger + e1 = 0 => p1 + co ** e1 * p1 + toutput(t1:Term,v:OutputForm):OutputForm == + t1.k = 0 => t1.c :: OutputForm + if t1.k = 1 + then mon:= v + else mon := v ** t1.k::OutputForm + t1.c = 1 => mon + t1.c = -1 and + ((t1.c :: OutputForm) = (-1$Integer)::OutputForm)@Boolean => - mon + t1.c::OutputForm * mon + outputForm(p:%,v:OutputForm) == + l: List(OutputForm) + l:=[toutput(t,v) for t in p] + null l => (0$Integer)::OutputForm -- else FreeModule 0 problems + reduce("+",l) + + coerce(p:%):OutputForm == outputForm(p, "?"::OutputForm) + elt(p:%,val:R) == + null p => 0$R + co:=p.first.c + n:=p.first.k + for tm in p.rest repeat + co:= co * val ** (n - (n:=tm.k)):NonNegativeInteger + tm.c + n = 0 => co + co * val ** n + elt(p:%,val:%) == + null p => 0$% + coef:% := p.first.c :: % + n:=p.first.k + for tm in p.rest repeat + coef:= coef * val ** (n-(n:=tm.k)):NonNegativeInteger+(tm.c::%) + n = 0 => coef + coef * val ** n + + monicDivide(p1:%,p2:%) == + null p2 => error "monicDivide: division by 0" + leadingCoefficient p2 ^= 1 => error "Divisor Not Monic" + p2 = 1 => [p1,0] + null p1 => [0,0] + degree p1 < (n:=degree p2) => [0,p1] + rout:Rep := [] + p2 := p2.rest + while not null p1 repeat + (u:=subtractIfCan(p1.first.k, n)) case "failed" => leave + rout:=[[u, p1.first.c], :rout] + p1:=fmecg(p1.rest, rout.first.k, rout.first.c, p2) + [reverse_!(rout),p1] + + if R has IntegralDomain then + discriminant(p) == discriminant(p)$PseudoRemainderSequence(R,%) +-- discriminant(p) == +-- null p or zero?(p.first.k) => error "cannot take discriminant of constants" +-- dp:=differentiate p +-- corr:= p.first.c ** ((degree p - 1 - degree dp)::NonNegativeInteger) +-- (-1)**((p.first.k*(p.first.k-1)) quo 2):NonNegativeInteger +-- * (corr * resultant(p,dp) exquo p.first.c)::R + + subResultantGcd(p1,p2) == subResultantGcd(p1,p2)$PseudoRemainderSequence(R,%) +-- subResultantGcd(p1,p2) == --args # 0, non-coef, prim, ans not prim +-- --see algorithm 1 (p. 4) of Brown's latest (unpublished) paper +-- if p1.first.k < p2.first.k then (p1,p2):=(p2,p1) +-- p:=pseudoRemainder(p1,p2) +-- co:=1$R; +-- e:= (p1.first.k - p2.first.k):NonNegativeInteger +-- while not null p and p.first.k ^= 0 repeat +-- p1:=p2; p2:=p; p:=pseudoRemainder(p1,p2) +-- null p or p.first.k = 0 => "enuf" +-- co:=(p1.first.c ** e exquo co ** max(0, (e-1))::NonNegativeInteger)::R +-- e:= (p1.first.k - p2.first.k):NonNegativeInteger; c1:=co**e +-- p:=[[tm.k,((tm.c exquo p1.first.c)::R exquo c1)::R] for tm in p] +-- if null p then p2 else 1$% + + resultant(p1,p2) == resultant(p1,p2)$PseudoRemainderSequence(R,%) +-- resultant(p1,p2) == --SubResultant PRS Algorithm +-- null p1 or null p2 => 0$R +-- 0 = degree(p1) => ((first p1).c)**degree(p2) +-- 0 = degree(p2) => ((first p2).c)**degree(p1) +-- if p1.first.k < p2.first.k then +-- (if odd?(p1.first.k) then p1:=-p1; (p1,p2):=(p2,p1)) +-- p:=pseudoRemainder(p1,p2) +-- co:=1$R; e:=(p1.first.k-p2.first.k):NonNegativeInteger +-- while not null p repeat +-- if not odd?(e) then p:=-p +-- p1:=p2; p2:=p; p:=pseudoRemainder(p1,p2) +-- co:=(p1.first.c ** e exquo co ** max(e:Integer-1,0):NonNegativeInteger)::R +-- e:= (p1.first.k - p2.first.k):NonNegativeInteger; c1:=co**e +-- p:=(p exquo ((leadingCoefficient p1) * c1))::% +-- degree p2 > 0 => 0$R +-- (p2.first.c**e exquo co**((e-1)::NonNegativeInteger))::R + if R has GcdDomain then + content(p) == if null p then 0$R else "gcd"/[tm.c for tm in p] + --make CONTENT more efficient? + + primitivePart(p) == + null p => p + ct :=content(p) + unitCanonical((p exquo ct)::%) + -- exquo present since % is now an IntegralDomain + + gcd(p1,p2) == + gcdPolynomial(p1 pretend SparseUnivariatePolynomial R, + p2 pretend SparseUnivariatePolynomial R) pretend % + + if R has Field then + divide( p1, p2) == + zero? p2 => error "Division by 0" +-- one? p2 => [p1,0] + (p2 = 1) => [p1,0] + ct:=inv(p2.first.c) + n:=p2.first.k + p2:=p2.rest + rout:=empty()$List(Term) + while p1 ^= 0 repeat + (u:=subtractIfCan(p1.first.k, n)) case "failed" => leave + rout:=[[u, ct * p1.first.c], :rout] + p1:=fmecg(p1.rest, rout.first.k, rout.first.c, p2) + [reverse_!(rout),p1] + + p / co == inv(co) * p + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain SUPEXPR SparseUnivariatePolynomialExpressions} +This domain is a hack, in some sense. What I'd really like to do - +automatically - is to provide all operations supported by the coefficient +domain, as long as the polynomials can be retracted to that domain, i.e., as +long as they are just constants. I don't see another way to do this, +unfortunately. +\pagehead{SparseUnivariatePolynomialExpressions}{SUPEXPR} +\pagepic{ps/v103sparseunivariatepolynomialexpressions.ps}{SUPEXPR}{1.00} +<>= +)abb domain SUPEXPR SparseUnivariatePolynomialExpressions +SparseUnivariatePolynomialExpressions(R: Ring): Exports == Implementation where + + Exports == UnivariatePolynomialCategory R with + + if R has TranscendentalFunctionCategory + then TranscendentalFunctionCategory + + Implementation == SparseUnivariatePolynomial R add + + if R has TranscendentalFunctionCategory then + exp(p: %): % == + ground? p => coerce exp ground p + output(hconcat("exp p for p= ", p::OutputForm))$OutputPackage + error "SUPTRAFUN: exp only defined for elements of the coefficient ring" + sin(p: %): % == + ground? p => coerce sin ground p + output(hconcat("sin p for p= ", p::OutputForm))$OutputPackage + error "SUPTRAFUN: sin only defined for elements of the coefficient ring" + asin(p: %): % == + ground? p => coerce asin ground p + output(hconcat("asin p for p= ", p::OutputForm))$OutputPackage + error "SUPTRAFUN: asin only defined for elements of the coefficient ring" + cos(p: %): % == + ground? p => coerce cos ground p + output(hconcat("cos p for p= ", p::OutputForm))$OutputPackage + error "SUPTRAFUN: cos only defined for elements of the coefficient ring" + acos(p: %): % == + ground? p => coerce acos ground p + output(hconcat("acos p for p= ", p::OutputForm))$OutputPackage + error "SUPTRAFUN: acos only defined for elements of the coefficient ring" +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain SUPXS SparseUnivariatePuiseuxSeries} +\pagehead{SparseUnivariatePuiseuxSeries}{SUPXS} +\pagepic{ps/v103sparseunivariatepuiseuxseries.ps}{SUPXS}{1.00} +<>= +)abbrev domain SUPXS SparseUnivariatePuiseuxSeries +++ Author: Clifton J. Williamson +++ Date Created: 11 November 1994 +++ Date Last Updated: 28 February 1995 +++ Basic Operations: +++ Related Domains: InnerSparseUnivariatePowerSeries, +++ SparseUnivariateTaylorSeries, SparseUnivariateLaurentSeries +++ Also See: +++ AMS Classifications: +++ Keywords: sparse, series +++ Examples: +++ References: +++ Description: Sparse Puiseux series in one variable +++ \spadtype{SparseUnivariatePuiseuxSeries} is a domain representing Puiseux +++ series in one variable with coefficients in an arbitrary ring. The +++ parameters of the type specify the coefficient ring, the power series +++ variable, and the center of the power series expansion. For example, +++ \spad{SparseUnivariatePuiseuxSeries(Integer,x,3)} represents Puiseux +++ series in \spad{(x - 3)} with \spadtype{Integer} coefficients. +SparseUnivariatePuiseuxSeries(Coef,var,cen): Exports == Implementation where + Coef : Ring + var : Symbol + cen : Coef + I ==> Integer + NNI ==> NonNegativeInteger + OUT ==> OutputForm + RN ==> Fraction Integer + SUTS ==> SparseUnivariateTaylorSeries(Coef,var,cen) + SULS ==> SparseUnivariateLaurentSeries(Coef,var,cen) + SUPS ==> InnerSparseUnivariatePowerSeries(Coef) + + Exports ==> Join(UnivariatePuiseuxSeriesConstructorCategory(Coef,SULS),_ + RetractableTo SUTS) with + coerce: Variable(var) -> % + ++ coerce(var) converts the series variable \spad{var} into a + ++ Puiseux series. + differentiate: (%,Variable(var)) -> % + ++ \spad{differentiate(f(x),x)} returns the derivative of + ++ \spad{f(x)} with respect to \spad{x}. + if Coef has Algebra Fraction Integer then + integrate: (%,Variable(var)) -> % + ++ \spad{integrate(f(x))} returns an anti-derivative of the power + ++ series \spad{f(x)} with constant coefficient 0. + ++ We may integrate a series when we can divide coefficients + ++ by integers. + + Implementation ==> UnivariatePuiseuxSeriesConstructor(Coef,SULS) add + + Rep := Record(expon:RN,lSeries:SULS) + + getExpon: % -> RN + getExpon pxs == pxs.expon + + variable x == var + center x == cen + + coerce(v: Variable(var)) == + zero? cen => monomial(1,1) + monomial(1,1) + monomial(cen,0) + + coerce(uts:SUTS) == uts :: SULS :: % + + retractIfCan(upxs:%):Union(SUTS,"failed") == + (uls := retractIfCan(upxs)@Union(SULS,"failed")) case "failed" => + "failed" + retractIfCan(uls :: SULS)@Union(SUTS,"failed") + + if Coef has "*": (Fraction Integer, Coef) -> Coef then + differentiate(upxs:%,v:Variable(var)) == differentiate upxs + + if Coef has Algebra Fraction Integer then + integrate(upxs:%,v:Variable(var)) == integrate upxs + +--% OutputForms + + coerce(x:%): OUT == + sups : SUPS := laurentRep(x) pretend SUPS + st := getStream sups; refer := getRef sups + if not(explicitlyEmpty? st or explicitEntries? st) _ + and (nx := retractIfCan(elt refer)@Union(I,"failed")) case I then + count : NNI := _$streamCount$Lisp + degr := min(count,(nx :: I) + count + 1) + extend(sups,degr) + seriesToOutputForm(st,refer,variable x,center x,rationalPower x) + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain ORESUP SparseUnivariateSkewPolynomial} +\pagehead{SparseUnivariateSkewPolynomial}{ORESUP} +\pagepic{ps/v103sparseunivariateskewpolynomial.ps}{ORESUP}{1.00} +See also:\\ +\refto{Automorphism}{AUTOMOR} +\refto{UnivariateSkewPolynomial}{OREUP} +<>= +)abbrev domain ORESUP SparseUnivariateSkewPolynomial +++ Author: Manuel Bronstein +++ Date Created: 19 October 1993 +++ Date Last Updated: 1 February 1994 +++ Description: +++ This is the domain of sparse univariate skew polynomials over an Ore +++ coefficient field. +++ The multiplication is given by \spad{x a = \sigma(a) x + \delta a}. +SparseUnivariateSkewPolynomial(R:Ring, sigma:Automorphism R, delta: R -> R): + UnivariateSkewPolynomialCategory R with + outputForm: (%, OutputForm) -> OutputForm + ++ outputForm(p, x) returns the output form of p using x for the + ++ otherwise anonymous variable. + == SparseUnivariatePolynomial R add + import UnivariateSkewPolynomialCategoryOps(R, %) + + x:% * y:% == times(x, y, sigma, delta) + apply(p, c, r) == apply(p, c, r, sigma, delta) + + if R has IntegralDomain then + monicLeftDivide(a, b) == monicLeftDivide(a, b, sigma) + monicRightDivide(a, b) == monicRightDivide(a, b, sigma) + + if R has Field then + leftDivide(a, b) == leftDivide(a, b, sigma) + rightDivide(a, b) == rightDivide(a, b, sigma) + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain SUTS SparseUnivariateTaylorSeries} +\pagehead{SparseUnivariateTaylorSeries}{SUTS} +\pagepic{ps/v103sparseunivariatetaylorseries.ps}{SUTS}{1.00} +<>= +)abbrev domain SUTS SparseUnivariateTaylorSeries +++ Author: Clifton J. Williamson +++ Date Created: 16 February 1990 +++ Date Last Updated: 10 March 1995 +++ Basic Operations: +++ Related Domains: InnerSparseUnivariatePowerSeries, +++ SparseUnivariateLaurentSeries, SparseUnivariatePuiseuxSeries +++ Also See: +++ AMS Classifications: +++ Keywords: Taylor series, sparse power series +++ Examples: +++ References: +++ Description: Sparse Taylor series in one variable +++ \spadtype{SparseUnivariateTaylorSeries} is a domain representing Taylor +++ series in one variable with coefficients in an arbitrary ring. The +++ parameters of the type specify the coefficient ring, the power series +++ variable, and the center of the power series expansion. For example, +++ \spadtype{SparseUnivariateTaylorSeries}(Integer,x,3) represents Taylor +++ series in \spad{(x - 3)} with \spadtype{Integer} coefficients. +SparseUnivariateTaylorSeries(Coef,var,cen): Exports == Implementation where + Coef : Ring + var : Symbol + cen : Coef + COM ==> OrderedCompletion Integer + I ==> Integer + L ==> List + NNI ==> NonNegativeInteger + OUT ==> OutputForm + P ==> Polynomial Coef + REF ==> Reference OrderedCompletion Integer + RN ==> Fraction Integer + Term ==> Record(k:Integer,c:Coef) + SG ==> String + ST ==> Stream Term + UP ==> UnivariatePolynomial(var,Coef) + + Exports ==> UnivariateTaylorSeriesCategory(Coef) with + coerce: UP -> % + ++\spad{coerce(p)} converts a univariate polynomial p in the variable + ++\spad{var} to a univariate Taylor series in \spad{var}. + univariatePolynomial: (%,NNI) -> UP + ++\spad{univariatePolynomial(f,k)} returns a univariate polynomial + ++ consisting of the sum of all terms of f of degree \spad{<= k}. + coerce: Variable(var) -> % + ++\spad{coerce(var)} converts the series variable \spad{var} into a + ++ Taylor series. + differentiate: (%,Variable(var)) -> % + ++ \spad{differentiate(f(x),x)} computes the derivative of + ++ \spad{f(x)} with respect to \spad{x}. + if Coef has Algebra Fraction Integer then + integrate: (%,Variable(var)) -> % + ++ \spad{integrate(f(x),x)} returns an anti-derivative of the power + ++ series \spad{f(x)} with constant coefficient 0. + ++ We may integrate a series when we can divide coefficients + ++ by integers. + + Implementation ==> InnerSparseUnivariatePowerSeries(Coef) add + import REF + + Rep := InnerSparseUnivariatePowerSeries(Coef) + + makeTerm: (Integer,Coef) -> Term + makeTerm(exp,coef) == [exp,coef] + getCoef: Term -> Coef + getCoef term == term.c + getExpon: Term -> Integer + getExpon term == term.k + + monomial(coef,expon) == monomial(coef,expon)$Rep + extend(x,n) == extend(x,n)$Rep + + 0 == monomial(0,0)$Rep + 1 == monomial(1,0)$Rep + + recip uts == iExquo(1,uts,true) + + if Coef has IntegralDomain then + uts1 exquo uts2 == iExquo(uts1,uts2,true) + + quoByVar uts == taylorQuoByVar(uts)$Rep + + differentiate(x:%,v:Variable(var)) == differentiate x + +--% Creation and destruction of series + + coerce(v: Variable(var)) == + zero? cen => monomial(1,1) + monomial(1,1) + monomial(cen,0) + + coerce(p:UP) == + zero? p => 0 + if not zero? cen then p := p(monomial(1,1)$UP + monomial(cen,0)$UP) + st : ST := empty() + while not zero? p repeat + st := concat(makeTerm(degree p,leadingCoefficient p),st) + p := reductum p + makeSeries(ref plusInfinity(),st) + + univariatePolynomial(x,n) == + extend(x,n); st := getStream x + ans : UP := 0; oldDeg : I := 0; + mon := monomial(1,1)$UP - monomial(center x,0)$UP; monPow : UP := 1 + while explicitEntries? st repeat + (xExpon := getExpon(xTerm := frst st)) > n => return ans + pow := (xExpon - oldDeg) :: NNI; oldDeg := xExpon + monPow := monPow * mon ** pow + ans := ans + getCoef(xTerm) * monPow + st := rst st + ans + + polynomial(x,n) == + extend(x,n); st := getStream x + ans : P := 0; oldDeg : I := 0; + mon := (var :: P) - (center(x) :: P); monPow : P := 1 + while explicitEntries? st repeat + (xExpon := getExpon(xTerm := frst st)) > n => return ans + pow := (xExpon - oldDeg) :: NNI; oldDeg := xExpon + monPow := monPow * mon ** pow + ans := ans + getCoef(xTerm) * monPow + st := rst st + ans + + polynomial(x,n1,n2) == polynomial(truncate(x,n1,n2),n2) + + truncate(x,n) == truncate(x,n)$Rep + truncate(x,n1,n2) == truncate(x,n1,n2)$Rep + + iCoefficients: (ST,REF,I) -> Stream Coef + iCoefficients(x,refer,n) == delay + -- when this function is called, we are computing the nth order + -- coefficient of the series + explicitlyEmpty? x => empty() + -- if terms up to order n have not been computed, + -- apply lazy evaluation + nn := n :: COM + while (nx := elt refer) < nn repeat lazyEvaluate x + -- must have nx >= n + explicitEntries? x => + xCoef := getCoef(xTerm := frst x); xExpon := getExpon xTerm + xExpon = n => concat(xCoef,iCoefficients(rst x,refer,n + 1)) + -- must have nx > n + concat(0,iCoefficients(x,refer,n + 1)) + concat(0,iCoefficients(x,refer,n + 1)) + + coefficients uts == + refer := getRef uts; x := getStream uts + iCoefficients(x,refer,0) + + terms uts == terms(uts)$Rep pretend Stream Record(k:NNI,c:Coef) + + iSeries: (Stream Coef,I,REF) -> ST + iSeries(st,n,refer) == delay + -- when this function is called, we are creating the nth order + -- term of a series + empty? st => (setelt(refer,plusInfinity()); empty()) + setelt(refer,n :: COM) + zero? (coef := frst st) => iSeries(rst st,n + 1,refer) + concat(makeTerm(n,coef),iSeries(rst st,n + 1,refer)) + + series(st:Stream Coef) == + refer := ref(-1) + makeSeries(refer,iSeries(st,0,refer)) + + nniToI: Stream Record(k:NNI,c:Coef) -> ST + nniToI st == + empty? st => empty() + term : Term := [(frst st).k,(frst st).c] + concat(term,nniToI rst st) + + series(st:Stream Record(k:NNI,c:Coef)) == series(nniToI st)$Rep + +--% Values + + variable x == var + center x == cen + + coefficient(x,n) == coefficient(x,n)$Rep + elt(x:%,n:NonNegativeInteger) == coefficient(x,n) + + pole? x == false + + order x == (order(x)$Rep) :: NNI + order(x,n) == (order(x,n)$Rep) :: NNI + +--% Composition + + elt(uts1:%,uts2:%) == + zero? uts2 => coefficient(uts1,0) :: % + not zero? coefficient(uts2,0) => + error "elt: second argument must have positive order" + iCompose(uts1,uts2) + +--% Integration + + if Coef has Algebra Fraction Integer then + + integrate(x:%,v:Variable(var)) == integrate x + +--% Transcendental functions + + (uts1:%) ** (uts2:%) == exp(log(uts1) * uts2) + + if Coef has CommutativeRing then + + (uts:%) ** (r:RN) == cRationalPower(uts,r) + + exp uts == cExp uts + log uts == cLog uts + + sin uts == cSin uts + cos uts == cCos uts + tan uts == cTan uts + cot uts == cCot uts + sec uts == cSec uts + csc uts == cCsc uts + + asin uts == cAsin uts + acos uts == cAcos uts + atan uts == cAtan uts + acot uts == cAcot uts + asec uts == cAsec uts + acsc uts == cAcsc uts + + sinh uts == cSinh uts + cosh uts == cCosh uts + tanh uts == cTanh uts + coth uts == cCoth uts + sech uts == cSech uts + csch uts == cCsch uts + + asinh uts == cAsinh uts + acosh uts == cAcosh uts + atanh uts == cAtanh uts + acoth uts == cAcoth uts + asech uts == cAsech uts + acsch uts == cAcsch uts + + else + + ZERO : SG := "series must have constant coefficient zero" + ONE : SG := "series must have constant coefficient one" + NPOWERS : SG := "series expansion has terms of negative degree" + + (uts:%) ** (r:RN) == +-- not one? coefficient(uts,0) => + not (coefficient(uts,0) = 1) => + error "**: constant coefficient must be one" + onePlusX : % := monomial(1,0) + monomial(1,1) + ratPow := cPower(uts,r :: Coef) + iCompose(ratPow,uts - 1) + + exp uts == + zero? coefficient(uts,0) => + expx := cExp monomial(1,1) + iCompose(expx,uts) + error concat("exp: ",ZERO) + + log uts == +-- one? coefficient(uts,0) => + (coefficient(uts,0) = 1) => + log1PlusX := cLog(monomial(1,0) + monomial(1,1)) + iCompose(log1PlusX,uts - 1) + error concat("log: ",ONE) + + sin uts == + zero? coefficient(uts,0) => + sinx := cSin monomial(1,1) + iCompose(sinx,uts) + error concat("sin: ",ZERO) + + cos uts == + zero? coefficient(uts,0) => + cosx := cCos monomial(1,1) + iCompose(cosx,uts) + error concat("cos: ",ZERO) + + tan uts == + zero? coefficient(uts,0) => + tanx := cTan monomial(1,1) + iCompose(tanx,uts) + error concat("tan: ",ZERO) + + cot uts == + zero? uts => error "cot: cot(0) is undefined" + zero? coefficient(uts,0) => error concat("cot: ",NPOWERS) + error concat("cot: ",ZERO) + + sec uts == + zero? coefficient(uts,0) => + secx := cSec monomial(1,1) + iCompose(secx,uts) + error concat("sec: ",ZERO) + + csc uts == + zero? uts => error "csc: csc(0) is undefined" + zero? coefficient(uts,0) => error concat("csc: ",NPOWERS) + error concat("csc: ",ZERO) + + asin uts == + zero? coefficient(uts,0) => + asinx := cAsin monomial(1,1) + iCompose(asinx,uts) + error concat("asin: ",ZERO) + + atan uts == + zero? coefficient(uts,0) => + atanx := cAtan monomial(1,1) + iCompose(atanx,uts) + error concat("atan: ",ZERO) + + acos z == error "acos: acos undefined on this coefficient domain" + acot z == error "acot: acot undefined on this coefficient domain" + asec z == error "asec: asec undefined on this coefficient domain" + acsc z == error "acsc: acsc undefined on this coefficient domain" + + sinh uts == + zero? coefficient(uts,0) => + sinhx := cSinh monomial(1,1) + iCompose(sinhx,uts) + error concat("sinh: ",ZERO) + + cosh uts == + zero? coefficient(uts,0) => + coshx := cCosh monomial(1,1) + iCompose(coshx,uts) + error concat("cosh: ",ZERO) + + tanh uts == + zero? coefficient(uts,0) => + tanhx := cTanh monomial(1,1) + iCompose(tanhx,uts) + error concat("tanh: ",ZERO) + + coth uts == + zero? uts => error "coth: coth(0) is undefined" + zero? coefficient(uts,0) => error concat("coth: ",NPOWERS) + error concat("coth: ",ZERO) + + sech uts == + zero? coefficient(uts,0) => + sechx := cSech monomial(1,1) + iCompose(sechx,uts) + error concat("sech: ",ZERO) + + csch uts == + zero? uts => error "csch: csch(0) is undefined" + zero? coefficient(uts,0) => error concat("csch: ",NPOWERS) + error concat("csch: ",ZERO) + + asinh uts == + zero? coefficient(uts,0) => + asinhx := cAsinh monomial(1,1) + iCompose(asinhx,uts) + error concat("asinh: ",ZERO) + + atanh uts == + zero? coefficient(uts,0) => + atanhx := cAtanh monomial(1,1) + iCompose(atanhx,uts) + error concat("atanh: ",ZERO) + + acosh uts == error "acosh: acosh undefined on this coefficient domain" + acoth uts == error "acoth: acoth undefined on this coefficient domain" + asech uts == error "asech: asech undefined on this coefficient domain" + acsch uts == error "acsch: acsch undefined on this coefficient domain" + + if Coef has Field then + if Coef has Algebra Fraction Integer then + + (uts:%) ** (r:Coef) == +-- not one? coefficient(uts,1) => + not (coefficient(uts,1) = 1) => + error "**: constant coefficient should be 1" + cPower(uts,r) + +--% OutputForms + + coerce(x:%): OUT == + count : NNI := _$streamCount$Lisp + extend(x,count) + seriesToOutputForm(getStream x,getRef x,variable x,center x,1) + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{domain SHDP SplitHomogeneousDirectProduct} \pagehead{SplitHomogeneousDirectProduct}{SHDP} \pagepic{ps/v103splithomogeneousdirectproduct.ps}{SHDP}{1.00} @@ -61336,6 +66114,878 @@ SplittingTree(V,C) : Exports == Implementation where @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain SREGSET SquareFreeRegularTriangularSet} +<>= +-- sregset.spad.pamphlet SquareFreeRegularTriangularSet.input +)spool SquareFreeRegularTriangularSet.output +)set message test on +)set message auto off +)clear all +--S 1 of 23 +R := Integer +--R +--R +--R (1) Integer +--R Type: Domain +--E 1 + +--S 2 of 23 +ls : List Symbol := [x,y,z,t] +--R +--R +--R (2) [x,y,z,t] +--R Type: List Symbol +--E 2 + +--S 3 of 23 +V := OVAR(ls) +--R +--R +--R (3) OrderedVariableList [x,y,z,t] +--R Type: Domain +--E 3 + +--S 4 of 23 +E := IndexedExponents V +--R +--R +--R (4) IndexedExponents OrderedVariableList [x,y,z,t] +--R Type: Domain +--E 4 + +--S 5 of 23 +P := NSMP(R, V) +--R +--R +--R (5) NewSparseMultivariatePolynomial(Integer,OrderedVariableList [x,y,z,t]) +--R Type: Domain +--E 5 + +--S 6 of 23 +x: P := 'x +--R +--R +--R (6) x +--R Type: NewSparseMultivariatePolynomial(Integer,OrderedVariableList [x,y,z,t]) +--E 6 + +--S 7 of 23 +y: P := 'y +--R +--R +--R (7) y +--R Type: NewSparseMultivariatePolynomial(Integer,OrderedVariableList [x,y,z,t]) +--E 7 + +--S 8 of 23 +z: P := 'z +--R +--R +--R (8) z +--R Type: NewSparseMultivariatePolynomial(Integer,OrderedVariableList [x,y,z,t]) +--E 8 + +--S 9 of 23 +t: P := 't +--R +--R +--R (9) t +--R Type: NewSparseMultivariatePolynomial(Integer,OrderedVariableList [x,y,z,t]) +--E 9 + +--S 10 of 23 +ST := SREGSET(R,E,V,P) +--R +--R +--R (10) +--R SquareFreeRegularTriangularSet(Integer,IndexedExponents OrderedVariableList [ +--R x,y,z,t],OrderedVariableList [x,y,z,t],NewSparseMultivariatePolynomial(Intege +--R r,OrderedVariableList [x,y,z,t])) +--R Type: Domain +--E 10 + +--S 11 of 23 +p1 := x ** 31 - x ** 6 - x - y +--R +--R +--R 31 6 +--R (11) x - x - x - y +--R Type: NewSparseMultivariatePolynomial(Integer,OrderedVariableList [x,y,z,t]) +--E 11 + +--S 12 of 23 +p2 := x ** 8 - z +--R +--R +--R 8 +--R (12) x - z +--R Type: NewSparseMultivariatePolynomial(Integer,OrderedVariableList [x,y,z,t]) +--E 12 + +--S 13 of 23 +p3 := x ** 10 - t +--R +--R +--R 10 +--R (13) x - t +--R Type: NewSparseMultivariatePolynomial(Integer,OrderedVariableList [x,y,z,t]) +--E 13 + +--S 14 of 23 +lp := [p1, p2, p3] +--R +--R +--R 31 6 8 10 +--R (14) [x - x - x - y,x - z,x - t] +--RType: List NewSparseMultivariatePolynomial(Integer,OrderedVariableList [x,y,z,t]) +--E 14 + +--S 15 of 23 +zeroSetSplit(lp)$ST +--R +--R +--R 5 4 2 3 8 5 3 2 4 2 +--R (15) [{z - t ,t z y + 2z y - t + 2t + t - t ,(t - t)x - t y - z }] +--RType: List SquareFreeRegularTriangularSet(Integer,IndexedExponents OrderedVariableList [x,y,z,t],OrderedVariableList [x,y,z,t],NewSparseMultivariatePolynomial(Integer,OrderedVariableList [x,y,z,t])) +--E 15 + +--S 16 of 23 +zeroSetSplit(lp,false)$ST +--R +--R +--R (16) +--R 5 4 2 3 8 5 3 2 4 2 +--R [{z - t ,t z y + 2z y - t + 2t + t - t ,(t - t)x - t y - z }, +--R 3 5 2 2 +--R {t - 1,z - t,t y + z ,z x - t}, {t,z,y,x}] +--RType: List SquareFreeRegularTriangularSet(Integer,IndexedExponents OrderedVariableList [x,y,z,t],OrderedVariableList [x,y,z,t],NewSparseMultivariatePolynomial(Integer,OrderedVariableList [x,y,z,t])) +--E 16 + +--S 17 of 23 +T := REGSET(R,E,V,P) +--R +--R +--R (17) +--R RegularTriangularSet(Integer,IndexedExponents OrderedVariableList [x,y,z,t],O +--R rderedVariableList [x,y,z,t],NewSparseMultivariatePolynomial(Integer,OrderedV +--R ariableList [x,y,z,t])) +--R Type: Domain +--E 17 + +--S 18 of 23 +lts := zeroSetSplit(lp,false)$T +--R +--R +--R (18) +--R 5 4 2 3 8 5 3 2 4 2 +--R [{z - t ,t z y + 2z y - t + 2t + t - t ,(t - t)x - t y - z }, +--R 3 5 2 3 2 +--R {t - 1,z - t,t z y + 2z y + 1,z x - t}, {t,z,y,x}] +--RType: List RegularTriangularSet(Integer,IndexedExponents OrderedVariableList [x,y,z,t],OrderedVariableList [x,y,z,t],NewSparseMultivariatePolynomial(Integer,OrderedVariableList [x,y,z,t])) +--E 18 + +--S 19 of 23 +ts := lts.2 +--R +--R +--R 3 5 2 3 2 +--R (19) {t - 1,z - t,t z y + 2z y + 1,z x - t} +--RType: RegularTriangularSet(Integer,IndexedExponents OrderedVariableList [x,y,z,t],OrderedVariableList [x,y,z,t],NewSparseMultivariatePolynomial(Integer,OrderedVariableList [x,y,z,t])) +--E 19 + +--S 20 of 23 +pol := select(ts,'y)$T +--R +--R +--R 2 3 +--R (20) t z y + 2z y + 1 +--RType: Union(NewSparseMultivariatePolynomial(Integer,OrderedVariableList [x,y,z,t]),...) +--E 20 + +--S 21 of 23 +tower := collectUnder(ts,'y)$T +--R +--R +--R 3 5 +--R (21) {t - 1,z - t} +--RType: RegularTriangularSet(Integer,IndexedExponents OrderedVariableList [x,y,z,t],OrderedVariableList [x,y,z,t],NewSparseMultivariatePolynomial(Integer,OrderedVariableList [x,y,z,t])) +--E 21 + +--S 22 of 23 +pack := RegularTriangularSetGcdPackage(R,E,V,P,T) +--R +--R +--R (22) +--R RegularTriangularSetGcdPackage(Integer,IndexedExponents OrderedVariableList [ +--R x,y,z,t],OrderedVariableList [x,y,z,t],NewSparseMultivariatePolynomial(Intege +--R r,OrderedVariableList [x,y,z,t]),RegularTriangularSet(Integer,IndexedExponent +--R s OrderedVariableList [x,y,z,t],OrderedVariableList [x,y,z,t],NewSparseMultiv +--R ariatePolynomial(Integer,OrderedVariableList [x,y,z,t]))) +--R Type: Domain +--E 22 + +--S 23 of 23 +toseSquareFreePart(pol,tower)$pack +--R +--R +--R 2 3 5 +--R (23) [[val= t y + z ,tower= {t - 1,z - t}]] +--RType: List Record(val: NewSparseMultivariatePolynomial(Integer,OrderedVariableList [x,y,z,t]),tower: RegularTriangularSet(Integer,IndexedExponents OrderedVariableList [x,y,z,t],OrderedVariableList [x,y,z,t],NewSparseMultivariatePolynomial(Integer,OrderedVariableList [x,y,z,t]))) +--E 23 +)spool +)lisp (bye) +@ +<>= +==================================================================== +SquareFreeRegularTriangularSet examples +==================================================================== + +The SquareFreeRegularTriangularSet domain constructor implements +square-free regular triangular sets. See the RegularTriangularSet +domain constructor for general regular triangular sets. Let T be a +regular triangular set consisting of polynomials t1, ..., tm ordered +by increasing main variables. The regular triangular set T is +square-free if T is empty or if t1, ..., tm-1 is square-free and if the +polynomial tm is square-free as a univariate polynomial with coefficients +in the tower of simple extensions associated with t1,...,tm-1. + +The main interest of square-free regular triangular sets is that their +associated towers of simple extensions are product of fields. +Consequently, the saturated ideal of a square-free regular triangular +set is radical. This property simplifies some of the operations +related to regular triangular sets. However, building square-free +regular triangular sets is generally more expensive than building +general regular triangular sets. + +As the RegularTriangularSet domain constructor, the +SquareFreeRegularTriangularSet domain constructor also implements a +method for solving polynomial systems by means of regular triangular +sets. This is in fact the same method with some adaptations to take +into account the fact that the computed regular chains are +square-free. Note that it is also possible to pass from a +decomposition into general regular triangular sets to a decomposition +into square-free regular triangular sets. This conversion is used +internally by the LazardSetSolvingPackage package constructor. + +N.B. When solving polynomial systems with the +SquareFreeRegularTriangularSet domain constructor or the +LazardSetSolvingPackage package constructor, decompositions have no +redundant components. See also LexTriangularPackage and +ZeroDimensionalSolvePackage for the case of algebraic systems with a +finite number of (complex) solutions. + +We shall explain now how to use the constructor SquareFreeRegularTriangularSet. + +This constructor takes four arguments. The first one, R, is the +coefficient ring of the polynomials; it must belong to the category +GcdDomain. The second one, E, is the exponent monoid of the +polynomials; it must belong to the category OrderedAbelianMonoidSup. +the third one, V, is the ordered set of variables; it must belong to +the category OrderedSet. The last one is the polynomial ring; it must +belong to the category RecursivePolynomialCategory(R,E,V). The +abbreviation for SquareFreeRegularTriangularSet} is SREGSET. + +Note that the way of understanding triangular decompositions +is detailed in the example of the RegularTriangularSet constructor. + +Let us illustrate the use of this constructor with one example +(Donati-Traverso). Define the coefficient ring. + + R := Integer + Integer + Type: Domain + +Define the list of variables, + + ls : List Symbol := [x,y,z,t] + [x,y,z,t] + Type: List Symbol + +and make it an ordered set; + + V := OVAR(ls) + OrderedVariableList [x,y,z,t] + Type: Domain + +then define the exponent monoid. + + E := IndexedExponents V + IndexedExponents OrderedVariableList [x,y,z,t] + Type: Domain + +Define the polynomial ring. + + P := NSMP(R, V) + NewSparseMultivariatePolynomial(Integer,OrderedVariableList [x,y,z,t]) + Type: Domain + +Let the variables be polynomial. + + x: P := 'x + x + Type: NewSparseMultivariatePolynomial(Integer, + OrderedVariableList [x,y,z,t]) + + y: P := 'y + y + Type: NewSparseMultivariatePolynomial(Integer, + OrderedVariableList [x,y,z,t]) + + z: P := 'z + z + Type: NewSparseMultivariatePolynomial(Integer, + OrderedVariableList [x,y,z,t]) + + t: P := 't + t + Type: NewSparseMultivariatePolynomial(Integer, + OrderedVariableList [x,y,z,t]) + +Now call the SquareFreeRegularTriangularSet domain constructor. + + ST := SREGSET(R,E,V,P) + SquareFreeRegularTriangularSet(Integer,IndexedExponents OrderedVariableList [ + x,y,z,t],OrderedVariableList [x,y,z,t],NewSparseMultivariatePolynomial(Intege + r,OrderedVariableList [x,y,z,t])) + Type: Domain + +Define a polynomial system. + + p1 := x ** 31 - x ** 6 - x - y + 31 6 + x - x - x - y + Type: NewSparseMultivariatePolynomial(Integer, + OrderedVariableList [x,y,z,t]) + + p2 := x ** 8 - z + 8 + x - z + Type: NewSparseMultivariatePolynomial(Integer, + OrderedVariableList [x,y,z,t]) + + p3 := x ** 10 - t + 10 + x - t + Type: NewSparseMultivariatePolynomial(Integer, + OrderedVariableList [x,y,z,t]) + + lp := [p1, p2, p3] + 31 6 8 10 + [x - x - x - y,x - z,x - t] + Type: List NewSparseMultivariatePolynomial(Integer, + OrderedVariableList [x,y,z,t]) + +First of all, let us solve this system in the sense of Kalkbrener. + + zeroSetSplit(lp)$ST + 5 4 2 3 8 5 3 2 4 2 + [{z - t ,t z y + 2z y - t + 2t + t - t ,(t - t)x - t y - z }] + Type: List SquareFreeRegularTriangularSet(Integer, + IndexedExponents OrderedVariableList [x,y,z,t], + OrderedVariableList [x,y,z,t], + NewSparseMultivariatePolynomial(Integer, + OrderedVariableList [x,y,z,t])) + +And now in the sense of Lazard (or Wu and other authors). + + zeroSetSplit(lp,false)$ST + 5 4 2 3 8 5 3 2 4 2 + [{z - t ,t z y + 2z y - t + 2t + t - t ,(t - t)x - t y - z }, + 3 5 2 2 + {t - 1,z - t,t y + z ,z x - t}, {t,z,y,x}] + Type: List SquareFreeRegularTriangularSet(Integer, + IndexedExponents OrderedVariableList [x,y,z,t], + OrderedVariableList [x,y,z,t], + NewSparseMultivariatePolynomial(Integer, + OrderedVariableList [x,y,z,t])) + +Now to see the difference with the RegularTriangularSet domain +constructor, we define: + + T := REGSET(R,E,V,P) + RegularTriangularSet(Integer,IndexedExponents OrderedVariableList [x,y,z,t],O + rderedVariableList [x,y,z,t],NewSparseMultivariatePolynomial(Integer,OrderedV + ariableList [x,y,z,t])) + Type: Domain + +and compute: + + lts := zeroSetSplit(lp,false)$T + 5 4 2 3 8 5 3 2 4 2 + [{z - t ,t z y + 2z y - t + 2t + t - t ,(t - t)x - t y - z }, + 3 5 2 3 2 + {t - 1,z - t,t z y + 2z y + 1,z x - t}, {t,z,y,x}] + Type: List RegularTriangularSet(Integer, + IndexedExponents OrderedVariableList [x,y,z,t], + OrderedVariableList [x,y,z,t], + NewSparseMultivariatePolynomial(Integer, + OrderedVariableList [x,y,z,t])) + +If you look at the second set in both decompositions in the sense of Lazard, +you will see that the polynomial with main variable y is not the same. + +Let us understand what has happened. + +We define: + + ts := lts.2 + 3 5 2 3 2 + (19) {t - 1,z - t,t z y + 2z y + 1,z x - t} + Type: RegularTriangularSet(Integer, + IndexedExponents OrderedVariableList [x,y,z,t], + OrderedVariableList [x,y,z,t], + NewSparseMultivariatePolynomial(Integer, + OrderedVariableList [x,y,z,t])) + + pol := select(ts,'y)$T + 2 3 + t z y + 2z y + 1 + Type: Union(NewSparseMultivariatePolynomial(Integer, + OrderedVariableList [x,y,z,t]),...) + + tower := collectUnder(ts,'y)$T + 3 5 + {t - 1,z - t} + Type: RegularTriangularSet(Integer, + IndexedExponents OrderedVariableList [x,y,z,t], + OrderedVariableList [x,y,z,t], + NewSparseMultivariatePolynomial(Integer, + OrderedVariableList [x,y,z,t])) + + pack := RegularTriangularSetGcdPackage(R,E,V,P,T) + RegularTriangularSetGcdPackage(Integer,IndexedExponents OrderedVariableList [ + x,y,z,t],OrderedVariableList [x,y,z,t],NewSparseMultivariatePolynomial(Intege + r,OrderedVariableList [x,y,z,t]),RegularTriangularSet(Integer,IndexedExponent + s OrderedVariableList [x,y,z,t],OrderedVariableList [x,y,z,t],NewSparseMultiv + ariatePolynomial(Integer,OrderedVariableList [x,y,z,t]))) + Type: Domain + +Then we compute: + + toseSquareFreePart(pol,tower)$pack + 2 3 5 + [[val= t y + z ,tower= {t - 1,z - t}]] + Type: List Record(val: NewSparseMultivariatePolynomial(Integer, + OrderedVariableList [x,y,z,t]), + tower: RegularTriangularSet(Integer, + IndexedExponents OrderedVariableList [x,y,z,t], + OrderedVariableList [x,y,z,t], + NewSparseMultivariatePolynomial(Integer, + OrderedVariableList [x,y,z,t]))) + +See Also: +o )help GcdDomain +o )help OrderedAbelianMonoidSup +o )help OrderedSet +o )help RecursivePolynomialCategory +o )help ZeroDimensionalSolvePackage +o )help LexTriangularPackage +o )help LazardSetSolvingPackage +o )help RegularTriangularSet +o )show SquareFreeRegularTriangularSet +o $AXIOM/doc/src/algebra/sregset.spad.dvi + +@ +\pagehead{SquareFreeRegularTriangularSet}{SREGSET} +\pagepic{ps/v103squarefreeregulartriangularset.ps}{SREGSET}{1.00} +<>= +)abbrev domain SREGSET SquareFreeRegularTriangularSet +++ Author: Marc Moreno Maza +++ Date Created: 08/25/1998 +++ Date Last Updated: 16/12/1998 +++ Basic Functions: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ Description: +++ This domain provides an implementation of square-free regular chains. +++ Moreover, the operation \axiomOpFrom{zeroSetSplit}{SquareFreeRegularTriangularSetCategory} +++ is an implementation of a new algorithm for solving polynomial systems by +++ means of regular chains.\newline +++ References : +++ [1] M. MORENO MAZA "A new algorithm for computing triangular +++ decomposition of algebraic varieties" NAG Tech. Rep. 4/98. +++ Version: 2 + +SquareFreeRegularTriangularSet(R,E,V,P) : Exports == Implementation where + + R : GcdDomain + E : OrderedAbelianMonoidSup + V : OrderedSet + P : RecursivePolynomialCategory(R,E,V) + N ==> NonNegativeInteger + Z ==> Integer + B ==> Boolean + LP ==> List P + PtoP ==> P -> P + PS ==> GeneralPolynomialSet(R,E,V,P) + PWT ==> Record(val : P, tower : $) + BWT ==> Record(val : Boolean, tower : $) + LpWT ==> Record(val : (List P), tower : $) + Split ==> List $ + iprintpack ==> InternalPrintPackage() + polsetpack ==> PolynomialSetUtilitiesPackage(R,E,V,P) + quasicomppack ==> SquareFreeQuasiComponentPackage(R,E,V,P,$) + regsetgcdpack ==> SquareFreeRegularTriangularSetGcdPackage(R,E,V,P,$) + regsetdecomppack ==> SquareFreeRegularSetDecompositionPackage(R,E,V,P,$) + + Exports == SquareFreeRegularTriangularSetCategory(R,E,V,P) with + + internalAugment: (P,$,B,B,B,B,B) -> List $ + ++ \axiom{internalAugment(p,ts,b1,b2,b3,b4,b5)} + ++ is an internal subroutine, exported only for developement. + zeroSetSplit: (LP, B, B) -> Split + ++ \axiom{zeroSetSplit(lp,clos?,info?)} has the same specifications as + ++ \axiomOpFrom{zeroSetSplit}{RegularTriangularSetCategory} + ++ from \spadtype{RegularTriangularSetCategory} + ++ Moreover, if \axiom{clos?} then solves in the sense of the Zariski closure + ++ else solves in the sense of the regular zeros. If \axiom{info?} then + ++ do print messages during the computations. + zeroSetSplit: (LP, B, B, B, B) -> Split + ++ \axiom{zeroSetSplit(lp,b1,b2.b3,b4)} + ++ is an internal subroutine, exported only for developement. + internalZeroSetSplit: (LP, B, B, B) -> Split + ++ \axiom{internalZeroSetSplit(lp,b1,b2,b3)} + ++ is an internal subroutine, exported only for developement. + pre_process: (LP, B, B) -> Record(val: LP, towers: Split) + ++ \axiom{pre_process(lp,b1,b2)} + ++ is an internal subroutine, exported only for developement. + + Implementation == add + + Rep ==> LP + + rep(s:$):Rep == s pretend Rep + per(l:Rep):$ == l pretend $ + + copy ts == + per(copy(rep(ts))$LP) + empty() == + per([]) + empty?(ts:$) == + empty?(rep(ts)) + parts ts == + rep(ts) + members ts == + rep(ts) + map (f : PtoP, ts : $) : $ == + construct(map(f,rep(ts))$LP)$$ + map! (f : PtoP, ts : $) : $ == + construct(map!(f,rep(ts))$LP)$$ + member? (p,ts) == + member?(p,rep(ts))$LP + unitIdealIfCan() == + "failed"::Union($,"failed") + roughUnitIdeal? ts == + false + coerce(ts:$) : OutputForm == + lp : List(P) := reverse(rep(ts)) + brace([p::OutputForm for p in lp]$List(OutputForm))$OutputForm + mvar ts == + empty? ts => error "mvar$SREGSET: #1 is empty" + mvar(first(rep(ts)))$P + first ts == + empty? ts => "failed"::Union(P,"failed") + first(rep(ts))::Union(P,"failed") + last ts == + empty? ts => "failed"::Union(P,"failed") + last(rep(ts))::Union(P,"failed") + rest ts == + empty? ts => "failed"::Union($,"failed") + per(rest(rep(ts)))::Union($,"failed") + coerce(ts:$) : (List P) == + rep(ts) + + collectUpper (ts,v) == + empty? ts => ts + lp := rep(ts) + newlp : Rep := [] + while (not empty? lp) and (mvar(first(lp)) > v) repeat + newlp := cons(first(lp),newlp) + lp := rest lp + per(reverse(newlp)) + + collectUnder (ts,v) == + empty? ts => ts + lp := rep(ts) + while (not empty? lp) and (mvar(first(lp)) >= v) repeat + lp := rest lp + per(lp) + + construct(lp:List(P)) == + ts : $ := per([]) + empty? lp => ts + lp := sort(infRittWu?,lp) + while not empty? lp repeat + eif := extendIfCan(ts,first(lp)) + not (eif case $) => + error"in construct : List P -> $ from SREGSET : bad #1" + ts := eif::$ + lp := rest lp + ts + + extendIfCan(ts:$,p:P) == + ground? p => "failed"::Union($,"failed") + empty? ts => + p := squareFreePart primitivePart p + (per([p]))::Union($,"failed") + not (mvar(ts) < mvar(p)) => "failed"::Union($,"failed") + invertible?(init(p),ts)@Boolean => + lts: Split := augment(p,ts) + #lts ~= 1 => "failed"::Union($,"failed") + (first lts)::Union($,"failed") + "failed"::Union($,"failed") + + removeZero(p:P, ts:$): P == + (ground? p) or (empty? ts) => p + v := mvar(p) + ts_v_- := collectUnder(ts,v) + if algebraic?(v,ts) + then + q := lazyPrem(p,select(ts,v)::P) + zero? q => return q + zero? removeZero(q,ts_v_-) => return 0 + empty? ts_v_- => p + q: P := 0 + while positive? degree(p,v) repeat + q := removeZero(init(p),ts_v_-) * mainMonomial(p) + q + p := tail(p) + q + removeZero(p,ts_v_-) + + internalAugment(p:P,ts:$): $ == + -- ASSUME that adding p to ts DOES NOT require any split + ground? p => error "in internalAugment$SREGSET: ground? #1" + first(internalAugment(p,ts,false,false,false,false,false)) + + internalAugment(lp:List(P),ts:$): $ == + -- ASSUME that adding p to ts DOES NOT require any split + empty? lp => ts + internalAugment(rest lp, internalAugment(first lp, ts)) + + internalAugment(p:P,ts:$,rem?:B,red?:B,prim?:B,sqfr?:B,extend?:B): Split == + -- ASSUME p is not a constant + -- ASSUME mvar(p) is not algebraic w.r.t. ts + -- ASSUME init(p) invertible modulo ts + -- if rem? then REDUCE p by remainder + -- if prim? then REPLACE p by its main primitive part + -- if sqfr? then FACTORIZE SQUARE FREE p over R + -- if extend? DO NOT ASSUME every pol in ts_v_+ is invertible modulo ts + v := mvar(p) + ts_v_- := collectUnder(ts,v) + ts_v_+ := collectUpper(ts,v) + if rem? then p := remainder(p,ts_v_-).polnum + -- if rem? then p := reduceByQuasiMonic(p,ts_v_-) + if red? then p := removeZero(p,ts_v_-) + if prim? then p := mainPrimitivePart p + lts: Split + if sqfr? + then + lts: Split := [] + lsfp := squareFreeFactors(p)$polsetpack + for f in lsfp repeat + (ground? f) or (mvar(f) < v) => "leave" + lpwt := squareFreePart(f,ts_v_-) + for pwt in lpwt repeat + sfp := pwt.val; us := pwt.tower + lts := cons( per(cons(pwt.val, rep(pwt.tower))), lts) + else + lts: Split := [per(cons(p,rep(ts_v_-)))] + extend? => extend(members(ts_v_+),lts) + [per(concat(rep(ts_v_+),rep(us))) for us in lts] + + augment(p:P,ts:$): List $ == + ground? p => error "in augment$SREGSET: ground? #1" + algebraic?(mvar(p),ts) => error "in augment$SREGSET: bad #1" + -- ASSUME init(p) invertible modulo ts + -- DOES NOT ASSUME anything else. + -- THUS reduction, mainPrimitivePart and squareFree are NEEDED + internalAugment(p,ts,true,true,true,true,true) + + extend(p:P,ts:$): List $ == + ground? p => error "in extend$SREGSET: ground? #1" + v := mvar(p) + not (mvar(ts) < mvar(p)) => error "in extend$SREGSET: bad #1" + split: List($) := invertibleSet(init(p),ts) + lts: List($) := [] + for us in split repeat + lts := concat(augment(p,us),lts) + lts + + invertible?(p:P,ts:$): Boolean == + stoseInvertible?(p,ts)$regsetgcdpack + + invertible?(p:P,ts:$): List BWT == + stoseInvertible?_sqfreg(p,ts)$regsetgcdpack + + invertibleSet(p:P,ts:$): Split == + stoseInvertibleSet_sqfreg(p,ts)$regsetgcdpack + + lastSubResultant(p1:P,p2:P,ts:$): List PWT == + stoseLastSubResultant(p1,p2,ts)$regsetgcdpack + + squareFreePart(p:P, ts: $): List PWT == + stoseSquareFreePart(p,ts)$regsetgcdpack + + intersect(p:P, ts: $): List($) == decompose([p], [ts], false, false)$regsetdecomppack + + intersect(lp: LP, lts: List($)): List($) == decompose(lp, lts, false, false)$regsetdecomppack + -- SOLVE in the regular zero sense + -- and DO NOT PRINT info + + decompose(p:P, ts: $): List($) == decompose([p], [ts], true, false)$regsetdecomppack + + decompose(lp: LP, lts: List($)): List($) == decompose(lp, lts, true, false)$regsetdecomppack + -- SOLVE in the closure sense + -- and DO NOT PRINT info + + zeroSetSplit(lp:List(P)) == zeroSetSplit(lp,true,false) + -- by default SOLVE in the closure sense + -- and DO NOT PRINT info + + zeroSetSplit(lp:List(P), clos?: B) == zeroSetSplit(lp,clos?, false) + + zeroSetSplit(lp:List(P), clos?: B, info?: B) == + -- if clos? then SOLVE in the closure sense + -- if info? then PRINT info + -- by default USE hash-tables + -- and PREPROCESS the input system + zeroSetSplit(lp,true,clos?,info?,true) + + zeroSetSplit(lp:List(P),hash?:B,clos?:B,info?:B,prep?:B) == + -- if hash? then USE hash-tables + -- if info? then PRINT information + -- if clos? then SOLVE in the closure sense + -- if prep? then PREPROCESS the input system + if hash? + then + s1, s2, s3, dom1, dom2, dom3: String + e: String := empty()$String + if info? then (s1,s2,s3) := ("w","g","i") else (s1,s2,s3) := (e,e,e) + if info? + then + (dom1, dom2, dom3) := ("QCMPACK", "REGSETGCD: Gcd", "REGSETGCD: Inv Set") + else + (dom1, dom2, dom3) := (e,e,e) + startTable!(s1,"W",dom1)$quasicomppack + startTableGcd!(s2,"G",dom2)$regsetgcdpack + startTableInvSet!(s3,"I",dom3)$regsetgcdpack + lts := internalZeroSetSplit(lp,clos?,info?,prep?) + if hash? + then + stopTable!()$quasicomppack + stopTableGcd!()$regsetgcdpack + stopTableInvSet!()$regsetgcdpack + lts + + internalZeroSetSplit(lp:LP,clos?:B,info?:B,prep?:B) == + -- if info? then PRINT information + -- if clos? then SOLVE in the closure sense + -- if prep? then PREPROCESS the input system + if prep? + then + pp := pre_process(lp,clos?,info?) + lp := pp.val + lts := pp.towers + else + ts: $ := [[]] + lts := [ts] + lp := remove(zero?, lp) + any?(ground?, lp) => [] + empty? lp => lts + empty? lts => lts + lp := sort(infRittWu?,lp) + clos? => decompose(lp,lts, clos?, info?)$regsetdecomppack + -- IN DIM > 0 with clos? the following is not false ... + for p in lp repeat + lts := decompose([p],lts, clos?, info?)$regsetdecomppack + lts + + largeSystem?(lp:LP): Boolean == + -- Gonnet and Gerdt and not Wu-Wang.2 + #lp > 16 => true + #lp < 13 => false + lts: List($) := [] + (#lp :: Z - numberOfVariables(lp,lts)$regsetdecomppack :: Z) > 3 + + smallSystem?(lp:LP): Boolean == + -- neural, Vermeer, Liu, and not f-633 and not Hairer-2 + #lp < 5 + + mediumSystem?(lp:LP): Boolean == + -- f-633 and not Hairer-2 + lts: List($) := [] + (numberOfVariables(lp,lts)$regsetdecomppack :: Z - #lp :: Z) < 2 + +-- lin?(p:P):Boolean == ground?(init(p)) and one?(mdeg(p)) + lin?(p:P):Boolean == ground?(init(p)) and (mdeg(p) = 1) + + pre_process(lp:LP,clos?:B,info?:B): Record(val: LP, towers: Split) == + -- if info? then PRINT information + -- if clos? then SOLVE in the closure sense + ts: $ := [[]]; + lts: Split := [ts] + empty? lp => [lp,lts] + lp1: List P := [] + lp2: List P := [] + for p in lp repeat + ground? (tail p) => lp1 := cons(p, lp1) + lp2 := cons(p, lp2) + lts: Split := decompose(lp1,[ts],clos?,info?)$regsetdecomppack + probablyZeroDim?(lp)$polsetpack => + largeSystem?(lp) => return [lp2,lts] + if #lp > 7 + then + -- Butcher (8,8) + Wu-Wang.2 (13,16) + lp2 := crushedSet(lp2)$polsetpack + lp2 := remove(zero?,lp2) + any?(ground?,lp2) => return [lp2, lts] + lp3 := [p for p in lp2 | lin?(p)] + lp4 := [p for p in lp2 | not lin?(p)] + if clos? + then + lts := decompose(lp4,lts, clos?, info?)$regsetdecomppack + else + lp4 := sort(infRittWu?,lp4) + for p in lp4 repeat + lts := decompose([p],lts, clos?, info?)$regsetdecomppack + lp2 := lp3 + else + lp2 := crushedSet(lp2)$polsetpack + lp2 := remove(zero?,lp2) + any?(ground?,lp2) => return [lp2, lts] + if clos? + then + lts := decompose(lp2,lts, clos?, info?)$regsetdecomppack + else + lp2 := sort(infRittWu?,lp2) + for p in lp2 repeat + lts := decompose([p],lts, clos?, info?)$regsetdecomppack + lp2 := [] + return [lp2,lts] + smallSystem?(lp) => [lp2,lts] + mediumSystem?(lp) => [crushedSet(lp2)$polsetpack,lts] + lp3 := [p for p in lp2 | lin?(p)] + lp4 := [p for p in lp2 | not lin?(p)] + if clos? + then + lts := decompose(lp4,lts, clos?, info?)$regsetdecomppack + else + lp4 := sort(infRittWu?,lp4) + for p in lp4 repeat + lts := decompose([p],lts, clos?, info?)$regsetdecomppack + if clos? + then + lts := decompose(lp3,lts, clos?, info?)$regsetdecomppack + else + lp3 := sort(infRittWu?,lp3) + for p in lp3 repeat + lts := decompose([p],lts, clos?, info?)$regsetdecomppack + lp2 := [] + return [lp2,lts] + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{domain SQMATRIX SquareMatrix} <>= -- matrix.spad.pamphlet SquareMatrix.input @@ -61687,6 +67337,1398 @@ Stack(S:SetCategory): StackAggregate S with @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain STREAM Stream} +<>= +-- stream.spad.pamphlet Stream.input +)spool Stream.output +)set message test on +)set message auto off +)clear all +--S 1 of 12 +ints := [i for i in 0..] +--R +--R +--R (1) [0,1,2,3,4,5,6,7,8,9,...] +--R Type: Stream NonNegativeInteger +--E 1 + +--S 2 of 12 +f : List INT -> List INT +--R +--R Type: Void +--E 2 + +--S 3 of 12 +f x == [x.1 + x.2, x.1] +--R +--R Type: Void +--E 3 + +--S 4 of 12 +fibs := [i.2 for i in [generate(f,[1,1])]] +--R +--R Compiling function f with type List Integer -> List Integer +--R +--R (4) [1,1,2,3,5,8,13,21,34,55,...] +--R Type: Stream Integer +--E 4 + +--S 5 of 12 +[i for i in ints | odd? i] +--R +--R +--R (5) [1,3,5,7,9,11,13,15,17,19,...] +--R Type: Stream NonNegativeInteger +--E 5 + +--S 6 of 12 +odds := [2*i+1 for i in ints] +--R +--R +--R (6) [1,3,5,7,9,11,13,15,17,19,...] +--R Type: Stream NonNegativeInteger +--E 6 + +--S 7 of 12 +scan(0,+,odds) +--R +--R +--R (7) [1,4,9,16,25,36,49,64,81,100,...] +--R Type: Stream NonNegativeInteger +--E 7 + +--S 8 of 12 +[i*j for i in ints for j in odds] +--R +--R +--R (8) [0,3,10,21,36,55,78,105,136,171,...] +--R Type: Stream NonNegativeInteger +--E 8 + +--S 9 of 12 +map(*,ints,odds) +--R +--R +--R (9) [0,3,10,21,36,55,78,105,136,171,...] +--R Type: Stream NonNegativeInteger +--E 9 + +--S 10 of 12 +first ints +--R +--R +--R (10) 0 +--R Type: NonNegativeInteger +--E 10 + +--S 11 of 12 +rest ints +--R +--R +--R (11) [1,2,3,4,5,6,7,8,9,10,...] +--R Type: Stream NonNegativeInteger +--E 11 + +--S 12 of 12 +fibs 20 +--R +--R +--R (12) 6765 +--R Type: PositiveInteger +--E 12 +)spool +)lisp (bye) +@ +<>= +==================================================================== +Stream examples +==================================================================== + +A Stream object is represented as a list whose last element contains +the wherewithal to create the next element, should it ever be required. + +Let ints be the infinite stream of non-negative integers. + + ints := [i for i in 0..] + [0,1,2,3,4,5,6,7,8,9,...] + Type: Stream NonNegativeInteger + +By default, ten stream elements are calculated. This number may be +changed to something else by the system command + )set streams calculate + +More generally, you can construct a stream by specifying its initial +value and a function which, when given an element, creates the next element. + + f : List INT -> List INT + Type: Void + + f x == [x.1 + x.2, x.1] + Type: Void + + fibs := [i.2 for i in [generate(f,[1,1])]] + [1,1,2,3,5,8,13,21,34,55,...] + Type: Stream Integer + +You can create the stream of odd non-negative integers by either filtering +them from the integers, or by evaluating an expression for each integer. + + [i for i in ints | odd? i] + [1,3,5,7,9,11,13,15,17,19,...] + Type: Stream NonNegativeInteger + + odds := [2*i+1 for i in ints] + [1,3,5,7,9,11,13,15,17,19,...] + Type: Stream NonNegativeInteger + +You can accumulate the initial segments of a stream using the scan operation. + + scan(0,+,odds) + [1,4,9,16,25,36,49,64,81,100,...] + Type: Stream NonNegativeInteger + +The corresponding elements of two or more streams can be combined in this way. + + [i*j for i in ints for j in odds] + [0,3,10,21,36,55,78,105,136,171,...] + Type: Stream NonNegativeInteger + + map(*,ints,odds) + [0,3,10,21,36,55,78,105,136,171,...] + Type: Stream NonNegativeInteger + +Many operations similar to those applicable to lists are available for +streams. + + first ints + 0 + Type: NonNegativeInteger + + rest ints + [1,2,3,4,5,6,7,8,9,10,...] + Type: Stream NonNegativeInteger + + fibs 20 + 6765 + Type: PositiveInteger + +See Also: +o )help StreamFunctions1 +o )help StreamFunctions2 +o )help StreamFunctions3 +o )show Stream +o $AXIOM/doc/src/algebra/stream.spad.dvi + +@ +\pagehead{Stream}{STREAM} +\pagepic{ps/v103stream.ps}{STREAM}{1.00} +<>= +)abbrev domain STREAM Stream +++ Implementation of streams via lazy evaluation +++ Authors: Burge, Watt; updated by Clifton J. Williamson +++ Date Created: July 1986 +++ Date Last Updated: 30 March 1990 +++ Keywords: stream, infinite list, infinite sequence +++ Examples: +++ References: +++ Description: +++ A stream is an implementation of an infinite sequence using +++ a list of terms that have been computed and a function closure +++ to compute additional terms when needed. + +Stream(S): Exports == Implementation where +-- problems: +-- 1) dealing with functions which basically want a finite structure +-- 2) 'map' doesn't deal with cycles very well + + S : Type + B ==> Boolean + OUT ==> OutputForm + I ==> Integer + L ==> List + NNI ==> NonNegativeInteger + U ==> UniversalSegment I + + Exports ==> LazyStreamAggregate(S) with + shallowlyMutable + ++ one may destructively alter a stream by assigning new + ++ values to its entries. + + coerce: L S -> % + ++ coerce(l) converts a list l to a stream. + ++ + ++X m:=[1,2,3,4,5,6,7,8,9,10,11,12] + ++X coerce(m)@Stream(Integer) + ++X m::Stream(Integer) + + repeating: L S -> % + ++ repeating(l) is a repeating stream whose period is the list l. + ++ + ++X m:=repeating([-1,0,1,2,3]) + + if S has SetCategory then + repeating?: (L S,%) -> B + ++ repeating?(l,s) returns true if a stream s is periodic + ++ with period l, and false otherwise. + ++ + ++X m:=[1,2,3] + ++X n:=repeating(m) + ++X repeating?(m,n) + + findCycle: (NNI,%) -> Record(cycle?: B, prefix: NNI, period: NNI) + ++ findCycle(n,st) determines if st is periodic within n. + ++ + ++X m:=[1,2,3] + ++X n:=repeating(m) + ++X findCycle(3,n) + ++X findCycle(2,n) + + delay: (() -> %) -> % + ++ delay(f) creates a stream with a lazy evaluation defined by + ++ function f. + ++ Caution: This function can only be called in compiled code. + cons: (S,%) -> % + ++ cons(a,s) returns a stream whose \spad{first} is \spad{a} + ++ and whose \spad{rest} is s. + ++ Note: \spad{cons(a,s) = concat(a,s)}. + ++ + ++X m:=[1,2,3] + ++X n:=repeating(m) + ++X cons(4,n) + + if S has SetCategory then + output: (I, %) -> Void + ++ output(n,st) computes and displays the first n entries + ++ of st. + ++ + ++X m:=[1,2,3] + ++X n:=repeating(m) + ++X output(5,n) + + showAllElements: % -> OUT + ++ showAllElements(s) creates an output form which displays all + ++ computed elements. + ++ + ++X m:=[1,2,3,4,5,6,7,8,9,10,11,12] + ++X n:=m::Stream(PositiveInteger) + ++X showAllElements n + + showAll?: () -> B + ++ showAll?() returns true if all computed entries of streams + ++ will be displayed. + --!! this should be a function of one argument + setrest_!: (%,I,%) -> % + ++ setrest!(x,n,y) sets rest(x,n) to y. The function will expand + ++ cycles if necessary. + ++ + ++X p:=[i for i in 1..] + ++X q:=[i for i in 9..] + ++X setrest!(p,4,q) + ++X p + + generate: (() -> S) -> % + ++ generate(f) creates an infinite stream all of whose elements are + ++ equal to \spad{f()}. + ++ Note: \spad{generate(f) = [f(),f(),f(),...]}. + ++ + ++X f():Integer == 1 + ++X generate(f) + + generate: (S -> S,S) -> % + ++ generate(f,x) creates an infinite stream whose first element is + ++ x and whose nth element (\spad{n > 1}) is f applied to the previous + ++ element. Note: \spad{generate(f,x) = [x,f(x),f(f(x)),...]}. + ++ + ++X f(x:Integer):Integer == x+10 + ++X generate(f,10) + + filterWhile: (S -> Boolean,%) -> % + ++ filterWhile(p,s) returns \spad{[x0,x1,...,x(n-1)]} where + ++ \spad{s = [x0,x1,x2,..]} and + ++ n is the smallest index such that \spad{p(xn) = false}. + ++ + ++X m:=[i for i in 1..] + ++X f(x:PositiveInteger):Boolean == x < 5 + ++X filterWhile(f,m) + + filterUntil: (S -> Boolean,%) -> % + ++ filterUntil(p,s) returns \spad{[x0,x1,...,x(n)]} where + ++ \spad{s = [x0,x1,x2,..]} and + ++ n is the smallest index such that \spad{p(xn) = true}. + ++ + ++X m:=[i for i in 1..] + ++X f(x:PositiveInteger):Boolean == x < 5 + ++X filterUntil(f,m) + +-- if S has SetCategory then +-- map: ((S,S) -> S,%,%,S) -> % +-- ++ map(f,x,y,a) is equivalent to map(f,x,y) +-- ++ If z = map(f,x,y,a), then z = map(f,x,y) except if +-- ++ x.n = a and rest(rest(x,n)) = rest(x,n) in which case +-- ++ rest(z,n) = rest(y,n) or if y.m = a and rest(rest(y,m)) = +-- ++ rest(y,m) in which case rest(z,n) = rest(x,n). +-- ++ Think of the case where f(xi,yi) = xi + yi and a = 0. + + Implementation ==> add + MIN ==> 1 -- minimal stream index; see also the defaults in LZSTAGG + x:% + + import CyclicStreamTools(S,%) + +--% representation + + -- This description of the rep is not quite true. + -- The Rep is a pair of one of three forms: + -- [value: S, rest: %] + -- [nullstream: Magic, NIL ] + -- [nonnullstream: Magic, fun: () -> %] + -- Could use a record of unions if we could guarantee no tags. + + NullStream: S := _$NullStream$Lisp pretend S + NonNullStream: S := _$NonNullStream$Lisp pretend S + + Rep := Record(firstElt: S, restOfStream: %) + + explicitlyEmpty? x == EQ(frst x,NullStream)$Lisp + lazy? x == EQ(frst x,NonNullStream)$Lisp + +--% signatures of local functions + + setfrst_! : (%,S) -> S + setrst_! : (%,%) -> % + setToNil_! : % -> % + setrestt_! : (%,I,%) -> % + lazyEval : % -> % + expand_! : (%,I) -> % + +--% functions to access or change record fields without lazy evaluation + + frst x == x.firstElt + rst x == x.restOfStream + + setfrst_!(x,s) == x.firstElt := s + setrst_!(x,y) == x.restOfStream := y + + setToNil_! x == + -- destructively changes x to a null stream + setfrst_!(x,NullStream); setrst_!(x,NIL$Lisp) + x + +--% SETCAT functions + + if S has SetCategory then + + getm : (%,L OUT,I) -> L OUT + streamCountCoerce : % -> OUT + listm : (%,L OUT,I) -> L OUT + + getm(x,le,n) == + explicitlyEmpty? x => le + lazy? x => + n > 0 => + empty? x => le + getm(rst x,concat(frst(x) :: OUT,le),n - 1) + concat(message("..."),le) + eq?(x,rst x) => concat(overbar(frst(x) :: OUT),le) + n > 0 => getm(rst x,concat(frst(x) :: OUT,le),n - 1) + concat(message("..."),le) + + streamCountCoerce x == + -- this will not necessarily display all stream elements + -- which have been computed + count := _$streamCount$Lisp + -- compute count elements + y := x + for i in 1..count while not empty? y repeat y := rst y + fc := findCycle(count,x) + not fc.cycle? => bracket reverse_! getm(x,empty(),count) + le : L OUT := empty() + for i in 1..fc.prefix repeat + le := concat(first(x) :: OUT,le) + x := rest x + pp : OUT := + fc.period = 1 => overbar(frst(x) :: OUT) + pl : L OUT := empty() + for i in 1..fc.period repeat + pl := concat(frst(x) :: OUT,pl) + x := rest x + overbar commaSeparate reverse_! pl + bracket reverse_! concat(pp,le) + + listm(x,le,n) == + explicitlyEmpty? x => le + lazy? x => + n > 0 => + empty? x => le + listm(rst x, concat(frst(x) :: OUT,le),n-1) + concat(message("..."),le) + listm(rst x,concat(frst(x) :: OUT,le),n-1) + + showAllElements x == + -- this will display all stream elements which have been computed + -- and will display at least n elements with n = streamCount$Lisp + extend(x,_$streamCount$Lisp) + cycElt := cycleElt x + cycElt case "failed" => + le := listm(x,empty(),_$streamCount$Lisp) + bracket reverse_! le + cycEnt := computeCycleEntry(x,cycElt :: %) + le : L OUT := empty() + while not eq?(x,cycEnt) repeat + le := concat(frst(x) :: OUT,le) + x := rst x + len := computeCycleLength(cycElt :: %) + pp : OUT := + len = 1 => overbar(frst(x) :: OUT) + pl : L OUT := [] + for i in 1..len repeat + pl := concat(frst(x) :: OUT,pl) + x := rst x + overbar commaSeparate reverse_! pl + bracket reverse_! concat(pp,le) + + showAll?() == + NULL(_$streamsShowAll$Lisp)$Lisp => false + true + + coerce(x):OUT == + showAll?() => showAllElements x + streamCountCoerce x + +--% AGG functions + + lazyCopy:% -> % + lazyCopy x == delay + empty? x => empty() + concat(frst x, copy rst x) + + copy x == + cycElt := cycleElt x + cycElt case "failed" => lazyCopy x + ce := cycElt :: % + len := computeCycleLength(ce) + e := computeCycleEntry(x,ce) + d := distance(x,e) + cycle := complete first(e,len) + setrst_!(tail cycle,cycle) + d = 0 => cycle + head := complete first(x,d::NNI) + setrst_!(tail head,cycle) + head + +--% CNAGG functions + + construct l == + -- copied from defaults to avoid loading defaults + empty? l => empty() + concat(first l, construct rest l) + +--% ELTAGG functions + + elt(x:%,n:I) == + -- copied from defaults to avoid loading defaults + n < MIN or empty? x => error "elt: no such element" + n = MIN => frst x + elt(rst x,n - 1) + + seteltt:(%,I,S) -> S + seteltt(x,n,s) == + n = MIN => setfrst_!(x,s) + seteltt(rst x,n - 1,s) + + setelt(x,n:I,s:S) == + n < MIN or empty? x => error "setelt: no such element" + x := expand_!(x,n - MIN + 1) + seteltt(x,n,s) + +--% IXAGG functions + + removee: ((S -> Boolean),%) -> % + removee(p,x) == delay + empty? x => empty() + p(frst x) => remove(p,rst x) + concat(frst x,remove(p,rst x)) + + remove(p,x) == + explicitlyEmpty? x => empty() + eq?(x,rst x) => + p(frst x) => empty() + x + removee(p,x) + + selectt: ((S -> Boolean),%) -> % + selectt(p,x) == delay + empty? x => empty() + not p(frst x) => select(p, rst x) + concat(frst x,select(p,rst x)) + + select(p,x) == + explicitlyEmpty? x => empty() + eq?(x,rst x) => + p(frst x) => x + empty() + selectt(p,x) + + map(f,x) == + map(f,x pretend Stream(S))$StreamFunctions2(S,S) pretend % + + map(g,x,y) == + xs := x pretend Stream(S); ys := y pretend Stream(S) + map(g,xs,ys)$StreamFunctions3(S,S,S) pretend % + + fill_!(x,s) == + setfrst_!(x,s) + setrst_!(x,x) + + map_!(f,x) == + -- too many problems with map_! on a lazy stream, so + -- in this case, an error message is returned + cyclic? x => + tail := cycleTail x ; y := x + until y = tail repeat + setfrst_!(y,f frst y) + y := rst y + x + explicitlyFinite? x => + y := x + while not empty? y repeat + setfrst_!(y,f frst y) + y := rst y + x + error "map!: stream with lazy evaluation" + + swap_!(x,m,n) == + (not index?(m,x)) or (not index?(n,x)) => + error "swap!: no such elements" + x := expand_!(x,max(m,n) - MIN + 1) + xm := elt(x,m); xn := elt(x,n) + setelt(x,m,xn); setelt(x,n,xm) + x + +--% LNAGG functions + + concat(x:%,s:S) == delay + empty? x => concat(s,empty()) + concat(frst x,concat(rst x,s)) + + concat(x:%,y:%) == delay + empty? x => copy y + concat(frst x,concat(rst x, y)) + + concat l == delay + empty? l => empty() + empty?(x := first l) => concat rest l + concat(frst x,concat(rst x,concat rest l)) + + setelt(x,seg:U,s:S) == + low := lo seg + hasHi seg => + high := hi seg + high < low => s + (not index?(low,x)) or (not index?(high,x)) => + error "setelt: index out of range" + x := expand_!(x,high - MIN + 1) + y := rest(x,(low - MIN) :: NNI) + for i in 0..(high-low) repeat + setfrst_!(y,s) + y := rst y + s + not index?(low,x) => error "setelt: index out of range" + x := rest(x,(low - MIN) :: NNI) + setrst_!(x,x) + setfrst_!(x,s) + +--% RCAGG functions + + empty() == [NullStream, NIL$Lisp] + + lazyEval x == (rst(x):(()-> %)) () + + lazyEvaluate x == + st := lazyEval x + setfrst_!(x, frst st) + setrst_!(x,if EQ(rst st,st)$Lisp then x else rst st) + x + + -- empty? is the only function that explicitly causes evaluation + -- of a stream element + empty? x == + while lazy? x repeat + st := lazyEval x + setfrst_!(x, frst st) + setrst_!(x,if EQ(rst st,st)$Lisp then x else rst st) + explicitlyEmpty? x + + --setvalue(x,s) == setfirst_!(x,s) + + --setchildren(x,l) == + --empty? l => error "setchildren: empty list of children" + --not(empty? rest l) => error "setchildren: wrong number of children" + --setrest_!(x,first l) + +--% URAGG functions + + first(x,n) == delay + -- former name: take + n = 0 or empty? x => empty() + (concat(frst x, first(rst x,(n-1) :: NNI))) + + concat(s:S,x:%) == [s,x] + cons(s,x) == concat(s,x) + + cycleSplit_! x == + cycElt := cycleElt x + cycElt case "failed" => + error "cycleSplit_!: non-cyclic stream" + y := computeCycleEntry(x,cycElt :: %) + eq?(x,y) => (setToNil_! x; return y) + z := rst x + repeat + eq?(y,z) => (setrest_!(x,empty()); return y) + x := z ; z := rst z + + expand_!(x,n) == + -- expands cycles (if necessary) so that the first n + -- elements of x will not be part of a cycle + n < 1 => x + y := x + for i in 1..n while not empty? y repeat y := rst y + cycElt := cycleElt x + cycElt case "failed" => x + e := computeCycleEntry(x,cycElt :: %) + d : I := distance(x,e) + d >= n => x + if d = 0 then + -- roll the cycle 1 entry + d := 1 + t := cycleTail e + if eq?(t,e) then + t := concat(frst t,empty()) + e := setrst_!(t,t) + setrst_!(x,e) + else + setrst_!(t,concat(frst e,rst e)) + e := rst e + nLessD := (n-d) :: NNI + y := complete first(e,nLessD) + e := rest(e,nLessD) + setrst_!(tail y,e) + setrst_!(rest(x,(d-1) :: NNI),y) + x + + first x == + empty? x => error "Can't take the first of an empty stream." + frst x + + concat_!(x:%,y:%) == + empty? x => y + setrst_!(tail x,y) + + concat_!(x:%,s:S) == + concat_!(x,concat(s,empty())) + + setfirst_!(x,s) == setelt(x,0,s) + setelt(x,"first",s) == setfirst_!(x,s) + setrest_!(x,y) == + empty? x => error "setrest!: empty stream" + setrst_!(x,y) + setelt(x,"rest",y) == setrest_!(x,y) + + setlast_!(x,s) == + empty? x => error "setlast!: empty stream" + setfrst_!(tail x, s) + setelt(x,"last",s) == setlast_!(x,s) + + split_!(x,n) == + n < MIN => error "split!: index out of range" + n = MIN => + y : % := empty() + setfrst_!(y,frst x) + setrst_!(y,rst x) + setToNil_! x + y + x := expand_!(x,n - MIN) + x := rest(x,(n - MIN - 1) :: NNI) + y := rest x + setrst_!(x,empty()) + y + +--% STREAM functions + + coerce(l: L S) == construct l + + repeating l == + empty? l => + error "Need a non-null list to make a repeating stream." + x0 : % := x := construct l + while not empty? rst x repeat x := rst x + setrst_!(x,x0) + + if S has SetCategory then + + repeating?(l, x) == + empty? l => + error "Need a non-empty? list to make a repeating stream." + empty? rest l => + not empty? x and frst x = first l and x = rst x + x0 := x + for s in l repeat + empty? x or s ^= frst x => return false + x := rst x + eq?(x,x0) + + findCycle(n, x) == + hd := x + -- Determine whether periodic within n. + tl := rest(x, n) + explicitlyEmpty? tl => [false, 0, 0] + i := 0; while not eq?(x,tl) repeat (x := rst x; i := i + 1) + i = n => [false, 0, 0] + -- Find period. Now x=tl, so step over and find it again. + x := rst x; per := 1 + while not eq?(x,tl) repeat (x := rst x; per := per + 1) + -- Find non-periodic part. + x := hd; xp := rest(hd, per); npp := 0 + while not eq?(x,xp) repeat (x := rst x; xp := rst xp; npp := npp+1) + [true, npp, per] + + delay(fs:()->%) == [NonNullStream, fs pretend %] + +-- explicitlyEmpty? x == markedNull? x + + explicitEntries? x == + not explicitlyEmpty? x and not lazy? x + + numberOfComputedEntries x == + explicitEntries? x => numberOfComputedEntries(rst x) + 1 + 0 + + if S has SetCategory then + + output(n,x) == + (not(n>0))or empty? x => void() + mathPrint(frst(x)::OUT)$Lisp + output(n-1, rst x) + + setrestt_!(x,n,y) == + n = 0 => setrst_!(x,y) + setrestt_!(rst x,n-1,y) + + setrest_!(x,n,y) == + n < 0 or empty? x => error "setrest!: no such rest" + x := expand_!(x,n+1) + setrestt_!(x,n,y) + + generate f == delay concat(f(), generate f) + gen:(S -> S,S) -> % + gen(f,s) == delay(ss:=f s; concat(ss, gen(f,ss))) + generate(f,s)==concat(s,gen(f,s)) + + concat(x:%,y:%) ==delay + empty? x => y + concat(frst x,concat(rst x,y)) + + swhilee:(S -> Boolean,%) -> % + swhilee(p,x) == delay + empty? x => empty() + not p(frst x) => empty() + concat(frst x,filterWhile(p,rst x)) + filterWhile(p,x)== + explicitlyEmpty? x => empty() + eq?(x,rst x) => + p(frst x) => x + empty() + swhilee(p,x) + + suntill: (S -> Boolean,%) -> % + suntill(p,x) == delay + empty? x => empty() + p(frst x) => concat(frst x,empty()) + concat(frst x, filterUntil(p, rst x)) + + filterUntil(p,x)== + explicitlyEmpty? x => empty() + eq?(x,rst x) => + p(frst x) => concat(frst x,empty()) + x + suntill(p,x) + +-- if S has SetCategory then +-- mapp: ((S,S) -> S,%,%,S) -> % +-- mapp(f,x,y,a) == delay +-- empty? x or empty? y => empty() +-- concat(f(frst x,frst y), map(f,rst x,rst y,a)) +-- map(f,x,y,a) == +-- explicitlyEmpty? x => empty() +-- eq?(x,rst x) => +-- frst x=a => y +-- map(f(frst x,#1),y) +-- explicitlyEmpty? y => empty() +-- eq?(y,rst y) => +-- frst y=a => x +-- p(f(#1,frst y),x) +-- mapp(f,x,y,a) + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain STRING String} +<>= +-- string.spad.pamphlet String.input +)spool String.output +)set message test on +)set message auto off +)clear all +--S 1 of 35 +hello := "Hello, I'm AXIOM!" +--R +--R +--R (1) "Hello, I'm AXIOM!" +--R Type: String +--E 1 + +--S 2 of 35 +said := "Jane said, \_"Look!\_"" +--R +--R +--R (2) "Jane said, \"Look!\"" +--R Type: String +--E 2 + +--S 3 of 35 +saw := "She saw exactly one underscore: \_\_." +--R +--R +--R (3) "She saw exactly one underscore: \\." +--R Type: String +--E 3 + +--S 4 of 35 +gasp: String := new(32, char "x") +--R +--R +--R (4) "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx" +--R Type: String +--E 4 + +--S 5 of 35 +#gasp +--R +--R +--R (5) 32 +--R Type: PositiveInteger +--E 5 + +--S 6 of 35 +hello.2 +--R +--R +--R (6) e +--R Type: Character +--E 6 + +--S 7 of 35 +hello 2 +--R +--R +--R (7) e +--R Type: Character +--E 7 + +--S 8 of 35 +hello(2) +--R +--R +--R (8) e +--R Type: Character +--E 8 + +--S 9 of 35 +hullo := copy hello +--R +--R +--R (9) "Hello, I'm AXIOM!" +--R Type: String +--E 9 + +--S 10 of 35 +hullo.2 := char "u"; [hello, hullo] +--R +--R +--R (10) ["Hello, I'm AXIOM!","Hullo, I'm AXIOM!"] +--R Type: List String +--E 10 + +--S 11 of 35 +saidsaw := concat ["alpha","---","omega"] +--R +--R +--R (11) "alpha---omega" +--R Type: String +--E 11 + +--S 12 of 35 +concat("hello ","goodbye") +--R +--R +--R (12) "hello goodbye" +--R Type: String +--E 12 + +--S 13 of 35 +"This " "is " "several " "strings " "concatenated." +--R +--R +--R (13) "This is several strings concatenated." +--R Type: String +--E 13 + +--S 14 of 35 +hello(1..5) +--R +--R +--R (14) "Hello" +--R Type: String +--E 14 + +--S 15 of 35 +hello(8..) +--R +--R +--R (15) "I'm AXIOM!" +--R Type: String +--E 15 + +--S 16 of 35 +split(hello, char " ") +--R +--R +--R (16) ["Hello,","I'm","AXIOM!"] +--R Type: List String +--E 16 + +--S 17 of 35 +other := complement alphanumeric(); +--R +--R Type: CharacterClass +--E 17 + +--S 18 of 35 +split(saidsaw, other) +--R +--R +--R (18) ["alpha","omega"] +--R Type: List String +--E 18 + +--S 19 of 35 +trim("## ++ relax ++ ##", char "#") +--R +--R +--R (19) " ++ relax ++ " +--R Type: String +--E 19 + +--S 20 of 35 +trim("## ++ relax ++ ##", other) +--R +--R +--R (20) "relax" +--R Type: String +--E 20 + +--S 21 of 35 +leftTrim("## ++ relax ++ ##", other) +--R +--R +--R (21) "relax ++ ##" +--R Type: String +--E 21 + +--S 22 of 35 +rightTrim("## ++ relax ++ ##", other) +--R +--R +--R (22) "## ++ relax" +--R Type: String +--E 22 + +--S 23 of 35 +upperCase hello +--R +--R +--R (23) "HELLO, I'M AXIOM!" +--R Type: String +--E 23 + +--S 24 of 35 +lowerCase hello +--R +--R +--R (24) "hello, i'm axiom!" +--R Type: String +--E 24 + +--S 25 of 35 +prefix?("He", "Hello") +--R +--R +--R (25) true +--R Type: Boolean +--E 25 + +--S 26 of 35 +prefix?("Her", "Hello") +--R +--R +--R (26) false +--R Type: Boolean +--E 26 + +--S 27 of 35 +suffix?("", "Hello") +--R +--R +--R (27) true +--R Type: Boolean +--E 27 + +--S 28 of 35 +suffix?("LO", "Hello") +--R +--R +--R (28) false +--R Type: Boolean +--E 28 + +--S 29 of 35 +substring?("ll", "Hello", 3) +--R +--R +--R (29) true +--R Type: Boolean +--E 29 + +--S 30 of 35 +substring?("ll", "Hello", 4) +--R +--R +--R (30) false +--R Type: Boolean +--E 30 + +--S 31 of 35 +n := position("nd", "underground", 1) +--R +--R +--R (31) 2 +--R Type: PositiveInteger +--E 31 + +--S 32 of 35 +n := position("nd", "underground", n+1) +--R +--R +--R (32) 10 +--R Type: PositiveInteger +--E 32 + +--S 33 of 35 +n := position("nd", "underground", n+1) +--R +--R +--R (33) 0 +--R Type: NonNegativeInteger +--E 33 + +--S 34 of 35 +position(char "d", "underground", 1) +--R +--R +--R (34) 3 +--R Type: PositiveInteger +--E 34 + +--S 35 of 35 +position(hexDigit(), "underground", 1) +--R +--R +--R (35) 3 +--R Type: PositiveInteger +--E 35 +)spool +)lisp (bye) +@ +<>= +==================================================================== +String examples +==================================================================== + +The type String provides character strings. Character strings +provide all the operations for a one-dimensional array of characters, +plus additional operations for manipulating text. + +String values can be created using double quotes. + + hello := "Hello, I'm AXIOM!" + "Hello, I'm AXIOM!" + Type: String + +Note, however, that double quotes and underscores must be preceded by +an extra underscore. + + said := "Jane said, \_"Look!\_"" + "Jane said, \"Look!\"" + Type: String + + saw := "She saw exactly one underscore: \_\_." + "She saw exactly one underscore: \\." + Type: String + +It is also possible to use new to create a string of any size filled +with a given character. Since there are many new functions it is +necessary to indicate the desired type. + + gasp: String := new(32, char "x") + "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx" + Type: String + +The length of a string is given by #. + + #gasp + 32 + Type: PositiveInteger + +Indexing operations allow characters to be extracted or replaced in strings. +For any string s, indices lie in the range 1..#s. + + hello.2 + e + Type: Character + +Indexing is really just the application of a string to a subscript, so +any application syntax works. + + hello 2 + e + Type: Character + + hello(2) + e + Type: Character + +If it is important not to modify a given string, it should be copied +before any updating operations are used. + + hullo := copy hello + "Hello, I'm AXIOM!" + Type: String + + hullo.2 := char "u"; [hello, hullo] + ["Hello, I'm AXIOM!","Hullo, I'm AXIOM!"] + Type: List String + +Operations are provided to split and join strings. The concat +operation allows several strings to be joined together. + + saidsaw := concat ["alpha","---","omega"] + "alpha---omega" + Type: String + +There is a version of concat that works with two strings. + + concat("hello ","goodbye") + "hello goodbye" + Type: String + +Juxtaposition can also be used to concatenate strings. + + "This " "is " "several " "strings " "concatenated." + "This is several strings concatenated." + Type: String + +Substrings are obtained by giving an index range. + + hello(1..5) + "Hello" + Type: String + + hello(8..) + "I'm AXIOM!" + Type: String + +A string can be split into several substrings by giving a separation +character or character class. + + split(hello, char " ") + ["Hello,","I'm","AXIOM!"] + Type: List String + + other := complement alphanumeric(); + Type: CharacterClass + + split(saidsaw, other) + ["alpha","omega"] + Type: List String + +Unwanted characters can be trimmed from the beginning or end of a string +using the operations trim, leftTrim and rightTrim. + + trim("## ++ relax ++ ##", char "#") + " ++ relax ++ " + Type: String + +Each of these functions takes a string and a second argument to specify +the characters to be discarded. + + trim("## ++ relax ++ ##", other) + "relax" + Type: String + +The second argument can be given either as a single character or as a +character class. + + leftTrim("## ++ relax ++ ##", other) + "relax ++ ##" + Type: String + + rightTrim("## ++ relax ++ ##", other) + "## ++ relax" + Type: String + +Strings can be changed to upper case or lower case using the +operations upperCase and lowerCase. + + upperCase hello + "HELLO, I'M AXIOM!" + Type: String + +The versions with the exclamation mark change the original string, +while the others produce a copy. + + lowerCase hello + "hello, i'm axiom!" + Type: String + +Some basic string matching is provided. The function prefix? tests +whether one string is an initial prefix of another. + + prefix?("He", "Hello") + true + Type: Boolean + + prefix?("Her", "Hello") + false + Type: Boolean + +A similar function, suffix?, tests for suffixes. + + suffix?("", "Hello") + true + Type: Boolean + + suffix?("LO", "Hello") + false + Type: Boolean + +The function substring? tests for a substring given a starting position. + + substring?("ll", "Hello", 3) + true + Type: Boolean + + substring?("ll", "Hello", 4) + false + Type: Boolean + +A number of position functions locate things in strings. If the first +argument to position is a string, then position(s,t,i) finds the +location of s as a substring of t starting the search at position i. + + n := position("nd", "underground", 1) + 2 + Type: PositiveInteger + + n := position("nd", "underground", n+1) + 10 + Type: PositiveInteger + +If s is not found, then 0 is returned (minIndex(s)-1 in IndexedString). + + n := position("nd", "underground", n+1) + 0 + Type: NonNegativeInteger + +To search for a specific character or a member of a character class, +a different first argument is used. + + position(char "d", "underground", 1) + 3 + Type: PositiveInteger + + position(hexDigit(), "underground", 1) + 3 + Type: PositiveInteger + +See Also: +o )help Character +o )help CharacterClass +o )show String +o $AXIOM/doc/src/algebra/string.spad.dvi + +@ +\pagehead{String}{STRING} +\pagepic{ps/v103string.ps}{STRING}{1.00} +See also:\\ +\refto{Character}{CHAR} +\refto{CharacterClass}{CCLASS} +\refto{IndexedString}{ISTRING} +<>= +)abbrev domain STRING String +++ Description: +++ This is the domain of character strings. +MINSTRINGINDEX ==> 1 -- as of 3/14/90. + +String(): StringCategory == IndexedString(MINSTRINGINDEX) add + string n == STRINGIMAGE(n)$Lisp + + OMwrite(x: %): String == + s: String := "" + sp := OM_-STRINGTOSTRINGPTR(s)$Lisp + dev: OpenMathDevice := OMopenString(sp pretend String, OMencodingXML) + OMputObject(dev) + OMputString(dev, x pretend String) + 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) + OMputString(dev, x pretend String) + if wholeObj then + OMputEndObject(dev) + OMclose(dev) + s := OM_-STRINGPTRTOSTRING(sp)$Lisp pretend String + s + + OMwrite(dev: OpenMathDevice, x: %): Void == + OMputObject(dev) + OMputString(dev, x pretend String) + OMputEndObject(dev) + + OMwrite(dev: OpenMathDevice, x: %, wholeObj: Boolean): Void == + if wholeObj then + OMputObject(dev) + OMputString(dev, x pretend String) + if wholeObj then + OMputEndObject(dev) + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{domain SUBSPACE SubSpace} The first argument n is the dimension of the subSpace @@ -62213,6 +69255,34 @@ SubSpaceComponentProperty() : Exports == Implementation where @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain SUCH SuchThat} +\pagehead{SuchThat}{SUCH} +\pagepic{ps/v103suchthat.ps}{SUCH}{1.00} +<>= +)abbrev domain SUCH SuchThat +++ Description: +++ This domain implements "such that" forms +SuchThat(S1, S2): Cat == Capsule where + E ==> OutputForm + S1, S2: SetCategory + + Cat == SetCategory with + construct: (S1, S2) -> % + ++ construct(s,t) makes a form s:t + lhs: % -> S1 + ++ lhs(f) returns the left side of f + rhs: % -> S2 + ++ rhs(f) returns the right side of f + + Capsule == add + Rep := Record(obj: S1, cond: S2) + construct(o, c) == [o, c]$Record(obj: S1, cond: S2) + lhs st == st.obj + rhs st == st.cond + coerce(w):E == infix("|"::E, w.obj::E, w.cond::E) + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{domain SWITCH Switch} \pagehead{Switch}{SWITCH} \pagepic{ps/v103switch.ps}{SWITCH}{1.00} @@ -62314,6 +69384,700 @@ Switch():public == private where @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain SYMBOL Symbol} +<>= +-- symbol.spad.pamphlet Symbol.input +)spool Symbol.output +)set message test on +)set message auto off +)clear all +--S 1 of 24 +X: Symbol := 'x +--R +--R +--R (1) x +--R Type: Symbol +--E 1 + +--S 2 of 24 +XX: Symbol := x +--R +--R +--R (2) x +--R Type: Symbol +--E 2 + +--S 3 of 24 +A := 'a +--R +--R +--R (3) a +--R Type: Variable a +--E 3 + +--S 4 of 24 +B := b +--R +--R +--R (4) b +--R Type: Variable b +--E 4 + +--S 5 of 24 +x**2 + 1 +--R +--R +--R 2 +--R (5) x + 1 +--R Type: Polynomial Integer +--E 5 + +--S 6 of 24 +"Hello"::Symbol +--R +--R +--R (6) Hello +--R Type: Symbol +--E 6 + +--S 7 of 24 +new()$Symbol +--R +--R +--R (7) %A +--R Type: Symbol +--E 7 + +--S 8 of 24 +new()$Symbol +--R +--R +--R (8) %B +--R Type: Symbol +--E 8 + +--S 9 of 24 +new("xyz")$Symbol +--R +--R +--R (9) %xyz0 +--R Type: Symbol +--E 9 + +--S 10 of 24 +X[i,j] +--R +--R +--R (10) x +--R i,j +--R Type: Symbol +--E 10 + +--S 11 of 24 +U := subscript(u, [1,2,1,2]) +--R +--R +--R (11) u +--R 1,2,1,2 +--R Type: Symbol +--E 11 + +--S 12 of 24 +V := superscript(v, [n]) +--R +--R +--R n +--R (12) v +--R Type: Symbol +--E 12 + +--S 13 of 24 +P := argscript(p, [t]) +--R +--R +--R (13) p(t) +--R Type: Symbol +--E 13 + +--S 14 of 24 +scripted? U +--R +--R +--R (14) true +--R Type: Boolean +--E 14 + +--S 15 of 24 +scripted? X +--R +--R +--R (15) false +--R Type: Boolean +--E 15 + +--S 16 of 24 +string X +--R +--R +--R (16) "x" +--R Type: String +--E 16 + +--S 17 of 24 +name U +--R +--R +--R (17) u +--R Type: Symbol +--E 17 + +--S 18 of 24 +scripts U +--R +--R +--R (18) [sub= [1,2,1,2],sup= [],presup= [],presub= [],args= []] +--RType: Record(sub: List OutputForm,sup: List OutputForm,presup: List OutputForm,presub: List OutputForm,args: List OutputForm) +--E 18 + +--S 19 of 24 +name X +--R +--R +--R (19) x +--R Type: Symbol +--E 19 + +--S 20 of 24 +scripts X +--R +--R +--R (20) [sub= [],sup= [],presup= [],presub= [],args= []] +--RType: Record(sub: List OutputForm,sup: List OutputForm,presup: List OutputForm,presub: List OutputForm,args: List OutputForm) +--E 20 + +--S 21 of 24 +M := script(Mammoth, [ [i,j],[k,l],[0,1],[2],[u,v,w] ]) +--R +--R +--R 0,1 k,l +--R (21) Mammoth (u,v,w) +--R 2 i,j +--R Type: Symbol +--E 21 + +--S 22 of 24 +scripts M +--R +--R +--R (22) [sub= [i,j],sup= [k,l],presup= [0,1],presub= [2],args= [u,v,w]] +--RType: Record(sub: List OutputForm,sup: List OutputForm,presup: List OutputForm,presub: List OutputForm,args: List OutputForm) +--E 22 + +--S 23 of 24 +N := script(Nut, [ [i,j],[k,l],[0,1] ]) +--R +--R +--R 0,1 k,l +--R (23) Nut +--R i,j +--R Type: Symbol +--E 23 + +--S 24 of 24 +scripts N +--R +--R +--R (24) [sub= [i,j],sup= [k,l],presup= [0,1],presub= [],args= []] +--RType: Record(sub: List OutputForm,sup: List OutputForm,presup: List OutputForm,presub: List OutputForm,args: List OutputForm) +--E 24 +)spool +)lisp (bye) +@ +<>= +==================================================================== +Symbol examples +==================================================================== + +Symbols are one of the basic types manipulated by Axiom. The +Symbol domain provides ways to create symbols of many varieties. + +The simplest way to create a symbol is to "single quote" an identifier. + + X: Symbol := 'x + x + Type: Symbol + +This gives the symbol even if x has been assigned a value. If x has +not been assigned a value, then it is possible to omit the quote. + + XX: Symbol := x + x + Type: Symbol + +Declarations must be used when working with symbols, because otherwise +the interpreter tries to place values in a more specialized type Variable. + + A := 'a + a + Type: Variable a + + B := b + b + Type: Variable b + +The normal way of entering polynomials uses this fact. + + x**2 + 1 + 2 + x + 1 + Type: Polynomial Integer + +Another convenient way to create symbols is to convert a string. +This is useful when the name is to be constructed by a program. + + "Hello"::Symbol + Hello + Type: Symbol + +Sometimes it is necessary to generate new unique symbols, for example, +to name constants of integration. The expression new() generates a +symbol starting with %. + + new()$Symbol + %A + Type: Symbol + +Successive calls to new produce different symbols. + + new()$Symbol + %B + Type: Symbol + +The expression new("s") produces a symbol starting with %s. + + new("xyz")$Symbol + %xyz0 + Type: Symbol + +A symbol can be adorned in various ways. The most basic thing is +applying a symbol to a list of subscripts. + + X[i,j] + x + i,j + Type: Symbol + +Somewhat less pretty is to attach subscripts, superscripts or arguments. + + U := subscript(u, [1,2,1,2]) + u + 1,2,1,2 + Type: Symbol + + V := superscript(v, [n]) + n + v + Type: Symbol + + P := argscript(p, [t]) + p(t) + Type: Symbol + +It is possible to test whether a symbol has scripts using the scripted? test. + + scripted? U + true + Type: Boolean + + scripted? X + false + Type: Boolean + +If a symbol is not scripted, then it may be converted to a string. + + string X + "x" + Type: String + +The basic parts can always be extracted using the name and scripts operations. + + name U + u + Type: Symbol + + scripts U + [sub= [1,2,1,2],sup= [],presup= [],presub= [],args= []] + Type: Record(sub: List OutputForm, + sup: List OutputForm, + presup: List OutputForm, + presub: List OutputForm, + args: List OutputForm) + + name X + x + Type: Symbol + + scripts X + [sub= [],sup= [],presup= [],presub= [],args= []] + Type: Record(sub: List OutputForm, + sup: List OutputForm, + presup: List OutputForm, + presub: List OutputForm, + args: List OutputForm) + +The most general form is obtained using the script operation. This +operation takes an argument which is a list containing, in this order, +lists of subscripts, superscripts, presuperscripts, presubscripts and +arguments to a symbol. + + M := script(Mammoth, [ [i,j],[k,l],[0,1],[2],[u,v,w] ]) + 0,1 k,l + Mammoth (u,v,w) + 2 i,j + Type: Symbol + + scripts M + [sub= [i,j],sup= [k,l],presup= [0,1],presub= [2],args= [u,v,w]] + Type: Record(sub: List OutputForm, + sup: List OutputForm, + presup: List OutputForm, + presub: List OutputForm, + args: List OutputForm) + +If trailing lists of scripts are omitted, they are assumed to be empty. + + N := script(Nut, [ [i,j],[k,l],[0,1] ]) + 0,1 k,l + Nut + i,j + Type: Symbol + + scripts N + [sub= [i,j],sup= [k,l],presup= [0,1],presub= [],args= []] + Type: Record(sub: List OutputForm, + sup: List OutputForm, + presup: List OutputForm, + presub: List OutputForm, + args: List OutputForm) + + +See Also: +o )show Symbol +o $AXIOM/doc/src/algebra/symbol.spad.dvi + +@ +\pagehead{Symbol}{SYMBOL} +\pagepic{ps/v103symbol.ps}{SYMBOL}{1.00} +<>= +)abbrev domain SYMBOL Symbol +++ Author: Stephen Watt +++ Date Created: 1986 +++ Date Last Updated: 7 Mar 1991, 29 Apr. 1994 (FDLL) +++ Description: +++ Basic and scripted symbols. +++ Keywords: symbol. +Symbol(): Exports == Implementation where + L ==> List OutputForm + Scripts ==> Record(sub:L,sup:L,presup:L,presub:L,args:L) + + Exports ==> Join(OrderedSet, ConvertibleTo InputForm, OpenMath, + ConvertibleTo Symbol, + ConvertibleTo Pattern Integer, ConvertibleTo Pattern Float, + PatternMatchable Integer, PatternMatchable Float) with + new: () -> % + ++ new() returns a new symbol whose name starts with %. + new: % -> % + ++ new(s) returns a new symbol whose name starts with %s. + resetNew: () -> Void + ++ resetNew() resets the internals counters that new() and + ++ new(s) use to return distinct symbols every time. + coerce: String -> % + ++ coerce(s) converts the string s to a symbol. + name: % -> % + ++ name(s) returns s without its scripts. + scripted?: % -> Boolean + ++ scripted?(s) is true if s has been given any scripts. + scripts: % -> Scripts + ++ scripts(s) returns all the scripts of s. + script: (%, List L) -> % + ++ script(s, [a,b,c,d,e]) returns s with subscripts a, + ++ superscripts b, pre-superscripts c, pre-subscripts d, + ++ and argument-scripts e. Omitted components are taken to be empty. + ++ For example, \spad{script(s, [a,b,c])} is equivalent to + ++ \spad{script(s,[a,b,c,[],[]])}. + script: (%, Scripts) -> % + ++ script(s, [a,b,c,d,e]) returns s with subscripts a, + ++ superscripts b, pre-superscripts c, pre-subscripts d, + ++ and argument-scripts e. + subscript: (%, L) -> % + ++ subscript(s, [a1,...,an]) returns s + ++ subscripted by \spad{[a1,...,an]}. + superscript: (%, L) -> % + ++ superscript(s, [a1,...,an]) returns s + ++ superscripted by \spad{[a1,...,an]}. + argscript: (%, L) -> % + ++ argscript(s, [a1,...,an]) returns s + ++ arg-scripted by \spad{[a1,...,an]}. + elt: (%, L) -> % + ++ elt(s,[a1,...,an]) or s([a1,...,an]) returns s subscripted by \spad{[a1,...,an]}. + string: % -> String + ++ string(s) converts the symbol s to a string. + ++ Error: if the symbol is subscripted. + list: % -> List % + ++ list(sy) takes a scripted symbol and produces a list + ++ of the name followed by the scripts. + sample: constant -> % + ++ sample() returns a sample of % + + Implementation ==> add + count: Reference(Integer) := ref 0 + xcount: AssociationList(%, Integer) := empty() + istrings:PrimitiveArray(String) := + construct ["0","1","2","3","4","5","6","7","8","9"] + -- the following 3 strings shall be of empty intersection + nums:String:="0123456789" + ALPHAS:String:="ABCDEFGHIJKLMNOPQRSTUVWXYZ" + alphas:String:="abcdefghijklmnopqrstuvwxyz" + + writeOMSym(dev: OpenMathDevice, x: %): Void == + scripted? x => + error "Cannot convert a scripted symbol to OpenMath" + OMputVariable(dev, x pretend Symbol) + + OMwrite(x: %): String == + s: String := "" + sp := OM_-STRINGTOSTRINGPTR(s)$Lisp + dev: OpenMathDevice := OMopenString(sp pretend String, OMencodingXML) + OMputObject(dev) + writeOMSym(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) + writeOMSym(dev, x) + if wholeObj then + OMputEndObject(dev) + OMclose(dev) + s := OM_-STRINGPTRTOSTRING(sp)$Lisp pretend String + s + + OMwrite(dev: OpenMathDevice, x: %): Void == + OMputObject(dev) + writeOMSym(dev, x) + OMputEndObject(dev) + + OMwrite(dev: OpenMathDevice, x: %, wholeObj: Boolean): Void == + if wholeObj then + OMputObject(dev) + writeOMSym(dev, x) + if wholeObj then + OMputEndObject(dev) + + hd:String := "*" + lhd := #hd + ord0 := ord char("0")$Character + + istring : Integer -> String + syprefix : Scripts -> String + syscripts: Scripts -> L + + convert(s:%):InputForm == convert(s pretend Symbol)$InputForm + convert(s:%):Symbol == s pretend Symbol + coerce(s:String):% == VALUES(INTERN(s)$Lisp)$Lisp + x = y == EQUAL(x,y)$Lisp + x < y == GGREATERP(y, x)$Lisp + coerce(x:%):OutputForm == outputForm(x pretend Symbol) + subscript(sy, lx) == script(sy, [lx, nil, nil(), nil(), nil()]) + elt(sy,lx) == subscript(sy,lx) + superscript(sy, lx) == script(sy,[nil(),lx, nil(), nil(), nil()]) + argscript(sy, lx) == script(sy,[nil(),nil(), nil(), nil(), lx]) + + patternMatch(x:%,p:Pattern Integer,l:PatternMatchResult(Integer,%))== + (patternMatch(x pretend Symbol, p, l pretend + PatternMatchResult(Integer, Symbol))$PatternMatchSymbol(Integer)) + pretend PatternMatchResult(Integer, %) + + patternMatch(x:%, p:Pattern Float, l:PatternMatchResult(Float, %)) == + (patternMatch(x pretend Symbol, p, l pretend + PatternMatchResult(Float, Symbol))$PatternMatchSymbol(Float)) + pretend PatternMatchResult(Float, %) + + convert(x:%):Pattern(Float) == + coerce(x pretend Symbol)$Pattern(Float) + + convert(x:%):Pattern(Integer) == + coerce(x pretend Symbol)$Pattern(Integer) + + syprefix sc == + ns: List Integer := [#sc.presub, #sc.presup, #sc.sup, #sc.sub] + while #ns >= 2 and zero? first ns repeat ns := rest ns + concat concat(concat(hd, istring(#sc.args)), + [istring n for n in reverse_! ns]) + + syscripts sc == + all := sc.presub + all := concat(sc.presup, all) + all := concat(sc.sup, all) + all := concat(sc.sub, all) + concat(all, sc.args) + + script(sy: %, ls: List L) == + sc: Scripts := [nil(), nil(), nil(), nil(), nil()] + if not null ls then (sc.sub := first ls; ls := rest ls) + if not null ls then (sc.sup := first ls; ls := rest ls) + if not null ls then (sc.presup := first ls; ls := rest ls) + if not null ls then (sc.presub := first ls; ls := rest ls) + if not null ls then (sc.args := first ls; ls := rest ls) + script(sy, sc) + + script(sy: %, sc: Scripts) == + scripted? sy => error "Cannot add scripts to a scripted symbol" + (concat(concat(syprefix sc, string name sy)::%::OutputForm, + syscripts sc)) pretend % + + string e == + not scripted? e => PNAME(e)$Lisp + error "Cannot form string from non-atomic symbols." + +-- Scripts ==> Record(sub:L,sup:L,presup:L,presub:L,args:L) + latex e == + s : String := (PNAME(name e)$Lisp) pretend String + if #s > 1 and s.1 ^= char "\" then + s := concat("\mbox{\it ", concat(s, "}")$String)$String + not scripted? e => s + ss : Scripts := scripts e + lo : List OutputForm := ss.sub + sc : String + if not empty? lo then + sc := "__{" + while not empty? lo repeat + sc := concat(sc, latex first lo)$String + lo := rest lo + if not empty? lo then sc := concat(sc, ", ")$String + sc := concat(sc, "}")$String + s := concat(s, sc)$String + lo := ss.sup + if not empty? lo then + sc := "^{" + while not empty? lo repeat + sc := concat(sc, latex first lo)$String + lo := rest lo + if not empty? lo then sc := concat(sc, ", ")$String + sc := concat(sc, "}")$String + s := concat(s, sc)$String + lo := ss.presup + if not empty? lo then + sc := "{}^{" + while not empty? lo repeat + sc := concat(sc, latex first lo)$String + lo := rest lo + if not empty? lo then sc := concat(sc, ", ")$String + sc := concat(sc, "}")$String + s := concat(sc, s)$String + lo := ss.presub + if not empty? lo then + sc := "{}__{" + while not empty? lo repeat + sc := concat(sc, latex first lo)$String + lo := rest lo + if not empty? lo then sc := concat(sc, ", ")$String + sc := concat(sc, "}")$String + s := concat(sc, s)$String + lo := ss.args + if not empty? lo then + sc := "\left( {" + while not empty? lo repeat + sc := concat(sc, latex first lo)$String + lo := rest lo + if not empty? lo then sc := concat(sc, ", ")$String + sc := concat(sc, "} \right)")$String + s := concat(s, sc)$String + s + + anyRadix(n:Integer,s:String):String == + ns:String:="" + repeat + qr := divide(n,#s) + n := qr.quotient + ns := concat(s.(qr.remainder+minIndex s),ns) + if zero?(n) then return ns + + new() == + sym := anyRadix(count()::Integer,ALPHAS) + count() := count() + 1 + concat("%",sym)::% + + new x == + n:Integer := + (u := search(x, xcount)) case "failed" => 0 + inc(u::Integer) + xcount(x) := n + xx := + not scripted? x => string x + string name x + xx := concat("%",xx) + xx := + (position(xx.maxIndex(xx),nums)>=minIndex(nums)) => + concat(xx, anyRadix(n,alphas)) + concat(xx, anyRadix(n,nums)) + not scripted? x => xx::% + script(xx::%,scripts x) + + resetNew() == + count() := 0 + for k in keys xcount repeat remove_!(k, xcount) + void + + scripted? sy == + not ATOM(sy)$Lisp + + name sy == + not scripted? sy => sy + str := string first list sy + for i in lhd+1..#str repeat + not digit?(str.i) => return((str.(i..#str))::%) + error "Improper scripted symbol" + + scripts sy == + not scripted? sy => [nil(), nil(), nil(), nil(), nil()] + nscripts: List NonNegativeInteger := [0, 0, 0, 0, 0] + lscripts: List L := [nil(), nil(), nil(), nil(), nil()] + str := string first list sy + nstr := #str + m := minIndex nscripts + for i in m.. for j in lhd+1..nstr while digit?(str.j) repeat + nscripts.i := (ord(str.j) - ord0)::NonNegativeInteger + -- Put the number of function scripts at the end. + nscripts := concat(rest nscripts, first nscripts) + allscripts := rest list sy + m := minIndex lscripts + for i in m.. for n in nscripts repeat + #allscripts < n => error "Improper script count in symbol" + lscripts.i := [a::OutputForm for a in first(allscripts, n)] + allscripts := rest(allscripts, n) + [lscripts.m, lscripts.(m+1), lscripts.(m+2), + lscripts.(m+3), lscripts.(m+4)] + + istring n == + n > 9 => error "Can have at most 9 scripts of each kind" + istrings.(n + minIndex istrings) + + list sy == + not scripted? sy => + error "Cannot convert a symbol to a list if it is not subscripted" + sy pretend List(%) + + sample() == "aSymbol"::% + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{domain SYMTAB SymbolTable} \pagehead{SymbolTable}{SYMTAB} \pagepic{ps/v103symboltable.ps}{SYMTAB}{1.00} @@ -63335,6 +71099,358 @@ ThreeDimensionalMatrix(R) : Exports == Implementation where @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain SPACE3 ThreeSpace} +\pagehead{ThreeSpace}{SPACE3} +\pagepic{ps/v103threespace.ps}{SPACE3}{1.00} +<>= +)abbrev domain SPACE3 ThreeSpace +++ Author: +++ Date Created: +++ Date Last Updated: +++ Basic Operations: create3Space, numberOfComponents, numberOfComposites, +++ merge, composite, components, copy, enterPointData, modifyPointData, point, +++ point?, curve, curve?, closedCurve, closedCurve?, polygon, polygon? mesh, +++ mesh?, lp, lllip, lllp, llprop, lprop, objects, check, subspace, coerce +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: The domain ThreeSpace is used for creating three dimensional +++ objects using functions for defining points, curves, polygons, constructs +++ and the subspaces containing them. + +ThreeSpace(R:Ring):Exports == Implementation where + -- m is the dimension of the point + + I ==> Integer + PI ==> PositiveInteger + NNI ==> NonNegativeInteger + L ==> List + B ==> Boolean + O ==> OutputForm + SUBSPACE ==> SubSpace(3,R) + POINT ==> Point(R) + PROP ==> SubSpaceComponentProperty() + REP3D ==> Record(lp:L POINT,llliPt:L L L NNI, llProp:L L PROP, lProp:L PROP) + OBJ3D ==> Record(points:NNI, curves:NNI, polygons:NNI, constructs:NNI) + + Exports ==> ThreeSpaceCategory(R) + Implementation ==> add + import COMPPROP + import POINT + import SUBSPACE + import ListFunctions2(List(R),POINT) + import Set(NNI) + + Rep := Record( subspaceField:SUBSPACE, compositesField:L SUBSPACE, _ + rep3DField:REP3D, objectsField:OBJ3D, _ + converted:B) + +--% Local Functions + convertSpace : % -> % + convertSpace space == + space.converted => space + space.converted := true + lllipt : L L L NNI := [] + llprop : L L PROP := [] + lprop : L PROP := [] + for component in children space.subspaceField repeat + lprop := cons(extractProperty component,lprop) + tmpllipt : L L NNI := [] + tmplprop : L PROP := [] + for curve in children component repeat + tmplprop := cons(extractProperty curve,tmplprop) + tmplipt : L NNI := [] + for point in children curve repeat + tmplipt := cons(extractIndex point,tmplipt) + tmpllipt := cons(reverse_! tmplipt,tmpllipt) + llprop := cons(reverse_! tmplprop, llprop) + lllipt := cons(reverse_! tmpllipt, lllipt) + space.rep3DField := [pointData space.subspaceField, + reverse_! lllipt,reverse_! llprop,reverse_! lprop] + space + + +--% Exported Functions + polygon(space:%,points:L POINT) == + #points < 3 => + error "You need at least 3 points to define a polygon" + pt := addPoint2(space.subspaceField,first points) + points := rest points + addPointLast(space.subspaceField, pt, first points, 1) + for p in rest points repeat + addPointLast(space.subspaceField, pt, p, 2) + space.converted := false + space + create3Space() == [ new()$SUBSPACE, [], [ [], [], [], [] ], [0,0,0,0], false ] + create3Space(s) == [ s, [], [ [], [], [], [] ], [0,0,0,0], false ] + numberOfComponents(space) == #(children((space::Rep).subspaceField)) + numberOfComposites(space) == #((space::Rep).compositesField) + merge(listOfThreeSpaces) == + -- * -- we may want to remove duplicate components when that functionality exists in List + newspace := create3Space(merge([ts.subspaceField for ts in listOfThreeSpaces])) +-- newspace.compositesField := [for cs in ts.compositesField for ts in listOfThreeSpaces] + for ts in listOfThreeSpaces repeat + newspace.compositesField := append(ts.compositesField,newspace.compositesField) + newspace + merge(s1,s2) == merge([s1,s2]) + composite(listOfThreeSpaces) == + space := create3Space() + space.subspaceField := merge [s.subspaceField for s in listOfThreeSpaces] + space.compositesField := [deepCopy space.subspaceField] +-- for aSpace in listOfThreeSpaces repeat + -- create a composite (which are supercomponents that group + -- separate components together) out of all possible components +-- space.compositesField := append(children aSpace.subspaceField,space.compositesField) + space + components(space) == [create3Space(s) for s in separate space.subspaceField] + composites(space) == [create3Space(s) for s in space.compositesField] + copy(space) == + spc := create3Space(deepCopy(space.subspaceField)) + spc.compositesField := [deepCopy s for s in space.compositesField] + spc + + enterPointData(space,listOfPoints) == + for p in listOfPoints repeat + addPoint(space.subspaceField,p) + #(pointData space.subspaceField) + modifyPointData(space,i,p) == + modifyPoint(space.subspaceField,i,p) + space + + -- 3D primitives, each grouped in the following order + -- xxx?(s) : query whether the threespace, s, holds an xxx + -- xxx(s) : extract xxx from threespace, s + -- xxx(p) : create a new three space with xxx, p + -- xxx(s,p) : add xxx, p, to a three space, s + -- xxx(s,q) : add an xxx, convertable from q, to a three space, s + -- xxx(s,i) : add an xxx, the data for xxx being indexed by reference *** complete this + point?(space:%) == + #(c:=children space.subspaceField) > 1$NNI => + error "This ThreeSpace has more than one component" + -- our 3-space has one component, a list of list of points + #(kid:=children first c) = 1$NNI => -- the component has one subcomponent (a list of points) + #(children first kid) = 1$NNI -- this list of points only has one entry, so it's a point + false + point(space:%) == + point? space => extractPoint(traverse(space.subspaceField,[1,1,1]::L NNI)) + error "This ThreeSpace holds something other than a single point - try the objects() command" + point(aPoint:POINT) == point(create3Space(),aPoint) + point(space:%,aPoint:POINT) == + addPoint(space.subspaceField,[],aPoint) + space.converted := false + space + point(space:%,l:L R) == + pt := point(l) + point(space,pt) + point(space:%,i:NNI) == + addPoint(space.subspaceField,[],i) + space.converted := false + space + + curve?(space:%) == + #(c:=children space.subspaceField) > 1$NNI => + error "This ThreeSpace has more than one component" + -- our 3-space has one component, a list of list of points + #(children first c) = 1$NNI -- there is only one subcomponent, so it's a list of points + curve(space:%) == + curve? space => + spc := first children first children space.subspaceField + [extractPoint(s) for s in children spc] + error "This ThreeSpace holds something other than a curve - try the objects() command" + curve(points:L POINT) == curve(create3Space(),points) + curve(space:%,points:L POINT) == + addPoint(space.subspaceField,[],first points) + path : L NNI := [#(children space.subspaceField),1] + for p in rest points repeat + addPoint(space.subspaceField,path,p) + space.converted := false + space + curve(space:%,points:L L R) == + pts := map(point,points) + curve(space,pts) + + closedCurve?(space:%) == + #(c:=children space.subspaceField) > 1$NNI => + error "This ThreeSpace has more than one component" + -- our 3-space has one component, a list of list of points + #(kid := children first c) = 1$NNI => -- there is one subcomponent => it's a list of points + extractClosed first kid -- is it a closed curve? + false + closedCurve(space:%) == + closedCurve? space => + spc := first children first children space.subspaceField + -- get the list of points + [extractPoint(s) for s in children spc] + -- for now, we are not repeating points... + error "This ThreeSpace holds something other than a curve - try the objects() command" + closedCurve(points:L POINT) == closedCurve(create3Space(),points) + closedCurve(space:%,points:L POINT) == + addPoint(space.subspaceField,[],first points) + path : L NNI := [#(children space.subspaceField),1] + closeComponent(space.subspaceField,path,true) + for p in rest points repeat + addPoint(space.subspaceField,path,p) + space.converted := false + space + closedCurve(space:%,points:L L R) == + pts := map(point,points) + closedCurve(space,pts) + + polygon?(space:%) == + #(c:=children space.subspaceField) > 1$NNI => + error "This ThreeSpace has more than one component" + -- our 3-space has one component, a list of list of points + #(kid:=children first c) = 2::NNI => + -- there are two subcomponents + -- the convention is to have one point in the first child and to put + -- the remaining points (2 or more) in the second, and last, child + #(children first kid) = 1$NNI and #(children second kid) > 2::NNI + false -- => returns Void...? + polygon(space:%) == + polygon? space => + listOfPoints : L POINT := + [extractPoint(first children first (cs := children first children space.subspaceField))] + [extractPoint(s) for s in children second cs] + error "This ThreeSpace holds something other than a polygon - try the objects() command" + polygon(points:L POINT) == polygon(create3Space(),points) + polygon(space:%,points:L L R) == + pts := map(point,points) + polygon(space,pts) + + mesh?(space:%) == + #(c:=children space.subspaceField) > 1$NNI => + error "This ThreeSpace has more than one component" + -- our 3-space has one component, a list of list of points + #(kid:=children first c) > 1$NNI => + -- there are two or more subcomponents (list of points) + -- so this may be a definition of a mesh; if the size + -- of each list of points is the same and they are all + -- greater than 1(?) then we have an acceptable mesh + -- use a set to hold the curve size info: if heterogenous + -- curve sizes exist, then the set would hold all the sizes; + -- otherwise it would just have the one element indicating + -- the sizes for all the curves + whatSizes := brace()$Set(NNI) + for eachCurve in kid repeat + insert_!(#children eachCurve,whatSizes) + #whatSizes > 1 => error "Mesh defined with curves of different sizes" + first parts whatSizes < 2 => + error "Mesh defined with single point curves (use curve())" + true + false + mesh(space:%) == + mesh? space => + llp : L L POINT := [] + for lpSpace in children first children space.subspaceField repeat + llp := cons([extractPoint(s) for s in children lpSpace],llp) + llp + error "This ThreeSpace holds something other than a mesh - try the objects() command" + mesh(points:L L POINT) == mesh(create3Space(),points,false,false) + mesh(points:L L POINT,prop1:B,prop2:B) == mesh(create3Space(),points,prop1,prop2) +--+ old ones \/ + mesh(space:%,llpoints:L L L R,lprops:L PROP,prop:PROP) == + pts := [map(point,points) for points in llpoints] + mesh(space,pts,lprops,prop) + mesh(space:%,llp:L L POINT,lprops:L PROP,prop:PROP) == + addPoint(space.subspaceField,[],first first llp) + defineProperty(space.subspaceField,path:L NNI:=[#children space.subspaceField],prop) + path := append(path,[1]) + defineProperty(space.subspaceField,path,first lprops) + for p in rest (first llp) repeat + addPoint(space.subspaceField,path,p) + for lp in rest llp for aProp in rest lprops for count in 2.. repeat + addPoint(space.subspaceField,path := [first path],first lp) + path := append(path,[count]) + defineProperty(space.subspaceField,path,aProp) + for p in rest lp repeat + addPoint(space.subspaceField,path,p) + space.converted := false + space +--+ old ones /\ + mesh(space:%,llpoints:L L L R,prop1:B,prop2:B) == + pts := [map(point,points) for points in llpoints] + mesh(space,pts,prop1,prop2) + mesh(space:%,llp:L L POINT,prop1:B,prop2:B) == + -- prop2 refers to property of the ends of a surface (list of lists of points) + -- while prop1 refers to the individual curves (list of points) + -- ** note we currently use Booleans for closed (rather than a pair + -- ** of booleans for closed and solid) + propA : PROP := new() + close(propA,prop1) + propB : PROP := new() + close(propB,prop2) + addPoint(space.subspaceField,[],first first llp) + defineProperty(space.subspaceField,path:L NNI:=[#children space.subspaceField],propB) + path := append(path,[1]) + defineProperty(space.subspaceField,path,propA) + for p in rest (first llp) repeat + addPoint(space.subspaceField,path,p) + for lp in rest llp for count in 2.. repeat + addPoint(space.subspaceField,path := [first path],first lp) + path := append(path,[count]) + defineProperty(space.subspaceField,path,propA) + for p in rest lp repeat + addPoint(space.subspaceField,path,p) + space.converted := false + space + + lp space == + if ^space.converted then space := convertSpace space + space.rep3DField.lp + lllip space == + if ^space.converted then space := convertSpace space + space.rep3DField.llliPt +-- lllp space == +-- if ^space.converted then space := convertSpace space +-- space.rep3DField.lllPt + llprop space == + if ^space.converted then space := convertSpace space + space.rep3DField.llProp + lprop space == + if ^space.converted then space := convertSpace space + space.rep3DField.lProp + + -- this function is just to see how this representation really + -- does work + objects space == + if ^space.converted then space := convertSpace space + numPts := 0$NNI + numCurves := 0$NNI + numPolys := 0$NNI + numConstructs := 0$NNI + for component in children space.subspaceField repeat + #(kid:=children component) = 1 => + #(children first kid) = 1 => numPts := numPts + 1 + numCurves := numCurves + 1 + (#kid = 2) and _ + (#children first kid = 1) and _ + (#children first rest kid ^= 1) => + numPolys := numPolys + 1 + numConstructs := numConstructs + 1 + -- otherwise, a mathematical surface is assumed + -- there could also be garbage representation + -- since there are always more permutations that + -- we could ever want, so the user should not + -- fumble around too much with the structure + -- as other applications need to interpret it + [numPts,numCurves,numPolys,numConstructs] + + check(s) == + ^s.converted => convertSpace s + s + + subspace(s) == s.subspaceField + + coerce(s) == + if ^s.converted then s := convertSpace s + hconcat(["3-Space with "::O, _ + (sizo:=#(s.rep3DField.llliPt))::O, _ + (sizo=1=>" component"::O;" components"::O)]) + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{domain TUPLE Tuple} <>= "TUPLE" -> "PRIMARR" @@ -65885,6 +74001,281 @@ UnivariateSkewPolynomial(x:Symbol, R:Ring, sigma:Automorphism R, delta: R -> R): @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{domain UNISEG UniversalSegment} +<>= +-- seg.spad.pamphlet UniversalSegment.input +)spool UniversalSegment.output +)set message test on +)set message auto off +)clear all +--S 1 of 9 +pints := 1.. +--R +--R +--R (1) 1.. +--R Type: UniversalSegment PositiveInteger +--E 1 + +--S 2 of 9 +nevens := (0..) by -2 +--R +--R +--R (2) 0.. by - 2 +--R Type: UniversalSegment NonNegativeInteger +--E 2 + +--S 3 of 9 +useg: UniversalSegment(Integer) := 3..10 +--R +--R +--R (3) 3..10 +--R Type: UniversalSegment Integer +--E 3 + +--S 4 of 9 +hasHi pints +--R +--R +--R (4) false +--R Type: Boolean +--E 4 + +--S 5 of 9 +hasHi nevens +--R +--R +--R (5) false +--R Type: Boolean +--E 5 + +--S 6 of 9 +hasHi useg +--R +--R +--R (6) true +--R Type: Boolean +--E 6 + +--S 7 of 9 +expand pints +--R +--R +--R (7) [1,2,3,4,5,6,7,8,9,10,...] +--R Type: Stream Integer +--E 7 + +--S 8 of 9 +expand nevens +--R +--R +--R (8) [0,- 2,- 4,- 6,- 8,- 10,- 12,- 14,- 16,- 18,...] +--R Type: Stream Integer +--E 8 + +--S 9 of 9 +expand [1, 3, 10..15, 100..] +--R +--R +--R (9) [1,3,10,11,12,13,14,15,100,101,...] +--R Type: Stream Integer +--E 9 +)spool +)lisp (bye) +@ +<>= +==================================================================== +UniversalSegment examples +==================================================================== + +The UniversalSegment domain generalizes Segment by allowing segments +without a "hi" end point. + + pints := 1.. + 1.. + Type: UniversalSegment PositiveInteger + + nevens := (0..) by -2 + 0.. by - 2 + Type: UniversalSegment NonNegativeInteger + +Values of type Segment are automatically converted to type +UniversalSegment when appropriate. + + useg: UniversalSegment(Integer) := 3..10 + 3..10 + Type: UniversalSegment Integer + +The operation hasHi is used to test whether a segment has a hi end point. + + hasHi pints + false + Type: Boolean + + hasHi nevens + false + Type: Boolean + + hasHi useg + true + Type: Boolean + +All operations available on type Segment apply to UniversalSegment, with +the proviso that expansions produce streams rather than lists. This is +to accommodate infinite expansions. + + expand pints + [1,2,3,4,5,6,7,8,9,10,...] + Type: Stream Integer + + expand nevens + [0,- 2,- 4,- 6,- 8,- 10,- 12,- 14,- 16,- 18,...] + Type: Stream Integer + + expand [1, 3, 10..15, 100..] + [1,3,10,11,12,13,14,15,100,101,...] + Type: Stream Integer + +See Also: +o )help Segment +o )help SegmentBinding +o )help List +o )help Stream +o )show UniversalSegment +o $AXIOM/doc/src/algebra/seg.spad.dvi + +@ +\pagehead{UniversalSegment}{UNISEG} +\pagepic{ps/v103universalsegment.ps}{UNISEG}{1.00} +See also:\\ +\refto{Segment}{SEG} +\refto{SegmentBinding}{SEGBIND} +<>= +)abbrev domain UNISEG UniversalSegment +++ Author: Robert S. Sutor +++ Date Created: 1987 +++ Date Last Updated: June 4, 1991 +++ Basic Operations: +++ Related Domains: Segment +++ Also See: +++ AMS Classifications: +++ Keywords: equation +++ Examples: +++ References: +++ Description: +++ This domain provides segments which may be half open. +++ That is, ranges of the form \spad{a..} or \spad{a..b}. + +UniversalSegment(S: Type): SegmentCategory(S) with + SEGMENT: S -> % + ++ \spad{l..} produces a half open segment, + ++ that is, one with no upper bound. + segment: S -> % + ++ segment(l) is an alternate way to construct the segment \spad{l..}. + coerce : Segment S -> % + ++ coerce(x) allows \spadtype{Segment} values to be used as %. + hasHi: % -> Boolean + ++ hasHi(s) tests whether the segment s has an upper bound. + + if S has SetCategory then SetCategory + + if S has OrderedRing then + SegmentExpansionCategory(S, Stream S) +-- expand : (List %, S) -> Stream S +-- expand : (%, S) -> Stream S + + == add + Rec ==> Record(low: S, high: S, incr: Integer) + Rec2 ==> Record(low: S, incr: Integer) + SEG ==> Segment S + + Rep := Union(Rec2, Rec) + a,b : S + s : % + i: Integer + ls : List % + + segment a == [a, 1]$Rec2 :: Rep + segment(a,b) == [a,b,1]$Rec :: Rep + BY(s,i) == + s case Rec => [lo s, hi s, i]$Rec ::Rep + [lo s, i]$Rec2 :: Rep + + lo s == + s case Rec2 => (s :: Rec2).low + (s :: Rec).low + + low s == + s case Rec2 => (s :: Rec2).low + (s :: Rec).low + + hasHi s == s case Rec + + hi s == + not hasHi(s) => error "hi: segment has no upper bound" + (s :: Rec).high + + high s == + not hasHi(s) => error "high: segment has no upper bound" + (s :: Rec).high + + incr s == + s case Rec2 => (s :: Rec2).incr + (s :: Rec).incr + + SEGMENT(a) == segment a + SEGMENT(a,b) == segment(a,b) + + coerce(sg : SEG): % == segment(lo sg, hi sg) + + convert a == [a,a,1] + + if S has SetCategory then + + (s1:%) = (s2:%) == + s1 case Rec2 => + s2 case Rec2 => + s1.low = s2.low and s1.incr = s2.incr + false + s1 case Rec => + s2 case Rec => + s2.low = s2.low and s1.high=s2.high and s1.incr=s2.incr + false + false + + coerce(s: %): OutputForm == + seg := + e := (lo s)::OutputForm + hasHi s => SEGMENT(e, (hi s)::OutputForm) + SEGMENT e + inc := incr s + inc = 1 => seg + infix(" by "::OutputForm, seg, inc::OutputForm) + + if S has OrderedRing then + expand(s:%) == expand([s]) + map(f:S->S, s:%) == map(f, expand s) + + plusInc(t: S, a: S): S == t + a + + expand(ls: List %):Stream S == + st:Stream S := empty() + null ls => st + + lb:List(Segment S) := nil() + while not null ls and hasHi first ls repeat + s := first ls + ls := rest ls + ns := BY(SEGMENT(lo s, hi s), incr s)$Segment(S) + lb := concat_!(lb,ns) + if not null ls then + s := first ls + st: Stream S := generate(#1 + incr(s)::S, lo s) + else + st: Stream S := empty() + concat(construct expand(lb), st) + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Chapter V} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -66160,6 +74551,980 @@ This is eventually forcibly replaced by a recompiled version. @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{CHAR.lsp BOOTSTRAP} +{\bf CHAR} depends on a chain of +files. We need to break this cycle to build the algebra. So we keep a +cached copy of the translated {\bf CHAR} category which we can write +into the {\bf MID} directory. We compile the lisp code and copy the +{\bf CHAR.o} file to the {\bf OUT} directory. This is eventually +forcibly replaced by a recompiled version. + +Note that this code is not included in the generated catdef.spad file. + +<>= + + +(|/VERSIONCHECK| 2) + +(PUT (QUOTE |CHAR;=;2$B;1|) (QUOTE |SPADreplace|) (QUOTE EQL)) + +(DEFUN |CHAR;=;2$B;1| (|a| |b| |$|) (EQL |a| |b|)) + +(PUT (QUOTE |CHAR;<;2$B;2|) (QUOTE |SPADreplace|) (QUOTE QSLESSP)) + +(DEFUN |CHAR;<;2$B;2| (|a| |b| |$|) (QSLESSP |a| |b|)) + +(PUT (QUOTE |CHAR;size;Nni;3|) (QUOTE |SPADreplace|) (QUOTE (XLAM NIL 256))) + +(DEFUN |CHAR;size;Nni;3| (|$|) 256) + +(DEFUN |CHAR;index;Pi$;4| (|n| |$|) (SPADCALL (|-| |n| 1) (QREFELT |$| 18))) + +(DEFUN |CHAR;lookup;$Pi;5| (|c| |$|) + (PROG (#1=#:G90919) + (RETURN + (PROG1 + (LETT #1# (|+| 1 (SPADCALL |c| (QREFELT |$| 21))) |CHAR;lookup;$Pi;5|) + (|check-subtype| (|>| #1# 0) (QUOTE (|PositiveInteger|)) #1#))))) + +(DEFUN |CHAR;char;I$;6| (|n| |$|) (SPADCALL |n| (QREFELT |$| 23))) + +(PUT (QUOTE |CHAR;ord;$I;7|) (QUOTE |SPADreplace|) (QUOTE (XLAM (|c|) |c|))) + +(DEFUN |CHAR;ord;$I;7| (|c| |$|) |c|) + +(DEFUN |CHAR;random;$;8| (|$|) + (SPADCALL (REMAINDER2 (|random|) (SPADCALL (QREFELT |$| 16))) + (QREFELT |$| 18))) + +(PUT (QUOTE |CHAR;space;$;9|) + (QUOTE |SPADreplace|) (QUOTE (XLAM NIL (QENUM " " 0)))) + +(DEFUN |CHAR;space;$;9| (|$|) (QENUM " " 0)) + +(PUT (QUOTE |CHAR;quote;$;10|) + (QUOTE |SPADreplace|) (QUOTE (XLAM NIL (QENUM "\" " 0)))) + +(DEFUN |CHAR;quote;$;10| (|$|) (QENUM "\" " 0)) + +(PUT (QUOTE |CHAR;escape;$;11|) + (QUOTE |SPADreplace|) (QUOTE (XLAM NIL (QENUM "_ " 0)))) + +(DEFUN |CHAR;escape;$;11| (|$|) (QENUM "_ " 0)) + +(DEFUN |CHAR;coerce;$Of;12| (|c| |$|) + (ELT (QREFELT |$| 10) + (|+| (QREFELT |$| 11) (SPADCALL |c| (QREFELT |$| 21))))) + +(DEFUN |CHAR;digit?;$B;13| (|c| |$|) + (SPADCALL |c| (|spadConstant| |$| 31) (QREFELT |$| 33))) + +(DEFUN |CHAR;hexDigit?;$B;14| (|c| |$|) + (SPADCALL |c| (|spadConstant| |$| 35) (QREFELT |$| 33))) + +(DEFUN |CHAR;upperCase?;$B;15| (|c| |$|) + (SPADCALL |c| (|spadConstant| |$| 37) (QREFELT |$| 33))) + +(DEFUN |CHAR;lowerCase?;$B;16| (|c| |$|) + (SPADCALL |c| (|spadConstant| |$| 39) (QREFELT |$| 33))) + +(DEFUN |CHAR;alphabetic?;$B;17| (|c| |$|) + (SPADCALL |c| (|spadConstant| |$| 41) (QREFELT |$| 33))) + +(DEFUN |CHAR;alphanumeric?;$B;18| (|c| |$|) + (SPADCALL |c| (|spadConstant| |$| 43) (QREFELT |$| 33))) + +(DEFUN |CHAR;latex;$S;19| (|c| |$|) + (STRCONC "\\mbox{`" (STRCONC (|MAKE-FULL-CVEC| 1 |c|) "'}"))) + +(DEFUN |CHAR;char;S$;20| (|s| |$|) + (COND + ((EQL (QCSIZE |s|) 1) + (SPADCALL |s| (SPADCALL |s| (QREFELT |$| 47)) (QREFELT |$| 48))) + ((QUOTE T) (|error| "String is not a single character")))) + +(DEFUN |CHAR;upperCase;2$;21| (|c| |$|) + (QENUM (PNAME (UPCASE (NUM2CHAR (SPADCALL |c| (QREFELT |$| 21))))) 0)) + +(DEFUN |CHAR;lowerCase;2$;22| (|c| |$|) + (QENUM (PNAME (DOWNCASE (NUM2CHAR (SPADCALL |c| (QREFELT |$| 21))))) 0)) + +(DEFUN |Character| NIL + (PROG NIL + (RETURN + (PROG (#1=#:G90941) + (RETURN + (COND + ((LETT #1# (HGET |$ConstructorCache| (QUOTE |Character|)) |Character|) + (|CDRwithIncrement| (CDAR #1#))) + ((QUOTE T) + (|UNWIND-PROTECT| + (PROG1 + (CDDAR + (HPUT |$ConstructorCache| (QUOTE |Character|) + (LIST (CONS NIL (CONS 1 (|Character;|)))))) + (LETT #1# T |Character|)) + (COND + ((NOT #1#) (HREM |$ConstructorCache| (QUOTE |Character|)))))))))))) + +(DEFUN |Character;| NIL + (PROG (|dv$| |$| |pv$| #1=#:G90939 |i|) + (RETURN + (SEQ + (PROGN + (LETT |dv$| (QUOTE (|Character|)) . #2=(|Character|)) + (LETT |$| (GETREFV 53) . #2#) + (QSETREFV |$| 0 |dv$|) + (QSETREFV |$| 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #2#)) + (|haddProp| |$ConstructorCache| (QUOTE |Character|) NIL (CONS 1 |$|)) + (|stuffDomainSlots| |$|) + (QSETREFV |$| 6 (|SingleInteger|)) + (QSETREFV |$| 10 + (SPADCALL + (PROGN + (LETT #1# NIL . #2#) + (SEQ + (LETT |i| 0 . #2#) + G190 + (COND ((QSGREATERP |i| 255) (GO G191))) + (SEQ (EXIT (LETT #1# (CONS (NUM2CHAR |i|) #1#) . #2#))) + (LETT |i| (QSADD1 |i|) . #2#) + (GO G190) + G191 + (EXIT (NREVERSE0 #1#)))) + (QREFELT |$| 9))) + (QSETREFV |$| 11 0) |$|))))) + +(MAKEPROP (QUOTE |Character|) (QUOTE |infovec|) + (LIST (QUOTE + #(NIL NIL NIL NIL NIL NIL (QUOTE |Rep|) (|List| 28) (|PrimitiveArray| 28) + (0 . |construct|) (QUOTE |OutChars|) (QUOTE |minChar|) (|Boolean|) + |CHAR;=;2$B;1| |CHAR;<;2$B;2| (|NonNegativeInteger|) |CHAR;size;Nni;3| + (|Integer|) |CHAR;char;I$;6| (|PositiveInteger|) |CHAR;index;Pi$;4| + |CHAR;ord;$I;7| |CHAR;lookup;$Pi;5| (5 . |coerce|) |CHAR;random;$;8| + |CHAR;space;$;9| |CHAR;quote;$;10| |CHAR;escape;$;11| (|OutputForm|) + |CHAR;coerce;$Of;12| (|CharacterClass|) (10 . |digit|) (|Character|) + (14 . |member?|) |CHAR;digit?;$B;13| (20 . |hexDigit|) + |CHAR;hexDigit?;$B;14| (24 . |upperCase|) |CHAR;upperCase?;$B;15| + (28 . |lowerCase|) |CHAR;lowerCase?;$B;16| (32 . |alphabetic|) + |CHAR;alphabetic?;$B;17| (36 . |alphanumeric|) |CHAR;alphanumeric?;$B;18| + (|String|) |CHAR;latex;$S;19| (40 . |minIndex|) (45 . |elt|) + |CHAR;char;S$;20| |CHAR;upperCase;2$;21| |CHAR;lowerCase;2$;22| + (|SingleInteger|))) (QUOTE #(|~=| 51 |upperCase?| 57 |upperCase| 62 + |space| 67 |size| 71 |random| 75 |quote| 79 |ord| 83 |min| 88 |max| 94 + |lowerCase?| 100 |lowerCase| 105 |lookup| 110 |latex| 115 |index| 120 + |hexDigit?| 125 |hash| 130 |escape| 135 |digit?| 139 |coerce| 144 |char| + 149 |alphanumeric?| 159 |alphabetic?| 164 |>=| 169 |>| 175 |=| 181 |<=| + 187 |<| 193)) (QUOTE NIL) + (CONS + (|makeByteWordVec2| 1 (QUOTE (0 0 0 0 0 0))) + (CONS + (QUOTE #(NIL |OrderedSet&| NIL |SetCategory&| |BasicType&| NIL)) + (CONS + (QUOTE #((|OrderedFinite|) (|OrderedSet|) (|Finite|) (|SetCategory|) + (|BasicType|) (|CoercibleTo| 28))) + (|makeByteWordVec2| 52 + (QUOTE (1 8 0 7 9 1 6 0 17 23 0 30 0 31 2 30 12 32 0 33 0 30 0 35 + 0 30 0 37 0 30 0 39 0 30 0 41 0 30 0 43 1 45 17 0 47 2 45 + 32 0 17 48 2 0 12 0 0 1 1 0 12 0 38 1 0 0 0 50 0 0 0 25 0 + 0 15 16 0 0 0 24 0 0 0 26 1 0 17 0 21 2 0 0 0 0 1 2 0 0 0 + 0 1 1 0 12 0 40 1 0 0 0 51 1 0 19 0 22 1 0 45 0 46 1 0 0 19 + 20 1 0 12 0 36 1 0 52 0 1 0 0 0 27 1 0 12 0 34 1 0 28 0 29 + 1 0 0 45 49 1 0 0 17 18 1 0 12 0 44 1 0 12 0 42 2 0 12 0 0 + 1 2 0 12 0 0 1 2 0 12 0 0 13 2 0 12 0 0 1 2 0 12 0 0 14)))))) + (QUOTE |lookupComplete|))) + +(MAKEPROP (QUOTE |Character|) (QUOTE NILADIC) T) +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{DFLOAT.lsp BOOTSTRAP} +{\bf DFLOAT} depends on itself. +We need to break this cycle to build the algebra. So we keep a +cached copy of the translated {\bf DFLOAT} category which we can write +into the {\bf MID} directory. We compile the lisp code and copy the +{\bf DFLOAT.o} file to the {\bf OUT} directory. This is eventually +forcibly replaced by a recompiled version. + +Note that this code is not included in the generated catdef.spad file. + +<>= + +(|/VERSIONCHECK| 2) + +(DEFUN |DFLOAT;OMwrite;$S;1| (|x| |$|) + (PROG (|sp| |dev| |s|) + (RETURN + (SEQ + (LETT |s| "" |DFLOAT;OMwrite;$S;1|) + (LETT |sp| (|OM-STRINGTOSTRINGPTR| |s|) |DFLOAT;OMwrite;$S;1|) + (LETT |dev| + (SPADCALL |sp| (SPADCALL (QREFELT |$| 7)) (QREFELT |$| 10)) + |DFLOAT;OMwrite;$S;1|) + (SPADCALL |dev| (QREFELT |$| 12)) + (SPADCALL |dev| |x| (QREFELT |$| 14)) + (SPADCALL |dev| (QREFELT |$| 15)) + (SPADCALL |dev| (QREFELT |$| 16)) + (LETT |s| (|OM-STRINGPTRTOSTRING| |sp|) |DFLOAT;OMwrite;$S;1|) + (EXIT |s|))))) + +(DEFUN |DFLOAT;OMwrite;$BS;2| (|x| |wholeObj| |$|) + (PROG (|sp| |dev| |s|) + (RETURN + (SEQ + (LETT |s| "" |DFLOAT;OMwrite;$BS;2|) + (LETT |sp| (|OM-STRINGTOSTRINGPTR| |s|) |DFLOAT;OMwrite;$BS;2|) + (LETT |dev| + (SPADCALL |sp| (SPADCALL (QREFELT |$| 7)) (QREFELT |$| 10)) + |DFLOAT;OMwrite;$BS;2|) + (COND (|wholeObj| (SPADCALL |dev| (QREFELT |$| 12)))) + (SPADCALL |dev| |x| (QREFELT |$| 14)) + (COND (|wholeObj| (SPADCALL |dev| (QREFELT |$| 15)))) + (SPADCALL |dev| (QREFELT |$| 16)) + (LETT |s| (|OM-STRINGPTRTOSTRING| |sp|) |DFLOAT;OMwrite;$BS;2|) + (EXIT |s|))))) + +(DEFUN |DFLOAT;OMwrite;Omd$V;3| (|dev| |x| |$|) + (SEQ + (SPADCALL |dev| (QREFELT |$| 12)) + (SPADCALL |dev| |x| (QREFELT |$| 14)) + (EXIT (SPADCALL |dev| (QREFELT |$| 15))))) + +(DEFUN |DFLOAT;OMwrite;Omd$BV;4| (|dev| |x| |wholeObj| |$|) + (SEQ + (COND (|wholeObj| (SPADCALL |dev| (QREFELT |$| 12)))) + (SPADCALL |dev| |x| (QREFELT |$| 14)) + (EXIT (COND (|wholeObj| (SPADCALL |dev| (QREFELT |$| 15))))))) + +(PUT (QUOTE |DFLOAT;checkComplex|) (QUOTE |SPADreplace|) (QUOTE |C-TO-R|)) + +(DEFUN |DFLOAT;checkComplex| (|x| |$|) (|C-TO-R| |x|)) + +(PUT + (QUOTE |DFLOAT;base;Pi;6|) + (QUOTE |SPADreplace|) + (QUOTE (XLAM NIL (|FLOAT-RADIX| 0.0)))) + +(DEFUN |DFLOAT;base;Pi;6| (|$|) (|FLOAT-RADIX| 0.0)) + +(DEFUN |DFLOAT;mantissa;$I;7| (|x| |$|) (QCAR (|DFLOAT;manexp| |x| |$|))) + +(DEFUN |DFLOAT;exponent;$I;8| (|x| |$|) (QCDR (|DFLOAT;manexp| |x| |$|))) + +(PUT + (QUOTE |DFLOAT;precision;Pi;9|) + (QUOTE |SPADreplace|) + (QUOTE (XLAM NIL (|FLOAT-DIGITS| 0.0)))) + +(DEFUN |DFLOAT;precision;Pi;9| (|$|) (|FLOAT-DIGITS| 0.0)) + +(DEFUN |DFLOAT;bits;Pi;10| (|$|) + (PROG (#1=#:G105705) + (RETURN + (COND + ((EQL (|FLOAT-RADIX| 0.0) 2) (|FLOAT-DIGITS| 0.0)) + ((EQL (|FLOAT-RADIX| 0.0) 16) (|*| 4 (|FLOAT-DIGITS| 0.0))) + ((QUOTE T) + (PROG1 + (LETT #1# + (FIX + (SPADCALL + (|FLOAT-DIGITS| 0.0) + (SPADCALL + (FLOAT (|FLOAT-RADIX| 0.0) |MOST-POSITIVE-LONG-FLOAT|) + (QREFELT |$| 28)) + (QREFELT |$| 29))) + |DFLOAT;bits;Pi;10|) + (|check-subtype| (|>| #1# 0) (QUOTE (|PositiveInteger|)) #1#))))))) + +(PUT + (QUOTE |DFLOAT;max;$;11|) + (QUOTE |SPADreplace|) + (QUOTE (XLAM NIL |MOST-POSITIVE-LONG-FLOAT|))) + +(DEFUN |DFLOAT;max;$;11| (|$|) |MOST-POSITIVE-LONG-FLOAT|) + +(PUT + (QUOTE |DFLOAT;min;$;12|) + (QUOTE |SPADreplace|) + (QUOTE (XLAM NIL |MOST-NEGATIVE-LONG-FLOAT|))) + +(DEFUN |DFLOAT;min;$;12| (|$|) |MOST-NEGATIVE-LONG-FLOAT|) + +(DEFUN |DFLOAT;order;$I;13| (|a| |$|) + (|-| (|+| (|FLOAT-DIGITS| 0.0) (SPADCALL |a| (QREFELT |$| 26))) 1)) + +(PUT + (QUOTE |DFLOAT;Zero;$;14|) + (QUOTE |SPADreplace|) + (QUOTE (XLAM NIL (FLOAT 0 |MOST-POSITIVE-LONG-FLOAT|)))) + +(DEFUN |DFLOAT;Zero;$;14| (|$|) (FLOAT 0 |MOST-POSITIVE-LONG-FLOAT|)) + +(PUT + (QUOTE |DFLOAT;One;$;15|) + (QUOTE |SPADreplace|) + (QUOTE (XLAM NIL (FLOAT 1 |MOST-POSITIVE-LONG-FLOAT|)))) + +(DEFUN |DFLOAT;One;$;15| (|$|) (FLOAT 1 |MOST-POSITIVE-LONG-FLOAT|)) + +(DEFUN |DFLOAT;exp1;$;16| (|$|) + (|/| + (FLOAT 534625820200 |MOST-POSITIVE-LONG-FLOAT|) + (FLOAT 196677847971 |MOST-POSITIVE-LONG-FLOAT|))) + +(PUT (QUOTE |DFLOAT;pi;$;17|) (QUOTE |SPADreplace|) (QUOTE (XLAM NIL PI))) + +(DEFUN |DFLOAT;pi;$;17| (|$|) PI) + +(DEFUN |DFLOAT;coerce;$Of;18| (|x| |$|) (SPADCALL |x| (QREFELT |$| 39))) + +(DEFUN |DFLOAT;convert;$If;19| (|x| |$|) (SPADCALL |x| (QREFELT |$| 42))) + +(PUT (QUOTE |DFLOAT;<;2$B;20|) (QUOTE |SPADreplace|) (QUOTE |<|)) + +(DEFUN |DFLOAT;<;2$B;20| (|x| |y| |$|) (|<| |x| |y|)) + +(PUT (QUOTE |DFLOAT;-;2$;21|) (QUOTE |SPADreplace|) (QUOTE |-|)) + +(DEFUN |DFLOAT;-;2$;21| (|x| |$|) (|-| |x|)) + +(PUT (QUOTE |DFLOAT;+;3$;22|) (QUOTE |SPADreplace|) (QUOTE |+|)) + +(DEFUN |DFLOAT;+;3$;22| (|x| |y| |$|) (|+| |x| |y|)) + +(PUT (QUOTE |DFLOAT;-;3$;23|) (QUOTE |SPADreplace|) (QUOTE |-|)) + +(DEFUN |DFLOAT;-;3$;23| (|x| |y| |$|) (|-| |x| |y|)) + +(PUT (QUOTE |DFLOAT;*;3$;24|) (QUOTE |SPADreplace|) (QUOTE |*|)) + +(DEFUN |DFLOAT;*;3$;24| (|x| |y| |$|) (|*| |x| |y|)) + +(PUT (QUOTE |DFLOAT;*;I2$;25|) (QUOTE |SPADreplace|) (QUOTE |*|)) + +(DEFUN |DFLOAT;*;I2$;25| (|i| |x| |$|) (|*| |i| |x|)) + +(PUT (QUOTE |DFLOAT;max;3$;26|) (QUOTE |SPADreplace|) (QUOTE MAX)) + +(DEFUN |DFLOAT;max;3$;26| (|x| |y| |$|) (MAX |x| |y|)) + +(PUT (QUOTE |DFLOAT;min;3$;27|) (QUOTE |SPADreplace|) (QUOTE MIN)) + +(DEFUN |DFLOAT;min;3$;27| (|x| |y| |$|) (MIN |x| |y|)) + +(PUT (QUOTE |DFLOAT;=;2$B;28|) (QUOTE |SPADreplace|) (QUOTE |=|)) + +(DEFUN |DFLOAT;=;2$B;28| (|x| |y| |$|) (|=| |x| |y|)) + +(PUT (QUOTE |DFLOAT;/;$I$;29|) (QUOTE |SPADreplace|) (QUOTE |/|)) + +(DEFUN |DFLOAT;/;$I$;29| (|x| |i| |$|) (|/| |x| |i|)) + +(DEFUN |DFLOAT;sqrt;2$;30| (|x| |$|) (|DFLOAT;checkComplex| (SQRT |x|) |$|)) + +(DEFUN |DFLOAT;log10;2$;31| (|x| |$|) (|DFLOAT;checkComplex| (|log| |x|) |$|)) + +(PUT (QUOTE |DFLOAT;**;$I$;32|) (QUOTE |SPADreplace|) (QUOTE EXPT)) + +(DEFUN |DFLOAT;**;$I$;32| (|x| |i| |$|) (EXPT |x| |i|)) + +(DEFUN |DFLOAT;**;3$;33| (|x| |y| |$|) + (|DFLOAT;checkComplex| (EXPT |x| |y|) |$|)) + +(PUT + (QUOTE |DFLOAT;coerce;I$;34|) + (QUOTE |SPADreplace|) + (QUOTE (XLAM (|i|) (FLOAT |i| |MOST-POSITIVE-LONG-FLOAT|)))) + +(DEFUN |DFLOAT;coerce;I$;34| (|i| |$|) (FLOAT |i| |MOST-POSITIVE-LONG-FLOAT|)) + +(PUT (QUOTE |DFLOAT;exp;2$;35|) (QUOTE |SPADreplace|) (QUOTE EXP)) + +(DEFUN |DFLOAT;exp;2$;35| (|x| |$|) (EXP |x|)) + +(DEFUN |DFLOAT;log;2$;36| (|x| |$|) (|DFLOAT;checkComplex| (LN |x|) |$|)) + +(DEFUN |DFLOAT;log2;2$;37| (|x| |$|) (|DFLOAT;checkComplex| (LOG2 |x|) |$|)) + +(PUT (QUOTE |DFLOAT;sin;2$;38|) (QUOTE |SPADreplace|) (QUOTE SIN)) + +(DEFUN |DFLOAT;sin;2$;38| (|x| |$|) (SIN |x|)) + +(PUT (QUOTE |DFLOAT;cos;2$;39|) (QUOTE |SPADreplace|) (QUOTE COS)) + +(DEFUN |DFLOAT;cos;2$;39| (|x| |$|) (COS |x|)) + +(PUT (QUOTE |DFLOAT;tan;2$;40|) (QUOTE |SPADreplace|) (QUOTE TAN)) + +(DEFUN |DFLOAT;tan;2$;40| (|x| |$|) (TAN |x|)) + +(PUT (QUOTE |DFLOAT;cot;2$;41|) (QUOTE |SPADreplace|) (QUOTE COT)) + +(DEFUN |DFLOAT;cot;2$;41| (|x| |$|) (COT |x|)) + +(PUT (QUOTE |DFLOAT;sec;2$;42|) (QUOTE |SPADreplace|) (QUOTE SEC)) + +(DEFUN |DFLOAT;sec;2$;42| (|x| |$|) (SEC |x|)) + +(PUT (QUOTE |DFLOAT;csc;2$;43|) (QUOTE |SPADreplace|) (QUOTE CSC)) + +(DEFUN |DFLOAT;csc;2$;43| (|x| |$|) (CSC |x|)) + +(DEFUN |DFLOAT;asin;2$;44| (|x| |$|) (|DFLOAT;checkComplex| (ASIN |x|) |$|)) + +(DEFUN |DFLOAT;acos;2$;45| (|x| |$|) (|DFLOAT;checkComplex| (ACOS |x|) |$|)) + +(PUT (QUOTE |DFLOAT;atan;2$;46|) (QUOTE |SPADreplace|) (QUOTE ATAN)) + +(DEFUN |DFLOAT;atan;2$;46| (|x| |$|) (ATAN |x|)) + +(DEFUN |DFLOAT;acsc;2$;47| (|x| |$|) (|DFLOAT;checkComplex| (ACSC |x|) |$|)) + +(PUT (QUOTE |DFLOAT;acot;2$;48|) (QUOTE |SPADreplace|) (QUOTE ACOT)) + +(DEFUN |DFLOAT;acot;2$;48| (|x| |$|) (ACOT |x|)) + +(DEFUN |DFLOAT;asec;2$;49| (|x| |$|) (|DFLOAT;checkComplex| (ASEC |x|) |$|)) + +(PUT (QUOTE |DFLOAT;sinh;2$;50|) (QUOTE |SPADreplace|) (QUOTE SINH)) + +(DEFUN |DFLOAT;sinh;2$;50| (|x| |$|) (SINH |x|)) + +(PUT (QUOTE |DFLOAT;cosh;2$;51|) (QUOTE |SPADreplace|) (QUOTE COSH)) + +(DEFUN |DFLOAT;cosh;2$;51| (|x| |$|) (COSH |x|)) + +(PUT (QUOTE |DFLOAT;tanh;2$;52|) (QUOTE |SPADreplace|) (QUOTE TANH)) + +(DEFUN |DFLOAT;tanh;2$;52| (|x| |$|) (TANH |x|)) + +(PUT (QUOTE |DFLOAT;csch;2$;53|) (QUOTE |SPADreplace|) (QUOTE CSCH)) + +(DEFUN |DFLOAT;csch;2$;53| (|x| |$|) (CSCH |x|)) + +(PUT (QUOTE |DFLOAT;coth;2$;54|) (QUOTE |SPADreplace|) (QUOTE COTH)) + +(DEFUN |DFLOAT;coth;2$;54| (|x| |$|) (COTH |x|)) + +(PUT (QUOTE |DFLOAT;sech;2$;55|) (QUOTE |SPADreplace|) (QUOTE SECH)) + +(DEFUN |DFLOAT;sech;2$;55| (|x| |$|) (SECH |x|)) + +(PUT (QUOTE |DFLOAT;asinh;2$;56|) (QUOTE |SPADreplace|) (QUOTE ASINH)) + +(DEFUN |DFLOAT;asinh;2$;56| (|x| |$|) (ASINH |x|)) + +(DEFUN |DFLOAT;acosh;2$;57| (|x| |$|) (|DFLOAT;checkComplex| (ACOSH |x|) |$|)) + +(DEFUN |DFLOAT;atanh;2$;58| (|x| |$|) (|DFLOAT;checkComplex| (ATANH |x|) |$|)) + +(PUT (QUOTE |DFLOAT;acsch;2$;59|) (QUOTE |SPADreplace|) (QUOTE ACSCH)) + +(DEFUN |DFLOAT;acsch;2$;59| (|x| |$|) (ACSCH |x|)) + +(DEFUN |DFLOAT;acoth;2$;60| (|x| |$|) (|DFLOAT;checkComplex| (ACOTH |x|) |$|)) + +(DEFUN |DFLOAT;asech;2$;61| (|x| |$|) (|DFLOAT;checkComplex| (ASECH |x|) |$|)) + +(PUT (QUOTE |DFLOAT;/;3$;62|) (QUOTE |SPADreplace|) (QUOTE |/|)) + +(DEFUN |DFLOAT;/;3$;62| (|x| |y| |$|) (|/| |x| |y|)) + +(PUT (QUOTE |DFLOAT;negative?;$B;63|) (QUOTE |SPADreplace|) (QUOTE MINUSP)) + +(DEFUN |DFLOAT;negative?;$B;63| (|x| |$|) (MINUSP |x|)) + +(PUT (QUOTE |DFLOAT;zero?;$B;64|) (QUOTE |SPADreplace|) (QUOTE ZEROP)) + +(DEFUN |DFLOAT;zero?;$B;64| (|x| |$|) (ZEROP |x|)) + +(PUT (QUOTE |DFLOAT;hash;$I;65|) (QUOTE |SPADreplace|) (QUOTE HASHEQ)) + +(DEFUN |DFLOAT;hash;$I;65| (|x| |$|) (HASHEQ |x|)) + +(DEFUN |DFLOAT;recip;$U;66| (|x| |$|) + (COND + ((ZEROP |x|) (CONS 1 "failed")) + ((QUOTE T) (CONS 0 (|/| 1.0 |x|))))) + +(PUT + (QUOTE |DFLOAT;differentiate;2$;67|) + (QUOTE |SPADreplace|) + (QUOTE (XLAM (|x|) 0.0))) + +(DEFUN |DFLOAT;differentiate;2$;67| (|x| |$|) 0.0) + +(DEFUN |DFLOAT;Gamma;2$;68| (|x| |$|) (SPADCALL |x| (QREFELT |$| 93))) + +(DEFUN |DFLOAT;Beta;3$;69| (|x| |y| |$|) (SPADCALL |x| |y| (QREFELT |$| 95))) + +(PUT (QUOTE |DFLOAT;wholePart;$I;70|) (QUOTE |SPADreplace|) (QUOTE FIX)) + +(DEFUN |DFLOAT;wholePart;$I;70| (|x| |$|) (FIX |x|)) + +(DEFUN |DFLOAT;float;2IPi$;71| (|ma| |ex| |b| |$|) + (|*| |ma| (EXPT (FLOAT |b| |MOST-POSITIVE-LONG-FLOAT|) |ex|))) + +(PUT + (QUOTE |DFLOAT;convert;2$;72|) + (QUOTE |SPADreplace|) + (QUOTE (XLAM (|x|) |x|))) + +(DEFUN |DFLOAT;convert;2$;72| (|x| |$|) |x|) + +(DEFUN |DFLOAT;convert;$F;73| (|x| |$|) (SPADCALL |x| (QREFELT |$| 101))) + +(DEFUN |DFLOAT;rationalApproximation;$NniF;74| (|x| |d| |$|) + (SPADCALL |x| |d| 10 (QREFELT |$| 105))) + +(DEFUN |DFLOAT;atan;3$;75| (|x| |y| |$|) + (PROG (|theta|) + (RETURN + (SEQ + (COND + ((|=| |x| 0.0) + (COND + ((|<| 0.0 |y|) (|/| PI 2)) + ((|<| |y| 0.0) (|-| (|/| PI 2))) + ((QUOTE T) 0.0))) + ((QUOTE T) + (SEQ + (LETT |theta| + (ATAN (|FLOAT-SIGN| 1.0 (|/| |y| |x|))) + |DFLOAT;atan;3$;75|) + (COND + ((|<| |x| 0.0) (LETT |theta| (|-| PI |theta|) |DFLOAT;atan;3$;75|))) + (COND ((|<| |y| 0.0) (LETT |theta| (|-| |theta|) |DFLOAT;atan;3$;75|))) + (EXIT |theta|)))))))) + +(DEFUN |DFLOAT;retract;$F;76| (|x| |$|) + (PROG (#1=#:G105780) + (RETURN + (SPADCALL |x| + (PROG1 + (LETT #1# (|-| (|FLOAT-DIGITS| 0.0) 1) |DFLOAT;retract;$F;76|) + (|check-subtype| (|>=| #1# 0) (QUOTE (|NonNegativeInteger|)) #1#)) + (|FLOAT-RADIX| 0.0) + (QREFELT |$| 105))))) + +(DEFUN |DFLOAT;retractIfCan;$U;77| (|x| |$|) + (PROG (#1=#:G105785) + (RETURN + (CONS 0 + (SPADCALL |x| + (PROG1 + (LETT #1# (|-| (|FLOAT-DIGITS| 0.0) 1) |DFLOAT;retractIfCan;$U;77|) + (|check-subtype| (|>=| #1# 0) (QUOTE (|NonNegativeInteger|)) #1#)) + (|FLOAT-RADIX| 0.0) + (QREFELT |$| 105)))))) + +(DEFUN |DFLOAT;retract;$I;78| (|x| |$|) + (PROG (|n|) + (RETURN + (SEQ + (LETT |n| (FIX |x|) |DFLOAT;retract;$I;78|) + (EXIT + (COND + ((|=| |x| (FLOAT |n| |MOST-POSITIVE-LONG-FLOAT|)) |n|) + ((QUOTE T) (|error| "Not an integer")))))))) + +(DEFUN |DFLOAT;retractIfCan;$U;79| (|x| |$|) + (PROG (|n|) + (RETURN + (SEQ + (LETT |n| (FIX |x|) |DFLOAT;retractIfCan;$U;79|) + (EXIT + (COND + ((|=| |x| (FLOAT |n| |MOST-POSITIVE-LONG-FLOAT|)) (CONS 0 |n|)) + ((QUOTE T) (CONS 1 "failed")))))))) + +(DEFUN |DFLOAT;sign;$I;80| (|x| |$|) + (SPADCALL (|FLOAT-SIGN| |x| 1.0) (QREFELT |$| 111))) + +(PUT + (QUOTE |DFLOAT;abs;2$;81|) + (QUOTE |SPADreplace|) + (QUOTE (XLAM (|x|) (|FLOAT-SIGN| 1.0 |x|)))) + +(DEFUN |DFLOAT;abs;2$;81| (|x| |$|) (|FLOAT-SIGN| 1.0 |x|)) + +(DEFUN |DFLOAT;manexp| (|x| |$|) + (PROG (|s| #1=#:G105806 |me| |two53|) + (RETURN + (SEQ + (EXIT + (COND + ((ZEROP |x|) (CONS 0 0)) + ((QUOTE T) + (SEQ + (LETT |s| (SPADCALL |x| (QREFELT |$| 114)) |DFLOAT;manexp|) + (LETT |x| (|FLOAT-SIGN| 1.0 |x|) |DFLOAT;manexp|) + (COND + ((|<| |MOST-POSITIVE-LONG-FLOAT| |x|) + (PROGN + (LETT #1# + (CONS + (|+| + (|*| + |s| + (SPADCALL |MOST-POSITIVE-LONG-FLOAT| (QREFELT |$| 25))) 1) + (SPADCALL |MOST-POSITIVE-LONG-FLOAT| (QREFELT |$| 26))) + |DFLOAT;manexp|) + (GO #1#)))) + (LETT |me| (MANEXP |x|) |DFLOAT;manexp|) + (LETT |two53| + (EXPT (|FLOAT-RADIX| 0.0) (|FLOAT-DIGITS| 0.0)) |DFLOAT;manexp|) + (EXIT + (CONS + (|*| |s| (FIX (|*| |two53| (QCAR |me|)))) + (|-| (QCDR |me|) (|FLOAT-DIGITS| 0.0)))))))) + #1# + (EXIT #1#))))) + +(DEFUN |DFLOAT;rationalApproximation;$2NniF;83| (|f| |d| |b| |$|) + (PROG (|#G102| |nu| |ex| BASE #1=#:G105809 |de| |tol| |#G103| |q| |r| + |p2| |q2| #2=#:G105827 |#G104| |#G105| |p0| |p1| |#G106| |#G107| + |q0| |q1| |#G108| |#G109| |s| |t| #3=#:G105825) + (RETURN + (SEQ + (EXIT + (SEQ + (PROGN + (LETT |#G102| + (|DFLOAT;manexp| |f| |$|) + |DFLOAT;rationalApproximation;$2NniF;83|) + (LETT |nu| (QCAR |#G102|) |DFLOAT;rationalApproximation;$2NniF;83|) + (LETT |ex| (QCDR |#G102|) |DFLOAT;rationalApproximation;$2NniF;83|) + |#G102|) + (LETT BASE (|FLOAT-RADIX| 0.0) |DFLOAT;rationalApproximation;$2NniF;83|) + (EXIT + (COND + ((|<| |ex| 0) + (SEQ + (LETT |de| + (EXPT BASE + (PROG1 + (LETT #1# (|-| |ex|) |DFLOAT;rationalApproximation;$2NniF;83|) + (|check-subtype| + (|>=| #1# 0) + (QUOTE (|NonNegativeInteger|)) + #1#))) + |DFLOAT;rationalApproximation;$2NniF;83|) + (EXIT + (COND + ((|<| |b| 2) (|error| "base must be > 1")) + ((QUOTE T) + (SEQ + (LETT |tol| + (EXPT |b| |d|) + |DFLOAT;rationalApproximation;$2NniF;83|) + (LETT |s| |nu| |DFLOAT;rationalApproximation;$2NniF;83|) + (LETT |t| |de| |DFLOAT;rationalApproximation;$2NniF;83|) + (LETT |p0| 0 |DFLOAT;rationalApproximation;$2NniF;83|) + (LETT |p1| 1 |DFLOAT;rationalApproximation;$2NniF;83|) + (LETT |q0| 1 |DFLOAT;rationalApproximation;$2NniF;83|) + (LETT |q1| 0 |DFLOAT;rationalApproximation;$2NniF;83|) + (EXIT + (SEQ + G190 + NIL + (SEQ + (PROGN + (LETT |#G103| + (DIVIDE2 |s| |t|) + |DFLOAT;rationalApproximation;$2NniF;83|) + (LETT |q| + (QCAR |#G103|) + |DFLOAT;rationalApproximation;$2NniF;83|) + (LETT |r| + (QCDR |#G103|) + |DFLOAT;rationalApproximation;$2NniF;83|) + |#G103|) + (LETT |p2| + (|+| (|*| |q| |p1|) |p0|) + |DFLOAT;rationalApproximation;$2NniF;83|) + (LETT |q2| + (|+| (|*| |q| |q1|) |q0|) + |DFLOAT;rationalApproximation;$2NniF;83|) + (COND + ((OR + (EQL |r| 0) + (|<| + (SPADCALL |tol| + (ABS (|-| (|*| |nu| |q2|) (|*| |de| |p2|))) + (QREFELT |$| 118)) + (|*| |de| (ABS |p2|)))) + (EXIT + (PROGN + (LETT #2# + (SPADCALL |p2| |q2| (QREFELT |$| 117)) + |DFLOAT;rationalApproximation;$2NniF;83|) + (GO #2#))))) + (PROGN + (LETT |#G104| |p1| |DFLOAT;rationalApproximation;$2NniF;83|) + (LETT |#G105| |p2| |DFLOAT;rationalApproximation;$2NniF;83|) + (LETT |p0| |#G104| |DFLOAT;rationalApproximation;$2NniF;83|) + (LETT |p1| |#G105| |DFLOAT;rationalApproximation;$2NniF;83|)) + (PROGN + (LETT |#G106| |q1| |DFLOAT;rationalApproximation;$2NniF;83|) + (LETT |#G107| |q2| |DFLOAT;rationalApproximation;$2NniF;83|) + (LETT |q0| |#G106| |DFLOAT;rationalApproximation;$2NniF;83|) + (LETT |q1| |#G107| |DFLOAT;rationalApproximation;$2NniF;83|)) + (EXIT + (PROGN + (LETT |#G108| |t| |DFLOAT;rationalApproximation;$2NniF;83|) + (LETT |#G109| |r| |DFLOAT;rationalApproximation;$2NniF;83|) + (LETT |s| |#G108| |DFLOAT;rationalApproximation;$2NniF;83|) + (LETT |t| + |#G109| + |DFLOAT;rationalApproximation;$2NniF;83|)))) + NIL (GO G190) G191 (EXIT NIL))))))))) + ((QUOTE T) + (SPADCALL + (|*| |nu| + (EXPT BASE + (PROG1 + (LETT #3# |ex| |DFLOAT;rationalApproximation;$2NniF;83|) + (|check-subtype| + (|>=| #3# 0) + (QUOTE (|NonNegativeInteger|)) + #3#)))) + (QREFELT |$| 119))))))) + #2# + (EXIT #2#))))) + +(DEFUN |DFLOAT;**;$F$;84| (|x| |r| |$|) + (PROG (|n| |d| #1=#:G105837) + (RETURN + (SEQ + (EXIT + (COND + ((ZEROP |x|) + (COND + ((SPADCALL |r| (QREFELT |$| 120)) (|error| "0**0 is undefined")) + ((SPADCALL |r| (QREFELT |$| 121)) (|error| "division by 0")) + ((QUOTE T) 0.0))) + ((OR (SPADCALL |r| (QREFELT |$| 120)) (SPADCALL |x| (QREFELT |$| 122))) + 1.0) + ((QUOTE T) + (COND + ((SPADCALL |r| (QREFELT |$| 123)) |x|) + ((QUOTE T) + (SEQ + (LETT |n| (SPADCALL |r| (QREFELT |$| 124)) |DFLOAT;**;$F$;84|) + (LETT |d| (SPADCALL |r| (QREFELT |$| 125)) |DFLOAT;**;$F$;84|) + (EXIT + (COND + ((MINUSP |x|) + (COND + ((ODDP |d|) + (COND + ((ODDP |n|) + (PROGN + (LETT #1# + (|-| (SPADCALL (|-| |x|) |r| (QREFELT |$| 126))) + |DFLOAT;**;$F$;84|) + (GO #1#))) + ((QUOTE T) + (PROGN + (LETT #1# + (SPADCALL (|-| |x|) |r| (QREFELT |$| 126)) + |DFLOAT;**;$F$;84|) + (GO #1#))))) + ((QUOTE T) (|error| "negative root")))) + ((EQL |d| 2) (EXPT (SPADCALL |x| (QREFELT |$| 54)) |n|)) + ((QUOTE T) + (SPADCALL |x| + (|/| + (FLOAT |n| |MOST-POSITIVE-LONG-FLOAT|) + (FLOAT |d| |MOST-POSITIVE-LONG-FLOAT|)) + (QREFELT |$| 57))))))))))) + #1# + (EXIT #1#))))) + +(DEFUN |DoubleFloat| NIL + (PROG NIL + (RETURN + (PROG (#1=#:G105850) + (RETURN + (COND + ((LETT #1# + (HGET |$ConstructorCache| (QUOTE |DoubleFloat|)) + |DoubleFloat|) + (|CDRwithIncrement| (CDAR #1#))) + ((QUOTE T) + (|UNWIND-PROTECT| + (PROG1 + (CDDAR + (HPUT |$ConstructorCache| + (QUOTE |DoubleFloat|) + (LIST (CONS NIL (CONS 1 (|DoubleFloat;|)))))) + (LETT #1# T |DoubleFloat|)) + (COND + ((NOT #1#) (HREM |$ConstructorCache| (QUOTE |DoubleFloat|)))))))))))) + +(DEFUN |DoubleFloat;| NIL + (PROG (|dv$| |$| |pv$|) + (RETURN + (PROGN + (LETT |dv$| (QUOTE (|DoubleFloat|)) . #1=(|DoubleFloat|)) + (LETT |$| (GETREFV 140) . #1#) + (QSETREFV |$| 0 |dv$|) + (QSETREFV |$| 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #1#)) + (|haddProp| |$ConstructorCache| (QUOTE |DoubleFloat|) NIL (CONS 1 |$|)) + (|stuffDomainSlots| |$|) |$|)))) + +(MAKEPROP + (QUOTE |DoubleFloat|) + (QUOTE |infovec|) + (LIST + (QUOTE #(NIL NIL NIL NIL NIL NIL (|OpenMathEncoding|) (0 . |OMencodingXML|) + (|String|) (|OpenMathDevice|) (4 . |OMopenString|) (|Void|) + (10 . |OMputObject|) (|DoubleFloat|) (15 . |OMputFloat|) + (21 . |OMputEndObject|) (26 . |OMclose|) |DFLOAT;OMwrite;$S;1| + (|Boolean|) |DFLOAT;OMwrite;$BS;2| |DFLOAT;OMwrite;Omd$V;3| + |DFLOAT;OMwrite;Omd$BV;4| (|PositiveInteger|) |DFLOAT;base;Pi;6| + (|Integer|) |DFLOAT;mantissa;$I;7| |DFLOAT;exponent;$I;8| + |DFLOAT;precision;Pi;9| |DFLOAT;log2;2$;37| (31 . |*|) + |DFLOAT;bits;Pi;10| |DFLOAT;max;$;11| |DFLOAT;min;$;12| + |DFLOAT;order;$I;13| + (CONS IDENTITY (FUNCALL (|dispatchFunction| |DFLOAT;Zero;$;14|) |$|)) + (CONS IDENTITY (FUNCALL (|dispatchFunction| |DFLOAT;One;$;15|) |$|)) + |DFLOAT;exp1;$;16| |DFLOAT;pi;$;17| (|OutputForm|) (37 . |outputForm|) + |DFLOAT;coerce;$Of;18| (|InputForm|) (42 . |convert|) + |DFLOAT;convert;$If;19| |DFLOAT;<;2$B;20| |DFLOAT;-;2$;21| + |DFLOAT;+;3$;22| |DFLOAT;-;3$;23| |DFLOAT;*;3$;24| |DFLOAT;*;I2$;25| + |DFLOAT;max;3$;26| |DFLOAT;min;3$;27| |DFLOAT;=;2$B;28| + |DFLOAT;/;$I$;29| |DFLOAT;sqrt;2$;30| |DFLOAT;log10;2$;31| + |DFLOAT;**;$I$;32| |DFLOAT;**;3$;33| |DFLOAT;coerce;I$;34| + |DFLOAT;exp;2$;35| |DFLOAT;log;2$;36| |DFLOAT;sin;2$;38| + |DFLOAT;cos;2$;39| |DFLOAT;tan;2$;40| |DFLOAT;cot;2$;41| + |DFLOAT;sec;2$;42| |DFLOAT;csc;2$;43| |DFLOAT;asin;2$;44| + |DFLOAT;acos;2$;45| |DFLOAT;atan;2$;46| |DFLOAT;acsc;2$;47| + |DFLOAT;acot;2$;48| |DFLOAT;asec;2$;49| |DFLOAT;sinh;2$;50| + |DFLOAT;cosh;2$;51| |DFLOAT;tanh;2$;52| |DFLOAT;csch;2$;53| + |DFLOAT;coth;2$;54| |DFLOAT;sech;2$;55| |DFLOAT;asinh;2$;56| + |DFLOAT;acosh;2$;57| |DFLOAT;atanh;2$;58| |DFLOAT;acsch;2$;59| + |DFLOAT;acoth;2$;60| |DFLOAT;asech;2$;61| |DFLOAT;/;3$;62| + |DFLOAT;negative?;$B;63| |DFLOAT;zero?;$B;64| |DFLOAT;hash;$I;65| + (|Union| |$| (QUOTE "failed")) |DFLOAT;recip;$U;66| + |DFLOAT;differentiate;2$;67| (|DoubleFloatSpecialFunctions|) + (47 . |Gamma|) |DFLOAT;Gamma;2$;68| (52 . |Beta|) |DFLOAT;Beta;3$;69| + |DFLOAT;wholePart;$I;70| |DFLOAT;float;2IPi$;71| |DFLOAT;convert;2$;72| + (|Float|) (58 . |convert|) |DFLOAT;convert;$F;73| (|Fraction| 24) + (|NonNegativeInteger|) |DFLOAT;rationalApproximation;$2NniF;83| + |DFLOAT;rationalApproximation;$NniF;74| |DFLOAT;atan;3$;75| + |DFLOAT;retract;$F;76| (|Union| 103 (QUOTE "failed")) + |DFLOAT;retractIfCan;$U;77| |DFLOAT;retract;$I;78| + (|Union| 24 (QUOTE "failed")) |DFLOAT;retractIfCan;$U;79| + |DFLOAT;sign;$I;80| |DFLOAT;abs;2$;81| (63 . |Zero|) (67 . |/|) + (73 . |*|) (79 . |coerce|) (84 . |zero?|) (89 . |negative?|) + (94 . |one?|) (99 . |one?|) (104 . |numer|) (109 . |denom|) + |DFLOAT;**;$F$;84| (|Pattern| 100) (|PatternMatchResult| 100 |$|) + (|Factored| |$|) (|Union| 131 (QUOTE "failed")) (|List| |$|) + (|Record| (|:| |coef1| |$|) (|:| |coef2| |$|) (|:| |generator| |$|)) + (|Record| (|:| |coef1| |$|) (|:| |coef2| |$|)) + (|Union| 133 (QUOTE "failed")) + (|Record| (|:| |quotient| |$|) (|:| |remainder| |$|)) + (|Record| (|:| |coef| 131) (|:| |generator| |$|)) + (|SparseUnivariatePolynomial| |$|) (|Record| (|:| |unit| |$|) + (|:| |canonical| |$|) (|:| |associate| |$|)) (|SingleInteger|))) + (QUOTE #(|~=| 114 |zero?| 120 |wholePart| 125 |unitNormal| 130 + |unitCanonical| 135 |unit?| 140 |truncate| 145 |tanh| 150 |tan| + 155 |subtractIfCan| 160 |squareFreePart| 166 |squareFree| 171 + |sqrt| 176 |sizeLess?| 181 |sinh| 187 |sin| 192 |sign| 197 |sech| + 202 |sec| 207 |sample| 212 |round| 216 |retractIfCan| 221 |retract| + 231 |rem| 241 |recip| 247 |rationalApproximation| 252 |quo| 265 + |principalIdeal| 271 |prime?| 276 |precision| 281 |positive?| 285 + |pi| 290 |patternMatch| 294 |order| 301 |one?| 306 |nthRoot| 311 + |norm| 317 |negative?| 322 |multiEuclidean| 327 |min| 333 |max| 343 + |mantissa| 353 |log2| 358 |log10| 363 |log| 368 |lcm| 373 |latex| + 384 |inv| 389 |hash| 394 |gcdPolynomial| 404 |gcd| 410 |fractionPart| + 421 |floor| 426 |float| 431 |factor| 444 |extendedEuclidean| 449 + |exquo| 462 |expressIdealMember| 468 |exponent| 474 |exp1| 479 |exp| + 483 |euclideanSize| 488 |divide| 493 |digits| 499 |differentiate| + 503 |csch| 514 |csc| 519 |coth| 524 |cot| 529 |cosh| 534 |cos| 539 + |convert| 544 |coerce| 564 |characteristic| 594 |ceiling| 598 |bits| + 603 |base| 607 |atanh| 611 |atan| 616 |associates?| 627 |asinh| 633 + |asin| 638 |asech| 643 |asec| 648 |acsch| 653 |acsc| 658 |acoth| 663 + |acot| 668 |acosh| 673 |acos| 678 |abs| 683 |^| 688 |Zero| 706 |One| + 710 |OMwrite| 714 |Gamma| 738 D 743 |Beta| 754 |>=| 760 |>| 766 |=| + 772 |<=| 778 |<| 784 |/| 790 |-| 802 |+| 813 |**| 819 |*| 849)) + (QUOTE ((|approximate| . 0) (|canonicalsClosed| . 0) + (|canonicalUnitNormal| . 0) (|noZeroDivisors| . 0) + ((|commutative| "*") . 0) (|rightUnitary| . 0) (|leftUnitary| . 0) + (|unitsKnown| . 0))) + (CONS + (|makeByteWordVec2| 1 (QUOTE (0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 + 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0))) + (CONS + (QUOTE #(|FloatingPointSystem&| |RealNumberSystem&| |Field&| + |EuclideanDomain&| NIL |UniqueFactorizationDomain&| |GcdDomain&| + |DivisionRing&| |IntegralDomain&| |Algebra&| |Algebra&| + |DifferentialRing&| NIL |OrderedRing&| |Module&| NIL NIL |Module&| + NIL NIL NIL |Ring&| NIL NIL NIL NIL NIL NIL NIL |AbelianGroup&| NIL + NIL |AbelianMonoid&| |Monoid&| NIL |OrderedSet&| |AbelianSemiGroup&| + |SemiGroup&| |TranscendentalFunctionCategory&| NIL |SetCategory&| NIL + |ElementaryFunctionCategory&| NIL |HyperbolicFunctionCategory&| + |ArcTrigonometricFunctionCategory&| |TrigonometricFunctionCategory&| + NIL NIL |RadicalCategory&| |RetractableTo&| |RetractableTo&| NIL + NIL |BasicType&| NIL)) (CONS (QUOTE #((|FloatingPointSystem|) + (|RealNumberSystem|) (|Field|) (|EuclideanDomain|) + (|PrincipalIdealDomain|) (|UniqueFactorizationDomain|) + (|GcdDomain|) (|DivisionRing|) (|IntegralDomain|) (|Algebra| 103) + (|Algebra| |$$|) (|DifferentialRing|) (|CharacteristicZero|) + (|OrderedRing|) (|Module| 103) (|EntireRing|) (|CommutativeRing|) + (|Module| |$$|) (|OrderedAbelianGroup|) (|BiModule| 103 103) + (|BiModule| |$$| |$$|) (|Ring|) (|OrderedCancellationAbelianMonoid|) + (|RightModule| 103) (|LeftModule| 103) (|LeftModule| |$$|) (|Rng|) + (|RightModule| |$$|) (|OrderedAbelianMonoid|) (|AbelianGroup|) + (|OrderedAbelianSemiGroup|) (|CancellationAbelianMonoid|) + (|AbelianMonoid|) (|Monoid|) (|PatternMatchable| 100) (|OrderedSet|) + (|AbelianSemiGroup|) (|SemiGroup|) (|TranscendentalFunctionCategory|) + (|RealConstant|) (|SetCategory|) (|ConvertibleTo| 41) + (|ElementaryFunctionCategory|) (|ArcHyperbolicFunctionCategory|) + (|HyperbolicFunctionCategory|) (|ArcTrigonometricFunctionCategory|) + (|TrigonometricFunctionCategory|) (|OpenMath|) (|ConvertibleTo| 127) + (|RadicalCategory|) (|RetractableTo| 103) (|RetractableTo| 24) + (|ConvertibleTo| 100) (|ConvertibleTo| 13) (|BasicType|) + (|CoercibleTo| 38))) + (|makeByteWordVec2| 139 + (QUOTE (0 6 0 7 2 9 0 8 6 10 1 9 11 0 12 2 9 11 0 13 14 1 9 11 0 15 + 1 9 11 0 16 2 0 0 22 0 29 1 38 0 13 39 1 41 0 13 42 1 92 13 13 93 2 92 + 13 13 13 95 1 100 0 13 101 0 103 0 116 2 103 0 24 24 117 2 24 0 104 0 + 118 1 103 0 24 119 1 103 18 0 120 1 103 18 0 121 1 0 18 0 122 1 103 18 + 0 123 1 103 24 0 124 1 103 24 0 125 2 0 18 0 0 1 1 0 18 0 87 1 0 24 0 + 97 1 0 138 0 1 1 0 0 0 1 1 0 18 0 1 1 0 0 0 1 1 0 0 0 75 1 0 0 0 63 2 + 0 89 0 0 1 1 0 0 0 1 1 0 129 0 1 1 0 0 0 54 2 0 18 0 0 1 1 0 0 0 73 1 + 0 0 0 61 1 0 24 0 114 1 0 0 0 78 1 0 0 0 65 0 0 0 1 1 0 0 0 1 1 0 109 + 0 110 1 0 112 0 113 1 0 103 0 108 1 0 24 0 111 2 0 0 0 0 1 1 0 89 0 + 90 2 0 103 0 104 106 3 0 103 0 104 104 105 2 0 0 0 0 1 1 0 136 131 1 + 1 0 18 0 1 0 0 22 27 1 0 18 0 1 0 0 0 37 3 0 128 0 127 128 1 1 0 24 + 0 33 1 0 18 0 122 2 0 0 0 24 1 1 0 0 0 1 1 0 18 0 86 2 0 130 131 0 1 + 0 0 0 32 2 0 0 0 0 51 0 0 0 31 2 0 0 0 0 50 1 0 24 0 25 1 0 0 0 28 1 + 0 0 0 55 1 0 0 0 60 1 0 0 131 1 2 0 0 0 0 1 1 0 8 0 1 1 0 0 0 1 1 0 + 24 0 88 1 0 139 0 1 2 0 137 137 137 1 1 0 0 131 1 2 0 0 0 0 1 1 0 0 + 0 1 1 0 0 0 1 3 0 0 24 24 22 98 2 0 0 24 24 1 1 0 129 0 1 2 0 132 0 + 0 1 3 0 134 0 0 0 1 2 0 89 0 0 1 2 0 130 131 0 1 1 0 24 0 26 0 0 0 + 36 1 0 0 0 59 1 0 104 0 1 2 0 135 0 0 1 0 0 22 1 1 0 0 0 91 2 0 0 0 + 104 1 1 0 0 0 76 1 0 0 0 66 1 0 0 0 77 1 0 0 0 64 1 0 0 0 74 1 0 0 0 + 62 1 0 41 0 43 1 0 127 0 1 1 0 13 0 99 1 0 100 0 102 1 0 0 103 1 1 0 + 0 24 58 1 0 0 103 1 1 0 0 24 58 1 0 0 0 1 1 0 38 0 40 0 0 104 1 1 0 + 0 0 1 0 0 22 30 0 0 22 23 1 0 0 0 81 2 0 0 0 0 107 1 0 0 0 69 2 0 18 + 0 0 1 1 0 0 0 79 1 0 0 0 67 1 0 0 0 84 1 0 0 0 72 1 0 0 0 82 1 0 0 0 + 70 1 0 0 0 83 1 0 0 0 71 1 0 0 0 80 1 0 0 0 68 1 0 0 0 115 2 0 0 0 + 24 1 2 0 0 0 104 1 2 0 0 0 22 1 0 0 0 34 0 0 0 35 2 0 11 9 0 20 3 0 + 11 9 0 18 21 1 0 8 0 17 2 0 8 0 18 19 1 0 0 0 94 1 0 0 0 1 2 0 0 0 + 104 1 2 0 0 0 0 96 2 0 18 0 0 1 2 0 18 0 0 1 2 0 18 0 0 52 2 0 18 0 + 0 1 2 0 18 0 0 44 2 0 0 0 24 53 2 0 0 0 0 85 2 0 0 0 0 47 1 0 0 0 + 45 2 0 0 0 0 46 2 0 0 0 0 57 2 0 0 0 103 126 2 0 0 0 24 56 2 0 0 0 + 104 1 2 0 0 0 22 1 2 0 0 0 103 1 2 0 0 103 0 1 2 0 0 0 0 48 2 0 0 + 24 0 49 2 0 0 104 0 1 2 0 0 22 0 29)))))) + (QUOTE |lookupComplete|))) + +(MAKEPROP (QUOTE |DoubleFloat|) (QUOTE NILADIC) T) +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{ILIST.lsp BOOTSTRAP} {\bf ILIST} depends on a chain of files. We need to break this cycle to build the algebra. So we keep a @@ -67286,6 +76651,111 @@ Note that this code is not included in the generated catdef.spad file. (MAKEPROP (QUOTE |Integer|) (QUOTE NILADIC) T) @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{ISTRING.lsp BOOTSTRAP} +{\bf ISTRING} depends on a chain of +files. We need to break this cycle to build the algebra. So we keep a +cached copy of the translated {\bf ISTRING} category which we can write +into the {\bf MID} directory. We compile the lisp code and copy the +{\bf ISTRING.o} file to the {\bf OUT} directory. This is eventually +forcibly replaced by a recompiled version. + +Note that this code is not included in the generated catdef.spad file. + +<>= + +(|/VERSIONCHECK| 2) + +(PUT (QUOTE |ISTRING;new;NniC$;1|) (QUOTE |SPADreplace|) (QUOTE |MAKE-FULL-CVEC|)) + +(DEFUN |ISTRING;new;NniC$;1| (|n| |c| |$|) (|MAKE-FULL-CVEC| |n| |c|)) + +(PUT (QUOTE |ISTRING;empty;$;2|) (QUOTE |SPADreplace|) (QUOTE (XLAM NIL (|MAKE-FULL-CVEC| 0)))) + +(DEFUN |ISTRING;empty;$;2| (|$|) (|MAKE-FULL-CVEC| 0)) + +(DEFUN |ISTRING;empty?;$B;3| (|s| |$|) (EQL (QCSIZE |s|) 0)) + +(PUT (QUOTE |ISTRING;#;$Nni;4|) (QUOTE |SPADreplace|) (QUOTE QCSIZE)) + +(DEFUN |ISTRING;#;$Nni;4| (|s| |$|) (QCSIZE |s|)) + +(PUT (QUOTE |ISTRING;=;2$B;5|) (QUOTE |SPADreplace|) (QUOTE EQUAL)) + +(DEFUN |ISTRING;=;2$B;5| (|s| |t| |$|) (EQUAL |s| |t|)) + +(PUT (QUOTE |ISTRING;<;2$B;6|) (QUOTE |SPADreplace|) (QUOTE (XLAM (|s| |t|) (CGREATERP |t| |s|)))) + +(DEFUN |ISTRING;<;2$B;6| (|s| |t| |$|) (CGREATERP |t| |s|)) + +(PUT (QUOTE |ISTRING;concat;3$;7|) (QUOTE |SPADreplace|) (QUOTE STRCONC)) + +(DEFUN |ISTRING;concat;3$;7| (|s| |t| |$|) (STRCONC |s| |t|)) + +(PUT (QUOTE |ISTRING;copy;2$;8|) (QUOTE |SPADreplace|) (QUOTE |COPY-SEQ|)) + +(DEFUN |ISTRING;copy;2$;8| (|s| |$|) (|COPY-SEQ| |s|)) + +(DEFUN |ISTRING;insert;2$I$;9| (|s| |t| |i| |$|) (SPADCALL (SPADCALL (SPADCALL |s| (SPADCALL (QREFELT |$| 6) (|-| |i| 1) (QREFELT |$| 20)) (QREFELT |$| 21)) |t| (QREFELT |$| 16)) (SPADCALL |s| (SPADCALL |i| (QREFELT |$| 22)) (QREFELT |$| 21)) (QREFELT |$| 16))) + +(DEFUN |ISTRING;coerce;$Of;10| (|s| |$|) (SPADCALL |s| (QREFELT |$| 26))) + +(DEFUN |ISTRING;minIndex;$I;11| (|s| |$|) (QREFELT |$| 6)) + +(DEFUN |ISTRING;upperCase!;2$;12| (|s| |$|) (SPADCALL (ELT |$| 31) |s| (QREFELT |$| 33))) + +(DEFUN |ISTRING;lowerCase!;2$;13| (|s| |$|) (SPADCALL (ELT |$| 36) |s| (QREFELT |$| 33))) + +(DEFUN |ISTRING;latex;$S;14| (|s| |$|) (STRCONC "\\mbox{``" (STRCONC |s| "''}"))) + +(DEFUN |ISTRING;replace;$Us2$;15| (|s| |sg| |t| |$|) (PROG (|l| |m| |n| |h| #1=#:G91425 |r| #2=#:G91433 #3=#:G91432 |i| #4=#:G91431 |k|) (RETURN (SEQ (LETT |l| (|-| (SPADCALL |sg| (QREFELT |$| 39)) (QREFELT |$| 6)) |ISTRING;replace;$Us2$;15|) (LETT |m| (SPADCALL |s| (QREFELT |$| 13)) |ISTRING;replace;$Us2$;15|) (LETT |n| (SPADCALL |t| (QREFELT |$| 13)) |ISTRING;replace;$Us2$;15|) (LETT |h| (COND ((SPADCALL |sg| (QREFELT |$| 40)) (|-| (SPADCALL |sg| (QREFELT |$| 41)) (QREFELT |$| 6))) ((QUOTE T) (|-| (SPADCALL |s| (QREFELT |$| 42)) (QREFELT |$| 6)))) |ISTRING;replace;$Us2$;15|) (COND ((OR (OR (|<| |l| 0) (NULL (|<| |h| |m|))) (|<| |h| (|-| |l| 1))) (EXIT (|error| "index out of range")))) (LETT |r| (SPADCALL (PROG1 (LETT #1# (|+| (|-| |m| (|+| (|-| |h| |l|) 1)) |n|) |ISTRING;replace;$Us2$;15|) (|check-subtype| (|>=| #1# 0) (QUOTE (|NonNegativeInteger|)) #1#)) (SPADCALL (QREFELT |$| 43)) (QREFELT |$| 9)) |ISTRING;replace;$Us2$;15|) (SEQ (LETT |i| 0 |ISTRING;replace;$Us2$;15|) (LETT #2# (|-| |l| 1) |ISTRING;replace;$Us2$;15|) (LETT |k| 0 |ISTRING;replace;$Us2$;15|) G190 (COND ((QSGREATERP |i| #2#) (GO G191))) (SEQ (EXIT (QESET |r| |k| (QENUM |s| |i|)))) (LETT |k| (PROG1 (QSADD1 |k|) (LETT |i| (QSADD1 |i|) |ISTRING;replace;$Us2$;15|)) |ISTRING;replace;$Us2$;15|) (GO G190) G191 (EXIT NIL)) (SEQ (LETT |i| 0 |ISTRING;replace;$Us2$;15|) (LETT #3# (|-| |n| 1) |ISTRING;replace;$Us2$;15|) (LETT |k| |k| |ISTRING;replace;$Us2$;15|) G190 (COND ((QSGREATERP |i| #3#) (GO G191))) (SEQ (EXIT (QESET |r| |k| (QENUM |t| |i|)))) (LETT |k| (PROG1 (|+| |k| 1) (LETT |i| (QSADD1 |i|) |ISTRING;replace;$Us2$;15|)) |ISTRING;replace;$Us2$;15|) (GO G190) G191 (EXIT NIL)) (SEQ (LETT |i| (|+| |h| 1) |ISTRING;replace;$Us2$;15|) (LETT #4# (|-| |m| 1) |ISTRING;replace;$Us2$;15|) (LETT |k| |k| |ISTRING;replace;$Us2$;15|) G190 (COND ((|>| |i| #4#) (GO G191))) (SEQ (EXIT (QESET |r| |k| (QENUM |s| |i|)))) (LETT |k| (PROG1 (|+| |k| 1) (LETT |i| (|+| |i| 1) |ISTRING;replace;$Us2$;15|)) |ISTRING;replace;$Us2$;15|) (GO G190) G191 (EXIT NIL)) (EXIT |r|))))) + +(DEFUN |ISTRING;setelt;$I2C;16| (|s| |i| |c| |$|) (SEQ (COND ((OR (|<| |i| (QREFELT |$| 6)) (|<| (SPADCALL |s| (QREFELT |$| 42)) |i|)) (|error| "index out of range")) ((QUOTE T) (SEQ (QESET |s| (|-| |i| (QREFELT |$| 6)) |c|) (EXIT |c|)))))) + +(DEFUN |ISTRING;substring?;2$IB;17| (|part| |whole| |startpos| |$|) (PROG (|np| |nw| |iw| |ip| #1=#:G91443 #2=#:G91442 #3=#:G91438) (RETURN (SEQ (EXIT (SEQ (LETT |np| (QCSIZE |part|) |ISTRING;substring?;2$IB;17|) (LETT |nw| (QCSIZE |whole|) |ISTRING;substring?;2$IB;17|) (LETT |startpos| (|-| |startpos| (QREFELT |$| 6)) |ISTRING;substring?;2$IB;17|) (EXIT (COND ((|<| |startpos| 0) (|error| "index out of bounds")) ((|<| (|-| |nw| |startpos|) |np|) (QUOTE NIL)) ((QUOTE T) (SEQ (SEQ (EXIT (SEQ (LETT |iw| |startpos| |ISTRING;substring?;2$IB;17|) (LETT |ip| 0 |ISTRING;substring?;2$IB;17|) (LETT #1# (|-| |np| 1) |ISTRING;substring?;2$IB;17|) G190 (COND ((QSGREATERP |ip| #1#) (GO G191))) (SEQ (EXIT (COND ((NULL (EQL (QENUM |part| |ip|) (QENUM |whole| |iw|))) (PROGN (LETT #3# (PROGN (LETT #2# (QUOTE NIL) |ISTRING;substring?;2$IB;17|) (GO #2#)) |ISTRING;substring?;2$IB;17|) (GO #3#)))))) (LETT |ip| (PROG1 (QSADD1 |ip|) (LETT |iw| (|+| |iw| 1) |ISTRING;substring?;2$IB;17|)) |ISTRING;substring?;2$IB;17|) (GO G190) G191 (EXIT NIL))) #3# (EXIT #3#)) (EXIT (QUOTE T)))))))) #2# (EXIT #2#))))) + +(DEFUN |ISTRING;position;2$2I;18| (|s| |t| |startpos| |$|) (PROG (|r|) (RETURN (SEQ (LETT |startpos| (|-| |startpos| (QREFELT |$| 6)) |ISTRING;position;2$2I;18|) (EXIT (COND ((|<| |startpos| 0) (|error| "index out of bounds")) ((NULL (|<| |startpos| (QCSIZE |t|))) (|-| (QREFELT |$| 6) 1)) ((QUOTE T) (SEQ (LETT |r| (STRPOS |s| |t| |startpos| NIL) |ISTRING;position;2$2I;18|) (EXIT (COND ((EQ |r| NIL) (|-| (QREFELT |$| 6) 1)) ((QUOTE T) (|+| |r| (QREFELT |$| 6))))))))))))) + +(DEFUN |ISTRING;position;C$2I;19| (|c| |t| |startpos| |$|) (PROG (|r| #1=#:G91454 #2=#:G91453) (RETURN (SEQ (EXIT (SEQ (LETT |startpos| (|-| |startpos| (QREFELT |$| 6)) |ISTRING;position;C$2I;19|) (EXIT (COND ((|<| |startpos| 0) (|error| "index out of bounds")) ((NULL (|<| |startpos| (QCSIZE |t|))) (|-| (QREFELT |$| 6) 1)) ((QUOTE T) (SEQ (SEQ (LETT |r| |startpos| |ISTRING;position;C$2I;19|) (LETT #1# (QSDIFFERENCE (QCSIZE |t|) 1) |ISTRING;position;C$2I;19|) G190 (COND ((|>| |r| #1#) (GO G191))) (SEQ (EXIT (COND ((EQL (QENUM |t| |r|) |c|) (PROGN (LETT #2# (|+| |r| (QREFELT |$| 6)) |ISTRING;position;C$2I;19|) (GO #2#)))))) (LETT |r| (|+| |r| 1) |ISTRING;position;C$2I;19|) (GO G190) G191 (EXIT NIL)) (EXIT (|-| (QREFELT |$| 6) 1)))))))) #2# (EXIT #2#))))) + +(DEFUN |ISTRING;position;Cc$2I;20| (|cc| |t| |startpos| |$|) (PROG (|r| #1=#:G91461 #2=#:G91460) (RETURN (SEQ (EXIT (SEQ (LETT |startpos| (|-| |startpos| (QREFELT |$| 6)) |ISTRING;position;Cc$2I;20|) (EXIT (COND ((|<| |startpos| 0) (|error| "index out of bounds")) ((NULL (|<| |startpos| (QCSIZE |t|))) (|-| (QREFELT |$| 6) 1)) ((QUOTE T) (SEQ (SEQ (LETT |r| |startpos| |ISTRING;position;Cc$2I;20|) (LETT #1# (QSDIFFERENCE (QCSIZE |t|) 1) |ISTRING;position;Cc$2I;20|) G190 (COND ((|>| |r| #1#) (GO G191))) (SEQ (EXIT (COND ((SPADCALL (QENUM |t| |r|) |cc| (QREFELT |$| 49)) (PROGN (LETT #2# (|+| |r| (QREFELT |$| 6)) |ISTRING;position;Cc$2I;20|) (GO #2#)))))) (LETT |r| (|+| |r| 1) |ISTRING;position;Cc$2I;20|) (GO G190) G191 (EXIT NIL)) (EXIT (|-| (QREFELT |$| 6) 1)))))))) #2# (EXIT #2#))))) + +(DEFUN |ISTRING;suffix?;2$B;21| (|s| |t| |$|) (PROG (|n| |m|) (RETURN (SEQ (LETT |n| (SPADCALL |t| (QREFELT |$| 42)) |ISTRING;suffix?;2$B;21|) (LETT |m| (SPADCALL |s| (QREFELT |$| 42)) |ISTRING;suffix?;2$B;21|) (EXIT (COND ((|<| |n| |m|) (QUOTE NIL)) ((QUOTE T) (SPADCALL |s| |t| (|-| (|+| (QREFELT |$| 6) |n|) |m|) (QREFELT |$| 46))))))))) + +(DEFUN |ISTRING;split;$CL;22| (|s| |c| |$|) (PROG (|n| |j| |i| |l|) (RETURN (SEQ (LETT |n| (SPADCALL |s| (QREFELT |$| 42)) |ISTRING;split;$CL;22|) (SEQ (LETT |i| (QREFELT |$| 6) |ISTRING;split;$CL;22|) G190 (COND ((OR (|>| |i| |n|) (NULL (SPADCALL (SPADCALL |s| |i| (QREFELT |$| 52)) |c| (QREFELT |$| 53)))) (GO G191))) (SEQ (EXIT 0)) (LETT |i| (|+| |i| 1) |ISTRING;split;$CL;22|) (GO G190) G191 (EXIT NIL)) (LETT |l| (SPADCALL (QREFELT |$| 55)) |ISTRING;split;$CL;22|) (SEQ G190 (COND ((NULL (COND ((|<| |n| |i|) (QUOTE NIL)) ((QUOTE T) (SEQ (LETT |j| (SPADCALL |c| |s| |i| (QREFELT |$| 48)) |ISTRING;split;$CL;22|) (EXIT (COND ((|<| |j| (QREFELT |$| 6)) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))))))) (GO G191))) (SEQ (LETT |l| (SPADCALL (SPADCALL |s| (SPADCALL |i| (|-| |j| 1) (QREFELT |$| 20)) (QREFELT |$| 21)) |l| (QREFELT |$| 56)) |ISTRING;split;$CL;22|) (EXIT (SEQ (LETT |i| |j| |ISTRING;split;$CL;22|) G190 (COND ((OR (|>| |i| |n|) (NULL (SPADCALL (SPADCALL |s| |i| (QREFELT |$| 52)) |c| (QREFELT |$| 53)))) (GO G191))) (SEQ (EXIT 0)) (LETT |i| (|+| |i| 1) |ISTRING;split;$CL;22|) (GO G190) G191 (EXIT NIL)))) NIL (GO G190) G191 (EXIT NIL)) (COND ((NULL (|<| |n| |i|)) (LETT |l| (SPADCALL (SPADCALL |s| (SPADCALL |i| |n| (QREFELT |$| 20)) (QREFELT |$| 21)) |l| (QREFELT |$| 56)) |ISTRING;split;$CL;22|))) (EXIT (SPADCALL |l| (QREFELT |$| 57))))))) + +(DEFUN |ISTRING;split;$CcL;23| (|s| |cc| |$|) (PROG (|n| |j| |i| |l|) (RETURN (SEQ (LETT |n| (SPADCALL |s| (QREFELT |$| 42)) |ISTRING;split;$CcL;23|) (SEQ (LETT |i| (QREFELT |$| 6) |ISTRING;split;$CcL;23|) G190 (COND ((OR (|>| |i| |n|) (NULL (SPADCALL (SPADCALL |s| |i| (QREFELT |$| 52)) |cc| (QREFELT |$| 49)))) (GO G191))) (SEQ (EXIT 0)) (LETT |i| (|+| |i| 1) |ISTRING;split;$CcL;23|) (GO G190) G191 (EXIT NIL)) (LETT |l| (SPADCALL (QREFELT |$| 55)) |ISTRING;split;$CcL;23|) (SEQ G190 (COND ((NULL (COND ((|<| |n| |i|) (QUOTE NIL)) ((QUOTE T) (SEQ (LETT |j| (SPADCALL |cc| |s| |i| (QREFELT |$| 50)) |ISTRING;split;$CcL;23|) (EXIT (COND ((|<| |j| (QREFELT |$| 6)) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))))))) (GO G191))) (SEQ (LETT |l| (SPADCALL (SPADCALL |s| (SPADCALL |i| (|-| |j| 1) (QREFELT |$| 20)) (QREFELT |$| 21)) |l| (QREFELT |$| 56)) |ISTRING;split;$CcL;23|) (EXIT (SEQ (LETT |i| |j| |ISTRING;split;$CcL;23|) G190 (COND ((OR (|>| |i| |n|) (NULL (SPADCALL (SPADCALL |s| |i| (QREFELT |$| 52)) |cc| (QREFELT |$| 49)))) (GO G191))) (SEQ (EXIT 0)) (LETT |i| (|+| |i| 1) |ISTRING;split;$CcL;23|) (GO G190) G191 (EXIT NIL)))) NIL (GO G190) G191 (EXIT NIL)) (COND ((NULL (|<| |n| |i|)) (LETT |l| (SPADCALL (SPADCALL |s| (SPADCALL |i| |n| (QREFELT |$| 20)) (QREFELT |$| 21)) |l| (QREFELT |$| 56)) |ISTRING;split;$CcL;23|))) (EXIT (SPADCALL |l| (QREFELT |$| 57))))))) + +(DEFUN |ISTRING;leftTrim;$C$;24| (|s| |c| |$|) (PROG (|n| |i|) (RETURN (SEQ (LETT |n| (SPADCALL |s| (QREFELT |$| 42)) |ISTRING;leftTrim;$C$;24|) (SEQ (LETT |i| (QREFELT |$| 6) |ISTRING;leftTrim;$C$;24|) G190 (COND ((OR (|>| |i| |n|) (NULL (SPADCALL (SPADCALL |s| |i| (QREFELT |$| 52)) |c| (QREFELT |$| 53)))) (GO G191))) (SEQ (EXIT 0)) (LETT |i| (|+| |i| 1) |ISTRING;leftTrim;$C$;24|) (GO G190) G191 (EXIT NIL)) (EXIT (SPADCALL |s| (SPADCALL |i| |n| (QREFELT |$| 20)) (QREFELT |$| 21))))))) + +(DEFUN |ISTRING;leftTrim;$Cc$;25| (|s| |cc| |$|) (PROG (|n| |i|) (RETURN (SEQ (LETT |n| (SPADCALL |s| (QREFELT |$| 42)) |ISTRING;leftTrim;$Cc$;25|) (SEQ (LETT |i| (QREFELT |$| 6) |ISTRING;leftTrim;$Cc$;25|) G190 (COND ((OR (|>| |i| |n|) (NULL (SPADCALL (SPADCALL |s| |i| (QREFELT |$| 52)) |cc| (QREFELT |$| 49)))) (GO G191))) (SEQ (EXIT 0)) (LETT |i| (|+| |i| 1) |ISTRING;leftTrim;$Cc$;25|) (GO G190) G191 (EXIT NIL)) (EXIT (SPADCALL |s| (SPADCALL |i| |n| (QREFELT |$| 20)) (QREFELT |$| 21))))))) + +(DEFUN |ISTRING;rightTrim;$C$;26| (|s| |c| |$|) (PROG (|j| #1=#:G91487) (RETURN (SEQ (SEQ (LETT |j| (SPADCALL |s| (QREFELT |$| 42)) |ISTRING;rightTrim;$C$;26|) (LETT #1# (QREFELT |$| 6) |ISTRING;rightTrim;$C$;26|) G190 (COND ((OR (|<| |j| #1#) (NULL (SPADCALL (SPADCALL |s| |j| (QREFELT |$| 52)) |c| (QREFELT |$| 53)))) (GO G191))) (SEQ (EXIT 0)) (LETT |j| (|+| |j| -1) |ISTRING;rightTrim;$C$;26|) (GO G190) G191 (EXIT NIL)) (EXIT (SPADCALL |s| (SPADCALL (SPADCALL |s| (QREFELT |$| 28)) |j| (QREFELT |$| 20)) (QREFELT |$| 21))))))) + +(DEFUN |ISTRING;rightTrim;$Cc$;27| (|s| |cc| |$|) (PROG (|j| #1=#:G91491) (RETURN (SEQ (SEQ (LETT |j| (SPADCALL |s| (QREFELT |$| 42)) |ISTRING;rightTrim;$Cc$;27|) (LETT #1# (QREFELT |$| 6) |ISTRING;rightTrim;$Cc$;27|) G190 (COND ((OR (|<| |j| #1#) (NULL (SPADCALL (SPADCALL |s| |j| (QREFELT |$| 52)) |cc| (QREFELT |$| 49)))) (GO G191))) (SEQ (EXIT 0)) (LETT |j| (|+| |j| -1) |ISTRING;rightTrim;$Cc$;27|) (GO G190) G191 (EXIT NIL)) (EXIT (SPADCALL |s| (SPADCALL (SPADCALL |s| (QREFELT |$| 28)) |j| (QREFELT |$| 20)) (QREFELT |$| 21))))))) + +(DEFUN |ISTRING;concat;L$;28| (|l| |$|) (PROG (#1=#:G91500 #2=#:G91494 #3=#:G91492 #4=#:G91493 |t| |s| #5=#:G91499 |i|) (RETURN (SEQ (LETT |t| (SPADCALL (PROGN (LETT #4# NIL |ISTRING;concat;L$;28|) (SEQ (LETT |s| NIL |ISTRING;concat;L$;28|) (LETT #1# |l| |ISTRING;concat;L$;28|) G190 (COND ((OR (ATOM #1#) (PROGN (LETT |s| (CAR #1#) |ISTRING;concat;L$;28|) NIL)) (GO G191))) (SEQ (EXIT (PROGN (LETT #2# (SPADCALL |s| (QREFELT |$| 13)) |ISTRING;concat;L$;28|) (COND (#4# (LETT #3# (|+| #3# #2#) |ISTRING;concat;L$;28|)) ((QUOTE T) (PROGN (LETT #3# #2# |ISTRING;concat;L$;28|) (LETT #4# (QUOTE T) |ISTRING;concat;L$;28|))))))) (LETT #1# (CDR #1#) |ISTRING;concat;L$;28|) (GO G190) G191 (EXIT NIL)) (COND (#4# #3#) ((QUOTE T) 0))) (SPADCALL (QREFELT |$| 43)) (QREFELT |$| 9)) |ISTRING;concat;L$;28|) (LETT |i| (QREFELT |$| 6) |ISTRING;concat;L$;28|) (SEQ (LETT |s| NIL |ISTRING;concat;L$;28|) (LETT #5# |l| |ISTRING;concat;L$;28|) G190 (COND ((OR (ATOM #5#) (PROGN (LETT |s| (CAR #5#) |ISTRING;concat;L$;28|) NIL)) (GO G191))) (SEQ (SPADCALL |t| |s| |i| (QREFELT |$| 65)) (EXIT (LETT |i| (|+| |i| (SPADCALL |s| (QREFELT |$| 13))) |ISTRING;concat;L$;28|))) (LETT #5# (CDR #5#) |ISTRING;concat;L$;28|) (GO G190) G191 (EXIT NIL)) (EXIT |t|))))) + +(DEFUN |ISTRING;copyInto!;2$I$;29| (|y| |x| |s| |$|) (PROG (|m| |n|) (RETURN (SEQ (LETT |m| (SPADCALL |x| (QREFELT |$| 13)) |ISTRING;copyInto!;2$I$;29|) (LETT |n| (SPADCALL |y| (QREFELT |$| 13)) |ISTRING;copyInto!;2$I$;29|) (LETT |s| (|-| |s| (QREFELT |$| 6)) |ISTRING;copyInto!;2$I$;29|) (COND ((OR (|<| |s| 0) (|<| |n| (|+| |s| |m|))) (EXIT (|error| "index out of range")))) (RPLACSTR |y| |s| |m| |x| 0 |m|) (EXIT |y|))))) + +(DEFUN |ISTRING;elt;$IC;30| (|s| |i| |$|) (COND ((OR (|<| |i| (QREFELT |$| 6)) (|<| (SPADCALL |s| (QREFELT |$| 42)) |i|)) (|error| "index out of range")) ((QUOTE T) (QENUM |s| (|-| |i| (QREFELT |$| 6)))))) + +(DEFUN |ISTRING;elt;$Us$;31| (|s| |sg| |$|) (PROG (|l| |h|) (RETURN (SEQ (LETT |l| (|-| (SPADCALL |sg| (QREFELT |$| 39)) (QREFELT |$| 6)) |ISTRING;elt;$Us$;31|) (LETT |h| (COND ((SPADCALL |sg| (QREFELT |$| 40)) (|-| (SPADCALL |sg| (QREFELT |$| 41)) (QREFELT |$| 6))) ((QUOTE T) (|-| (SPADCALL |s| (QREFELT |$| 42)) (QREFELT |$| 6)))) |ISTRING;elt;$Us$;31|) (COND ((OR (|<| |l| 0) (NULL (|<| |h| (SPADCALL |s| (QREFELT |$| 13))))) (EXIT (|error| "index out of bound")))) (EXIT (SUBSTRING |s| |l| (MAX 0 (|+| (|-| |h| |l|) 1)))))))) + +(DEFUN |ISTRING;hash;$I;32| (|s| |$|) (PROG (|n|) (RETURN (SEQ (LETT |n| (QCSIZE |s|) |ISTRING;hash;$I;32|) (EXIT (COND ((ZEROP |n|) 0) ((EQL |n| 1) (SPADCALL (SPADCALL |s| (QREFELT |$| 6) (QREFELT |$| 52)) (QREFELT |$| 67))) ((QUOTE T) (|*| (|*| (SPADCALL (SPADCALL |s| (QREFELT |$| 6) (QREFELT |$| 52)) (QREFELT |$| 67)) (SPADCALL (SPADCALL |s| (|-| (|+| (QREFELT |$| 6) |n|) 1) (QREFELT |$| 52)) (QREFELT |$| 67))) (SPADCALL (SPADCALL |s| (|+| (QREFELT |$| 6) (QUOTIENT2 |n| 2)) (QREFELT |$| 52)) (QREFELT |$| 67)))))))))) + +(PUT (QUOTE |ISTRING;match;2$CNni;33|) (QUOTE |SPADreplace|) (QUOTE |stringMatch|)) + +(DEFUN |ISTRING;match;2$CNni;33| (|pattern| |target| |wildcard| |$|) (|stringMatch| |pattern| |target| |wildcard|)) + +(DEFUN |ISTRING;match?;2$CB;34| (|pattern| |target| |dontcare| |$|) (PROG (|n| |m| #1=#:G91514 #2=#:G91516 |s| #3=#:G91518 #4=#:G91526 |i| |p| #5=#:G91519 |q|) (RETURN (SEQ (EXIT (SEQ (LETT |n| (SPADCALL |pattern| (QREFELT |$| 42)) |ISTRING;match?;2$CB;34|) (LETT |p| (PROG1 (LETT #1# (SPADCALL |dontcare| |pattern| (LETT |m| (SPADCALL |pattern| (QREFELT |$| 28)) |ISTRING;match?;2$CB;34|) (QREFELT |$| 48)) |ISTRING;match?;2$CB;34|) (|check-subtype| (|>=| #1# 0) (QUOTE (|NonNegativeInteger|)) #1#)) |ISTRING;match?;2$CB;34|) (EXIT (COND ((EQL |p| (|-| |m| 1)) (SPADCALL |pattern| |target| (QREFELT |$| 14))) ((QUOTE T) (SEQ (COND ((NULL (EQL |p| |m|)) (COND ((NULL (SPADCALL (SPADCALL |pattern| (SPADCALL |m| (|-| |p| 1) (QREFELT |$| 20)) (QREFELT |$| 21)) |target| (QREFELT |$| 70))) (EXIT (QUOTE NIL)))))) (LETT |i| |p| |ISTRING;match?;2$CB;34|) (LETT |q| (PROG1 (LETT #2# (SPADCALL |dontcare| |pattern| (|+| |p| 1) (QREFELT |$| 48)) |ISTRING;match?;2$CB;34|) (|check-subtype| (|>=| #2# 0) (QUOTE (|NonNegativeInteger|)) #2#)) |ISTRING;match?;2$CB;34|) (SEQ G190 (COND ((NULL (COND ((EQL |q| (|-| |m| 1)) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) (GO G191))) (SEQ (LETT |s| (SPADCALL |pattern| (SPADCALL (|+| |p| 1) (|-| |q| 1) (QREFELT |$| 20)) (QREFELT |$| 21)) |ISTRING;match?;2$CB;34|) (LETT |i| (PROG1 (LETT #3# (SPADCALL |s| |target| |i| (QREFELT |$| 47)) |ISTRING;match?;2$CB;34|) (|check-subtype| (|>=| #3# 0) (QUOTE (|NonNegativeInteger|)) #3#)) |ISTRING;match?;2$CB;34|) (EXIT (COND ((EQL |i| (|-| |m| 1)) (PROGN (LETT #4# (QUOTE NIL) |ISTRING;match?;2$CB;34|) (GO #4#))) ((QUOTE T) (SEQ (LETT |i| (|+| |i| (SPADCALL |s| (QREFELT |$| 13))) |ISTRING;match?;2$CB;34|) (LETT |p| |q| |ISTRING;match?;2$CB;34|) (EXIT (LETT |q| (PROG1 (LETT #5# (SPADCALL |dontcare| |pattern| (|+| |q| 1) (QREFELT |$| 48)) |ISTRING;match?;2$CB;34|) (|check-subtype| (|>=| #5# 0) (QUOTE (|NonNegativeInteger|)) #5#)) |ISTRING;match?;2$CB;34|))))))) NIL (GO G190) G191 (EXIT NIL)) (COND ((NULL (EQL |p| |n|)) (COND ((NULL (SPADCALL (SPADCALL |pattern| (SPADCALL (|+| |p| 1) |n| (QREFELT |$| 20)) (QREFELT |$| 21)) |target| (QREFELT |$| 51))) (EXIT (QUOTE NIL)))))) (EXIT (QUOTE T)))))))) #4# (EXIT #4#))))) + +(DEFUN |IndexedString| (#1=#:G91535) (PROG NIL (RETURN (PROG (#2=#:G91536) (RETURN (COND ((LETT #2# (|lassocShiftWithFunction| (LIST (|devaluate| #1#)) (HGET |$ConstructorCache| (QUOTE |IndexedString|)) (QUOTE |domainEqualList|)) |IndexedString|) (|CDRwithIncrement| #2#)) ((QUOTE T) (|UNWIND-PROTECT| (PROG1 (|IndexedString;| #1#) (LETT #2# T |IndexedString|)) (COND ((NOT #2#) (HREM |$ConstructorCache| (QUOTE |IndexedString|)))))))))))) + +(DEFUN |IndexedString;| (|#1|) (PROG (|DV$1| |dv$| |$| #1=#:G91534 #2=#:G91533 |pv$|) (RETURN (PROGN (LETT |DV$1| (|devaluate| |#1|) . #3=(|IndexedString|)) (LETT |dv$| (LIST (QUOTE |IndexedString|) |DV$1|) . #3#) (LETT |$| (GETREFV 83) . #3#) (QSETREFV |$| 0 |dv$|) (QSETREFV |$| 3 (LETT |pv$| (|buildPredVector| 0 0 (LIST (|HasCategory| (|Character|) (QUOTE (|SetCategory|))) (|HasCategory| (|Character|) (QUOTE (|ConvertibleTo| (|InputForm|)))) (LETT #1# (|HasCategory| (|Character|) (QUOTE (|OrderedSet|))) . #3#) (OR #1# (|HasCategory| (|Character|) (QUOTE (|SetCategory|)))) (|HasCategory| (|Integer|) (QUOTE (|OrderedSet|))) (LETT #2# (AND (|HasCategory| (|Character|) (QUOTE (|Evalable| (|Character|)))) (|HasCategory| (|Character|) (QUOTE (|SetCategory|)))) . #3#) (OR (AND (|HasCategory| (|Character|) (QUOTE (|Evalable| (|Character|)))) #1#) #2#))) . #3#)) (|haddProp| |$ConstructorCache| (QUOTE |IndexedString|) (LIST |DV$1|) (CONS 1 |$|)) (|stuffDomainSlots| |$|) (QSETREFV |$| 6 |#1|) |$|)))) + +(MAKEPROP (QUOTE |IndexedString|) (QUOTE |infovec|) (LIST (QUOTE #(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|NonNegativeInteger|) (|Character|) |ISTRING;new;NniC$;1| |ISTRING;empty;$;2| (|Boolean|) |ISTRING;empty?;$B;3| |ISTRING;#;$Nni;4| |ISTRING;=;2$B;5| |ISTRING;<;2$B;6| |ISTRING;concat;3$;7| |ISTRING;copy;2$;8| (|Integer|) (|UniversalSegment| 18) (0 . SEGMENT) |ISTRING;elt;$Us$;31| (6 . SEGMENT) |ISTRING;insert;2$I$;9| (|String|) (|OutputForm|) (11 . |outputForm|) |ISTRING;coerce;$Of;10| |ISTRING;minIndex;$I;11| (|CharacterClass|) (16 . |upperCase|) (20 . |upperCase|) (|Mapping| 8 8) (25 . |map!|) |ISTRING;upperCase!;2$;12| (31 . |lowerCase|) (35 . |lowerCase|) |ISTRING;lowerCase!;2$;13| |ISTRING;latex;$S;14| (40 . |lo|) (45 . |hasHi|) (50 . |hi|) (55 . |maxIndex|) (60 . |space|) |ISTRING;replace;$Us2$;15| |ISTRING;setelt;$I2C;16| |ISTRING;substring?;2$IB;17| |ISTRING;position;2$2I;18| |ISTRING;position;C$2I;19| (64 . |member?|) |ISTRING;position;Cc$2I;20| |ISTRING;suffix?;2$B;21| |ISTRING;elt;$IC;30| (70 . |=|) (|List| |$$|) (76 . |empty|) (80 . |concat|) (86 . |reverse!|) (|List| |$|) |ISTRING;split;$CL;22| |ISTRING;split;$CcL;23| |ISTRING;leftTrim;$C$;24| |ISTRING;leftTrim;$Cc$;25| |ISTRING;rightTrim;$C$;26| |ISTRING;rightTrim;$Cc$;27| |ISTRING;copyInto!;2$I$;29| |ISTRING;concat;L$;28| (91 . |ord|) |ISTRING;hash;$I;32| |ISTRING;match;2$CNni;33| (96 . |prefix?|) |ISTRING;match?;2$CB;34| (|List| 8) (|List| 74) (|Equation| 8) (|Mapping| 8 8 8) (|InputForm|) (|SingleInteger|) (|Mapping| 11 8) (|Mapping| 11 8 8) (|Void|) (|Union| 8 (QUOTE "failed")) (|List| 18))) (QUOTE #(|~=| 102 |upperCase!| 108 |upperCase| 113 |trim| 118 |swap!| 130 |suffix?| 137 |substring?| 143 |split| 150 |sorted?| 162 |sort!| 173 |sort| 184 |size?| 195 |setelt| 201 |select| 215 |sample| 221 |rightTrim| 225 |reverse!| 237 |reverse| 242 |replace| 247 |removeDuplicates| 254 |remove| 259 |reduce| 271 |qsetelt!| 292 |qelt| 299 |prefix?| 305 |position| 311 |parts| 344 |new| 349 |more?| 355 |minIndex| 361 |min| 366 |merge| 372 |members| 385 |member?| 390 |maxIndex| 396 |max| 401 |match?| 407 |match| 414 |map!| 421 |map| 427 |lowerCase!| 440 |lowerCase| 445 |less?| 450 |leftTrim| 456 |latex| 468 |insert| 473 |indices| 487 |index?| 492 |hash| 498 |first| 508 |find| 513 |fill!| 519 |every?| 525 |eval| 531 |eq?| 557 |entry?| 563 |entries| 569 |empty?| 574 |empty| 579 |elt| 583 |delete| 608 |count| 620 |copyInto!| 632 |copy| 639 |convert| 644 |construct| 649 |concat| 654 |coerce| 677 |any?| 687 |>=| 693 |>| 699 |=| 705 |<=| 711 |<| 717 |#| 723)) (QUOTE ((|shallowlyMutable| . 0) (|finiteAggregate| . 0))) (CONS (|makeByteWordVec2| 7 (QUOTE (0 0 0 0 0 0 0 3 0 0 7 4 0 0 7 1 2 4))) (CONS (QUOTE #(|StringAggregate&| |OneDimensionalArrayAggregate&| |FiniteLinearAggregate&| |LinearAggregate&| |IndexedAggregate&| |Collection&| |HomogeneousAggregate&| |OrderedSet&| |Aggregate&| |EltableAggregate&| |Evalable&| |SetCategory&| NIL NIL |InnerEvalable&| NIL NIL |BasicType&|)) (CONS (QUOTE #((|StringAggregate|) (|OneDimensionalArrayAggregate| 8) (|FiniteLinearAggregate| 8) (|LinearAggregate| 8) (|IndexedAggregate| 18 8) (|Collection| 8) (|HomogeneousAggregate| 8) (|OrderedSet|) (|Aggregate|) (|EltableAggregate| 18 8) (|Evalable| 8) (|SetCategory|) (|Type|) (|Eltable| 18 8) (|InnerEvalable| 8 8) (|CoercibleTo| 25) (|ConvertibleTo| 76) (|BasicType|))) (|makeByteWordVec2| 82 (QUOTE (2 19 0 18 18 20 1 19 0 18 22 1 25 0 24 26 0 29 0 30 1 8 0 0 31 2 0 0 32 0 33 0 29 0 35 1 8 0 0 36 1 19 18 0 39 1 19 11 0 40 1 19 18 0 41 1 0 18 0 42 0 8 0 43 2 29 11 8 0 49 2 8 11 0 0 53 0 54 0 55 2 54 0 2 0 56 1 54 0 0 57 1 8 18 0 67 2 0 11 0 0 70 2 1 11 0 0 1 1 0 0 0 34 1 0 0 0 1 2 0 0 0 8 1 2 0 0 0 29 1 3 0 80 0 18 18 1 2 0 11 0 0 51 3 0 11 0 0 18 46 2 0 58 0 29 60 2 0 58 0 8 59 1 3 11 0 1 2 0 11 79 0 1 1 3 0 0 1 2 0 0 79 0 1 1 3 0 0 1 2 0 0 79 0 1 2 0 11 0 7 1 3 0 8 0 19 8 1 3 0 8 0 18 8 45 2 0 0 78 0 1 0 0 0 1 2 0 0 0 8 63 2 0 0 0 29 64 1 0 0 0 1 1 0 0 0 1 3 0 0 0 19 0 44 1 1 0 0 1 2 1 0 8 0 1 2 0 0 78 0 1 4 1 8 75 0 8 8 1 3 0 8 75 0 8 1 2 0 8 75 0 1 3 0 8 0 18 8 1 2 0 8 0 18 1 2 0 11 0 0 70 3 1 18 8 0 18 48 2 1 18 8 0 1 3 0 18 29 0 18 50 3 0 18 0 0 18 47 2 0 18 78 0 1 1 0 72 0 1 2 0 0 7 8 9 2 0 11 0 7 1 1 5 18 0 28 2 3 0 0 0 1 2 3 0 0 0 1 3 0 0 79 0 0 1 1 0 72 0 1 2 1 11 8 0 1 1 5 18 0 42 2 3 0 0 0 1 3 0 11 0 0 8 71 3 0 7 0 0 8 69 2 0 0 32 0 33 3 0 0 75 0 0 1 2 0 0 32 0 1 1 0 0 0 37 1 0 0 0 1 2 0 11 0 7 1 2 0 0 0 8 61 2 0 0 0 29 62 1 1 24 0 38 3 0 0 8 0 18 1 3 0 0 0 0 18 23 1 0 82 0 1 2 0 11 18 0 1 1 1 77 0 1 1 0 18 0 68 1 5 8 0 1 2 0 81 78 0 1 2 0 0 0 8 1 2 0 11 78 0 1 3 6 0 0 72 72 1 3 6 0 0 8 8 1 2 6 0 0 73 1 2 6 0 0 74 1 2 0 11 0 0 1 2 1 11 8 0 1 1 0 72 0 1 1 0 11 0 12 0 0 0 10 2 0 0 0 0 1 2 0 0 0 19 21 2 0 8 0 18 52 3 0 8 0 18 8 1 2 0 0 0 18 1 2 0 0 0 19 1 2 1 7 8 0 1 2 0 7 78 0 1 3 0 0 0 0 18 65 1 0 0 0 17 1 2 76 0 1 1 0 0 72 1 1 0 0 58 66 2 0 0 0 0 16 2 0 0 0 8 1 2 0 0 8 0 1 1 1 25 0 27 1 0 0 8 1 2 0 11 78 0 1 2 3 11 0 0 1 2 3 11 0 0 1 2 1 11 0 0 14 2 3 11 0 0 1 2 3 11 0 0 15 1 0 7 0 13)))))) (QUOTE |lookupComplete|))) +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \section{LIST.lsp BOOTSTRAP} {\bf LIST} depends on a chain of files. We need to break this cycle to build the algebra. So we keep a @@ -68823,6 +78293,771 @@ Note that this code is not included in the generated catdef.spad file. @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{SINT.lsp BOOTSTRAP} +<>= + +(/VERSIONCHECK 2) + +(DEFUN |SINT;writeOMSingleInt| (|dev| |x| $) + (SEQ + (COND + ((QSLESSP |x| 0) + (SEQ + (SPADCALL |dev| (QREFELT $ 9)) + (SPADCALL |dev| "arith1" "unaryminus" (QREFELT $ 11)) + (SPADCALL |dev| (QSMINUS |x|) (QREFELT $ 13)) + (EXIT (SPADCALL |dev| (QREFELT $ 14))))) + ((QUOTE T) (SPADCALL |dev| |x| (QREFELT $ 13)))))) + +(DEFUN |SINT;OMwrite;$S;2| (|x| $) + (PROG (|sp| |dev| |s|) + (RETURN + (SEQ + (LETT |s| "" |SINT;OMwrite;$S;2|) + (LETT |sp| (OM-STRINGTOSTRINGPTR |s|) |SINT;OMwrite;$S;2|) + (LETT |dev| + (SPADCALL |sp| (SPADCALL (QREFELT $ 16)) (QREFELT $ 17)) + |SINT;OMwrite;$S;2|) + (SPADCALL |dev| (QREFELT $ 18)) + (|SINT;writeOMSingleInt| |dev| |x| $) + (SPADCALL |dev| (QREFELT $ 19)) + (SPADCALL |dev| (QREFELT $ 20)) + (LETT |s| (OM-STRINGPTRTOSTRING |sp|) |SINT;OMwrite;$S;2|) + (EXIT |s|))))) + +(DEFUN |SINT;OMwrite;$BS;3| (|x| |wholeObj| $) + (PROG (|sp| |dev| |s|) + (RETURN + (SEQ + (LETT |s| "" |SINT;OMwrite;$BS;3|) + (LETT |sp| (OM-STRINGTOSTRINGPTR |s|) |SINT;OMwrite;$BS;3|) + (LETT |dev| + (SPADCALL |sp| (SPADCALL (QREFELT $ 16)) (QREFELT $ 17)) + |SINT;OMwrite;$BS;3|) + (COND (|wholeObj| (SPADCALL |dev| (QREFELT $ 18)))) + (|SINT;writeOMSingleInt| |dev| |x| $) + (COND (|wholeObj| (SPADCALL |dev| (QREFELT $ 19)))) + (SPADCALL |dev| (QREFELT $ 20)) + (LETT |s| (OM-STRINGPTRTOSTRING |sp|) |SINT;OMwrite;$BS;3|) + (EXIT |s|))))) + +(DEFUN |SINT;OMwrite;Omd$V;4| (|dev| |x| $) + (SEQ + (SPADCALL |dev| (QREFELT $ 18)) + (|SINT;writeOMSingleInt| |dev| |x| $) + (EXIT (SPADCALL |dev| (QREFELT $ 19))))) + +(DEFUN |SINT;OMwrite;Omd$BV;5| (|dev| |x| |wholeObj| $) + (SEQ + (COND (|wholeObj| (SPADCALL |dev| (QREFELT $ 18)))) + (|SINT;writeOMSingleInt| |dev| |x| $) + (EXIT (COND (|wholeObj| (SPADCALL |dev| (QREFELT $ 19))))))) + +(PUT + (QUOTE |SINT;reducedSystem;MM;6|) + (QUOTE |SPADreplace|) + (QUOTE (XLAM (|m|) |m|))) + +(DEFUN |SINT;reducedSystem;MM;6| (|m| $) |m|) + +(DEFUN |SINT;coerce;$Of;7| (|x| $) + (SPADCALL |x| (QREFELT $ 30))) + +(PUT + (QUOTE |SINT;convert;$I;8|) + (QUOTE |SPADreplace|) + (QUOTE (XLAM (|x|) |x|))) + +(DEFUN |SINT;convert;$I;8| (|x| $) |x|) + +(DEFUN |SINT;*;I2$;9| (|i| |y| $) + (QSTIMES (SPADCALL |i| (QREFELT $ 33)) |y|)) + +(PUT + (QUOTE |SINT;Zero;$;10|) + (QUOTE |SPADreplace|) + (QUOTE (XLAM NIL 0))) + +(DEFUN |SINT;Zero;$;10| ($) 0) + +(PUT + (QUOTE |SINT;One;$;11|) + (QUOTE |SPADreplace|) + (QUOTE (XLAM NIL 1))) + +(DEFUN |SINT;One;$;11| ($) 1) + +(PUT + (QUOTE |SINT;base;$;12|) + (QUOTE |SPADreplace|) + (QUOTE (XLAM NIL 2))) + +(DEFUN |SINT;base;$;12| ($) 2) + +(PUT + (QUOTE |SINT;max;$;13|) + (QUOTE |SPADreplace|) + (QUOTE (XLAM NIL MOST-POSITIVE-FIXNUM))) + +(DEFUN |SINT;max;$;13| ($) MOST-POSITIVE-FIXNUM) + +(PUT + (QUOTE |SINT;min;$;14|) + (QUOTE |SPADreplace|) + (QUOTE (XLAM NIL MOST-NEGATIVE-FIXNUM))) + +(DEFUN |SINT;min;$;14| ($) MOST-NEGATIVE-FIXNUM) + +(PUT + (QUOTE |SINT;=;2$B;15|) + (QUOTE |SPADreplace|) + (QUOTE EQL)) + +(DEFUN |SINT;=;2$B;15| (|x| |y| $) + (EQL |x| |y|)) + +(PUT + (QUOTE |SINT;~;2$;16|) + (QUOTE |SPADreplace|) + (QUOTE LOGNOT)) + +(DEFUN |SINT;~;2$;16| (|x| $) + (LOGNOT |x|)) + +(PUT + (QUOTE |SINT;not;2$;17|) + (QUOTE |SPADreplace|) + (QUOTE LOGNOT)) + +(DEFUN |SINT;not;2$;17| (|x| $) + (LOGNOT |x|)) + +(PUT + (QUOTE |SINT;/\\;3$;18|) + (QUOTE |SPADreplace|) + (QUOTE LOGAND)) + +(DEFUN |SINT;/\\;3$;18| (|x| |y| $) + (LOGAND |x| |y|)) + +(PUT + (QUOTE |SINT;\\/;3$;19|) + (QUOTE |SPADreplace|) + (QUOTE LOGIOR)) + +(DEFUN |SINT;\\/;3$;19| (|x| |y| $) + (LOGIOR |x| |y|)) + +(PUT + (QUOTE |SINT;Not;2$;20|) + (QUOTE |SPADreplace|) + (QUOTE LOGNOT)) + +(DEFUN |SINT;Not;2$;20| (|x| $) + (LOGNOT |x|)) + +(PUT + (QUOTE |SINT;And;3$;21|) + (QUOTE |SPADreplace|) + (QUOTE LOGAND)) + +(DEFUN |SINT;And;3$;21| (|x| |y| $) + (LOGAND |x| |y|)) + +(PUT + (QUOTE |SINT;Or;3$;22|) + (QUOTE |SPADreplace|) + (QUOTE LOGIOR)) + +(DEFUN |SINT;Or;3$;22| (|x| |y| $) + (LOGIOR |x| |y|)) + +(PUT + (QUOTE |SINT;xor;3$;23|) + (QUOTE |SPADreplace|) + (QUOTE LOGXOR)) + +(DEFUN |SINT;xor;3$;23| (|x| |y| $) + (LOGXOR |x| |y|)) + +(PUT + (QUOTE |SINT;<;2$B;24|) + (QUOTE |SPADreplace|) + (QUOTE QSLESSP)) + +(DEFUN |SINT;<;2$B;24| (|x| |y| $) + (QSLESSP |x| |y|)) + +(PUT + (QUOTE |SINT;inc;2$;25|) + (QUOTE |SPADreplace|) + (QUOTE QSADD1)) + +(DEFUN |SINT;inc;2$;25| (|x| $) + (QSADD1 |x|)) + +(PUT + (QUOTE |SINT;dec;2$;26|) + (QUOTE |SPADreplace|) + (QUOTE QSSUB1)) + +(DEFUN |SINT;dec;2$;26| (|x| $) + (QSSUB1 |x|)) + +(PUT + (QUOTE |SINT;-;2$;27|) + (QUOTE |SPADreplace|) + (QUOTE QSMINUS)) + +(DEFUN |SINT;-;2$;27| (|x| $) + (QSMINUS |x|)) + +(PUT + (QUOTE |SINT;+;3$;28|) + (QUOTE |SPADreplace|) + (QUOTE QSPLUS)) + +(DEFUN |SINT;+;3$;28| (|x| |y| $) + (QSPLUS |x| |y|)) + +(PUT + (QUOTE |SINT;-;3$;29|) + (QUOTE |SPADreplace|) + (QUOTE QSDIFFERENCE)) + +(DEFUN |SINT;-;3$;29| (|x| |y| $) + (QSDIFFERENCE |x| |y|)) + +(PUT + (QUOTE |SINT;*;3$;30|) + (QUOTE |SPADreplace|) + (QUOTE QSTIMES)) + +(DEFUN |SINT;*;3$;30| (|x| |y| $) + (QSTIMES |x| |y|)) + +(DEFUN |SINT;**;$Nni$;31| (|x| |n| $) + (SPADCALL (EXPT |x| |n|) (QREFELT $ 33))) + +(PUT + (QUOTE |SINT;quo;3$;32|) + (QUOTE |SPADreplace|) + (QUOTE QSQUOTIENT)) + +(DEFUN |SINT;quo;3$;32| (|x| |y| $) + (QSQUOTIENT |x| |y|)) + +(PUT + (QUOTE |SINT;rem;3$;33|) + (QUOTE |SPADreplace|) + (QUOTE QSREMAINDER)) + +(DEFUN |SINT;rem;3$;33| (|x| |y| $) + (QSREMAINDER |x| |y|)) + +(DEFUN |SINT;divide;2$R;34| (|x| |y| $) + (CONS (QSQUOTIENT |x| |y|) (QSREMAINDER |x| |y|))) + +(PUT (QUOTE |SINT;gcd;3$;35|) + (QUOTE |SPADreplace|) (QUOTE GCD)) + +(DEFUN |SINT;gcd;3$;35| (|x| |y| $) + (GCD |x| |y|)) + +(PUT + (QUOTE |SINT;abs;2$;36|) + (QUOTE |SPADreplace|) + (QUOTE QSABSVAL)) + +(DEFUN |SINT;abs;2$;36| (|x| $) + (QSABSVAL |x|)) + +(PUT + (QUOTE |SINT;odd?;$B;37|) + (QUOTE |SPADreplace|) + (QUOTE QSODDP)) + +(DEFUN |SINT;odd?;$B;37| (|x| $) + (QSODDP |x|)) + +(PUT + (QUOTE |SINT;zero?;$B;38|) + (QUOTE |SPADreplace|) + (QUOTE QSZEROP)) + +(DEFUN |SINT;zero?;$B;38| (|x| $) + (QSZEROP |x|)) + +(PUT + (QUOTE |SINT;max;3$;39|) + (QUOTE |SPADreplace|) + (QUOTE QSMAX)) + +(DEFUN |SINT;max;3$;39| (|x| |y| $) + (QSMAX |x| |y|)) + +(PUT + (QUOTE |SINT;min;3$;40|) + (QUOTE |SPADreplace|) + (QUOTE QSMIN)) + +(DEFUN |SINT;min;3$;40| (|x| |y| $) + (QSMIN |x| |y|)) + +(PUT + (QUOTE |SINT;hash;2$;41|) + (QUOTE |SPADreplace|) + (QUOTE HASHEQ)) + +(DEFUN |SINT;hash;2$;41| (|x| $) + (HASHEQ |x|)) + +(PUT + (QUOTE |SINT;length;2$;42|) + (QUOTE |SPADreplace|) + (QUOTE INTEGER-LENGTH)) + +(DEFUN |SINT;length;2$;42| (|x| $) + (INTEGER-LENGTH |x|)) + +(PUT + (QUOTE |SINT;shift;3$;43|) + (QUOTE |SPADreplace|) + (QUOTE QSLEFTSHIFT)) + +(DEFUN |SINT;shift;3$;43| (|x| |n| $) + (QSLEFTSHIFT |x| |n|)) + +(PUT + (QUOTE |SINT;mulmod;4$;44|) + (QUOTE |SPADreplace|) + (QUOTE QSMULTMOD)) + +(DEFUN |SINT;mulmod;4$;44| (|a| |b| |p| $) + (QSMULTMOD |a| |b| |p|)) + +(PUT + (QUOTE |SINT;addmod;4$;45|) + (QUOTE |SPADreplace|) + (QUOTE QSADDMOD)) + +(DEFUN |SINT;addmod;4$;45| (|a| |b| |p| $) + (QSADDMOD |a| |b| |p|)) + +(PUT + (QUOTE |SINT;submod;4$;46|) + (QUOTE |SPADreplace|) + (QUOTE QSDIFMOD)) + +(DEFUN |SINT;submod;4$;46| (|a| |b| |p| $) + (QSDIFMOD |a| |b| |p|)) + +(PUT + (QUOTE |SINT;negative?;$B;47|) + (QUOTE |SPADreplace|) + (QUOTE QSMINUSP)) + +(DEFUN |SINT;negative?;$B;47| (|x| $) + (QSMINUSP |x|)) + +(PUT + (QUOTE |SINT;reducedSystem;MVR;48|) + (QUOTE |SPADreplace|) + (QUOTE CONS)) + +(DEFUN |SINT;reducedSystem;MVR;48| (|m| |v| $) + (CONS |m| |v|)) + +(DEFUN |SINT;positiveRemainder;3$;49| (|x| |n| $) + (PROG (|r|) + (RETURN + (SEQ + (LETT |r| (QSREMAINDER |x| |n|) |SINT;positiveRemainder;3$;49|) + (EXIT + (COND + ((QSMINUSP |r|) + (COND + ((QSMINUSP |n|) (QSDIFFERENCE |x| |n|)) + ((QUOTE T) (QSPLUS |r| |n|)))) + ((QUOTE T) |r|))))))) + +(DEFUN |SINT;coerce;I$;50| (|x| $) + (SEQ + (COND + ((NULL (< MOST-POSITIVE-FIXNUM |x|)) + (COND ((NULL (< |x| MOST-NEGATIVE-FIXNUM)) (EXIT |x|))))) + (EXIT (|error| "integer too large to represent in a machine word")))) + +(DEFUN |SINT;random;$;51| ($) + (SEQ + (SETELT $ 6 (REMAINDER (TIMES 314159269 (QREFELT $ 6)) 2147483647)) + (EXIT (REMAINDER (QREFELT $ 6) 67108864)))) + +(PUT + (QUOTE |SINT;random;2$;52|) + (QUOTE |SPADreplace|) + (QUOTE RANDOM)) + +(DEFUN |SINT;random;2$;52| (|n| $) + (RANDOM |n|)) + +(DEFUN |SINT;unitNormal;$R;53| (|x| $) + (COND + ((QSLESSP |x| 0) (VECTOR -1 (QSMINUS |x|) -1)) + ((QUOTE T) (VECTOR 1 |x| 1)))) + +(DEFUN |SingleInteger| NIL + (PROG NIL + (RETURN + (PROG (#0=#:G1358) + (RETURN + (COND + ((LETT #0# + (HGET |$ConstructorCache| (QUOTE |SingleInteger|)) + |SingleInteger|) + (|CDRwithIncrement| (CDAR #0#))) + ((QUOTE T) + (UNWIND-PROTECT + (PROG1 + (CDDAR + (HPUT + |$ConstructorCache| + (QUOTE |SingleInteger|) + (LIST (CONS NIL (CONS 1 (|SingleInteger;|)))))) + (LETT #0# T |SingleInteger|)) + (COND + ((NOT #0#) + (HREM |$ConstructorCache| + (QUOTE |SingleInteger|)))))))))))) + +(DEFUN |SingleInteger;| NIL + (PROG (|dv$| $ |pv$|) + (RETURN + (PROGN + (LETT |dv$| (QUOTE (|SingleInteger|)) . #0=(|SingleInteger|)) + (LETT $ (GETREFV 103) . #0#) + (QSETREFV $ 0 |dv$|) + (QSETREFV $ 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) + (|haddProp| |$ConstructorCache| (QUOTE |SingleInteger|) NIL (CONS 1 $)) + (|stuffDomainSlots| $) (QSETREFV $ 6 1) $)))) + +(MAKEPROP + (QUOTE |SingleInteger|) + (QUOTE |infovec|) + (LIST + (QUOTE + #(NIL NIL NIL NIL NIL NIL + (QUOTE |seed|) + (|Void|) + (|OpenMathDevice|) + (0 . |OMputApp|) + (|String|) + (5 . |OMputSymbol|) + (|Integer|) + (12 . |OMputInteger|) + (18 . |OMputEndApp|) + (|OpenMathEncoding|) + (23 . |OMencodingXML|) + (27 . |OMopenString|) + (33 . |OMputObject|) + (38 . |OMputEndObject|) + (43 . |OMclose|) + |SINT;OMwrite;$S;2| + (|Boolean|) + |SINT;OMwrite;$BS;3| + |SINT;OMwrite;Omd$V;4| + |SINT;OMwrite;Omd$BV;5| + (|Matrix| 12) + (|Matrix| $) + |SINT;reducedSystem;MM;6| + (|OutputForm|) + (48 . |coerce|) + |SINT;coerce;$Of;7| + |SINT;convert;$I;8| + (53 . |coerce|) + |SINT;*;I2$;9| + (CONS IDENTITY (FUNCALL (|dispatchFunction| |SINT;Zero;$;10|) $)) + (CONS IDENTITY (FUNCALL (|dispatchFunction| |SINT;One;$;11|) $)) + |SINT;base;$;12| + |SINT;max;$;13| + |SINT;min;$;14| + |SINT;=;2$B;15| + |SINT;~;2$;16| + |SINT;not;2$;17| + |SINT;/\\;3$;18| + |SINT;\\/;3$;19| + |SINT;Not;2$;20| + |SINT;And;3$;21| + |SINT;Or;3$;22| + |SINT;xor;3$;23| + |SINT;<;2$B;24| + |SINT;inc;2$;25| + |SINT;dec;2$;26| + |SINT;-;2$;27| + |SINT;+;3$;28| + |SINT;-;3$;29| + |SINT;*;3$;30| + (|NonNegativeInteger|) + |SINT;**;$Nni$;31| + |SINT;quo;3$;32| + |SINT;rem;3$;33| + (|Record| (|:| |quotient| $) (|:| |remainder| $)) + |SINT;divide;2$R;34| + |SINT;gcd;3$;35| + |SINT;abs;2$;36| + |SINT;odd?;$B;37| + |SINT;zero?;$B;38| + |SINT;max;3$;39| + |SINT;min;3$;40| + |SINT;hash;2$;41| + |SINT;length;2$;42| + |SINT;shift;3$;43| + |SINT;mulmod;4$;44| + |SINT;addmod;4$;45| + |SINT;submod;4$;46| + |SINT;negative?;$B;47| + (|Record| (|:| |mat| 26) (|:| |vec| (|Vector| 12))) + (|Vector| $) + |SINT;reducedSystem;MVR;48| + |SINT;positiveRemainder;3$;49| + |SINT;coerce;I$;50| + |SINT;random;$;51| + |SINT;random;2$;52| + (|Record| (|:| |unit| $) (|:| |canonical| $) (|:| |associate| $)) + |SINT;unitNormal;$R;53| + (|Union| 85 (QUOTE "failed")) + (|Fraction| 12) + (|Union| $ (QUOTE "failed")) + (|Float|) + (|DoubleFloat|) + (|Pattern| 12) + (|PatternMatchResult| 12 $) + (|InputForm|) + (|Union| 12 (QUOTE "failed")) + (|Record| (|:| |coef| 94) (|:| |generator| $)) + (|List| $) + (|Union| 94 (QUOTE "failed")) + (|Record| (|:| |coef1| $) (|:| |coef2| $) (|:| |generator| $)) + (|Record| (|:| |coef1| $) (|:| |coef2| $)) + (|Union| 97 (QUOTE "failed")) + (|Factored| $) + (|SparseUnivariatePolynomial| $) + (|PositiveInteger|) + (|SingleInteger|))) + (QUOTE + #(~= 58 ~ 64 |zero?| 69 |xor| 74 |unitNormal| 80 |unitCanonical| 85 + |unit?| 90 |symmetricRemainder| 95 |subtractIfCan| 101 |submod| 107 + |squareFreePart| 114 |squareFree| 119 |sizeLess?| 124 |sign| 130 + |shift| 135 |sample| 141 |retractIfCan| 145 |retract| 150 |rem| 155 + |reducedSystem| 161 |recip| 172 |rationalIfCan| 177 |rational?| 182 + |rational| 187 |random| 192 |quo| 201 |principalIdeal| 207 + |prime?| 212 |powmod| 217 |positiveRemainder| 224 |positive?| 230 + |permutation| 235 |patternMatch| 241 |one?| 248 |odd?| 253 |not| 258 + |nextItem| 263 |negative?| 268 |multiEuclidean| 273 |mulmod| 279 + |min| 286 |max| 296 |mask| 306 |length| 311 |lcm| 316 |latex| 327 + |invmod| 332 |init| 338 |inc| 342 |hash| 347 |gcdPolynomial| 357 + |gcd| 363 |factorial| 374 |factor| 379 |extendedEuclidean| 384 + |exquo| 397 |expressIdealMember| 403 |even?| 409 |euclideanSize| 414 + |divide| 419 |differentiate| 425 |dec| 436 |copy| 441 |convert| 446 + |coerce| 471 |characteristic| 491 |bit?| 495 |binomial| 501 + |base| 507 |associates?| 511 |addmod| 517 |abs| 524 ^ 529 |\\/| 541 + |Zero| 547 |Or| 551 |One| 557 |OMwrite| 561 |Not| 585 D 590 + |And| 601 >= 607 > 613 = 619 <= 625 < 631 |/\\| 637 - 643 + 654 + ** 660 * 672)) + (QUOTE ( + (|noetherian| . 0) + (|canonicalsClosed| . 0) + (|canonical| . 0) + (|canonicalUnitNormal| . 0) + (|multiplicativeValuation| . 0) + (|noZeroDivisors| . 0) + ((|commutative| "*") . 0) + (|rightUnitary| . 0) + (|leftUnitary| . 0) + (|unitsKnown| . 0))) + (CONS + (|makeByteWordVec2| 1 + (QUOTE (0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 + 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 + 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0))) + (CONS + (QUOTE + #(|IntegerNumberSystem&| |EuclideanDomain&| + |UniqueFactorizationDomain&| NIL NIL |GcdDomain&| + |IntegralDomain&| |Algebra&| |Module&| NIL |Module&| NIL NIL + |Module&| NIL |DifferentialRing&| |OrderedRing&| NIL |Module&| + NIL |Module&| NIL NIL NIL NIL NIL NIL |Ring&| NIL NIL NIL NIL + NIL NIL NIL NIL NIL NIL NIL NIL NIL |AbelianGroup&| NIL NIL + |AbelianMonoid&| |Monoid&| NIL NIL NIL NIL |OrderedSet&| + |AbelianSemiGroup&| |SemiGroup&| |Logic&| NIL |SetCategory&| NIL + NIL NIL NIL |RetractableTo&| NIL NIL NIL |RetractableTo&| NIL NIL + NIL NIL NIL NIL |RetractableTo&| NIL |BasicType&| NIL)) + (CONS + (QUOTE + #((|IntegerNumberSystem|) (|EuclideanDomain|) + (|UniqueFactorizationDomain|) (|PrincipalIdealDomain|) + (|OrderedIntegralDomain|) (|GcdDomain|) (|IntegralDomain|) + (|Algebra| $$) (|Module| 12) (|LinearlyExplicitRingOver| 12) + (|Module| #0=#:G1062) (|LinearlyExplicitRingOver| #0#) + (|CharacteristicZero|) (|Module| #1=#:G106217) + (|LinearlyExplicitRingOver| #1#) (|DifferentialRing|) + (|OrderedRing|) (|CommutativeRing|) (|Module| |t#1|) + (|EntireRing|) (|Module| $$) (|BiModule| 12 12) + (|BiModule| #0# #0#) (|BiModule| #1# #1#) + (|OrderedAbelianGroup|) (|BiModule| |t#1| |t#1|) + (|BiModule| $$ $$) (|Ring|) (|RightModule| 12) + (|LeftModule| 12) (|RightModule| #0#) (|LeftModule| #0#) + (|RightModule| #1#) (|LeftModule| #1#) + (|OrderedCancellationAbelianMonoid|) (|RightModule| |t#1|) + (|LeftModule| |t#1|) (|LeftModule| $$) (|Rng|) + (|RightModule| $$) (|OrderedAbelianMonoid|) (|AbelianGroup|) + (|OrderedAbelianSemiGroup|) (|CancellationAbelianMonoid|) + (|AbelianMonoid|) (|Monoid|) (|PatternMatchable| 12) + (|PatternMatchable| #:G1065) (|StepThrough|) + (|PatternMatchable| #:G106220) (|OrderedSet|) + (|AbelianSemiGroup|) (|SemiGroup|) (|Logic|) (|RealConstant|) + (|SetCategory|) (|OpenMath|) (|CoercibleTo| #:G82356) + (|ConvertibleTo| 89) (|ConvertibleTo| 91) (|RetractableTo| 12) + (|ConvertibleTo| 12) (|ConvertibleTo| #:G1064) + (|ConvertibleTo| #:G1063) (|RetractableTo| #:G1061) + (|ConvertibleTo| #:G1060) (|ConvertibleTo| 87) + (|ConvertibleTo| 88) (|CombinatorialFunctionCategory|) + (|ConvertibleTo| #:G106219) (|ConvertibleTo| #:G106218) + (|RetractableTo| #:G106216) (|ConvertibleTo| #:G106215) + (|BasicType|) (|CoercibleTo| 29))) + (|makeByteWordVec2| 102 + (QUOTE + (1 8 7 0 9 3 8 7 0 10 10 11 2 8 7 0 12 13 1 8 7 0 14 0 15 0 + 16 2 8 0 10 15 17 1 8 7 0 18 1 8 7 0 19 1 8 7 0 20 1 12 29 + 0 30 1 0 0 12 33 2 0 22 0 0 1 1 0 0 0 41 1 0 22 0 65 2 0 0 + 0 0 48 1 0 82 0 83 1 0 0 0 1 1 0 22 0 1 2 0 0 0 0 1 2 0 86 + 0 0 1 3 0 0 0 0 0 73 1 0 0 0 1 1 0 99 0 1 2 0 22 0 0 1 1 0 + 12 0 1 2 0 0 0 0 70 0 0 0 1 1 0 92 0 1 1 0 12 0 1 2 0 0 0 0 + 59 1 0 26 27 28 2 0 75 27 76 77 1 0 86 0 1 1 0 84 0 1 1 0 + 22 0 1 1 0 85 0 1 1 0 0 0 81 0 0 0 80 2 0 0 0 0 58 1 0 93 + 94 1 1 0 22 0 1 3 0 0 0 0 0 1 2 0 0 0 0 78 1 0 22 0 1 2 0 0 + 0 0 1 3 0 90 0 89 90 1 1 0 22 0 1 1 0 22 0 64 1 0 0 0 42 1 + 0 86 0 1 1 0 22 0 74 2 0 95 94 0 1 3 0 0 0 0 0 71 0 0 0 39 + 2 0 0 0 0 67 0 0 0 38 2 0 0 0 0 66 1 0 0 0 1 1 0 0 0 69 1 0 + 0 94 1 2 0 0 0 0 1 1 0 10 0 1 2 0 0 0 0 1 0 0 0 1 1 0 0 0 50 + 1 0 0 0 68 1 0 102 0 1 2 0 100 100 100 1 1 0 0 94 1 2 0 0 0 + 0 62 1 0 0 0 1 1 0 99 0 1 2 0 96 0 0 1 3 0 98 0 0 0 1 2 0 86 + 0 0 1 2 0 95 94 0 1 1 0 22 0 1 1 0 56 0 1 2 0 60 0 0 61 1 0 + 0 0 1 2 0 0 0 56 1 1 0 0 0 51 1 0 0 0 1 1 0 87 0 1 1 0 88 0 + 1 1 0 89 0 1 1 0 91 0 1 1 0 12 0 32 1 0 0 12 79 1 0 0 0 1 1 + 0 0 12 79 1 0 29 0 31 0 0 56 1 2 0 22 0 0 1 2 0 0 0 0 1 0 0 + 0 37 2 0 22 0 0 1 3 0 0 0 0 0 72 1 0 0 0 63 2 0 0 0 56 1 2 0 + 0 0 101 1 2 0 0 0 0 44 0 0 0 35 2 0 0 0 0 47 0 0 0 36 3 0 7 + 8 0 22 25 2 0 10 0 22 23 2 0 7 8 0 24 1 0 10 0 21 1 0 0 0 45 + 1 0 0 0 1 2 0 0 0 56 1 2 0 0 0 0 46 2 0 22 0 0 1 2 0 22 0 0 + 1 2 0 22 0 0 40 2 0 22 0 0 1 2 0 22 0 0 49 2 0 0 0 0 43 1 0 + 0 0 52 2 0 0 0 0 54 2 0 0 0 0 53 2 0 0 0 56 57 2 0 0 0 101 1 + 2 0 0 0 0 55 2 0 0 12 0 34 2 0 0 56 0 1 2 0 0 101 0 1)))))) + (QUOTE |lookupComplete|))) + +(MAKEPROP (QUOTE |SingleInteger|) (QUOTE NILADIC) T) + +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\section{SYMBOL.lsp BOOTSTRAP} +{\bf SYMBOL} depends on a chain of +files. We need to break this cycle to build the algebra. So we keep a +cached copy of the translated {\bf SYMBOL} category which we can write +into the {\bf MID} directory. We compile the lisp code and copy the +{\bf SYMBOL.o} file to the {\bf OUT} directory. This is eventually +forcibly replaced by a recompiled version. + +Note that this code is not included in the generated catdef.spad file. + +<>= + +(|/VERSIONCHECK| 2) + +(DEFUN |SYMBOL;writeOMSym| (|dev| |x| |$|) (COND ((SPADCALL |x| (QREFELT |$| 21)) (|error| "Cannot convert a scripted symbol to OpenMath")) ((QUOTE T) (SPADCALL |dev| |x| (QREFELT |$| 25))))) + +(DEFUN |SYMBOL;OMwrite;$S;2| (|x| |$|) (PROG (|sp| |dev| |s|) (RETURN (SEQ (LETT |s| "" |SYMBOL;OMwrite;$S;2|) (LETT |sp| (|OM-STRINGTOSTRINGPTR| |s|) |SYMBOL;OMwrite;$S;2|) (LETT |dev| (SPADCALL |sp| (SPADCALL (QREFELT |$| 27)) (QREFELT |$| 29)) |SYMBOL;OMwrite;$S;2|) (SPADCALL |dev| (QREFELT |$| 30)) (|SYMBOL;writeOMSym| |dev| |x| |$|) (SPADCALL |dev| (QREFELT |$| 31)) (SPADCALL |dev| (QREFELT |$| 32)) (LETT |s| (|OM-STRINGPTRTOSTRING| |sp|) |SYMBOL;OMwrite;$S;2|) (EXIT |s|))))) + +(DEFUN |SYMBOL;OMwrite;$BS;3| (|x| |wholeObj| |$|) (PROG (|sp| |dev| |s|) (RETURN (SEQ (LETT |s| "" |SYMBOL;OMwrite;$BS;3|) (LETT |sp| (|OM-STRINGTOSTRINGPTR| |s|) |SYMBOL;OMwrite;$BS;3|) (LETT |dev| (SPADCALL |sp| (SPADCALL (QREFELT |$| 27)) (QREFELT |$| 29)) |SYMBOL;OMwrite;$BS;3|) (COND (|wholeObj| (SPADCALL |dev| (QREFELT |$| 30)))) (|SYMBOL;writeOMSym| |dev| |x| |$|) (COND (|wholeObj| (SPADCALL |dev| (QREFELT |$| 31)))) (SPADCALL |dev| (QREFELT |$| 32)) (LETT |s| (|OM-STRINGPTRTOSTRING| |sp|) |SYMBOL;OMwrite;$BS;3|) (EXIT |s|))))) + +(DEFUN |SYMBOL;OMwrite;Omd$V;4| (|dev| |x| |$|) (SEQ (SPADCALL |dev| (QREFELT |$| 30)) (|SYMBOL;writeOMSym| |dev| |x| |$|) (EXIT (SPADCALL |dev| (QREFELT |$| 31))))) + +(DEFUN |SYMBOL;OMwrite;Omd$BV;5| (|dev| |x| |wholeObj| |$|) (SEQ (COND (|wholeObj| (SPADCALL |dev| (QREFELT |$| 30)))) (|SYMBOL;writeOMSym| |dev| |x| |$|) (EXIT (COND (|wholeObj| (SPADCALL |dev| (QREFELT |$| 31))))))) + +(DEFUN |SYMBOL;convert;$If;6| (|s| |$|) (SPADCALL |s| (QREFELT |$| 44))) + +(PUT (QUOTE |SYMBOL;convert;2$;7|) (QUOTE |SPADreplace|) (QUOTE (XLAM (|s|) |s|))) + +(DEFUN |SYMBOL;convert;2$;7| (|s| |$|) |s|) + +(DEFUN |SYMBOL;coerce;S$;8| (|s| |$|) (VALUES (INTERN |s|))) + +(PUT (QUOTE |SYMBOL;=;2$B;9|) (QUOTE |SPADreplace|) (QUOTE EQUAL)) + +(DEFUN |SYMBOL;=;2$B;9| (|x| |y| |$|) (EQUAL |x| |y|)) + +(PUT (QUOTE |SYMBOL;<;2$B;10|) (QUOTE |SPADreplace|) (QUOTE (XLAM (|x| |y|) (GGREATERP |y| |x|)))) + +(DEFUN |SYMBOL;<;2$B;10| (|x| |y| |$|) (GGREATERP |y| |x|)) + +(DEFUN |SYMBOL;coerce;$Of;11| (|x| |$|) (SPADCALL |x| (QREFELT |$| 51))) + +(DEFUN |SYMBOL;subscript;$L$;12| (|sy| |lx| |$|) (SPADCALL |sy| (LIST |lx| NIL NIL NIL NIL) (QREFELT |$| 54))) + +(DEFUN |SYMBOL;elt;$L$;13| (|sy| |lx| |$|) (SPADCALL |sy| |lx| (QREFELT |$| 56))) + +(DEFUN |SYMBOL;superscript;$L$;14| (|sy| |lx| |$|) (SPADCALL |sy| (LIST NIL |lx| NIL NIL NIL) (QREFELT |$| 54))) + +(DEFUN |SYMBOL;argscript;$L$;15| (|sy| |lx| |$|) (SPADCALL |sy| (LIST NIL NIL NIL NIL |lx|) (QREFELT |$| 54))) + +(DEFUN |SYMBOL;patternMatch;$P2Pmr;16| (|x| |p| |l| |$|) (SPADCALL |x| |p| |l| (QREFELT |$| 63))) + +(DEFUN |SYMBOL;patternMatch;$P2Pmr;17| (|x| |p| |l| |$|) (SPADCALL |x| |p| |l| (QREFELT |$| 69))) + +(DEFUN |SYMBOL;convert;$P;18| (|x| |$|) (SPADCALL |x| (QREFELT |$| 72))) + +(DEFUN |SYMBOL;convert;$P;19| (|x| |$|) (SPADCALL |x| (QREFELT |$| 74))) + +(DEFUN |SYMBOL;syprefix| (|sc| |$|) (PROG (|ns| #1=#:G108218 |n| #2=#:G108219) (RETURN (SEQ (LETT |ns| (LIST (LENGTH (QVELT |sc| 3)) (LENGTH (QVELT |sc| 2)) (LENGTH (QVELT |sc| 1)) (LENGTH (QVELT |sc| 0))) |SYMBOL;syprefix|) (SEQ G190 (COND ((NULL (COND ((|<| (LENGTH |ns|) 2) (QUOTE NIL)) ((QUOTE T) (ZEROP (|SPADfirst| |ns|))))) (GO G191))) (SEQ (EXIT (LETT |ns| (CDR |ns|) |SYMBOL;syprefix|))) NIL (GO G190) G191 (EXIT NIL)) (EXIT (SPADCALL (CONS (STRCONC (QREFELT |$| 37) (|SYMBOL;istring| (LENGTH (QVELT |sc| 4)) |$|)) (PROGN (LETT #1# NIL |SYMBOL;syprefix|) (SEQ (LETT |n| NIL |SYMBOL;syprefix|) (LETT #2# (NREVERSE |ns|) |SYMBOL;syprefix|) G190 (COND ((OR (ATOM #2#) (PROGN (LETT |n| (CAR #2#) |SYMBOL;syprefix|) NIL)) (GO G191))) (SEQ (EXIT (LETT #1# (CONS (|SYMBOL;istring| |n| |$|) #1#) |SYMBOL;syprefix|))) (LETT #2# (CDR #2#) |SYMBOL;syprefix|) (GO G190) G191 (EXIT (NREVERSE0 #1#))))) (QREFELT |$| 77))))))) + +(DEFUN |SYMBOL;syscripts| (|sc| |$|) (PROG (|all|) (RETURN (SEQ (LETT |all| (QVELT |sc| 3) |SYMBOL;syscripts|) (LETT |all| (SPADCALL (QVELT |sc| 2) |all| (QREFELT |$| 78)) |SYMBOL;syscripts|) (LETT |all| (SPADCALL (QVELT |sc| 1) |all| (QREFELT |$| 78)) |SYMBOL;syscripts|) (LETT |all| (SPADCALL (QVELT |sc| 0) |all| (QREFELT |$| 78)) |SYMBOL;syscripts|) (EXIT (SPADCALL |all| (QVELT |sc| 4) (QREFELT |$| 78))))))) + +(DEFUN |SYMBOL;script;$L$;22| (|sy| |ls| |$|) (PROG (|sc|) (RETURN (SEQ (LETT |sc| (VECTOR NIL NIL NIL NIL NIL) |SYMBOL;script;$L$;22|) (COND ((NULL (NULL |ls|)) (SEQ (QSETVELT |sc| 0 (|SPADfirst| |ls|)) (EXIT (LETT |ls| (CDR |ls|) |SYMBOL;script;$L$;22|))))) (COND ((NULL (NULL |ls|)) (SEQ (QSETVELT |sc| 1 (|SPADfirst| |ls|)) (EXIT (LETT |ls| (CDR |ls|) |SYMBOL;script;$L$;22|))))) (COND ((NULL (NULL |ls|)) (SEQ (QSETVELT |sc| 2 (|SPADfirst| |ls|)) (EXIT (LETT |ls| (CDR |ls|) |SYMBOL;script;$L$;22|))))) (COND ((NULL (NULL |ls|)) (SEQ (QSETVELT |sc| 3 (|SPADfirst| |ls|)) (EXIT (LETT |ls| (CDR |ls|) |SYMBOL;script;$L$;22|))))) (COND ((NULL (NULL |ls|)) (SEQ (QSETVELT |sc| 4 (|SPADfirst| |ls|)) (EXIT (LETT |ls| (CDR |ls|) |SYMBOL;script;$L$;22|))))) (EXIT (SPADCALL |sy| |sc| (QREFELT |$| 80))))))) + +(DEFUN |SYMBOL;script;$R$;23| (|sy| |sc| |$|) (COND ((SPADCALL |sy| (QREFELT |$| 21)) (|error| "Cannot add scripts to a scripted symbol")) ((QUOTE T) (CONS (SPADCALL (SPADCALL (STRCONC (|SYMBOL;syprefix| |sc| |$|) (SPADCALL (SPADCALL |sy| (QREFELT |$| 81)) (QREFELT |$| 82))) (QREFELT |$| 47)) (QREFELT |$| 52)) (|SYMBOL;syscripts| |sc| |$|))))) + +(DEFUN |SYMBOL;string;$S;24| (|e| |$|) (COND ((NULL (SPADCALL |e| (QREFELT |$| 21))) (PNAME |e|)) ((QUOTE T) (|error| "Cannot form string from non-atomic symbols.")))) + +(DEFUN |SYMBOL;latex;$S;25| (|e| |$|) (PROG (|ss| |lo| |sc| |s|) (RETURN (SEQ (LETT |s| (PNAME (SPADCALL |e| (QREFELT |$| 81))) |SYMBOL;latex;$S;25|) (COND ((|<| 1 (QCSIZE |s|)) (COND ((NULL (SPADCALL (SPADCALL |s| 1 (QREFELT |$| 83)) (SPADCALL "\\" (QREFELT |$| 40)) (QREFELT |$| 84))) (LETT |s| (STRCONC "\\mbox{\\it " (STRCONC |s| "}")) |SYMBOL;latex;$S;25|))))) (COND ((NULL (SPADCALL |e| (QREFELT |$| 21))) (EXIT |s|))) (LETT |ss| (SPADCALL |e| (QREFELT |$| 85)) |SYMBOL;latex;$S;25|) (LETT |lo| (QVELT |ss| 0) |SYMBOL;latex;$S;25|) (COND ((NULL (NULL |lo|)) (SEQ (LETT |sc| "_{" |SYMBOL;latex;$S;25|) (SEQ G190 (COND ((NULL (COND ((NULL |lo|) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) (GO G191))) (SEQ (LETT |sc| (STRCONC |sc| (SPADCALL (|SPADfirst| |lo|) (QREFELT |$| 86))) |SYMBOL;latex;$S;25|) (LETT |lo| (CDR |lo|) |SYMBOL;latex;$S;25|) (EXIT (COND ((NULL (NULL |lo|)) (LETT |sc| (STRCONC |sc| ", ") |SYMBOL;latex;$S;25|))))) NIL (GO G190) G191 (EXIT NIL)) (LETT |sc| (STRCONC |sc| "}") |SYMBOL;latex;$S;25|) (EXIT (LETT |s| (STRCONC |s| |sc|) |SYMBOL;latex;$S;25|))))) (LETT |lo| (QVELT |ss| 1) |SYMBOL;latex;$S;25|) (COND ((NULL (NULL |lo|)) (SEQ (LETT |sc| "^{" |SYMBOL;latex;$S;25|) (SEQ G190 (COND ((NULL (COND ((NULL |lo|) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) (GO G191))) (SEQ (LETT |sc| (STRCONC |sc| (SPADCALL (|SPADfirst| |lo|) (QREFELT |$| 86))) |SYMBOL;latex;$S;25|) (LETT |lo| (CDR |lo|) |SYMBOL;latex;$S;25|) (EXIT (COND ((NULL (NULL |lo|)) (LETT |sc| (STRCONC |sc| ", ") |SYMBOL;latex;$S;25|))))) NIL (GO G190) G191 (EXIT NIL)) (LETT |sc| (STRCONC |sc| "}") |SYMBOL;latex;$S;25|) (EXIT (LETT |s| (STRCONC |s| |sc|) |SYMBOL;latex;$S;25|))))) (LETT |lo| (QVELT |ss| 2) |SYMBOL;latex;$S;25|) (COND ((NULL (NULL |lo|)) (SEQ (LETT |sc| "{}^{" |SYMBOL;latex;$S;25|) (SEQ G190 (COND ((NULL (COND ((NULL |lo|) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) (GO G191))) (SEQ (LETT |sc| (STRCONC |sc| (SPADCALL (|SPADfirst| |lo|) (QREFELT |$| 86))) |SYMBOL;latex;$S;25|) (LETT |lo| (CDR |lo|) |SYMBOL;latex;$S;25|) (EXIT (COND ((NULL (NULL |lo|)) (LETT |sc| (STRCONC |sc| ", ") |SYMBOL;latex;$S;25|))))) NIL (GO G190) G191 (EXIT NIL)) (LETT |sc| (STRCONC |sc| "}") |SYMBOL;latex;$S;25|) (EXIT (LETT |s| (STRCONC |sc| |s|) |SYMBOL;latex;$S;25|))))) (LETT |lo| (QVELT |ss| 3) |SYMBOL;latex;$S;25|) (COND ((NULL (NULL |lo|)) (SEQ (LETT |sc| "{}_{" |SYMBOL;latex;$S;25|) (SEQ G190 (COND ((NULL (COND ((NULL |lo|) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) (GO G191))) (SEQ (LETT |sc| (STRCONC |sc| (SPADCALL (|SPADfirst| |lo|) (QREFELT |$| 86))) |SYMBOL;latex;$S;25|) (LETT |lo| (CDR |lo|) |SYMBOL;latex;$S;25|) (EXIT (COND ((NULL (NULL |lo|)) (LETT |sc| (STRCONC |sc| ", ") |SYMBOL;latex;$S;25|))))) NIL (GO G190) G191 (EXIT NIL)) (LETT |sc| (STRCONC |sc| "}") |SYMBOL;latex;$S;25|) (EXIT (LETT |s| (STRCONC |sc| |s|) |SYMBOL;latex;$S;25|))))) (LETT |lo| (QVELT |ss| 4) |SYMBOL;latex;$S;25|) (COND ((NULL (NULL |lo|)) (SEQ (LETT |sc| "\\left( {" |SYMBOL;latex;$S;25|) (SEQ G190 (COND ((NULL (COND ((NULL |lo|) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) (GO G191))) (SEQ (LETT |sc| (STRCONC |sc| (SPADCALL (|SPADfirst| |lo|) (QREFELT |$| 86))) |SYMBOL;latex;$S;25|) (LETT |lo| (CDR |lo|) |SYMBOL;latex;$S;25|) (EXIT (COND ((NULL (NULL |lo|)) (LETT |sc| (STRCONC |sc| ", ") |SYMBOL;latex;$S;25|))))) NIL (GO G190) G191 (EXIT NIL)) (LETT |sc| (STRCONC |sc| "} \\right)") |SYMBOL;latex;$S;25|) (EXIT (LETT |s| (STRCONC |s| |sc|) |SYMBOL;latex;$S;25|))))) (EXIT |s|))))) + +(DEFUN |SYMBOL;anyRadix| (|n| |s| |$|) (PROG (|qr| |ns| #1=#:G108274) (RETURN (SEQ (EXIT (SEQ (LETT |ns| "" |SYMBOL;anyRadix|) (EXIT (SEQ G190 NIL (SEQ (LETT |qr| (DIVIDE2 |n| (QCSIZE |s|)) |SYMBOL;anyRadix|) (LETT |n| (QCAR |qr|) |SYMBOL;anyRadix|) (LETT |ns| (SPADCALL (SPADCALL |s| (|+| (QCDR |qr|) (SPADCALL |s| (QREFELT |$| 88))) (QREFELT |$| 83)) |ns| (QREFELT |$| 89)) |SYMBOL;anyRadix|) (EXIT (COND ((ZEROP |n|) (PROGN (LETT #1# |ns| |SYMBOL;anyRadix|) (GO #1#)))))) NIL (GO G190) G191 (EXIT NIL))))) #1# (EXIT #1#))))) + +(DEFUN |SYMBOL;new;$;27| (|$|) (PROG (|sym|) (RETURN (SEQ (LETT |sym| (|SYMBOL;anyRadix| (SPADCALL (QREFELT |$| 9) (QREFELT |$| 90)) (QREFELT |$| 18) |$|) |SYMBOL;new;$;27|) (SPADCALL (QREFELT |$| 9) (|+| (SPADCALL (QREFELT |$| 9) (QREFELT |$| 90)) 1) (QREFELT |$| 91)) (EXIT (SPADCALL (STRCONC "%" |sym|) (QREFELT |$| 47))))))) + +(DEFUN |SYMBOL;new;2$;28| (|x| |$|) (PROG (|u| |n| |xx|) (RETURN (SEQ (LETT |n| (SEQ (LETT |u| (SPADCALL |x| (QREFELT |$| 12) (QREFELT |$| 94)) |SYMBOL;new;2$;28|) (EXIT (COND ((QEQCAR |u| 1) 0) ((QUOTE T) (|+| (QCDR |u|) 1))))) |SYMBOL;new;2$;28|) (SPADCALL (QREFELT |$| 12) |x| |n| (QREFELT |$| 95)) (LETT |xx| (COND ((NULL (SPADCALL |x| (QREFELT |$| 21))) (SPADCALL |x| (QREFELT |$| 82))) ((QUOTE T) (SPADCALL (SPADCALL |x| (QREFELT |$| 81)) (QREFELT |$| 82)))) |SYMBOL;new;2$;28|) (LETT |xx| (STRCONC "%" |xx|) |SYMBOL;new;2$;28|) (LETT |xx| (COND ((NULL (|<| (SPADCALL (SPADCALL |xx| (SPADCALL |xx| (QREFELT |$| 96)) (QREFELT |$| 83)) (QREFELT |$| 17) (QREFELT |$| 97)) (SPADCALL (QREFELT |$| 17) (QREFELT |$| 88)))) (STRCONC |xx| (|SYMBOL;anyRadix| |n| (QREFELT |$| 19) |$|))) ((QUOTE T) (STRCONC |xx| (|SYMBOL;anyRadix| |n| (QREFELT |$| 17) |$|)))) |SYMBOL;new;2$;28|) (COND ((NULL (SPADCALL |x| (QREFELT |$| 21))) (EXIT (SPADCALL |xx| (QREFELT |$| 47))))) (EXIT (SPADCALL (SPADCALL |xx| (QREFELT |$| 47)) (SPADCALL |x| (QREFELT |$| 85)) (QREFELT |$| 80))))))) + +(DEFUN |SYMBOL;resetNew;V;29| (|$|) (PROG (|k| #1=#:G108297) (RETURN (SEQ (SPADCALL (QREFELT |$| 9) 0 (QREFELT |$| 91)) (SEQ (LETT |k| NIL |SYMBOL;resetNew;V;29|) (LETT #1# (SPADCALL (QREFELT |$| 12) (QREFELT |$| 100)) |SYMBOL;resetNew;V;29|) G190 (COND ((OR (ATOM #1#) (PROGN (LETT |k| (CAR #1#) |SYMBOL;resetNew;V;29|) NIL)) (GO G191))) (SEQ (EXIT (SPADCALL |k| (QREFELT |$| 12) (QREFELT |$| 101)))) (LETT #1# (CDR #1#) |SYMBOL;resetNew;V;29|) (GO G190) G191 (EXIT NIL)) (EXIT (SPADCALL (QREFELT |$| 102))))))) + +(DEFUN |SYMBOL;scripted?;$B;30| (|sy| |$|) (COND ((ATOM |sy|) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) + +(DEFUN |SYMBOL;name;2$;31| (|sy| |$|) (PROG (|str| |i| #1=#:G108304 #2=#:G108303 #3=#:G108301) (RETURN (SEQ (EXIT (COND ((NULL (SPADCALL |sy| (QREFELT |$| 21))) |sy|) ((QUOTE T) (SEQ (LETT |str| (SPADCALL (SPADCALL (SPADCALL |sy| (QREFELT |$| 104)) (QREFELT |$| 105)) (QREFELT |$| 82)) |SYMBOL;name;2$;31|) (SEQ (EXIT (SEQ (LETT |i| (|+| (QREFELT |$| 38) 1) |SYMBOL;name;2$;31|) (LETT #1# (QCSIZE |str|) |SYMBOL;name;2$;31|) G190 (COND ((|>| |i| #1#) (GO G191))) (SEQ (EXIT (COND ((NULL (SPADCALL (SPADCALL |str| |i| (QREFELT |$| 83)) (QREFELT |$| 106))) (PROGN (LETT #3# (PROGN (LETT #2# (SPADCALL (SPADCALL |str| (SPADCALL |i| (QCSIZE |str|) (QREFELT |$| 108)) (QREFELT |$| 109)) (QREFELT |$| 47)) |SYMBOL;name;2$;31|) (GO #2#)) |SYMBOL;name;2$;31|) (GO #3#)))))) (LETT |i| (|+| |i| 1) |SYMBOL;name;2$;31|) (GO G190) G191 (EXIT NIL))) #3# (EXIT #3#)) (EXIT (|error| "Improper scripted symbol")))))) #2# (EXIT #2#))))) + +(DEFUN |SYMBOL;scripts;$R;32| (|sy| |$|) (PROG (|lscripts| |str| |nstr| |j| #1=#:G108307 |nscripts| |m| |n| #2=#:G108316 |i| #3=#:G108317 |a| #4=#:G108318 |allscripts|) (RETURN (SEQ (COND ((NULL (SPADCALL |sy| (QREFELT |$| 21))) (VECTOR NIL NIL NIL NIL NIL)) ((QUOTE T) (SEQ (LETT |nscripts| (LIST 0 0 0 0 0) |SYMBOL;scripts;$R;32|) (LETT |lscripts| (LIST NIL NIL NIL NIL NIL) |SYMBOL;scripts;$R;32|) (LETT |str| (SPADCALL (SPADCALL (SPADCALL |sy| (QREFELT |$| 104)) (QREFELT |$| 105)) (QREFELT |$| 82)) |SYMBOL;scripts;$R;32|) (LETT |nstr| (QCSIZE |str|) |SYMBOL;scripts;$R;32|) (LETT |m| (SPADCALL |nscripts| (QREFELT |$| 111)) |SYMBOL;scripts;$R;32|) (SEQ (LETT |j| (|+| (QREFELT |$| 38) 1) |SYMBOL;scripts;$R;32|) (LETT |i| |m| |SYMBOL;scripts;$R;32|) G190 (COND ((OR (|>| |j| |nstr|) (NULL (SPADCALL (SPADCALL |str| |j| (QREFELT |$| 83)) (QREFELT |$| 106)))) (GO G191))) (SEQ (EXIT (SPADCALL |nscripts| |i| (PROG1 (LETT #1# (|-| (SPADCALL (SPADCALL |str| |j| (QREFELT |$| 83)) (QREFELT |$| 41)) (QREFELT |$| 42)) |SYMBOL;scripts;$R;32|) (|check-subtype| (|>=| #1# 0) (QUOTE (|NonNegativeInteger|)) #1#)) (QREFELT |$| 113)))) (LETT |i| (PROG1 (|+| |i| 1) (LETT |j| (|+| |j| 1) |SYMBOL;scripts;$R;32|)) |SYMBOL;scripts;$R;32|) (GO G190) G191 (EXIT NIL)) (LETT |nscripts| (SPADCALL (CDR |nscripts|) (|SPADfirst| |nscripts|) (QREFELT |$| 114)) |SYMBOL;scripts;$R;32|) (LETT |allscripts| (SPADCALL (SPADCALL |sy| (QREFELT |$| 104)) (QREFELT |$| 115)) |SYMBOL;scripts;$R;32|) (LETT |m| (SPADCALL |lscripts| (QREFELT |$| 116)) |SYMBOL;scripts;$R;32|) (SEQ (LETT |n| NIL |SYMBOL;scripts;$R;32|) (LETT #2# |nscripts| |SYMBOL;scripts;$R;32|) (LETT |i| |m| |SYMBOL;scripts;$R;32|) G190 (COND ((OR (ATOM #2#) (PROGN (LETT |n| (CAR #2#) |SYMBOL;scripts;$R;32|) NIL)) (GO G191))) (SEQ (EXIT (COND ((|<| (SPADCALL |allscripts| (QREFELT |$| 117)) |n|) (|error| "Improper script count in symbol")) ((QUOTE T) (SEQ (SPADCALL |lscripts| |i| (PROGN (LETT #3# NIL |SYMBOL;scripts;$R;32|) (SEQ (LETT |a| NIL |SYMBOL;scripts;$R;32|) (LETT #4# (SPADCALL |allscripts| |n| (QREFELT |$| 118)) |SYMBOL;scripts;$R;32|) G190 (COND ((OR (ATOM #4#) (PROGN (LETT |a| (CAR #4#) |SYMBOL;scripts;$R;32|) NIL)) (GO G191))) (SEQ (EXIT (LETT #3# (CONS (SPADCALL |a| (QREFELT |$| 52)) #3#) |SYMBOL;scripts;$R;32|))) (LETT #4# (CDR #4#) |SYMBOL;scripts;$R;32|) (GO G190) G191 (EXIT (NREVERSE0 #3#)))) (QREFELT |$| 119)) (EXIT (LETT |allscripts| (SPADCALL |allscripts| |n| (QREFELT |$| 120)) |SYMBOL;scripts;$R;32|))))))) (LETT |i| (PROG1 (|+| |i| 1) (LETT #2# (CDR #2#) |SYMBOL;scripts;$R;32|)) |SYMBOL;scripts;$R;32|) (GO G190) G191 (EXIT NIL)) (EXIT (VECTOR (SPADCALL |lscripts| |m| (QREFELT |$| 121)) (SPADCALL |lscripts| (|+| |m| 1) (QREFELT |$| 121)) (SPADCALL |lscripts| (|+| |m| 2) (QREFELT |$| 121)) (SPADCALL |lscripts| (|+| |m| 3) (QREFELT |$| 121)) (SPADCALL |lscripts| (|+| |m| 4) (QREFELT |$| 121))))))))))) + +(DEFUN |SYMBOL;istring| (|n| |$|) (COND ((|<| 9 |n|) (|error| "Can have at most 9 scripts of each kind")) ((QUOTE T) (ELT (QREFELT |$| 16) (|+| |n| 0))))) + +(DEFUN |SYMBOL;list;$L;34| (|sy| |$|) (COND ((NULL (SPADCALL |sy| (QREFELT |$| 21))) (|error| "Cannot convert a symbol to a list if it is not subscripted")) ((QUOTE T) |sy|))) + +(DEFUN |SYMBOL;sample;$;35| (|$|) (SPADCALL "aSymbol" (QREFELT |$| 47))) + +(DEFUN |Symbol| NIL (PROG NIL (RETURN (PROG (#1=#:G108325) (RETURN (COND ((LETT #1# (HGET |$ConstructorCache| (QUOTE |Symbol|)) |Symbol|) (|CDRwithIncrement| (CDAR #1#))) ((QUOTE T) (|UNWIND-PROTECT| (PROG1 (CDDAR (HPUT |$ConstructorCache| (QUOTE |Symbol|) (LIST (CONS NIL (CONS 1 (|Symbol;|)))))) (LETT #1# T |Symbol|)) (COND ((NOT #1#) (HREM |$ConstructorCache| (QUOTE |Symbol|)))))))))))) + +(DEFUN |Symbol;| NIL (PROG (|dv$| |$| |pv$|) (RETURN (PROGN (LETT |dv$| (QUOTE (|Symbol|)) . #1=(|Symbol|)) (LETT |$| (GETREFV 124) . #1#) (QSETREFV |$| 0 |dv$|) (QSETREFV |$| 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #1#)) (|haddProp| |$ConstructorCache| (QUOTE |Symbol|) NIL (CONS 1 |$|)) (|stuffDomainSlots| |$|) (QSETREFV |$| 9 (SPADCALL 0 (QREFELT |$| 8))) (QSETREFV |$| 12 (SPADCALL (QREFELT |$| 11))) (QSETREFV |$| 16 (SPADCALL (LIST #2="0" "1" "2" "3" "4" "5" "6" "7" "8" "9") (QREFELT |$| 15))) (QSETREFV |$| 17 "0123456789") (QSETREFV |$| 18 "ABCDEFGHIJKLMNOPQRSTUVWXYZ") (QSETREFV |$| 19 "abcdefghijklmnopqrstuvwxyz") (QSETREFV |$| 37 "*") (QSETREFV |$| 38 (QCSIZE (QREFELT |$| 37))) (QSETREFV |$| 42 (SPADCALL (SPADCALL #2# (QREFELT |$| 40)) (QREFELT |$| 41))) |$|)))) + +(MAKEPROP (QUOTE |Symbol|) (QUOTE |infovec|) (LIST (QUOTE #(NIL NIL NIL NIL NIL NIL (|Integer|) (|Reference| 6) (0 . |ref|) (QUOTE |count|) (|AssociationList| |$$| 6) (5 . |empty|) (QUOTE |xcount|) (|List| 28) (|PrimitiveArray| 28) (9 . |construct|) (QUOTE |istrings|) (QUOTE |nums|) (QUOTE ALPHAS) (QUOTE |alphas|) (|Boolean|) |SYMBOL;scripted?;$B;30| (|Void|) (|Symbol|) (|OpenMathDevice|) (14 . |OMputVariable|) (|OpenMathEncoding|) (20 . |OMencodingXML|) (|String|) (24 . |OMopenString|) (30 . |OMputObject|) (35 . |OMputEndObject|) (40 . |OMclose|) |SYMBOL;OMwrite;$S;2| |SYMBOL;OMwrite;$BS;3| |SYMBOL;OMwrite;Omd$V;4| |SYMBOL;OMwrite;Omd$BV;5| (QUOTE |hd|) (QUOTE |lhd|) (|Character|) (45 . |char|) (50 . |ord|) (QUOTE |ord0|) (|InputForm|) (55 . |convert|) |SYMBOL;convert;$If;6| |SYMBOL;convert;2$;7| |SYMBOL;coerce;S$;8| |SYMBOL;=;2$B;9| |SYMBOL;<;2$B;10| (|OutputForm|) (60 . |outputForm|) |SYMBOL;coerce;$Of;11| (|List| 55) |SYMBOL;script;$L$;22| (|List| 50) |SYMBOL;subscript;$L$;12| |SYMBOL;elt;$L$;13| |SYMBOL;superscript;$L$;14| |SYMBOL;argscript;$L$;15| (|PatternMatchResult| 6 23) (|Pattern| 6) (|PatternMatchSymbol| 6) (65 . |patternMatch|) (|PatternMatchResult| 6 |$|) |SYMBOL;patternMatch;$P2Pmr;16| (|PatternMatchResult| (|Float|) 23) (|Pattern| (|Float|)) (|PatternMatchSymbol| (|Float|)) (72 . |patternMatch|) (|PatternMatchResult| (|Float|) |$|) |SYMBOL;patternMatch;$P2Pmr;17| (79 . |coerce|) |SYMBOL;convert;$P;18| (84 . |coerce|) |SYMBOL;convert;$P;19| (|List| |$|) (89 . |concat|) (94 . |concat|) (|Record| (|:| |sub| 55) (|:| |sup| 55) (|:| |presup| 55) (|:| |presub| 55) (|:| |args| 55)) |SYMBOL;script;$R$;23| |SYMBOL;name;2$;31| |SYMBOL;string;$S;24| (100 . |elt|) (106 . |=|) |SYMBOL;scripts;$R;32| (112 . |latex|) |SYMBOL;latex;$S;25| (117 . |minIndex|) (122 . |concat|) (128 . |elt|) (133 . |setelt|) |SYMBOL;new;$;27| (|Union| 6 (QUOTE "failed")) (139 . |search|) (145 . |setelt|) (152 . |maxIndex|) (157 . |position|) |SYMBOL;new;2$;28| (|List| |$$|) (163 . |keys|) (168 . |remove!|) (174 . |void|) |SYMBOL;resetNew;V;29| |SYMBOL;list;$L;34| (178 . |first|) (183 . |digit?|) (|UniversalSegment| 6) (188 . SEGMENT) (194 . |elt|) (|List| 112) (200 . |minIndex|) (|NonNegativeInteger|) (205 . |setelt|) (212 . |concat|) (218 . |rest|) (223 . |minIndex|) (228 . |#|) (233 . |first|) (239 . |setelt|) (246 . |rest|) (252 . |elt|) (CONS IDENTITY (FUNCALL (|dispatchFunction| |SYMBOL;sample;$;35|) |$|)) (|SingleInteger|))) (QUOTE #(|~=| 258 |superscript| 264 |subscript| 270 |string| 276 |scripts| 281 |scripted?| 286 |script| 291 |sample| 303 |resetNew| 307 |patternMatch| 311 |new| 325 |name| 334 |min| 339 |max| 345 |list| 351 |latex| 356 |hash| 361 |elt| 366 |convert| 372 |coerce| 392 |argscript| 402 |OMwrite| 408 |>=| 432 |>| 438 |=| 444 |<=| 450 |<| 456)) (QUOTE NIL) (CONS (|makeByteWordVec2| 1 (QUOTE (0 0 0 0 0 0 0 0 0 0 0))) (CONS (QUOTE #(|OrderedSet&| NIL NIL |SetCategory&| |BasicType&| NIL NIL NIL NIL NIL NIL)) (CONS (QUOTE #((|OrderedSet|) (|PatternMatchable| (|Float|)) (|PatternMatchable| 6) (|SetCategory|) (|BasicType|) (|ConvertibleTo| 67) (|ConvertibleTo| 61) (|ConvertibleTo| 23) (|OpenMath|) (|ConvertibleTo| 43) (|CoercibleTo| 50))) (|makeByteWordVec2| 123 (QUOTE (1 7 0 6 8 0 10 0 11 1 14 0 13 15 2 24 22 0 23 25 0 26 0 27 2 24 0 28 26 29 1 24 22 0 30 1 24 22 0 31 1 24 22 0 32 1 39 0 28 40 1 39 6 0 41 1 43 0 23 44 1 50 0 23 51 3 62 60 23 61 60 63 3 68 66 23 67 66 69 1 67 0 23 72 1 61 0 23 74 1 28 0 76 77 2 55 0 0 0 78 2 28 39 0 6 83 2 39 20 0 0 84 1 50 28 0 86 1 28 6 0 88 2 28 0 39 0 89 1 7 6 0 90 2 7 6 0 6 91 2 10 93 2 0 94 3 10 6 0 2 6 95 1 28 6 0 96 2 28 6 39 0 97 1 10 99 0 100 2 10 93 2 0 101 0 22 0 102 1 99 2 0 105 1 39 20 0 106 2 107 0 6 6 108 2 28 0 0 107 109 1 110 6 0 111 3 110 112 0 6 112 113 2 110 0 0 112 114 1 99 0 0 115 1 53 6 0 116 1 99 112 0 117 2 99 0 0 112 118 3 53 55 0 6 55 119 2 99 0 0 112 120 2 53 55 0 6 121 2 0 20 0 0 1 2 0 0 0 55 58 2 0 0 0 55 56 1 0 28 0 82 1 0 79 0 85 1 0 20 0 21 2 0 0 0 53 54 2 0 0 0 79 80 0 0 0 122 0 0 22 103 3 0 64 0 61 64 65 3 0 70 0 67 70 71 1 0 0 0 98 0 0 0 92 1 0 0 0 81 2 0 0 0 0 1 2 0 0 0 0 1 1 0 76 0 104 1 0 28 0 87 1 0 123 0 1 2 0 0 0 55 57 1 0 61 0 75 1 0 67 0 73 1 0 23 0 46 1 0 43 0 45 1 0 0 28 47 1 0 50 0 52 2 0 0 0 55 59 3 0 22 24 0 20 36 2 0 28 0 20 34 2 0 22 24 0 35 1 0 28 0 33 2 0 20 0 0 1 2 0 20 0 0 1 2 0 20 0 0 48 2 0 20 0 0 1 2 0 20 0 0 49)))))) (QUOTE |lookupComplete|))) + +(MAKEPROP (QUOTE |Symbol|) (QUOTE NILADIC) T) +@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \chapter{Chunk collections} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% <>= @@ -68878,6 +79113,8 @@ Note that this code is not included in the generated catdef.spad file. <> <> +<> +<> <> <> <> @@ -68894,6 +79131,7 @@ Note that this code is not included in the generated catdef.spad file. <> <> <> +<> <> <> <> @@ -68985,6 +79223,7 @@ Note that this code is not included in the generated catdef.spad file. <> <> <> +<> <> <> <> @@ -68993,6 +79232,7 @@ Note that this code is not included in the generated catdef.spad file. <> <> <> +<> <> <> <> @@ -69106,24 +79346,39 @@ Note that this code is not included in the generated catdef.spad file. <> <> +<> +<> +<> +<> +<> <> <> +<> <> <> <> <> <> <> +<> <> +<> +<> <> +<> <> <> <> +<> <> <> +<> +<> <> <> +<> <> +<> <> <> @@ -69131,6 +79386,7 @@ Note that this code is not included in the generated catdef.spad file. <> <> <> +<> <> <> @@ -69141,6 +79397,7 @@ Note that this code is not included in the generated catdef.spad file. <> <> <> +<> @ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% diff --git a/books/ps/v103character.ps b/books/ps/v103character.ps new file mode 100644 index 0000000..35fec09 --- /dev/null +++ b/books/ps/v103character.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 +% Character +[ /Rect [ 0 0 70 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=CHAR) >> + /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 +(Character) +[9.36 6.96 6.24 4.8 6.24 6.24 3.84 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/v103characterclass.ps b/books/ps/v103characterclass.ps new file mode 100644 index 0000000..309b021 --- /dev/null +++ b/books/ps/v103characterclass.ps @@ -0,0 +1,248 @@ +%!PS-Adobe-2.0 +%%Creator: dot version 2.8 (Thu Sep 14 20:34:11 UTC 2006) +%%For: (root) root +%%Title: pic +%%Pages: (atend) +%%BoundingBox: 36 36 146 80 +%%EndComments +save +%%BeginProlog +/DotDict 200 dict def +DotDict begin + +/setupLatin1 { +mark +/EncodingVector 256 array def + EncodingVector 0 + +ISOLatin1Encoding 0 255 getinterval putinterval +EncodingVector 45 /hyphen put + +% Set up ISO Latin 1 character encoding +/starnetISO { + dup dup findfont dup length dict begin + { 1 index /FID ne { def }{ pop pop } ifelse + } forall + /Encoding EncodingVector def + currentdict end definefont +} def +/Times-Roman starnetISO def +/Times-Italic starnetISO def +/Times-Bold starnetISO def +/Times-BoldItalic starnetISO def +/Helvetica starnetISO def +/Helvetica-Oblique starnetISO def +/Helvetica-Bold starnetISO def +/Helvetica-BoldOblique starnetISO def +/Courier starnetISO def +/Courier-Oblique starnetISO def +/Courier-Bold starnetISO def +/Courier-BoldOblique starnetISO def +cleartomark +} bind def + +%%BeginResource: procset graphviz 0 0 +/coord-font-family /Times-Roman def +/default-font-family /Times-Roman def +/coordfont coord-font-family findfont 8 scalefont def + +/InvScaleFactor 1.0 def +/set_scale { + dup 1 exch div /InvScaleFactor exch def + dup scale +} bind def + +% styles +/solid { [] 0 setdash } bind def +/dashed { [9 InvScaleFactor mul dup ] 0 setdash } bind def +/dotted { [1 InvScaleFactor mul 6 InvScaleFactor mul] 0 setdash } bind def +/invis {/fill {newpath} def /stroke {newpath} def /show {pop newpath} def} bind def +/bold { 2 setlinewidth } bind def +/filled { } bind def +/unfilled { } bind def +/rounded { } bind def +/diagonals { } bind def + +% hooks for setting color +/nodecolor { sethsbcolor } bind def +/edgecolor { sethsbcolor } bind def +/graphcolor { sethsbcolor } bind def +/nopcolor {pop pop pop} bind def + +/beginpage { % i j npages + /npages exch def + /j exch def + /i exch def + /str 10 string def + npages 1 gt { + gsave + coordfont setfont + 0 0 moveto + (\() show i str cvs show (,) show j str cvs show (\)) show + grestore + } if +} bind def + +/set_font { + findfont exch + scalefont setfont +} def + +% draw aligned label in bounding box aligned to current point +/alignedtext { % width adj text + /text exch def + /adj exch def + /width exch def + gsave + width 0 gt { + text stringwidth pop adj mul 0 rmoveto + } if + [] 0 setdash + text show + grestore +} def + +/boxprim { % xcorner ycorner xsize ysize + 4 2 roll + moveto + 2 copy + exch 0 rlineto + 0 exch rlineto + pop neg 0 rlineto + closepath +} bind def + +/ellipse_path { + /ry exch def + /rx exch def + /y exch def + /x exch def + matrix currentmatrix + newpath + x y translate + rx ry scale + 0 0 1 0 360 arc + setmatrix +} bind def + +/endpage { showpage } bind def +/showpage { } def + +/layercolorseq + [ % layer color sequence - darkest to lightest + [0 0 0] + [.2 .8 .8] + [.4 .8 .8] + [.6 .8 .8] + [.8 .8 .8] + ] +def + +/layerlen layercolorseq length def + +/setlayer {/maxlayer exch def /curlayer exch def + layercolorseq curlayer 1 sub layerlen mod get + aload pop sethsbcolor + /nodecolor {nopcolor} def + /edgecolor {nopcolor} def + /graphcolor {nopcolor} def +} bind def + +/onlayer { curlayer ne {invis} if } def + +/onlayers { + /myupper exch def + /mylower exch def + curlayer mylower lt + curlayer myupper gt + or + {invis} if +} def + +/curlayer 0 def + +%%EndResource +%%EndProlog +%%BeginSetup +14 default-font-family set_font +1 setmiterlimit +% /arrowlength 10 def +% /arrowwidth 5 def + +% make sure pdfmark is harmless for PS-interpreters other than Distiller +/pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse +% make '<<' and '>>' safe on PS Level 1 devices +/languagelevel where {pop languagelevel}{1} ifelse +2 lt { + userdict (<<) cvn ([) cvn load put + userdict (>>) cvn ([) cvn load put +} if + +%%EndSetup +%%Page: 1 1 +%%PageBoundingBox: 36 36 146 80 +%%PageOrientation: Portrait +gsave +36 36 110 44 boxprim clip newpath +36 36 translate +0 0 1 beginpage +1.0000 set_scale +4 4 translate 0 rotate +0.167 0.600 1.000 graphcolor +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +108 42 lineto +108 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +108 42 lineto +108 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% CharacterClass +[ /Rect [ 0 0 102 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=CCLASS) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 102 36 moveto +0 36 lineto +0 0 lineto +102 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 102 36 moveto +0 36 lineto +0 0 lineto +102 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +8 13 moveto +(CharacterClass) +[9.36 6.96 6.24 4.8 6.24 6.24 3.84 6.24 4.8 9.36 3.84 6.24 5.52 5.52] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103doublefloat.ps b/books/ps/v103doublefloat.ps new file mode 100644 index 0000000..a429635 --- /dev/null +++ b/books/ps/v103doublefloat.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 +% DoubleFloat +[ /Rect [ 0 0 86 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=DFLOAT) >> + /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 +(DoubleFloat) +[10.08 6.96 6.96 6.96 3.84 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/v103indexedstring.ps b/books/ps/v103indexedstring.ps new file mode 100644 index 0000000..e413671 --- /dev/null +++ b/books/ps/v103indexedstring.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 140 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 140 80 +%%PageOrientation: Portrait +gsave +36 36 104 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 +102 42 lineto +102 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +102 42 lineto +102 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% IndexedString +[ /Rect [ 0 0 96 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=ISTRING) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 96 36 moveto +0 36 lineto +0 0 lineto +96 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 96 36 moveto +0 36 lineto +0 0 lineto +96 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +8 13 moveto +(IndexedString) +[4.56 6.96 6.96 5.76 6.48 6.24 6.96 7.44 3.84 5.04 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/v103innersparseunivariatepowerseries.ps b/books/ps/v103innersparseunivariatepowerseries.ps new file mode 100644 index 0000000..62022ed --- /dev/null +++ b/books/ps/v103innersparseunivariatepowerseries.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 +% InnerSparseUnivariatePowerSeries +[ /Rect [ 0 0 212 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=ISUPS) >> + /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 +8 13 moveto +(InnerSparseUnivariatePowerSeries) +[4.56 6.96 6.96 6.24 4.8 7.68 6.96 6.24 4.8 5.52 6.24 9.6 6.96 3.84 6.72 6.24 5.04 3.84 6.24 3.84 6.24 7.44 6.48 9.6 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/v103segment.ps b/books/ps/v103segment.ps new file mode 100644 index 0000000..02a516e --- /dev/null +++ b/books/ps/v103segment.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 +% Segment +[ /Rect [ 0 0 64 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=SEG) >> + /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 +(Segment) +[7.68 6.24 6.96 10.8 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/v103segmentbinding.ps b/books/ps/v103segmentbinding.ps new file mode 100644 index 0000000..26b08e2 --- /dev/null +++ b/books/ps/v103segmentbinding.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 154 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 154 80 +%%PageOrientation: Portrait +gsave +36 36 118 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 +116 42 lineto +116 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +116 42 lineto +116 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% SegmentBinding +[ /Rect [ 0 0 110 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=SEGBIND) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 110 36 moveto +0 36 lineto +0 0 lineto +110 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 110 36 moveto +0 36 lineto +0 0 lineto +110 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +8 13 moveto +(SegmentBinding) +[7.68 6.24 6.96 10.8 6.24 6.96 3.84 9.36 3.84 6.96 6.96 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/v103set.ps b/books/ps/v103set.ps new file mode 100644 index 0000000..b7aded4 --- /dev/null +++ b/books/ps/v103set.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 +% Set +[ /Rect [ 0 0 54 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=SET) >> + /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 +18 13 moveto +(Set) +[7.68 6 3.84] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103sexpression.ps b/books/ps/v103sexpression.ps new file mode 100644 index 0000000..3830239 --- /dev/null +++ b/books/ps/v103sexpression.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 +% SExpression +[ /Rect [ 0 0 86 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=SEX) >> + /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 +(SExpression) +[7.68 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/v103sexpressionof.ps b/books/ps/v103sexpressionof.ps new file mode 100644 index 0000000..76f84c0 --- /dev/null +++ b/books/ps/v103sexpressionof.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 144 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 144 80 +%%PageOrientation: Portrait +gsave +36 36 108 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 +106 42 lineto +106 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +106 42 lineto +106 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% SExpressionOf +[ /Rect [ 0 0 100 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=SEXOF) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 100 36 moveto +0 36 lineto +0 0 lineto +100 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 100 36 moveto +0 36 lineto +0 0 lineto +100 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +7 13 moveto +(SExpressionOf) +[7.68 8.64 6.96 6.96 4.8 6.24 5.52 5.52 3.84 6.96 6.96 10.08 4.56] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103singleinteger.ps b/books/ps/v103singleinteger.ps new file mode 100644 index 0000000..eda2443 --- /dev/null +++ b/books/ps/v103singleinteger.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 +% SingleInteger +[ /Rect [ 0 0 92 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=SINT) >> + /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 +(SingleInteger) +[7.68 3.84 6.96 6.96 3.84 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/v103sparseunivariatelaurentseries.ps b/books/ps/v103sparseunivariatelaurentseries.ps new file mode 100644 index 0000000..b93d9bc --- /dev/null +++ b/books/ps/v103sparseunivariatelaurentseries.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 234 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 234 80 +%%PageOrientation: Portrait +gsave +36 36 198 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 +196 42 lineto +196 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +196 42 lineto +196 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% SparseUnivariateLaurentSeries +[ /Rect [ 0 0 190 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=SULS) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 190 36 moveto +0 36 lineto +0 0 lineto +190 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 190 36 moveto +0 36 lineto +0 0 lineto +190 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +7 13 moveto +(SparseUnivariateLaurentSeries) +[7.68 6.96 6.24 4.8 5.52 6.24 9.6 6.96 3.84 6.72 6.24 5.04 3.84 6.24 3.84 6.24 8.64 6.24 6.96 4.8 6.24 6.96 3.84 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/v103sparseunivariatepolynomialexpressions.ps b/books/ps/v103sparseunivariatepolynomialexpressions.ps new file mode 100644 index 0000000..44a49d6 --- /dev/null +++ b/books/ps/v103sparseunivariatepolynomialexpressions.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 288 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 288 80 +%%PageOrientation: Portrait +gsave +36 36 252 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 +250 42 lineto +250 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +250 42 lineto +250 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% SparseUnivariatePolynomialExpressions +[ /Rect [ 0 0 244 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=SUPEXPR) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 244 36 moveto +0 36 lineto +0 0 lineto +244 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 244 36 moveto +0 36 lineto +0 0 lineto +244 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +8 13 moveto +(SparseUnivariatePolynomialExpressions) +[7.68 6.96 6.24 4.8 5.52 6.24 9.6 6.96 3.84 6.72 6.24 5.04 3.84 6.24 3.84 6.24 7.44 6.96 3.6 6.96 6.96 6.96 10.8 3.84 6.24 3.84 8.64 6.96 6.96 4.8 6.24 5.52 5.52 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/v103sparseunivariatepuiseuxseries.ps b/books/ps/v103sparseunivariatepuiseuxseries.ps new file mode 100644 index 0000000..371915b --- /dev/null +++ b/books/ps/v103sparseunivariatepuiseuxseries.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 234 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 234 80 +%%PageOrientation: Portrait +gsave +36 36 198 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 +196 42 lineto +196 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +196 42 lineto +196 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% SparseUnivariatePuiseuxSeries +[ /Rect [ 0 0 190 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=SUPXS) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 190 36 moveto +0 36 lineto +0 0 lineto +190 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 190 36 moveto +0 36 lineto +0 0 lineto +190 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +7 13 moveto +(SparseUnivariatePuiseuxSeries) +[7.68 6.96 6.24 4.8 5.52 6.24 9.6 6.96 3.84 6.72 6.24 5.04 3.84 6.24 3.84 6.24 7.68 6.96 3.84 5.52 6.24 6.96 6.96 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/v103sparseunivariatetaylorseries.ps b/books/ps/v103sparseunivariatetaylorseries.ps new file mode 100644 index 0000000..2c24bfb --- /dev/null +++ b/books/ps/v103sparseunivariatetaylorseries.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 226 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 226 80 +%%PageOrientation: Portrait +gsave +36 36 190 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 +188 42 lineto +188 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +188 42 lineto +188 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% SparseUnivariateTaylorSeries +[ /Rect [ 0 0 182 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=SUTS) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 182 36 moveto +0 36 lineto +0 0 lineto +182 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 182 36 moveto +0 36 lineto +0 0 lineto +182 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +7 13 moveto +(SparseUnivariateTaylorSeries) +[7.68 6.96 6.24 4.8 5.52 6.24 9.6 6.96 3.84 6.72 6.24 5.04 3.84 6.24 3.84 6.24 7.68 5.76 6.48 3.84 6.96 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/v103squarefreeregulartriangularset.ps b/books/ps/v103squarefreeregulartriangularset.ps new file mode 100644 index 0000000..36121a3 --- /dev/null +++ b/books/ps/v103squarefreeregulartriangularset.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 244 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 244 80 +%%PageOrientation: Portrait +gsave +36 36 208 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 +206 42 lineto +206 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +206 42 lineto +206 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% SquareFreeRegularTriangularSet +[ /Rect [ 0 0 200 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=SREGSET) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 200 36 moveto +0 36 lineto +0 0 lineto +200 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 200 36 moveto +0 36 lineto +0 0 lineto +200 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +8 13 moveto +(SquareFreeRegularTriangularSet) +[7.68 6.72 6.96 6.24 4.8 6.24 7.44 4.8 6.24 6.24 9.12 6.24 6.96 6.96 3.84 6.24 4.8 7.92 5.04 3.84 6.24 6.96 6.96 6.96 3.84 6.24 4.8 7.68 6 3.84] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103stream.ps b/books/ps/v103stream.ps new file mode 100644 index 0000000..2e805d4 --- /dev/null +++ b/books/ps/v103stream.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 100 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 100 80 +%%PageOrientation: Portrait +gsave +36 36 64 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 +62 42 lineto +62 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +62 42 lineto +62 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% Stream +[ /Rect [ 0 0 56 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=STREAM) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 56 36 moveto +0 36 lineto +0 0 lineto +56 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 56 36 moveto +0 36 lineto +0 0 lineto +56 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +8 13 moveto +(Stream) +[7.44 3.84 4.8 6.24 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/v103string.ps b/books/ps/v103string.ps new file mode 100644 index 0000000..fd25408 --- /dev/null +++ b/books/ps/v103string.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 +% String +[ /Rect [ 0 0 54 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=STRING) >> + /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 +(String) +[7.44 3.84 5.04 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/v103suchthat.ps b/books/ps/v103suchthat.ps new file mode 100644 index 0000000..868dfdd --- /dev/null +++ b/books/ps/v103suchthat.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 +% SuchThat +[ /Rect [ 0 0 70 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=SUCH) >> + /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 +8 13 moveto +(SuchThat) +[7.68 6.96 6 6.96 8.64 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/v103symbol.ps b/books/ps/v103symbol.ps new file mode 100644 index 0000000..f00ac06 --- /dev/null +++ b/books/ps/v103symbol.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 104 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 104 80 +%%PageOrientation: Portrait +gsave +36 36 68 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 +66 42 lineto +66 -6 lineto +closepath +fill +0.167 0.600 1.000 graphcolor +newpath -6 -6 moveto +-6 42 lineto +66 42 lineto +66 -6 lineto +closepath +stroke +0.000 0.000 0.000 graphcolor +14.00 /Times-Roman set_font +% Symbol +[ /Rect [ 0 0 60 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=SYMBOL) >> + /Subtype /Link +/ANN pdfmark +gsave 10 dict begin +filled +0.537 0.247 0.902 nodecolor +0.537 0.247 0.902 nodecolor +newpath 60 36 moveto +0 36 lineto +0 0 lineto +60 0 lineto +closepath +fill +0.537 0.247 0.902 nodecolor +newpath 60 36 moveto +0 36 lineto +0 0 lineto +60 0 lineto +closepath +stroke +gsave 10 dict begin +0.000 0.000 0.000 nodecolor +8 13 moveto +(Symbol) +[7.68 6.96 10.8 6.96 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/v103taylorsolve.ps b/books/ps/v103taylorsolve.ps new file mode 100644 index 0000000..af6f8ac --- /dev/null +++ b/books/ps/v103taylorsolve.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 +% TaylorSolve +[ /Rect [ 0 0 82 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=UTSSOL) >> + /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 +(TaylorSolve) +[7.68 5.76 6.48 3.84 6.96 4.8 7.68 6.96 3.36 6.48 6.24] +xshow +end grestore +end grestore +endpage +showpage +grestore +%%PageTrailer +%%EndPage: 1 +%%Trailer +%%Pages: 1 +end +restore +%%EOF diff --git a/books/ps/v103threespace.ps b/books/ps/v103threespace.ps new file mode 100644 index 0000000..2b720ed --- /dev/null +++ b/books/ps/v103threespace.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 +% ThreeSpace +[ /Rect [ 0 0 82 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=SPACE3) >> + /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 +(ThreeSpace) +[8.64 6.96 4.8 6.24 6.24 7.68 6.96 6.24 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/v103universalsegment.ps b/books/ps/v103universalsegment.ps new file mode 100644 index 0000000..6bceb60 --- /dev/null +++ b/books/ps/v103universalsegment.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 +% UniversalSegment +[ /Rect [ 0 0 120 36 ] + /Border [ 0 0 0 ] + /Action << /Subtype /URI /URI (bookvol10.3.pdf#nameddest=UNISEG) >> + /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 +(UniversalSegment) +[9.6 6.96 3.84 6.48 6.24 4.8 5.52 6.24 3.84 7.68 6.24 6.96 10.8 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/changelog b/changelog index 8d394a3..51fe338 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,57 @@ +20081215 tpd src/axiom-website/patches.html 20081215.02.tpd.patch +20081215 tpd books/ps/v103universalsegment.ps added +20081215 tpd books/ps/v103threespace.ps added +20081215 tpd books/ps/v103taylorsolve.ps added +20081215 tpd books/ps/v103symbol.ps added +20081215 tpd books/ps/v103suchthat.ps added +20081215 tpd books/ps/v103string.ps added +20081215 tpd books/ps/v103stream.ps added +20081215 tpd books/ps/v103squarefreeregulartriangularset.ps added +20081215 tpd books/ps/v103sparseunivariatetaylorseries.ps added +20081215 tpd books/ps/v103sparseunivariatepuiseuxseries.ps added +20081215 tpd books/ps/v103sparseunivariatepolynomialexpressions.ps added +20081215 tpd books/ps/v103sparseunivariatelaurentseries.ps added +20081215 tpd books/ps/v103singleinteger.ps added +20081215 tpd books/ps/v103sexpressionof.ps added +20081215 tpd books/ps/v103sexpression.ps added +20081215 tpd books/ps/v103set.ps added +20081215 tpd books/ps/v103segmentbinding.ps added +20081215 tpd books/ps/v103segment.ps added +20081215 tpd books/ps/v103innersparseunivariatepowerseries.ps added +20081215 tpd books/ps/v103indexedstring.ps added +20081215 tpd books/ps/v103doublefloat.ps added +20081215 tpd books/ps/v103characterclass.ps added +20081215 tpd books/ps/v103character.ps added +20081215 tpd src/algebra/Makefile remove symbol.spad +20081215 tpd src/algebra/symbol.spad removed, move domain to bookvol10.3 +20081215 tpd src/algebra/Makefile remove suts.spad +20081215 tpd src/algebra/suts.spad removed, move domain to bookvol10.3 +20081215 tpd src/algebra/Makefile remove supxs.spad +20081215 tpd src/algebra/supxs.spad removed, move domain to bookvol10.3 +20081215 tpd src/algebra/Makefile remove sups.spad +20081215 tpd src/algebra/sups.spad removed, move domain to bookvol10.3 +20081215 tpd src/algebra/Makefile remove suls.spad +20081215 tpd src/algebra/suls.spad removed, move domain to bookvol10.3 +20081215 tpd src/algebra/Makefile remove suchthat.spad +20081215 tpd src/algebra/suchthat.spad removed, move domain to bookvol10.3 +20081215 tpd src/algebra/string.spad removed, move domains to bookvol10.3 +20081215 tpd src/algebra/stream.spad move domain to bookvol10.3 +20081215 tpd src/algebra/ssolve.spad move domain to bookvol10.3 +20081215 tpd src/algebra/Makefile fixup help +20081215 tpd src/algebra/sregset.spad move domain to bookvol10.3 +20081215 tpd src/algebra/space.spad move domain to bookvol10.3 +20081215 tpd src/algebra/Makefile remove si.spad +20081215 tpd src/algebra/si.spad removed, moved domain to bookvol10.3 +20081215 tpd src/algebra/Makefile remove sf.spad +20081215 tpd src/algebra/sf.spad removed, moved domain to bookvol10.3 +20081215 tpd src/algebra/Makefile remove sex.spad +20081215 tpd src/algebra/sex.spad removed, moved domain to bookvol10.3 +20081215 tpd src/algebra/Makefile remove sets.spad +20081215 tpd src/algebra/sets.spad removed, moved domain to bookvol10.3 +20081215 tpd src/algebra/Makefile add SegmentBinding.help, fixup helps +20081215 tpd src/algebra/seg.spad move domains to bookvol10.3 +20081215 tpd src/axiom-website/patches.html 20081215.01.tpd.patch +20081215 tpd src/axiom-website/download.html add vector linux 20081214 tpd src/axiom-website/patches.html 20081214.01.tpd.patch 20081214 tpd books/bookvol10.3.pamphlet add domains 20081214 tpd books/ps/v103ruleset.ps added diff --git a/src/algebra/Makefile.pamphlet b/src/algebra/Makefile.pamphlet index d29b0de..5cb177f 100644 --- a/src/algebra/Makefile.pamphlet +++ b/src/algebra/Makefile.pamphlet @@ -84,9 +84,6 @@ stanzas before continuing upward. \section{The Algebra Lattice Layers} \subsection{Layer 0 Bootstrap} \subsubsection{Completed spad files} -\begin{verbatim} -si.spad.pamphlet (INS SINT) -\end{verbatim} Note well that none of the algebra stanzas should include these files in the preconditions otherwise we have an infinite compile loop. These files are originally bootstrapped from lisp code @@ -236,7 +233,6 @@ LAYER3=\ \subsubsection{Completed spad files} \begin{verbatim} paramete.spad.pamphlet (PARPCURV PARPC2 PARSCURV PARSC2 PARSURF PARSU2 -suchthat.spad.pamphlet (SUCH) ystream.spad.pamphlet (YSTREAM) \end{verbatim} @@ -339,7 +335,6 @@ LAYER8=\ \begin{verbatim} degred.spad.pamphlet (DEGRED) retract.spad.pamphlet (RETRACT FRETRCT RATRET) -sf.spad.pamphlet (REAL RADCAT RNS FPS DFLOAT) \end{verbatim} <>= @@ -471,7 +466,6 @@ numquad.spad.pamphlet (NUMQUAD) perman.spad.pamphlet (GRAY PERMAN) pseudolin.spad.pamphlet (PSEUDLIN) rep2.spad.pamphlet (REP2) -sex.spad.pamphlet (SEXCAT SEXOF SEX) solvedio.spad.pamphlet (DIOSP) \end{verbatim} @@ -682,7 +676,6 @@ padiclib.spad.pamphlet (IBPTOOLS IBACHIN PWFFINTB) permgrps.spad.pamphlet (PERMGRP PGE) random.spad.pamphlet (RANDSRC RDIST INTBIT RIDIST RFDIST) sgcf.spad.pamphlet (SGCF) -string.spad.pamphlet (CHAR CCLASS ISTRING STRING STRICAT) view3d.spad.pamphlet (VIEW3D) \end{verbatim} @@ -759,8 +752,6 @@ rep1.spad.pamphlet (REP1) s.spad.pamphlet (NAGS) seg.spad.pamphlet (SEGCAT SEGXCAT SEG SEG2 SEGBIND SETBIND2 UNISEG UNISEG2 INCRMAPS) -sets.spad.pamphlet (SET) -sups.spad.pamphlet (ISUPS) syssolp.spad.pamphlet (SYSSOLP) variable.spad.pamphlet (OVAR VARIABLE RULECOLD FUNCTION ANON) \end{verbatim} @@ -857,7 +848,6 @@ riccati.spad.pamphlet (ODEPRRIC ODERTRIC) rule.spad.pamphlet (RULE APPRULE RULESET) sign.spad.pamphlet (TOOLSIGN INPSIGN SIGNRF LIMITRF) special.spad.pamphlet (DFSFUN ORTHPOL NTPOLFN) -suts.spad.pamphlet (SUTS) tools.spad.pamphlet (ESTOOLS ESTOOLS1 ESTOOLS2) triset.spad.pamphlet (TSETCAT GTSET PSETPK) tube.spad.pamphlet (TUBE TUBETOOL EXPRTUBE NUMTUBE) @@ -929,8 +919,6 @@ oderf.spad.pamphlet (BALFACT BOUNDZRO ODEPRIM UTSODETL ODERAT ODETOOLS ODEINT puiseux.spad.pamphlet (UPXSCCA UPXSCONS UPXS UPXS2) radeigen.spad.pamphlet (REP) solverad.spad.pamphlet (SOLVERAD) -suls.spad.pamphlet (SULS) -supxs.spad.pamphlet (SUPXS) taylor.spad.pamphlet (ITAYLOR UTS UTS2) \end{verbatim} @@ -1204,16 +1192,15 @@ SPADFILES= \ ${OUTSRC}/rep2.spad ${OUTSRC}/retract.spad \ ${OUTSRC}/rf.spad ${OUTSRC}/riccati.spad ${OUTSRC}/rinterp.spad \ ${OUTSRC}/rule.spad \ - ${OUTSRC}/seg.spad ${OUTSRC}/setorder.spad ${OUTSRC}/sets.spad \ - ${OUTSRC}/sex.spad ${OUTSRC}/sf.spad ${OUTSRC}/sgcf.spad \ - ${OUTSRC}/sign.spad ${OUTSRC}/si.spad ${OUTSRC}/smith.spad \ + ${OUTSRC}/seg.spad ${OUTSRC}/setorder.spad \ + ${OUTSRC}/sgcf.spad \ + ${OUTSRC}/sign.spad ${OUTSRC}/smith.spad \ ${OUTSRC}/solvedio.spad ${OUTSRC}/solvefor.spad ${OUTSRC}/solvelin.spad \ ${OUTSRC}/solverad.spad ${OUTSRC}/sortpak.spad ${OUTSRC}/space.spad \ ${OUTSRC}/special.spad ${OUTSRC}/sregset.spad ${OUTSRC}/s.spad \ - ${OUTSRC}/stream.spad ${OUTSRC}/string.spad ${OUTSRC}/sttaylor.spad \ - ${OUTSRC}/sttf.spad ${OUTSRC}/sturm.spad ${OUTSRC}/suchthat.spad \ - ${OUTSRC}/suls.spad ${OUTSRC}/sum.spad ${OUTSRC}/sups.spad \ - ${OUTSRC}/supxs.spad ${OUTSRC}/suts.spad ${OUTSRC}/symbol.spad \ + ${OUTSRC}/stream.spad ${OUTSRC}/sttaylor.spad \ + ${OUTSRC}/sttf.spad ${OUTSRC}/sturm.spad \ + ${OUTSRC}/sum.spad \ ${OUTSRC}/syssolp.spad ${OUTSRC}/system.spad \ ${OUTSRC}/tableau.spad ${OUTSRC}/table.spad ${OUTSRC}/taylor.spad \ ${OUTSRC}/tex.spad ${OUTSRC}/tools.spad ${OUTSRC}/transsolve.spad \ @@ -1357,16 +1344,15 @@ DOCFILES= \ ${DOC}/rep2.spad.dvi ${DOC}/retract.spad.dvi \ ${DOC}/rf.spad.dvi ${DOC}/riccati.spad.dvi ${DOC}/rinterp.spad.dvi \ ${DOC}/rule.spad.dvi \ - ${DOC}/seg.spad.dvi ${DOC}/setorder.spad.dvi ${DOC}/sets.spad.dvi \ - ${DOC}/sex.spad.dvi ${DOC}/sf.spad.dvi ${DOC}/sgcf.spad.dvi \ - ${DOC}/sign.spad.dvi ${DOC}/si.spad.dvi ${DOC}/smith.spad.dvi \ + ${DOC}/seg.spad.dvi ${DOC}/setorder.spad.dvi \ + ${DOC}/sgcf.spad.dvi \ + ${DOC}/sign.spad.dvi ${DOC}/smith.spad.dvi \ ${DOC}/solvedio.spad.dvi ${DOC}/solvefor.spad.dvi ${DOC}/solvelin.spad.dvi \ ${DOC}/solverad.spad.dvi ${DOC}/sortpak.spad.dvi ${DOC}/space.spad.dvi \ ${DOC}/special.spad.dvi ${DOC}/sregset.spad.dvi ${DOC}/s.spad.dvi \ - ${DOC}/stream.spad.dvi ${DOC}/string.spad.dvi ${DOC}/sttaylor.spad.dvi \ - ${DOC}/sttf.spad.dvi ${DOC}/sturm.spad.dvi ${DOC}/suchthat.spad.dvi \ - ${DOC}/suls.spad.dvi ${DOC}/sum.spad.dvi ${DOC}/sups.spad.dvi \ - ${DOC}/supxs.spad.dvi ${DOC}/suts.spad.dvi ${DOC}/symbol.spad.dvi \ + ${DOC}/stream.spad.dvi ${DOC}/sttaylor.spad.dvi \ + ${DOC}/sttf.spad.dvi ${DOC}/sturm.spad.dvi \ + ${DOC}/sum.spad.dvi \ ${DOC}/syssolp.spad.dvi ${DOC}/system.spad.dvi \ ${DOC}/tableau.spad.dvi ${DOC}/table.spad.dvi ${DOC}/taylor.spad.dvi \ ${DOC}/tex.spad.dvi ${DOC}/tools.spad.dvi ${DOC}/transsolve.spad.dvi \ @@ -2022,6 +2008,7 @@ SPADHELP=\ ${HELP}/RadixExpansion.help ${HELP}/RealClosure.help \ ${HELP}/RealSolvePackage.help ${HELP}/RegularTriangularSet.help \ ${HELP}/RomanNumeral.help ${HELP}/Segment.help \ + ${HELP}/SegmentBinding.help \ ${HELP}/Set.help ${HELP}/SingleInteger.help \ ${HELP}/SparseTable.help ${HELP}/SquareMatrix.help \ ${HELP}/SquareFreeRegularTriangularSet.help \ @@ -2183,20 +2170,21 @@ ${HELP}/CartesianTensor.help: ${BOOKS}/bookvol10.3.pamphlet @${TANGLE} -R"CartesianTensor.input" ${BOOKS}/bookvol10.3.pamphlet \ >${INPUT}/CartesianTensor.input -${HELP}/Character.help: ${IN}/string.spad.pamphlet - @echo 7007 create Character.help from ${IN}/string.spad.pamphlet - @${TANGLE} -R"Character.help" ${IN}/string.spad.pamphlet \ +${HELP}/Character.help: ${BOOKS}/bookvol10.3.pamphlet + @echo 7007 create Character.help from ${BOOKS}/bookvol10.3.pamphlet + @${TANGLE} -R"Character.help" ${BOOKS}/bookvol10.3.pamphlet \ >${HELP}/Character.help @cp ${HELP}/Character.help ${HELP}/CHAR.help - @${TANGLE} -R"Character.input" ${IN}/string.spad.pamphlet \ + @${TANGLE} -R"Character.input" ${BOOKS}/bookvol10.3.pamphlet \ >${INPUT}/Character.input -${HELP}/CharacterClass.help: ${IN}/string.spad.pamphlet - @echo 7008 create CharacterClass.help from ${IN}/string.spad.pamphlet - @${TANGLE} -R"CharacterClass.help" ${IN}/string.spad.pamphlet \ +${HELP}/CharacterClass.help: ${BOOKS}/bookvol10.3.pamphlet + @echo 7008 create CharacterClass.help from \ + ${BOOKS}/bookvol10.3.pamphlet + @${TANGLE} -R"CharacterClass.help" ${BOOKS}/bookvol10.3.pamphlet \ >${HELP}/CharacterClass.help @cp ${HELP}/CharacterClass.help ${HELP}/CCLASS.help - @${TANGLE} -R"CharacterClass.input" ${IN}/string.spad.pamphlet \ + @${TANGLE} -R"CharacterClass.input" ${BOOKS}/bookvol10.3.pamphlet \ >${INPUT}/CharacterClass.input ${HELP}/CliffordAlgebra.help: ${BOOKS}/bookvol10.3.pamphlet @@ -2263,12 +2251,12 @@ ${HELP}/DistributedMultivariatePolynomial.help: \ ${BOOKS}/bookvol10.3.pamphlet \ >${INPUT}/DistributedMultivariatePolynomial.input -${HELP}/DoubleFloat.help: ${IN}/sf.spad.pamphlet - @echo 7016 create DoubleFloat.help from ${IN}/sf.spad.pamphlet - @${TANGLE} -R"DoubleFloat.help" ${IN}/sf.spad.pamphlet \ +${HELP}/DoubleFloat.help: ${BOOKS}/bookvol10.3.pamphlet + @echo 7016 create DoubleFloat.help from ${BOOKS}/bookvol10.3.pamphlet + @${TANGLE} -R"DoubleFloat.help" ${BOOKS}/bookvol10.3.pamphlet \ >${HELP}/DoubleFloat.help @cp ${HELP}/DoubleFloat.help ${HELP}/DFLOAT.help - @${TANGLE} -R"DoubleFloat.input" ${IN}/sf.spad.pamphlet \ + @${TANGLE} -R"DoubleFloat.input" ${BOOKS}/bookvol10.3.pamphlet \ >${INPUT}/DoubleFloat.input ${HELP}/EqTable.help: ${IN}/table.spad.pamphlet @@ -2783,28 +2771,37 @@ ${HELP}/RomanNumeral.help: ${BOOKS}/bookvol10.3.pamphlet @${TANGLE} -R"RomanNumeral.input" ${BOOKS}/bookvol10.3.pamphlet \ >${INPUT}/RomanNumeral.input -${HELP}/Segment.help: ${IN}/seg.spad.pamphlet - @echo 7072 create Segment.help from ${IN}/seg.spad.pamphlet - @${TANGLE} -R"Segment.help" ${IN}/seg.spad.pamphlet \ +${HELP}/Segment.help: ${BOOKS}/bookvol10.3.pamphlet + @echo 7072 create Segment.help from ${BOOKS}/bookvol10.3.pamphlet + @${TANGLE} -R"Segment.help" ${BOOKS}/bookvol10.3.pamphlet \ >${HELP}/Segment.help @cp ${HELP}/Segment.help ${HELP}/SEG.help - @${TANGLE} -R"Segment.input" ${IN}/seg.spad.pamphlet \ + @${TANGLE} -R"Segment.input" ${BOOKS}/bookvol10.3.pamphlet \ >${INPUT}/Segment.input -${HELP}/Set.help: ${IN}/sets.spad.pamphlet - @echo 7073 create Set.help from ${IN}/sets.spad.pamphlet - @${TANGLE} -R"Set.help" ${IN}/sets.spad.pamphlet \ +${HELP}/SegmentBinding.help: ${BOOKS}/bookvol10.3.pamphlet + @echo 7072 create SegmentBinding.help from \ + ${BOOKS}/bookvol10.3.pamphlet + @${TANGLE} -R"SegmentBinding.help" ${BOOKS}/bookvol10.3.pamphlet \ + >${HELP}/SegmentBinding.help + @cp ${HELP}/SegmentBinding.help ${HELP}/SEG.help + @${TANGLE} -R"SegmentBinding.input" ${BOOKS}/bookvol10.3.pamphlet \ + >${INPUT}/SegmentBinding.input + +${HELP}/Set.help: ${BOOKS}/bookvol10.3.pamphlet + @echo 7073 create Set.help from ${BOOKS}/bookvol10.3.pamphlet + @${TANGLE} -R"Set.help" ${BOOKS}/bookvol10.3.pamphlet \ >${HELP}/Set.help @-cp ${HELP}/Set.help ${HELP}/SET.help - @${TANGLE} -R"Set.input" ${IN}/sets.spad.pamphlet \ + @${TANGLE} -R"Set.input" ${BOOKS}/bookvol10.3.pamphlet \ >${INPUT}/Set.input -${HELP}/SingleInteger.help: ${IN}/si.spad.pamphlet - @echo 7074 create SingleInteger.help from ${IN}/si.spad.pamphlet - @${TANGLE} -R"SingleInteger.help" ${IN}/si.spad.pamphlet \ +${HELP}/SingleInteger.help: ${BOOKS}/bookvol10.3.pamphlet + @echo 7074 create SingleInteger.help from ${BOOKS}/bookvol10.3.pamphlet + @${TANGLE} -R"SingleInteger.help" ${BOOKS}/bookvol10.3.pamphlet \ >${HELP}/SingleInteger.help @cp ${HELP}/SingleInteger.help ${HELP}/SINT.help - @${TANGLE} -R"SingleInteger.input" ${IN}/si.spad.pamphlet \ + @${TANGLE} -R"SingleInteger.input" ${BOOKS}/bookvol10.3.pamphlet \ >${INPUT}/SingleInteger.input ${HELP}/SparseTable.help: ${IN}/table.spad.pamphlet @@ -2823,31 +2820,31 @@ ${HELP}/SquareMatrix.help: ${BOOKS}/bookvol10.3.pamphlet @${TANGLE} -R"SquareMatrix.input" ${BOOKS}/bookvol10.3.pamphlet \ >${INPUT}/SquareMatrix.input -${HELP}/SquareFreeRegularTriangularSet.help: ${IN}/sregset.spad.pamphlet +${HELP}/SquareFreeRegularTriangularSet.help: ${BOOKS}/bookvol10.3.pamphlet @echo 7077 create SquareFreeRegularTriangularSet.help from \ - ${IN}/sregset.spad.pamphlet + ${BOOKS}/bookvol10.3.pamphlet @${TANGLE} -R"SquareFreeRegularTriangularSet.help" \ - ${IN}/sregset.spad.pamphlet \ + ${BOOKS}/bookvol10.3.pamphlet \ >${HELP}/SquareFreeRegularTriangularSet.help @cp ${HELP}/SquareFreeRegularTriangularSet.help ${HELP}/SREGSET.help @${TANGLE} -R"SquareFreeRegularTriangularSet.input" \ - ${IN}/sregset.spad.pamphlet \ + ${BOOKS}/bookvol10.3.pamphlet \ >${INPUT}/SquareFreeRegularTriangularSet.input -${HELP}/Stream.help: ${IN}/stream.spad.pamphlet - @echo 7078 create Stream.help from ${IN}/stream.spad.pamphlet - @${TANGLE} -R"Stream.help" ${IN}/stream.spad.pamphlet \ +${HELP}/Stream.help: ${BOOKS}/bookvol10.3.pamphlet + @echo 7078 create Stream.help from ${BOOKS}/bookvol10.3.pamphlet + @${TANGLE} -R"Stream.help" ${BOOKS}/bookvol10.3.pamphlet \ >${HELP}/Stream.help @-cp ${HELP}/Stream.help ${HELP}/STREAM.help - @${TANGLE} -R"Stream.input" ${IN}/stream.spad.pamphlet \ + @${TANGLE} -R"Stream.input" ${BOOKS}/bookvol10.3.pamphlet \ >${INPUT}/Stream.input -${HELP}/String.help: ${IN}/string.spad.pamphlet - @echo 7079 create String.help from ${IN}/string.spad.pamphlet - @${TANGLE} -R"String.help" ${IN}/string.spad.pamphlet \ +${HELP}/String.help: ${BOOKS}/bookvol10.3.pamphlet + @echo 7079 create String.help from ${BOOKS}/bookvol10.3.pamphlet + @${TANGLE} -R"String.help" ${BOOKS}/bookvol10.3.pamphlet \ >${HELP}/String.help @-cp ${HELP}/String.help ${HELP}/STRING.help - @${TANGLE} -R"String.input" ${IN}/string.spad.pamphlet \ + @${TANGLE} -R"String.input" ${BOOKS}/bookvol10.3.pamphlet \ >${INPUT}/String.input ${HELP}/StringTable.help: ${IN}/table.spad.pamphlet @@ -2858,12 +2855,12 @@ ${HELP}/StringTable.help: ${IN}/table.spad.pamphlet @${TANGLE} -R"StringTable.input" ${IN}/table.spad.pamphlet \ >${INPUT}/StringTable.input -${HELP}/Symbol.help: ${IN}/symbol.spad.pamphlet - @echo 7081 create Symbol.help from ${IN}/symbol.spad.pamphlet - @${TANGLE} -R"Symbol.help" ${IN}/symbol.spad.pamphlet \ +${HELP}/Symbol.help: ${BOOKS}/bookvol10.3.pamphlet + @echo 7081 create Symbol.help from ${BOOKS}/bookvol10.3.pamphlet + @${TANGLE} -R"Symbol.help" ${BOOKS}/bookvol10.3.pamphlet \ >${HELP}/Symbol.help @-cp ${HELP}/Symbol.help ${HELP}/SYMBOL.help - @${TANGLE} -R"Symbol.input" ${IN}/symbol.spad.pamphlet \ + @${TANGLE} -R"Symbol.input" ${BOOKS}/bookvol10.3.pamphlet \ >${INPUT}/Symbol.input ${HELP}/Table.help: ${IN}/table.spad.pamphlet @@ -2912,12 +2909,13 @@ ${HELP}/UnivariatePolynomial.help: ${BOOKS}/bookvol10.3.pamphlet ${BOOKS}/bookvol10.3.pamphlet \ >${INPUT}/UnivariatePolynomial.input -${HELP}/UniversalSegment.help: ${IN}/seg.spad.pamphlet - @echo 7087 create UniversalSegment.help from ${IN}/seg.spad.pamphlet - @${TANGLE} -R"UniversalSegment.help" ${IN}/seg.spad.pamphlet \ +${HELP}/UniversalSegment.help: ${BOOKS}/bookvol10.3.pamphlet + @echo 7087 create UniversalSegment.help from \ + ${BOOKS}/bookvol10.3.pamphlet + @${TANGLE} -R"UniversalSegment.help" ${BOOKS}/bookvol10.3.pamphlet \ >${HELP}/UniversalSegment.help @cp ${HELP}/UniversalSegment.help ${HELP}/UNISEG.help - @${TANGLE} -R"UniversalSegment.input" ${IN}/seg.spad.pamphlet \ + @${TANGLE} -R"UniversalSegment.input" ${BOOKS}/bookvol10.3.pamphlet \ >${INPUT}/UniversalSegment.input ${HELP}/Vector.help: ${IN}/vector.spad.pamphlet diff --git a/src/algebra/seg.spad.pamphlet b/src/algebra/seg.spad.pamphlet index a56e519..ddbbd7a 100644 --- a/src/algebra/seg.spad.pamphlet +++ b/src/algebra/seg.spad.pamphlet @@ -9,254 +9,6 @@ \eject \tableofcontents \eject -\section{domain SEG Segment} -<>= --- seg.spad.pamphlet Segment.input -)spool Segment.output -)set message test on -)set message auto off -)clear all ---S 1 of 10 -s := 3..10 ---R ---R ---R (1) 3..10 ---R Type: Segment PositiveInteger ---E 1 - ---S 2 of 10 -lo s ---R ---R ---R (2) 3 ---R Type: PositiveInteger ---E 2 - ---S 3 of 10 -hi s ---R ---R ---R (3) 10 ---R Type: PositiveInteger ---E 3 - ---S 4 of 10 -t := 10..3 by -2 ---R ---R ---R (4) 10..3 by - 2 ---R Type: Segment PositiveInteger ---E 4 - ---S 5 of 10 -incr s ---R ---R ---R (5) 1 ---R Type: PositiveInteger ---E 5 - ---S 6 of 10 -incr t ---R ---R ---R (6) - 2 ---R Type: Integer ---E 6 - ---S 7 of 10 -l := [1..3, 5, 9, 15..11 by -1] ---R ---R ---R (7) [1..3,5..5,9..9,15..11 by - 1] ---R Type: List Segment PositiveInteger ---E 7 - ---S 8 of 10 -expand s ---R ---R ---R (8) [3,4,5,6,7,8,9,10] ---R Type: List Integer ---E 8 - ---S 9 of 10 -expand t ---R ---R ---R (9) [10,8,6,4] ---R Type: List Integer ---E 9 - ---S 10 of 10 -expand l ---R ---R ---R (10) [1,2,3,5,9,15,14,13,12,11] ---R Type: List Integer ---E 10 -)spool -)lisp (bye) -@ -<>= -==================================================================== -Segment examples -==================================================================== - -The Segment domain provides a generalized interval type. - -Segments are created using the .. construct by indicating the -(included) end points. - - s := 3..10 - 3..10 - Type: Segment PositiveInteger - -The first end point is called the lo and the second is called hi. - - lo s - 3 - Type: PositiveInteger - -These names are used even though the end points might belong to an -unordered set. - - hi s - 10 - Type: PositiveInteger - -In addition to the end points, each segment has an integer "increment". -An increment can be specified using the "by" construct. - - t := 10..3 by -2 - 10..3 by - 2 - Type: Segment PositiveInteger - -This part can be obtained using the incr function. - - incr s - 1 - Type: PositiveInteger - -Unless otherwise specified, the increment is 1. - - incr t - - 2 - Type: Integer - -A single value can be converted to a segment with equal end points. -This happens if segments and single values are mixed in a list. - - l := [1..3, 5, 9, 15..11 by -1] - [1..3,5..5,9..9,15..11 by - 1] - Type: List Segment PositiveInteger - -If the underlying type is an ordered ring, it is possible to perform -additional operations. The expand operation creates a list of points -in a segment. - - expand s - [3,4,5,6,7,8,9,10] - Type: List Integer - -If k > 0, then expand(l..h by k) creates the list [l, l+k, ..., lN] -where lN <= h < lN+k. If k < 0, then lN >= h > lN+k. - - expand t - [10,8,6,4] - Type: List Integer - -It is also possible to expand a list of segments. This is equivalent -to appending lists obtained by expanding each segment individually. - - expand l - [1,2,3,5,9,15,14,13,12,11] - Type: List Integer - -See Also: -o )help UniversalSegment -o )help SegmentBinding -o )show Segment -o $AXIOM/doc/src/algebra/seg.spad.dvi - -@ -<>= -)abbrev domain SEG Segment -++ Author: Stephen M. Watt -++ Date Created: December 1986 -++ Date Last Updated: June 3, 1991 -++ Basic Operations: -++ Related Domains: -++ Also See: -++ AMS Classifications: -++ Keywords: range, segment -++ Examples: -++ References: -++ Description: -++ This type is used to specify a range of values from type \spad{S}. - -Segment(S:Type): SegmentCategory(S) with - if S has SetCategory then SetCategory - if S has OrderedRing then SegmentExpansionCategory(S, List S) - == add - - Rep := Record(low: S, high: S, incr: Integer) - - a..b == [a,b,1] - lo s == s.low - low s == s.low - hi s == s.high - high s == s.high - incr s == s.incr - segment(a,b) == [a,b,1] - BY(s, r) == [lo s, hi s, r] - - if S has SetCategory then - (s1:%) = (s2:%) == - s1.low = s2.low and s1.high=s2.high and s1.incr = s2.incr - - coerce(s:%):OutputForm == - seg := SEGMENT(s.low::OutputForm, s.high::OutputForm) - s.incr = 1 => seg - infix(" by "::OutputForm, seg, s.incr::OutputForm) - - convert a == [a,a,1] - - if S has OrderedRing then - expand(ls: List %):List S == - lr := nil()$List(S) - for s in ls repeat - l := lo s - h := hi s - inc := (incr s)::S - zero? inc => error "Cannot expand a segment with an increment of zero" - if inc > 0 then - while l <= h repeat - lr := concat(l, lr) - l := l + inc - else - while l >= h repeat - lr := concat(l, lr) - l := l + inc - reverse_! lr - - expand(s : %) == expand([s]$List(%))$% - map(f : S->S, s : %): List S == - lr := nil()$List(S) - l := lo s - h := hi s - inc := (incr s)::S - if inc > 0 then - while l <= h repeat - lr := concat(f l, lr) - l := l + inc - else - while l >= h repeat - lr := concat(f l, lr) - l := l + inc - reverse_! lr - -@ \section{package SEG2 SegmentFunctions2} <>= )abbrev package SEG2 SegmentFunctions2 @@ -307,163 +59,6 @@ SegmentFunctions2(R:Type, S:Type): public == private where reverse_! lr @ -\section{domain SEGBIND SegmentBinding} -<>= --- seg.spad.pamphlet SegmentBinding.input -)spool SegmentBinding.output -)set message test on -)set message auto off -)clear all ---S 1 of 5 -x = a..b ---R ---R ---R (1) x= a..b ---R Type: SegmentBinding Symbol ---E 1 - ---S 2 of 5 -sum(i**2, i = 0..n) ---R ---R ---R 3 2 ---R 2n + 3n + n ---R (2) ------------- ---R 6 ---R Type: Fraction Polynomial Integer ---E 2 - ---S 3 of 5 -sb := y = 1/2..3/2 ---R ---R ---R 1 3 ---R (3) y= (-)..(-) ---R 2 2 ---R Type: SegmentBinding Fraction Integer ---E 3 - ---S 4 of 5 -variable(sb) ---R ---R ---R (4) y ---R Type: Symbol ---E 4 - ---S 5 of 5 -segment(sb) ---R ---R ---R 1 3 ---R (5) (-)..(-) ---R 2 2 ---R Type: Segment Fraction Integer ---E 5 -)spool -)lisp (bye) -@ -<>= -==================================================================== -SegmentBinding examples -==================================================================== - -The SegmentBinding type is used to indicate a range for a named symbol. - -First give the symbol, then an = and finally a segment of values. - - x = a..b - x= a..b - Type: SegmentBinding Symbol - -This is used to provide a convenient syntax for arguments to certain -operations. - - sum(i**2, i = 0..n) - 3 2 - 2n + 3n + n - ------------- - 6 - Type: Fraction Polynomial Integer - - draw(x**2, x = -2..2) - TwoDimensionalViewport: "x*x" - Type: TwoDimensionalViewport - - -The left-hand side must be of type Symbol but the right-hand side can -be a segment over any type. - - sb := y = 1/2..3/2 - 1 3 - y= (-)..(-) - 2 2 - Type: SegmentBinding Fraction Integer - -The left- and right-hand sides can be obtained using the variable and -segment operations. - - variable(sb) - y - Type: Symbol - - segment(sb) - 1 3 - (-)..(-) - 2 2 - Type: Segment Fraction Integer - -See Also: -o )help Segment -o )help UniversalSegment -o )show SegmentBinding -o $AXIOM/doc/src/algebra/seg.spad.dvi - -@ -<>= -)abbrev domain SEGBIND SegmentBinding -++ Author: -++ Date Created: -++ Date Last Updated: June 4, 1991 -++ Basic Operations: -++ Related Domains: Equation, Segment, Symbol -++ Also See: -++ AMS Classifications: -++ Keywords: equation -++ Examples: -++ References: -++ Description: -++ This domain is used to provide the function argument syntax \spad{v=a..b}. -++ This is used, for example, by the top-level \spadfun{draw} functions. -SegmentBinding(S:Type): Type with - equation: (Symbol, Segment S) -> % - ++ equation(v,a..b) creates a segment binding value with variable - ++ \spad{v} and segment \spad{a..b}. Note that the interpreter parses - ++ \spad{v=a..b} to this form. - variable: % -> Symbol - ++ variable(segb) returns the variable from the left hand side of - ++ the \spadtype{SegmentBinding}. For example, if \spad{segb} is - ++ \spad{v=a..b}, then \spad{variable(segb)} returns \spad{v}. - segment : % -> Segment S - ++ segment(segb) returns the segment from the right hand side of - ++ the \spadtype{SegmentBinding}. For example, if \spad{segb} is - ++ \spad{v=a..b}, then \spad{segment(segb)} returns \spad{a..b}. - - if S has SetCategory then SetCategory - == add - Rep := Record(var:Symbol, seg:Segment S) - equation(x,s) == [x, s] - variable b == b.var - segment b == b.seg - - if S has SetCategory then - - b1 = b2 == variable b1 = variable b2 and segment b1 = segment b2 - - coerce(b:%):OutputForm == - variable(b)::OutputForm = segment(b)::OutputForm - -@ \section{package SEGBIND2 SegmentBindingFunctions2} <>= )abbrev package SEGBIND2 SegmentBindingFunctions2 @@ -488,275 +83,6 @@ SegmentBindingFunctions2(R:Type, S:Type): with equation(variable b, map(f, segment b)$SegmentFunctions2(R, S)) @ -\section{domain UNISEG UniversalSegment} -<>= --- seg.spad.pamphlet UniversalSegment.input -)spool UniversalSegment.output -)set message test on -)set message auto off -)clear all ---S 1 of 9 -pints := 1.. ---R ---R ---R (1) 1.. ---R Type: UniversalSegment PositiveInteger ---E 1 - ---S 2 of 9 -nevens := (0..) by -2 ---R ---R ---R (2) 0.. by - 2 ---R Type: UniversalSegment NonNegativeInteger ---E 2 - ---S 3 of 9 -useg: UniversalSegment(Integer) := 3..10 ---R ---R ---R (3) 3..10 ---R Type: UniversalSegment Integer ---E 3 - ---S 4 of 9 -hasHi pints ---R ---R ---R (4) false ---R Type: Boolean ---E 4 - ---S 5 of 9 -hasHi nevens ---R ---R ---R (5) false ---R Type: Boolean ---E 5 - ---S 6 of 9 -hasHi useg ---R ---R ---R (6) true ---R Type: Boolean ---E 6 - ---S 7 of 9 -expand pints ---R ---R ---R (7) [1,2,3,4,5,6,7,8,9,10,...] ---R Type: Stream Integer ---E 7 - ---S 8 of 9 -expand nevens ---R ---R ---R (8) [0,- 2,- 4,- 6,- 8,- 10,- 12,- 14,- 16,- 18,...] ---R Type: Stream Integer ---E 8 - ---S 9 of 9 -expand [1, 3, 10..15, 100..] ---R ---R ---R (9) [1,3,10,11,12,13,14,15,100,101,...] ---R Type: Stream Integer ---E 9 -)spool -)lisp (bye) -@ -<>= -==================================================================== -UniversalSegment examples -==================================================================== - -The UniversalSegment domain generalizes Segment by allowing segments -without a "hi" end point. - - pints := 1.. - 1.. - Type: UniversalSegment PositiveInteger - - nevens := (0..) by -2 - 0.. by - 2 - Type: UniversalSegment NonNegativeInteger - -Values of type Segment are automatically converted to type -UniversalSegment when appropriate. - - useg: UniversalSegment(Integer) := 3..10 - 3..10 - Type: UniversalSegment Integer - -The operation hasHi is used to test whether a segment has a hi end point. - - hasHi pints - false - Type: Boolean - - hasHi nevens - false - Type: Boolean - - hasHi useg - true - Type: Boolean - -All operations available on type Segment apply to UniversalSegment, with -the proviso that expansions produce streams rather than lists. This is -to accommodate infinite expansions. - - expand pints - [1,2,3,4,5,6,7,8,9,10,...] - Type: Stream Integer - - expand nevens - [0,- 2,- 4,- 6,- 8,- 10,- 12,- 14,- 16,- 18,...] - Type: Stream Integer - - expand [1, 3, 10..15, 100..] - [1,3,10,11,12,13,14,15,100,101,...] - Type: Stream Integer - -See Also: -o )help Segment -o )help SegmentBinding -o )help List -o )help Stream -o )show UniversalSegment -o $AXIOM/doc/src/algebra/seg.spad.dvi - -@ -<>= -)abbrev domain UNISEG UniversalSegment -++ Author: Robert S. Sutor -++ Date Created: 1987 -++ Date Last Updated: June 4, 1991 -++ Basic Operations: -++ Related Domains: Segment -++ Also See: -++ AMS Classifications: -++ Keywords: equation -++ Examples: -++ References: -++ Description: -++ This domain provides segments which may be half open. -++ That is, ranges of the form \spad{a..} or \spad{a..b}. - -UniversalSegment(S: Type): SegmentCategory(S) with - SEGMENT: S -> % - ++ \spad{l..} produces a half open segment, - ++ that is, one with no upper bound. - segment: S -> % - ++ segment(l) is an alternate way to construct the segment \spad{l..}. - coerce : Segment S -> % - ++ coerce(x) allows \spadtype{Segment} values to be used as %. - hasHi: % -> Boolean - ++ hasHi(s) tests whether the segment s has an upper bound. - - if S has SetCategory then SetCategory - - if S has OrderedRing then - SegmentExpansionCategory(S, Stream S) --- expand : (List %, S) -> Stream S --- expand : (%, S) -> Stream S - - == add - Rec ==> Record(low: S, high: S, incr: Integer) - Rec2 ==> Record(low: S, incr: Integer) - SEG ==> Segment S - - Rep := Union(Rec2, Rec) - a,b : S - s : % - i: Integer - ls : List % - - segment a == [a, 1]$Rec2 :: Rep - segment(a,b) == [a,b,1]$Rec :: Rep - BY(s,i) == - s case Rec => [lo s, hi s, i]$Rec ::Rep - [lo s, i]$Rec2 :: Rep - - lo s == - s case Rec2 => (s :: Rec2).low - (s :: Rec).low - - low s == - s case Rec2 => (s :: Rec2).low - (s :: Rec).low - - hasHi s == s case Rec - - hi s == - not hasHi(s) => error "hi: segment has no upper bound" - (s :: Rec).high - - high s == - not hasHi(s) => error "high: segment has no upper bound" - (s :: Rec).high - - incr s == - s case Rec2 => (s :: Rec2).incr - (s :: Rec).incr - - SEGMENT(a) == segment a - SEGMENT(a,b) == segment(a,b) - - coerce(sg : SEG): % == segment(lo sg, hi sg) - - convert a == [a,a,1] - - if S has SetCategory then - - (s1:%) = (s2:%) == - s1 case Rec2 => - s2 case Rec2 => - s1.low = s2.low and s1.incr = s2.incr - false - s1 case Rec => - s2 case Rec => - s2.low = s2.low and s1.high=s2.high and s1.incr=s2.incr - false - false - - coerce(s: %): OutputForm == - seg := - e := (lo s)::OutputForm - hasHi s => SEGMENT(e, (hi s)::OutputForm) - SEGMENT e - inc := incr s - inc = 1 => seg - infix(" by "::OutputForm, seg, inc::OutputForm) - - if S has OrderedRing then - expand(s:%) == expand([s]) - map(f:S->S, s:%) == map(f, expand s) - - plusInc(t: S, a: S): S == t + a - - expand(ls: List %):Stream S == - st:Stream S := empty() - null ls => st - - lb:List(Segment S) := nil() - while not null ls and hasHi first ls repeat - s := first ls - ls := rest ls - ns := BY(SEGMENT(lo s, hi s), incr s)$Segment(S) - lb := concat_!(lb,ns) - if not null ls then - s := first ls - st: Stream S := generate(#1 + incr(s)::S, lo s) - else - st: Stream S := empty() - concat(construct expand(lb), st) - -@ \section{package UNISEG2 UniversalSegmentFunctions2} <>= )abbrev package UNISEG2 UniversalSegmentFunctions2 @@ -860,11 +186,8 @@ IncrementingMaps(R:Join(Monoid, AbelianSemiGroup)): with <<*>>= <> -<> <> -<> <> -<> <> <> @ diff --git a/src/algebra/sets.spad.pamphlet b/src/algebra/sets.spad.pamphlet deleted file mode 100644 index 0a348b4..0000000 --- a/src/algebra/sets.spad.pamphlet +++ /dev/null @@ -1,541 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra sets.spad} -\author{Michael Monagan, Richard Jenks} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{domain SET Set} -<>= --- sets.spad.pamphlet Set.input -)spool Set.output -)set message test on -)set message auto off -)clear all ---S 1 of 20 -s := set [x**2-1, y**2-1, z**2-1] ---R ---R ---R 2 2 2 ---R (1) {x - 1,y - 1,z - 1} ---R Type: Set Polynomial Integer ---E 1 - ---S 2 of 20 -t := set [x**i - i+1 for i in 2..10 | prime? i] ---R ---R ---R 2 3 5 7 ---R (2) {x - 1,x - 2,x - 4,x - 6} ---R Type: Set Polynomial Integer ---E 2 - ---S 3 of 20 -i := intersect(s,t) ---R ---R ---R 2 ---R (3) {x - 1} ---R Type: Set Polynomial Integer ---E 3 - ---S 4 of 20 -u := union(s,t) ---R ---R ---R 2 3 5 7 2 2 ---R (4) {x - 1,x - 2,x - 4,x - 6,y - 1,z - 1} ---R Type: Set Polynomial Integer ---E 4 - ---S 5 of 20 -difference(s,t) ---R ---R ---R 2 2 ---R (5) {y - 1,z - 1} ---R Type: Set Polynomial Integer ---E 5 - ---S 6 of 20 -symmetricDifference(s,t) ---R ---R ---R 3 5 7 2 2 ---R (6) {x - 2,x - 4,x - 6,y - 1,z - 1} ---R Type: Set Polynomial Integer ---E 6 - ---S 7 of 20 -member?(y, s) ---R ---R ---R (7) false ---R Type: Boolean ---E 7 - ---S 8 of 20 -member?((y+1)*(y-1), s) ---R ---R ---R (8) true ---R Type: Boolean ---E 8 - ---S 9 of 20 -subset?(i, s) ---R ---R ---R (9) true ---R Type: Boolean ---E 9 - ---S 10 of 20 -subset?(u, s) ---R ---R ---R (10) false ---R Type: Boolean ---E 10 - ---S 11 of 20 -gs := set [g for i in 1..11 | primitive?(g := i::PF 11)] ---R ---R ---R (11) {2,6,7,8} ---R Type: Set PrimeField 11 ---E 11 - ---S 12 of 20 -complement gs ---R ---R ---R (12) {1,3,4,5,9,10,0} ---R Type: Set PrimeField 11 ---E 12 - ---S 13 of 20 -a := set [i**2 for i in 1..5] ---R ---R ---R (13) {1,4,9,16,25} ---R Type: Set PositiveInteger ---E 13 - ---S 14 of 20 -insert!(32, a) ---R ---R ---R (14) {1,4,9,16,25,32} ---R Type: Set PositiveInteger ---E 14 - ---S 15 of 20 -remove!(25, a) ---R ---R ---R (15) {1,4,9,16,32} ---R Type: Set PositiveInteger ---E 15 - ---S 16 of 20 -a ---R ---R ---R (16) {1,4,9,16,32} ---R Type: Set PositiveInteger ---E 16 - ---S 17 of 20 -b := b0 := set [i**2 for i in 1..5] ---R ---R ---R (17) {1,4,9,16,25} ---R Type: Set PositiveInteger ---E 17 - ---S 18 of 20 -b := union(b, {32}) ---R ---R ---R (18) {1,4,9,16,25,32} ---R Type: Set PositiveInteger ---E 18 - ---S 19 of 20 -b := difference(b, {25}) ---R ---R ---R (19) {1,4,9,16,32} ---R Type: Set PositiveInteger ---E 19 - ---S 20 of 20 -b0 ---R ---R ---R (20) {1,4,9,16,25} ---R Type: Set PositiveInteger ---E 20 -)spool -)lisp (bye) -@ -<>= -==================================================================== -Set examples -==================================================================== - -The Set domain allows one to represent explicit finite sets of values. -These are similar to lists, but duplicate elements are not allowed. - -Sets can be created by giving a fixed set of values ... - - s := set [x**2-1, y**2-1, z**2-1] - 2 2 2 - {x - 1,y - 1,z - 1} - Type: Set Polynomial Integer - -or by using a collect form, just as for lists. In either case, the -set is formed from a finite collection of values. - - t := set [x**i - i+1 for i in 2..10 | prime? i] - 2 3 5 7 - {x - 1,x - 2,x - 4,x - 6} - Type: Set Polynomial Integer - -The basic operations on sets are intersect, union, difference, and -symmetricDifference. - - i := intersect(s,t) - 2 - {x - 1} - Type: Set Polynomial Integer - - u := union(s,t) - 2 3 5 7 2 2 - {x - 1,x - 2,x - 4,x - 6,y - 1,z - 1} - Type: Set Polynomial Integer - -The set difference(s,t) contains those members of s which are not in t. - - difference(s,t) - 2 2 - {y - 1,z - 1} - Type: Set Polynomial Integer - -The set symmetricDifference(s,t) contains those elements which are -in s or t but not in both. - - symmetricDifference(s,t) - 3 5 7 2 2 - {x - 2,x - 4,x - 6,y - 1,z - 1} - Type: Set Polynomial Integer - -Set membership is tested using the member? operation. - - member?(y, s) - false - Type: Boolean - - member?((y+1)*(y-1), s) - true - Type: Boolean - -The subset? function determines whether one set is a subset of another. - - subset?(i, s) - true - Type: Boolean - - subset?(u, s) - false - Type: Boolean - -When the base type is finite, the absolute complement of a set is -defined. This finds the set of all multiplicative generators of -PrimeField 11---the integers mod 11. - - gs := set [g for i in 1..11 | primitive?(g := i::PF 11)] - {2,6,7,8} - Type: Set PrimeField 11 - -The following values are not generators. - - complement gs - {1,3,4,5,9,10,0} - Type: Set PrimeField 11 - -Often the members of a set are computed individually; in addition, -values can be inserted or removed from a set over the course of a -computation. - -There are two ways to do this: - - a := set [i**2 for i in 1..5] - {1,4,9,16,25} - Type: Set PositiveInteger - -One is to view a set as a data structure and to apply updating operations. - - insert!(32, a) - {1,4,9,16,25,32} - Type: Set PositiveInteger - - remove!(25, a) - {1,4,9,16,32} - Type: Set PositiveInteger - - a - {1,4,9,16,32} - Type: Set PositiveInteger - -The other way is to view a set as a mathematical entity and to -create new sets from old. - - b := b0 := set [i**2 for i in 1..5] - {1,4,9,16,25} - Type: Set PositiveInteger - - b := union(b, {32}) - {1,4,9,16,25,32} - Type: Set PositiveInteger - - b := difference(b, {25}) - {1,4,9,16,32} - Type: Set PositiveInteger - - b0 - {1,4,9,16,25} - Type: Set PositiveInteger - -See Also: -o )help List -o )show Set -o $AXIOM/doc/src/algebra/sets.spad.dvi - -@ -<>= -)abbrev domain SET Set -++ Author: Michael Monagan; revised by Richard Jenks -++ Date Created: August 87 through August 88 -++ Date Last Updated: May 1991 -++ Basic Operations: -++ Related Constructors: -++ Also See: -++ AMS Classifications: -++ Keywords: -++ References: -++ Description: -++ A set over a domain D models the usual mathematical notion of a finite set -++ of elements from D. -++ Sets are unordered collections of distinct elements -++ (that is, order and duplication does not matter). -++ The notation \spad{set [a,b,c]} can be used to create -++ a set and the usual operations such as union and intersection are available -++ to form new sets. -++ In our implementation, \Language{} maintains the entries in -++ sorted order. Specifically, the parts function returns the entries -++ as a list in ascending order and -++ the extract operation returns the maximum entry. -++ Given two sets s and t where \spad{#s = m} and \spad{#t = n}, -++ the complexity of -++ \spad{s = t} is \spad{O(min(n,m))} -++ \spad{s < t} is \spad{O(max(n,m))} -++ \spad{union(s,t)}, \spad{intersect(s,t)}, \spad{minus(s,t)}, \spad{symmetricDifference(s,t)} is \spad{O(max(n,m))} -++ \spad{member(x,t)} is \spad{O(n log n)} -++ \spad{insert(x,t)} and \spad{remove(x,t)} is \spad{O(n)} -Set(S:SetCategory): FiniteSetAggregate S == add - Rep := FlexibleArray(S) - # s == _#$Rep s - brace() == empty() - set() == empty() - empty() == empty()$Rep - copy s == copy(s)$Rep - parts s == parts(s)$Rep - inspect s == (empty? s => error "Empty set"; s(maxIndex s)) - - extract_! s == - x := inspect s - delete_!(s, maxIndex s) - x - - find(f, s) == find(f, s)$Rep - - map(f, s) == map_!(f,copy s) - - map_!(f,s) == - map_!(f,s)$Rep - removeDuplicates_! s - - reduce(f, s) == reduce(f, s)$Rep - - reduce(f, s, x) == reduce(f, s, x)$Rep - - reduce(f, s, x, y) == reduce(f, s, x, y)$Rep - - if S has ConvertibleTo InputForm then - convert(x:%):InputForm == - convert [convert("set"::Symbol)@InputForm, - convert(parts x)@InputForm] - - if S has OrderedSet then - s = t == s =$Rep t - max s == inspect s - min s == (empty? s => error "Empty set"; s(minIndex s)) - - construct l == - zero?(n := #l) => empty() - a := new(n, first l) - for i in minIndex(a).. for x in l repeat a.i := x - removeDuplicates_! sort_! a - - insert_!(x, s) == - n := inc maxIndex s - k := minIndex s - while k < n and x > s.k repeat k := inc k - k < n and s.k = x => s - insert_!(x, s, k) - - member?(x, s) == -- binary search - empty? s => false - t := maxIndex s - b := minIndex s - while b < t repeat - m := (b+t) quo 2 - if x > s.m then b := m+1 else t := m - x = s.t - - remove_!(x:S, s:%) == - n := inc maxIndex s - k := minIndex s - while k < n and x > s.k repeat k := inc k - k < n and x = s.k => delete_!(s, k) - s - - -- the set operations are implemented as variations of merging - intersect(s, t) == - m := maxIndex s - n := maxIndex t - i := minIndex s - j := minIndex t - r := empty() - while i <= m and j <= n repeat - s.i = t.j => (concat_!(r, s.i); i := i+1; j := j+1) - if s.i < t.j then i := i+1 else j := j+1 - r - - difference(s:%, t:%) == - m := maxIndex s - n := maxIndex t - i := minIndex s - j := minIndex t - r := empty() - while i <= m and j <= n repeat - s.i = t.j => (i := i+1; j := j+1) - s.i < t.j => (concat_!(r, s.i); i := i+1) - j := j+1 - while i <= m repeat (concat_!(r, s.i); i := i+1) - r - - symmetricDifference(s, t) == - m := maxIndex s - n := maxIndex t - i := minIndex s - j := minIndex t - r := empty() - while i <= m and j <= n repeat - s.i < t.j => (concat_!(r, s.i); i := i+1) - s.i > t.j => (concat_!(r, t.j); j := j+1) - i := i+1; j := j+1 - while i <= m repeat (concat_!(r, s.i); i := i+1) - while j <= n repeat (concat_!(r, t.j); j := j+1) - r - - subset?(s, t) == - m := maxIndex s - n := maxIndex t - m > n => false - i := minIndex s - j := minIndex t - while i <= m and j <= n repeat - s.i = t.j => (i := i+1; j := j+1) - s.i > t.j => j := j+1 - return false - i > m - - union(s:%, t:%) == - m := maxIndex s - n := maxIndex t - i := minIndex s - j := minIndex t - r := empty() - while i <= m and j <= n repeat - s.i = t.j => (concat_!(r, s.i); i := i+1; j := j+1) - s.i < t.j => (concat_!(r, s.i); i := i+1) - (concat_!(r, t.j); j := j+1) - while i <= m repeat (concat_!(r, s.i); i := i+1) - while j <= n repeat (concat_!(r, t.j); j := j+1) - r - - else - insert_!(x, s) == - for k in minIndex s .. maxIndex s repeat - s.k = x => return s - insert_!(x, s, inc maxIndex s) - - remove_!(x:S, s:%) == - n := inc maxIndex s - k := minIndex s - while k < n repeat - x = s.k => return delete_!(s, k) - k := inc k - s - -@ -\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/sex.spad.pamphlet b/src/algebra/sex.spad.pamphlet deleted file mode 100644 index 554af3c..0000000 --- a/src/algebra/sex.spad.pamphlet +++ /dev/null @@ -1,138 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra sex.spad} -\author{Stephen M. Watt} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{domain SEXOF SExpressionOf} -<>= -)abbrev domain SEXOF SExpressionOf -++ Domain for Lisp values over arbitrary atomic types -++ Author: S.M.Watt -++ Date Created: July 1987 -++ Date Last Modified: 23 May 1991 -++ Description: -++ This domain allows the manipulation of Lisp values over -++ arbitrary atomic types. --- Allows the names of the atomic types to be chosen. --- *** Warning *** Although the parameters are declared only to be Sets, --- *** Warning *** they must have the appropriate representations. -SExpressionOf(Str, Sym, Int, Flt, Expr): Decl == Body where - Str, Sym, Int, Flt, Expr: SetCategory - - Decl ==> SExpressionCategory(Str, Sym, Int, Flt, Expr) - - Body ==> add - Rep := Expr - - dotex:OutputForm := INTERN(".")$Lisp - - coerce(b:%):OutputForm == - null? b => paren empty() - atom? b => coerce(b)$Rep - r := b - while not atom? r repeat r := cdr r - l1 := [b1::OutputForm for b1 in (l := destruct b)] - not null? r => - paren blankSeparate concat_!(l1, [dotex, r::OutputForm]) - #l = 2 and (first(l1) = QUOTE)@Boolean => quote first rest l1 - paren blankSeparate l1 - - b1 = b2 == EQUAL(b1,b2)$Lisp - eq(b1, b2) == EQ(b1,b2)$Lisp - - null? b == NULL(b)$Lisp - atom? b == ATOM(b)$Lisp - pair? b == PAIRP(b)$Lisp - - list? b == PAIRP(b)$Lisp or NULL(b)$Lisp - string? b == STRINGP(b)$Lisp - symbol? b == IDENTP(b)$Lisp - integer? b == INTP(b)$Lisp - float? b == RNUMP(b)$Lisp - - destruct b == (list? b => b pretend List %; error "Non-list") - string b == (STRINGP(b)$Lisp=> b pretend Str;error "Non-string") - symbol b == (IDENTP(b)$Lisp => b pretend Sym;error "Non-symbol") - float b == (RNUMP(b)$Lisp => b pretend Flt;error "Non-float") - integer b == (INTP(b)$Lisp => b pretend Int;error "Non-integer") - expr b == b pretend Expr - - convert(l: List %) == l pretend % - convert(st: Str) == st pretend % - convert(sy: Sym) == sy pretend % - convert(n: Int) == n pretend % - convert(f: Flt) == f pretend % - convert(e: Expr) == e pretend % - - car b == CAR(b)$Lisp - cdr b == CDR(b)$Lisp - # b == LENGTH(b)$Lisp - elt(b:%, i:Integer) == destruct(b).i - elt(b:%, li:List Integer) == - for i in li repeat b := destruct(b).i - b - -@ -\section{domain SEX SExpression} -<>= -)abbrev domain SEX SExpression -++ Domain for the standard Lisp values -++ Author: S.M.Watt -++ Date Created: July 1987 -++ Date Last Modified: 23 May 1991 -++ Description: -++ This domain allows the manipulation of the usual Lisp values; -SExpression() - == SExpressionOf(String, Symbol, Integer, DoubleFloat, OutputForm) - -@ -\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/sf.spad.pamphlet b/src/algebra/sf.spad.pamphlet deleted file mode 100644 index 825d704..0000000 --- a/src/algebra/sf.spad.pamphlet +++ /dev/null @@ -1,990 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra sf.spad} -\author{Michael Monagan, Stephen M. Watt} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{domain DFLOAT DoubleFloat} -Greg Vanuxem has added some functionality to allow the user to modify -the printed format of floating point numbers. The format of the numbers -follows the common lisp format specification for floats. First we include -Greg's email to show the use of this feature: -\begin{verbatim} -PS: For those who use the Doublefloat domain - there is an another (undocumented) patch that adds a - lisp format to the DoubleFloat output routine. Copy - int/algebra/DFLOAT.spad to your working directory, - patch it, compile it and ")lib" it when necessary. - - -(1) -> )boot $useBFasDefault:=false - -(SPADLET |$useBFasDefault| NIL) -Value = NIL -(1) -> a:= matrix [ [0.5978,0.2356], [0.4512,0.2355] ] - - + 0.5978 0.2356 + - (1) | | - +0.45119999999999999 0.23549999999999999+ - Type: Matrix DoubleFloat -(2) -> )lib DFLOAT - DoubleFloat is now explicitly exposed in frame initial - DoubleFloat will be automatically loaded when needed -from /home/greg/Axiom/DFLOAT.nrlib/code -(2) -> doubleFloatFormat("~,4,,F") - - (2) "~G" - Type: String -(3) -> a - - +0.5978 0.2356+ - (3) | | - +0.4512 0.2355+ - Type: Matrix DoubleFloat - -\end{verbatim} -So it is clear that he has added a new function called -{\tt doubleFloatFormat} which takes a string argument that -specifies the common lisp format control string (\"{}\~{},4,,F\"{}). -For reference we quote from the common lisp manual \cite{1}. -On page 582 we find: - -\begin{quote} -A format directive consists of a tilde (\~{}), optional prefix -parameters separated by commas, optional colon (:) and at-sign (@) -modifiers, and a single character indicating what kind of directive this is. -The alphabetic case of the directive character is ignored. The prefix -parameters are generally integers, notated as optionally signed decimal -numbers. - -X3J13 voted in June 1987 (80) to specify that if both colon and at-sign -modifiers are present, they may appear in either order; thus \~{}:@R -and \~{}@:R mean the same thing. However, it is traditional to put the -colon first, and all examples in the book put colon before at-signs. -\end{quote} - -\noindent -On page 588 we find: - -\begin{quote} -\~{}F - -{\sl Fixed-format floating-point}. The next {\sl arg} is printed as a -floating point number. - -The full form is {\sl \~{}w,d,k,overfowchar,padchar}F. The parameter -{\sl w} is the width of the filed to be printed; {\sl d} is the number -of digits to print after the decimal point; {\sl k} is a scale factor -that defaults to zero. - -Exactly {\sl w} characters will be output. First, leading copies of the -character {\sl padchar} (which defaults to a space) are printed, if -necessary, to pad the field on the left. If the {\sl arg} is negative, -then a minus sign is printed; if the {\sl arg} is not negative, then -a plus signed is printed if and only if the @ modifier was specified. -Then a sequence of digits, containing a single embedded decimal point, -is printed; this represents the magnitude of the value of {\sl arg} -times $10^k$, rounded to {\sl d} fractional digits. (When rounding up -and rounding down would produce printed values equidistant from the -scaled value of {\sl arg}, then the implementation is free to use -either one. For example, printing the argument 6.375 using the format -\~{}4.2F may correctly produce either 6.37 or 6.38.) Leading zeros are -not permitted, except that a single zero digit is output before the -decimal point if the printed value is less than 1, and this single zero -digit is not output after all if $w = d + 1$. - -If it is impossible to print the value in the required format in the -field of width {\sl w}, then one of two actions is taken. If the -parameter {\sl overflowchar} is specified, then {\sl w} copies of that -parameter are printed instead of the scaled value of {\sl arg}. If the -{\sl overflowchar} parameter is omitted, then the scaled value is -printed using more than {\sl w} characters, as many more as may be -needed. - -If the {\sl w} parameter is omitted, then the field is of variable width. -In effect, a value is chosen for {\sl w} in such a way that no leading pad -characters need to be printed and exactly {\sl d} characters will follow -the decimal point. For example, the directive \~{},2F will print exactly -two digits after the decimal point and as many as necessary before the -decimal point. - -If the parameter {\sl d} is omitted, then there is no constraint on the -number of digits to appear after the decimal point. A value is chosen -for {\sl d} in such a way that as many digits as possible may be printed -subject to the width constraint imposed by the parameter {\sl w} and the -constraint that no trailing zero digits may appear in the fraction, except -that if the fraction to be printed is zero, then a single zero digit should -appear after the decimal point if permitted by the width constraint. - -If both {\sl w} and {\sl d} are omitted, then the effect is to print the -value using ordinary free-format output; {\tt prin1} uses this format -for any number whose magnitude is either zero or between $10^{-3}$ -(inclusive) and $10^7$ (exclusive). - -If {\sl w} is omitted, then if the magnitude of {\sl arg} is so large -(or, if {\sl d} is also omitted, so small) that more than 100 digits -would have to be printed, then an implementation is free, at its -discretion, to print the number using exponential notation instead, -as if by the directive \~{}E (with all parameters of \~{}E defaulted, -not taking their valued from the \~{}F directive). - -If {\sl arg} is a rational number, then it is coerced to be a -{\tt single-float} and then printed. (Alternatively, an implementation -is permitted to process a rational number by any other method that has -essentially the same behavior but avoids such hazards as loss of -precision or overflow because of the coercion. However, note that if -{\sl w} and {\sl d} are unspecified and the number has no exact decimal -representation, for example 1/3, some precision cutoff must be chosen -by the implementation; only a finite number of digits may be printed.) - -If {\sl arg} is a complex number or some non-numeric object, then it -is printed using the format directive {\sl \~{}w}D, thereby printing -it in decimal radix and a minimum field width of {\sl w}. (If it is -desired to print each of the real part and imaginary part of a -complex number using a \~{}F directive, then this must be done explicitly -with two \~{}F directives and code to extract the two parts of the -complex number.) - - -\end{quote} -<>= --- sf.spad.pamphlet DoubleFloat.input -)spool DoubleFloat.output -)set message test on -)set message auto off -)clear all ---S 1 of 10 -2.71828 ---R ---R ---R (1) 2.71828 ---R Type: Float ---E 1 - ---S 2 of 10 -2.71828@DoubleFloat ---R ---R ---R (2) 2.71828 ---R Type: DoubleFloat ---E 2 - ---S 3 of 10 -2.71828 :: DoubleFloat ---R ---R ---R (3) 2.71828 ---R Type: DoubleFloat ---E 3 - ---S 4 of 10 -eApprox : DoubleFloat := 2.71828 ---R ---R ---R (4) 2.71828 ---R Type: DoubleFloat ---E 4 - ---S 5 of 10 -avg : List DoubleFloat -> DoubleFloat ---R ---R Type: Void ---E 5 - ---S 6 of 10 -avg l == - empty? l => 0 :: DoubleFloat - reduce(_+,l) / #l ---R ---R Type: Void ---E 6 - ---S 7 of 10 -avg [] ---R ---R Compiling function avg with type List DoubleFloat -> DoubleFloat ---R ---R (7) 0. ---R Type: DoubleFloat ---E 7 - ---S 8 of 10 -avg [3.4,9.7,-6.8] ---R ---R ---R (8) 2.1000000000000001 ---R Type: DoubleFloat ---E 8 - ---S 9 of 10 -cos(3.1415926)$DoubleFloat ---R ---R ---R (9) - 0.99999999999999856 ---R Type: DoubleFloat ---E 9 - ---S 10 of 10 -cos(3.1415926 :: DoubleFloat) ---R ---R ---R (10) - 0.99999999999999856 ---R Type: DoubleFloat ---E 10 -)spool -)lisp (bye) -@ - -<>= -==================================================================== -DoubleFloat examples -==================================================================== - -Axiom provides two kinds of floating point numbers. The domain Float -(abbreviation FLOAT) implements a model of arbitrary precision -floating point numbers. The domain DoubleFloat (abbreviation DFLOAT) -is intended to make available hardware floating point arithmetic in -Axiom. The actual model of floating point DoubleFloat that 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. - -The usual arithmetic and elementary functions are available for -DoubleFloat. By default, floating point numbers that you enter into -Axiom are of type Float. - - 2.71828 - 2.71828 - Type: Float - -You must therefore tell Axiom that you want to use DoubleFloat values -and operations. The following are some conservative guidelines for -getting Axiom to use DoubleFloat. - -To get a value of type DoubleFloat, use a target with @, ... - - 2.71828@DoubleFloat - 2.71828 - Type: DoubleFloat - -a conversion, ... - - 2.71828 :: DoubleFloat - 2.71828 - Type: DoubleFloat - -or an assignment to a declared variable. It is more efficient if you -use a target rather than an explicit or implicit conversion. - - eApprox : DoubleFloat := 2.71828 - 2.71828 - Type: DoubleFloat - -You also need to declare functions that work with DoubleFloat. - - avg : List DoubleFloat -> DoubleFloat - Type: Void - - avg l == - empty? l => 0 :: DoubleFloat - reduce(_+,l) / #l - Type: Void - - avg [] - 0. - Type: DoubleFloat - - avg [3.4,9.7,-6.8] - 2.1000000000000001 - Type: DoubleFloat - -Use package-calling for operations from DoubleFloat unless the -arguments themselves are already of type DoubleFloat. - - cos(3.1415926)$DoubleFloat - -0.99999999999999856 - Type: DoubleFloat - - cos(3.1415926 :: DoubleFloat) - -0.99999999999999856 - Type: DoubleFloat - -By far, the most common usage of DoubleFloat is for functions to be -graphed. - - -See Also: -0 )help Float -o )show DoubleFloat -o $AXIOM/doc/src/algebra/sf.spad.dvi - -@ -<>= -"DFLOAT" -> "FPS" -"DoubleFloat()" -> "FloatingPointSystem()" -"DFLOAT" -> "DIFRING" -"DoubleFloat()" -> "DifferentialRing()" -"DFLOAT" -> "OM" -"DoubleFloat()" -> "OpenMath()" -"DFLOAT" -> "TRANFUN" -"DoubleFloat()" -> "TranscendentalFunctionCategory()" -"DFLOAT" -> "SPFCAT" -"DoubleFloat()" -> "SpecialFunctionCategory()" -"DFLOAT" -> "KONVERT" -"DoubleFloat()" -> "ConvertibleTo(InputForm)" -@ -<>= -)abbrev domain DFLOAT DoubleFloat -++ Author: Michael Monagan -++ Date Created: -++ January 1988 -++ Change History: -++ Basic Operations: exp1, hash, log2, log10, rationalApproximation, / , ** -++ Related Constructors: -++ Keywords: small float -++ Description: \spadtype{DoubleFloat} is intended to make accessible -++ hardware floating point arithmetic in \Language{}, either native double -++ precision, or IEEE. On most machines, there will be hardware support for -++ the arithmetic operations: -++ \spadfunFrom{+}{DoubleFloat}, \spadfunFrom{*}{DoubleFloat}, -++ \spadfunFrom{/}{DoubleFloat} and possibly also the -++ \spadfunFrom{sqrt}{DoubleFloat} operation. -++ The operations \spadfunFrom{exp}{DoubleFloat}, -++ \spadfunFrom{log}{DoubleFloat}, \spadfunFrom{sin}{DoubleFloat}, -++ \spadfunFrom{cos}{DoubleFloat}, -++ \spadfunFrom{atan}{DoubleFloat} are normally coded in -++ software based on minimax polynomial/rational approximations. -++ Note that under Lisp/VM, \spadfunFrom{atan}{DoubleFloat} -++ is not available at this time. -++ Some general comments about the accuracy of the operations: -++ the operations \spadfunFrom{+}{DoubleFloat}, -++ \spadfunFrom{*}{DoubleFloat}, \spadfunFrom{/}{DoubleFloat} and -++ \spadfunFrom{sqrt}{DoubleFloat} are expected to be fully accurate. -++ The operations \spadfunFrom{exp}{DoubleFloat}, -++ \spadfunFrom{log}{DoubleFloat}, \spadfunFrom{sin}{DoubleFloat}, -++ \spadfunFrom{cos}{DoubleFloat} and -++ \spadfunFrom{atan}{DoubleFloat} are not expected to be -++ fully accurate. In particular, \spadfunFrom{sin}{DoubleFloat} -++ and \spadfunFrom{cos}{DoubleFloat} -++ will lose all precision for large arguments. -++ -++ The \spadtype{Float} domain provides an alternative to the -++ \spad{DoubleFloat} domain. -++ It provides an arbitrary precision model of floating point arithmetic. -++ This means that accuracy problems like those above are eliminated -++ by increasing the working precision where necessary. \spadtype{Float} -++ provides some special functions such as \spadfunFrom{erf}{DoubleFloat}, -++ the error function -++ in addition to the elementary functions. The disadvantage of -++ \spadtype{Float} is that it is much more expensive than small floats when the latter can be used. --- I've put some timing comparisons in the notes for the Float --- domain about the difference in speed between the two domains. -DoubleFloat(): Join(FloatingPointSystem, DifferentialRing, OpenMath, - TranscendentalFunctionCategory, SpecialFunctionCategory, _ - ConvertibleTo InputForm) with - _/ : (%, Integer) -> % - ++ x / i computes the division from x by an integer i. - _*_* : (%,%) -> % - ++ x ** y returns the yth power of x (equal to \spad{exp(y log x)}). - exp1 : () -> % - ++ exp1() returns the natural log base \spad{2.718281828...}. - hash : % -> Integer - ++ hash(x) returns the hash key for x - log2 : % -> % - ++ log2(x) computes the logarithm with base 2 for x. - log10: % -> % - ++ log10(x) computes the logarithm with base 10 for x. - atan : (%,%) -> % - ++ atan(x,y) computes the arc tangent from x with phase y. - Gamma: % -> % - ++ Gamma(x) is the Euler Gamma function. - Beta : (%,%) -> % - ++ Beta(x,y) is \spad{Gamma(x) * Gamma(y)/Gamma(x+y)}. - doubleFloatFormat : String -> String - ++ change the output format for doublefloats using lisp format strings - rationalApproximation: (%, NonNegativeInteger) -> Fraction Integer - ++ rationalApproximation(f, n) computes a rational approximation - ++ r to f with relative error \spad{< 10**(-n)}. - rationalApproximation: (%, NonNegativeInteger, NonNegativeInteger) -> Fraction Integer - ++ 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)}). - - == add - format: String := "~G" - MER ==> Record(MANTISSA:Integer,EXPONENT:Integer) - - manexp: % -> MER - - doubleFloatFormat(s:String): String == - ss: String := format - format := s - ss - - OMwrite(x: %): String == - s: String := "" - sp := OM_-STRINGTOSTRINGPTR(s)$Lisp - dev: OpenMathDevice := OMopenString(sp pretend String, OMencodingXML) - OMputObject(dev) - OMputFloat(dev, convert 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) - OMputFloat(dev, convert x) - if wholeObj then - OMputEndObject(dev) - OMclose(dev) - s := OM_-STRINGPTRTOSTRING(sp)$Lisp pretend String - s - - OMwrite(dev: OpenMathDevice, x: %): Void == - OMputObject(dev) - OMputFloat(dev, convert x) - OMputEndObject(dev) - - OMwrite(dev: OpenMathDevice, x: %, wholeObj: Boolean): Void == - if wholeObj then - OMputObject(dev) - OMputFloat(dev, convert x) - if wholeObj then - OMputEndObject(dev) - - checkComplex(x:%):% == C_-TO_-R(x)$Lisp - -- In AKCL we used to have to make the arguments to ASIN ACOS ACOSH ATANH - -- complex to get the correct behaviour. - --makeComplex(x: %):% == COMPLEX(x, 0$%)$Lisp - - base() == FLOAT_-RADIX(0$%)$Lisp - mantissa x == manexp(x).MANTISSA - exponent x == manexp(x).EXPONENT - precision() == FLOAT_-DIGITS(0$%)$Lisp - bits() == - base() = 2 => precision() - base() = 16 => 4*precision() - wholePart(precision()*log2(base()::%))::PositiveInteger - max() == MOST_-POSITIVE_-DOUBLE_-FLOAT$Lisp - min() == MOST_-NEGATIVE_-DOUBLE_-FLOAT$Lisp - order(a) == precision() + exponent a - 1 - 0 == FLOAT(0$Lisp,MOST_-POSITIVE_-DOUBLE_-FLOAT$Lisp)$Lisp - 1 == FLOAT(1$Lisp,MOST_-POSITIVE_-DOUBLE_-FLOAT$Lisp)$Lisp - -- rational approximation to e accurate to 23 digits - exp1() == FLOAT(534625820200,MOST_-POSITIVE_-DOUBLE_-FLOAT$Lisp)$Lisp / _ - FLOAT(196677847971,MOST_-POSITIVE_-DOUBLE_-FLOAT$Lisp)$Lisp - pi() == FLOAT(PI$Lisp,MOST_-POSITIVE_-DOUBLE_-FLOAT$Lisp)$Lisp - coerce(x:%):OutputForm == - x >= 0 => message(FORMAT(NIL$Lisp,format,x)$Lisp pretend String) - - (message(FORMAT(NIL$Lisp,format,-x)$Lisp pretend String)) - convert(x:%):InputForm == convert(x pretend DoubleFloat)$InputForm - x < y == (x "failed"; 1 / x) - differentiate x == 0 - - SFSFUN ==> DoubleFloatSpecialFunctions() - sfx ==> x pretend DoubleFloat - sfy ==> y pretend DoubleFloat - airyAi x == airyAi(sfx)$SFSFUN pretend % - airyBi x == airyBi(sfx)$SFSFUN pretend % - besselI(x,y) == besselI(sfx,sfy)$SFSFUN pretend % - besselJ(x,y) == besselJ(sfx,sfy)$SFSFUN pretend % - besselK(x,y) == besselK(sfx,sfy)$SFSFUN pretend % - besselY(x,y) == besselY(sfx,sfy)$SFSFUN pretend % - Beta(x,y) == Beta(sfx,sfy)$SFSFUN pretend % - digamma x == digamma(sfx)$SFSFUN pretend % - Gamma x == Gamma(sfx)$SFSFUN pretend % --- not implemented in SFSFUN --- Gamma(x,y) == Gamma(sfx,sfy)$SFSFUN pretend % - polygamma(x,y) == - if (n := retractIfCan(x:%):Union(Integer, "failed")) case Integer _ - and n >= 0 - then polygamma(n::Integer::NonNegativeInteger,sfy)$SFSFUN pretend % - else error "polygamma: first argument should be a nonnegative integer" - - wholePart x == FIX(x)$Lisp - float(ma,ex,b) == ma*(b::%)**ex - convert(x:%):DoubleFloat == x pretend DoubleFloat - convert(x:%):Float == convert(x pretend DoubleFloat)$Float - rationalApproximation(x, d) == rationalApproximation(x, d, 10) - - 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 - - retract(x:%):Fraction(Integer) == - rationalApproximation(x, (precision() - 1)::NonNegativeInteger, base()) - - retractIfCan(x:%):Union(Fraction Integer, "failed") == - rationalApproximation(x, (precision() - 1)::NonNegativeInteger, base()) - - retract(x:%):Integer == - x = ((n := wholePart x)::%) => n - error "Not an integer" - - retractIfCan(x:%):Union(Integer, "failed") == - x = ((n := wholePart x)::%) => n - "failed" - - sign(x) == retract FLOAT_-SIGN(x,1)$Lisp - abs x == FLOAT_-SIGN(1,x)$Lisp - - - - manexp(x) == - zero? x => [0,0] - s := sign x; x := abs x - if x > max()$% then return [s*mantissa(max())+1,exponent max()] - me:Record(man:%,exp:Integer) := MANEXP(x)$Lisp - two53:= base()**precision() - [s*wholePart(two53 * me.man ),me.exp-precision()] - --- rationalApproximation(y,d,b) == --- this is the quotient remainder algorithm (requires wholePart operation) --- x := y --- if b < 2 then error "base must be > 1" --- tol := (b::%)**d --- p0,p1,q0,q1 : Integer --- p0 := 0; p1 := 1; q0 := 1; q1 := 0 --- repeat --- a := wholePart x --- x := fractionPart x --- p2 := p0+a*p1 --- q2 := q0+a*q1 --- if x = 0 or tol*abs(q2*y-(p2::%)) < abs(q2*y) then --- return (p2/q2) --- (p0,p1) := (p1,p2) --- (q0,q1) := (q1,q2) --- x := 1/x - - rationalApproximation(f,d,b) == - -- this algorithm expresses f as n / d where d = BASE ** k - -- then all arithmetic operations are done over the integers - (nu, ex) := manexp f - BASE := base() - ex >= 0 => (nu * BASE ** (ex::NonNegativeInteger))::Fraction(Integer) - de :Integer := BASE**((-ex)::NonNegativeInteger) - b < 2 => error "base must be > 1" - tol := b**d - s := nu; t := de - p0:Integer := 0; p1:Integer := 1; q0:Integer := 1; q1:Integer := 0 - repeat - (q,r) := divide(s, t) - p2 := q*p1+p0 - q2 := q*q1+q0 - r = 0 or tol*abs(nu*q2-de*p2) < de*abs(p2) => return(p2/q2) - (p0,p1) := (p1,p2) - (q0,q1) := (q1,q2) - (s,t) := (t,r) - - x:% ** r:Fraction Integer == - zero? x => - zero? r => error "0**0 is undefined" - negative? r => error "division by 0" - 0 --- zero? r or one? x => 1 - zero? r or (x = 1) => 1 --- one? r => x - (r = 1) => x - n := numer r - d := denom r - negative? x => - odd? d => - odd? n => return -((-x)**r) - return ((-x)**r) - error "negative root" - d = 2 => sqrt(x) ** n - x ** (n::% / d::%) - -@ -\section{DFLOAT.lsp BOOTSTRAP} -{\bf DFLOAT} depends on itself. -We need to break this cycle to build the algebra. So we keep a -cached copy of the translated {\bf DFLOAT} category which we can write -into the {\bf MID} directory. We compile the lisp code and copy the -{\bf DFLOAT.o} file to the {\bf OUT} directory. This is eventually -forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<>= - -(|/VERSIONCHECK| 2) - -(DEFUN |DFLOAT;OMwrite;$S;1| (|x| |$|) (PROG (|sp| |dev| |s|) (RETURN (SEQ (LETT |s| "" |DFLOAT;OMwrite;$S;1|) (LETT |sp| (|OM-STRINGTOSTRINGPTR| |s|) |DFLOAT;OMwrite;$S;1|) (LETT |dev| (SPADCALL |sp| (SPADCALL (QREFELT |$| 7)) (QREFELT |$| 10)) |DFLOAT;OMwrite;$S;1|) (SPADCALL |dev| (QREFELT |$| 12)) (SPADCALL |dev| |x| (QREFELT |$| 14)) (SPADCALL |dev| (QREFELT |$| 15)) (SPADCALL |dev| (QREFELT |$| 16)) (LETT |s| (|OM-STRINGPTRTOSTRING| |sp|) |DFLOAT;OMwrite;$S;1|) (EXIT |s|))))) - -(DEFUN |DFLOAT;OMwrite;$BS;2| (|x| |wholeObj| |$|) (PROG (|sp| |dev| |s|) (RETURN (SEQ (LETT |s| "" |DFLOAT;OMwrite;$BS;2|) (LETT |sp| (|OM-STRINGTOSTRINGPTR| |s|) |DFLOAT;OMwrite;$BS;2|) (LETT |dev| (SPADCALL |sp| (SPADCALL (QREFELT |$| 7)) (QREFELT |$| 10)) |DFLOAT;OMwrite;$BS;2|) (COND (|wholeObj| (SPADCALL |dev| (QREFELT |$| 12)))) (SPADCALL |dev| |x| (QREFELT |$| 14)) (COND (|wholeObj| (SPADCALL |dev| (QREFELT |$| 15)))) (SPADCALL |dev| (QREFELT |$| 16)) (LETT |s| (|OM-STRINGPTRTOSTRING| |sp|) |DFLOAT;OMwrite;$BS;2|) (EXIT |s|))))) - -(DEFUN |DFLOAT;OMwrite;Omd$V;3| (|dev| |x| |$|) (SEQ (SPADCALL |dev| (QREFELT |$| 12)) (SPADCALL |dev| |x| (QREFELT |$| 14)) (EXIT (SPADCALL |dev| (QREFELT |$| 15))))) - -(DEFUN |DFLOAT;OMwrite;Omd$BV;4| (|dev| |x| |wholeObj| |$|) (SEQ (COND (|wholeObj| (SPADCALL |dev| (QREFELT |$| 12)))) (SPADCALL |dev| |x| (QREFELT |$| 14)) (EXIT (COND (|wholeObj| (SPADCALL |dev| (QREFELT |$| 15))))))) - -(PUT (QUOTE |DFLOAT;checkComplex|) (QUOTE |SPADreplace|) (QUOTE |C-TO-R|)) - -(DEFUN |DFLOAT;checkComplex| (|x| |$|) (|C-TO-R| |x|)) - -(PUT (QUOTE |DFLOAT;base;Pi;6|) (QUOTE |SPADreplace|) (QUOTE (XLAM NIL (|FLOAT-RADIX| 0.0)))) - -(DEFUN |DFLOAT;base;Pi;6| (|$|) (|FLOAT-RADIX| 0.0)) - -(DEFUN |DFLOAT;mantissa;$I;7| (|x| |$|) (QCAR (|DFLOAT;manexp| |x| |$|))) - -(DEFUN |DFLOAT;exponent;$I;8| (|x| |$|) (QCDR (|DFLOAT;manexp| |x| |$|))) - -(PUT (QUOTE |DFLOAT;precision;Pi;9|) (QUOTE |SPADreplace|) (QUOTE (XLAM NIL (|FLOAT-DIGITS| 0.0)))) - -(DEFUN |DFLOAT;precision;Pi;9| (|$|) (|FLOAT-DIGITS| 0.0)) - -(DEFUN |DFLOAT;bits;Pi;10| (|$|) (PROG (#1=#:G105705) (RETURN (COND ((EQL (|FLOAT-RADIX| 0.0) 2) (|FLOAT-DIGITS| 0.0)) ((EQL (|FLOAT-RADIX| 0.0) 16) (|*| 4 (|FLOAT-DIGITS| 0.0))) ((QUOTE T) (PROG1 (LETT #1# (FIX (SPADCALL (|FLOAT-DIGITS| 0.0) (SPADCALL (FLOAT (|FLOAT-RADIX| 0.0) |MOST-POSITIVE-LONG-FLOAT|) (QREFELT |$| 28)) (QREFELT |$| 29))) |DFLOAT;bits;Pi;10|) (|check-subtype| (|>| #1# 0) (QUOTE (|PositiveInteger|)) #1#))))))) - -(PUT (QUOTE |DFLOAT;max;$;11|) (QUOTE |SPADreplace|) (QUOTE (XLAM NIL |MOST-POSITIVE-LONG-FLOAT|))) - -(DEFUN |DFLOAT;max;$;11| (|$|) |MOST-POSITIVE-LONG-FLOAT|) - -(PUT (QUOTE |DFLOAT;min;$;12|) (QUOTE |SPADreplace|) (QUOTE (XLAM NIL |MOST-NEGATIVE-LONG-FLOAT|))) - -(DEFUN |DFLOAT;min;$;12| (|$|) |MOST-NEGATIVE-LONG-FLOAT|) - -(DEFUN |DFLOAT;order;$I;13| (|a| |$|) (|-| (|+| (|FLOAT-DIGITS| 0.0) (SPADCALL |a| (QREFELT |$| 26))) 1)) - -(PUT (QUOTE |DFLOAT;Zero;$;14|) (QUOTE |SPADreplace|) (QUOTE (XLAM NIL (FLOAT 0 |MOST-POSITIVE-LONG-FLOAT|)))) - -(DEFUN |DFLOAT;Zero;$;14| (|$|) (FLOAT 0 |MOST-POSITIVE-LONG-FLOAT|)) - -(PUT (QUOTE |DFLOAT;One;$;15|) (QUOTE |SPADreplace|) (QUOTE (XLAM NIL (FLOAT 1 |MOST-POSITIVE-LONG-FLOAT|)))) - -(DEFUN |DFLOAT;One;$;15| (|$|) (FLOAT 1 |MOST-POSITIVE-LONG-FLOAT|)) - -(DEFUN |DFLOAT;exp1;$;16| (|$|) (|/| (FLOAT 534625820200 |MOST-POSITIVE-LONG-FLOAT|) (FLOAT 196677847971 |MOST-POSITIVE-LONG-FLOAT|))) - -(PUT (QUOTE |DFLOAT;pi;$;17|) (QUOTE |SPADreplace|) (QUOTE (XLAM NIL PI))) - -(DEFUN |DFLOAT;pi;$;17| (|$|) PI) - -(DEFUN |DFLOAT;coerce;$Of;18| (|x| |$|) (SPADCALL |x| (QREFELT |$| 39))) - -(DEFUN |DFLOAT;convert;$If;19| (|x| |$|) (SPADCALL |x| (QREFELT |$| 42))) - -(PUT (QUOTE |DFLOAT;<;2$B;20|) (QUOTE |SPADreplace|) (QUOTE |<|)) - -(DEFUN |DFLOAT;<;2$B;20| (|x| |y| |$|) (|<| |x| |y|)) - -(PUT (QUOTE |DFLOAT;-;2$;21|) (QUOTE |SPADreplace|) (QUOTE |-|)) - -(DEFUN |DFLOAT;-;2$;21| (|x| |$|) (|-| |x|)) - -(PUT (QUOTE |DFLOAT;+;3$;22|) (QUOTE |SPADreplace|) (QUOTE |+|)) - -(DEFUN |DFLOAT;+;3$;22| (|x| |y| |$|) (|+| |x| |y|)) - -(PUT (QUOTE |DFLOAT;-;3$;23|) (QUOTE |SPADreplace|) (QUOTE |-|)) - -(DEFUN |DFLOAT;-;3$;23| (|x| |y| |$|) (|-| |x| |y|)) - -(PUT (QUOTE |DFLOAT;*;3$;24|) (QUOTE |SPADreplace|) (QUOTE |*|)) - -(DEFUN |DFLOAT;*;3$;24| (|x| |y| |$|) (|*| |x| |y|)) - -(PUT (QUOTE |DFLOAT;*;I2$;25|) (QUOTE |SPADreplace|) (QUOTE |*|)) - -(DEFUN |DFLOAT;*;I2$;25| (|i| |x| |$|) (|*| |i| |x|)) - -(PUT (QUOTE |DFLOAT;max;3$;26|) (QUOTE |SPADreplace|) (QUOTE MAX)) - -(DEFUN |DFLOAT;max;3$;26| (|x| |y| |$|) (MAX |x| |y|)) - -(PUT (QUOTE |DFLOAT;min;3$;27|) (QUOTE |SPADreplace|) (QUOTE MIN)) - -(DEFUN |DFLOAT;min;3$;27| (|x| |y| |$|) (MIN |x| |y|)) - -(PUT (QUOTE |DFLOAT;=;2$B;28|) (QUOTE |SPADreplace|) (QUOTE |=|)) - -(DEFUN |DFLOAT;=;2$B;28| (|x| |y| |$|) (|=| |x| |y|)) - -(PUT (QUOTE |DFLOAT;/;$I$;29|) (QUOTE |SPADreplace|) (QUOTE |/|)) - -(DEFUN |DFLOAT;/;$I$;29| (|x| |i| |$|) (|/| |x| |i|)) - -(DEFUN |DFLOAT;sqrt;2$;30| (|x| |$|) (|DFLOAT;checkComplex| (SQRT |x|) |$|)) - -(DEFUN |DFLOAT;log10;2$;31| (|x| |$|) (|DFLOAT;checkComplex| (|log| |x|) |$|)) - -(PUT (QUOTE |DFLOAT;**;$I$;32|) (QUOTE |SPADreplace|) (QUOTE EXPT)) - -(DEFUN |DFLOAT;**;$I$;32| (|x| |i| |$|) (EXPT |x| |i|)) - -(DEFUN |DFLOAT;**;3$;33| (|x| |y| |$|) (|DFLOAT;checkComplex| (EXPT |x| |y|) |$|)) - -(PUT (QUOTE |DFLOAT;coerce;I$;34|) (QUOTE |SPADreplace|) (QUOTE (XLAM (|i|) (FLOAT |i| |MOST-POSITIVE-LONG-FLOAT|)))) - -(DEFUN |DFLOAT;coerce;I$;34| (|i| |$|) (FLOAT |i| |MOST-POSITIVE-LONG-FLOAT|)) - -(PUT (QUOTE |DFLOAT;exp;2$;35|) (QUOTE |SPADreplace|) (QUOTE EXP)) - -(DEFUN |DFLOAT;exp;2$;35| (|x| |$|) (EXP |x|)) - -(DEFUN |DFLOAT;log;2$;36| (|x| |$|) (|DFLOAT;checkComplex| (LN |x|) |$|)) - -(DEFUN |DFLOAT;log2;2$;37| (|x| |$|) (|DFLOAT;checkComplex| (LOG2 |x|) |$|)) - -(PUT (QUOTE |DFLOAT;sin;2$;38|) (QUOTE |SPADreplace|) (QUOTE SIN)) - -(DEFUN |DFLOAT;sin;2$;38| (|x| |$|) (SIN |x|)) - -(PUT (QUOTE |DFLOAT;cos;2$;39|) (QUOTE |SPADreplace|) (QUOTE COS)) - -(DEFUN |DFLOAT;cos;2$;39| (|x| |$|) (COS |x|)) - -(PUT (QUOTE |DFLOAT;tan;2$;40|) (QUOTE |SPADreplace|) (QUOTE TAN)) - -(DEFUN |DFLOAT;tan;2$;40| (|x| |$|) (TAN |x|)) - -(PUT (QUOTE |DFLOAT;cot;2$;41|) (QUOTE |SPADreplace|) (QUOTE COT)) - -(DEFUN |DFLOAT;cot;2$;41| (|x| |$|) (COT |x|)) - -(PUT (QUOTE |DFLOAT;sec;2$;42|) (QUOTE |SPADreplace|) (QUOTE SEC)) - -(DEFUN |DFLOAT;sec;2$;42| (|x| |$|) (SEC |x|)) - -(PUT (QUOTE |DFLOAT;csc;2$;43|) (QUOTE |SPADreplace|) (QUOTE CSC)) - -(DEFUN |DFLOAT;csc;2$;43| (|x| |$|) (CSC |x|)) - -(DEFUN |DFLOAT;asin;2$;44| (|x| |$|) (|DFLOAT;checkComplex| (ASIN |x|) |$|)) - -(DEFUN |DFLOAT;acos;2$;45| (|x| |$|) (|DFLOAT;checkComplex| (ACOS |x|) |$|)) - -(PUT (QUOTE |DFLOAT;atan;2$;46|) (QUOTE |SPADreplace|) (QUOTE ATAN)) - -(DEFUN |DFLOAT;atan;2$;46| (|x| |$|) (ATAN |x|)) - -(DEFUN |DFLOAT;acsc;2$;47| (|x| |$|) (|DFLOAT;checkComplex| (ACSC |x|) |$|)) - -(PUT (QUOTE |DFLOAT;acot;2$;48|) (QUOTE |SPADreplace|) (QUOTE ACOT)) - -(DEFUN |DFLOAT;acot;2$;48| (|x| |$|) (ACOT |x|)) - -(DEFUN |DFLOAT;asec;2$;49| (|x| |$|) (|DFLOAT;checkComplex| (ASEC |x|) |$|)) - -(PUT (QUOTE |DFLOAT;sinh;2$;50|) (QUOTE |SPADreplace|) (QUOTE SINH)) - -(DEFUN |DFLOAT;sinh;2$;50| (|x| |$|) (SINH |x|)) - -(PUT (QUOTE |DFLOAT;cosh;2$;51|) (QUOTE |SPADreplace|) (QUOTE COSH)) - -(DEFUN |DFLOAT;cosh;2$;51| (|x| |$|) (COSH |x|)) - -(PUT (QUOTE |DFLOAT;tanh;2$;52|) (QUOTE |SPADreplace|) (QUOTE TANH)) - -(DEFUN |DFLOAT;tanh;2$;52| (|x| |$|) (TANH |x|)) - -(PUT (QUOTE |DFLOAT;csch;2$;53|) (QUOTE |SPADreplace|) (QUOTE CSCH)) - -(DEFUN |DFLOAT;csch;2$;53| (|x| |$|) (CSCH |x|)) - -(PUT (QUOTE |DFLOAT;coth;2$;54|) (QUOTE |SPADreplace|) (QUOTE COTH)) - -(DEFUN |DFLOAT;coth;2$;54| (|x| |$|) (COTH |x|)) - -(PUT (QUOTE |DFLOAT;sech;2$;55|) (QUOTE |SPADreplace|) (QUOTE SECH)) - -(DEFUN |DFLOAT;sech;2$;55| (|x| |$|) (SECH |x|)) - -(PUT (QUOTE |DFLOAT;asinh;2$;56|) (QUOTE |SPADreplace|) (QUOTE ASINH)) - -(DEFUN |DFLOAT;asinh;2$;56| (|x| |$|) (ASINH |x|)) - -(DEFUN |DFLOAT;acosh;2$;57| (|x| |$|) (|DFLOAT;checkComplex| (ACOSH |x|) |$|)) - -(DEFUN |DFLOAT;atanh;2$;58| (|x| |$|) (|DFLOAT;checkComplex| (ATANH |x|) |$|)) - -(PUT (QUOTE |DFLOAT;acsch;2$;59|) (QUOTE |SPADreplace|) (QUOTE ACSCH)) - -(DEFUN |DFLOAT;acsch;2$;59| (|x| |$|) (ACSCH |x|)) - -(DEFUN |DFLOAT;acoth;2$;60| (|x| |$|) (|DFLOAT;checkComplex| (ACOTH |x|) |$|)) - -(DEFUN |DFLOAT;asech;2$;61| (|x| |$|) (|DFLOAT;checkComplex| (ASECH |x|) |$|)) - -(PUT (QUOTE |DFLOAT;/;3$;62|) (QUOTE |SPADreplace|) (QUOTE |/|)) - -(DEFUN |DFLOAT;/;3$;62| (|x| |y| |$|) (|/| |x| |y|)) - -(PUT (QUOTE |DFLOAT;negative?;$B;63|) (QUOTE |SPADreplace|) (QUOTE MINUSP)) - -(DEFUN |DFLOAT;negative?;$B;63| (|x| |$|) (MINUSP |x|)) - -(PUT (QUOTE |DFLOAT;zero?;$B;64|) (QUOTE |SPADreplace|) (QUOTE ZEROP)) - -(DEFUN |DFLOAT;zero?;$B;64| (|x| |$|) (ZEROP |x|)) - -(PUT (QUOTE |DFLOAT;hash;$I;65|) (QUOTE |SPADreplace|) (QUOTE HASHEQ)) - -(DEFUN |DFLOAT;hash;$I;65| (|x| |$|) (HASHEQ |x|)) - -(DEFUN |DFLOAT;recip;$U;66| (|x| |$|) (COND ((ZEROP |x|) (CONS 1 "failed")) ((QUOTE T) (CONS 0 (|/| 1.0 |x|))))) - -(PUT (QUOTE |DFLOAT;differentiate;2$;67|) (QUOTE |SPADreplace|) (QUOTE (XLAM (|x|) 0.0))) - -(DEFUN |DFLOAT;differentiate;2$;67| (|x| |$|) 0.0) - -(DEFUN |DFLOAT;Gamma;2$;68| (|x| |$|) (SPADCALL |x| (QREFELT |$| 93))) - -(DEFUN |DFLOAT;Beta;3$;69| (|x| |y| |$|) (SPADCALL |x| |y| (QREFELT |$| 95))) - -(PUT (QUOTE |DFLOAT;wholePart;$I;70|) (QUOTE |SPADreplace|) (QUOTE FIX)) - -(DEFUN |DFLOAT;wholePart;$I;70| (|x| |$|) (FIX |x|)) - -(DEFUN |DFLOAT;float;2IPi$;71| (|ma| |ex| |b| |$|) (|*| |ma| (EXPT (FLOAT |b| |MOST-POSITIVE-LONG-FLOAT|) |ex|))) - -(PUT (QUOTE |DFLOAT;convert;2$;72|) (QUOTE |SPADreplace|) (QUOTE (XLAM (|x|) |x|))) - -(DEFUN |DFLOAT;convert;2$;72| (|x| |$|) |x|) - -(DEFUN |DFLOAT;convert;$F;73| (|x| |$|) (SPADCALL |x| (QREFELT |$| 101))) - -(DEFUN |DFLOAT;rationalApproximation;$NniF;74| (|x| |d| |$|) (SPADCALL |x| |d| 10 (QREFELT |$| 105))) - -(DEFUN |DFLOAT;atan;3$;75| (|x| |y| |$|) (PROG (|theta|) (RETURN (SEQ (COND ((|=| |x| 0.0) (COND ((|<| 0.0 |y|) (|/| PI 2)) ((|<| |y| 0.0) (|-| (|/| PI 2))) ((QUOTE T) 0.0))) ((QUOTE T) (SEQ (LETT |theta| (ATAN (|FLOAT-SIGN| 1.0 (|/| |y| |x|))) |DFLOAT;atan;3$;75|) (COND ((|<| |x| 0.0) (LETT |theta| (|-| PI |theta|) |DFLOAT;atan;3$;75|))) (COND ((|<| |y| 0.0) (LETT |theta| (|-| |theta|) |DFLOAT;atan;3$;75|))) (EXIT |theta|)))))))) - -(DEFUN |DFLOAT;retract;$F;76| (|x| |$|) (PROG (#1=#:G105780) (RETURN (SPADCALL |x| (PROG1 (LETT #1# (|-| (|FLOAT-DIGITS| 0.0) 1) |DFLOAT;retract;$F;76|) (|check-subtype| (|>=| #1# 0) (QUOTE (|NonNegativeInteger|)) #1#)) (|FLOAT-RADIX| 0.0) (QREFELT |$| 105))))) - -(DEFUN |DFLOAT;retractIfCan;$U;77| (|x| |$|) (PROG (#1=#:G105785) (RETURN (CONS 0 (SPADCALL |x| (PROG1 (LETT #1# (|-| (|FLOAT-DIGITS| 0.0) 1) |DFLOAT;retractIfCan;$U;77|) (|check-subtype| (|>=| #1# 0) (QUOTE (|NonNegativeInteger|)) #1#)) (|FLOAT-RADIX| 0.0) (QREFELT |$| 105)))))) - -(DEFUN |DFLOAT;retract;$I;78| (|x| |$|) (PROG (|n|) (RETURN (SEQ (LETT |n| (FIX |x|) |DFLOAT;retract;$I;78|) (EXIT (COND ((|=| |x| (FLOAT |n| |MOST-POSITIVE-LONG-FLOAT|)) |n|) ((QUOTE T) (|error| "Not an integer")))))))) - -(DEFUN |DFLOAT;retractIfCan;$U;79| (|x| |$|) (PROG (|n|) (RETURN (SEQ (LETT |n| (FIX |x|) |DFLOAT;retractIfCan;$U;79|) (EXIT (COND ((|=| |x| (FLOAT |n| |MOST-POSITIVE-LONG-FLOAT|)) (CONS 0 |n|)) ((QUOTE T) (CONS 1 "failed")))))))) - -(DEFUN |DFLOAT;sign;$I;80| (|x| |$|) (SPADCALL (|FLOAT-SIGN| |x| 1.0) (QREFELT |$| 111))) - -(PUT (QUOTE |DFLOAT;abs;2$;81|) (QUOTE |SPADreplace|) (QUOTE (XLAM (|x|) (|FLOAT-SIGN| 1.0 |x|)))) - -(DEFUN |DFLOAT;abs;2$;81| (|x| |$|) (|FLOAT-SIGN| 1.0 |x|)) - -(DEFUN |DFLOAT;manexp| (|x| |$|) (PROG (|s| #1=#:G105806 |me| |two53|) (RETURN (SEQ (EXIT (COND ((ZEROP |x|) (CONS 0 0)) ((QUOTE T) (SEQ (LETT |s| (SPADCALL |x| (QREFELT |$| 114)) |DFLOAT;manexp|) (LETT |x| (|FLOAT-SIGN| 1.0 |x|) |DFLOAT;manexp|) (COND ((|<| |MOST-POSITIVE-LONG-FLOAT| |x|) (PROGN (LETT #1# (CONS (|+| (|*| |s| (SPADCALL |MOST-POSITIVE-LONG-FLOAT| (QREFELT |$| 25))) 1) (SPADCALL |MOST-POSITIVE-LONG-FLOAT| (QREFELT |$| 26))) |DFLOAT;manexp|) (GO #1#)))) (LETT |me| (MANEXP |x|) |DFLOAT;manexp|) (LETT |two53| (EXPT (|FLOAT-RADIX| 0.0) (|FLOAT-DIGITS| 0.0)) |DFLOAT;manexp|) (EXIT (CONS (|*| |s| (FIX (|*| |two53| (QCAR |me|)))) (|-| (QCDR |me|) (|FLOAT-DIGITS| 0.0)))))))) #1# (EXIT #1#))))) - -(DEFUN |DFLOAT;rationalApproximation;$2NniF;83| (|f| |d| |b| |$|) (PROG (|#G102| |nu| |ex| BASE #1=#:G105809 |de| |tol| |#G103| |q| |r| |p2| |q2| #2=#:G105827 |#G104| |#G105| |p0| |p1| |#G106| |#G107| |q0| |q1| |#G108| |#G109| |s| |t| #3=#:G105825) (RETURN (SEQ (EXIT (SEQ (PROGN (LETT |#G102| (|DFLOAT;manexp| |f| |$|) |DFLOAT;rationalApproximation;$2NniF;83|) (LETT |nu| (QCAR |#G102|) |DFLOAT;rationalApproximation;$2NniF;83|) (LETT |ex| (QCDR |#G102|) |DFLOAT;rationalApproximation;$2NniF;83|) |#G102|) (LETT BASE (|FLOAT-RADIX| 0.0) |DFLOAT;rationalApproximation;$2NniF;83|) (EXIT (COND ((|<| |ex| 0) (SEQ (LETT |de| (EXPT BASE (PROG1 (LETT #1# (|-| |ex|) |DFLOAT;rationalApproximation;$2NniF;83|) (|check-subtype| (|>=| #1# 0) (QUOTE (|NonNegativeInteger|)) #1#))) |DFLOAT;rationalApproximation;$2NniF;83|) (EXIT (COND ((|<| |b| 2) (|error| "base must be > 1")) ((QUOTE T) (SEQ (LETT |tol| (EXPT |b| |d|) |DFLOAT;rationalApproximation;$2NniF;83|) (LETT |s| |nu| |DFLOAT;rationalApproximation;$2NniF;83|) (LETT |t| |de| |DFLOAT;rationalApproximation;$2NniF;83|) (LETT |p0| 0 |DFLOAT;rationalApproximation;$2NniF;83|) (LETT |p1| 1 |DFLOAT;rationalApproximation;$2NniF;83|) (LETT |q0| 1 |DFLOAT;rationalApproximation;$2NniF;83|) (LETT |q1| 0 |DFLOAT;rationalApproximation;$2NniF;83|) (EXIT (SEQ G190 NIL (SEQ (PROGN (LETT |#G103| (DIVIDE2 |s| |t|) |DFLOAT;rationalApproximation;$2NniF;83|) (LETT |q| (QCAR |#G103|) |DFLOAT;rationalApproximation;$2NniF;83|) (LETT |r| (QCDR |#G103|) |DFLOAT;rationalApproximation;$2NniF;83|) |#G103|) (LETT |p2| (|+| (|*| |q| |p1|) |p0|) |DFLOAT;rationalApproximation;$2NniF;83|) (LETT |q2| (|+| (|*| |q| |q1|) |q0|) |DFLOAT;rationalApproximation;$2NniF;83|) (COND ((OR (EQL |r| 0) (|<| (SPADCALL |tol| (ABS (|-| (|*| |nu| |q2|) (|*| |de| |p2|))) (QREFELT |$| 118)) (|*| |de| (ABS |p2|)))) (EXIT (PROGN (LETT #2# (SPADCALL |p2| |q2| (QREFELT |$| 117)) |DFLOAT;rationalApproximation;$2NniF;83|) (GO #2#))))) (PROGN (LETT |#G104| |p1| |DFLOAT;rationalApproximation;$2NniF;83|) (LETT |#G105| |p2| |DFLOAT;rationalApproximation;$2NniF;83|) (LETT |p0| |#G104| |DFLOAT;rationalApproximation;$2NniF;83|) (LETT |p1| |#G105| |DFLOAT;rationalApproximation;$2NniF;83|)) (PROGN (LETT |#G106| |q1| |DFLOAT;rationalApproximation;$2NniF;83|) (LETT |#G107| |q2| |DFLOAT;rationalApproximation;$2NniF;83|) (LETT |q0| |#G106| |DFLOAT;rationalApproximation;$2NniF;83|) (LETT |q1| |#G107| |DFLOAT;rationalApproximation;$2NniF;83|)) (EXIT (PROGN (LETT |#G108| |t| |DFLOAT;rationalApproximation;$2NniF;83|) (LETT |#G109| |r| |DFLOAT;rationalApproximation;$2NniF;83|) (LETT |s| |#G108| |DFLOAT;rationalApproximation;$2NniF;83|) (LETT |t| |#G109| |DFLOAT;rationalApproximation;$2NniF;83|)))) NIL (GO G190) G191 (EXIT NIL))))))))) ((QUOTE T) (SPADCALL (|*| |nu| (EXPT BASE (PROG1 (LETT #3# |ex| |DFLOAT;rationalApproximation;$2NniF;83|) (|check-subtype| (|>=| #3# 0) (QUOTE (|NonNegativeInteger|)) #3#)))) (QREFELT |$| 119))))))) #2# (EXIT #2#))))) - -(DEFUN |DFLOAT;**;$F$;84| (|x| |r| |$|) (PROG (|n| |d| #1=#:G105837) (RETURN (SEQ (EXIT (COND ((ZEROP |x|) (COND ((SPADCALL |r| (QREFELT |$| 120)) (|error| "0**0 is undefined")) ((SPADCALL |r| (QREFELT |$| 121)) (|error| "division by 0")) ((QUOTE T) 0.0))) ((OR (SPADCALL |r| (QREFELT |$| 120)) (SPADCALL |x| (QREFELT |$| 122))) 1.0) ((QUOTE T) (COND ((SPADCALL |r| (QREFELT |$| 123)) |x|) ((QUOTE T) (SEQ (LETT |n| (SPADCALL |r| (QREFELT |$| 124)) |DFLOAT;**;$F$;84|) (LETT |d| (SPADCALL |r| (QREFELT |$| 125)) |DFLOAT;**;$F$;84|) (EXIT (COND ((MINUSP |x|) (COND ((ODDP |d|) (COND ((ODDP |n|) (PROGN (LETT #1# (|-| (SPADCALL (|-| |x|) |r| (QREFELT |$| 126))) |DFLOAT;**;$F$;84|) (GO #1#))) ((QUOTE T) (PROGN (LETT #1# (SPADCALL (|-| |x|) |r| (QREFELT |$| 126)) |DFLOAT;**;$F$;84|) (GO #1#))))) ((QUOTE T) (|error| "negative root")))) ((EQL |d| 2) (EXPT (SPADCALL |x| (QREFELT |$| 54)) |n|)) ((QUOTE T) (SPADCALL |x| (|/| (FLOAT |n| |MOST-POSITIVE-LONG-FLOAT|) (FLOAT |d| |MOST-POSITIVE-LONG-FLOAT|)) (QREFELT |$| 57))))))))))) #1# (EXIT #1#))))) - -(DEFUN |DoubleFloat| NIL (PROG NIL (RETURN (PROG (#1=#:G105850) (RETURN (COND ((LETT #1# (HGET |$ConstructorCache| (QUOTE |DoubleFloat|)) |DoubleFloat|) (|CDRwithIncrement| (CDAR #1#))) ((QUOTE T) (|UNWIND-PROTECT| (PROG1 (CDDAR (HPUT |$ConstructorCache| (QUOTE |DoubleFloat|) (LIST (CONS NIL (CONS 1 (|DoubleFloat;|)))))) (LETT #1# T |DoubleFloat|)) (COND ((NOT #1#) (HREM |$ConstructorCache| (QUOTE |DoubleFloat|)))))))))))) - -(DEFUN |DoubleFloat;| NIL (PROG (|dv$| |$| |pv$|) (RETURN (PROGN (LETT |dv$| (QUOTE (|DoubleFloat|)) . #1=(|DoubleFloat|)) (LETT |$| (GETREFV 140) . #1#) (QSETREFV |$| 0 |dv$|) (QSETREFV |$| 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #1#)) (|haddProp| |$ConstructorCache| (QUOTE |DoubleFloat|) NIL (CONS 1 |$|)) (|stuffDomainSlots| |$|) |$|)))) - -(MAKEPROP (QUOTE |DoubleFloat|) (QUOTE |infovec|) (LIST (QUOTE #(NIL NIL NIL NIL NIL NIL (|OpenMathEncoding|) (0 . |OMencodingXML|) (|String|) (|OpenMathDevice|) (4 . |OMopenString|) (|Void|) (10 . |OMputObject|) (|DoubleFloat|) (15 . |OMputFloat|) (21 . |OMputEndObject|) (26 . |OMclose|) |DFLOAT;OMwrite;$S;1| (|Boolean|) |DFLOAT;OMwrite;$BS;2| |DFLOAT;OMwrite;Omd$V;3| |DFLOAT;OMwrite;Omd$BV;4| (|PositiveInteger|) |DFLOAT;base;Pi;6| (|Integer|) |DFLOAT;mantissa;$I;7| |DFLOAT;exponent;$I;8| |DFLOAT;precision;Pi;9| |DFLOAT;log2;2$;37| (31 . |*|) |DFLOAT;bits;Pi;10| |DFLOAT;max;$;11| |DFLOAT;min;$;12| |DFLOAT;order;$I;13| (CONS IDENTITY (FUNCALL (|dispatchFunction| |DFLOAT;Zero;$;14|) |$|)) (CONS IDENTITY (FUNCALL (|dispatchFunction| |DFLOAT;One;$;15|) |$|)) |DFLOAT;exp1;$;16| |DFLOAT;pi;$;17| (|OutputForm|) (37 . |outputForm|) |DFLOAT;coerce;$Of;18| (|InputForm|) (42 . |convert|) |DFLOAT;convert;$If;19| |DFLOAT;<;2$B;20| |DFLOAT;-;2$;21| |DFLOAT;+;3$;22| |DFLOAT;-;3$;23| |DFLOAT;*;3$;24| |DFLOAT;*;I2$;25| |DFLOAT;max;3$;26| |DFLOAT;min;3$;27| |DFLOAT;=;2$B;28| |DFLOAT;/;$I$;29| |DFLOAT;sqrt;2$;30| |DFLOAT;log10;2$;31| |DFLOAT;**;$I$;32| |DFLOAT;**;3$;33| |DFLOAT;coerce;I$;34| |DFLOAT;exp;2$;35| |DFLOAT;log;2$;36| |DFLOAT;sin;2$;38| |DFLOAT;cos;2$;39| |DFLOAT;tan;2$;40| |DFLOAT;cot;2$;41| |DFLOAT;sec;2$;42| |DFLOAT;csc;2$;43| |DFLOAT;asin;2$;44| |DFLOAT;acos;2$;45| |DFLOAT;atan;2$;46| |DFLOAT;acsc;2$;47| |DFLOAT;acot;2$;48| |DFLOAT;asec;2$;49| |DFLOAT;sinh;2$;50| |DFLOAT;cosh;2$;51| |DFLOAT;tanh;2$;52| |DFLOAT;csch;2$;53| |DFLOAT;coth;2$;54| |DFLOAT;sech;2$;55| |DFLOAT;asinh;2$;56| |DFLOAT;acosh;2$;57| |DFLOAT;atanh;2$;58| |DFLOAT;acsch;2$;59| |DFLOAT;acoth;2$;60| |DFLOAT;asech;2$;61| |DFLOAT;/;3$;62| |DFLOAT;negative?;$B;63| |DFLOAT;zero?;$B;64| |DFLOAT;hash;$I;65| (|Union| |$| (QUOTE "failed")) |DFLOAT;recip;$U;66| |DFLOAT;differentiate;2$;67| (|DoubleFloatSpecialFunctions|) (47 . |Gamma|) |DFLOAT;Gamma;2$;68| (52 . |Beta|) |DFLOAT;Beta;3$;69| |DFLOAT;wholePart;$I;70| |DFLOAT;float;2IPi$;71| |DFLOAT;convert;2$;72| (|Float|) (58 . |convert|) |DFLOAT;convert;$F;73| (|Fraction| 24) (|NonNegativeInteger|) |DFLOAT;rationalApproximation;$2NniF;83| |DFLOAT;rationalApproximation;$NniF;74| |DFLOAT;atan;3$;75| |DFLOAT;retract;$F;76| (|Union| 103 (QUOTE "failed")) |DFLOAT;retractIfCan;$U;77| |DFLOAT;retract;$I;78| (|Union| 24 (QUOTE "failed")) |DFLOAT;retractIfCan;$U;79| |DFLOAT;sign;$I;80| |DFLOAT;abs;2$;81| (63 . |Zero|) (67 . |/|) (73 . |*|) (79 . |coerce|) (84 . |zero?|) (89 . |negative?|) (94 . |one?|) (99 . |one?|) (104 . |numer|) (109 . |denom|) |DFLOAT;**;$F$;84| (|Pattern| 100) (|PatternMatchResult| 100 |$|) (|Factored| |$|) (|Union| 131 (QUOTE "failed")) (|List| |$|) (|Record| (|:| |coef1| |$|) (|:| |coef2| |$|) (|:| |generator| |$|)) (|Record| (|:| |coef1| |$|) (|:| |coef2| |$|)) (|Union| 133 (QUOTE "failed")) (|Record| (|:| |quotient| |$|) (|:| |remainder| |$|)) (|Record| (|:| |coef| 131) (|:| |generator| |$|)) (|SparseUnivariatePolynomial| |$|) (|Record| (|:| |unit| |$|) (|:| |canonical| |$|) (|:| |associate| |$|)) (|SingleInteger|))) (QUOTE #(|~=| 114 |zero?| 120 |wholePart| 125 |unitNormal| 130 |unitCanonical| 135 |unit?| 140 |truncate| 145 |tanh| 150 |tan| 155 |subtractIfCan| 160 |squareFreePart| 166 |squareFree| 171 |sqrt| 176 |sizeLess?| 181 |sinh| 187 |sin| 192 |sign| 197 |sech| 202 |sec| 207 |sample| 212 |round| 216 |retractIfCan| 221 |retract| 231 |rem| 241 |recip| 247 |rationalApproximation| 252 |quo| 265 |principalIdeal| 271 |prime?| 276 |precision| 281 |positive?| 285 |pi| 290 |patternMatch| 294 |order| 301 |one?| 306 |nthRoot| 311 |norm| 317 |negative?| 322 |multiEuclidean| 327 |min| 333 |max| 343 |mantissa| 353 |log2| 358 |log10| 363 |log| 368 |lcm| 373 |latex| 384 |inv| 389 |hash| 394 |gcdPolynomial| 404 |gcd| 410 |fractionPart| 421 |floor| 426 |float| 431 |factor| 444 |extendedEuclidean| 449 |exquo| 462 |expressIdealMember| 468 |exponent| 474 |exp1| 479 |exp| 483 |euclideanSize| 488 |divide| 493 |digits| 499 |differentiate| 503 |csch| 514 |csc| 519 |coth| 524 |cot| 529 |cosh| 534 |cos| 539 |convert| 544 |coerce| 564 |characteristic| 594 |ceiling| 598 |bits| 603 |base| 607 |atanh| 611 |atan| 616 |associates?| 627 |asinh| 633 |asin| 638 |asech| 643 |asec| 648 |acsch| 653 |acsc| 658 |acoth| 663 |acot| 668 |acosh| 673 |acos| 678 |abs| 683 |^| 688 |Zero| 706 |One| 710 |OMwrite| 714 |Gamma| 738 D 743 |Beta| 754 |>=| 760 |>| 766 |=| 772 |<=| 778 |<| 784 |/| 790 |-| 802 |+| 813 |**| 819 |*| 849)) (QUOTE ((|approximate| . 0) (|canonicalsClosed| . 0) (|canonicalUnitNormal| . 0) (|noZeroDivisors| . 0) ((|commutative| "*") . 0) (|rightUnitary| . 0) (|leftUnitary| . 0) (|unitsKnown| . 0))) (CONS (|makeByteWordVec2| 1 (QUOTE (0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0))) (CONS (QUOTE #(|FloatingPointSystem&| |RealNumberSystem&| |Field&| |EuclideanDomain&| NIL |UniqueFactorizationDomain&| |GcdDomain&| |DivisionRing&| |IntegralDomain&| |Algebra&| |Algebra&| |DifferentialRing&| NIL |OrderedRing&| |Module&| NIL NIL |Module&| NIL NIL NIL |Ring&| NIL NIL NIL NIL NIL NIL NIL |AbelianGroup&| NIL NIL |AbelianMonoid&| |Monoid&| NIL |OrderedSet&| |AbelianSemiGroup&| |SemiGroup&| |TranscendentalFunctionCategory&| NIL |SetCategory&| NIL |ElementaryFunctionCategory&| NIL |HyperbolicFunctionCategory&| |ArcTrigonometricFunctionCategory&| |TrigonometricFunctionCategory&| NIL NIL |RadicalCategory&| |RetractableTo&| |RetractableTo&| NIL NIL |BasicType&| NIL)) (CONS (QUOTE #((|FloatingPointSystem|) (|RealNumberSystem|) (|Field|) (|EuclideanDomain|) (|PrincipalIdealDomain|) (|UniqueFactorizationDomain|) (|GcdDomain|) (|DivisionRing|) (|IntegralDomain|) (|Algebra| 103) (|Algebra| |$$|) (|DifferentialRing|) (|CharacteristicZero|) (|OrderedRing|) (|Module| 103) (|EntireRing|) (|CommutativeRing|) (|Module| |$$|) (|OrderedAbelianGroup|) (|BiModule| 103 103) (|BiModule| |$$| |$$|) (|Ring|) (|OrderedCancellationAbelianMonoid|) (|RightModule| 103) (|LeftModule| 103) (|LeftModule| |$$|) (|Rng|) (|RightModule| |$$|) (|OrderedAbelianMonoid|) (|AbelianGroup|) (|OrderedAbelianSemiGroup|) (|CancellationAbelianMonoid|) (|AbelianMonoid|) (|Monoid|) (|PatternMatchable| 100) (|OrderedSet|) (|AbelianSemiGroup|) (|SemiGroup|) (|TranscendentalFunctionCategory|) (|RealConstant|) (|SetCategory|) (|ConvertibleTo| 41) (|ElementaryFunctionCategory|) (|ArcHyperbolicFunctionCategory|) (|HyperbolicFunctionCategory|) (|ArcTrigonometricFunctionCategory|) (|TrigonometricFunctionCategory|) (|OpenMath|) (|ConvertibleTo| 127) (|RadicalCategory|) (|RetractableTo| 103) (|RetractableTo| 24) (|ConvertibleTo| 100) (|ConvertibleTo| 13) (|BasicType|) (|CoercibleTo| 38))) (|makeByteWordVec2| 139 (QUOTE (0 6 0 7 2 9 0 8 6 10 1 9 11 0 12 2 9 11 0 13 14 1 9 11 0 15 1 9 11 0 16 2 0 0 22 0 29 1 38 0 13 39 1 41 0 13 42 1 92 13 13 93 2 92 13 13 13 95 1 100 0 13 101 0 103 0 116 2 103 0 24 24 117 2 24 0 104 0 118 1 103 0 24 119 1 103 18 0 120 1 103 18 0 121 1 0 18 0 122 1 103 18 0 123 1 103 24 0 124 1 103 24 0 125 2 0 18 0 0 1 1 0 18 0 87 1 0 24 0 97 1 0 138 0 1 1 0 0 0 1 1 0 18 0 1 1 0 0 0 1 1 0 0 0 75 1 0 0 0 63 2 0 89 0 0 1 1 0 0 0 1 1 0 129 0 1 1 0 0 0 54 2 0 18 0 0 1 1 0 0 0 73 1 0 0 0 61 1 0 24 0 114 1 0 0 0 78 1 0 0 0 65 0 0 0 1 1 0 0 0 1 1 0 109 0 110 1 0 112 0 113 1 0 103 0 108 1 0 24 0 111 2 0 0 0 0 1 1 0 89 0 90 2 0 103 0 104 106 3 0 103 0 104 104 105 2 0 0 0 0 1 1 0 136 131 1 1 0 18 0 1 0 0 22 27 1 0 18 0 1 0 0 0 37 3 0 128 0 127 128 1 1 0 24 0 33 1 0 18 0 122 2 0 0 0 24 1 1 0 0 0 1 1 0 18 0 86 2 0 130 131 0 1 0 0 0 32 2 0 0 0 0 51 0 0 0 31 2 0 0 0 0 50 1 0 24 0 25 1 0 0 0 28 1 0 0 0 55 1 0 0 0 60 1 0 0 131 1 2 0 0 0 0 1 1 0 8 0 1 1 0 0 0 1 1 0 24 0 88 1 0 139 0 1 2 0 137 137 137 1 1 0 0 131 1 2 0 0 0 0 1 1 0 0 0 1 1 0 0 0 1 3 0 0 24 24 22 98 2 0 0 24 24 1 1 0 129 0 1 2 0 132 0 0 1 3 0 134 0 0 0 1 2 0 89 0 0 1 2 0 130 131 0 1 1 0 24 0 26 0 0 0 36 1 0 0 0 59 1 0 104 0 1 2 0 135 0 0 1 0 0 22 1 1 0 0 0 91 2 0 0 0 104 1 1 0 0 0 76 1 0 0 0 66 1 0 0 0 77 1 0 0 0 64 1 0 0 0 74 1 0 0 0 62 1 0 41 0 43 1 0 127 0 1 1 0 13 0 99 1 0 100 0 102 1 0 0 103 1 1 0 0 24 58 1 0 0 103 1 1 0 0 24 58 1 0 0 0 1 1 0 38 0 40 0 0 104 1 1 0 0 0 1 0 0 22 30 0 0 22 23 1 0 0 0 81 2 0 0 0 0 107 1 0 0 0 69 2 0 18 0 0 1 1 0 0 0 79 1 0 0 0 67 1 0 0 0 84 1 0 0 0 72 1 0 0 0 82 1 0 0 0 70 1 0 0 0 83 1 0 0 0 71 1 0 0 0 80 1 0 0 0 68 1 0 0 0 115 2 0 0 0 24 1 2 0 0 0 104 1 2 0 0 0 22 1 0 0 0 34 0 0 0 35 2 0 11 9 0 20 3 0 11 9 0 18 21 1 0 8 0 17 2 0 8 0 18 19 1 0 0 0 94 1 0 0 0 1 2 0 0 0 104 1 2 0 0 0 0 96 2 0 18 0 0 1 2 0 18 0 0 1 2 0 18 0 0 52 2 0 18 0 0 1 2 0 18 0 0 44 2 0 0 0 24 53 2 0 0 0 0 85 2 0 0 0 0 47 1 0 0 0 45 2 0 0 0 0 46 2 0 0 0 0 57 2 0 0 0 103 126 2 0 0 0 24 56 2 0 0 0 104 1 2 0 0 0 22 1 2 0 0 0 103 1 2 0 0 103 0 1 2 0 0 0 0 48 2 0 0 24 0 49 2 0 0 104 0 1 2 0 0 22 0 29)))))) (QUOTE |lookupComplete|))) - -(MAKEPROP (QUOTE |DoubleFloat|) (QUOTE NILADIC) T) -@ -\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} Steele, Guy L. Jr. ``Common Lisp The Language'' -Second Edition 1990 ISBN 1-55558-041-6 Digital Press -\end{thebibliography} -\end{document} diff --git a/src/algebra/si.spad.pamphlet b/src/algebra/si.spad.pamphlet deleted file mode 100644 index 7d63f61..0000000 --- a/src/algebra/si.spad.pamphlet +++ /dev/null @@ -1,1115 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra si.spad} -\author{Stephen M. Watt, Michael Monagan, James Davenport, Barry Trager} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{domain SINT SingleInteger} -The definition of {\bf one?} has been rewritten -as it relies on calling {\bf ONEP} which is a function specific -to Codemist Common Lisp but is not defined in Common Lisp. -<>= --- si.spad.pamphlet SingleInteger.input -)spool SingleInteger.output -)set message test on -)set message auto off -)clear all ---S 1 of 11 -min()$SingleInteger ---R ---R ---R (1) - 2147483648 ---R Type: SingleInteger ---E 1 - ---S 2 of 11 -max()$SingleInteger ---R ---R ---R (2) 2147483647 ---R Type: SingleInteger ---E 2 - ---S 3 of 11 -a := 1234 :: SingleInteger ---R ---R ---R (3) 1234 ---R Type: SingleInteger ---E 3 - ---S 4 of 11 -b := 124$SingleInteger ---R ---R ---R (4) 124 ---R Type: SingleInteger ---E 4 - ---S 5 of 11 -gcd(a,b) ---R ---R ---R (5) 2 ---R Type: SingleInteger ---E 5 - ---S 6 of 11 -lcm(a,b) ---R ---R ---R (6) 76508 ---R Type: SingleInteger ---E 6 - ---S 7 of 11 -mulmod(5,6,13)$SingleInteger ---R ---R ---R (7) 4 ---R Type: SingleInteger ---E 7 - ---S 8 of 11 -positiveRemainder(37,13)$SingleInteger ---R ---R ---R (8) 11 ---R Type: SingleInteger ---E 8 - ---S 9 of 11 -And(3,4)$SingleInteger ---R ---R ---R (9) 0 ---R Type: SingleInteger ---E 9 - ---S 10 of 11 -shift(1,4)$SingleInteger ---R ---R ---R (10) 16 ---R Type: SingleInteger ---E 10 - ---S 11 of 11 -shift(31,-1)$SingleInteger ---R ---R ---R (11) 15 ---R Type: SingleInteger ---E 11 -)spool -)lisp (bye) -@ -<>= -==================================================================== -SingleInteger examples -==================================================================== - -The SingleInteger domain is intended to provide support in Axiom -for machine integer arithmetic. It is generally much faster than -(bignum) Integer arithmetic but suffers from a limited range of -values. Since Axiom can be implemented on top of various dialects of -Lisp, the actual representation of small integers may not correspond -exactly to the host machines integer representation. - -You can discover the minimum and maximum values in your implementation -by using min and max. - - min()$SingleInteger - - 2147483648 - Type: SingleInteger - - max()$SingleInteger - 2147483647 - Type: SingleInteger - -To avoid confusion with Integer, which is the default type for -integers, you usually need to work with declared variables. - - a := 1234 :: SingleInteger - 1234 - Type: SingleInteger - -or use package calling - - b := 124$SingleInteger - 124 - Type: SingleInteger - -You can add, multiply and subtract SingleInteger objects, and ask for -the greatest common divisor (gcd). - - gcd(a,b) - 2 - Type: SingleInteger - -The least common multiple (lcm) is also available. - - lcm(a,b) - 76508 - Type: SingleInteger - -Operations mulmod, addmod, submod, and invmod are similar - they provide -arithmetic modulo a given small integer. -Here is 5 * 6 mod 13. - - mulmod(5,6,13)$SingleInteger - 4 - Type: SingleInteger - -To reduce a small integer modulo a prime, use positiveRemainder. - - positiveRemainder(37,13)$SingleInteger - 11 - Type: SingleInteger - -Operations And, Or, xor, and Not provide bit level operations on small -integers. - - And(3,4)$SingleInteger - 0 - Type: SingleInteger - -Use shift(int,numToShift) to shift bits, where i is shifted left if -numToShift is positive, right if negative. - - shift(1,4)$SingleInteger - 16 - Type: SingleInteger - - shift(31,-1)$SingleInteger - 15 - Type: SingleInteger - -Many other operations are available for small integers, including many -of those provided for Integer. - -See Also: -o )help Integer -o )show SingleInteger -o $AXIOM/doc/src/algebra/si.spad.dvi - -@ -<>= -"SINT" -> "INS" -"SingleInteger()" -> "IntegerNumberSystem()" -"SINT" -> "LOGIC" -"SingleInteger()" -> "Logic()" -"SINT" -> "OM" -"SingleInteger()" -> "OpenMath()" -@ -<>= -)abbrev domain SINT SingleInteger - --- following patch needed to deal with *:(I,%) -> % --- affects behavior of SourceLevelSubset ---)bo $noSubsets := true --- No longer - JHD !! still needed 5/3/91 BMT - -++ Author: Michael Monagan -++ Date Created: -++ January 1988 -++ Change History: -++ Basic Operations: max, min, -++ not, and, or, xor, Not, And, Or -++ Related Constructors: -++ Keywords: single integer -++ Description: SingleInteger is intended to support machine integer -++ arithmetic. - --- MAXINT, BASE (machine integer constants) --- MODULUS, MULTIPLIER (random number generator constants) - - --- Lisp dependencies --- EQ, ABSVAL, TIMES, INTEGER-LENGTH, HASHEQ, REMAINDER --- QSLESSP, QSGREATERP, QSADD1, QSSUB1, QSMINUS, QSPLUS, QSDIFFERENCE --- QSTIMES, QSREMAINDER, QSODDP, QSZEROP, QSMAX, QSMIN, QSNOT, QSAND --- QSOR, QSXOR, QSLEFTSHIFT, QSADDMOD, QSDIFMOD, QSMULTMOD - - -SingleInteger(): Join(IntegerNumberSystem,Logic,OpenMath) with - canonical - ++ \spad{canonical} means that mathematical equality is - ++ implied by data structure equality. - canonicalsClosed - ++ \spad{canonicalClosed} means two positives multiply to - ++ give positive. - noetherian - ++ \spad{noetherian} all ideals are finitely generated - ++ (in fact principal). - - max : () -> % - ++ max() returns the largest single integer. - min : () -> % - ++ min() returns the smallest single integer. - - -- bit operations - "not": % -> % - ++ not(n) returns the bit-by-bit logical {\em not} of the single integer n. - "~" : % -> % - ++ ~ n returns the bit-by-bit logical {\em not } of the single integer n. - "/\": (%, %) -> % - ++ n /\ m returns the bit-by-bit logical {\em and} of - ++ the single integers n and m. - "\/" : (%, %) -> % - ++ n \/ m returns the bit-by-bit logical {\em or} of - ++ the single integers n and m. - "xor": (%, %) -> % - ++ xor(n,m) returns the bit-by-bit logical {\em xor} of - ++ the single integers n and m. - Not : % -> % - ++ Not(n) returns the bit-by-bit logical {\em not} of the single integer n. - And : (%,%) -> % - ++ And(n,m) returns the bit-by-bit logical {\em and} of - ++ the single integers n and m. - Or : (%,%) -> % - ++ Or(n,m) returns the bit-by-bit logical {\em or} of - ++ the single integers n and m. - - == add - - seed : % := 1$Lisp -- for random() - MAXINT ==> MOST_-POSITIVE_-FIXNUM$Lisp - MININT ==> MOST_-NEGATIVE_-FIXNUM$Lisp - BASE ==> 67108864$Lisp -- 2**26 - MULTIPLIER ==> 314159269$Lisp -- from Knuth's table - MODULUS ==> 2147483647$Lisp -- 2**31-1 - - writeOMSingleInt(dev: OpenMathDevice, x: %): Void == - if x < 0 then - OMputApp(dev) - OMputSymbol(dev, "arith1", "unary_minus") - OMputInteger(dev, convert(-x)) - OMputEndApp(dev) - else - OMputInteger(dev, convert(x)) - - OMwrite(x: %): String == - s: String := "" - sp := OM_-STRINGTOSTRINGPTR(s)$Lisp - dev: OpenMathDevice := OMopenString(sp pretend String, OMencodingXML) - OMputObject(dev) - writeOMSingleInt(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) - writeOMSingleInt(dev, x) - if wholeObj then - OMputEndObject(dev) - OMclose(dev) - s := OM_-STRINGPTRTOSTRING(sp)$Lisp pretend String - s - - OMwrite(dev: OpenMathDevice, x: %): Void == - OMputObject(dev) - writeOMSingleInt(dev, x) - OMputEndObject(dev) - - OMwrite(dev: OpenMathDevice, x: %, wholeObj: Boolean): Void == - if wholeObj then - OMputObject(dev) - writeOMSingleInt(dev, x) - if wholeObj then - OMputEndObject(dev) - - reducedSystem m == m pretend Matrix(Integer) - coerce(x):OutputForm == (convert(x)@Integer)::OutputForm - convert(x:%):Integer == x pretend Integer - i:Integer * y:% == i::% * y - 0 == 0$Lisp - 1 == 1$Lisp - base() == 2$Lisp - max() == MAXINT - min() == MININT - x = y == EQL(x,y)$Lisp - _~ x == LOGNOT(x)$Lisp - not(x) == LOGNOT(x)$Lisp - _/_\(x,y) == LOGAND(x,y)$Lisp - _\_/(x,y) == LOGIOR(x,y)$Lisp - Not(x) == LOGNOT(x)$Lisp - And(x,y) == LOGAND(x,y)$Lisp - Or(x,y) == LOGIOR(x,y)$Lisp - xor(x,y) == LOGXOR(x,y)$Lisp - x < y == QSLESSP(x,y)$Lisp - inc x == QSADD1(x)$Lisp - dec x == QSSUB1(x)$Lisp - - x == QSMINUS(x)$Lisp - x + y == QSPLUS(x,y)$Lisp - x:% - y:% == QSDIFFERENCE(x,y)$Lisp - x:% * y:% == QSTIMES(x,y)$Lisp - x:% ** n:NonNegativeInteger == ((EXPT(x, n)$Lisp) pretend Integer)::% - x quo y == QSQUOTIENT(x,y)$Lisp - x rem y == QSREMAINDER(x,y)$Lisp - divide(x, y) == CONS(QSQUOTIENT(x,y)$Lisp,QSREMAINDER(x,y)$Lisp)$Lisp - gcd(x,y) == GCD(x,y)$Lisp - abs(x) == QSABSVAL(x)$Lisp - odd?(x) == QSODDP(x)$Lisp - zero?(x) == QSZEROP(x)$Lisp --- one?(x) == ONEP(x)$Lisp - one?(x) == x = 1 - max(x,y) == QSMAX(x,y)$Lisp - min(x,y) == QSMIN(x,y)$Lisp - hash(x) == HASHEQ(x)$Lisp - length(x) == INTEGER_-LENGTH(x)$Lisp - shift(x,n) == QSLEFTSHIFT(x,n)$Lisp - mulmod(a,b,p) == QSMULTMOD(a,b,p)$Lisp - addmod(a,b,p) == QSADDMOD(a,b,p)$Lisp - submod(a,b,p) == QSDIFMOD(a,b,p)$Lisp - negative?(x) == QSMINUSP$Lisp x - - - reducedSystem(m, v) == - [m pretend Matrix(Integer), v pretend Vector(Integer)] - - positiveRemainder(x,n) == - r := QSREMAINDER(x,n)$Lisp - QSMINUSP(r)$Lisp => - QSMINUSP(n)$Lisp => QSDIFFERENCE(x, n)$Lisp - QSPLUS(r, n)$Lisp - r - - coerce(x:Integer):% == - (x <= max pretend Integer) and (x >= min pretend Integer) => - x pretend % - error "integer too large to represent in a machine word" - - random() == - seed := REMAINDER(TIMES(MULTIPLIER,seed)$Lisp,MODULUS)$Lisp - REMAINDER(seed,BASE)$Lisp - - random(n) == RANDOM(n)$Lisp - - UCA ==> Record(unit:%,canonical:%,associate:%) - unitNormal x == - x < 0 => [-1,-x,-1]$UCA - [1,x,1]$UCA - -)bo $noSubsets := false - -@ -\section{SINT.lsp BOOTSTRAP} -<>= - -(/VERSIONCHECK 2) - -(DEFUN |SINT;writeOMSingleInt| (|dev| |x| $) - (SEQ - (COND - ((QSLESSP |x| 0) - (SEQ - (SPADCALL |dev| (QREFELT $ 9)) - (SPADCALL |dev| "arith1" "unaryminus" (QREFELT $ 11)) - (SPADCALL |dev| (QSMINUS |x|) (QREFELT $ 13)) - (EXIT (SPADCALL |dev| (QREFELT $ 14))))) - ((QUOTE T) (SPADCALL |dev| |x| (QREFELT $ 13)))))) - -(DEFUN |SINT;OMwrite;$S;2| (|x| $) - (PROG (|sp| |dev| |s|) - (RETURN - (SEQ - (LETT |s| "" |SINT;OMwrite;$S;2|) - (LETT |sp| (OM-STRINGTOSTRINGPTR |s|) |SINT;OMwrite;$S;2|) - (LETT |dev| - (SPADCALL |sp| (SPADCALL (QREFELT $ 16)) (QREFELT $ 17)) - |SINT;OMwrite;$S;2|) - (SPADCALL |dev| (QREFELT $ 18)) - (|SINT;writeOMSingleInt| |dev| |x| $) - (SPADCALL |dev| (QREFELT $ 19)) - (SPADCALL |dev| (QREFELT $ 20)) - (LETT |s| (OM-STRINGPTRTOSTRING |sp|) |SINT;OMwrite;$S;2|) - (EXIT |s|))))) - -(DEFUN |SINT;OMwrite;$BS;3| (|x| |wholeObj| $) - (PROG (|sp| |dev| |s|) - (RETURN - (SEQ - (LETT |s| "" |SINT;OMwrite;$BS;3|) - (LETT |sp| (OM-STRINGTOSTRINGPTR |s|) |SINT;OMwrite;$BS;3|) - (LETT |dev| - (SPADCALL |sp| (SPADCALL (QREFELT $ 16)) (QREFELT $ 17)) - |SINT;OMwrite;$BS;3|) - (COND (|wholeObj| (SPADCALL |dev| (QREFELT $ 18)))) - (|SINT;writeOMSingleInt| |dev| |x| $) - (COND (|wholeObj| (SPADCALL |dev| (QREFELT $ 19)))) - (SPADCALL |dev| (QREFELT $ 20)) - (LETT |s| (OM-STRINGPTRTOSTRING |sp|) |SINT;OMwrite;$BS;3|) - (EXIT |s|))))) - -(DEFUN |SINT;OMwrite;Omd$V;4| (|dev| |x| $) - (SEQ - (SPADCALL |dev| (QREFELT $ 18)) - (|SINT;writeOMSingleInt| |dev| |x| $) - (EXIT (SPADCALL |dev| (QREFELT $ 19))))) - -(DEFUN |SINT;OMwrite;Omd$BV;5| (|dev| |x| |wholeObj| $) - (SEQ - (COND (|wholeObj| (SPADCALL |dev| (QREFELT $ 18)))) - (|SINT;writeOMSingleInt| |dev| |x| $) - (EXIT (COND (|wholeObj| (SPADCALL |dev| (QREFELT $ 19))))))) - -(PUT - (QUOTE |SINT;reducedSystem;MM;6|) - (QUOTE |SPADreplace|) - (QUOTE (XLAM (|m|) |m|))) - -(DEFUN |SINT;reducedSystem;MM;6| (|m| $) |m|) - -(DEFUN |SINT;coerce;$Of;7| (|x| $) - (SPADCALL |x| (QREFELT $ 30))) - -(PUT - (QUOTE |SINT;convert;$I;8|) - (QUOTE |SPADreplace|) - (QUOTE (XLAM (|x|) |x|))) - -(DEFUN |SINT;convert;$I;8| (|x| $) |x|) - -(DEFUN |SINT;*;I2$;9| (|i| |y| $) - (QSTIMES (SPADCALL |i| (QREFELT $ 33)) |y|)) - -(PUT - (QUOTE |SINT;Zero;$;10|) - (QUOTE |SPADreplace|) - (QUOTE (XLAM NIL 0))) - -(DEFUN |SINT;Zero;$;10| ($) 0) - -(PUT - (QUOTE |SINT;One;$;11|) - (QUOTE |SPADreplace|) - (QUOTE (XLAM NIL 1))) - -(DEFUN |SINT;One;$;11| ($) 1) - -(PUT - (QUOTE |SINT;base;$;12|) - (QUOTE |SPADreplace|) - (QUOTE (XLAM NIL 2))) - -(DEFUN |SINT;base;$;12| ($) 2) - -(PUT - (QUOTE |SINT;max;$;13|) - (QUOTE |SPADreplace|) - (QUOTE (XLAM NIL MOST-POSITIVE-FIXNUM))) - -(DEFUN |SINT;max;$;13| ($) MOST-POSITIVE-FIXNUM) - -(PUT - (QUOTE |SINT;min;$;14|) - (QUOTE |SPADreplace|) - (QUOTE (XLAM NIL MOST-NEGATIVE-FIXNUM))) - -(DEFUN |SINT;min;$;14| ($) MOST-NEGATIVE-FIXNUM) - -(PUT - (QUOTE |SINT;=;2$B;15|) - (QUOTE |SPADreplace|) - (QUOTE EQL)) - -(DEFUN |SINT;=;2$B;15| (|x| |y| $) - (EQL |x| |y|)) - -(PUT - (QUOTE |SINT;~;2$;16|) - (QUOTE |SPADreplace|) - (QUOTE LOGNOT)) - -(DEFUN |SINT;~;2$;16| (|x| $) - (LOGNOT |x|)) - -(PUT - (QUOTE |SINT;not;2$;17|) - (QUOTE |SPADreplace|) - (QUOTE LOGNOT)) - -(DEFUN |SINT;not;2$;17| (|x| $) - (LOGNOT |x|)) - -(PUT - (QUOTE |SINT;/\\;3$;18|) - (QUOTE |SPADreplace|) - (QUOTE LOGAND)) - -(DEFUN |SINT;/\\;3$;18| (|x| |y| $) - (LOGAND |x| |y|)) - -(PUT - (QUOTE |SINT;\\/;3$;19|) - (QUOTE |SPADreplace|) - (QUOTE LOGIOR)) - -(DEFUN |SINT;\\/;3$;19| (|x| |y| $) - (LOGIOR |x| |y|)) - -(PUT - (QUOTE |SINT;Not;2$;20|) - (QUOTE |SPADreplace|) - (QUOTE LOGNOT)) - -(DEFUN |SINT;Not;2$;20| (|x| $) - (LOGNOT |x|)) - -(PUT - (QUOTE |SINT;And;3$;21|) - (QUOTE |SPADreplace|) - (QUOTE LOGAND)) - -(DEFUN |SINT;And;3$;21| (|x| |y| $) - (LOGAND |x| |y|)) - -(PUT - (QUOTE |SINT;Or;3$;22|) - (QUOTE |SPADreplace|) - (QUOTE LOGIOR)) - -(DEFUN |SINT;Or;3$;22| (|x| |y| $) - (LOGIOR |x| |y|)) - -(PUT - (QUOTE |SINT;xor;3$;23|) - (QUOTE |SPADreplace|) - (QUOTE LOGXOR)) - -(DEFUN |SINT;xor;3$;23| (|x| |y| $) - (LOGXOR |x| |y|)) - -(PUT - (QUOTE |SINT;<;2$B;24|) - (QUOTE |SPADreplace|) - (QUOTE QSLESSP)) - -(DEFUN |SINT;<;2$B;24| (|x| |y| $) - (QSLESSP |x| |y|)) - -(PUT - (QUOTE |SINT;inc;2$;25|) - (QUOTE |SPADreplace|) - (QUOTE QSADD1)) - -(DEFUN |SINT;inc;2$;25| (|x| $) - (QSADD1 |x|)) - -(PUT - (QUOTE |SINT;dec;2$;26|) - (QUOTE |SPADreplace|) - (QUOTE QSSUB1)) - -(DEFUN |SINT;dec;2$;26| (|x| $) - (QSSUB1 |x|)) - -(PUT - (QUOTE |SINT;-;2$;27|) - (QUOTE |SPADreplace|) - (QUOTE QSMINUS)) - -(DEFUN |SINT;-;2$;27| (|x| $) - (QSMINUS |x|)) - -(PUT - (QUOTE |SINT;+;3$;28|) - (QUOTE |SPADreplace|) - (QUOTE QSPLUS)) - -(DEFUN |SINT;+;3$;28| (|x| |y| $) - (QSPLUS |x| |y|)) - -(PUT - (QUOTE |SINT;-;3$;29|) - (QUOTE |SPADreplace|) - (QUOTE QSDIFFERENCE)) - -(DEFUN |SINT;-;3$;29| (|x| |y| $) - (QSDIFFERENCE |x| |y|)) - -(PUT - (QUOTE |SINT;*;3$;30|) - (QUOTE |SPADreplace|) - (QUOTE QSTIMES)) - -(DEFUN |SINT;*;3$;30| (|x| |y| $) - (QSTIMES |x| |y|)) - -(DEFUN |SINT;**;$Nni$;31| (|x| |n| $) - (SPADCALL (EXPT |x| |n|) (QREFELT $ 33))) - -(PUT - (QUOTE |SINT;quo;3$;32|) - (QUOTE |SPADreplace|) - (QUOTE QSQUOTIENT)) - -(DEFUN |SINT;quo;3$;32| (|x| |y| $) - (QSQUOTIENT |x| |y|)) - -(PUT - (QUOTE |SINT;rem;3$;33|) - (QUOTE |SPADreplace|) - (QUOTE QSREMAINDER)) - -(DEFUN |SINT;rem;3$;33| (|x| |y| $) - (QSREMAINDER |x| |y|)) - -(DEFUN |SINT;divide;2$R;34| (|x| |y| $) - (CONS (QSQUOTIENT |x| |y|) (QSREMAINDER |x| |y|))) - -(PUT (QUOTE |SINT;gcd;3$;35|) - (QUOTE |SPADreplace|) (QUOTE GCD)) - -(DEFUN |SINT;gcd;3$;35| (|x| |y| $) - (GCD |x| |y|)) - -(PUT - (QUOTE |SINT;abs;2$;36|) - (QUOTE |SPADreplace|) - (QUOTE QSABSVAL)) - -(DEFUN |SINT;abs;2$;36| (|x| $) - (QSABSVAL |x|)) - -(PUT - (QUOTE |SINT;odd?;$B;37|) - (QUOTE |SPADreplace|) - (QUOTE QSODDP)) - -(DEFUN |SINT;odd?;$B;37| (|x| $) - (QSODDP |x|)) - -(PUT - (QUOTE |SINT;zero?;$B;38|) - (QUOTE |SPADreplace|) - (QUOTE QSZEROP)) - -(DEFUN |SINT;zero?;$B;38| (|x| $) - (QSZEROP |x|)) - -(PUT - (QUOTE |SINT;max;3$;39|) - (QUOTE |SPADreplace|) - (QUOTE QSMAX)) - -(DEFUN |SINT;max;3$;39| (|x| |y| $) - (QSMAX |x| |y|)) - -(PUT - (QUOTE |SINT;min;3$;40|) - (QUOTE |SPADreplace|) - (QUOTE QSMIN)) - -(DEFUN |SINT;min;3$;40| (|x| |y| $) - (QSMIN |x| |y|)) - -(PUT - (QUOTE |SINT;hash;2$;41|) - (QUOTE |SPADreplace|) - (QUOTE HASHEQ)) - -(DEFUN |SINT;hash;2$;41| (|x| $) - (HASHEQ |x|)) - -(PUT - (QUOTE |SINT;length;2$;42|) - (QUOTE |SPADreplace|) - (QUOTE INTEGER-LENGTH)) - -(DEFUN |SINT;length;2$;42| (|x| $) - (INTEGER-LENGTH |x|)) - -(PUT - (QUOTE |SINT;shift;3$;43|) - (QUOTE |SPADreplace|) - (QUOTE QSLEFTSHIFT)) - -(DEFUN |SINT;shift;3$;43| (|x| |n| $) - (QSLEFTSHIFT |x| |n|)) - -(PUT - (QUOTE |SINT;mulmod;4$;44|) - (QUOTE |SPADreplace|) - (QUOTE QSMULTMOD)) - -(DEFUN |SINT;mulmod;4$;44| (|a| |b| |p| $) - (QSMULTMOD |a| |b| |p|)) - -(PUT - (QUOTE |SINT;addmod;4$;45|) - (QUOTE |SPADreplace|) - (QUOTE QSADDMOD)) - -(DEFUN |SINT;addmod;4$;45| (|a| |b| |p| $) - (QSADDMOD |a| |b| |p|)) - -(PUT - (QUOTE |SINT;submod;4$;46|) - (QUOTE |SPADreplace|) - (QUOTE QSDIFMOD)) - -(DEFUN |SINT;submod;4$;46| (|a| |b| |p| $) - (QSDIFMOD |a| |b| |p|)) - -(PUT - (QUOTE |SINT;negative?;$B;47|) - (QUOTE |SPADreplace|) - (QUOTE QSMINUSP)) - -(DEFUN |SINT;negative?;$B;47| (|x| $) - (QSMINUSP |x|)) - -(PUT - (QUOTE |SINT;reducedSystem;MVR;48|) - (QUOTE |SPADreplace|) - (QUOTE CONS)) - -(DEFUN |SINT;reducedSystem;MVR;48| (|m| |v| $) - (CONS |m| |v|)) - -(DEFUN |SINT;positiveRemainder;3$;49| (|x| |n| $) - (PROG (|r|) - (RETURN - (SEQ - (LETT |r| (QSREMAINDER |x| |n|) |SINT;positiveRemainder;3$;49|) - (EXIT - (COND - ((QSMINUSP |r|) - (COND - ((QSMINUSP |n|) (QSDIFFERENCE |x| |n|)) - ((QUOTE T) (QSPLUS |r| |n|)))) - ((QUOTE T) |r|))))))) - -(DEFUN |SINT;coerce;I$;50| (|x| $) - (SEQ - (COND - ((NULL (< MOST-POSITIVE-FIXNUM |x|)) - (COND ((NULL (< |x| MOST-NEGATIVE-FIXNUM)) (EXIT |x|))))) - (EXIT (|error| "integer too large to represent in a machine word")))) - -(DEFUN |SINT;random;$;51| ($) - (SEQ - (SETELT $ 6 (REMAINDER (TIMES 314159269 (QREFELT $ 6)) 2147483647)) - (EXIT (REMAINDER (QREFELT $ 6) 67108864)))) - -(PUT - (QUOTE |SINT;random;2$;52|) - (QUOTE |SPADreplace|) - (QUOTE RANDOM)) - -(DEFUN |SINT;random;2$;52| (|n| $) - (RANDOM |n|)) - -(DEFUN |SINT;unitNormal;$R;53| (|x| $) - (COND - ((QSLESSP |x| 0) (VECTOR -1 (QSMINUS |x|) -1)) - ((QUOTE T) (VECTOR 1 |x| 1)))) - -(DEFUN |SingleInteger| NIL - (PROG NIL - (RETURN - (PROG (#0=#:G1358) - (RETURN - (COND - ((LETT #0# - (HGET |$ConstructorCache| (QUOTE |SingleInteger|)) - |SingleInteger|) - (|CDRwithIncrement| (CDAR #0#))) - ((QUOTE T) - (UNWIND-PROTECT - (PROG1 - (CDDAR - (HPUT - |$ConstructorCache| - (QUOTE |SingleInteger|) - (LIST (CONS NIL (CONS 1 (|SingleInteger;|)))))) - (LETT #0# T |SingleInteger|)) - (COND - ((NOT #0#) - (HREM |$ConstructorCache| - (QUOTE |SingleInteger|)))))))))))) - -(DEFUN |SingleInteger;| NIL - (PROG (|dv$| $ |pv$|) - (RETURN - (PROGN - (LETT |dv$| (QUOTE (|SingleInteger|)) . #0=(|SingleInteger|)) - (LETT $ (GETREFV 103) . #0#) - (QSETREFV $ 0 |dv$|) - (QSETREFV $ 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) - (|haddProp| |$ConstructorCache| (QUOTE |SingleInteger|) NIL (CONS 1 $)) - (|stuffDomainSlots| $) (QSETREFV $ 6 1) $)))) - -(MAKEPROP - (QUOTE |SingleInteger|) - (QUOTE |infovec|) - (LIST - (QUOTE - #(NIL NIL NIL NIL NIL NIL - (QUOTE |seed|) - (|Void|) - (|OpenMathDevice|) - (0 . |OMputApp|) - (|String|) - (5 . |OMputSymbol|) - (|Integer|) - (12 . |OMputInteger|) - (18 . |OMputEndApp|) - (|OpenMathEncoding|) - (23 . |OMencodingXML|) - (27 . |OMopenString|) - (33 . |OMputObject|) - (38 . |OMputEndObject|) - (43 . |OMclose|) - |SINT;OMwrite;$S;2| - (|Boolean|) - |SINT;OMwrite;$BS;3| - |SINT;OMwrite;Omd$V;4| - |SINT;OMwrite;Omd$BV;5| - (|Matrix| 12) - (|Matrix| $) - |SINT;reducedSystem;MM;6| - (|OutputForm|) - (48 . |coerce|) - |SINT;coerce;$Of;7| - |SINT;convert;$I;8| - (53 . |coerce|) - |SINT;*;I2$;9| - (CONS IDENTITY (FUNCALL (|dispatchFunction| |SINT;Zero;$;10|) $)) - (CONS IDENTITY (FUNCALL (|dispatchFunction| |SINT;One;$;11|) $)) - |SINT;base;$;12| - |SINT;max;$;13| - |SINT;min;$;14| - |SINT;=;2$B;15| - |SINT;~;2$;16| - |SINT;not;2$;17| - |SINT;/\\;3$;18| - |SINT;\\/;3$;19| - |SINT;Not;2$;20| - |SINT;And;3$;21| - |SINT;Or;3$;22| - |SINT;xor;3$;23| - |SINT;<;2$B;24| - |SINT;inc;2$;25| - |SINT;dec;2$;26| - |SINT;-;2$;27| - |SINT;+;3$;28| - |SINT;-;3$;29| - |SINT;*;3$;30| - (|NonNegativeInteger|) - |SINT;**;$Nni$;31| - |SINT;quo;3$;32| - |SINT;rem;3$;33| - (|Record| (|:| |quotient| $) (|:| |remainder| $)) - |SINT;divide;2$R;34| - |SINT;gcd;3$;35| - |SINT;abs;2$;36| - |SINT;odd?;$B;37| - |SINT;zero?;$B;38| - |SINT;max;3$;39| - |SINT;min;3$;40| - |SINT;hash;2$;41| - |SINT;length;2$;42| - |SINT;shift;3$;43| - |SINT;mulmod;4$;44| - |SINT;addmod;4$;45| - |SINT;submod;4$;46| - |SINT;negative?;$B;47| - (|Record| (|:| |mat| 26) (|:| |vec| (|Vector| 12))) - (|Vector| $) - |SINT;reducedSystem;MVR;48| - |SINT;positiveRemainder;3$;49| - |SINT;coerce;I$;50| - |SINT;random;$;51| - |SINT;random;2$;52| - (|Record| (|:| |unit| $) (|:| |canonical| $) (|:| |associate| $)) - |SINT;unitNormal;$R;53| - (|Union| 85 (QUOTE "failed")) - (|Fraction| 12) - (|Union| $ (QUOTE "failed")) - (|Float|) - (|DoubleFloat|) - (|Pattern| 12) - (|PatternMatchResult| 12 $) - (|InputForm|) - (|Union| 12 (QUOTE "failed")) - (|Record| (|:| |coef| 94) (|:| |generator| $)) - (|List| $) - (|Union| 94 (QUOTE "failed")) - (|Record| (|:| |coef1| $) (|:| |coef2| $) (|:| |generator| $)) - (|Record| (|:| |coef1| $) (|:| |coef2| $)) - (|Union| 97 (QUOTE "failed")) - (|Factored| $) - (|SparseUnivariatePolynomial| $) - (|PositiveInteger|) - (|SingleInteger|))) - (QUOTE - #(~= 58 ~ 64 |zero?| 69 |xor| 74 |unitNormal| 80 |unitCanonical| 85 - |unit?| 90 |symmetricRemainder| 95 |subtractIfCan| 101 |submod| 107 - |squareFreePart| 114 |squareFree| 119 |sizeLess?| 124 |sign| 130 - |shift| 135 |sample| 141 |retractIfCan| 145 |retract| 150 |rem| 155 - |reducedSystem| 161 |recip| 172 |rationalIfCan| 177 |rational?| 182 - |rational| 187 |random| 192 |quo| 201 |principalIdeal| 207 - |prime?| 212 |powmod| 217 |positiveRemainder| 224 |positive?| 230 - |permutation| 235 |patternMatch| 241 |one?| 248 |odd?| 253 |not| 258 - |nextItem| 263 |negative?| 268 |multiEuclidean| 273 |mulmod| 279 - |min| 286 |max| 296 |mask| 306 |length| 311 |lcm| 316 |latex| 327 - |invmod| 332 |init| 338 |inc| 342 |hash| 347 |gcdPolynomial| 357 - |gcd| 363 |factorial| 374 |factor| 379 |extendedEuclidean| 384 - |exquo| 397 |expressIdealMember| 403 |even?| 409 |euclideanSize| 414 - |divide| 419 |differentiate| 425 |dec| 436 |copy| 441 |convert| 446 - |coerce| 471 |characteristic| 491 |bit?| 495 |binomial| 501 - |base| 507 |associates?| 511 |addmod| 517 |abs| 524 ^ 529 |\\/| 541 - |Zero| 547 |Or| 551 |One| 557 |OMwrite| 561 |Not| 585 D 590 - |And| 601 >= 607 > 613 = 619 <= 625 < 631 |/\\| 637 - 643 + 654 - ** 660 * 672)) - (QUOTE ( - (|noetherian| . 0) - (|canonicalsClosed| . 0) - (|canonical| . 0) - (|canonicalUnitNormal| . 0) - (|multiplicativeValuation| . 0) - (|noZeroDivisors| . 0) - ((|commutative| "*") . 0) - (|rightUnitary| . 0) - (|leftUnitary| . 0) - (|unitsKnown| . 0))) - (CONS - (|makeByteWordVec2| 1 - (QUOTE (0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 - 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 - 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0))) - (CONS - (QUOTE - #(|IntegerNumberSystem&| |EuclideanDomain&| - |UniqueFactorizationDomain&| NIL NIL |GcdDomain&| - |IntegralDomain&| |Algebra&| |Module&| NIL |Module&| NIL NIL - |Module&| NIL |DifferentialRing&| |OrderedRing&| NIL |Module&| - NIL |Module&| NIL NIL NIL NIL NIL NIL |Ring&| NIL NIL NIL NIL - NIL NIL NIL NIL NIL NIL NIL NIL NIL |AbelianGroup&| NIL NIL - |AbelianMonoid&| |Monoid&| NIL NIL NIL NIL |OrderedSet&| - |AbelianSemiGroup&| |SemiGroup&| |Logic&| NIL |SetCategory&| NIL - NIL NIL NIL |RetractableTo&| NIL NIL NIL |RetractableTo&| NIL NIL - NIL NIL NIL NIL |RetractableTo&| NIL |BasicType&| NIL)) - (CONS - (QUOTE - #((|IntegerNumberSystem|) (|EuclideanDomain|) - (|UniqueFactorizationDomain|) (|PrincipalIdealDomain|) - (|OrderedIntegralDomain|) (|GcdDomain|) (|IntegralDomain|) - (|Algebra| $$) (|Module| 12) (|LinearlyExplicitRingOver| 12) - (|Module| #0=#:G1062) (|LinearlyExplicitRingOver| #0#) - (|CharacteristicZero|) (|Module| #1=#:G106217) - (|LinearlyExplicitRingOver| #1#) (|DifferentialRing|) - (|OrderedRing|) (|CommutativeRing|) (|Module| |t#1|) - (|EntireRing|) (|Module| $$) (|BiModule| 12 12) - (|BiModule| #0# #0#) (|BiModule| #1# #1#) - (|OrderedAbelianGroup|) (|BiModule| |t#1| |t#1|) - (|BiModule| $$ $$) (|Ring|) (|RightModule| 12) - (|LeftModule| 12) (|RightModule| #0#) (|LeftModule| #0#) - (|RightModule| #1#) (|LeftModule| #1#) - (|OrderedCancellationAbelianMonoid|) (|RightModule| |t#1|) - (|LeftModule| |t#1|) (|LeftModule| $$) (|Rng|) - (|RightModule| $$) (|OrderedAbelianMonoid|) (|AbelianGroup|) - (|OrderedAbelianSemiGroup|) (|CancellationAbelianMonoid|) - (|AbelianMonoid|) (|Monoid|) (|PatternMatchable| 12) - (|PatternMatchable| #:G1065) (|StepThrough|) - (|PatternMatchable| #:G106220) (|OrderedSet|) - (|AbelianSemiGroup|) (|SemiGroup|) (|Logic|) (|RealConstant|) - (|SetCategory|) (|OpenMath|) (|CoercibleTo| #:G82356) - (|ConvertibleTo| 89) (|ConvertibleTo| 91) (|RetractableTo| 12) - (|ConvertibleTo| 12) (|ConvertibleTo| #:G1064) - (|ConvertibleTo| #:G1063) (|RetractableTo| #:G1061) - (|ConvertibleTo| #:G1060) (|ConvertibleTo| 87) - (|ConvertibleTo| 88) (|CombinatorialFunctionCategory|) - (|ConvertibleTo| #:G106219) (|ConvertibleTo| #:G106218) - (|RetractableTo| #:G106216) (|ConvertibleTo| #:G106215) - (|BasicType|) (|CoercibleTo| 29))) - (|makeByteWordVec2| 102 - (QUOTE - (1 8 7 0 9 3 8 7 0 10 10 11 2 8 7 0 12 13 1 8 7 0 14 0 15 0 - 16 2 8 0 10 15 17 1 8 7 0 18 1 8 7 0 19 1 8 7 0 20 1 12 29 - 0 30 1 0 0 12 33 2 0 22 0 0 1 1 0 0 0 41 1 0 22 0 65 2 0 0 - 0 0 48 1 0 82 0 83 1 0 0 0 1 1 0 22 0 1 2 0 0 0 0 1 2 0 86 - 0 0 1 3 0 0 0 0 0 73 1 0 0 0 1 1 0 99 0 1 2 0 22 0 0 1 1 0 - 12 0 1 2 0 0 0 0 70 0 0 0 1 1 0 92 0 1 1 0 12 0 1 2 0 0 0 0 - 59 1 0 26 27 28 2 0 75 27 76 77 1 0 86 0 1 1 0 84 0 1 1 0 - 22 0 1 1 0 85 0 1 1 0 0 0 81 0 0 0 80 2 0 0 0 0 58 1 0 93 - 94 1 1 0 22 0 1 3 0 0 0 0 0 1 2 0 0 0 0 78 1 0 22 0 1 2 0 0 - 0 0 1 3 0 90 0 89 90 1 1 0 22 0 1 1 0 22 0 64 1 0 0 0 42 1 - 0 86 0 1 1 0 22 0 74 2 0 95 94 0 1 3 0 0 0 0 0 71 0 0 0 39 - 2 0 0 0 0 67 0 0 0 38 2 0 0 0 0 66 1 0 0 0 1 1 0 0 0 69 1 0 - 0 94 1 2 0 0 0 0 1 1 0 10 0 1 2 0 0 0 0 1 0 0 0 1 1 0 0 0 50 - 1 0 0 0 68 1 0 102 0 1 2 0 100 100 100 1 1 0 0 94 1 2 0 0 0 - 0 62 1 0 0 0 1 1 0 99 0 1 2 0 96 0 0 1 3 0 98 0 0 0 1 2 0 86 - 0 0 1 2 0 95 94 0 1 1 0 22 0 1 1 0 56 0 1 2 0 60 0 0 61 1 0 - 0 0 1 2 0 0 0 56 1 1 0 0 0 51 1 0 0 0 1 1 0 87 0 1 1 0 88 0 - 1 1 0 89 0 1 1 0 91 0 1 1 0 12 0 32 1 0 0 12 79 1 0 0 0 1 1 - 0 0 12 79 1 0 29 0 31 0 0 56 1 2 0 22 0 0 1 2 0 0 0 0 1 0 0 - 0 37 2 0 22 0 0 1 3 0 0 0 0 0 72 1 0 0 0 63 2 0 0 0 56 1 2 0 - 0 0 101 1 2 0 0 0 0 44 0 0 0 35 2 0 0 0 0 47 0 0 0 36 3 0 7 - 8 0 22 25 2 0 10 0 22 23 2 0 7 8 0 24 1 0 10 0 21 1 0 0 0 45 - 1 0 0 0 1 2 0 0 0 56 1 2 0 0 0 0 46 2 0 22 0 0 1 2 0 22 0 0 - 1 2 0 22 0 0 40 2 0 22 0 0 1 2 0 22 0 0 49 2 0 0 0 0 43 1 0 - 0 0 52 2 0 0 0 0 54 2 0 0 0 0 53 2 0 0 0 56 57 2 0 0 0 101 1 - 2 0 0 0 0 55 2 0 0 12 0 34 2 0 0 56 0 1 2 0 0 101 0 1)))))) - (QUOTE |lookupComplete|))) - -(MAKEPROP (QUOTE |SingleInteger|) (QUOTE NILADIC) T) - -@ -\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/space.spad.pamphlet b/src/algebra/space.spad.pamphlet index bf4b19f..f5bc0a1 100644 --- a/src/algebra/space.spad.pamphlet +++ b/src/algebra/space.spad.pamphlet @@ -9,355 +9,6 @@ \eject \tableofcontents \eject -\section{domain SPACE3 ThreeSpace} -<>= -)abbrev domain SPACE3 ThreeSpace -++ Author: -++ Date Created: -++ Date Last Updated: -++ Basic Operations: create3Space, numberOfComponents, numberOfComposites, -++ merge, composite, components, copy, enterPointData, modifyPointData, point, -++ point?, curve, curve?, closedCurve, closedCurve?, polygon, polygon? mesh, -++ mesh?, lp, lllip, lllp, llprop, lprop, objects, check, subspace, coerce -++ Related Constructors: -++ Also See: -++ AMS Classifications: -++ Keywords: -++ References: -++ Description: The domain ThreeSpace is used for creating three dimensional -++ objects using functions for defining points, curves, polygons, constructs -++ and the subspaces containing them. - -ThreeSpace(R:Ring):Exports == Implementation where - -- m is the dimension of the point - - I ==> Integer - PI ==> PositiveInteger - NNI ==> NonNegativeInteger - L ==> List - B ==> Boolean - O ==> OutputForm - SUBSPACE ==> SubSpace(3,R) - POINT ==> Point(R) - PROP ==> SubSpaceComponentProperty() - REP3D ==> Record(lp:L POINT,llliPt:L L L NNI, llProp:L L PROP, lProp:L PROP) - OBJ3D ==> Record(points:NNI, curves:NNI, polygons:NNI, constructs:NNI) - - Exports ==> ThreeSpaceCategory(R) - Implementation ==> add - import COMPPROP - import POINT - import SUBSPACE - import ListFunctions2(List(R),POINT) - import Set(NNI) - - Rep := Record( subspaceField:SUBSPACE, compositesField:L SUBSPACE, _ - rep3DField:REP3D, objectsField:OBJ3D, _ - converted:B) - ---% Local Functions - convertSpace : % -> % - convertSpace space == - space.converted => space - space.converted := true - lllipt : L L L NNI := [] - llprop : L L PROP := [] - lprop : L PROP := [] - for component in children space.subspaceField repeat - lprop := cons(extractProperty component,lprop) - tmpllipt : L L NNI := [] - tmplprop : L PROP := [] - for curve in children component repeat - tmplprop := cons(extractProperty curve,tmplprop) - tmplipt : L NNI := [] - for point in children curve repeat - tmplipt := cons(extractIndex point,tmplipt) - tmpllipt := cons(reverse_! tmplipt,tmpllipt) - llprop := cons(reverse_! tmplprop, llprop) - lllipt := cons(reverse_! tmpllipt, lllipt) - space.rep3DField := [pointData space.subspaceField, - reverse_! lllipt,reverse_! llprop,reverse_! lprop] - space - - ---% Exported Functions - polygon(space:%,points:L POINT) == - #points < 3 => - error "You need at least 3 points to define a polygon" - pt := addPoint2(space.subspaceField,first points) - points := rest points - addPointLast(space.subspaceField, pt, first points, 1) - for p in rest points repeat - addPointLast(space.subspaceField, pt, p, 2) - space.converted := false - space - create3Space() == [ new()$SUBSPACE, [], [ [], [], [], [] ], [0,0,0,0], false ] - create3Space(s) == [ s, [], [ [], [], [], [] ], [0,0,0,0], false ] - numberOfComponents(space) == #(children((space::Rep).subspaceField)) - numberOfComposites(space) == #((space::Rep).compositesField) - merge(listOfThreeSpaces) == - -- * -- we may want to remove duplicate components when that functionality exists in List - newspace := create3Space(merge([ts.subspaceField for ts in listOfThreeSpaces])) --- newspace.compositesField := [for cs in ts.compositesField for ts in listOfThreeSpaces] - for ts in listOfThreeSpaces repeat - newspace.compositesField := append(ts.compositesField,newspace.compositesField) - newspace - merge(s1,s2) == merge([s1,s2]) - composite(listOfThreeSpaces) == - space := create3Space() - space.subspaceField := merge [s.subspaceField for s in listOfThreeSpaces] - space.compositesField := [deepCopy space.subspaceField] --- for aSpace in listOfThreeSpaces repeat - -- create a composite (which are supercomponents that group - -- separate components together) out of all possible components --- space.compositesField := append(children aSpace.subspaceField,space.compositesField) - space - components(space) == [create3Space(s) for s in separate space.subspaceField] - composites(space) == [create3Space(s) for s in space.compositesField] - copy(space) == - spc := create3Space(deepCopy(space.subspaceField)) - spc.compositesField := [deepCopy s for s in space.compositesField] - spc - - enterPointData(space,listOfPoints) == - for p in listOfPoints repeat - addPoint(space.subspaceField,p) - #(pointData space.subspaceField) - modifyPointData(space,i,p) == - modifyPoint(space.subspaceField,i,p) - space - - -- 3D primitives, each grouped in the following order - -- xxx?(s) : query whether the threespace, s, holds an xxx - -- xxx(s) : extract xxx from threespace, s - -- xxx(p) : create a new three space with xxx, p - -- xxx(s,p) : add xxx, p, to a three space, s - -- xxx(s,q) : add an xxx, convertable from q, to a three space, s - -- xxx(s,i) : add an xxx, the data for xxx being indexed by reference *** complete this - point?(space:%) == - #(c:=children space.subspaceField) > 1$NNI => - error "This ThreeSpace has more than one component" - -- our 3-space has one component, a list of list of points - #(kid:=children first c) = 1$NNI => -- the component has one subcomponent (a list of points) - #(children first kid) = 1$NNI -- this list of points only has one entry, so it's a point - false - point(space:%) == - point? space => extractPoint(traverse(space.subspaceField,[1,1,1]::L NNI)) - error "This ThreeSpace holds something other than a single point - try the objects() command" - point(aPoint:POINT) == point(create3Space(),aPoint) - point(space:%,aPoint:POINT) == - addPoint(space.subspaceField,[],aPoint) - space.converted := false - space - point(space:%,l:L R) == - pt := point(l) - point(space,pt) - point(space:%,i:NNI) == - addPoint(space.subspaceField,[],i) - space.converted := false - space - - curve?(space:%) == - #(c:=children space.subspaceField) > 1$NNI => - error "This ThreeSpace has more than one component" - -- our 3-space has one component, a list of list of points - #(children first c) = 1$NNI -- there is only one subcomponent, so it's a list of points - curve(space:%) == - curve? space => - spc := first children first children space.subspaceField - [extractPoint(s) for s in children spc] - error "This ThreeSpace holds something other than a curve - try the objects() command" - curve(points:L POINT) == curve(create3Space(),points) - curve(space:%,points:L POINT) == - addPoint(space.subspaceField,[],first points) - path : L NNI := [#(children space.subspaceField),1] - for p in rest points repeat - addPoint(space.subspaceField,path,p) - space.converted := false - space - curve(space:%,points:L L R) == - pts := map(point,points) - curve(space,pts) - - closedCurve?(space:%) == - #(c:=children space.subspaceField) > 1$NNI => - error "This ThreeSpace has more than one component" - -- our 3-space has one component, a list of list of points - #(kid := children first c) = 1$NNI => -- there is one subcomponent => it's a list of points - extractClosed first kid -- is it a closed curve? - false - closedCurve(space:%) == - closedCurve? space => - spc := first children first children space.subspaceField - -- get the list of points - [extractPoint(s) for s in children spc] - -- for now, we are not repeating points... - error "This ThreeSpace holds something other than a curve - try the objects() command" - closedCurve(points:L POINT) == closedCurve(create3Space(),points) - closedCurve(space:%,points:L POINT) == - addPoint(space.subspaceField,[],first points) - path : L NNI := [#(children space.subspaceField),1] - closeComponent(space.subspaceField,path,true) - for p in rest points repeat - addPoint(space.subspaceField,path,p) - space.converted := false - space - closedCurve(space:%,points:L L R) == - pts := map(point,points) - closedCurve(space,pts) - - polygon?(space:%) == - #(c:=children space.subspaceField) > 1$NNI => - error "This ThreeSpace has more than one component" - -- our 3-space has one component, a list of list of points - #(kid:=children first c) = 2::NNI => - -- there are two subcomponents - -- the convention is to have one point in the first child and to put - -- the remaining points (2 or more) in the second, and last, child - #(children first kid) = 1$NNI and #(children second kid) > 2::NNI - false -- => returns Void...? - polygon(space:%) == - polygon? space => - listOfPoints : L POINT := - [extractPoint(first children first (cs := children first children space.subspaceField))] - [extractPoint(s) for s in children second cs] - error "This ThreeSpace holds something other than a polygon - try the objects() command" - polygon(points:L POINT) == polygon(create3Space(),points) - polygon(space:%,points:L L R) == - pts := map(point,points) - polygon(space,pts) - - mesh?(space:%) == - #(c:=children space.subspaceField) > 1$NNI => - error "This ThreeSpace has more than one component" - -- our 3-space has one component, a list of list of points - #(kid:=children first c) > 1$NNI => - -- there are two or more subcomponents (list of points) - -- so this may be a definition of a mesh; if the size - -- of each list of points is the same and they are all - -- greater than 1(?) then we have an acceptable mesh - -- use a set to hold the curve size info: if heterogenous - -- curve sizes exist, then the set would hold all the sizes; - -- otherwise it would just have the one element indicating - -- the sizes for all the curves - whatSizes := brace()$Set(NNI) - for eachCurve in kid repeat - insert_!(#children eachCurve,whatSizes) - #whatSizes > 1 => error "Mesh defined with curves of different sizes" - first parts whatSizes < 2 => - error "Mesh defined with single point curves (use curve())" - true - false - mesh(space:%) == - mesh? space => - llp : L L POINT := [] - for lpSpace in children first children space.subspaceField repeat - llp := cons([extractPoint(s) for s in children lpSpace],llp) - llp - error "This ThreeSpace holds something other than a mesh - try the objects() command" - mesh(points:L L POINT) == mesh(create3Space(),points,false,false) - mesh(points:L L POINT,prop1:B,prop2:B) == mesh(create3Space(),points,prop1,prop2) ---+ old ones \/ - mesh(space:%,llpoints:L L L R,lprops:L PROP,prop:PROP) == - pts := [map(point,points) for points in llpoints] - mesh(space,pts,lprops,prop) - mesh(space:%,llp:L L POINT,lprops:L PROP,prop:PROP) == - addPoint(space.subspaceField,[],first first llp) - defineProperty(space.subspaceField,path:L NNI:=[#children space.subspaceField],prop) - path := append(path,[1]) - defineProperty(space.subspaceField,path,first lprops) - for p in rest (first llp) repeat - addPoint(space.subspaceField,path,p) - for lp in rest llp for aProp in rest lprops for count in 2.. repeat - addPoint(space.subspaceField,path := [first path],first lp) - path := append(path,[count]) - defineProperty(space.subspaceField,path,aProp) - for p in rest lp repeat - addPoint(space.subspaceField,path,p) - space.converted := false - space ---+ old ones /\ - mesh(space:%,llpoints:L L L R,prop1:B,prop2:B) == - pts := [map(point,points) for points in llpoints] - mesh(space,pts,prop1,prop2) - mesh(space:%,llp:L L POINT,prop1:B,prop2:B) == - -- prop2 refers to property of the ends of a surface (list of lists of points) - -- while prop1 refers to the individual curves (list of points) - -- ** note we currently use Booleans for closed (rather than a pair - -- ** of booleans for closed and solid) - propA : PROP := new() - close(propA,prop1) - propB : PROP := new() - close(propB,prop2) - addPoint(space.subspaceField,[],first first llp) - defineProperty(space.subspaceField,path:L NNI:=[#children space.subspaceField],propB) - path := append(path,[1]) - defineProperty(space.subspaceField,path,propA) - for p in rest (first llp) repeat - addPoint(space.subspaceField,path,p) - for lp in rest llp for count in 2.. repeat - addPoint(space.subspaceField,path := [first path],first lp) - path := append(path,[count]) - defineProperty(space.subspaceField,path,propA) - for p in rest lp repeat - addPoint(space.subspaceField,path,p) - space.converted := false - space - - lp space == - if ^space.converted then space := convertSpace space - space.rep3DField.lp - lllip space == - if ^space.converted then space := convertSpace space - space.rep3DField.llliPt --- lllp space == --- if ^space.converted then space := convertSpace space --- space.rep3DField.lllPt - llprop space == - if ^space.converted then space := convertSpace space - space.rep3DField.llProp - lprop space == - if ^space.converted then space := convertSpace space - space.rep3DField.lProp - - -- this function is just to see how this representation really - -- does work - objects space == - if ^space.converted then space := convertSpace space - numPts := 0$NNI - numCurves := 0$NNI - numPolys := 0$NNI - numConstructs := 0$NNI - for component in children space.subspaceField repeat - #(kid:=children component) = 1 => - #(children first kid) = 1 => numPts := numPts + 1 - numCurves := numCurves + 1 - (#kid = 2) and _ - (#children first kid = 1) and _ - (#children first rest kid ^= 1) => - numPolys := numPolys + 1 - numConstructs := numConstructs + 1 - -- otherwise, a mathematical surface is assumed - -- there could also be garbage representation - -- since there are always more permutations that - -- we could ever want, so the user should not - -- fumble around too much with the structure - -- as other applications need to interpret it - [numPts,numCurves,numPolys,numConstructs] - - check(s) == - ^s.converted => convertSpace s - s - - subspace(s) == s.subspaceField - - coerce(s) == - if ^s.converted then s := convertSpace s - hconcat(["3-Space with "::O, _ - (sizo:=#(s.rep3DField.llliPt))::O, _ - (sizo=1=>" component"::O;" components"::O)]) - -@ \section{package TOPSP TopLevelThreeSpace} <>= )abbrev package TOPSP TopLevelThreeSpace @@ -407,7 +58,6 @@ TopLevelThreeSpace(): with <<*>>= <> -<> <> @ \eject diff --git a/src/algebra/sregset.spad.pamphlet b/src/algebra/sregset.spad.pamphlet index 88588cc..9bfe286 100644 --- a/src/algebra/sregset.spad.pamphlet +++ b/src/algebra/sregset.spad.pamphlet @@ -1124,875 +1124,6 @@ SquareFreeRegularSetDecompositionPackage(R,E,V,P,TS): Exports == Implementation removeSuperfluousCases(branches)$quasicomppack @ -\section{domain SREGSET SquareFreeRegularTriangularSet} -<>= --- sregset.spad.pamphlet SquareFreeRegularTriangularSet.input -)spool SquareFreeRegularTriangularSet.output -)set message test on -)set message auto off -)clear all ---S 1 of 23 -R := Integer ---R ---R ---R (1) Integer ---R Type: Domain ---E 1 - ---S 2 of 23 -ls : List Symbol := [x,y,z,t] ---R ---R ---R (2) [x,y,z,t] ---R Type: List Symbol ---E 2 - ---S 3 of 23 -V := OVAR(ls) ---R ---R ---R (3) OrderedVariableList [x,y,z,t] ---R Type: Domain ---E 3 - ---S 4 of 23 -E := IndexedExponents V ---R ---R ---R (4) IndexedExponents OrderedVariableList [x,y,z,t] ---R Type: Domain ---E 4 - ---S 5 of 23 -P := NSMP(R, V) ---R ---R ---R (5) NewSparseMultivariatePolynomial(Integer,OrderedVariableList [x,y,z,t]) ---R Type: Domain ---E 5 - ---S 6 of 23 -x: P := 'x ---R ---R ---R (6) x ---R Type: NewSparseMultivariatePolynomial(Integer,OrderedVariableList [x,y,z,t]) ---E 6 - ---S 7 of 23 -y: P := 'y ---R ---R ---R (7) y ---R Type: NewSparseMultivariatePolynomial(Integer,OrderedVariableList [x,y,z,t]) ---E 7 - ---S 8 of 23 -z: P := 'z ---R ---R ---R (8) z ---R Type: NewSparseMultivariatePolynomial(Integer,OrderedVariableList [x,y,z,t]) ---E 8 - ---S 9 of 23 -t: P := 't ---R ---R ---R (9) t ---R Type: NewSparseMultivariatePolynomial(Integer,OrderedVariableList [x,y,z,t]) ---E 9 - ---S 10 of 23 -ST := SREGSET(R,E,V,P) ---R ---R ---R (10) ---R SquareFreeRegularTriangularSet(Integer,IndexedExponents OrderedVariableList [ ---R x,y,z,t],OrderedVariableList [x,y,z,t],NewSparseMultivariatePolynomial(Intege ---R r,OrderedVariableList [x,y,z,t])) ---R Type: Domain ---E 10 - ---S 11 of 23 -p1 := x ** 31 - x ** 6 - x - y ---R ---R ---R 31 6 ---R (11) x - x - x - y ---R Type: NewSparseMultivariatePolynomial(Integer,OrderedVariableList [x,y,z,t]) ---E 11 - ---S 12 of 23 -p2 := x ** 8 - z ---R ---R ---R 8 ---R (12) x - z ---R Type: NewSparseMultivariatePolynomial(Integer,OrderedVariableList [x,y,z,t]) ---E 12 - ---S 13 of 23 -p3 := x ** 10 - t ---R ---R ---R 10 ---R (13) x - t ---R Type: NewSparseMultivariatePolynomial(Integer,OrderedVariableList [x,y,z,t]) ---E 13 - ---S 14 of 23 -lp := [p1, p2, p3] ---R ---R ---R 31 6 8 10 ---R (14) [x - x - x - y,x - z,x - t] ---RType: List NewSparseMultivariatePolynomial(Integer,OrderedVariableList [x,y,z,t]) ---E 14 - ---S 15 of 23 -zeroSetSplit(lp)$ST ---R ---R ---R 5 4 2 3 8 5 3 2 4 2 ---R (15) [{z - t ,t z y + 2z y - t + 2t + t - t ,(t - t)x - t y - z }] ---RType: List SquareFreeRegularTriangularSet(Integer,IndexedExponents OrderedVariableList [x,y,z,t],OrderedVariableList [x,y,z,t],NewSparseMultivariatePolynomial(Integer,OrderedVariableList [x,y,z,t])) ---E 15 - ---S 16 of 23 -zeroSetSplit(lp,false)$ST ---R ---R ---R (16) ---R 5 4 2 3 8 5 3 2 4 2 ---R [{z - t ,t z y + 2z y - t + 2t + t - t ,(t - t)x - t y - z }, ---R 3 5 2 2 ---R {t - 1,z - t,t y + z ,z x - t}, {t,z,y,x}] ---RType: List SquareFreeRegularTriangularSet(Integer,IndexedExponents OrderedVariableList [x,y,z,t],OrderedVariableList [x,y,z,t],NewSparseMultivariatePolynomial(Integer,OrderedVariableList [x,y,z,t])) ---E 16 - ---S 17 of 23 -T := REGSET(R,E,V,P) ---R ---R ---R (17) ---R RegularTriangularSet(Integer,IndexedExponents OrderedVariableList [x,y,z,t],O ---R rderedVariableList [x,y,z,t],NewSparseMultivariatePolynomial(Integer,OrderedV ---R ariableList [x,y,z,t])) ---R Type: Domain ---E 17 - ---S 18 of 23 -lts := zeroSetSplit(lp,false)$T ---R ---R ---R (18) ---R 5 4 2 3 8 5 3 2 4 2 ---R [{z - t ,t z y + 2z y - t + 2t + t - t ,(t - t)x - t y - z }, ---R 3 5 2 3 2 ---R {t - 1,z - t,t z y + 2z y + 1,z x - t}, {t,z,y,x}] ---RType: List RegularTriangularSet(Integer,IndexedExponents OrderedVariableList [x,y,z,t],OrderedVariableList [x,y,z,t],NewSparseMultivariatePolynomial(Integer,OrderedVariableList [x,y,z,t])) ---E 18 - ---S 19 of 23 -ts := lts.2 ---R ---R ---R 3 5 2 3 2 ---R (19) {t - 1,z - t,t z y + 2z y + 1,z x - t} ---RType: RegularTriangularSet(Integer,IndexedExponents OrderedVariableList [x,y,z,t],OrderedVariableList [x,y,z,t],NewSparseMultivariatePolynomial(Integer,OrderedVariableList [x,y,z,t])) ---E 19 - ---S 20 of 23 -pol := select(ts,'y)$T ---R ---R ---R 2 3 ---R (20) t z y + 2z y + 1 ---RType: Union(NewSparseMultivariatePolynomial(Integer,OrderedVariableList [x,y,z,t]),...) ---E 20 - ---S 21 of 23 -tower := collectUnder(ts,'y)$T ---R ---R ---R 3 5 ---R (21) {t - 1,z - t} ---RType: RegularTriangularSet(Integer,IndexedExponents OrderedVariableList [x,y,z,t],OrderedVariableList [x,y,z,t],NewSparseMultivariatePolynomial(Integer,OrderedVariableList [x,y,z,t])) ---E 21 - ---S 22 of 23 -pack := RegularTriangularSetGcdPackage(R,E,V,P,T) ---R ---R ---R (22) ---R RegularTriangularSetGcdPackage(Integer,IndexedExponents OrderedVariableList [ ---R x,y,z,t],OrderedVariableList [x,y,z,t],NewSparseMultivariatePolynomial(Intege ---R r,OrderedVariableList [x,y,z,t]),RegularTriangularSet(Integer,IndexedExponent ---R s OrderedVariableList [x,y,z,t],OrderedVariableList [x,y,z,t],NewSparseMultiv ---R ariatePolynomial(Integer,OrderedVariableList [x,y,z,t]))) ---R Type: Domain ---E 22 - ---S 23 of 23 -toseSquareFreePart(pol,tower)$pack ---R ---R ---R 2 3 5 ---R (23) [[val= t y + z ,tower= {t - 1,z - t}]] ---RType: List Record(val: NewSparseMultivariatePolynomial(Integer,OrderedVariableList [x,y,z,t]),tower: RegularTriangularSet(Integer,IndexedExponents OrderedVariableList [x,y,z,t],OrderedVariableList [x,y,z,t],NewSparseMultivariatePolynomial(Integer,OrderedVariableList [x,y,z,t]))) ---E 23 -)spool -)lisp (bye) -@ -<>= -==================================================================== -SquareFreeRegularTriangularSet examples -==================================================================== - -The SquareFreeRegularTriangularSet domain constructor implements -square-free regular triangular sets. See the RegularTriangularSet -domain constructor for general regular triangular sets. Let T be a -regular triangular set consisting of polynomials t1, ..., tm ordered -by increasing main variables. The regular triangular set T is -square-free if T is empty or if t1, ..., tm-1 is square-free and if the -polynomial tm is square-free as a univariate polynomial with coefficients -in the tower of simple extensions associated with t1,...,tm-1. - -The main interest of square-free regular triangular sets is that their -associated towers of simple extensions are product of fields. -Consequently, the saturated ideal of a square-free regular triangular -set is radical. This property simplifies some of the operations -related to regular triangular sets. However, building square-free -regular triangular sets is generally more expensive than building -general regular triangular sets. - -As the RegularTriangularSet domain constructor, the -SquareFreeRegularTriangularSet domain constructor also implements a -method for solving polynomial systems by means of regular triangular -sets. This is in fact the same method with some adaptations to take -into account the fact that the computed regular chains are -square-free. Note that it is also possible to pass from a -decomposition into general regular triangular sets to a decomposition -into square-free regular triangular sets. This conversion is used -internally by the LazardSetSolvingPackage package constructor. - -N.B. When solving polynomial systems with the -SquareFreeRegularTriangularSet domain constructor or the -LazardSetSolvingPackage package constructor, decompositions have no -redundant components. See also LexTriangularPackage and -ZeroDimensionalSolvePackage for the case of algebraic systems with a -finite number of (complex) solutions. - -We shall explain now how to use the constructor SquareFreeRegularTriangularSet. - -This constructor takes four arguments. The first one, R, is the -coefficient ring of the polynomials; it must belong to the category -GcdDomain. The second one, E, is the exponent monoid of the -polynomials; it must belong to the category OrderedAbelianMonoidSup. -the third one, V, is the ordered set of variables; it must belong to -the category OrderedSet. The last one is the polynomial ring; it must -belong to the category RecursivePolynomialCategory(R,E,V). The -abbreviation for SquareFreeRegularTriangularSet} is SREGSET. - -Note that the way of understanding triangular decompositions -is detailed in the example of the RegularTriangularSet constructor. - -Let us illustrate the use of this constructor with one example -(Donati-Traverso). Define the coefficient ring. - - R := Integer - Integer - Type: Domain - -Define the list of variables, - - ls : List Symbol := [x,y,z,t] - [x,y,z,t] - Type: List Symbol - -and make it an ordered set; - - V := OVAR(ls) - OrderedVariableList [x,y,z,t] - Type: Domain - -then define the exponent monoid. - - E := IndexedExponents V - IndexedExponents OrderedVariableList [x,y,z,t] - Type: Domain - -Define the polynomial ring. - - P := NSMP(R, V) - NewSparseMultivariatePolynomial(Integer,OrderedVariableList [x,y,z,t]) - Type: Domain - -Let the variables be polynomial. - - x: P := 'x - x - Type: NewSparseMultivariatePolynomial(Integer, - OrderedVariableList [x,y,z,t]) - - y: P := 'y - y - Type: NewSparseMultivariatePolynomial(Integer, - OrderedVariableList [x,y,z,t]) - - z: P := 'z - z - Type: NewSparseMultivariatePolynomial(Integer, - OrderedVariableList [x,y,z,t]) - - t: P := 't - t - Type: NewSparseMultivariatePolynomial(Integer, - OrderedVariableList [x,y,z,t]) - -Now call the SquareFreeRegularTriangularSet domain constructor. - - ST := SREGSET(R,E,V,P) - SquareFreeRegularTriangularSet(Integer,IndexedExponents OrderedVariableList [ - x,y,z,t],OrderedVariableList [x,y,z,t],NewSparseMultivariatePolynomial(Intege - r,OrderedVariableList [x,y,z,t])) - Type: Domain - -Define a polynomial system. - - p1 := x ** 31 - x ** 6 - x - y - 31 6 - x - x - x - y - Type: NewSparseMultivariatePolynomial(Integer, - OrderedVariableList [x,y,z,t]) - - p2 := x ** 8 - z - 8 - x - z - Type: NewSparseMultivariatePolynomial(Integer, - OrderedVariableList [x,y,z,t]) - - p3 := x ** 10 - t - 10 - x - t - Type: NewSparseMultivariatePolynomial(Integer, - OrderedVariableList [x,y,z,t]) - - lp := [p1, p2, p3] - 31 6 8 10 - [x - x - x - y,x - z,x - t] - Type: List NewSparseMultivariatePolynomial(Integer, - OrderedVariableList [x,y,z,t]) - -First of all, let us solve this system in the sense of Kalkbrener. - - zeroSetSplit(lp)$ST - 5 4 2 3 8 5 3 2 4 2 - [{z - t ,t z y + 2z y - t + 2t + t - t ,(t - t)x - t y - z }] - Type: List SquareFreeRegularTriangularSet(Integer, - IndexedExponents OrderedVariableList [x,y,z,t], - OrderedVariableList [x,y,z,t], - NewSparseMultivariatePolynomial(Integer, - OrderedVariableList [x,y,z,t])) - -And now in the sense of Lazard (or Wu and other authors). - - zeroSetSplit(lp,false)$ST - 5 4 2 3 8 5 3 2 4 2 - [{z - t ,t z y + 2z y - t + 2t + t - t ,(t - t)x - t y - z }, - 3 5 2 2 - {t - 1,z - t,t y + z ,z x - t}, {t,z,y,x}] - Type: List SquareFreeRegularTriangularSet(Integer, - IndexedExponents OrderedVariableList [x,y,z,t], - OrderedVariableList [x,y,z,t], - NewSparseMultivariatePolynomial(Integer, - OrderedVariableList [x,y,z,t])) - -Now to see the difference with the RegularTriangularSet domain -constructor, we define: - - T := REGSET(R,E,V,P) - RegularTriangularSet(Integer,IndexedExponents OrderedVariableList [x,y,z,t],O - rderedVariableList [x,y,z,t],NewSparseMultivariatePolynomial(Integer,OrderedV - ariableList [x,y,z,t])) - Type: Domain - -and compute: - - lts := zeroSetSplit(lp,false)$T - 5 4 2 3 8 5 3 2 4 2 - [{z - t ,t z y + 2z y - t + 2t + t - t ,(t - t)x - t y - z }, - 3 5 2 3 2 - {t - 1,z - t,t z y + 2z y + 1,z x - t}, {t,z,y,x}] - Type: List RegularTriangularSet(Integer, - IndexedExponents OrderedVariableList [x,y,z,t], - OrderedVariableList [x,y,z,t], - NewSparseMultivariatePolynomial(Integer, - OrderedVariableList [x,y,z,t])) - -If you look at the second set in both decompositions in the sense of Lazard, -you will see that the polynomial with main variable y is not the same. - -Let us understand what has happened. - -We define: - - ts := lts.2 - 3 5 2 3 2 - (19) {t - 1,z - t,t z y + 2z y + 1,z x - t} - Type: RegularTriangularSet(Integer, - IndexedExponents OrderedVariableList [x,y,z,t], - OrderedVariableList [x,y,z,t], - NewSparseMultivariatePolynomial(Integer, - OrderedVariableList [x,y,z,t])) - - pol := select(ts,'y)$T - 2 3 - t z y + 2z y + 1 - Type: Union(NewSparseMultivariatePolynomial(Integer, - OrderedVariableList [x,y,z,t]),...) - - tower := collectUnder(ts,'y)$T - 3 5 - {t - 1,z - t} - Type: RegularTriangularSet(Integer, - IndexedExponents OrderedVariableList [x,y,z,t], - OrderedVariableList [x,y,z,t], - NewSparseMultivariatePolynomial(Integer, - OrderedVariableList [x,y,z,t])) - - pack := RegularTriangularSetGcdPackage(R,E,V,P,T) - RegularTriangularSetGcdPackage(Integer,IndexedExponents OrderedVariableList [ - x,y,z,t],OrderedVariableList [x,y,z,t],NewSparseMultivariatePolynomial(Intege - r,OrderedVariableList [x,y,z,t]),RegularTriangularSet(Integer,IndexedExponent - s OrderedVariableList [x,y,z,t],OrderedVariableList [x,y,z,t],NewSparseMultiv - ariatePolynomial(Integer,OrderedVariableList [x,y,z,t]))) - Type: Domain - -Then we compute: - - toseSquareFreePart(pol,tower)$pack - 2 3 5 - [[val= t y + z ,tower= {t - 1,z - t}]] - Type: List Record(val: NewSparseMultivariatePolynomial(Integer, - OrderedVariableList [x,y,z,t]), - tower: RegularTriangularSet(Integer, - IndexedExponents OrderedVariableList [x,y,z,t], - OrderedVariableList [x,y,z,t], - NewSparseMultivariatePolynomial(Integer, - OrderedVariableList [x,y,z,t]))) - -See Also: -o )help GcdDomain -o )help OrderedAbelianMonoidSup -o )help OrderedSet -o )help RecursivePolynomialCategory -o )help ZeroDimensionalSolvePackage -o )help LexTriangularPackage -o )help LazardSetSolvingPackage -o )help RegularTriangularSet -o )show SquareFreeRegularTriangularSet -o $AXIOM/doc/src/algebra/sregset.spad.dvi - -@ -<>= -)abbrev domain SREGSET SquareFreeRegularTriangularSet -++ Author: Marc Moreno Maza -++ Date Created: 08/25/1998 -++ Date Last Updated: 16/12/1998 -++ Basic Functions: -++ Related Constructors: -++ Also See: -++ AMS Classifications: -++ Keywords: -++ Description: -++ This domain provides an implementation of square-free regular chains. -++ Moreover, the operation \axiomOpFrom{zeroSetSplit}{SquareFreeRegularTriangularSetCategory} -++ is an implementation of a new algorithm for solving polynomial systems by -++ means of regular chains.\newline -++ References : -++ [1] M. MORENO MAZA "A new algorithm for computing triangular -++ decomposition of algebraic varieties" NAG Tech. Rep. 4/98. -++ Version: 2 - -SquareFreeRegularTriangularSet(R,E,V,P) : Exports == Implementation where - - R : GcdDomain - E : OrderedAbelianMonoidSup - V : OrderedSet - P : RecursivePolynomialCategory(R,E,V) - N ==> NonNegativeInteger - Z ==> Integer - B ==> Boolean - LP ==> List P - PtoP ==> P -> P - PS ==> GeneralPolynomialSet(R,E,V,P) - PWT ==> Record(val : P, tower : $) - BWT ==> Record(val : Boolean, tower : $) - LpWT ==> Record(val : (List P), tower : $) - Split ==> List $ - iprintpack ==> InternalPrintPackage() - polsetpack ==> PolynomialSetUtilitiesPackage(R,E,V,P) - quasicomppack ==> SquareFreeQuasiComponentPackage(R,E,V,P,$) - regsetgcdpack ==> SquareFreeRegularTriangularSetGcdPackage(R,E,V,P,$) - regsetdecomppack ==> SquareFreeRegularSetDecompositionPackage(R,E,V,P,$) - - Exports == SquareFreeRegularTriangularSetCategory(R,E,V,P) with - - internalAugment: (P,$,B,B,B,B,B) -> List $ - ++ \axiom{internalAugment(p,ts,b1,b2,b3,b4,b5)} - ++ is an internal subroutine, exported only for developement. - zeroSetSplit: (LP, B, B) -> Split - ++ \axiom{zeroSetSplit(lp,clos?,info?)} has the same specifications as - ++ \axiomOpFrom{zeroSetSplit}{RegularTriangularSetCategory} - ++ from \spadtype{RegularTriangularSetCategory} - ++ Moreover, if \axiom{clos?} then solves in the sense of the Zariski closure - ++ else solves in the sense of the regular zeros. If \axiom{info?} then - ++ do print messages during the computations. - zeroSetSplit: (LP, B, B, B, B) -> Split - ++ \axiom{zeroSetSplit(lp,b1,b2.b3,b4)} - ++ is an internal subroutine, exported only for developement. - internalZeroSetSplit: (LP, B, B, B) -> Split - ++ \axiom{internalZeroSetSplit(lp,b1,b2,b3)} - ++ is an internal subroutine, exported only for developement. - pre_process: (LP, B, B) -> Record(val: LP, towers: Split) - ++ \axiom{pre_process(lp,b1,b2)} - ++ is an internal subroutine, exported only for developement. - - Implementation == add - - Rep ==> LP - - rep(s:$):Rep == s pretend Rep - per(l:Rep):$ == l pretend $ - - copy ts == - per(copy(rep(ts))$LP) - empty() == - per([]) - empty?(ts:$) == - empty?(rep(ts)) - parts ts == - rep(ts) - members ts == - rep(ts) - map (f : PtoP, ts : $) : $ == - construct(map(f,rep(ts))$LP)$$ - map! (f : PtoP, ts : $) : $ == - construct(map!(f,rep(ts))$LP)$$ - member? (p,ts) == - member?(p,rep(ts))$LP - unitIdealIfCan() == - "failed"::Union($,"failed") - roughUnitIdeal? ts == - false - coerce(ts:$) : OutputForm == - lp : List(P) := reverse(rep(ts)) - brace([p::OutputForm for p in lp]$List(OutputForm))$OutputForm - mvar ts == - empty? ts => error "mvar$SREGSET: #1 is empty" - mvar(first(rep(ts)))$P - first ts == - empty? ts => "failed"::Union(P,"failed") - first(rep(ts))::Union(P,"failed") - last ts == - empty? ts => "failed"::Union(P,"failed") - last(rep(ts))::Union(P,"failed") - rest ts == - empty? ts => "failed"::Union($,"failed") - per(rest(rep(ts)))::Union($,"failed") - coerce(ts:$) : (List P) == - rep(ts) - - collectUpper (ts,v) == - empty? ts => ts - lp := rep(ts) - newlp : Rep := [] - while (not empty? lp) and (mvar(first(lp)) > v) repeat - newlp := cons(first(lp),newlp) - lp := rest lp - per(reverse(newlp)) - - collectUnder (ts,v) == - empty? ts => ts - lp := rep(ts) - while (not empty? lp) and (mvar(first(lp)) >= v) repeat - lp := rest lp - per(lp) - - construct(lp:List(P)) == - ts : $ := per([]) - empty? lp => ts - lp := sort(infRittWu?,lp) - while not empty? lp repeat - eif := extendIfCan(ts,first(lp)) - not (eif case $) => - error"in construct : List P -> $ from SREGSET : bad #1" - ts := eif::$ - lp := rest lp - ts - - extendIfCan(ts:$,p:P) == - ground? p => "failed"::Union($,"failed") - empty? ts => - p := squareFreePart primitivePart p - (per([p]))::Union($,"failed") - not (mvar(ts) < mvar(p)) => "failed"::Union($,"failed") - invertible?(init(p),ts)@Boolean => - lts: Split := augment(p,ts) - #lts ~= 1 => "failed"::Union($,"failed") - (first lts)::Union($,"failed") - "failed"::Union($,"failed") - - removeZero(p:P, ts:$): P == - (ground? p) or (empty? ts) => p - v := mvar(p) - ts_v_- := collectUnder(ts,v) - if algebraic?(v,ts) - then - q := lazyPrem(p,select(ts,v)::P) - zero? q => return q - zero? removeZero(q,ts_v_-) => return 0 - empty? ts_v_- => p - q: P := 0 - while positive? degree(p,v) repeat - q := removeZero(init(p),ts_v_-) * mainMonomial(p) + q - p := tail(p) - q + removeZero(p,ts_v_-) - - internalAugment(p:P,ts:$): $ == - -- ASSUME that adding p to ts DOES NOT require any split - ground? p => error "in internalAugment$SREGSET: ground? #1" - first(internalAugment(p,ts,false,false,false,false,false)) - - internalAugment(lp:List(P),ts:$): $ == - -- ASSUME that adding p to ts DOES NOT require any split - empty? lp => ts - internalAugment(rest lp, internalAugment(first lp, ts)) - - internalAugment(p:P,ts:$,rem?:B,red?:B,prim?:B,sqfr?:B,extend?:B): Split == - -- ASSUME p is not a constant - -- ASSUME mvar(p) is not algebraic w.r.t. ts - -- ASSUME init(p) invertible modulo ts - -- if rem? then REDUCE p by remainder - -- if prim? then REPLACE p by its main primitive part - -- if sqfr? then FACTORIZE SQUARE FREE p over R - -- if extend? DO NOT ASSUME every pol in ts_v_+ is invertible modulo ts - v := mvar(p) - ts_v_- := collectUnder(ts,v) - ts_v_+ := collectUpper(ts,v) - if rem? then p := remainder(p,ts_v_-).polnum - -- if rem? then p := reduceByQuasiMonic(p,ts_v_-) - if red? then p := removeZero(p,ts_v_-) - if prim? then p := mainPrimitivePart p - lts: Split - if sqfr? - then - lts: Split := [] - lsfp := squareFreeFactors(p)$polsetpack - for f in lsfp repeat - (ground? f) or (mvar(f) < v) => "leave" - lpwt := squareFreePart(f,ts_v_-) - for pwt in lpwt repeat - sfp := pwt.val; us := pwt.tower - lts := cons( per(cons(pwt.val, rep(pwt.tower))), lts) - else - lts: Split := [per(cons(p,rep(ts_v_-)))] - extend? => extend(members(ts_v_+),lts) - [per(concat(rep(ts_v_+),rep(us))) for us in lts] - - augment(p:P,ts:$): List $ == - ground? p => error "in augment$SREGSET: ground? #1" - algebraic?(mvar(p),ts) => error "in augment$SREGSET: bad #1" - -- ASSUME init(p) invertible modulo ts - -- DOES NOT ASSUME anything else. - -- THUS reduction, mainPrimitivePart and squareFree are NEEDED - internalAugment(p,ts,true,true,true,true,true) - - extend(p:P,ts:$): List $ == - ground? p => error "in extend$SREGSET: ground? #1" - v := mvar(p) - not (mvar(ts) < mvar(p)) => error "in extend$SREGSET: bad #1" - split: List($) := invertibleSet(init(p),ts) - lts: List($) := [] - for us in split repeat - lts := concat(augment(p,us),lts) - lts - - invertible?(p:P,ts:$): Boolean == - stoseInvertible?(p,ts)$regsetgcdpack - - invertible?(p:P,ts:$): List BWT == - stoseInvertible?_sqfreg(p,ts)$regsetgcdpack - - invertibleSet(p:P,ts:$): Split == - stoseInvertibleSet_sqfreg(p,ts)$regsetgcdpack - - lastSubResultant(p1:P,p2:P,ts:$): List PWT == - stoseLastSubResultant(p1,p2,ts)$regsetgcdpack - - squareFreePart(p:P, ts: $): List PWT == - stoseSquareFreePart(p,ts)$regsetgcdpack - - intersect(p:P, ts: $): List($) == decompose([p], [ts], false, false)$regsetdecomppack - - intersect(lp: LP, lts: List($)): List($) == decompose(lp, lts, false, false)$regsetdecomppack - -- SOLVE in the regular zero sense - -- and DO NOT PRINT info - - decompose(p:P, ts: $): List($) == decompose([p], [ts], true, false)$regsetdecomppack - - decompose(lp: LP, lts: List($)): List($) == decompose(lp, lts, true, false)$regsetdecomppack - -- SOLVE in the closure sense - -- and DO NOT PRINT info - - zeroSetSplit(lp:List(P)) == zeroSetSplit(lp,true,false) - -- by default SOLVE in the closure sense - -- and DO NOT PRINT info - - zeroSetSplit(lp:List(P), clos?: B) == zeroSetSplit(lp,clos?, false) - - zeroSetSplit(lp:List(P), clos?: B, info?: B) == - -- if clos? then SOLVE in the closure sense - -- if info? then PRINT info - -- by default USE hash-tables - -- and PREPROCESS the input system - zeroSetSplit(lp,true,clos?,info?,true) - - zeroSetSplit(lp:List(P),hash?:B,clos?:B,info?:B,prep?:B) == - -- if hash? then USE hash-tables - -- if info? then PRINT information - -- if clos? then SOLVE in the closure sense - -- if prep? then PREPROCESS the input system - if hash? - then - s1, s2, s3, dom1, dom2, dom3: String - e: String := empty()$String - if info? then (s1,s2,s3) := ("w","g","i") else (s1,s2,s3) := (e,e,e) - if info? - then - (dom1, dom2, dom3) := ("QCMPACK", "REGSETGCD: Gcd", "REGSETGCD: Inv Set") - else - (dom1, dom2, dom3) := (e,e,e) - startTable!(s1,"W",dom1)$quasicomppack - startTableGcd!(s2,"G",dom2)$regsetgcdpack - startTableInvSet!(s3,"I",dom3)$regsetgcdpack - lts := internalZeroSetSplit(lp,clos?,info?,prep?) - if hash? - then - stopTable!()$quasicomppack - stopTableGcd!()$regsetgcdpack - stopTableInvSet!()$regsetgcdpack - lts - - internalZeroSetSplit(lp:LP,clos?:B,info?:B,prep?:B) == - -- if info? then PRINT information - -- if clos? then SOLVE in the closure sense - -- if prep? then PREPROCESS the input system - if prep? - then - pp := pre_process(lp,clos?,info?) - lp := pp.val - lts := pp.towers - else - ts: $ := [[]] - lts := [ts] - lp := remove(zero?, lp) - any?(ground?, lp) => [] - empty? lp => lts - empty? lts => lts - lp := sort(infRittWu?,lp) - clos? => decompose(lp,lts, clos?, info?)$regsetdecomppack - -- IN DIM > 0 with clos? the following is not false ... - for p in lp repeat - lts := decompose([p],lts, clos?, info?)$regsetdecomppack - lts - - largeSystem?(lp:LP): Boolean == - -- Gonnet and Gerdt and not Wu-Wang.2 - #lp > 16 => true - #lp < 13 => false - lts: List($) := [] - (#lp :: Z - numberOfVariables(lp,lts)$regsetdecomppack :: Z) > 3 - - smallSystem?(lp:LP): Boolean == - -- neural, Vermeer, Liu, and not f-633 and not Hairer-2 - #lp < 5 - - mediumSystem?(lp:LP): Boolean == - -- f-633 and not Hairer-2 - lts: List($) := [] - (numberOfVariables(lp,lts)$regsetdecomppack :: Z - #lp :: Z) < 2 - --- lin?(p:P):Boolean == ground?(init(p)) and one?(mdeg(p)) - lin?(p:P):Boolean == ground?(init(p)) and (mdeg(p) = 1) - - pre_process(lp:LP,clos?:B,info?:B): Record(val: LP, towers: Split) == - -- if info? then PRINT information - -- if clos? then SOLVE in the closure sense - ts: $ := [[]]; - lts: Split := [ts] - empty? lp => [lp,lts] - lp1: List P := [] - lp2: List P := [] - for p in lp repeat - ground? (tail p) => lp1 := cons(p, lp1) - lp2 := cons(p, lp2) - lts: Split := decompose(lp1,[ts],clos?,info?)$regsetdecomppack - probablyZeroDim?(lp)$polsetpack => - largeSystem?(lp) => return [lp2,lts] - if #lp > 7 - then - -- Butcher (8,8) + Wu-Wang.2 (13,16) - lp2 := crushedSet(lp2)$polsetpack - lp2 := remove(zero?,lp2) - any?(ground?,lp2) => return [lp2, lts] - lp3 := [p for p in lp2 | lin?(p)] - lp4 := [p for p in lp2 | not lin?(p)] - if clos? - then - lts := decompose(lp4,lts, clos?, info?)$regsetdecomppack - else - lp4 := sort(infRittWu?,lp4) - for p in lp4 repeat - lts := decompose([p],lts, clos?, info?)$regsetdecomppack - lp2 := lp3 - else - lp2 := crushedSet(lp2)$polsetpack - lp2 := remove(zero?,lp2) - any?(ground?,lp2) => return [lp2, lts] - if clos? - then - lts := decompose(lp2,lts, clos?, info?)$regsetdecomppack - else - lp2 := sort(infRittWu?,lp2) - for p in lp2 repeat - lts := decompose([p],lts, clos?, info?)$regsetdecomppack - lp2 := [] - return [lp2,lts] - smallSystem?(lp) => [lp2,lts] - mediumSystem?(lp) => [crushedSet(lp2)$polsetpack,lts] - lp3 := [p for p in lp2 | lin?(p)] - lp4 := [p for p in lp2 | not lin?(p)] - if clos? - then - lts := decompose(lp4,lts, clos?, info?)$regsetdecomppack - else - lp4 := sort(infRittWu?,lp4) - for p in lp4 repeat - lts := decompose([p],lts, clos?, info?)$regsetdecomppack - if clos? - then - lts := decompose(lp3,lts, clos?, info?)$regsetdecomppack - else - lp3 := sort(infRittWu?,lp3) - for p in lp3 repeat - lts := decompose([p],lts, clos?, info?)$regsetdecomppack - lp2 := [] - return [lp2,lts] - -@ \section{License} <>= --Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. @@ -2032,7 +1163,6 @@ SquareFreeRegularTriangularSet(R,E,V,P) : Exports == Implementation where <> <> <> -<> @ \eject \begin{thebibliography}{99} diff --git a/src/algebra/ssolve.spad.pamphlet b/src/algebra/ssolve.spad.pamphlet index e8ccc97..cce6ca7 100644 --- a/src/algebra/ssolve.spad.pamphlet +++ b/src/algebra/ssolve.spad.pamphlet @@ -9,199 +9,6 @@ \begin{abstract} \end{abstract} \tableofcontents -\section{domain SUPEXPR SparseUnivariatePolynomialExpressions} - -This domain is a hack, in some sense. What I'd really like to do - -automatically - is to provide all operations supported by the coefficient -domain, as long as the polynomials can be retracted to that domain, i.e., as -long as they are just constants. I don't see another way to do this, -unfortunately. - -<>= -)abb domain SUPEXPR SparseUnivariatePolynomialExpressions -SparseUnivariatePolynomialExpressions(R: Ring): Exports == Implementation where - - Exports == UnivariatePolynomialCategory R with - - if R has TranscendentalFunctionCategory - then TranscendentalFunctionCategory - - Implementation == SparseUnivariatePolynomial R add - - if R has TranscendentalFunctionCategory then - exp(p: %): % == - ground? p => coerce exp ground p - output(hconcat("exp p for p= ", p::OutputForm))$OutputPackage - error "SUPTRAFUN: exp only defined for elements of the coefficient ring" - sin(p: %): % == - ground? p => coerce sin ground p - output(hconcat("sin p for p= ", p::OutputForm))$OutputPackage - error "SUPTRAFUN: sin only defined for elements of the coefficient ring" - asin(p: %): % == - ground? p => coerce asin ground p - output(hconcat("asin p for p= ", p::OutputForm))$OutputPackage - error "SUPTRAFUN: asin only defined for elements of the coefficient ring" - cos(p: %): % == - ground? p => coerce cos ground p - output(hconcat("cos p for p= ", p::OutputForm))$OutputPackage - error "SUPTRAFUN: cos only defined for elements of the coefficient ring" - acos(p: %): % == - ground? p => coerce acos ground p - output(hconcat("acos p for p= ", p::OutputForm))$OutputPackage - error "SUPTRAFUN: acos only defined for elements of the coefficient ring" -@ - - -\section{package UTSSOL TaylorSolve} - -[[UTSSOL]] is a facility to compute the first few coefficients of a Taylor -series given only implicitely by a function [[f]] that vanishes when applied to -the Taylor series. - -It uses the method of undetermined coefficients. - -\begin{ToDo} - Could I either - \begin{itemize} - \item take a function [[UTSCAT F -> UTSCAT F]] and still be able to compute - with undetermined coefficients, or - \item take a function [[F -> F]], and do likewise? - \end{itemize} - - Let's see. - - Try to compute the equation without resorting to power series. I.e., % - [[c: SUP SUP F]], and [[f: SUP SUP F -> SUP SUP F]]. Won't this make the - computation of coefficients terribly slow? - - I could also try to replace transcendental kernels with variables\dots - - Unfortunately, [[SUP F]] does not have [[TRANFUN]] -- well, it can't, of - course. However, I'd like to be able to compute % - [[sin(1+monomial(1,1)$UFPS SUP EXPR INT)]]. -\end{ToDo} - -<>= -)abb package UTSSOL TaylorSolve -TaylorSolve(F, UTSF, UTSSUPF): Exports == Implementation where - F: Field - SUP ==> SparseUnivariatePolynomialExpressions - UTSF: UnivariateTaylorSeriesCategory F - UTSSUPF: UnivariateTaylorSeriesCategory SUP F - NNI ==> NonNegativeInteger - - Exports == with - seriesSolve: (UTSSUPF -> UTSSUPF, List F) -> UTSF - - Implementation == add -<> -@ - -<>= - seriesSolve(f, l) == - c1 := map(#1::(SUP F), l)$ListFunctions2(F, SUP F)::(Stream SUP F) - coeffs: Stream SUP F := concat(c1, generate(monomial(1$F,1$NNI))) --- coeffs: Stream SUP F := concat(c1, monomial(1$F,1$NNI)) -@ - -[[coeffs]] is the stream of the already computed coefficients of the solution, -plus one which is so far undetermined. We store in [[st.2]] the complete stream -and in [[st.1]] the stream starting with the first coefficient that has -possibly not yet been computed. - -\begin{ToDo} - The mathematics is not quite worked out. If [[coeffs]] is initialized as - stream with all coefficients set to the \emph{same} transcendental value, - and not enough initial values are given, then the missing ones are - implicitely assumed to be all identical. It may well happen that a solution - is produced, although it is not uniquely determined\dots -\end{ToDo} - -<>= - st: List Stream SUP F := [coeffs, coeffs] -@ - -Consider an arbitrary equation $f\big(x, y(x)\big)=0$. When setting $x=0$, we -obtain $f\big(0, y(0)\big)=0$. It is not necessarily the case that this -determines $y(0)$ uniquely, so we need one initial value that satisfies this -equation. -\begin{ToDo} - [[seriesSolve]] should check that the given initial values satisfy $f\big(0, y(0), - y'(0),...\big) = 0$. -\end{ToDo} -Now consider the derivatives of $f$, where we write $y$ instead of $y(x)$ for -better readability: -\begin{equation*} - \frac{d}{dx}f(x, y)=f_1(x, y) + f_2(x, y)y^\prime -\end{equation*} -and -\begin{align*} - \frac{d^2}{dx^2}f(x, y)&=f_{1,1}(x, y)\\ - &+f_{1,2}(x, y)y^\prime\\ - &+f_{2,1}(x, y)y^\prime\\ - &+f_{2,2}(x, y)(y^\prime)^2\\ - &+f_2(x, y)y^{\prime\prime}. -\end{align*} -In general, $\frac{d^2}{dx^2}f(x, y)$ depends only linearly on -$y^{\prime\prime}$. - -\begin{ToDo} - This points to another possibility: Since we know that we only need to solve - linear equations, we could compute two values and then use interpolation. - This might be a bit slower, but more importantly: can we still check that we - have enough initial values? Furthermore, we then really need that $f$ is - analytic, i.e., operators are not necessarily allowed anymore. However, it - seems that composition is allowed. -\end{ToDo} - -<>= - next: () -> F := - nr := st.1 - res: F - - if ground?(coeff: SUP F := nr.1)$(SUP F) -@ -%$ - -If the next element was already calculated, we can simply return it: - -<>= - then - res := ground coeff - st.1 := rest nr - else -@ - -Otherwise, we have to find the first non-satisfied relation and solve it. It -should be linear, or a single non-constant monomial. That is, the solution -should be unique. - -<>= - ns := st.2 - eqs: Stream SUP F := coefficients f series ns - while zero? first eqs repeat eqs := rest eqs - eq: SUP F := first eqs - if degree eq > 1 then - if monomial? eq then res := 0 - else - output(hconcat("The equation is: ", eq::OutputForm)) - $OutputPackage - error "seriesSolve: equation for coefficient not linear" - else res := (-coefficient(eq, 0$NNI)$(SUP F) - /coefficient(eq, 1$NNI)$(SUP F)) - - nr.1 := res::SUP F --- concat!(st.2, monomial(1$F,1$NNI)) - st.1 := rest nr - - res - - series generate next - -@ -%$ - - \section{package EXPRSOL ExpressionSolve} \begin{ToDo} @@ -332,7 +139,6 @@ works. This is probably due to missing [[/]] in [[UFPS]]. <<*>>= <> -<> <> diff --git a/src/algebra/stream.spad.pamphlet b/src/algebra/stream.spad.pamphlet index b3e1e18..8209bf6 100644 --- a/src/algebra/stream.spad.pamphlet +++ b/src/algebra/stream.spad.pamphlet @@ -77,837 +77,6 @@ CyclicStreamTools(S,ST): Exports == Implementation where x := rst x ; y := rst y @ -\section{domain STREAM Stream} -<>= --- stream.spad.pamphlet Stream.input -)spool Stream.output -)set message test on -)set message auto off -)clear all ---S 1 of 12 -ints := [i for i in 0..] ---R ---R ---R (1) [0,1,2,3,4,5,6,7,8,9,...] ---R Type: Stream NonNegativeInteger ---E 1 - ---S 2 of 12 -f : List INT -> List INT ---R ---R Type: Void ---E 2 - ---S 3 of 12 -f x == [x.1 + x.2, x.1] ---R ---R Type: Void ---E 3 - ---S 4 of 12 -fibs := [i.2 for i in [generate(f,[1,1])]] ---R ---R Compiling function f with type List Integer -> List Integer ---R ---R (4) [1,1,2,3,5,8,13,21,34,55,...] ---R Type: Stream Integer ---E 4 - ---S 5 of 12 -[i for i in ints | odd? i] ---R ---R ---R (5) [1,3,5,7,9,11,13,15,17,19,...] ---R Type: Stream NonNegativeInteger ---E 5 - ---S 6 of 12 -odds := [2*i+1 for i in ints] ---R ---R ---R (6) [1,3,5,7,9,11,13,15,17,19,...] ---R Type: Stream NonNegativeInteger ---E 6 - ---S 7 of 12 -scan(0,+,odds) ---R ---R ---R (7) [1,4,9,16,25,36,49,64,81,100,...] ---R Type: Stream NonNegativeInteger ---E 7 - ---S 8 of 12 -[i*j for i in ints for j in odds] ---R ---R ---R (8) [0,3,10,21,36,55,78,105,136,171,...] ---R Type: Stream NonNegativeInteger ---E 8 - ---S 9 of 12 -map(*,ints,odds) ---R ---R ---R (9) [0,3,10,21,36,55,78,105,136,171,...] ---R Type: Stream NonNegativeInteger ---E 9 - ---S 10 of 12 -first ints ---R ---R ---R (10) 0 ---R Type: NonNegativeInteger ---E 10 - ---S 11 of 12 -rest ints ---R ---R ---R (11) [1,2,3,4,5,6,7,8,9,10,...] ---R Type: Stream NonNegativeInteger ---E 11 - ---S 12 of 12 -fibs 20 ---R ---R ---R (12) 6765 ---R Type: PositiveInteger ---E 12 -)spool -)lisp (bye) -@ -<>= -==================================================================== -Stream examples -==================================================================== - -A Stream object is represented as a list whose last element contains -the wherewithal to create the next element, should it ever be required. - -Let ints be the infinite stream of non-negative integers. - - ints := [i for i in 0..] - [0,1,2,3,4,5,6,7,8,9,...] - Type: Stream NonNegativeInteger - -By default, ten stream elements are calculated. This number may be -changed to something else by the system command - )set streams calculate - -More generally, you can construct a stream by specifying its initial -value and a function which, when given an element, creates the next element. - - f : List INT -> List INT - Type: Void - - f x == [x.1 + x.2, x.1] - Type: Void - - fibs := [i.2 for i in [generate(f,[1,1])]] - [1,1,2,3,5,8,13,21,34,55,...] - Type: Stream Integer - -You can create the stream of odd non-negative integers by either filtering -them from the integers, or by evaluating an expression for each integer. - - [i for i in ints | odd? i] - [1,3,5,7,9,11,13,15,17,19,...] - Type: Stream NonNegativeInteger - - odds := [2*i+1 for i in ints] - [1,3,5,7,9,11,13,15,17,19,...] - Type: Stream NonNegativeInteger - -You can accumulate the initial segments of a stream using the scan operation. - - scan(0,+,odds) - [1,4,9,16,25,36,49,64,81,100,...] - Type: Stream NonNegativeInteger - -The corresponding elements of two or more streams can be combined in this way. - - [i*j for i in ints for j in odds] - [0,3,10,21,36,55,78,105,136,171,...] - Type: Stream NonNegativeInteger - - map(*,ints,odds) - [0,3,10,21,36,55,78,105,136,171,...] - Type: Stream NonNegativeInteger - -Many operations similar to those applicable to lists are available for -streams. - - first ints - 0 - Type: NonNegativeInteger - - rest ints - [1,2,3,4,5,6,7,8,9,10,...] - Type: Stream NonNegativeInteger - - fibs 20 - 6765 - Type: PositiveInteger - -See Also: -o )help StreamFunctions1 -o )help StreamFunctions2 -o )help StreamFunctions3 -o )show Stream -o $AXIOM/doc/src/algebra/stream.spad.dvi - -@ -<>= -)abbrev domain STREAM Stream -++ Implementation of streams via lazy evaluation -++ Authors: Burge, Watt; updated by Clifton J. Williamson -++ Date Created: July 1986 -++ Date Last Updated: 30 March 1990 -++ Keywords: stream, infinite list, infinite sequence -++ Examples: -++ References: -++ Description: -++ A stream is an implementation of an infinite sequence using -++ a list of terms that have been computed and a function closure -++ to compute additional terms when needed. - -Stream(S): Exports == Implementation where --- problems: --- 1) dealing with functions which basically want a finite structure --- 2) 'map' doesn't deal with cycles very well - - S : Type - B ==> Boolean - OUT ==> OutputForm - I ==> Integer - L ==> List - NNI ==> NonNegativeInteger - U ==> UniversalSegment I - - Exports ==> LazyStreamAggregate(S) with - shallowlyMutable - ++ one may destructively alter a stream by assigning new - ++ values to its entries. - - coerce: L S -> % - ++ coerce(l) converts a list l to a stream. - ++ - ++X m:=[1,2,3,4,5,6,7,8,9,10,11,12] - ++X coerce(m)@Stream(Integer) - ++X m::Stream(Integer) - - repeating: L S -> % - ++ repeating(l) is a repeating stream whose period is the list l. - ++ - ++X m:=repeating([-1,0,1,2,3]) - - if S has SetCategory then - repeating?: (L S,%) -> B - ++ repeating?(l,s) returns true if a stream s is periodic - ++ with period l, and false otherwise. - ++ - ++X m:=[1,2,3] - ++X n:=repeating(m) - ++X repeating?(m,n) - - findCycle: (NNI,%) -> Record(cycle?: B, prefix: NNI, period: NNI) - ++ findCycle(n,st) determines if st is periodic within n. - ++ - ++X m:=[1,2,3] - ++X n:=repeating(m) - ++X findCycle(3,n) - ++X findCycle(2,n) - - delay: (() -> %) -> % - ++ delay(f) creates a stream with a lazy evaluation defined by - ++ function f. - ++ Caution: This function can only be called in compiled code. - cons: (S,%) -> % - ++ cons(a,s) returns a stream whose \spad{first} is \spad{a} - ++ and whose \spad{rest} is s. - ++ Note: \spad{cons(a,s) = concat(a,s)}. - ++ - ++X m:=[1,2,3] - ++X n:=repeating(m) - ++X cons(4,n) - - if S has SetCategory then - output: (I, %) -> Void - ++ output(n,st) computes and displays the first n entries - ++ of st. - ++ - ++X m:=[1,2,3] - ++X n:=repeating(m) - ++X output(5,n) - - showAllElements: % -> OUT - ++ showAllElements(s) creates an output form which displays all - ++ computed elements. - ++ - ++X m:=[1,2,3,4,5,6,7,8,9,10,11,12] - ++X n:=m::Stream(PositiveInteger) - ++X showAllElements n - - showAll?: () -> B - ++ showAll?() returns true if all computed entries of streams - ++ will be displayed. - --!! this should be a function of one argument - setrest_!: (%,I,%) -> % - ++ setrest!(x,n,y) sets rest(x,n) to y. The function will expand - ++ cycles if necessary. - ++ - ++X p:=[i for i in 1..] - ++X q:=[i for i in 9..] - ++X setrest!(p,4,q) - ++X p - - generate: (() -> S) -> % - ++ generate(f) creates an infinite stream all of whose elements are - ++ equal to \spad{f()}. - ++ Note: \spad{generate(f) = [f(),f(),f(),...]}. - ++ - ++X f():Integer == 1 - ++X generate(f) - - generate: (S -> S,S) -> % - ++ generate(f,x) creates an infinite stream whose first element is - ++ x and whose nth element (\spad{n > 1}) is f applied to the previous - ++ element. Note: \spad{generate(f,x) = [x,f(x),f(f(x)),...]}. - ++ - ++X f(x:Integer):Integer == x+10 - ++X generate(f,10) - - filterWhile: (S -> Boolean,%) -> % - ++ filterWhile(p,s) returns \spad{[x0,x1,...,x(n-1)]} where - ++ \spad{s = [x0,x1,x2,..]} and - ++ n is the smallest index such that \spad{p(xn) = false}. - ++ - ++X m:=[i for i in 1..] - ++X f(x:PositiveInteger):Boolean == x < 5 - ++X filterWhile(f,m) - - filterUntil: (S -> Boolean,%) -> % - ++ filterUntil(p,s) returns \spad{[x0,x1,...,x(n)]} where - ++ \spad{s = [x0,x1,x2,..]} and - ++ n is the smallest index such that \spad{p(xn) = true}. - ++ - ++X m:=[i for i in 1..] - ++X f(x:PositiveInteger):Boolean == x < 5 - ++X filterUntil(f,m) - --- if S has SetCategory then --- map: ((S,S) -> S,%,%,S) -> % --- ++ map(f,x,y,a) is equivalent to map(f,x,y) --- ++ If z = map(f,x,y,a), then z = map(f,x,y) except if --- ++ x.n = a and rest(rest(x,n)) = rest(x,n) in which case --- ++ rest(z,n) = rest(y,n) or if y.m = a and rest(rest(y,m)) = --- ++ rest(y,m) in which case rest(z,n) = rest(x,n). --- ++ Think of the case where f(xi,yi) = xi + yi and a = 0. - - Implementation ==> add - MIN ==> 1 -- minimal stream index; see also the defaults in LZSTAGG - x:% - - import CyclicStreamTools(S,%) - ---% representation - - -- This description of the rep is not quite true. - -- The Rep is a pair of one of three forms: - -- [value: S, rest: %] - -- [nullstream: Magic, NIL ] - -- [nonnullstream: Magic, fun: () -> %] - -- Could use a record of unions if we could guarantee no tags. - - NullStream: S := _$NullStream$Lisp pretend S - NonNullStream: S := _$NonNullStream$Lisp pretend S - - Rep := Record(firstElt: S, restOfStream: %) - - explicitlyEmpty? x == EQ(frst x,NullStream)$Lisp - lazy? x == EQ(frst x,NonNullStream)$Lisp - ---% signatures of local functions - - setfrst_! : (%,S) -> S - setrst_! : (%,%) -> % - setToNil_! : % -> % - setrestt_! : (%,I,%) -> % - lazyEval : % -> % - expand_! : (%,I) -> % - ---% functions to access or change record fields without lazy evaluation - - frst x == x.firstElt - rst x == x.restOfStream - - setfrst_!(x,s) == x.firstElt := s - setrst_!(x,y) == x.restOfStream := y - - setToNil_! x == - -- destructively changes x to a null stream - setfrst_!(x,NullStream); setrst_!(x,NIL$Lisp) - x - ---% SETCAT functions - - if S has SetCategory then - - getm : (%,L OUT,I) -> L OUT - streamCountCoerce : % -> OUT - listm : (%,L OUT,I) -> L OUT - - getm(x,le,n) == - explicitlyEmpty? x => le - lazy? x => - n > 0 => - empty? x => le - getm(rst x,concat(frst(x) :: OUT,le),n - 1) - concat(message("..."),le) - eq?(x,rst x) => concat(overbar(frst(x) :: OUT),le) - n > 0 => getm(rst x,concat(frst(x) :: OUT,le),n - 1) - concat(message("..."),le) - - streamCountCoerce x == - -- this will not necessarily display all stream elements - -- which have been computed - count := _$streamCount$Lisp - -- compute count elements - y := x - for i in 1..count while not empty? y repeat y := rst y - fc := findCycle(count,x) - not fc.cycle? => bracket reverse_! getm(x,empty(),count) - le : L OUT := empty() - for i in 1..fc.prefix repeat - le := concat(first(x) :: OUT,le) - x := rest x - pp : OUT := - fc.period = 1 => overbar(frst(x) :: OUT) - pl : L OUT := empty() - for i in 1..fc.period repeat - pl := concat(frst(x) :: OUT,pl) - x := rest x - overbar commaSeparate reverse_! pl - bracket reverse_! concat(pp,le) - - listm(x,le,n) == - explicitlyEmpty? x => le - lazy? x => - n > 0 => - empty? x => le - listm(rst x, concat(frst(x) :: OUT,le),n-1) - concat(message("..."),le) - listm(rst x,concat(frst(x) :: OUT,le),n-1) - - showAllElements x == - -- this will display all stream elements which have been computed - -- and will display at least n elements with n = streamCount$Lisp - extend(x,_$streamCount$Lisp) - cycElt := cycleElt x - cycElt case "failed" => - le := listm(x,empty(),_$streamCount$Lisp) - bracket reverse_! le - cycEnt := computeCycleEntry(x,cycElt :: %) - le : L OUT := empty() - while not eq?(x,cycEnt) repeat - le := concat(frst(x) :: OUT,le) - x := rst x - len := computeCycleLength(cycElt :: %) - pp : OUT := - len = 1 => overbar(frst(x) :: OUT) - pl : L OUT := [] - for i in 1..len repeat - pl := concat(frst(x) :: OUT,pl) - x := rst x - overbar commaSeparate reverse_! pl - bracket reverse_! concat(pp,le) - - showAll?() == - NULL(_$streamsShowAll$Lisp)$Lisp => false - true - - coerce(x):OUT == - showAll?() => showAllElements x - streamCountCoerce x - ---% AGG functions - - lazyCopy:% -> % - lazyCopy x == delay - empty? x => empty() - concat(frst x, copy rst x) - - copy x == - cycElt := cycleElt x - cycElt case "failed" => lazyCopy x - ce := cycElt :: % - len := computeCycleLength(ce) - e := computeCycleEntry(x,ce) - d := distance(x,e) - cycle := complete first(e,len) - setrst_!(tail cycle,cycle) - d = 0 => cycle - head := complete first(x,d::NNI) - setrst_!(tail head,cycle) - head - ---% CNAGG functions - - construct l == - -- copied from defaults to avoid loading defaults - empty? l => empty() - concat(first l, construct rest l) - ---% ELTAGG functions - - elt(x:%,n:I) == - -- copied from defaults to avoid loading defaults - n < MIN or empty? x => error "elt: no such element" - n = MIN => frst x - elt(rst x,n - 1) - - seteltt:(%,I,S) -> S - seteltt(x,n,s) == - n = MIN => setfrst_!(x,s) - seteltt(rst x,n - 1,s) - - setelt(x,n:I,s:S) == - n < MIN or empty? x => error "setelt: no such element" - x := expand_!(x,n - MIN + 1) - seteltt(x,n,s) - ---% IXAGG functions - - removee: ((S -> Boolean),%) -> % - removee(p,x) == delay - empty? x => empty() - p(frst x) => remove(p,rst x) - concat(frst x,remove(p,rst x)) - - remove(p,x) == - explicitlyEmpty? x => empty() - eq?(x,rst x) => - p(frst x) => empty() - x - removee(p,x) - - selectt: ((S -> Boolean),%) -> % - selectt(p,x) == delay - empty? x => empty() - not p(frst x) => select(p, rst x) - concat(frst x,select(p,rst x)) - - select(p,x) == - explicitlyEmpty? x => empty() - eq?(x,rst x) => - p(frst x) => x - empty() - selectt(p,x) - - map(f,x) == - map(f,x pretend Stream(S))$StreamFunctions2(S,S) pretend % - - map(g,x,y) == - xs := x pretend Stream(S); ys := y pretend Stream(S) - map(g,xs,ys)$StreamFunctions3(S,S,S) pretend % - - fill_!(x,s) == - setfrst_!(x,s) - setrst_!(x,x) - - map_!(f,x) == - -- too many problems with map_! on a lazy stream, so - -- in this case, an error message is returned - cyclic? x => - tail := cycleTail x ; y := x - until y = tail repeat - setfrst_!(y,f frst y) - y := rst y - x - explicitlyFinite? x => - y := x - while not empty? y repeat - setfrst_!(y,f frst y) - y := rst y - x - error "map!: stream with lazy evaluation" - - swap_!(x,m,n) == - (not index?(m,x)) or (not index?(n,x)) => - error "swap!: no such elements" - x := expand_!(x,max(m,n) - MIN + 1) - xm := elt(x,m); xn := elt(x,n) - setelt(x,m,xn); setelt(x,n,xm) - x - ---% LNAGG functions - - concat(x:%,s:S) == delay - empty? x => concat(s,empty()) - concat(frst x,concat(rst x,s)) - - concat(x:%,y:%) == delay - empty? x => copy y - concat(frst x,concat(rst x, y)) - - concat l == delay - empty? l => empty() - empty?(x := first l) => concat rest l - concat(frst x,concat(rst x,concat rest l)) - - setelt(x,seg:U,s:S) == - low := lo seg - hasHi seg => - high := hi seg - high < low => s - (not index?(low,x)) or (not index?(high,x)) => - error "setelt: index out of range" - x := expand_!(x,high - MIN + 1) - y := rest(x,(low - MIN) :: NNI) - for i in 0..(high-low) repeat - setfrst_!(y,s) - y := rst y - s - not index?(low,x) => error "setelt: index out of range" - x := rest(x,(low - MIN) :: NNI) - setrst_!(x,x) - setfrst_!(x,s) - ---% RCAGG functions - - empty() == [NullStream, NIL$Lisp] - - lazyEval x == (rst(x):(()-> %)) () - - lazyEvaluate x == - st := lazyEval x - setfrst_!(x, frst st) - setrst_!(x,if EQ(rst st,st)$Lisp then x else rst st) - x - - -- empty? is the only function that explicitly causes evaluation - -- of a stream element - empty? x == - while lazy? x repeat - st := lazyEval x - setfrst_!(x, frst st) - setrst_!(x,if EQ(rst st,st)$Lisp then x else rst st) - explicitlyEmpty? x - - --setvalue(x,s) == setfirst_!(x,s) - - --setchildren(x,l) == - --empty? l => error "setchildren: empty list of children" - --not(empty? rest l) => error "setchildren: wrong number of children" - --setrest_!(x,first l) - ---% URAGG functions - - first(x,n) == delay - -- former name: take - n = 0 or empty? x => empty() - (concat(frst x, first(rst x,(n-1) :: NNI))) - - concat(s:S,x:%) == [s,x] - cons(s,x) == concat(s,x) - - cycleSplit_! x == - cycElt := cycleElt x - cycElt case "failed" => - error "cycleSplit_!: non-cyclic stream" - y := computeCycleEntry(x,cycElt :: %) - eq?(x,y) => (setToNil_! x; return y) - z := rst x - repeat - eq?(y,z) => (setrest_!(x,empty()); return y) - x := z ; z := rst z - - expand_!(x,n) == - -- expands cycles (if necessary) so that the first n - -- elements of x will not be part of a cycle - n < 1 => x - y := x - for i in 1..n while not empty? y repeat y := rst y - cycElt := cycleElt x - cycElt case "failed" => x - e := computeCycleEntry(x,cycElt :: %) - d : I := distance(x,e) - d >= n => x - if d = 0 then - -- roll the cycle 1 entry - d := 1 - t := cycleTail e - if eq?(t,e) then - t := concat(frst t,empty()) - e := setrst_!(t,t) - setrst_!(x,e) - else - setrst_!(t,concat(frst e,rst e)) - e := rst e - nLessD := (n-d) :: NNI - y := complete first(e,nLessD) - e := rest(e,nLessD) - setrst_!(tail y,e) - setrst_!(rest(x,(d-1) :: NNI),y) - x - - first x == - empty? x => error "Can't take the first of an empty stream." - frst x - - concat_!(x:%,y:%) == - empty? x => y - setrst_!(tail x,y) - - concat_!(x:%,s:S) == - concat_!(x,concat(s,empty())) - - setfirst_!(x,s) == setelt(x,0,s) - setelt(x,"first",s) == setfirst_!(x,s) - setrest_!(x,y) == - empty? x => error "setrest!: empty stream" - setrst_!(x,y) - setelt(x,"rest",y) == setrest_!(x,y) - - setlast_!(x,s) == - empty? x => error "setlast!: empty stream" - setfrst_!(tail x, s) - setelt(x,"last",s) == setlast_!(x,s) - - split_!(x,n) == - n < MIN => error "split!: index out of range" - n = MIN => - y : % := empty() - setfrst_!(y,frst x) - setrst_!(y,rst x) - setToNil_! x - y - x := expand_!(x,n - MIN) - x := rest(x,(n - MIN - 1) :: NNI) - y := rest x - setrst_!(x,empty()) - y - ---% STREAM functions - - coerce(l: L S) == construct l - - repeating l == - empty? l => - error "Need a non-null list to make a repeating stream." - x0 : % := x := construct l - while not empty? rst x repeat x := rst x - setrst_!(x,x0) - - if S has SetCategory then - - repeating?(l, x) == - empty? l => - error "Need a non-empty? list to make a repeating stream." - empty? rest l => - not empty? x and frst x = first l and x = rst x - x0 := x - for s in l repeat - empty? x or s ^= frst x => return false - x := rst x - eq?(x,x0) - - findCycle(n, x) == - hd := x - -- Determine whether periodic within n. - tl := rest(x, n) - explicitlyEmpty? tl => [false, 0, 0] - i := 0; while not eq?(x,tl) repeat (x := rst x; i := i + 1) - i = n => [false, 0, 0] - -- Find period. Now x=tl, so step over and find it again. - x := rst x; per := 1 - while not eq?(x,tl) repeat (x := rst x; per := per + 1) - -- Find non-periodic part. - x := hd; xp := rest(hd, per); npp := 0 - while not eq?(x,xp) repeat (x := rst x; xp := rst xp; npp := npp+1) - [true, npp, per] - - delay(fs:()->%) == [NonNullStream, fs pretend %] - --- explicitlyEmpty? x == markedNull? x - - explicitEntries? x == - not explicitlyEmpty? x and not lazy? x - - numberOfComputedEntries x == - explicitEntries? x => numberOfComputedEntries(rst x) + 1 - 0 - - if S has SetCategory then - - output(n,x) == - (not(n>0))or empty? x => void() - mathPrint(frst(x)::OUT)$Lisp - output(n-1, rst x) - - setrestt_!(x,n,y) == - n = 0 => setrst_!(x,y) - setrestt_!(rst x,n-1,y) - - setrest_!(x,n,y) == - n < 0 or empty? x => error "setrest!: no such rest" - x := expand_!(x,n+1) - setrestt_!(x,n,y) - - generate f == delay concat(f(), generate f) - gen:(S -> S,S) -> % - gen(f,s) == delay(ss:=f s; concat(ss, gen(f,ss))) - generate(f,s)==concat(s,gen(f,s)) - - concat(x:%,y:%) ==delay - empty? x => y - concat(frst x,concat(rst x,y)) - - swhilee:(S -> Boolean,%) -> % - swhilee(p,x) == delay - empty? x => empty() - not p(frst x) => empty() - concat(frst x,filterWhile(p,rst x)) - filterWhile(p,x)== - explicitlyEmpty? x => empty() - eq?(x,rst x) => - p(frst x) => x - empty() - swhilee(p,x) - - suntill: (S -> Boolean,%) -> % - suntill(p,x) == delay - empty? x => empty() - p(frst x) => concat(frst x,empty()) - concat(frst x, filterUntil(p, rst x)) - - filterUntil(p,x)== - explicitlyEmpty? x => empty() - eq?(x,rst x) => - p(frst x) => concat(frst x,empty()) - x - suntill(p,x) - --- if S has SetCategory then --- mapp: ((S,S) -> S,%,%,S) -> % --- mapp(f,x,y,a) == delay --- empty? x or empty? y => empty() --- concat(f(frst x,frst y), map(f,rst x,rst y,a)) --- map(f,x,y,a) == --- explicitlyEmpty? x => empty() --- eq?(x,rst x) => --- frst x=a => y --- map(f(frst x,#1),y) --- explicitlyEmpty? y => empty() --- eq?(y,rst y) => --- frst y=a => x --- p(f(#1,frst y),x) --- mapp(f,x,y,a) - -@ \section{package STREAM1 StreamFunctions1} <>= )abbrev package STREAM1 StreamFunctions1 @@ -1089,7 +258,6 @@ StreamFunctions3(A,B,C): Exports == Implementation where <> <> -<> <> <> <> diff --git a/src/algebra/string.spad.pamphlet b/src/algebra/string.spad.pamphlet deleted file mode 100644 index a704234..0000000 --- a/src/algebra/string.spad.pamphlet +++ /dev/null @@ -1,1790 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra string.spad} -\author{Stephen M. Watt, Michael Monagan, Manuel Bronstein} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{domain CHAR Character} -<>= --- string.spad.pamphlet Character.input -)spool Character.output -)set message test on -)set message auto off -)clear all ---S 1 -chars := [char "a", char "A", char "X", char "8", char "+"] ---R ---R ---R (1) [a,A,X,8,+] ---R Type: List Character ---E 1 - ---S 2 -space() ---R ---R ---R (2) ---R Type: Character ---E 2 - ---S 3 -quote() ---R ---R ---R (3) " ---R Type: Character ---E 3 - ---S 4 -escape() ---R ---R ---R (4) _ ---R Type: Character ---E 4 - ---S 5 -[ord c for c in chars] ---R ---R ---R (5) [97,65,88,56,43] ---R Type: List Integer ---E 5 - ---S 6 -[upperCase c for c in chars] ---R ---R ---R (6) [A,A,X,8,+] ---R Type: List Character ---E 6 - ---S 7 -[lowerCase c for c in chars] ---R ---R ---R (7) [a,a,x,8,+] ---R Type: List Character ---E 7 - ---S 8 -[alphabetic? c for c in chars] ---R ---R ---R (8) [true,true,true,false,false] ---R Type: List Boolean ---E 8 - ---S 9 -[upperCase? c for c in chars] ---R ---R ---R (9) [false,true,true,false,false] ---R Type: List Boolean ---E 9 - ---S 10 -[lowerCase? c for c in chars] ---R ---R ---R (10) [true,false,false,false,false] ---R Type: List Boolean ---E 10 - ---S 11 -[digit? c for c in chars] ---R ---R ---R (11) [false,false,false,true,false] ---R Type: List Boolean ---E 11 - ---S 12 -[hexDigit? c for c in chars] ---R ---R ---R (12) [true,true,false,true,false] ---R Type: List Boolean ---E 12 - ---S 13 -[alphanumeric? c for c in chars] ---R ---R ---R (13) [true,true,true,true,false] ---R Type: List Boolean ---E 13 -)spool -)lisp (bye) -@ -<>= -==================================================================== -Character examples -==================================================================== - -The members of the domain Character are values representing letters, -numerals and other text elements. - -Characters can be obtained using String notation. - - chars := [char "a", char "A", char "X", char "8", char "+"] - [a,A,X,8,+] - Type: List Character - -Certain characters are available by name. This is the blank character. - - space() - - Type: Character - -This is the quote that is used in strings. - - quote() - " - Type: Character - -This is the escape character that allows quotes and other characters -within strings. - - escape() - _ - Type: Character - -Characters are represented as integers in a machine-dependent way. -The integer value can be obtained using the ord operation. It is -always true that char(ord c) = c and ord(char i) = i, provided that i -is in the range 0..size()$Character-1. - - [ord c for c in chars] - [97,65,88,56,43] - Type: List Integer - -The lowerCase operation converts an upper case letter to the -corresponding lower case letter. If the argument is not an upper case -letter, then it is returned unchanged. - - [upperCase c for c in chars] - [A,A,X,8,+] - Type: List Character - -The upperCase operation converts lower case letters to upper case. - - [lowerCase c for c in chars] - [a,a,x,8,+] - Type: List Character - -A number of tests are available to determine whether characters -belong to certain families. - - [alphabetic? c for c in chars] - [true,true,true,false,false] - Type: List Boolean - - [upperCase? c for c in chars] - [false,true,true,false,false] - Type: List Boolean - - [lowerCase? c for c in chars] - [true,false,false,false,false] - Type: List Boolean - - [digit? c for c in chars] - [false,false,false,true,false] - Type: List Boolean - - [hexDigit? c for c in chars] - [true,true,false,true,false] - Type: List Boolean - - [alphanumeric? c for c in chars] - [true,true,true,true,false] - Type: List Boolean - -See Also: -o )help CharacterClass -o )help String -o )show Character -o $AXIOM/doc/src/algebra/string.spad.dvi - -@ -<>= -)abbrev domain CHAR Character -++ Author: Stephen M. Watt -++ Date Created: July 1986 -++ Date Last Updated: June 20, 1991 -++ Basic Operations: char -++ Related Domains: -++ Also See: -++ AMS Classifications: -++ Keywords: character, string -++ Examples: -++ References: -++ Description: -++ This domain provides the basic character data type. - -Character: OrderedFinite() with - ord: % -> Integer - ++ ord(c) provides an integral code corresponding to the - ++ character c. It is always true that \spad{char ord c = c}. - ++ - ++X chars := [char "a", char "A", char "X", char "8", char "+"] - ++X [ord c for c in chars] - char: Integer -> % - ++ char(i) provides a character corresponding to the integer - ++ code i. It is always true that \spad{ord char i = i}. - ++ - ++X [char c for c in [97,65,88,56,43]] - char: String -> % - ++ char(s) provides a character from a string s of length one. - ++ - ++X [char c for c in ["a","A","X","8","+"]] - space: () -> % - ++ space() provides the blank character. - ++ - ++X space() - quote: () -> % - ++ quote() provides the string quote character, \spad{"}. - ++ - ++X quote() - escape: () -> % - ++ escape() provides the escape character, \spad{_}, which - ++ is used to allow quotes and other characters {\em within} - ++ strings. - ++ - ++X escape() - upperCase: % -> % - ++ upperCase(c) converts a lower case letter to the corresponding - ++ upper case letter. If c is not a lower case letter, then - ++ it is returned unchanged. - ++ - ++X chars := [char "a", char "A", char "X", char "8", char "+"] - ++X [upperCase c for c in chars] - lowerCase: % -> % - ++ lowerCase(c) converts an upper case letter to the corresponding - ++ lower case letter. If c is not an upper case letter, then - ++ it is returned unchanged. - ++ - ++X chars := [char "a", char "A", char "X", char "8", char "+"] - ++X [lowerCase c for c in chars] - digit?: % -> Boolean - ++ digit?(c) tests if c is a digit character, - ++ i.e. one of 0..9. - ++ - ++X chars := [char "a", char "A", char "X", char "8", char "+"] - ++X [digit? c for c in chars] - hexDigit?: % -> Boolean - ++ hexDigit?(c) tests if c is a hexadecimal numeral, - ++ i.e. one of 0..9, a..f or A..F. - ++ - ++X chars := [char "a", char "A", char "X", char "8", char "+"] - ++X [hexDigit? c for c in chars] - alphabetic?: % -> Boolean - ++ alphabetic?(c) tests if c is a letter, - ++ i.e. one of a..z or A..Z. - ++ - ++X chars := [char "a", char "A", char "X", char "8", char "+"] - ++X [alphabetic? c for c in chars] - upperCase?: % -> Boolean - ++ upperCase?(c) tests if c is an upper case letter, - ++ i.e. one of A..Z. - ++ - ++X chars := [char "a", char "A", char "X", char "8", char "+"] - ++X [upperCase? c for c in chars] - lowerCase?: % -> Boolean - ++ lowerCase?(c) tests if c is an lower case letter, - ++ i.e. one of a..z. - ++ - ++X chars := [char "a", char "A", char "X", char "8", char "+"] - ++X [lowerCase? c for c in chars] - alphanumeric?: % -> Boolean - ++ alphanumeric?(c) tests if c is either a letter or number, - ++ i.e. one of 0..9, a..z or A..Z. - ++ - ++X chars := [char "a", char "A", char "X", char "8", char "+"] - ++X [alphanumeric? c for c in chars] - - == add - - Rep := SingleInteger -- 0..255 - - CC ==> CharacterClass() - import CC - - OutChars:PrimitiveArray(OutputForm) := - construct [NUM2CHAR(i)$Lisp for i in 0..255] - - minChar := minIndex OutChars - - a = b == a =$Rep b - a < b == a <$Rep b - size() == 256 - index n == char((n - 1)::Integer) - lookup c == (1 + ord c)::PositiveInteger - char(n:Integer) == n::% - ord c == convert(c)$Rep - random() == char(random()$Integer rem size()) - space == QENUM(" ", 0$Lisp)$Lisp - quote == QENUM("_" ", 0$Lisp)$Lisp - escape == QENUM("__ ", 0$Lisp)$Lisp - coerce(c:%):OutputForm == OutChars(minChar + ord c) - digit? c == member?(c pretend Character, digit()) - hexDigit? c == member?(c pretend Character, hexDigit()) - upperCase? c == member?(c pretend Character, upperCase()) - lowerCase? c == member?(c pretend Character, lowerCase()) - alphabetic? c == member?(c pretend Character, alphabetic()) - alphanumeric? c == member?(c pretend Character, alphanumeric()) - - latex c == - concat("\mbox{`", concat(new(1,c pretend Character)$String, "'}")_ - $String)$String - - char(s:String) == - (#s) = 1 => s(minIndex s) pretend % - error "String is not a single character" - - upperCase c == - QENUM(PNAME(UPCASE(NUM2CHAR(ord c)$Lisp)$Lisp)$Lisp,0$Lisp)$Lisp - - lowerCase c == - QENUM(PNAME(DOWNCASE(NUM2CHAR(ord c)$Lisp)$Lisp)$Lisp,0$Lisp)$Lisp - -@ -\section{CHAR.lsp BOOTSTRAP} -{\bf CHAR} depends on a chain of -files. We need to break this cycle to build the algebra. So we keep a -cached copy of the translated {\bf CHAR} category which we can write -into the {\bf MID} directory. We compile the lisp code and copy the -{\bf CHAR.o} file to the {\bf OUT} directory. This is eventually -forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<>= - - -(|/VERSIONCHECK| 2) - -(PUT (QUOTE |CHAR;=;2$B;1|) (QUOTE |SPADreplace|) (QUOTE EQL)) - -(DEFUN |CHAR;=;2$B;1| (|a| |b| |$|) (EQL |a| |b|)) - -(PUT (QUOTE |CHAR;<;2$B;2|) (QUOTE |SPADreplace|) (QUOTE QSLESSP)) - -(DEFUN |CHAR;<;2$B;2| (|a| |b| |$|) (QSLESSP |a| |b|)) - -(PUT (QUOTE |CHAR;size;Nni;3|) (QUOTE |SPADreplace|) (QUOTE (XLAM NIL 256))) - -(DEFUN |CHAR;size;Nni;3| (|$|) 256) - -(DEFUN |CHAR;index;Pi$;4| (|n| |$|) (SPADCALL (|-| |n| 1) (QREFELT |$| 18))) - -(DEFUN |CHAR;lookup;$Pi;5| (|c| |$|) - (PROG (#1=#:G90919) - (RETURN - (PROG1 - (LETT #1# (|+| 1 (SPADCALL |c| (QREFELT |$| 21))) |CHAR;lookup;$Pi;5|) - (|check-subtype| (|>| #1# 0) (QUOTE (|PositiveInteger|)) #1#))))) - -(DEFUN |CHAR;char;I$;6| (|n| |$|) (SPADCALL |n| (QREFELT |$| 23))) - -(PUT (QUOTE |CHAR;ord;$I;7|) (QUOTE |SPADreplace|) (QUOTE (XLAM (|c|) |c|))) - -(DEFUN |CHAR;ord;$I;7| (|c| |$|) |c|) - -(DEFUN |CHAR;random;$;8| (|$|) - (SPADCALL (REMAINDER2 (|random|) (SPADCALL (QREFELT |$| 16))) - (QREFELT |$| 18))) - -(PUT (QUOTE |CHAR;space;$;9|) - (QUOTE |SPADreplace|) (QUOTE (XLAM NIL (QENUM " " 0)))) - -(DEFUN |CHAR;space;$;9| (|$|) (QENUM " " 0)) - -(PUT (QUOTE |CHAR;quote;$;10|) - (QUOTE |SPADreplace|) (QUOTE (XLAM NIL (QENUM "\" " 0)))) - -(DEFUN |CHAR;quote;$;10| (|$|) (QENUM "\" " 0)) - -(PUT (QUOTE |CHAR;escape;$;11|) - (QUOTE |SPADreplace|) (QUOTE (XLAM NIL (QENUM "_ " 0)))) - -(DEFUN |CHAR;escape;$;11| (|$|) (QENUM "_ " 0)) - -(DEFUN |CHAR;coerce;$Of;12| (|c| |$|) - (ELT (QREFELT |$| 10) - (|+| (QREFELT |$| 11) (SPADCALL |c| (QREFELT |$| 21))))) - -(DEFUN |CHAR;digit?;$B;13| (|c| |$|) - (SPADCALL |c| (|spadConstant| |$| 31) (QREFELT |$| 33))) - -(DEFUN |CHAR;hexDigit?;$B;14| (|c| |$|) - (SPADCALL |c| (|spadConstant| |$| 35) (QREFELT |$| 33))) - -(DEFUN |CHAR;upperCase?;$B;15| (|c| |$|) - (SPADCALL |c| (|spadConstant| |$| 37) (QREFELT |$| 33))) - -(DEFUN |CHAR;lowerCase?;$B;16| (|c| |$|) - (SPADCALL |c| (|spadConstant| |$| 39) (QREFELT |$| 33))) - -(DEFUN |CHAR;alphabetic?;$B;17| (|c| |$|) - (SPADCALL |c| (|spadConstant| |$| 41) (QREFELT |$| 33))) - -(DEFUN |CHAR;alphanumeric?;$B;18| (|c| |$|) - (SPADCALL |c| (|spadConstant| |$| 43) (QREFELT |$| 33))) - -(DEFUN |CHAR;latex;$S;19| (|c| |$|) - (STRCONC "\\mbox{`" (STRCONC (|MAKE-FULL-CVEC| 1 |c|) "'}"))) - -(DEFUN |CHAR;char;S$;20| (|s| |$|) - (COND - ((EQL (QCSIZE |s|) 1) - (SPADCALL |s| (SPADCALL |s| (QREFELT |$| 47)) (QREFELT |$| 48))) - ((QUOTE T) (|error| "String is not a single character")))) - -(DEFUN |CHAR;upperCase;2$;21| (|c| |$|) - (QENUM (PNAME (UPCASE (NUM2CHAR (SPADCALL |c| (QREFELT |$| 21))))) 0)) - -(DEFUN |CHAR;lowerCase;2$;22| (|c| |$|) - (QENUM (PNAME (DOWNCASE (NUM2CHAR (SPADCALL |c| (QREFELT |$| 21))))) 0)) - -(DEFUN |Character| NIL - (PROG NIL - (RETURN - (PROG (#1=#:G90941) - (RETURN - (COND - ((LETT #1# (HGET |$ConstructorCache| (QUOTE |Character|)) |Character|) - (|CDRwithIncrement| (CDAR #1#))) - ((QUOTE T) - (|UNWIND-PROTECT| - (PROG1 - (CDDAR - (HPUT |$ConstructorCache| (QUOTE |Character|) - (LIST (CONS NIL (CONS 1 (|Character;|)))))) - (LETT #1# T |Character|)) - (COND - ((NOT #1#) (HREM |$ConstructorCache| (QUOTE |Character|)))))))))))) - -(DEFUN |Character;| NIL - (PROG (|dv$| |$| |pv$| #1=#:G90939 |i|) - (RETURN - (SEQ - (PROGN - (LETT |dv$| (QUOTE (|Character|)) . #2=(|Character|)) - (LETT |$| (GETREFV 53) . #2#) - (QSETREFV |$| 0 |dv$|) - (QSETREFV |$| 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #2#)) - (|haddProp| |$ConstructorCache| (QUOTE |Character|) NIL (CONS 1 |$|)) - (|stuffDomainSlots| |$|) - (QSETREFV |$| 6 (|SingleInteger|)) - (QSETREFV |$| 10 - (SPADCALL - (PROGN - (LETT #1# NIL . #2#) - (SEQ - (LETT |i| 0 . #2#) - G190 - (COND ((QSGREATERP |i| 255) (GO G191))) - (SEQ (EXIT (LETT #1# (CONS (NUM2CHAR |i|) #1#) . #2#))) - (LETT |i| (QSADD1 |i|) . #2#) - (GO G190) - G191 - (EXIT (NREVERSE0 #1#)))) - (QREFELT |$| 9))) - (QSETREFV |$| 11 0) |$|))))) - -(MAKEPROP (QUOTE |Character|) (QUOTE |infovec|) - (LIST (QUOTE - #(NIL NIL NIL NIL NIL NIL (QUOTE |Rep|) (|List| 28) (|PrimitiveArray| 28) - (0 . |construct|) (QUOTE |OutChars|) (QUOTE |minChar|) (|Boolean|) - |CHAR;=;2$B;1| |CHAR;<;2$B;2| (|NonNegativeInteger|) |CHAR;size;Nni;3| - (|Integer|) |CHAR;char;I$;6| (|PositiveInteger|) |CHAR;index;Pi$;4| - |CHAR;ord;$I;7| |CHAR;lookup;$Pi;5| (5 . |coerce|) |CHAR;random;$;8| - |CHAR;space;$;9| |CHAR;quote;$;10| |CHAR;escape;$;11| (|OutputForm|) - |CHAR;coerce;$Of;12| (|CharacterClass|) (10 . |digit|) (|Character|) - (14 . |member?|) |CHAR;digit?;$B;13| (20 . |hexDigit|) - |CHAR;hexDigit?;$B;14| (24 . |upperCase|) |CHAR;upperCase?;$B;15| - (28 . |lowerCase|) |CHAR;lowerCase?;$B;16| (32 . |alphabetic|) - |CHAR;alphabetic?;$B;17| (36 . |alphanumeric|) |CHAR;alphanumeric?;$B;18| - (|String|) |CHAR;latex;$S;19| (40 . |minIndex|) (45 . |elt|) - |CHAR;char;S$;20| |CHAR;upperCase;2$;21| |CHAR;lowerCase;2$;22| - (|SingleInteger|))) (QUOTE #(|~=| 51 |upperCase?| 57 |upperCase| 62 - |space| 67 |size| 71 |random| 75 |quote| 79 |ord| 83 |min| 88 |max| 94 - |lowerCase?| 100 |lowerCase| 105 |lookup| 110 |latex| 115 |index| 120 - |hexDigit?| 125 |hash| 130 |escape| 135 |digit?| 139 |coerce| 144 |char| - 149 |alphanumeric?| 159 |alphabetic?| 164 |>=| 169 |>| 175 |=| 181 |<=| - 187 |<| 193)) (QUOTE NIL) - (CONS - (|makeByteWordVec2| 1 (QUOTE (0 0 0 0 0 0))) - (CONS - (QUOTE #(NIL |OrderedSet&| NIL |SetCategory&| |BasicType&| NIL)) - (CONS - (QUOTE #((|OrderedFinite|) (|OrderedSet|) (|Finite|) (|SetCategory|) - (|BasicType|) (|CoercibleTo| 28))) - (|makeByteWordVec2| 52 - (QUOTE (1 8 0 7 9 1 6 0 17 23 0 30 0 31 2 30 12 32 0 33 0 30 0 35 - 0 30 0 37 0 30 0 39 0 30 0 41 0 30 0 43 1 45 17 0 47 2 45 - 32 0 17 48 2 0 12 0 0 1 1 0 12 0 38 1 0 0 0 50 0 0 0 25 0 - 0 15 16 0 0 0 24 0 0 0 26 1 0 17 0 21 2 0 0 0 0 1 2 0 0 0 - 0 1 1 0 12 0 40 1 0 0 0 51 1 0 19 0 22 1 0 45 0 46 1 0 0 19 - 20 1 0 12 0 36 1 0 52 0 1 0 0 0 27 1 0 12 0 34 1 0 28 0 29 - 1 0 0 45 49 1 0 0 17 18 1 0 12 0 44 1 0 12 0 42 2 0 12 0 0 - 1 2 0 12 0 0 1 2 0 12 0 0 13 2 0 12 0 0 1 2 0 12 0 0 14)))))) - (QUOTE |lookupComplete|))) - -(MAKEPROP (QUOTE |Character|) (QUOTE NILADIC) T) -@ -\section{domain CCLASS CharacterClass} -<>= --- string.spad.pamphlet CharacterClass.input -)spool CharacterClass.output -)set message test on -)set message auto off -)clear all ---S 1 of 16 -cl1:=charClass[char "a",char "e",char "i",char "o",char "u",char "y"] ---R ---R ---R (1) "aeiouy" ---R Type: CharacterClass ---E 1 - ---S 2 of 16 -cl2 := charClass "bcdfghjklmnpqrstvwxyz" ---R ---R ---R (2) "bcdfghjklmnpqrstvwxyz" ---R Type: CharacterClass ---E 2 - ---S 3 of 16 -digit() ---R ---R ---R (3) "0123456789" ---R Type: CharacterClass ---E 3 - ---S 4 of 16 -hexDigit() ---R ---R ---R (4) "0123456789ABCDEFabcdef" ---R Type: CharacterClass ---E 4 - ---S 5 of 16 -upperCase() ---R ---R ---R (5) "ABCDEFGHIJKLMNOPQRSTUVWXYZ" ---R Type: CharacterClass ---E 5 - ---S 6 of 16 -lowerCase() ---R ---R ---R (6) "abcdefghijklmnopqrstuvwxyz" ---R Type: CharacterClass ---E 6 - ---S 7 of 16 -alphabetic() ---R ---R ---R (7) "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" ---R Type: CharacterClass ---E 7 - ---S 8 of 16 -alphanumeric() ---R ---R ---R (8) "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" ---R Type: CharacterClass ---E 8 - ---S 9 of 16 -member?(char "a", cl1) ---R ---R ---R (9) true ---R Type: Boolean ---E 9 - ---S 10 of 16 -member?(char "a", cl2) ---R ---R ---R (10) false ---R Type: Boolean ---E 10 - ---S 11 of 16 -intersect(cl1, cl2) ---R ---R ---R (11) "y" ---R Type: CharacterClass ---E 11 - ---S 12 of 16 -union(cl1,cl2) ---R ---R ---R (12) "abcdefghijklmnopqrstuvwxyz" ---R Type: CharacterClass ---E 12 - ---S 13 of 16 -difference(cl1,cl2) ---R ---R ---R (13) "aeiou" ---R Type: CharacterClass ---E 13 - ---S 14 of 16 -intersect(complement(cl1),cl2) ---R ---R ---R (14) "bcdfghjklmnpqrstvwxz" ---R Type: CharacterClass ---E 14 - ---S 15 of 16 -insert!(char "a", cl2) ---R ---R ---R (15) "abcdfghjklmnpqrstvwxyz" ---R Type: CharacterClass ---E 15 - ---S 16 of 16 -remove!(char "b", cl2) ---R ---R ---R (16) "acdfghjklmnpqrstvwxyz" ---R Type: CharacterClass ---E 16 -)spool -)lisp (bye) -@ -<>= -==================================================================== -CharacterClass examples -==================================================================== - -The CharacterClass domain allows classes of characters to be defined -and manipulated efficiently. - -Character classes can be created by giving either a string or a list -of characters. - - cl1:=charClass[char "a",char "e",char "i",char "o",char "u",char "y"] - "aeiouy" - Type: CharacterClass - - cl2 := charClass "bcdfghjklmnpqrstvwxyz" - "bcdfghjklmnpqrstvwxyz" - Type: CharacterClass - -A number of character classes are predefined for convenience. - - digit() - "0123456789" - Type: CharacterClass - - hexDigit() - "0123456789ABCDEFabcdef" - Type: CharacterClass - - upperCase() - "ABCDEFGHIJKLMNOPQRSTUVWXYZ" - Type: CharacterClass - - lowerCase() - "abcdefghijklmnopqrstuvwxyz" - Type: CharacterClass - - alphabetic() - "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" - Type: CharacterClass - - alphanumeric() - "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" - Type: CharacterClass - -You can quickly test whether a character belongs to a class. - - member?(char "a", cl1) - true - Type: Boolean - - member?(char "a", cl2) - false - Type: Boolean - -Classes have the usual set operations because the CharacterClass -domain belongs to the category FiniteSetAggregate(Character). - - intersect(cl1, cl2) - "y" - Type: CharacterClass - - union(cl1,cl2) - "abcdefghijklmnopqrstuvwxyz" - Type: CharacterClass - - difference(cl1,cl2) - "aeiou" - Type: CharacterClass - - intersect(complement(cl1),cl2) - "bcdfghjklmnpqrstvwxz" - Type: CharacterClass - -You can modify character classes by adding or removing characters. - - insert!(char "a", cl2) - "abcdfghjklmnpqrstvwxyz" - Type: CharacterClass - - remove!(char "b", cl2) - "acdfghjklmnpqrstvwxyz" - Type: CharacterClass - -See Also: -o )help Character -o )help String -o )show CharacterClass -o $AXIOM/doc/src/algebra/string.spad.dvi - -@ -<>= -)abbrev domain CCLASS CharacterClass -++ Author: Stephen M. Watt -++ Date Created: July 1986 -++ Date Last Updated: June 20, 1991 -++ Basic Operations: charClass -++ Related Domains: Character, Bits -++ Also See: -++ AMS Classifications: -++ Keywords: -++ Examples: -++ References: -++ Description: -++ This domain allows classes of characters to be defined and manipulated -++ efficiently. - - -CharacterClass: Join(SetCategory, ConvertibleTo String, - FiniteSetAggregate Character, ConvertibleTo List Character) with - charClass: String -> % - ++ charClass(s) creates a character class which contains - ++ exactly the characters given in the string s. - charClass: List Character -> % - ++ charClass(l) creates a character class which contains - ++ exactly the characters given in the list l. - digit: constant -> % - ++ digit() returns the class of all characters - ++ for which \spadfunFrom{digit?}{Character} is true. - hexDigit: constant -> % - ++ hexDigit() returns the class of all characters for which - ++ \spadfunFrom{hexDigit?}{Character} is true. - upperCase: constant -> % - ++ upperCase() returns the class of all characters for which - ++ \spadfunFrom{upperCase?}{Character} is true. - lowerCase: constant -> % - ++ lowerCase() returns the class of all characters for which - ++ \spadfunFrom{lowerCase?}{Character} is true. - alphabetic : constant -> % - ++ alphabetic() returns the class of all characters for which - ++ \spadfunFrom{alphabetic?}{Character} is true. - alphanumeric: constant -> % - ++ alphanumeric() returns the class of all characters for which - ++ \spadfunFrom{alphanumeric?}{Character} is true. - - == add - Rep := IndexedBits(0) - N := size()$Character - - a, b: % - - digit() == charClass "0123456789" - hexDigit() == charClass "0123456789abcdefABCDEF" - upperCase() == charClass "ABCDEFGHIJKLMNOPQRSTUVWXYZ" - lowerCase() == charClass "abcdefghijklmnopqrstuvwxyz" - alphabetic() == union(upperCase(), lowerCase()) - alphanumeric() == union(alphabetic(), digit()) - - a = b == a =$Rep b - - member?(c, a) == a(ord c) - union(a,b) == Or(a, b) - intersect (a,b) == And(a, b) - difference(a,b) == And(a, Not b) - complement a == Not a - - convert(cl):String == - construct(convert(cl)@List(Character)) - convert(cl:%):List(Character) == - [char(i) for i in 0..N-1 | cl.i] - - charClass(s: String) == - cl := new(N, false) - for i in minIndex(s)..maxIndex(s) repeat cl(ord s.i) := true - cl - - charClass(l: List Character) == - cl := new(N, false) - for c in l repeat cl(ord c) := true - cl - - coerce(cl):OutputForm == (convert(cl)@String)::OutputForm - - -- Stuff to make a legal SetAggregate view - # a == (n := 0; for i in 0..N-1 | a.i repeat n := n+1; n) - empty():% == charClass [] - brace():% == charClass [] - - insert_!(c, a) == (a(ord c) := true; a) - remove_!(c, a) == (a(ord c) := false; a) - - inspect(a) == - for i in 0..N-1 | a.i repeat - return char i - error "Cannot take a character from an empty class." - extract_!(a) == - for i in 0..N-1 | a.i repeat - a.i := false - return char i - error "Cannot take a character from an empty class." - - map(f, a) == - b := new(N, false) - for i in 0..N-1 | a.i repeat b(ord f char i) := true - b - - temp: % := new(N, false)$Rep - map_!(f, a) == - fill_!(temp, false) - for i in 0..N-1 | a.i repeat temp(ord f char i) := true - copyInto_!(a, temp, 0) - - parts a == - [char i for i in 0..N-1 | a.i] - -@ -\section{domain ISTRING IndexedString} -<>= -)abbrev domain ISTRING IndexedString -++ Authors: Stephen Watt, Michael Monagan, Manuel Bronstein 1986 .. 1991 --- The following Lisp dependencies are divided into two groups --- Those that are required --- QENUM QESET QCSIZE MAKE-FULL-CVEC EQ QSLESSP QSGREATERP --- Those that can are included for efficiency only --- COPY STRCONC SUBSTRING STRPOS RPLACSTR DOWNCASE UPCASE CGREATERP -++ Description: -++ This domain implements low-level strings - -IndexedString(mn:Integer): Export == Implementation where - B ==> Boolean - C ==> Character - I ==> Integer - N ==> NonNegativeInteger - U ==> UniversalSegment Integer - - Export ==> StringAggregate() with - hash: % -> I - ++ hash(x) provides a hashing function for strings - - Implementation ==> add - -- These assume Character's Rep is Small I - Qelt ==> QENUM$Lisp - Qequal ==> EQUAL$Lisp - Qsetelt ==> QESET$Lisp - Qsize ==> QCSIZE$Lisp - Cheq ==> EQL$Lisp - Chlt ==> QSLESSP$Lisp - Chgt ==> QSGREATERP$Lisp - - c: Character - cc: CharacterClass - --- new n == MAKE_-FULL_-CVEC(n, space$C)$Lisp - new(n, c) == MAKE_-FULL_-CVEC(n, c)$Lisp - empty() == MAKE_-FULL_-CVEC(0$Lisp)$Lisp - empty?(s) == Qsize(s) = 0 - #s == Qsize(s) - s = t == Qequal(s, t) - s < t == CGREATERP(t,s)$Lisp - concat(s:%,t:%) == STRCONC(s,t)$Lisp - copy s == COPY_-SEQ(s)$Lisp - insert(s:%, t:%, i:I) == concat(concat(s(mn..i-1), t), s(i..)) - coerce(s:%):OutputForm == outputForm(s pretend String) - minIndex s == mn - upperCase_! s == map_!(upperCase, s) - lowerCase_! s == map_!(lowerCase, s) - - latex s == concat("\mbox{``", concat(s pretend String, "''}")) - - replace(s, sg, t) == - l := lo(sg) - mn - m := #s - n := #t - h:I := if hasHi sg then hi(sg) - mn else maxIndex s - mn - l < 0 or h >= m or h < l-1 => error "index out of range" - r := new((m-(h-l+1)+n)::N, space$C) - for k in 0.. for i in 0..l-1 repeat Qsetelt(r, k, Qelt(s, i)) - for k in k.. for i in 0..n-1 repeat Qsetelt(r, k, Qelt(t, i)) - for k in k.. for i in h+1..m-1 repeat Qsetelt(r, k, Qelt(s, i)) - r - - setelt(s:%, i:I, c:C) == - i < mn or i > maxIndex(s) => error "index out of range" - Qsetelt(s, i - mn, c) - c - - substring?(part, whole, startpos) == - np:I := Qsize part - nw:I := Qsize whole - (startpos := startpos - mn) < 0 => error "index out of bounds" - np > nw - startpos => false - for ip in 0..np-1 for iw in startpos.. repeat - not Cheq(Qelt(part, ip), Qelt(whole, iw)) => return false - true - - position(s:%, t:%, startpos:I) == - (startpos := startpos - mn) < 0 => error "index out of bounds" - startpos >= Qsize t => mn - 1 - r:I := STRPOS(s, t, startpos, NIL$Lisp)$Lisp - EQ(r, NIL$Lisp)$Lisp => mn - 1 - r + mn - position(c: Character, t: %, startpos: I) == - (startpos := startpos - mn) < 0 => error "index out of bounds" - startpos >= Qsize t => mn - 1 - for r in startpos..Qsize t - 1 repeat - if Cheq(Qelt(t, r), c) then return r + mn - mn - 1 - position(cc: CharacterClass, t: %, startpos: I) == - (startpos := startpos - mn) < 0 => error "index out of bounds" - startpos >= Qsize t => mn - 1 - for r in startpos..Qsize t - 1 repeat - if member?(Qelt(t,r), cc) then return r + mn - mn - 1 - - suffix?(s, t) == - (m := maxIndex s) > (n := maxIndex t) => false - substring?(s, t, mn + n - m) - - split(s, c) == - n := maxIndex s - for i in mn..n while s.i = c repeat 0 - l := empty()$List(%) - j:Integer -- j is conditionally intialized - while i <= n and (j := position(c, s, i)) >= mn repeat - l := concat(s(i..j-1), l) - for i in j..n while s.i = c repeat 0 - if i <= n then l := concat(s(i..n), l) - reverse_! l - split(s, cc) == - n := maxIndex s - for i in mn..n while member?(s.i,cc) repeat 0 - l := empty()$List(%) - j:Integer -- j is conditionally intialized - while i <= n and (j := position(cc, s, i)) >= mn repeat - l := concat(s(i..j-1), l) - for i in j..n while member?(s.i,cc) repeat 0 - if i <= n then l := concat(s(i..n), l) - reverse_! l - - leftTrim(s, c) == - n := maxIndex s - for i in mn .. n while s.i = c repeat 0 - s(i..n) - leftTrim(s, cc) == - n := maxIndex s - for i in mn .. n while member?(s.i,cc) repeat 0 - s(i..n) - - rightTrim(s, c) == - for j in maxIndex s .. mn by -1 while s.j = c repeat 0 - s(minIndex(s)..j) - rightTrim(s, cc) == - for j in maxIndex s .. mn by -1 while member?(s.j, cc) repeat 0 - s(minIndex(s)..j) - - concat l == - t := new(+/[#s for s in l], space$C) - i := mn - for s in l repeat - copyInto_!(t, s, i) - i := i + #s - t - - copyInto_!(y, x, s) == - m := #x - n := #y - s := s - mn - s < 0 or s+m > n => error "index out of range" - RPLACSTR(y, s, m, x, 0, m)$Lisp - y - - elt(s:%, i:I) == - i < mn or i > maxIndex(s) => error "index out of range" - Qelt(s, i - mn) - - elt(s:%, sg:U) == - l := lo(sg) - mn - h := if hasHi sg then hi(sg) - mn else maxIndex s - mn - l < 0 or h >= #s => error "index out of bound" - SUBSTRING(s, l, max(0, h-l+1))$Lisp - - hash(s:$):Integer == - n:I := Qsize s - zero? n => 0 --- one? n => ord(s.mn) - (n = 1) => ord(s.mn) - ord(s.mn) * ord s(mn+n-1) * ord s(mn + n quo 2) - - match(pattern,target,wildcard) == stringMatch(pattern,target,CHARACTER(wildcard)$Lisp)$Lisp - -@ - -Up to [[patch--40]] this read - -\begin{verbatim} - match(pattern,target,wildcard) == stringMatch(pattern,target,wildcard)$Lisp -\end{verbatim} - -which did not work (Issue~\#97), since [[wildcard]] is an Axiom-[[Character]], -not a Lisp-[[Character]]. The operation [[CHARACTER]] from [[Lisp]] performs -the coercion. - -<>= - match?(pattern, target, dontcare) == - n := maxIndex pattern - p := position(dontcare, pattern, m := minIndex pattern)::N - p = m-1 => pattern = target - (p ^= m) and not prefix?(pattern(m..p-1), target) => false - i := p -- index into target - q := position(dontcare, pattern, p + 1)::N - while q ^= m-1 repeat - s := pattern(p+1..q-1) - i := position(s, target, i)::N - i = m-1 => return false - i := i + #s - p := q - q := position(dontcare, pattern, q + 1)::N - (p ^= n) and not suffix?(pattern(p+1..n), target) => false - true - -@ -\section{ISTRING.lsp BOOTSTRAP} -{\bf ISTRING} depends on a chain of -files. We need to break this cycle to build the algebra. So we keep a -cached copy of the translated {\bf ISTRING} category which we can write -into the {\bf MID} directory. We compile the lisp code and copy the -{\bf ISTRING.o} file to the {\bf OUT} directory. This is eventually -forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<>= - -(|/VERSIONCHECK| 2) - -(PUT (QUOTE |ISTRING;new;NniC$;1|) (QUOTE |SPADreplace|) (QUOTE |MAKE-FULL-CVEC|)) - -(DEFUN |ISTRING;new;NniC$;1| (|n| |c| |$|) (|MAKE-FULL-CVEC| |n| |c|)) - -(PUT (QUOTE |ISTRING;empty;$;2|) (QUOTE |SPADreplace|) (QUOTE (XLAM NIL (|MAKE-FULL-CVEC| 0)))) - -(DEFUN |ISTRING;empty;$;2| (|$|) (|MAKE-FULL-CVEC| 0)) - -(DEFUN |ISTRING;empty?;$B;3| (|s| |$|) (EQL (QCSIZE |s|) 0)) - -(PUT (QUOTE |ISTRING;#;$Nni;4|) (QUOTE |SPADreplace|) (QUOTE QCSIZE)) - -(DEFUN |ISTRING;#;$Nni;4| (|s| |$|) (QCSIZE |s|)) - -(PUT (QUOTE |ISTRING;=;2$B;5|) (QUOTE |SPADreplace|) (QUOTE EQUAL)) - -(DEFUN |ISTRING;=;2$B;5| (|s| |t| |$|) (EQUAL |s| |t|)) - -(PUT (QUOTE |ISTRING;<;2$B;6|) (QUOTE |SPADreplace|) (QUOTE (XLAM (|s| |t|) (CGREATERP |t| |s|)))) - -(DEFUN |ISTRING;<;2$B;6| (|s| |t| |$|) (CGREATERP |t| |s|)) - -(PUT (QUOTE |ISTRING;concat;3$;7|) (QUOTE |SPADreplace|) (QUOTE STRCONC)) - -(DEFUN |ISTRING;concat;3$;7| (|s| |t| |$|) (STRCONC |s| |t|)) - -(PUT (QUOTE |ISTRING;copy;2$;8|) (QUOTE |SPADreplace|) (QUOTE |COPY-SEQ|)) - -(DEFUN |ISTRING;copy;2$;8| (|s| |$|) (|COPY-SEQ| |s|)) - -(DEFUN |ISTRING;insert;2$I$;9| (|s| |t| |i| |$|) (SPADCALL (SPADCALL (SPADCALL |s| (SPADCALL (QREFELT |$| 6) (|-| |i| 1) (QREFELT |$| 20)) (QREFELT |$| 21)) |t| (QREFELT |$| 16)) (SPADCALL |s| (SPADCALL |i| (QREFELT |$| 22)) (QREFELT |$| 21)) (QREFELT |$| 16))) - -(DEFUN |ISTRING;coerce;$Of;10| (|s| |$|) (SPADCALL |s| (QREFELT |$| 26))) - -(DEFUN |ISTRING;minIndex;$I;11| (|s| |$|) (QREFELT |$| 6)) - -(DEFUN |ISTRING;upperCase!;2$;12| (|s| |$|) (SPADCALL (ELT |$| 31) |s| (QREFELT |$| 33))) - -(DEFUN |ISTRING;lowerCase!;2$;13| (|s| |$|) (SPADCALL (ELT |$| 36) |s| (QREFELT |$| 33))) - -(DEFUN |ISTRING;latex;$S;14| (|s| |$|) (STRCONC "\\mbox{``" (STRCONC |s| "''}"))) - -(DEFUN |ISTRING;replace;$Us2$;15| (|s| |sg| |t| |$|) (PROG (|l| |m| |n| |h| #1=#:G91425 |r| #2=#:G91433 #3=#:G91432 |i| #4=#:G91431 |k|) (RETURN (SEQ (LETT |l| (|-| (SPADCALL |sg| (QREFELT |$| 39)) (QREFELT |$| 6)) |ISTRING;replace;$Us2$;15|) (LETT |m| (SPADCALL |s| (QREFELT |$| 13)) |ISTRING;replace;$Us2$;15|) (LETT |n| (SPADCALL |t| (QREFELT |$| 13)) |ISTRING;replace;$Us2$;15|) (LETT |h| (COND ((SPADCALL |sg| (QREFELT |$| 40)) (|-| (SPADCALL |sg| (QREFELT |$| 41)) (QREFELT |$| 6))) ((QUOTE T) (|-| (SPADCALL |s| (QREFELT |$| 42)) (QREFELT |$| 6)))) |ISTRING;replace;$Us2$;15|) (COND ((OR (OR (|<| |l| 0) (NULL (|<| |h| |m|))) (|<| |h| (|-| |l| 1))) (EXIT (|error| "index out of range")))) (LETT |r| (SPADCALL (PROG1 (LETT #1# (|+| (|-| |m| (|+| (|-| |h| |l|) 1)) |n|) |ISTRING;replace;$Us2$;15|) (|check-subtype| (|>=| #1# 0) (QUOTE (|NonNegativeInteger|)) #1#)) (SPADCALL (QREFELT |$| 43)) (QREFELT |$| 9)) |ISTRING;replace;$Us2$;15|) (SEQ (LETT |i| 0 |ISTRING;replace;$Us2$;15|) (LETT #2# (|-| |l| 1) |ISTRING;replace;$Us2$;15|) (LETT |k| 0 |ISTRING;replace;$Us2$;15|) G190 (COND ((QSGREATERP |i| #2#) (GO G191))) (SEQ (EXIT (QESET |r| |k| (QENUM |s| |i|)))) (LETT |k| (PROG1 (QSADD1 |k|) (LETT |i| (QSADD1 |i|) |ISTRING;replace;$Us2$;15|)) |ISTRING;replace;$Us2$;15|) (GO G190) G191 (EXIT NIL)) (SEQ (LETT |i| 0 |ISTRING;replace;$Us2$;15|) (LETT #3# (|-| |n| 1) |ISTRING;replace;$Us2$;15|) (LETT |k| |k| |ISTRING;replace;$Us2$;15|) G190 (COND ((QSGREATERP |i| #3#) (GO G191))) (SEQ (EXIT (QESET |r| |k| (QENUM |t| |i|)))) (LETT |k| (PROG1 (|+| |k| 1) (LETT |i| (QSADD1 |i|) |ISTRING;replace;$Us2$;15|)) |ISTRING;replace;$Us2$;15|) (GO G190) G191 (EXIT NIL)) (SEQ (LETT |i| (|+| |h| 1) |ISTRING;replace;$Us2$;15|) (LETT #4# (|-| |m| 1) |ISTRING;replace;$Us2$;15|) (LETT |k| |k| |ISTRING;replace;$Us2$;15|) G190 (COND ((|>| |i| #4#) (GO G191))) (SEQ (EXIT (QESET |r| |k| (QENUM |s| |i|)))) (LETT |k| (PROG1 (|+| |k| 1) (LETT |i| (|+| |i| 1) |ISTRING;replace;$Us2$;15|)) |ISTRING;replace;$Us2$;15|) (GO G190) G191 (EXIT NIL)) (EXIT |r|))))) - -(DEFUN |ISTRING;setelt;$I2C;16| (|s| |i| |c| |$|) (SEQ (COND ((OR (|<| |i| (QREFELT |$| 6)) (|<| (SPADCALL |s| (QREFELT |$| 42)) |i|)) (|error| "index out of range")) ((QUOTE T) (SEQ (QESET |s| (|-| |i| (QREFELT |$| 6)) |c|) (EXIT |c|)))))) - -(DEFUN |ISTRING;substring?;2$IB;17| (|part| |whole| |startpos| |$|) (PROG (|np| |nw| |iw| |ip| #1=#:G91443 #2=#:G91442 #3=#:G91438) (RETURN (SEQ (EXIT (SEQ (LETT |np| (QCSIZE |part|) |ISTRING;substring?;2$IB;17|) (LETT |nw| (QCSIZE |whole|) |ISTRING;substring?;2$IB;17|) (LETT |startpos| (|-| |startpos| (QREFELT |$| 6)) |ISTRING;substring?;2$IB;17|) (EXIT (COND ((|<| |startpos| 0) (|error| "index out of bounds")) ((|<| (|-| |nw| |startpos|) |np|) (QUOTE NIL)) ((QUOTE T) (SEQ (SEQ (EXIT (SEQ (LETT |iw| |startpos| |ISTRING;substring?;2$IB;17|) (LETT |ip| 0 |ISTRING;substring?;2$IB;17|) (LETT #1# (|-| |np| 1) |ISTRING;substring?;2$IB;17|) G190 (COND ((QSGREATERP |ip| #1#) (GO G191))) (SEQ (EXIT (COND ((NULL (EQL (QENUM |part| |ip|) (QENUM |whole| |iw|))) (PROGN (LETT #3# (PROGN (LETT #2# (QUOTE NIL) |ISTRING;substring?;2$IB;17|) (GO #2#)) |ISTRING;substring?;2$IB;17|) (GO #3#)))))) (LETT |ip| (PROG1 (QSADD1 |ip|) (LETT |iw| (|+| |iw| 1) |ISTRING;substring?;2$IB;17|)) |ISTRING;substring?;2$IB;17|) (GO G190) G191 (EXIT NIL))) #3# (EXIT #3#)) (EXIT (QUOTE T)))))))) #2# (EXIT #2#))))) - -(DEFUN |ISTRING;position;2$2I;18| (|s| |t| |startpos| |$|) (PROG (|r|) (RETURN (SEQ (LETT |startpos| (|-| |startpos| (QREFELT |$| 6)) |ISTRING;position;2$2I;18|) (EXIT (COND ((|<| |startpos| 0) (|error| "index out of bounds")) ((NULL (|<| |startpos| (QCSIZE |t|))) (|-| (QREFELT |$| 6) 1)) ((QUOTE T) (SEQ (LETT |r| (STRPOS |s| |t| |startpos| NIL) |ISTRING;position;2$2I;18|) (EXIT (COND ((EQ |r| NIL) (|-| (QREFELT |$| 6) 1)) ((QUOTE T) (|+| |r| (QREFELT |$| 6))))))))))))) - -(DEFUN |ISTRING;position;C$2I;19| (|c| |t| |startpos| |$|) (PROG (|r| #1=#:G91454 #2=#:G91453) (RETURN (SEQ (EXIT (SEQ (LETT |startpos| (|-| |startpos| (QREFELT |$| 6)) |ISTRING;position;C$2I;19|) (EXIT (COND ((|<| |startpos| 0) (|error| "index out of bounds")) ((NULL (|<| |startpos| (QCSIZE |t|))) (|-| (QREFELT |$| 6) 1)) ((QUOTE T) (SEQ (SEQ (LETT |r| |startpos| |ISTRING;position;C$2I;19|) (LETT #1# (QSDIFFERENCE (QCSIZE |t|) 1) |ISTRING;position;C$2I;19|) G190 (COND ((|>| |r| #1#) (GO G191))) (SEQ (EXIT (COND ((EQL (QENUM |t| |r|) |c|) (PROGN (LETT #2# (|+| |r| (QREFELT |$| 6)) |ISTRING;position;C$2I;19|) (GO #2#)))))) (LETT |r| (|+| |r| 1) |ISTRING;position;C$2I;19|) (GO G190) G191 (EXIT NIL)) (EXIT (|-| (QREFELT |$| 6) 1)))))))) #2# (EXIT #2#))))) - -(DEFUN |ISTRING;position;Cc$2I;20| (|cc| |t| |startpos| |$|) (PROG (|r| #1=#:G91461 #2=#:G91460) (RETURN (SEQ (EXIT (SEQ (LETT |startpos| (|-| |startpos| (QREFELT |$| 6)) |ISTRING;position;Cc$2I;20|) (EXIT (COND ((|<| |startpos| 0) (|error| "index out of bounds")) ((NULL (|<| |startpos| (QCSIZE |t|))) (|-| (QREFELT |$| 6) 1)) ((QUOTE T) (SEQ (SEQ (LETT |r| |startpos| |ISTRING;position;Cc$2I;20|) (LETT #1# (QSDIFFERENCE (QCSIZE |t|) 1) |ISTRING;position;Cc$2I;20|) G190 (COND ((|>| |r| #1#) (GO G191))) (SEQ (EXIT (COND ((SPADCALL (QENUM |t| |r|) |cc| (QREFELT |$| 49)) (PROGN (LETT #2# (|+| |r| (QREFELT |$| 6)) |ISTRING;position;Cc$2I;20|) (GO #2#)))))) (LETT |r| (|+| |r| 1) |ISTRING;position;Cc$2I;20|) (GO G190) G191 (EXIT NIL)) (EXIT (|-| (QREFELT |$| 6) 1)))))))) #2# (EXIT #2#))))) - -(DEFUN |ISTRING;suffix?;2$B;21| (|s| |t| |$|) (PROG (|n| |m|) (RETURN (SEQ (LETT |n| (SPADCALL |t| (QREFELT |$| 42)) |ISTRING;suffix?;2$B;21|) (LETT |m| (SPADCALL |s| (QREFELT |$| 42)) |ISTRING;suffix?;2$B;21|) (EXIT (COND ((|<| |n| |m|) (QUOTE NIL)) ((QUOTE T) (SPADCALL |s| |t| (|-| (|+| (QREFELT |$| 6) |n|) |m|) (QREFELT |$| 46))))))))) - -(DEFUN |ISTRING;split;$CL;22| (|s| |c| |$|) (PROG (|n| |j| |i| |l|) (RETURN (SEQ (LETT |n| (SPADCALL |s| (QREFELT |$| 42)) |ISTRING;split;$CL;22|) (SEQ (LETT |i| (QREFELT |$| 6) |ISTRING;split;$CL;22|) G190 (COND ((OR (|>| |i| |n|) (NULL (SPADCALL (SPADCALL |s| |i| (QREFELT |$| 52)) |c| (QREFELT |$| 53)))) (GO G191))) (SEQ (EXIT 0)) (LETT |i| (|+| |i| 1) |ISTRING;split;$CL;22|) (GO G190) G191 (EXIT NIL)) (LETT |l| (SPADCALL (QREFELT |$| 55)) |ISTRING;split;$CL;22|) (SEQ G190 (COND ((NULL (COND ((|<| |n| |i|) (QUOTE NIL)) ((QUOTE T) (SEQ (LETT |j| (SPADCALL |c| |s| |i| (QREFELT |$| 48)) |ISTRING;split;$CL;22|) (EXIT (COND ((|<| |j| (QREFELT |$| 6)) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))))))) (GO G191))) (SEQ (LETT |l| (SPADCALL (SPADCALL |s| (SPADCALL |i| (|-| |j| 1) (QREFELT |$| 20)) (QREFELT |$| 21)) |l| (QREFELT |$| 56)) |ISTRING;split;$CL;22|) (EXIT (SEQ (LETT |i| |j| |ISTRING;split;$CL;22|) G190 (COND ((OR (|>| |i| |n|) (NULL (SPADCALL (SPADCALL |s| |i| (QREFELT |$| 52)) |c| (QREFELT |$| 53)))) (GO G191))) (SEQ (EXIT 0)) (LETT |i| (|+| |i| 1) |ISTRING;split;$CL;22|) (GO G190) G191 (EXIT NIL)))) NIL (GO G190) G191 (EXIT NIL)) (COND ((NULL (|<| |n| |i|)) (LETT |l| (SPADCALL (SPADCALL |s| (SPADCALL |i| |n| (QREFELT |$| 20)) (QREFELT |$| 21)) |l| (QREFELT |$| 56)) |ISTRING;split;$CL;22|))) (EXIT (SPADCALL |l| (QREFELT |$| 57))))))) - -(DEFUN |ISTRING;split;$CcL;23| (|s| |cc| |$|) (PROG (|n| |j| |i| |l|) (RETURN (SEQ (LETT |n| (SPADCALL |s| (QREFELT |$| 42)) |ISTRING;split;$CcL;23|) (SEQ (LETT |i| (QREFELT |$| 6) |ISTRING;split;$CcL;23|) G190 (COND ((OR (|>| |i| |n|) (NULL (SPADCALL (SPADCALL |s| |i| (QREFELT |$| 52)) |cc| (QREFELT |$| 49)))) (GO G191))) (SEQ (EXIT 0)) (LETT |i| (|+| |i| 1) |ISTRING;split;$CcL;23|) (GO G190) G191 (EXIT NIL)) (LETT |l| (SPADCALL (QREFELT |$| 55)) |ISTRING;split;$CcL;23|) (SEQ G190 (COND ((NULL (COND ((|<| |n| |i|) (QUOTE NIL)) ((QUOTE T) (SEQ (LETT |j| (SPADCALL |cc| |s| |i| (QREFELT |$| 50)) |ISTRING;split;$CcL;23|) (EXIT (COND ((|<| |j| (QREFELT |$| 6)) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))))))) (GO G191))) (SEQ (LETT |l| (SPADCALL (SPADCALL |s| (SPADCALL |i| (|-| |j| 1) (QREFELT |$| 20)) (QREFELT |$| 21)) |l| (QREFELT |$| 56)) |ISTRING;split;$CcL;23|) (EXIT (SEQ (LETT |i| |j| |ISTRING;split;$CcL;23|) G190 (COND ((OR (|>| |i| |n|) (NULL (SPADCALL (SPADCALL |s| |i| (QREFELT |$| 52)) |cc| (QREFELT |$| 49)))) (GO G191))) (SEQ (EXIT 0)) (LETT |i| (|+| |i| 1) |ISTRING;split;$CcL;23|) (GO G190) G191 (EXIT NIL)))) NIL (GO G190) G191 (EXIT NIL)) (COND ((NULL (|<| |n| |i|)) (LETT |l| (SPADCALL (SPADCALL |s| (SPADCALL |i| |n| (QREFELT |$| 20)) (QREFELT |$| 21)) |l| (QREFELT |$| 56)) |ISTRING;split;$CcL;23|))) (EXIT (SPADCALL |l| (QREFELT |$| 57))))))) - -(DEFUN |ISTRING;leftTrim;$C$;24| (|s| |c| |$|) (PROG (|n| |i|) (RETURN (SEQ (LETT |n| (SPADCALL |s| (QREFELT |$| 42)) |ISTRING;leftTrim;$C$;24|) (SEQ (LETT |i| (QREFELT |$| 6) |ISTRING;leftTrim;$C$;24|) G190 (COND ((OR (|>| |i| |n|) (NULL (SPADCALL (SPADCALL |s| |i| (QREFELT |$| 52)) |c| (QREFELT |$| 53)))) (GO G191))) (SEQ (EXIT 0)) (LETT |i| (|+| |i| 1) |ISTRING;leftTrim;$C$;24|) (GO G190) G191 (EXIT NIL)) (EXIT (SPADCALL |s| (SPADCALL |i| |n| (QREFELT |$| 20)) (QREFELT |$| 21))))))) - -(DEFUN |ISTRING;leftTrim;$Cc$;25| (|s| |cc| |$|) (PROG (|n| |i|) (RETURN (SEQ (LETT |n| (SPADCALL |s| (QREFELT |$| 42)) |ISTRING;leftTrim;$Cc$;25|) (SEQ (LETT |i| (QREFELT |$| 6) |ISTRING;leftTrim;$Cc$;25|) G190 (COND ((OR (|>| |i| |n|) (NULL (SPADCALL (SPADCALL |s| |i| (QREFELT |$| 52)) |cc| (QREFELT |$| 49)))) (GO G191))) (SEQ (EXIT 0)) (LETT |i| (|+| |i| 1) |ISTRING;leftTrim;$Cc$;25|) (GO G190) G191 (EXIT NIL)) (EXIT (SPADCALL |s| (SPADCALL |i| |n| (QREFELT |$| 20)) (QREFELT |$| 21))))))) - -(DEFUN |ISTRING;rightTrim;$C$;26| (|s| |c| |$|) (PROG (|j| #1=#:G91487) (RETURN (SEQ (SEQ (LETT |j| (SPADCALL |s| (QREFELT |$| 42)) |ISTRING;rightTrim;$C$;26|) (LETT #1# (QREFELT |$| 6) |ISTRING;rightTrim;$C$;26|) G190 (COND ((OR (|<| |j| #1#) (NULL (SPADCALL (SPADCALL |s| |j| (QREFELT |$| 52)) |c| (QREFELT |$| 53)))) (GO G191))) (SEQ (EXIT 0)) (LETT |j| (|+| |j| -1) |ISTRING;rightTrim;$C$;26|) (GO G190) G191 (EXIT NIL)) (EXIT (SPADCALL |s| (SPADCALL (SPADCALL |s| (QREFELT |$| 28)) |j| (QREFELT |$| 20)) (QREFELT |$| 21))))))) - -(DEFUN |ISTRING;rightTrim;$Cc$;27| (|s| |cc| |$|) (PROG (|j| #1=#:G91491) (RETURN (SEQ (SEQ (LETT |j| (SPADCALL |s| (QREFELT |$| 42)) |ISTRING;rightTrim;$Cc$;27|) (LETT #1# (QREFELT |$| 6) |ISTRING;rightTrim;$Cc$;27|) G190 (COND ((OR (|<| |j| #1#) (NULL (SPADCALL (SPADCALL |s| |j| (QREFELT |$| 52)) |cc| (QREFELT |$| 49)))) (GO G191))) (SEQ (EXIT 0)) (LETT |j| (|+| |j| -1) |ISTRING;rightTrim;$Cc$;27|) (GO G190) G191 (EXIT NIL)) (EXIT (SPADCALL |s| (SPADCALL (SPADCALL |s| (QREFELT |$| 28)) |j| (QREFELT |$| 20)) (QREFELT |$| 21))))))) - -(DEFUN |ISTRING;concat;L$;28| (|l| |$|) (PROG (#1=#:G91500 #2=#:G91494 #3=#:G91492 #4=#:G91493 |t| |s| #5=#:G91499 |i|) (RETURN (SEQ (LETT |t| (SPADCALL (PROGN (LETT #4# NIL |ISTRING;concat;L$;28|) (SEQ (LETT |s| NIL |ISTRING;concat;L$;28|) (LETT #1# |l| |ISTRING;concat;L$;28|) G190 (COND ((OR (ATOM #1#) (PROGN (LETT |s| (CAR #1#) |ISTRING;concat;L$;28|) NIL)) (GO G191))) (SEQ (EXIT (PROGN (LETT #2# (SPADCALL |s| (QREFELT |$| 13)) |ISTRING;concat;L$;28|) (COND (#4# (LETT #3# (|+| #3# #2#) |ISTRING;concat;L$;28|)) ((QUOTE T) (PROGN (LETT #3# #2# |ISTRING;concat;L$;28|) (LETT #4# (QUOTE T) |ISTRING;concat;L$;28|))))))) (LETT #1# (CDR #1#) |ISTRING;concat;L$;28|) (GO G190) G191 (EXIT NIL)) (COND (#4# #3#) ((QUOTE T) 0))) (SPADCALL (QREFELT |$| 43)) (QREFELT |$| 9)) |ISTRING;concat;L$;28|) (LETT |i| (QREFELT |$| 6) |ISTRING;concat;L$;28|) (SEQ (LETT |s| NIL |ISTRING;concat;L$;28|) (LETT #5# |l| |ISTRING;concat;L$;28|) G190 (COND ((OR (ATOM #5#) (PROGN (LETT |s| (CAR #5#) |ISTRING;concat;L$;28|) NIL)) (GO G191))) (SEQ (SPADCALL |t| |s| |i| (QREFELT |$| 65)) (EXIT (LETT |i| (|+| |i| (SPADCALL |s| (QREFELT |$| 13))) |ISTRING;concat;L$;28|))) (LETT #5# (CDR #5#) |ISTRING;concat;L$;28|) (GO G190) G191 (EXIT NIL)) (EXIT |t|))))) - -(DEFUN |ISTRING;copyInto!;2$I$;29| (|y| |x| |s| |$|) (PROG (|m| |n|) (RETURN (SEQ (LETT |m| (SPADCALL |x| (QREFELT |$| 13)) |ISTRING;copyInto!;2$I$;29|) (LETT |n| (SPADCALL |y| (QREFELT |$| 13)) |ISTRING;copyInto!;2$I$;29|) (LETT |s| (|-| |s| (QREFELT |$| 6)) |ISTRING;copyInto!;2$I$;29|) (COND ((OR (|<| |s| 0) (|<| |n| (|+| |s| |m|))) (EXIT (|error| "index out of range")))) (RPLACSTR |y| |s| |m| |x| 0 |m|) (EXIT |y|))))) - -(DEFUN |ISTRING;elt;$IC;30| (|s| |i| |$|) (COND ((OR (|<| |i| (QREFELT |$| 6)) (|<| (SPADCALL |s| (QREFELT |$| 42)) |i|)) (|error| "index out of range")) ((QUOTE T) (QENUM |s| (|-| |i| (QREFELT |$| 6)))))) - -(DEFUN |ISTRING;elt;$Us$;31| (|s| |sg| |$|) (PROG (|l| |h|) (RETURN (SEQ (LETT |l| (|-| (SPADCALL |sg| (QREFELT |$| 39)) (QREFELT |$| 6)) |ISTRING;elt;$Us$;31|) (LETT |h| (COND ((SPADCALL |sg| (QREFELT |$| 40)) (|-| (SPADCALL |sg| (QREFELT |$| 41)) (QREFELT |$| 6))) ((QUOTE T) (|-| (SPADCALL |s| (QREFELT |$| 42)) (QREFELT |$| 6)))) |ISTRING;elt;$Us$;31|) (COND ((OR (|<| |l| 0) (NULL (|<| |h| (SPADCALL |s| (QREFELT |$| 13))))) (EXIT (|error| "index out of bound")))) (EXIT (SUBSTRING |s| |l| (MAX 0 (|+| (|-| |h| |l|) 1)))))))) - -(DEFUN |ISTRING;hash;$I;32| (|s| |$|) (PROG (|n|) (RETURN (SEQ (LETT |n| (QCSIZE |s|) |ISTRING;hash;$I;32|) (EXIT (COND ((ZEROP |n|) 0) ((EQL |n| 1) (SPADCALL (SPADCALL |s| (QREFELT |$| 6) (QREFELT |$| 52)) (QREFELT |$| 67))) ((QUOTE T) (|*| (|*| (SPADCALL (SPADCALL |s| (QREFELT |$| 6) (QREFELT |$| 52)) (QREFELT |$| 67)) (SPADCALL (SPADCALL |s| (|-| (|+| (QREFELT |$| 6) |n|) 1) (QREFELT |$| 52)) (QREFELT |$| 67))) (SPADCALL (SPADCALL |s| (|+| (QREFELT |$| 6) (QUOTIENT2 |n| 2)) (QREFELT |$| 52)) (QREFELT |$| 67)))))))))) - -(PUT (QUOTE |ISTRING;match;2$CNni;33|) (QUOTE |SPADreplace|) (QUOTE |stringMatch|)) - -(DEFUN |ISTRING;match;2$CNni;33| (|pattern| |target| |wildcard| |$|) (|stringMatch| |pattern| |target| |wildcard|)) - -(DEFUN |ISTRING;match?;2$CB;34| (|pattern| |target| |dontcare| |$|) (PROG (|n| |m| #1=#:G91514 #2=#:G91516 |s| #3=#:G91518 #4=#:G91526 |i| |p| #5=#:G91519 |q|) (RETURN (SEQ (EXIT (SEQ (LETT |n| (SPADCALL |pattern| (QREFELT |$| 42)) |ISTRING;match?;2$CB;34|) (LETT |p| (PROG1 (LETT #1# (SPADCALL |dontcare| |pattern| (LETT |m| (SPADCALL |pattern| (QREFELT |$| 28)) |ISTRING;match?;2$CB;34|) (QREFELT |$| 48)) |ISTRING;match?;2$CB;34|) (|check-subtype| (|>=| #1# 0) (QUOTE (|NonNegativeInteger|)) #1#)) |ISTRING;match?;2$CB;34|) (EXIT (COND ((EQL |p| (|-| |m| 1)) (SPADCALL |pattern| |target| (QREFELT |$| 14))) ((QUOTE T) (SEQ (COND ((NULL (EQL |p| |m|)) (COND ((NULL (SPADCALL (SPADCALL |pattern| (SPADCALL |m| (|-| |p| 1) (QREFELT |$| 20)) (QREFELT |$| 21)) |target| (QREFELT |$| 70))) (EXIT (QUOTE NIL)))))) (LETT |i| |p| |ISTRING;match?;2$CB;34|) (LETT |q| (PROG1 (LETT #2# (SPADCALL |dontcare| |pattern| (|+| |p| 1) (QREFELT |$| 48)) |ISTRING;match?;2$CB;34|) (|check-subtype| (|>=| #2# 0) (QUOTE (|NonNegativeInteger|)) #2#)) |ISTRING;match?;2$CB;34|) (SEQ G190 (COND ((NULL (COND ((EQL |q| (|-| |m| 1)) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) (GO G191))) (SEQ (LETT |s| (SPADCALL |pattern| (SPADCALL (|+| |p| 1) (|-| |q| 1) (QREFELT |$| 20)) (QREFELT |$| 21)) |ISTRING;match?;2$CB;34|) (LETT |i| (PROG1 (LETT #3# (SPADCALL |s| |target| |i| (QREFELT |$| 47)) |ISTRING;match?;2$CB;34|) (|check-subtype| (|>=| #3# 0) (QUOTE (|NonNegativeInteger|)) #3#)) |ISTRING;match?;2$CB;34|) (EXIT (COND ((EQL |i| (|-| |m| 1)) (PROGN (LETT #4# (QUOTE NIL) |ISTRING;match?;2$CB;34|) (GO #4#))) ((QUOTE T) (SEQ (LETT |i| (|+| |i| (SPADCALL |s| (QREFELT |$| 13))) |ISTRING;match?;2$CB;34|) (LETT |p| |q| |ISTRING;match?;2$CB;34|) (EXIT (LETT |q| (PROG1 (LETT #5# (SPADCALL |dontcare| |pattern| (|+| |q| 1) (QREFELT |$| 48)) |ISTRING;match?;2$CB;34|) (|check-subtype| (|>=| #5# 0) (QUOTE (|NonNegativeInteger|)) #5#)) |ISTRING;match?;2$CB;34|))))))) NIL (GO G190) G191 (EXIT NIL)) (COND ((NULL (EQL |p| |n|)) (COND ((NULL (SPADCALL (SPADCALL |pattern| (SPADCALL (|+| |p| 1) |n| (QREFELT |$| 20)) (QREFELT |$| 21)) |target| (QREFELT |$| 51))) (EXIT (QUOTE NIL)))))) (EXIT (QUOTE T)))))))) #4# (EXIT #4#))))) - -(DEFUN |IndexedString| (#1=#:G91535) (PROG NIL (RETURN (PROG (#2=#:G91536) (RETURN (COND ((LETT #2# (|lassocShiftWithFunction| (LIST (|devaluate| #1#)) (HGET |$ConstructorCache| (QUOTE |IndexedString|)) (QUOTE |domainEqualList|)) |IndexedString|) (|CDRwithIncrement| #2#)) ((QUOTE T) (|UNWIND-PROTECT| (PROG1 (|IndexedString;| #1#) (LETT #2# T |IndexedString|)) (COND ((NOT #2#) (HREM |$ConstructorCache| (QUOTE |IndexedString|)))))))))))) - -(DEFUN |IndexedString;| (|#1|) (PROG (|DV$1| |dv$| |$| #1=#:G91534 #2=#:G91533 |pv$|) (RETURN (PROGN (LETT |DV$1| (|devaluate| |#1|) . #3=(|IndexedString|)) (LETT |dv$| (LIST (QUOTE |IndexedString|) |DV$1|) . #3#) (LETT |$| (GETREFV 83) . #3#) (QSETREFV |$| 0 |dv$|) (QSETREFV |$| 3 (LETT |pv$| (|buildPredVector| 0 0 (LIST (|HasCategory| (|Character|) (QUOTE (|SetCategory|))) (|HasCategory| (|Character|) (QUOTE (|ConvertibleTo| (|InputForm|)))) (LETT #1# (|HasCategory| (|Character|) (QUOTE (|OrderedSet|))) . #3#) (OR #1# (|HasCategory| (|Character|) (QUOTE (|SetCategory|)))) (|HasCategory| (|Integer|) (QUOTE (|OrderedSet|))) (LETT #2# (AND (|HasCategory| (|Character|) (QUOTE (|Evalable| (|Character|)))) (|HasCategory| (|Character|) (QUOTE (|SetCategory|)))) . #3#) (OR (AND (|HasCategory| (|Character|) (QUOTE (|Evalable| (|Character|)))) #1#) #2#))) . #3#)) (|haddProp| |$ConstructorCache| (QUOTE |IndexedString|) (LIST |DV$1|) (CONS 1 |$|)) (|stuffDomainSlots| |$|) (QSETREFV |$| 6 |#1|) |$|)))) - -(MAKEPROP (QUOTE |IndexedString|) (QUOTE |infovec|) (LIST (QUOTE #(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|NonNegativeInteger|) (|Character|) |ISTRING;new;NniC$;1| |ISTRING;empty;$;2| (|Boolean|) |ISTRING;empty?;$B;3| |ISTRING;#;$Nni;4| |ISTRING;=;2$B;5| |ISTRING;<;2$B;6| |ISTRING;concat;3$;7| |ISTRING;copy;2$;8| (|Integer|) (|UniversalSegment| 18) (0 . SEGMENT) |ISTRING;elt;$Us$;31| (6 . SEGMENT) |ISTRING;insert;2$I$;9| (|String|) (|OutputForm|) (11 . |outputForm|) |ISTRING;coerce;$Of;10| |ISTRING;minIndex;$I;11| (|CharacterClass|) (16 . |upperCase|) (20 . |upperCase|) (|Mapping| 8 8) (25 . |map!|) |ISTRING;upperCase!;2$;12| (31 . |lowerCase|) (35 . |lowerCase|) |ISTRING;lowerCase!;2$;13| |ISTRING;latex;$S;14| (40 . |lo|) (45 . |hasHi|) (50 . |hi|) (55 . |maxIndex|) (60 . |space|) |ISTRING;replace;$Us2$;15| |ISTRING;setelt;$I2C;16| |ISTRING;substring?;2$IB;17| |ISTRING;position;2$2I;18| |ISTRING;position;C$2I;19| (64 . |member?|) |ISTRING;position;Cc$2I;20| |ISTRING;suffix?;2$B;21| |ISTRING;elt;$IC;30| (70 . |=|) (|List| |$$|) (76 . |empty|) (80 . |concat|) (86 . |reverse!|) (|List| |$|) |ISTRING;split;$CL;22| |ISTRING;split;$CcL;23| |ISTRING;leftTrim;$C$;24| |ISTRING;leftTrim;$Cc$;25| |ISTRING;rightTrim;$C$;26| |ISTRING;rightTrim;$Cc$;27| |ISTRING;copyInto!;2$I$;29| |ISTRING;concat;L$;28| (91 . |ord|) |ISTRING;hash;$I;32| |ISTRING;match;2$CNni;33| (96 . |prefix?|) |ISTRING;match?;2$CB;34| (|List| 8) (|List| 74) (|Equation| 8) (|Mapping| 8 8 8) (|InputForm|) (|SingleInteger|) (|Mapping| 11 8) (|Mapping| 11 8 8) (|Void|) (|Union| 8 (QUOTE "failed")) (|List| 18))) (QUOTE #(|~=| 102 |upperCase!| 108 |upperCase| 113 |trim| 118 |swap!| 130 |suffix?| 137 |substring?| 143 |split| 150 |sorted?| 162 |sort!| 173 |sort| 184 |size?| 195 |setelt| 201 |select| 215 |sample| 221 |rightTrim| 225 |reverse!| 237 |reverse| 242 |replace| 247 |removeDuplicates| 254 |remove| 259 |reduce| 271 |qsetelt!| 292 |qelt| 299 |prefix?| 305 |position| 311 |parts| 344 |new| 349 |more?| 355 |minIndex| 361 |min| 366 |merge| 372 |members| 385 |member?| 390 |maxIndex| 396 |max| 401 |match?| 407 |match| 414 |map!| 421 |map| 427 |lowerCase!| 440 |lowerCase| 445 |less?| 450 |leftTrim| 456 |latex| 468 |insert| 473 |indices| 487 |index?| 492 |hash| 498 |first| 508 |find| 513 |fill!| 519 |every?| 525 |eval| 531 |eq?| 557 |entry?| 563 |entries| 569 |empty?| 574 |empty| 579 |elt| 583 |delete| 608 |count| 620 |copyInto!| 632 |copy| 639 |convert| 644 |construct| 649 |concat| 654 |coerce| 677 |any?| 687 |>=| 693 |>| 699 |=| 705 |<=| 711 |<| 717 |#| 723)) (QUOTE ((|shallowlyMutable| . 0) (|finiteAggregate| . 0))) (CONS (|makeByteWordVec2| 7 (QUOTE (0 0 0 0 0 0 0 3 0 0 7 4 0 0 7 1 2 4))) (CONS (QUOTE #(|StringAggregate&| |OneDimensionalArrayAggregate&| |FiniteLinearAggregate&| |LinearAggregate&| |IndexedAggregate&| |Collection&| |HomogeneousAggregate&| |OrderedSet&| |Aggregate&| |EltableAggregate&| |Evalable&| |SetCategory&| NIL NIL |InnerEvalable&| NIL NIL |BasicType&|)) (CONS (QUOTE #((|StringAggregate|) (|OneDimensionalArrayAggregate| 8) (|FiniteLinearAggregate| 8) (|LinearAggregate| 8) (|IndexedAggregate| 18 8) (|Collection| 8) (|HomogeneousAggregate| 8) (|OrderedSet|) (|Aggregate|) (|EltableAggregate| 18 8) (|Evalable| 8) (|SetCategory|) (|Type|) (|Eltable| 18 8) (|InnerEvalable| 8 8) (|CoercibleTo| 25) (|ConvertibleTo| 76) (|BasicType|))) (|makeByteWordVec2| 82 (QUOTE (2 19 0 18 18 20 1 19 0 18 22 1 25 0 24 26 0 29 0 30 1 8 0 0 31 2 0 0 32 0 33 0 29 0 35 1 8 0 0 36 1 19 18 0 39 1 19 11 0 40 1 19 18 0 41 1 0 18 0 42 0 8 0 43 2 29 11 8 0 49 2 8 11 0 0 53 0 54 0 55 2 54 0 2 0 56 1 54 0 0 57 1 8 18 0 67 2 0 11 0 0 70 2 1 11 0 0 1 1 0 0 0 34 1 0 0 0 1 2 0 0 0 8 1 2 0 0 0 29 1 3 0 80 0 18 18 1 2 0 11 0 0 51 3 0 11 0 0 18 46 2 0 58 0 29 60 2 0 58 0 8 59 1 3 11 0 1 2 0 11 79 0 1 1 3 0 0 1 2 0 0 79 0 1 1 3 0 0 1 2 0 0 79 0 1 2 0 11 0 7 1 3 0 8 0 19 8 1 3 0 8 0 18 8 45 2 0 0 78 0 1 0 0 0 1 2 0 0 0 8 63 2 0 0 0 29 64 1 0 0 0 1 1 0 0 0 1 3 0 0 0 19 0 44 1 1 0 0 1 2 1 0 8 0 1 2 0 0 78 0 1 4 1 8 75 0 8 8 1 3 0 8 75 0 8 1 2 0 8 75 0 1 3 0 8 0 18 8 1 2 0 8 0 18 1 2 0 11 0 0 70 3 1 18 8 0 18 48 2 1 18 8 0 1 3 0 18 29 0 18 50 3 0 18 0 0 18 47 2 0 18 78 0 1 1 0 72 0 1 2 0 0 7 8 9 2 0 11 0 7 1 1 5 18 0 28 2 3 0 0 0 1 2 3 0 0 0 1 3 0 0 79 0 0 1 1 0 72 0 1 2 1 11 8 0 1 1 5 18 0 42 2 3 0 0 0 1 3 0 11 0 0 8 71 3 0 7 0 0 8 69 2 0 0 32 0 33 3 0 0 75 0 0 1 2 0 0 32 0 1 1 0 0 0 37 1 0 0 0 1 2 0 11 0 7 1 2 0 0 0 8 61 2 0 0 0 29 62 1 1 24 0 38 3 0 0 8 0 18 1 3 0 0 0 0 18 23 1 0 82 0 1 2 0 11 18 0 1 1 1 77 0 1 1 0 18 0 68 1 5 8 0 1 2 0 81 78 0 1 2 0 0 0 8 1 2 0 11 78 0 1 3 6 0 0 72 72 1 3 6 0 0 8 8 1 2 6 0 0 73 1 2 6 0 0 74 1 2 0 11 0 0 1 2 1 11 8 0 1 1 0 72 0 1 1 0 11 0 12 0 0 0 10 2 0 0 0 0 1 2 0 0 0 19 21 2 0 8 0 18 52 3 0 8 0 18 8 1 2 0 0 0 18 1 2 0 0 0 19 1 2 1 7 8 0 1 2 0 7 78 0 1 3 0 0 0 0 18 65 1 0 0 0 17 1 2 76 0 1 1 0 0 72 1 1 0 0 58 66 2 0 0 0 0 16 2 0 0 0 8 1 2 0 0 8 0 1 1 1 25 0 27 1 0 0 8 1 2 0 11 78 0 1 2 3 11 0 0 1 2 3 11 0 0 1 2 1 11 0 0 14 2 3 11 0 0 1 2 3 11 0 0 15 1 0 7 0 13)))))) (QUOTE |lookupComplete|))) -@ -\section{domain STRING String} -<>= --- string.spad.pamphlet String.input -)spool String.output -)set message test on -)set message auto off -)clear all ---S 1 of 35 -hello := "Hello, I'm AXIOM!" ---R ---R ---R (1) "Hello, I'm AXIOM!" ---R Type: String ---E 1 - ---S 2 of 35 -said := "Jane said, \_"Look!\_"" ---R ---R ---R (2) "Jane said, \"Look!\"" ---R Type: String ---E 2 - ---S 3 of 35 -saw := "She saw exactly one underscore: \_\_." ---R ---R ---R (3) "She saw exactly one underscore: \\." ---R Type: String ---E 3 - ---S 4 of 35 -gasp: String := new(32, char "x") ---R ---R ---R (4) "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx" ---R Type: String ---E 4 - ---S 5 of 35 -#gasp ---R ---R ---R (5) 32 ---R Type: PositiveInteger ---E 5 - ---S 6 of 35 -hello.2 ---R ---R ---R (6) e ---R Type: Character ---E 6 - ---S 7 of 35 -hello 2 ---R ---R ---R (7) e ---R Type: Character ---E 7 - ---S 8 of 35 -hello(2) ---R ---R ---R (8) e ---R Type: Character ---E 8 - ---S 9 of 35 -hullo := copy hello ---R ---R ---R (9) "Hello, I'm AXIOM!" ---R Type: String ---E 9 - ---S 10 of 35 -hullo.2 := char "u"; [hello, hullo] ---R ---R ---R (10) ["Hello, I'm AXIOM!","Hullo, I'm AXIOM!"] ---R Type: List String ---E 10 - ---S 11 of 35 -saidsaw := concat ["alpha","---","omega"] ---R ---R ---R (11) "alpha---omega" ---R Type: String ---E 11 - ---S 12 of 35 -concat("hello ","goodbye") ---R ---R ---R (12) "hello goodbye" ---R Type: String ---E 12 - ---S 13 of 35 -"This " "is " "several " "strings " "concatenated." ---R ---R ---R (13) "This is several strings concatenated." ---R Type: String ---E 13 - ---S 14 of 35 -hello(1..5) ---R ---R ---R (14) "Hello" ---R Type: String ---E 14 - ---S 15 of 35 -hello(8..) ---R ---R ---R (15) "I'm AXIOM!" ---R Type: String ---E 15 - ---S 16 of 35 -split(hello, char " ") ---R ---R ---R (16) ["Hello,","I'm","AXIOM!"] ---R Type: List String ---E 16 - ---S 17 of 35 -other := complement alphanumeric(); ---R ---R Type: CharacterClass ---E 17 - ---S 18 of 35 -split(saidsaw, other) ---R ---R ---R (18) ["alpha","omega"] ---R Type: List String ---E 18 - ---S 19 of 35 -trim("## ++ relax ++ ##", char "#") ---R ---R ---R (19) " ++ relax ++ " ---R Type: String ---E 19 - ---S 20 of 35 -trim("## ++ relax ++ ##", other) ---R ---R ---R (20) "relax" ---R Type: String ---E 20 - ---S 21 of 35 -leftTrim("## ++ relax ++ ##", other) ---R ---R ---R (21) "relax ++ ##" ---R Type: String ---E 21 - ---S 22 of 35 -rightTrim("## ++ relax ++ ##", other) ---R ---R ---R (22) "## ++ relax" ---R Type: String ---E 22 - ---S 23 of 35 -upperCase hello ---R ---R ---R (23) "HELLO, I'M AXIOM!" ---R Type: String ---E 23 - ---S 24 of 35 -lowerCase hello ---R ---R ---R (24) "hello, i'm axiom!" ---R Type: String ---E 24 - ---S 25 of 35 -prefix?("He", "Hello") ---R ---R ---R (25) true ---R Type: Boolean ---E 25 - ---S 26 of 35 -prefix?("Her", "Hello") ---R ---R ---R (26) false ---R Type: Boolean ---E 26 - ---S 27 of 35 -suffix?("", "Hello") ---R ---R ---R (27) true ---R Type: Boolean ---E 27 - ---S 28 of 35 -suffix?("LO", "Hello") ---R ---R ---R (28) false ---R Type: Boolean ---E 28 - ---S 29 of 35 -substring?("ll", "Hello", 3) ---R ---R ---R (29) true ---R Type: Boolean ---E 29 - ---S 30 of 35 -substring?("ll", "Hello", 4) ---R ---R ---R (30) false ---R Type: Boolean ---E 30 - ---S 31 of 35 -n := position("nd", "underground", 1) ---R ---R ---R (31) 2 ---R Type: PositiveInteger ---E 31 - ---S 32 of 35 -n := position("nd", "underground", n+1) ---R ---R ---R (32) 10 ---R Type: PositiveInteger ---E 32 - ---S 33 of 35 -n := position("nd", "underground", n+1) ---R ---R ---R (33) 0 ---R Type: NonNegativeInteger ---E 33 - ---S 34 of 35 -position(char "d", "underground", 1) ---R ---R ---R (34) 3 ---R Type: PositiveInteger ---E 34 - ---S 35 of 35 -position(hexDigit(), "underground", 1) ---R ---R ---R (35) 3 ---R Type: PositiveInteger ---E 35 -)spool -)lisp (bye) -@ -<>= -==================================================================== -String examples -==================================================================== - -The type String provides character strings. Character strings -provide all the operations for a one-dimensional array of characters, -plus additional operations for manipulating text. - -String values can be created using double quotes. - - hello := "Hello, I'm AXIOM!" - "Hello, I'm AXIOM!" - Type: String - -Note, however, that double quotes and underscores must be preceded by -an extra underscore. - - said := "Jane said, \_"Look!\_"" - "Jane said, \"Look!\"" - Type: String - - saw := "She saw exactly one underscore: \_\_." - "She saw exactly one underscore: \\." - Type: String - -It is also possible to use new to create a string of any size filled -with a given character. Since there are many new functions it is -necessary to indicate the desired type. - - gasp: String := new(32, char "x") - "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx" - Type: String - -The length of a string is given by #. - - #gasp - 32 - Type: PositiveInteger - -Indexing operations allow characters to be extracted or replaced in strings. -For any string s, indices lie in the range 1..#s. - - hello.2 - e - Type: Character - -Indexing is really just the application of a string to a subscript, so -any application syntax works. - - hello 2 - e - Type: Character - - hello(2) - e - Type: Character - -If it is important not to modify a given string, it should be copied -before any updating operations are used. - - hullo := copy hello - "Hello, I'm AXIOM!" - Type: String - - hullo.2 := char "u"; [hello, hullo] - ["Hello, I'm AXIOM!","Hullo, I'm AXIOM!"] - Type: List String - -Operations are provided to split and join strings. The concat -operation allows several strings to be joined together. - - saidsaw := concat ["alpha","---","omega"] - "alpha---omega" - Type: String - -There is a version of concat that works with two strings. - - concat("hello ","goodbye") - "hello goodbye" - Type: String - -Juxtaposition can also be used to concatenate strings. - - "This " "is " "several " "strings " "concatenated." - "This is several strings concatenated." - Type: String - -Substrings are obtained by giving an index range. - - hello(1..5) - "Hello" - Type: String - - hello(8..) - "I'm AXIOM!" - Type: String - -A string can be split into several substrings by giving a separation -character or character class. - - split(hello, char " ") - ["Hello,","I'm","AXIOM!"] - Type: List String - - other := complement alphanumeric(); - Type: CharacterClass - - split(saidsaw, other) - ["alpha","omega"] - Type: List String - -Unwanted characters can be trimmed from the beginning or end of a string -using the operations trim, leftTrim and rightTrim. - - trim("## ++ relax ++ ##", char "#") - " ++ relax ++ " - Type: String - -Each of these functions takes a string and a second argument to specify -the characters to be discarded. - - trim("## ++ relax ++ ##", other) - "relax" - Type: String - -The second argument can be given either as a single character or as a -character class. - - leftTrim("## ++ relax ++ ##", other) - "relax ++ ##" - Type: String - - rightTrim("## ++ relax ++ ##", other) - "## ++ relax" - Type: String - -Strings can be changed to upper case or lower case using the -operations upperCase and lowerCase. - - upperCase hello - "HELLO, I'M AXIOM!" - Type: String - -The versions with the exclamation mark change the original string, -while the others produce a copy. - - lowerCase hello - "hello, i'm axiom!" - Type: String - -Some basic string matching is provided. The function prefix? tests -whether one string is an initial prefix of another. - - prefix?("He", "Hello") - true - Type: Boolean - - prefix?("Her", "Hello") - false - Type: Boolean - -A similar function, suffix?, tests for suffixes. - - suffix?("", "Hello") - true - Type: Boolean - - suffix?("LO", "Hello") - false - Type: Boolean - -The function substring? tests for a substring given a starting position. - - substring?("ll", "Hello", 3) - true - Type: Boolean - - substring?("ll", "Hello", 4) - false - Type: Boolean - -A number of position functions locate things in strings. If the first -argument to position is a string, then position(s,t,i) finds the -location of s as a substring of t starting the search at position i. - - n := position("nd", "underground", 1) - 2 - Type: PositiveInteger - - n := position("nd", "underground", n+1) - 10 - Type: PositiveInteger - -If s is not found, then 0 is returned (minIndex(s)-1 in IndexedString). - - n := position("nd", "underground", n+1) - 0 - Type: NonNegativeInteger - -To search for a specific character or a member of a character class, -a different first argument is used. - - position(char "d", "underground", 1) - 3 - Type: PositiveInteger - - position(hexDigit(), "underground", 1) - 3 - Type: PositiveInteger - -See Also: -o )help Character -o )help CharacterClass -o )show String -o $AXIOM/doc/src/algebra/string.spad.dvi - -@ -<>= -)abbrev domain STRING String -++ Description: -++ This is the domain of character strings. -MINSTRINGINDEX ==> 1 -- as of 3/14/90. - -String(): StringCategory == IndexedString(MINSTRINGINDEX) add - string n == STRINGIMAGE(n)$Lisp - - OMwrite(x: %): String == - s: String := "" - sp := OM_-STRINGTOSTRINGPTR(s)$Lisp - dev: OpenMathDevice := OMopenString(sp pretend String, OMencodingXML) - OMputObject(dev) - OMputString(dev, x pretend String) - 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) - OMputString(dev, x pretend String) - if wholeObj then - OMputEndObject(dev) - OMclose(dev) - s := OM_-STRINGPTRTOSTRING(sp)$Lisp pretend String - s - - OMwrite(dev: OpenMathDevice, x: %): Void == - OMputObject(dev) - OMputString(dev, x pretend String) - OMputEndObject(dev) - - OMwrite(dev: OpenMathDevice, x: %, wholeObj: Boolean): Void == - if wholeObj then - OMputObject(dev) - OMputString(dev, x pretend String) - if wholeObj then - OMputEndObject(dev) - -@ -\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/suchthat.spad.pamphlet b/src/algebra/suchthat.spad.pamphlet deleted file mode 100644 index f26514f..0000000 --- a/src/algebra/suchthat.spad.pamphlet +++ /dev/null @@ -1,79 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra suchthat.spad} -\author{Timothy Daly} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{domain SUCH SuchThat} -<>= -)abbrev domain SUCH SuchThat -++ Description: -++ This domain implements "such that" forms -SuchThat(S1, S2): Cat == Capsule where - E ==> OutputForm - S1, S2: SetCategory - - Cat == SetCategory with - construct: (S1, S2) -> % - ++ construct(s,t) makes a form s:t - lhs: % -> S1 - ++ lhs(f) returns the left side of f - rhs: % -> S2 - ++ rhs(f) returns the right side of f - - Capsule == add - Rep := Record(obj: S1, cond: S2) - construct(o, c) == [o, c]$Record(obj: S1, cond: S2) - lhs st == st.obj - rhs st == st.cond - coerce(w):E == infix("|"::E, w.obj::E, w.cond::E) - -@ -\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/suls.spad.pamphlet b/src/algebra/suls.spad.pamphlet deleted file mode 100644 index 8bdf483..0000000 --- a/src/algebra/suls.spad.pamphlet +++ /dev/null @@ -1,250 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra suls.spad} -\author{Clifton J. Williamson} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{domain SULS SparseUnivariateLaurentSeries} -<>= -)abbrev domain SULS SparseUnivariateLaurentSeries -++ Author: Clifton J. Williamson -++ Date Created: 11 November 1994 -++ Date Last Updated: 10 March 1995 -++ Basic Operations: -++ Related Domains: InnerSparseUnivariatePowerSeries, -++ SparseUnivariateTaylorSeries, SparseUnivariatePuiseuxSeries -++ Also See: -++ AMS Classifications: -++ Keywords: sparse, series -++ Examples: -++ References: -++ Description: Sparse Laurent series in one variable -++ \spadtype{SparseUnivariateLaurentSeries} is a domain representing Laurent -++ series in one variable with coefficients in an arbitrary ring. The -++ parameters of the type specify the coefficient ring, the power series -++ variable, and the center of the power series expansion. For example, -++ \spad{SparseUnivariateLaurentSeries(Integer,x,3)} represents Laurent -++ series in \spad{(x - 3)} with integer coefficients. -SparseUnivariateLaurentSeries(Coef,var,cen): Exports == Implementation where - Coef : Ring - var : Symbol - cen : Coef - I ==> Integer - NNI ==> NonNegativeInteger - OUT ==> OutputForm - P ==> Polynomial Coef - RF ==> Fraction Polynomial Coef - RN ==> Fraction Integer - S ==> String - SUTS ==> SparseUnivariateTaylorSeries(Coef,var,cen) - EFULS ==> ElementaryFunctionsUnivariateLaurentSeries(Coef,SUTS,%) - - Exports ==> UnivariateLaurentSeriesConstructorCategory(Coef,SUTS) with - coerce: Variable(var) -> % - ++ \spad{coerce(var)} converts the series variable \spad{var} into a - ++ Laurent series. - differentiate: (%,Variable(var)) -> % - ++ \spad{differentiate(f(x),x)} returns the derivative of - ++ \spad{f(x)} with respect to \spad{x}. - if Coef has Algebra Fraction Integer then - integrate: (%,Variable(var)) -> % - ++ \spad{integrate(f(x))} returns an anti-derivative of the power - ++ series \spad{f(x)} with constant coefficient 0. - ++ We may integrate a series when we can divide coefficients - ++ by integers. - - Implementation ==> InnerSparseUnivariatePowerSeries(Coef) add - - Rep := InnerSparseUnivariatePowerSeries(Coef) - - variable x == var - center x == cen - - coerce(v: Variable(var)) == - zero? cen => monomial(1,1) - monomial(1,1) + monomial(cen,0) - - pole? x == negative? order(x,0) - ---% operations with Taylor series - - coerce(uts:SUTS) == uts pretend % - - taylorIfCan uls == - pole? uls => "failed" - uls pretend SUTS - - taylor uls == - (uts := taylorIfCan uls) case "failed" => - error "taylor: Laurent series has a pole" - uts :: SUTS - - retractIfCan(x:%):Union(SUTS,"failed") == taylorIfCan x - - laurent(n,uts) == monomial(1,n) * (uts :: %) - - removeZeroes uls == uls - removeZeroes(n,uls) == uls - - taylorRep uls == taylor(monomial(1,-order(uls,0)) * uls) - degree uls == order(uls,0) - - numer uls == taylorRep uls - denom uls == monomial(1,(-order(uls,0)) :: NNI)$SUTS - - (uts:SUTS) * (uls:%) == (uts :: %) * uls - (uls:%) * (uts:SUTS) == uls * (uts :: %) - - if Coef has Field then - (uts1:SUTS) / (uts2:SUTS) == (uts1 :: %) / (uts2 :: %) - - recip(uls) == iExquo(1,uls,false) - - if Coef has IntegralDomain then - uls1 exquo uls2 == iExquo(uls1,uls2,false) - - if Coef has Field then - uls1:% / uls2:% == - (q := uls1 exquo uls2) case "failed" => - error "quotient cannot be computed" - q :: % - - differentiate(uls:%,v:Variable(var)) == differentiate uls - - elt(uls1:%,uls2:%) == - order(uls2,1) < 1 => - error "elt: second argument must have positive order" - negative?(ord := order(uls1,0)) => - (recipr := recip uls2) case "failed" => - error "elt: second argument not invertible" - uls3 := uls1 * monomial(1,-ord) - iCompose(uls3,uls2) * (recipr :: %) ** ((-ord) :: NNI) - iCompose(uls1,uls2) - - if Coef has IntegralDomain then - rationalFunction(uls,n) == - zero?(e := order(uls,0)) => - negative? n => 0 - polynomial(taylor uls,n :: NNI) :: RF - negative?(m := n - e) => 0 - poly := polynomial(taylor(monomial(1,-e) * uls),m :: NNI) :: RF - v := variable(uls) :: RF; c := center(uls) :: P :: RF - poly / (v - c) ** ((-e) :: NNI) - - rationalFunction(uls,n1,n2) == rationalFunction(truncate(uls,n1,n2),n2) - - if Coef has Algebra Fraction Integer then - - integrate uls == - zero? coefficient(uls,-1) => - error "integrate: series has term of order -1" - integrate(uls)$Rep - - integrate(uls:%,v:Variable(var)) == integrate uls - - (uls1:%) ** (uls2:%) == exp(log(uls1) * uls2) - - exp uls == exp(uls)$EFULS - log uls == log(uls)$EFULS - sin uls == sin(uls)$EFULS - cos uls == cos(uls)$EFULS - tan uls == tan(uls)$EFULS - cot uls == cot(uls)$EFULS - sec uls == sec(uls)$EFULS - csc uls == csc(uls)$EFULS - asin uls == asin(uls)$EFULS - acos uls == acos(uls)$EFULS - atan uls == atan(uls)$EFULS - acot uls == acot(uls)$EFULS - asec uls == asec(uls)$EFULS - acsc uls == acsc(uls)$EFULS - sinh uls == sinh(uls)$EFULS - cosh uls == cosh(uls)$EFULS - tanh uls == tanh(uls)$EFULS - coth uls == coth(uls)$EFULS - sech uls == sech(uls)$EFULS - csch uls == csch(uls)$EFULS - asinh uls == asinh(uls)$EFULS - acosh uls == acosh(uls)$EFULS - atanh uls == atanh(uls)$EFULS - acoth uls == acoth(uls)$EFULS - asech uls == asech(uls)$EFULS - acsch uls == acsch(uls)$EFULS - - if Coef has CommutativeRing then - - (uls:%) ** (r:RN) == cRationalPower(uls,r) - - else - - (uls:%) ** (r:RN) == - negative?(ord0 := order(uls,0)) => - order := ord0 :: I - (n := order exquo denom(r)) case "failed" => - error "**: rational power does not exist" - uts := retract(uls * monomial(1,-order))@SUTS - utsPow := (uts ** r) :: % - monomial(1,(n :: I) * numer(r)) * utsPow - uts := retract(uls)@SUTS - (uts ** r) :: % - ---% OutputForms - - coerce(uls:%): OUT == - st := getStream uls - if not(explicitlyEmpty? st or explicitEntries? st) _ - and (nx := retractIfCan(elt getRef uls))@Union(I,"failed") case I then - count : NNI := _$streamCount$Lisp - degr := min(count,(nx :: I) + count + 1) - extend(uls,degr) - seriesToOutputForm(st,getRef uls,variable uls,center uls,1) - -@ -\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/sups.spad.pamphlet b/src/algebra/sups.spad.pamphlet deleted file mode 100644 index 289a0f6..0000000 --- a/src/algebra/sups.spad.pamphlet +++ /dev/null @@ -1,1114 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra sups.spad} -\author{Clifton J. Williamson} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{domain ISUPS InnerSparseUnivariatePowerSeries} -<>= -)abbrev domain ISUPS InnerSparseUnivariatePowerSeries -++ Author: Clifton J. Williamson -++ Date Created: 28 October 1994 -++ Date Last Updated: 9 March 1995 -++ Basic Operations: -++ Related Domains: SparseUnivariateTaylorSeries, SparseUnivariateLaurentSeries -++ SparseUnivariatePuiseuxSeries -++ Also See: -++ AMS Classifications: -++ Keywords: sparse, series -++ Examples: -++ References: -++ Description: InnerSparseUnivariatePowerSeries is an internal domain -++ used for creating sparse Taylor and Laurent series. -InnerSparseUnivariatePowerSeries(Coef): Exports == Implementation where - Coef : Ring - B ==> Boolean - COM ==> OrderedCompletion Integer - I ==> Integer - L ==> List - NNI ==> NonNegativeInteger - OUT ==> OutputForm - PI ==> PositiveInteger - REF ==> Reference OrderedCompletion Integer - RN ==> Fraction Integer - Term ==> Record(k:Integer,c:Coef) - SG ==> String - ST ==> Stream Term - - Exports ==> UnivariatePowerSeriesCategory(Coef,Integer) with - makeSeries: (REF,ST) -> % - ++ makeSeries(refer,str) creates a power series from the reference - ++ \spad{refer} and the stream \spad{str}. - getRef: % -> REF - ++ getRef(f) returns a reference containing the order to which the - ++ terms of f have been computed. - getStream: % -> ST - ++ getStream(f) returns the stream of terms representing the series f. - series: ST -> % - ++ series(st) creates a series from a stream of non-zero terms, - ++ where a term is an exponent-coefficient pair. The terms in the - ++ stream should be ordered by increasing order of exponents. - monomial?: % -> B - ++ monomial?(f) tests if f is a single monomial. - multiplyCoefficients: (I -> Coef,%) -> % - ++ multiplyCoefficients(fn,f) returns the series - ++ \spad{sum(fn(n) * an * x^n,n = n0..)}, - ++ where f is the series \spad{sum(an * x^n,n = n0..)}. - iExquo: (%,%,B) -> Union(%,"failed") - ++ iExquo(f,g,taylor?) is the quotient of the power series f and g. - ++ If \spad{taylor?} is \spad{true}, then we must have - ++ \spad{order(f) >= order(g)}. - taylorQuoByVar: % -> % - ++ taylorQuoByVar(a0 + a1 x + a2 x**2 + ...) - ++ returns \spad{a1 + a2 x + a3 x**2 + ...} - iCompose: (%,%) -> % - ++ iCompose(f,g) returns \spad{f(g(x))}. This is an internal function - ++ which should only be called for Taylor series \spad{f(x)} and - ++ \spad{g(x)} such that the constant coefficient of \spad{g(x)} is zero. - seriesToOutputForm: (ST,REF,Symbol,Coef,RN) -> OutputForm - ++ seriesToOutputForm(st,refer,var,cen,r) prints the series - ++ \spad{f((var - cen)^r)}. - if Coef has Algebra Fraction Integer then - integrate: % -> % - ++ integrate(f(x)) returns an anti-derivative of the power series - ++ \spad{f(x)} with constant coefficient 0. - ++ Warning: function does not check for a term of degree -1. - cPower: (%,Coef) -> % - ++ cPower(f,r) computes \spad{f^r}, where f has constant coefficient 1. - ++ For use when the coefficient ring is commutative. - cRationalPower: (%,RN) -> % - ++ cRationalPower(f,r) computes \spad{f^r}. - ++ For use when the coefficient ring is commutative. - cExp: % -> % - ++ cExp(f) computes the exponential of the power series f. - ++ For use when the coefficient ring is commutative. - cLog: % -> % - ++ cLog(f) computes the logarithm of the power series f. - ++ For use when the coefficient ring is commutative. - cSin: % -> % - ++ cSin(f) computes the sine of the power series f. - ++ For use when the coefficient ring is commutative. - cCos: % -> % - ++ cCos(f) computes the cosine of the power series f. - ++ For use when the coefficient ring is commutative. - cTan: % -> % - ++ cTan(f) computes the tangent of the power series f. - ++ For use when the coefficient ring is commutative. - cCot: % -> % - ++ cCot(f) computes the cotangent of the power series f. - ++ For use when the coefficient ring is commutative. - cSec: % -> % - ++ cSec(f) computes the secant of the power series f. - ++ For use when the coefficient ring is commutative. - cCsc: % -> % - ++ cCsc(f) computes the cosecant of the power series f. - ++ For use when the coefficient ring is commutative. - cAsin: % -> % - ++ cAsin(f) computes the arcsine of the power series f. - ++ For use when the coefficient ring is commutative. - cAcos: % -> % - ++ cAcos(f) computes the arccosine of the power series f. - ++ For use when the coefficient ring is commutative. - cAtan: % -> % - ++ cAtan(f) computes the arctangent of the power series f. - ++ For use when the coefficient ring is commutative. - cAcot: % -> % - ++ cAcot(f) computes the arccotangent of the power series f. - ++ For use when the coefficient ring is commutative. - cAsec: % -> % - ++ cAsec(f) computes the arcsecant of the power series f. - ++ For use when the coefficient ring is commutative. - cAcsc: % -> % - ++ cAcsc(f) computes the arccosecant of the power series f. - ++ For use when the coefficient ring is commutative. - cSinh: % -> % - ++ cSinh(f) computes the hyperbolic sine of the power series f. - ++ For use when the coefficient ring is commutative. - cCosh: % -> % - ++ cCosh(f) computes the hyperbolic cosine of the power series f. - ++ For use when the coefficient ring is commutative. - cTanh: % -> % - ++ cTanh(f) computes the hyperbolic tangent of the power series f. - ++ For use when the coefficient ring is commutative. - cCoth: % -> % - ++ cCoth(f) computes the hyperbolic cotangent of the power series f. - ++ For use when the coefficient ring is commutative. - cSech: % -> % - ++ cSech(f) computes the hyperbolic secant of the power series f. - ++ For use when the coefficient ring is commutative. - cCsch: % -> % - ++ cCsch(f) computes the hyperbolic cosecant of the power series f. - ++ For use when the coefficient ring is commutative. - cAsinh: % -> % - ++ cAsinh(f) computes the inverse hyperbolic sine of the power - ++ series f. For use when the coefficient ring is commutative. - cAcosh: % -> % - ++ cAcosh(f) computes the inverse hyperbolic cosine of the power - ++ series f. For use when the coefficient ring is commutative. - cAtanh: % -> % - ++ cAtanh(f) computes the inverse hyperbolic tangent of the power - ++ series f. For use when the coefficient ring is commutative. - cAcoth: % -> % - ++ cAcoth(f) computes the inverse hyperbolic cotangent of the power - ++ series f. For use when the coefficient ring is commutative. - cAsech: % -> % - ++ cAsech(f) computes the inverse hyperbolic secant of the power - ++ series f. For use when the coefficient ring is commutative. - cAcsch: % -> % - ++ cAcsch(f) computes the inverse hyperbolic cosecant of the power - ++ series f. For use when the coefficient ring is commutative. - - Implementation ==> add - import REF - - Rep := Record(%ord: REF,%str: Stream Term) - -- when the value of 'ord' is n, this indicates that all non-zero - -- terms of order up to and including n have been computed; - -- when 'ord' is plusInfinity, all terms have been computed; - -- lazy evaluation of 'str' has the side-effect of modifying the value - -- of 'ord' - ---% Local functions - - makeTerm: (Integer,Coef) -> Term - getCoef: Term -> Coef - getExpon: Term -> Integer - iSeries: (ST,REF) -> ST - iExtend: (ST,COM,REF) -> ST - iTruncate0: (ST,REF,REF,COM,I,I) -> ST - iTruncate: (%,COM,I) -> % - iCoefficient: (ST,Integer) -> Coef - iOrder: (ST,COM,REF) -> I - iMap1: ((Coef,I) -> Coef,I -> I,B,ST,REF,REF,Integer) -> ST - iMap2: ((Coef,I) -> Coef,I -> I,B,%) -> % - iPlus1: ((Coef,Coef) -> Coef,ST,REF,ST,REF,REF,I) -> ST - iPlus2: ((Coef,Coef) -> Coef,%,%) -> % - productByTerm: (Coef,I,ST,REF,REF,I) -> ST - productLazyEval: (ST,REF,ST,REF,COM) -> Void - iTimes: (ST,REF,ST,REF,REF,I) -> ST - iDivide: (ST,REF,ST,REF,Coef,I,REF,I) -> ST - divide: (%,I,%,I,Coef) -> % - compose0: (ST,REF,ST,REF,I,%,%,I,REF,I) -> ST - factorials?: () -> Boolean - termOutput: (RN,Coef,OUT) -> OUT - showAll?: () -> Boolean - ---% macros - - makeTerm(exp,coef) == [exp,coef] - getCoef term == term.c - getExpon term == term.k - - makeSeries(refer,x) == [refer,x] - getRef ups == ups.%ord - getStream ups == ups.%str - ---% creation and destruction of series - - monomial(coef,expon) == - nix : ST := empty() - st := - zero? coef => nix - concat(makeTerm(expon,coef),nix) - makeSeries(ref plusInfinity(),st) - - monomial? ups == (not empty? getStream ups) and (empty? rst getStream ups) - - coerce(n:I) == n :: Coef :: % - coerce(r:Coef) == monomial(r,0) - - iSeries(x,refer) == - empty? x => (setelt(refer,plusInfinity()); empty()) - setelt(refer,(getExpon frst x) :: COM) - concat(frst x,iSeries(rst x,refer)) - - series(x:ST) == - empty? x => 0 - n := getExpon frst x; refer := ref(n :: COM) - makeSeries(refer,iSeries(x,refer)) - ---% values - - characteristic() == characteristic()$Coef - - 0 == monomial(0,0) - 1 == monomial(1,0) - - iExtend(st,n,refer) == - (elt refer) < n => - explicitlyEmpty? st => (setelt(refer,plusInfinity()); st) - explicitEntries? st => iExtend(rst st,n,refer) - iExtend(lazyEvaluate st,n,refer) - st - - extend(x,n) == (iExtend(getStream x,n :: COM,getRef x); x) - complete x == (iExtend(getStream x,plusInfinity(),getRef x); x) - - iTruncate0(x,xRefer,refer,minExp,maxExp,n) == delay - explicitlyEmpty? x => (setelt(refer,plusInfinity()); empty()) - nn := n :: COM - while (elt xRefer) < nn repeat lazyEvaluate x - explicitEntries? x => - (nx := getExpon(xTerm := frst x)) > maxExp => - (setelt(refer,plusInfinity()); empty()) - setelt(refer,nx :: COM) - (nx :: COM) >= minExp => - concat(makeTerm(nx,getCoef xTerm),_ - iTruncate0(rst x,xRefer,refer,minExp,maxExp,nx + 1)) - iTruncate0(rst x,xRefer,refer,minExp,maxExp,nx + 1) - -- can't have elt(xRefer) = infty unless all terms have been computed - degr := retract(elt xRefer)@I - setelt(refer,degr :: COM) - iTruncate0(x,xRefer,refer,minExp,maxExp,degr + 1) - - iTruncate(ups,minExp,maxExp) == - x := getStream ups; xRefer := getRef ups - explicitlyEmpty? x => 0 - explicitEntries? x => - deg := getExpon frst x - refer := ref((deg - 1) :: COM) - makeSeries(refer,iTruncate0(x,xRefer,refer,minExp,maxExp,deg)) - -- can't have elt(xRefer) = infty unless all terms have been computed - degr := retract(elt xRefer)@I - refer := ref(degr :: COM) - makeSeries(refer,iTruncate0(x,xRefer,refer,minExp,maxExp,degr + 1)) - - truncate(ups,n) == iTruncate(ups,minusInfinity(),n) - truncate(ups,n1,n2) == - if n1 > n2 then (n1,n2) := (n2,n1) - iTruncate(ups,n1 :: COM,n2) - - iCoefficient(st,n) == - explicitEntries? st => - term := frst st - (expon := getExpon term) > n => 0 - expon = n => getCoef term - iCoefficient(rst st,n) - 0 - - coefficient(x,n) == (extend(x,n); iCoefficient(getStream x,n)) - elt(x:%,n:Integer) == coefficient(x,n) - - iOrder(st,n,refer) == - explicitlyEmpty? st => error "order: series has infinite order" - explicitEntries? st => - ((r := getExpon frst st) :: COM) >= n => retract(n)@Integer - r - -- can't have elt(xRefer) = infty unless all terms have been computed - degr := retract(elt refer)@I - (degr :: COM) >= n => retract(n)@Integer - iOrder(lazyEvaluate st,n,refer) - - order x == iOrder(getStream x,plusInfinity(),getRef x) - order(x,n) == iOrder(getStream x,n :: COM,getRef x) - - terms x == getStream x - ---% predicates - - zero? ups == - x := getStream ups; ref := getRef ups - whatInfinity(n := elt ref) = 1 => explicitlyEmpty? x - count : NNI := _$streamCount$Lisp - for i in 1..count repeat - explicitlyEmpty? x => return true - explicitEntries? x => return false - lazyEvaluate x - false - - ups1 = ups2 == zero?(ups1 - ups2) - ---% arithmetic - - iMap1(cFcn,eFcn,check?,x,xRefer,refer,n) == delay - -- when this function is called, all terms in 'x' of order < n have been - -- computed and we compute the eFcn(n)th order coefficient of the result - explicitlyEmpty? x => (setelt(refer,plusInfinity()); empty()) - -- if terms in 'x' up to order n have not been computed, - -- apply lazy evaluation - nn := n :: COM - while (elt xRefer) < nn repeat lazyEvaluate x - -- 'x' may now be empty: retest - explicitlyEmpty? x => (setelt(refer,plusInfinity()); empty()) - -- must have nx >= n - explicitEntries? x => - xCoef := getCoef(xTerm := frst x); nx := getExpon xTerm - newCoef := cFcn(xCoef,nx); m := eFcn nx - setelt(refer,m :: COM) - not check? => - concat(makeTerm(m,newCoef),_ - iMap1(cFcn,eFcn,check?,rst x,xRefer,refer,nx + 1)) - zero? newCoef => iMap1(cFcn,eFcn,check?,rst x,xRefer,refer,nx + 1) - concat(makeTerm(m,newCoef),_ - iMap1(cFcn,eFcn,check?,rst x,xRefer,refer,nx + 1)) - -- can't have elt(xRefer) = infty unless all terms have been computed - degr := retract(elt xRefer)@I - setelt(refer,eFcn(degr) :: COM) - iMap1(cFcn,eFcn,check?,x,xRefer,refer,degr + 1) - - iMap2(cFcn,eFcn,check?,ups) == - -- 'eFcn' must be a strictly increasing function, - -- i.e. i < j => eFcn(i) < eFcn(j) - xRefer := getRef ups; x := getStream ups - explicitlyEmpty? x => 0 - explicitEntries? x => - deg := getExpon frst x - refer := ref(eFcn(deg - 1) :: COM) - makeSeries(refer,iMap1(cFcn,eFcn,check?,x,xRefer,refer,deg)) - -- can't have elt(xRefer) = infty unless all terms have been computed - degr := retract(elt xRefer)@I - refer := ref(eFcn(degr) :: COM) - makeSeries(refer,iMap1(cFcn,eFcn,check?,x,xRefer,refer,degr + 1)) - - map(fcn,x) == iMap2(fcn(#1),#1,true,x) - differentiate x == iMap2(#2 * #1,#1 - 1,true,x) - multiplyCoefficients(f,x) == iMap2(f(#2) * #1,#1,true,x) - multiplyExponents(x,n) == iMap2(#1,n * #1,false,x) - - iPlus1(op,x,xRefer,y,yRefer,refer,n) == delay - -- when this function is called, all terms in 'x' and 'y' of order < n - -- have been computed and we are computing the nth order coefficient of - -- the result; note the 'op' is either '+' or '-' - explicitlyEmpty? x => iMap1(op(0,#1),#1,false,y,yRefer,refer,n) - explicitlyEmpty? y => iMap1(op(#1,0),#1,false,x,xRefer,refer,n) - -- if terms up to order n have not been computed, - -- apply lazy evaluation - nn := n :: COM - while (elt xRefer) < nn repeat lazyEvaluate x - while (elt yRefer) < nn repeat lazyEvaluate y - -- 'x' or 'y' may now be empty: retest - explicitlyEmpty? x => iMap1(op(0,#1),#1,false,y,yRefer,refer,n) - explicitlyEmpty? y => iMap1(op(#1,0),#1,false,x,xRefer,refer,n) - -- must have nx >= n, ny >= n - -- both x and y have explicit terms - explicitEntries?(x) and explicitEntries?(y) => - xCoef := getCoef(xTerm := frst x); nx := getExpon xTerm - yCoef := getCoef(yTerm := frst y); ny := getExpon yTerm - nx = ny => - setelt(refer,nx :: COM) - zero? (coef := op(xCoef,yCoef)) => - iPlus1(op,rst x,xRefer,rst y,yRefer,refer,nx + 1) - concat(makeTerm(nx,coef),_ - iPlus1(op,rst x,xRefer,rst y,yRefer,refer,nx + 1)) - nx < ny => - setelt(refer,nx :: COM) - concat(makeTerm(nx,op(xCoef,0)),_ - iPlus1(op,rst x,xRefer,y,yRefer,refer,nx + 1)) - setelt(refer,ny :: COM) - concat(makeTerm(ny,op(0,yCoef)),_ - iPlus1(op,x,xRefer,rst y,yRefer,refer,ny + 1)) - -- y has no term of degree n - explicitEntries? x => - xCoef := getCoef(xTerm := frst x); nx := getExpon xTerm - -- can't have elt(yRefer) = infty unless all terms have been computed - (degr := retract(elt yRefer)@I) < nx => - setelt(refer,elt yRefer) - iPlus1(op,x,xRefer,y,yRefer,refer,degr + 1) - setelt(refer,nx :: COM) - concat(makeTerm(nx,op(xCoef,0)),_ - iPlus1(op,rst x,xRefer,y,yRefer,refer,nx + 1)) - -- x has no term of degree n - explicitEntries? y => - yCoef := getCoef(yTerm := frst y); ny := getExpon yTerm - -- can't have elt(xRefer) = infty unless all terms have been computed - (degr := retract(elt xRefer)@I) < ny => - setelt(refer,elt xRefer) - iPlus1(op,x,xRefer,y,yRefer,refer,degr + 1) - setelt(refer,ny :: COM) - concat(makeTerm(ny,op(0,yCoef)),_ - iPlus1(op,x,xRefer,rst y,yRefer,refer,ny + 1)) - -- neither x nor y has a term of degree n - setelt(refer,xyRef := min(elt xRefer,elt yRefer)) - -- can't have xyRef = infty unless all terms have been computed - iPlus1(op,x,xRefer,y,yRefer,refer,retract(xyRef)@I + 1) - - iPlus2(op,ups1,ups2) == - xRefer := getRef ups1; x := getStream ups1 - xDeg := - explicitlyEmpty? x => return map(op(0$Coef,#1),ups2) - explicitEntries? x => (getExpon frst x) - 1 - -- can't have elt(xRefer) = infty unless all terms have been computed - retract(elt xRefer)@I - yRefer := getRef ups2; y := getStream ups2 - yDeg := - explicitlyEmpty? y => return map(op(#1,0$Coef),ups1) - explicitEntries? y => (getExpon frst y) - 1 - -- can't have elt(yRefer) = infty unless all terms have been computed - retract(elt yRefer)@I - deg := min(xDeg,yDeg); refer := ref(deg :: COM) - makeSeries(refer,iPlus1(op,x,xRefer,y,yRefer,refer,deg + 1)) - - x + y == iPlus2(#1 + #2,x,y) - x - y == iPlus2(#1 - #2,x,y) - - y == iMap2(_-#1,#1,false,y) - - -- gives correct defaults for I, NNI and PI - n:I * x:% == (zero? n => 0; map(n * #1,x)) - n:NNI * x:% == (zero? n => 0; map(n * #1,x)) - n:PI * x:% == (zero? n => 0; map(n * #1,x)) - - productByTerm(coef,expon,x,xRefer,refer,n) == - iMap1(coef * #1,#1 + expon,true,x,xRefer,refer,n) - - productLazyEval(x,xRefer,y,yRefer,nn) == - explicitlyEmpty?(x) or explicitlyEmpty?(y) => void() - explicitEntries? x => - explicitEntries? y => void() - xDeg := (getExpon frst x) :: COM - while (xDeg + elt(yRefer)) < nn repeat lazyEvaluate y - void() - explicitEntries? y => - yDeg := (getExpon frst y) :: COM - while (yDeg + elt(xRefer)) < nn repeat lazyEvaluate x - void() - lazyEvaluate x - -- if x = y, then y may now have explicit entries - if lazy? y then lazyEvaluate y - productLazyEval(x,xRefer,y,yRefer,nn) - - iTimes(x,xRefer,y,yRefer,refer,n) == delay - -- when this function is called, we are computing the nth order - -- coefficient of the product - productLazyEval(x,xRefer,y,yRefer,n :: COM) - explicitlyEmpty?(x) or explicitlyEmpty?(y) => - (setelt(refer,plusInfinity()); empty()) - -- must have nx + ny >= n - explicitEntries?(x) and explicitEntries?(y) => - xCoef := getCoef(xTerm := frst x); xExpon := getExpon xTerm - yCoef := getCoef(yTerm := frst y); yExpon := getExpon yTerm - expon := xExpon + yExpon - setelt(refer,expon :: COM) - scRefer := ref(expon :: COM) - scMult := productByTerm(xCoef,xExpon,rst y,yRefer,scRefer,yExpon + 1) - prRefer := ref(expon :: COM) - pr := iTimes(rst x,xRefer,y,yRefer,prRefer,expon + 1) - sm := iPlus1(#1 + #2,scMult,scRefer,pr,prRefer,refer,expon + 1) - zero?(coef := xCoef * yCoef) => sm - concat(makeTerm(expon,coef),sm) - explicitEntries? x => - xExpon := getExpon frst x - -- can't have elt(yRefer) = infty unless all terms have been computed - degr := retract(elt yRefer)@I - setelt(refer,(xExpon + degr) :: COM) - iTimes(x,xRefer,y,yRefer,refer,xExpon + degr + 1) - explicitEntries? y => - yExpon := getExpon frst y - -- can't have elt(xRefer) = infty unless all terms have been computed - degr := retract(elt xRefer)@I - setelt(refer,(yExpon + degr) :: COM) - iTimes(x,xRefer,y,yRefer,refer,yExpon + degr + 1) - -- can't have elt(xRefer) = infty unless all terms have been computed - xDegr := retract(elt xRefer)@I - yDegr := retract(elt yRefer)@I - setelt(refer,(xDegr + yDegr) :: COM) - iTimes(x,xRefer,y,yRefer,refer,xDegr + yDegr + 1) - - ups1:% * ups2:% == - xRefer := getRef ups1; x := getStream ups1 - xDeg := - explicitlyEmpty? x => return 0 - explicitEntries? x => (getExpon frst x) - 1 - -- can't have elt(xRefer) = infty unless all terms have been computed - retract(elt xRefer)@I - yRefer := getRef ups2; y := getStream ups2 - yDeg := - explicitlyEmpty? y => return 0 - explicitEntries? y => (getExpon frst y) - 1 - -- can't have elt(yRefer) = infty unless all terms have been computed - retract(elt yRefer)@I - deg := xDeg + yDeg + 1; refer := ref(deg :: COM) - makeSeries(refer,iTimes(x,xRefer,y,yRefer,refer,deg + 1)) - - iDivide(x,xRefer,y,yRefer,rym,m,refer,n) == delay - -- when this function is called, we are computing the nth order - -- coefficient of the result - explicitlyEmpty? x => (setelt(refer,plusInfinity()); empty()) - -- if terms up to order n - m have not been computed, - -- apply lazy evaluation - nm := (n + m) :: COM - while (elt xRefer) < nm repeat lazyEvaluate x - -- 'x' may now be empty: retest - explicitlyEmpty? x => (setelt(refer,plusInfinity()); empty()) - -- must have nx >= n + m - explicitEntries? x => - newCoef := getCoef(xTerm := frst x) * rym; nx := getExpon xTerm - prodRefer := ref(nx :: COM) - prod := productByTerm(-newCoef,nx - m,rst y,yRefer,prodRefer,1) - sumRefer := ref(nx :: COM) - sum := iPlus1(#1 + #2,rst x,xRefer,prod,prodRefer,sumRefer,nx + 1) - setelt(refer,(nx - m) :: COM); term := makeTerm(nx - m,newCoef) - concat(term,iDivide(sum,sumRefer,y,yRefer,rym,m,refer,nx - m + 1)) - -- can't have elt(xRefer) = infty unless all terms have been computed - degr := retract(elt xRefer)@I - setelt(refer,(degr - m) :: COM) - iDivide(x,xRefer,y,yRefer,rym,m,refer,degr - m + 1) - - divide(ups1,deg1,ups2,deg2,r) == - xRefer := getRef ups1; x := getStream ups1 - yRefer := getRef ups2; y := getStream ups2 - refer := ref((deg1 - deg2) :: COM) - makeSeries(refer,iDivide(x,xRefer,y,yRefer,r,deg2,refer,deg1 - deg2 + 1)) - - iExquo(ups1,ups2,taylor?) == - xRefer := getRef ups1; x := getStream ups1 - yRefer := getRef ups2; y := getStream ups2 - n : I := 0 - -- try to find first non-zero term in y - -- give up after 1000 lazy evaluations - while not explicitEntries? y repeat - explicitlyEmpty? y => return "failed" - lazyEvaluate y - (n := n + 1) > 1000 => return "failed" - yCoef := getCoef(yTerm := frst y); ny := getExpon yTerm - (ry := recip yCoef) case "failed" => "failed" - nn := ny :: COM - if taylor? then - while (elt(xRefer) < nn) repeat - explicitlyEmpty? x => return 0 - explicitEntries? x => return "failed" - lazyEvaluate x - -- check if ups2 is a monomial - empty? rst y => iMap2(#1 * (ry :: Coef),#1 - ny,false,ups1) - explicitlyEmpty? x => 0 - nx := - explicitEntries? x => - ((deg := getExpon frst x) < ny) and taylor? => return "failed" - deg - 1 - -- can't have elt(xRefer) = infty unless all terms have been computed - retract(elt xRefer)@I - divide(ups1,nx,ups2,ny,ry :: Coef) - - taylorQuoByVar ups == - iMap2(#1,#1 - 1,false,ups - monomial(coefficient(ups,0),0)) - - compose0(x,xRefer,y,yRefer,yOrd,y1,yn0,n0,refer,n) == delay - -- when this function is called, we are computing the nth order - -- coefficient of the composite - explicitlyEmpty? x => (setelt(refer,plusInfinity()); empty()) - -- if terms in 'x' up to order n have not been computed, - -- apply lazy evaluation - nn := n :: COM; yyOrd := yOrd :: COM - while (yyOrd * elt(xRefer)) < nn repeat lazyEvaluate x - explicitEntries? x => - xCoef := getCoef(xTerm := frst x); n1 := getExpon xTerm - zero? n1 => - setelt(refer,n1 :: COM) - concat(makeTerm(n1,xCoef),_ - compose0(rst x,xRefer,y,yRefer,yOrd,y1,yn0,n0,refer,n1 + 1)) - yn1 := yn0 * y1 ** ((n1 - n0) :: NNI) - z := getStream yn1; zRefer := getRef yn1 - degr := yOrd * n1; prodRefer := ref((degr - 1) :: COM) - prod := iMap1(xCoef * #1,#1,true,z,zRefer,prodRefer,degr) - coRefer := ref((degr + yOrd - 1) :: COM) - co := compose0(rst x,xRefer,y,yRefer,yOrd,y1,yn1,n1,coRefer,degr + yOrd) - setelt(refer,(degr - 1) :: COM) - iPlus1(#1 + #2,prod,prodRefer,co,coRefer,refer,degr) - -- can't have elt(xRefer) = infty unless all terms have been computed - degr := yOrd * (retract(elt xRefer)@I + 1) - setelt(refer,(degr - 1) :: COM) - compose0(x,xRefer,y,yRefer,yOrd,y1,yn0,n0,refer,degr) - - iCompose(ups1,ups2) == - x := getStream ups1; xRefer := getRef ups1 - y := getStream ups2; yRefer := getRef ups2 - -- try to compute the order of 'ups2' - n : I := _$streamCount$Lisp - for i in 1..n while not explicitEntries? y repeat - explicitlyEmpty? y => coefficient(ups1,0) :: % - lazyEvaluate y - explicitlyEmpty? y => coefficient(ups1,0) :: % - yOrd : I := - explicitEntries? y => getExpon frst y - retract(elt yRefer)@I - compRefer := ref((-1) :: COM) - makeSeries(compRefer,_ - compose0(x,xRefer,y,yRefer,yOrd,ups2,1,0,compRefer,0)) - - if Coef has Algebra Fraction Integer then - - integrate x == iMap2(1/(#2 + 1) * #1,#1 + 1,true,x) - ---% Fixed point computations - - Ys ==> Y$ParadoxicalCombinatorsForStreams(Term) - - integ0: (ST,REF,REF,I) -> ST - integ0(x,intRef,ansRef,n) == delay - nLess1 := (n - 1) :: COM - while (elt intRef) < nLess1 repeat lazyEvaluate x - explicitlyEmpty? x => (setelt(ansRef,plusInfinity()); empty()) - explicitEntries? x => - xCoef := getCoef(xTerm := frst x); nx := getExpon xTerm - setelt(ansRef,(n1 := (nx + 1)) :: COM) - concat(makeTerm(n1,inv(n1 :: RN) * xCoef),_ - integ0(rst x,intRef,ansRef,n1)) - -- can't have elt(intRef) = infty unless all terms have been computed - degr := retract(elt intRef)@I; setelt(ansRef,(degr + 1) :: COM) - integ0(x,intRef,ansRef,degr + 2) - - integ1: (ST,REF,REF) -> ST - integ1(x,intRef,ansRef) == integ0(x,intRef,ansRef,1) - - lazyInteg: (Coef,() -> ST,REF,REF) -> ST - lazyInteg(a,xf,intRef,ansRef) == - ansStr : ST := integ1(delay xf,intRef,ansRef) - concat(makeTerm(0,a),ansStr) - - cPower(f,r) == - -- computes f^r. f should have constant coefficient 1. - fp := differentiate f - fInv := iExquo(1,f,false) :: %; y := r * fp * fInv - yRef := getRef y; yStr := getStream y - intRef := ref((-1) :: COM); ansRef := ref(0 :: COM) - ansStr := Ys lazyInteg(1,iTimes(#1,ansRef,yStr,yRef,intRef,0),_ - intRef,ansRef) - makeSeries(ansRef,ansStr) - - iExp: (%,Coef) -> % - iExp(f,cc) == - -- computes exp(f). cc = exp coefficient(f,0) - fp := differentiate f - fpRef := getRef fp; fpStr := getStream fp - intRef := ref((-1) :: COM); ansRef := ref(0 :: COM) - ansStr := Ys lazyInteg(cc,iTimes(#1,ansRef,fpStr,fpRef,intRef,0),_ - intRef,ansRef) - makeSeries(ansRef,ansStr) - - sincos0: (Coef,Coef,L ST,REF,REF,ST,REF,ST,REF) -> L ST - sincos0(sinc,cosc,list,sinRef,cosRef,fpStr,fpRef,fpStr2,fpRef2) == - sinStr := first list; cosStr := second list - prodRef1 := ref((-1) :: COM); prodRef2 := ref((-1) :: COM) - prodStr1 := iTimes(cosStr,cosRef,fpStr,fpRef,prodRef1,0) - prodStr2 := iTimes(sinStr,sinRef,fpStr2,fpRef2,prodRef2,0) - [lazyInteg(sinc,prodStr1,prodRef1,sinRef),_ - lazyInteg(cosc,prodStr2,prodRef2,cosRef)] - - iSincos: (%,Coef,Coef,I) -> Record(%sin: %, %cos: %) - iSincos(f,sinc,cosc,sign) == - fp := differentiate f - fpRef := getRef fp; fpStr := getStream fp --- fp2 := (one? sign => fp; -fp) - fp2 := ((sign = 1) => fp; -fp) - fpRef2 := getRef fp2; fpStr2 := getStream fp2 - sinRef := ref(0 :: COM); cosRef := ref(0 :: COM) - sincos := - Ys(sincos0(sinc,cosc,#1,sinRef,cosRef,fpStr,fpRef,fpStr2,fpRef2),2) - sinStr := (zero? sinc => rst first sincos; first sincos) - cosStr := (zero? cosc => rst second sincos; second sincos) - [makeSeries(sinRef,sinStr),makeSeries(cosRef,cosStr)] - - tan0: (Coef,ST,REF,ST,REF,I) -> ST - tan0(cc,ansStr,ansRef,fpStr,fpRef,sign) == - sqRef := ref((-1) :: COM) - sqStr := iTimes(ansStr,ansRef,ansStr,ansRef,sqRef,0) - one : % := 1; oneStr := getStream one; oneRef := getRef one - yRef := ref((-1) :: COM) - yStr : ST := --- one? sign => iPlus1(#1 + #2,oneStr,oneRef,sqStr,sqRef,yRef,0) - (sign = 1) => iPlus1(#1 + #2,oneStr,oneRef,sqStr,sqRef,yRef,0) - iPlus1(#1 - #2,oneStr,oneRef,sqStr,sqRef,yRef,0) - intRef := ref((-1) :: COM) - lazyInteg(cc,iTimes(yStr,yRef,fpStr,fpRef,intRef,0),intRef,ansRef) - - iTan: (%,%,Coef,I) -> % - iTan(f,fp,cc,sign) == - -- computes the tangent (and related functions) of f. - fpRef := getRef fp; fpStr := getStream fp - ansRef := ref(0 :: COM) - ansStr := Ys tan0(cc,#1,ansRef,fpStr,fpRef,sign) - zero? cc => makeSeries(ansRef,rst ansStr) - makeSeries(ansRef,ansStr) - ---% Error Reporting - - TRCONST : SG := "series expansion involves transcendental constants" - NPOWERS : SG := "series expansion has terms of negative degree" - FPOWERS : SG := "series expansion has terms of fractional degree" - MAYFPOW : SG := "series expansion may have terms of fractional degree" - LOGS : SG := "series expansion has logarithmic term" - NPOWLOG : SG := - "series expansion has terms of negative degree or logarithmic term" - NOTINV : SG := "leading coefficient not invertible" - ---% Rational powers and transcendental functions - - orderOrFailed : % -> Union(I,"failed") - orderOrFailed uts == - -- returns the order of x or "failed" - -- if -1 is returned, the series is identically zero - x := getStream uts - for n in 0..1000 repeat - explicitlyEmpty? x => return -1 - explicitEntries? x => return getExpon frst x - lazyEvaluate x - "failed" - - RATPOWERS : Boolean := Coef has "**": (Coef,RN) -> Coef - TRANSFCN : Boolean := Coef has TranscendentalFunctionCategory - - cRationalPower(uts,r) == - (ord0 := orderOrFailed uts) case "failed" => - error "**: series with many leading zero coefficients" - order := ord0 :: I - (n := order exquo denom(r)) case "failed" => - error "**: rational power does not exist" - cc := coefficient(uts,order) - (ccInv := recip cc) case "failed" => error concat("**: ",NOTINV) - ccPow := --- one? cc => cc - (cc = 1) => cc --- one? denom r => - (denom r) = 1 => - not negative?(num := numer r) => cc ** (num :: NNI) - (ccInv :: Coef) ** ((-num) :: NNI) - RATPOWERS => cc ** r - error "** rational power of coefficient undefined" - uts1 := (ccInv :: Coef) * uts - uts2 := uts1 * monomial(1,-order) - monomial(ccPow,(n :: I) * numer(r)) * cPower(uts2,r :: Coef) - - cExp uts == - zero?(cc := coefficient(uts,0)) => iExp(uts,1) - TRANSFCN => iExp(uts,exp cc) - error concat("exp: ",TRCONST) - - cLog uts == - zero?(cc := coefficient(uts,0)) => - error "log: constant coefficient should not be 0" --- one? cc => integrate(differentiate(uts) * (iExquo(1,uts,true) :: %)) - (cc = 1) => integrate(differentiate(uts) * (iExquo(1,uts,true) :: %)) - TRANSFCN => - y := iExquo(1,uts,true) :: % - (log(cc) :: %) + integrate(y * differentiate(uts)) - error concat("log: ",TRCONST) - - sincos: % -> Record(%sin: %, %cos: %) - sincos uts == - zero?(cc := coefficient(uts,0)) => iSincos(uts,0,1,-1) - TRANSFCN => iSincos(uts,sin cc,cos cc,-1) - error concat("sincos: ",TRCONST) - - cSin uts == sincos(uts).%sin - cCos uts == sincos(uts).%cos - - cTan uts == - zero?(cc := coefficient(uts,0)) => iTan(uts,differentiate uts,0,1) - TRANSFCN => iTan(uts,differentiate uts,tan cc,1) - error concat("tan: ",TRCONST) - - cCot uts == - zero? uts => error "cot: cot(0) is undefined" - zero?(cc := coefficient(uts,0)) => error error concat("cot: ",NPOWERS) - TRANSFCN => iTan(uts,-differentiate uts,cot cc,1) - error concat("cot: ",TRCONST) - - cSec uts == - zero?(cc := coefficient(uts,0)) => iExquo(1,cCos uts,true) :: % - TRANSFCN => - cosUts := cCos uts - zero? coefficient(cosUts,0) => error concat("sec: ",NPOWERS) - iExquo(1,cosUts,true) :: % - error concat("sec: ",TRCONST) - - cCsc uts == - zero? uts => error "csc: csc(0) is undefined" - TRANSFCN => - sinUts := cSin uts - zero? coefficient(sinUts,0) => error concat("csc: ",NPOWERS) - iExquo(1,sinUts,true) :: % - error concat("csc: ",TRCONST) - - cAsin uts == - zero?(cc := coefficient(uts,0)) => - integrate(cRationalPower(1 - uts*uts,-1/2) * differentiate(uts)) - TRANSFCN => - x := 1 - uts * uts - cc = 1 or cc = -1 => - -- compute order of 'x' - (ord := orderOrFailed x) case "failed" => - error concat("asin: ",MAYFPOW) - (order := ord :: I) = -1 => return asin(cc) :: % - odd? order => error concat("asin: ",FPOWERS) - c0 := asin(cc) :: % - c0 + integrate(cRationalPower(x,-1/2) * differentiate(uts)) - c0 := asin(cc) :: % - c0 + integrate(cRationalPower(x,-1/2) * differentiate(uts)) - error concat("asin: ",TRCONST) - - cAcos uts == - zero? uts => - TRANSFCN => acos(0)$Coef :: % - error concat("acos: ",TRCONST) - TRANSFCN => - x := 1 - uts * uts - cc := coefficient(uts,0) - cc = 1 or cc = -1 => - -- compute order of 'x' - (ord := orderOrFailed x) case "failed" => - error concat("acos: ",MAYFPOW) - (order := ord :: I) = -1 => return acos(cc) :: % - odd? order => error concat("acos: ",FPOWERS) - c0 := acos(cc) :: % - c0 + integrate(-cRationalPower(x,-1/2) * differentiate(uts)) - c0 := acos(cc) :: % - c0 + integrate(-cRationalPower(x,-1/2) * differentiate(uts)) - error concat("acos: ",TRCONST) - - cAtan uts == - zero?(cc := coefficient(uts,0)) => - y := iExquo(1,(1 :: %) + uts*uts,true) :: % - integrate(y * (differentiate uts)) - TRANSFCN => - (y := iExquo(1,(1 :: %) + uts*uts,true)) case "failed" => - error concat("atan: ",LOGS) - (atan(cc) :: %) + integrate((y :: %) * (differentiate uts)) - error concat("atan: ",TRCONST) - - cAcot uts == - TRANSFCN => - (y := iExquo(1,(1 :: %) + uts*uts,true)) case "failed" => - error concat("acot: ",LOGS) - cc := coefficient(uts,0) - (acot(cc) :: %) + integrate(-(y :: %) * (differentiate uts)) - error concat("acot: ",TRCONST) - - cAsec uts == - zero?(cc := coefficient(uts,0)) => - error "asec: constant coefficient should not be 0" - TRANSFCN => - x := uts * uts - 1 - y := - cc = 1 or cc = -1 => - -- compute order of 'x' - (ord := orderOrFailed x) case "failed" => - error concat("asec: ",MAYFPOW) - (order := ord :: I) = -1 => return asec(cc) :: % - odd? order => error concat("asec: ",FPOWERS) - cRationalPower(x,-1/2) * differentiate(uts) - cRationalPower(x,-1/2) * differentiate(uts) - (z := iExquo(y,uts,true)) case "failed" => - error concat("asec: ",NOTINV) - (asec(cc) :: %) + integrate(z :: %) - error concat("asec: ",TRCONST) - - cAcsc uts == - zero?(cc := coefficient(uts,0)) => - error "acsc: constant coefficient should not be 0" - TRANSFCN => - x := uts * uts - 1 - y := - cc = 1 or cc = -1 => - -- compute order of 'x' - (ord := orderOrFailed x) case "failed" => - error concat("acsc: ",MAYFPOW) - (order := ord :: I) = -1 => return acsc(cc) :: % - odd? order => error concat("acsc: ",FPOWERS) - -cRationalPower(x,-1/2) * differentiate(uts) - -cRationalPower(x,-1/2) * differentiate(uts) - (z := iExquo(y,uts,true)) case "failed" => - error concat("asec: ",NOTINV) - (acsc(cc) :: %) + integrate(z :: %) - error concat("acsc: ",TRCONST) - - sinhcosh: % -> Record(%sinh: %, %cosh: %) - sinhcosh uts == - zero?(cc := coefficient(uts,0)) => - tmp := iSincos(uts,0,1,1) - [tmp.%sin,tmp.%cos] - TRANSFCN => - tmp := iSincos(uts,sinh cc,cosh cc,1) - [tmp.%sin,tmp.%cos] - error concat("sinhcosh: ",TRCONST) - - cSinh uts == sinhcosh(uts).%sinh - cCosh uts == sinhcosh(uts).%cosh - - cTanh uts == - zero?(cc := coefficient(uts,0)) => iTan(uts,differentiate uts,0,-1) - TRANSFCN => iTan(uts,differentiate uts,tanh cc,-1) - error concat("tanh: ",TRCONST) - - cCoth uts == - tanhUts := cTanh uts - zero? tanhUts => error "coth: coth(0) is undefined" - zero? coefficient(tanhUts,0) => error concat("coth: ",NPOWERS) - iExquo(1,tanhUts,true) :: % - - cSech uts == - coshUts := cCosh uts - zero? coefficient(coshUts,0) => error concat("sech: ",NPOWERS) - iExquo(1,coshUts,true) :: % - - cCsch uts == - sinhUts := cSinh uts - zero? coefficient(sinhUts,0) => error concat("csch: ",NPOWERS) - iExquo(1,sinhUts,true) :: % - - cAsinh uts == - x := 1 + uts * uts - zero?(cc := coefficient(uts,0)) => cLog(uts + cRationalPower(x,1/2)) - TRANSFCN => - (ord := orderOrFailed x) case "failed" => - error concat("asinh: ",MAYFPOW) - (order := ord :: I) = -1 => return asinh(cc) :: % - odd? order => error concat("asinh: ",FPOWERS) - -- the argument to 'log' must have a non-zero constant term - cLog(uts + cRationalPower(x,1/2)) - error concat("asinh: ",TRCONST) - - cAcosh uts == - zero? uts => - TRANSFCN => acosh(0)$Coef :: % - error concat("acosh: ",TRCONST) - TRANSFCN => - cc := coefficient(uts,0); x := uts*uts - 1 - cc = 1 or cc = -1 => - -- compute order of 'x' - (ord := orderOrFailed x) case "failed" => - error concat("acosh: ",MAYFPOW) - (order := ord :: I) = -1 => return acosh(cc) :: % - odd? order => error concat("acosh: ",FPOWERS) - -- the argument to 'log' must have a non-zero constant term - cLog(uts + cRationalPower(x,1/2)) - cLog(uts + cRationalPower(x,1/2)) - error concat("acosh: ",TRCONST) - - cAtanh uts == - half := inv(2 :: RN) :: Coef - zero?(cc := coefficient(uts,0)) => - half * (cLog(1 + uts) - cLog(1 - uts)) - TRANSFCN => - cc = 1 or cc = -1 => error concat("atanh: ",LOGS) - half * (cLog(1 + uts) - cLog(1 - uts)) - error concat("atanh: ",TRCONST) - - cAcoth uts == - zero? uts => - TRANSFCN => acoth(0)$Coef :: % - error concat("acoth: ",TRCONST) - TRANSFCN => - cc := coefficient(uts,0); half := inv(2 :: RN) :: Coef - cc = 1 or cc = -1 => error concat("acoth: ",LOGS) - half * (cLog(uts + 1) - cLog(uts - 1)) - error concat("acoth: ",TRCONST) - - cAsech uts == - zero? uts => error "asech: asech(0) is undefined" - TRANSFCN => - zero?(cc := coefficient(uts,0)) => - error concat("asech: ",NPOWLOG) - x := 1 - uts * uts - cc = 1 or cc = -1 => - -- compute order of 'x' - (ord := orderOrFailed x) case "failed" => - error concat("asech: ",MAYFPOW) - (order := ord :: I) = -1 => return asech(cc) :: % - odd? order => error concat("asech: ",FPOWERS) - (utsInv := iExquo(1,uts,true)) case "failed" => - error concat("asech: ",NOTINV) - cLog((1 + cRationalPower(x,1/2)) * (utsInv :: %)) - (utsInv := iExquo(1,uts,true)) case "failed" => - error concat("asech: ",NOTINV) - cLog((1 + cRationalPower(x,1/2)) * (utsInv :: %)) - error concat("asech: ",TRCONST) - - cAcsch uts == - zero? uts => error "acsch: acsch(0) is undefined" - TRANSFCN => - zero?(cc := coefficient(uts,0)) => error concat("acsch: ",NPOWLOG) - x := uts * uts + 1 - -- compute order of 'x' - (ord := orderOrFailed x) case "failed" => - error concat("acsc: ",MAYFPOW) - (order := ord :: I) = -1 => return acsch(cc) :: % - odd? order => error concat("acsch: ",FPOWERS) - (utsInv := iExquo(1,uts,true)) case "failed" => - error concat("acsch: ",NOTINV) - cLog((1 + cRationalPower(x,1/2)) * (utsInv :: %)) - error concat("acsch: ",TRCONST) - ---% Output forms - - -- check a global Lisp variable - factorials?() == false - - termOutput(k,c,vv) == - -- creates a term c * vv ** k - k = 0 => c :: OUT - mon := (k = 1 => vv; vv ** (k :: OUT)) --- if factorials?() and k > 1 then --- c := factorial(k)$IntegerCombinatoricFunctions * c --- mon := mon / hconcat(k :: OUT,"!" :: OUT) - c = 1 => mon - c = -1 => -mon - (c :: OUT) * mon - - -- check a global Lisp variable - showAll?() == true - - seriesToOutputForm(st,refer,var,cen,r) == - vv := - zero? cen => var :: OUT - paren(var :: OUT - cen :: OUT) - l : L OUT := empty() - while explicitEntries? st repeat - term := frst st - l := concat(termOutput(getExpon(term) * r,getCoef term,vv),l) - st := rst st - l := - explicitlyEmpty? st => l - (deg := retractIfCan(elt refer)@Union(I,"failed")) case I => - concat(prefix("O" :: OUT,[vv ** ((((deg :: I) + 1) * r) :: OUT)]),l) - l - empty? l => (0$Coef) :: OUT - reduce("+",reverse_! l) - -@ -\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/supxs.spad.pamphlet b/src/algebra/supxs.spad.pamphlet deleted file mode 100644 index 311d6cd..0000000 --- a/src/algebra/supxs.spad.pamphlet +++ /dev/null @@ -1,142 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra supxs.spad} -\author{Clifton J. Williamson} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{domain SUPXS SparseUnivariatePuiseuxSeries} -<>= -)abbrev domain SUPXS SparseUnivariatePuiseuxSeries -++ Author: Clifton J. Williamson -++ Date Created: 11 November 1994 -++ Date Last Updated: 28 February 1995 -++ Basic Operations: -++ Related Domains: InnerSparseUnivariatePowerSeries, -++ SparseUnivariateTaylorSeries, SparseUnivariateLaurentSeries -++ Also See: -++ AMS Classifications: -++ Keywords: sparse, series -++ Examples: -++ References: -++ Description: Sparse Puiseux series in one variable -++ \spadtype{SparseUnivariatePuiseuxSeries} is a domain representing Puiseux -++ series in one variable with coefficients in an arbitrary ring. The -++ parameters of the type specify the coefficient ring, the power series -++ variable, and the center of the power series expansion. For example, -++ \spad{SparseUnivariatePuiseuxSeries(Integer,x,3)} represents Puiseux -++ series in \spad{(x - 3)} with \spadtype{Integer} coefficients. -SparseUnivariatePuiseuxSeries(Coef,var,cen): Exports == Implementation where - Coef : Ring - var : Symbol - cen : Coef - I ==> Integer - NNI ==> NonNegativeInteger - OUT ==> OutputForm - RN ==> Fraction Integer - SUTS ==> SparseUnivariateTaylorSeries(Coef,var,cen) - SULS ==> SparseUnivariateLaurentSeries(Coef,var,cen) - SUPS ==> InnerSparseUnivariatePowerSeries(Coef) - - Exports ==> Join(UnivariatePuiseuxSeriesConstructorCategory(Coef,SULS),_ - RetractableTo SUTS) with - coerce: Variable(var) -> % - ++ coerce(var) converts the series variable \spad{var} into a - ++ Puiseux series. - differentiate: (%,Variable(var)) -> % - ++ \spad{differentiate(f(x),x)} returns the derivative of - ++ \spad{f(x)} with respect to \spad{x}. - if Coef has Algebra Fraction Integer then - integrate: (%,Variable(var)) -> % - ++ \spad{integrate(f(x))} returns an anti-derivative of the power - ++ series \spad{f(x)} with constant coefficient 0. - ++ We may integrate a series when we can divide coefficients - ++ by integers. - - Implementation ==> UnivariatePuiseuxSeriesConstructor(Coef,SULS) add - - Rep := Record(expon:RN,lSeries:SULS) - - getExpon: % -> RN - getExpon pxs == pxs.expon - - variable x == var - center x == cen - - coerce(v: Variable(var)) == - zero? cen => monomial(1,1) - monomial(1,1) + monomial(cen,0) - - coerce(uts:SUTS) == uts :: SULS :: % - - retractIfCan(upxs:%):Union(SUTS,"failed") == - (uls := retractIfCan(upxs)@Union(SULS,"failed")) case "failed" => - "failed" - retractIfCan(uls :: SULS)@Union(SUTS,"failed") - - if Coef has "*": (Fraction Integer, Coef) -> Coef then - differentiate(upxs:%,v:Variable(var)) == differentiate upxs - - if Coef has Algebra Fraction Integer then - integrate(upxs:%,v:Variable(var)) == integrate upxs - ---% OutputForms - - coerce(x:%): OUT == - sups : SUPS := laurentRep(x) pretend SUPS - st := getStream sups; refer := getRef sups - if not(explicitlyEmpty? st or explicitEntries? st) _ - and (nx := retractIfCan(elt refer)@Union(I,"failed")) case I then - count : NNI := _$streamCount$Lisp - degr := min(count,(nx :: I) + count + 1) - extend(sups,degr) - seriesToOutputForm(st,refer,variable x,center x,rationalPower x) - -@ -\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/suts.spad.pamphlet b/src/algebra/suts.spad.pamphlet deleted file mode 100644 index 131d99b..0000000 --- a/src/algebra/suts.spad.pamphlet +++ /dev/null @@ -1,439 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra suts.spad} -\author{Clifton J. Williamson} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{domain SUTS SparseUnivariateTaylorSeries} -<>= -)abbrev domain SUTS SparseUnivariateTaylorSeries -++ Author: Clifton J. Williamson -++ Date Created: 16 February 1990 -++ Date Last Updated: 10 March 1995 -++ Basic Operations: -++ Related Domains: InnerSparseUnivariatePowerSeries, -++ SparseUnivariateLaurentSeries, SparseUnivariatePuiseuxSeries -++ Also See: -++ AMS Classifications: -++ Keywords: Taylor series, sparse power series -++ Examples: -++ References: -++ Description: Sparse Taylor series in one variable -++ \spadtype{SparseUnivariateTaylorSeries} is a domain representing Taylor -++ series in one variable with coefficients in an arbitrary ring. The -++ parameters of the type specify the coefficient ring, the power series -++ variable, and the center of the power series expansion. For example, -++ \spadtype{SparseUnivariateTaylorSeries}(Integer,x,3) represents Taylor -++ series in \spad{(x - 3)} with \spadtype{Integer} coefficients. -SparseUnivariateTaylorSeries(Coef,var,cen): Exports == Implementation where - Coef : Ring - var : Symbol - cen : Coef - COM ==> OrderedCompletion Integer - I ==> Integer - L ==> List - NNI ==> NonNegativeInteger - OUT ==> OutputForm - P ==> Polynomial Coef - REF ==> Reference OrderedCompletion Integer - RN ==> Fraction Integer - Term ==> Record(k:Integer,c:Coef) - SG ==> String - ST ==> Stream Term - UP ==> UnivariatePolynomial(var,Coef) - - Exports ==> UnivariateTaylorSeriesCategory(Coef) with - coerce: UP -> % - ++\spad{coerce(p)} converts a univariate polynomial p in the variable - ++\spad{var} to a univariate Taylor series in \spad{var}. - univariatePolynomial: (%,NNI) -> UP - ++\spad{univariatePolynomial(f,k)} returns a univariate polynomial - ++ consisting of the sum of all terms of f of degree \spad{<= k}. - coerce: Variable(var) -> % - ++\spad{coerce(var)} converts the series variable \spad{var} into a - ++ Taylor series. - differentiate: (%,Variable(var)) -> % - ++ \spad{differentiate(f(x),x)} computes the derivative of - ++ \spad{f(x)} with respect to \spad{x}. - if Coef has Algebra Fraction Integer then - integrate: (%,Variable(var)) -> % - ++ \spad{integrate(f(x),x)} returns an anti-derivative of the power - ++ series \spad{f(x)} with constant coefficient 0. - ++ We may integrate a series when we can divide coefficients - ++ by integers. - - Implementation ==> InnerSparseUnivariatePowerSeries(Coef) add - import REF - - Rep := InnerSparseUnivariatePowerSeries(Coef) - - makeTerm: (Integer,Coef) -> Term - makeTerm(exp,coef) == [exp,coef] - getCoef: Term -> Coef - getCoef term == term.c - getExpon: Term -> Integer - getExpon term == term.k - - monomial(coef,expon) == monomial(coef,expon)$Rep - extend(x,n) == extend(x,n)$Rep - - 0 == monomial(0,0)$Rep - 1 == monomial(1,0)$Rep - - recip uts == iExquo(1,uts,true) - - if Coef has IntegralDomain then - uts1 exquo uts2 == iExquo(uts1,uts2,true) - - quoByVar uts == taylorQuoByVar(uts)$Rep - - differentiate(x:%,v:Variable(var)) == differentiate x - ---% Creation and destruction of series - - coerce(v: Variable(var)) == - zero? cen => monomial(1,1) - monomial(1,1) + monomial(cen,0) - - coerce(p:UP) == - zero? p => 0 - if not zero? cen then p := p(monomial(1,1)$UP + monomial(cen,0)$UP) - st : ST := empty() - while not zero? p repeat - st := concat(makeTerm(degree p,leadingCoefficient p),st) - p := reductum p - makeSeries(ref plusInfinity(),st) - - univariatePolynomial(x,n) == - extend(x,n); st := getStream x - ans : UP := 0; oldDeg : I := 0; - mon := monomial(1,1)$UP - monomial(center x,0)$UP; monPow : UP := 1 - while explicitEntries? st repeat - (xExpon := getExpon(xTerm := frst st)) > n => return ans - pow := (xExpon - oldDeg) :: NNI; oldDeg := xExpon - monPow := monPow * mon ** pow - ans := ans + getCoef(xTerm) * monPow - st := rst st - ans - - polynomial(x,n) == - extend(x,n); st := getStream x - ans : P := 0; oldDeg : I := 0; - mon := (var :: P) - (center(x) :: P); monPow : P := 1 - while explicitEntries? st repeat - (xExpon := getExpon(xTerm := frst st)) > n => return ans - pow := (xExpon - oldDeg) :: NNI; oldDeg := xExpon - monPow := monPow * mon ** pow - ans := ans + getCoef(xTerm) * monPow - st := rst st - ans - - polynomial(x,n1,n2) == polynomial(truncate(x,n1,n2),n2) - - truncate(x,n) == truncate(x,n)$Rep - truncate(x,n1,n2) == truncate(x,n1,n2)$Rep - - iCoefficients: (ST,REF,I) -> Stream Coef - iCoefficients(x,refer,n) == delay - -- when this function is called, we are computing the nth order - -- coefficient of the series - explicitlyEmpty? x => empty() - -- if terms up to order n have not been computed, - -- apply lazy evaluation - nn := n :: COM - while (nx := elt refer) < nn repeat lazyEvaluate x - -- must have nx >= n - explicitEntries? x => - xCoef := getCoef(xTerm := frst x); xExpon := getExpon xTerm - xExpon = n => concat(xCoef,iCoefficients(rst x,refer,n + 1)) - -- must have nx > n - concat(0,iCoefficients(x,refer,n + 1)) - concat(0,iCoefficients(x,refer,n + 1)) - - coefficients uts == - refer := getRef uts; x := getStream uts - iCoefficients(x,refer,0) - - terms uts == terms(uts)$Rep pretend Stream Record(k:NNI,c:Coef) - - iSeries: (Stream Coef,I,REF) -> ST - iSeries(st,n,refer) == delay - -- when this function is called, we are creating the nth order - -- term of a series - empty? st => (setelt(refer,plusInfinity()); empty()) - setelt(refer,n :: COM) - zero? (coef := frst st) => iSeries(rst st,n + 1,refer) - concat(makeTerm(n,coef),iSeries(rst st,n + 1,refer)) - - series(st:Stream Coef) == - refer := ref(-1) - makeSeries(refer,iSeries(st,0,refer)) - - nniToI: Stream Record(k:NNI,c:Coef) -> ST - nniToI st == - empty? st => empty() - term : Term := [(frst st).k,(frst st).c] - concat(term,nniToI rst st) - - series(st:Stream Record(k:NNI,c:Coef)) == series(nniToI st)$Rep - ---% Values - - variable x == var - center x == cen - - coefficient(x,n) == coefficient(x,n)$Rep - elt(x:%,n:NonNegativeInteger) == coefficient(x,n) - - pole? x == false - - order x == (order(x)$Rep) :: NNI - order(x,n) == (order(x,n)$Rep) :: NNI - ---% Composition - - elt(uts1:%,uts2:%) == - zero? uts2 => coefficient(uts1,0) :: % - not zero? coefficient(uts2,0) => - error "elt: second argument must have positive order" - iCompose(uts1,uts2) - ---% Integration - - if Coef has Algebra Fraction Integer then - - integrate(x:%,v:Variable(var)) == integrate x - ---% Transcendental functions - - (uts1:%) ** (uts2:%) == exp(log(uts1) * uts2) - - if Coef has CommutativeRing then - - (uts:%) ** (r:RN) == cRationalPower(uts,r) - - exp uts == cExp uts - log uts == cLog uts - - sin uts == cSin uts - cos uts == cCos uts - tan uts == cTan uts - cot uts == cCot uts - sec uts == cSec uts - csc uts == cCsc uts - - asin uts == cAsin uts - acos uts == cAcos uts - atan uts == cAtan uts - acot uts == cAcot uts - asec uts == cAsec uts - acsc uts == cAcsc uts - - sinh uts == cSinh uts - cosh uts == cCosh uts - tanh uts == cTanh uts - coth uts == cCoth uts - sech uts == cSech uts - csch uts == cCsch uts - - asinh uts == cAsinh uts - acosh uts == cAcosh uts - atanh uts == cAtanh uts - acoth uts == cAcoth uts - asech uts == cAsech uts - acsch uts == cAcsch uts - - else - - ZERO : SG := "series must have constant coefficient zero" - ONE : SG := "series must have constant coefficient one" - NPOWERS : SG := "series expansion has terms of negative degree" - - (uts:%) ** (r:RN) == --- not one? coefficient(uts,0) => - not (coefficient(uts,0) = 1) => - error "**: constant coefficient must be one" - onePlusX : % := monomial(1,0) + monomial(1,1) - ratPow := cPower(uts,r :: Coef) - iCompose(ratPow,uts - 1) - - exp uts == - zero? coefficient(uts,0) => - expx := cExp monomial(1,1) - iCompose(expx,uts) - error concat("exp: ",ZERO) - - log uts == --- one? coefficient(uts,0) => - (coefficient(uts,0) = 1) => - log1PlusX := cLog(monomial(1,0) + monomial(1,1)) - iCompose(log1PlusX,uts - 1) - error concat("log: ",ONE) - - sin uts == - zero? coefficient(uts,0) => - sinx := cSin monomial(1,1) - iCompose(sinx,uts) - error concat("sin: ",ZERO) - - cos uts == - zero? coefficient(uts,0) => - cosx := cCos monomial(1,1) - iCompose(cosx,uts) - error concat("cos: ",ZERO) - - tan uts == - zero? coefficient(uts,0) => - tanx := cTan monomial(1,1) - iCompose(tanx,uts) - error concat("tan: ",ZERO) - - cot uts == - zero? uts => error "cot: cot(0) is undefined" - zero? coefficient(uts,0) => error concat("cot: ",NPOWERS) - error concat("cot: ",ZERO) - - sec uts == - zero? coefficient(uts,0) => - secx := cSec monomial(1,1) - iCompose(secx,uts) - error concat("sec: ",ZERO) - - csc uts == - zero? uts => error "csc: csc(0) is undefined" - zero? coefficient(uts,0) => error concat("csc: ",NPOWERS) - error concat("csc: ",ZERO) - - asin uts == - zero? coefficient(uts,0) => - asinx := cAsin monomial(1,1) - iCompose(asinx,uts) - error concat("asin: ",ZERO) - - atan uts == - zero? coefficient(uts,0) => - atanx := cAtan monomial(1,1) - iCompose(atanx,uts) - error concat("atan: ",ZERO) - - acos z == error "acos: acos undefined on this coefficient domain" - acot z == error "acot: acot undefined on this coefficient domain" - asec z == error "asec: asec undefined on this coefficient domain" - acsc z == error "acsc: acsc undefined on this coefficient domain" - - sinh uts == - zero? coefficient(uts,0) => - sinhx := cSinh monomial(1,1) - iCompose(sinhx,uts) - error concat("sinh: ",ZERO) - - cosh uts == - zero? coefficient(uts,0) => - coshx := cCosh monomial(1,1) - iCompose(coshx,uts) - error concat("cosh: ",ZERO) - - tanh uts == - zero? coefficient(uts,0) => - tanhx := cTanh monomial(1,1) - iCompose(tanhx,uts) - error concat("tanh: ",ZERO) - - coth uts == - zero? uts => error "coth: coth(0) is undefined" - zero? coefficient(uts,0) => error concat("coth: ",NPOWERS) - error concat("coth: ",ZERO) - - sech uts == - zero? coefficient(uts,0) => - sechx := cSech monomial(1,1) - iCompose(sechx,uts) - error concat("sech: ",ZERO) - - csch uts == - zero? uts => error "csch: csch(0) is undefined" - zero? coefficient(uts,0) => error concat("csch: ",NPOWERS) - error concat("csch: ",ZERO) - - asinh uts == - zero? coefficient(uts,0) => - asinhx := cAsinh monomial(1,1) - iCompose(asinhx,uts) - error concat("asinh: ",ZERO) - - atanh uts == - zero? coefficient(uts,0) => - atanhx := cAtanh monomial(1,1) - iCompose(atanhx,uts) - error concat("atanh: ",ZERO) - - acosh uts == error "acosh: acosh undefined on this coefficient domain" - acoth uts == error "acoth: acoth undefined on this coefficient domain" - asech uts == error "asech: asech undefined on this coefficient domain" - acsch uts == error "acsch: acsch undefined on this coefficient domain" - - if Coef has Field then - if Coef has Algebra Fraction Integer then - - (uts:%) ** (r:Coef) == --- not one? coefficient(uts,1) => - not (coefficient(uts,1) = 1) => - error "**: constant coefficient should be 1" - cPower(uts,r) - ---% OutputForms - - coerce(x:%): OUT == - count : NNI := _$streamCount$Lisp - extend(x,count) - seriesToOutputForm(getStream x,getRef x,variable x,center x,1) - -@ -\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/symbol.spad.pamphlet b/src/algebra/symbol.spad.pamphlet deleted file mode 100644 index 69de307..0000000 --- a/src/algebra/symbol.spad.pamphlet +++ /dev/null @@ -1,843 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra symbol.spad} -\author{Stephen M. Watt} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{domain SYMBOL Symbol} -<>= --- symbol.spad.pamphlet Symbol.input -)spool Symbol.output -)set message test on -)set message auto off -)clear all ---S 1 of 24 -X: Symbol := 'x ---R ---R ---R (1) x ---R Type: Symbol ---E 1 - ---S 2 of 24 -XX: Symbol := x ---R ---R ---R (2) x ---R Type: Symbol ---E 2 - ---S 3 of 24 -A := 'a ---R ---R ---R (3) a ---R Type: Variable a ---E 3 - ---S 4 of 24 -B := b ---R ---R ---R (4) b ---R Type: Variable b ---E 4 - ---S 5 of 24 -x**2 + 1 ---R ---R ---R 2 ---R (5) x + 1 ---R Type: Polynomial Integer ---E 5 - ---S 6 of 24 -"Hello"::Symbol ---R ---R ---R (6) Hello ---R Type: Symbol ---E 6 - ---S 7 of 24 -new()$Symbol ---R ---R ---R (7) %A ---R Type: Symbol ---E 7 - ---S 8 of 24 -new()$Symbol ---R ---R ---R (8) %B ---R Type: Symbol ---E 8 - ---S 9 of 24 -new("xyz")$Symbol ---R ---R ---R (9) %xyz0 ---R Type: Symbol ---E 9 - ---S 10 of 24 -X[i,j] ---R ---R ---R (10) x ---R i,j ---R Type: Symbol ---E 10 - ---S 11 of 24 -U := subscript(u, [1,2,1,2]) ---R ---R ---R (11) u ---R 1,2,1,2 ---R Type: Symbol ---E 11 - ---S 12 of 24 -V := superscript(v, [n]) ---R ---R ---R n ---R (12) v ---R Type: Symbol ---E 12 - ---S 13 of 24 -P := argscript(p, [t]) ---R ---R ---R (13) p(t) ---R Type: Symbol ---E 13 - ---S 14 of 24 -scripted? U ---R ---R ---R (14) true ---R Type: Boolean ---E 14 - ---S 15 of 24 -scripted? X ---R ---R ---R (15) false ---R Type: Boolean ---E 15 - ---S 16 of 24 -string X ---R ---R ---R (16) "x" ---R Type: String ---E 16 - ---S 17 of 24 -name U ---R ---R ---R (17) u ---R Type: Symbol ---E 17 - ---S 18 of 24 -scripts U ---R ---R ---R (18) [sub= [1,2,1,2],sup= [],presup= [],presub= [],args= []] ---RType: Record(sub: List OutputForm,sup: List OutputForm,presup: List OutputForm,presub: List OutputForm,args: List OutputForm) ---E 18 - ---S 19 of 24 -name X ---R ---R ---R (19) x ---R Type: Symbol ---E 19 - ---S 20 of 24 -scripts X ---R ---R ---R (20) [sub= [],sup= [],presup= [],presub= [],args= []] ---RType: Record(sub: List OutputForm,sup: List OutputForm,presup: List OutputForm,presub: List OutputForm,args: List OutputForm) ---E 20 - ---S 21 of 24 -M := script(Mammoth, [ [i,j],[k,l],[0,1],[2],[u,v,w] ]) ---R ---R ---R 0,1 k,l ---R (21) Mammoth (u,v,w) ---R 2 i,j ---R Type: Symbol ---E 21 - ---S 22 of 24 -scripts M ---R ---R ---R (22) [sub= [i,j],sup= [k,l],presup= [0,1],presub= [2],args= [u,v,w]] ---RType: Record(sub: List OutputForm,sup: List OutputForm,presup: List OutputForm,presub: List OutputForm,args: List OutputForm) ---E 22 - ---S 23 of 24 -N := script(Nut, [ [i,j],[k,l],[0,1] ]) ---R ---R ---R 0,1 k,l ---R (23) Nut ---R i,j ---R Type: Symbol ---E 23 - ---S 24 of 24 -scripts N ---R ---R ---R (24) [sub= [i,j],sup= [k,l],presup= [0,1],presub= [],args= []] ---RType: Record(sub: List OutputForm,sup: List OutputForm,presup: List OutputForm,presub: List OutputForm,args: List OutputForm) ---E 24 -)spool -)lisp (bye) -@ -<>= -==================================================================== -Symbol examples -==================================================================== - -Symbols are one of the basic types manipulated by Axiom. The -Symbol domain provides ways to create symbols of many varieties. - -The simplest way to create a symbol is to "single quote" an identifier. - - X: Symbol := 'x - x - Type: Symbol - -This gives the symbol even if x has been assigned a value. If x has -not been assigned a value, then it is possible to omit the quote. - - XX: Symbol := x - x - Type: Symbol - -Declarations must be used when working with symbols, because otherwise -the interpreter tries to place values in a more specialized type Variable. - - A := 'a - a - Type: Variable a - - B := b - b - Type: Variable b - -The normal way of entering polynomials uses this fact. - - x**2 + 1 - 2 - x + 1 - Type: Polynomial Integer - -Another convenient way to create symbols is to convert a string. -This is useful when the name is to be constructed by a program. - - "Hello"::Symbol - Hello - Type: Symbol - -Sometimes it is necessary to generate new unique symbols, for example, -to name constants of integration. The expression new() generates a -symbol starting with %. - - new()$Symbol - %A - Type: Symbol - -Successive calls to new produce different symbols. - - new()$Symbol - %B - Type: Symbol - -The expression new("s") produces a symbol starting with %s. - - new("xyz")$Symbol - %xyz0 - Type: Symbol - -A symbol can be adorned in various ways. The most basic thing is -applying a symbol to a list of subscripts. - - X[i,j] - x - i,j - Type: Symbol - -Somewhat less pretty is to attach subscripts, superscripts or arguments. - - U := subscript(u, [1,2,1,2]) - u - 1,2,1,2 - Type: Symbol - - V := superscript(v, [n]) - n - v - Type: Symbol - - P := argscript(p, [t]) - p(t) - Type: Symbol - -It is possible to test whether a symbol has scripts using the scripted? test. - - scripted? U - true - Type: Boolean - - scripted? X - false - Type: Boolean - -If a symbol is not scripted, then it may be converted to a string. - - string X - "x" - Type: String - -The basic parts can always be extracted using the name and scripts operations. - - name U - u - Type: Symbol - - scripts U - [sub= [1,2,1,2],sup= [],presup= [],presub= [],args= []] - Type: Record(sub: List OutputForm, - sup: List OutputForm, - presup: List OutputForm, - presub: List OutputForm, - args: List OutputForm) - - name X - x - Type: Symbol - - scripts X - [sub= [],sup= [],presup= [],presub= [],args= []] - Type: Record(sub: List OutputForm, - sup: List OutputForm, - presup: List OutputForm, - presub: List OutputForm, - args: List OutputForm) - -The most general form is obtained using the script operation. This -operation takes an argument which is a list containing, in this order, -lists of subscripts, superscripts, presuperscripts, presubscripts and -arguments to a symbol. - - M := script(Mammoth, [ [i,j],[k,l],[0,1],[2],[u,v,w] ]) - 0,1 k,l - Mammoth (u,v,w) - 2 i,j - Type: Symbol - - scripts M - [sub= [i,j],sup= [k,l],presup= [0,1],presub= [2],args= [u,v,w]] - Type: Record(sub: List OutputForm, - sup: List OutputForm, - presup: List OutputForm, - presub: List OutputForm, - args: List OutputForm) - -If trailing lists of scripts are omitted, they are assumed to be empty. - - N := script(Nut, [ [i,j],[k,l],[0,1] ]) - 0,1 k,l - Nut - i,j - Type: Symbol - - scripts N - [sub= [i,j],sup= [k,l],presup= [0,1],presub= [],args= []] - Type: Record(sub: List OutputForm, - sup: List OutputForm, - presup: List OutputForm, - presub: List OutputForm, - args: List OutputForm) - - -See Also: -o )show Symbol -o $AXIOM/doc/src/algebra/symbol.spad.dvi - -@ -<>= -)abbrev domain SYMBOL Symbol -++ Author: Stephen Watt -++ Date Created: 1986 -++ Date Last Updated: 7 Mar 1991, 29 Apr. 1994 (FDLL) -++ Description: -++ Basic and scripted symbols. -++ Keywords: symbol. -Symbol(): Exports == Implementation where - L ==> List OutputForm - Scripts ==> Record(sub:L,sup:L,presup:L,presub:L,args:L) - - Exports ==> Join(OrderedSet, ConvertibleTo InputForm, OpenMath, - ConvertibleTo Symbol, - ConvertibleTo Pattern Integer, ConvertibleTo Pattern Float, - PatternMatchable Integer, PatternMatchable Float) with - new: () -> % - ++ new() returns a new symbol whose name starts with %. - new: % -> % - ++ new(s) returns a new symbol whose name starts with %s. - resetNew: () -> Void - ++ resetNew() resets the internals counters that new() and - ++ new(s) use to return distinct symbols every time. - coerce: String -> % - ++ coerce(s) converts the string s to a symbol. - name: % -> % - ++ name(s) returns s without its scripts. - scripted?: % -> Boolean - ++ scripted?(s) is true if s has been given any scripts. - scripts: % -> Scripts - ++ scripts(s) returns all the scripts of s. - script: (%, List L) -> % - ++ script(s, [a,b,c,d,e]) returns s with subscripts a, - ++ superscripts b, pre-superscripts c, pre-subscripts d, - ++ and argument-scripts e. Omitted components are taken to be empty. - ++ For example, \spad{script(s, [a,b,c])} is equivalent to - ++ \spad{script(s,[a,b,c,[],[]])}. - script: (%, Scripts) -> % - ++ script(s, [a,b,c,d,e]) returns s with subscripts a, - ++ superscripts b, pre-superscripts c, pre-subscripts d, - ++ and argument-scripts e. - subscript: (%, L) -> % - ++ subscript(s, [a1,...,an]) returns s - ++ subscripted by \spad{[a1,...,an]}. - superscript: (%, L) -> % - ++ superscript(s, [a1,...,an]) returns s - ++ superscripted by \spad{[a1,...,an]}. - argscript: (%, L) -> % - ++ argscript(s, [a1,...,an]) returns s - ++ arg-scripted by \spad{[a1,...,an]}. - elt: (%, L) -> % - ++ elt(s,[a1,...,an]) or s([a1,...,an]) returns s subscripted by \spad{[a1,...,an]}. - string: % -> String - ++ string(s) converts the symbol s to a string. - ++ Error: if the symbol is subscripted. - list: % -> List % - ++ list(sy) takes a scripted symbol and produces a list - ++ of the name followed by the scripts. - sample: constant -> % - ++ sample() returns a sample of % - - Implementation ==> add - count: Reference(Integer) := ref 0 - xcount: AssociationList(%, Integer) := empty() - istrings:PrimitiveArray(String) := - construct ["0","1","2","3","4","5","6","7","8","9"] - -- the following 3 strings shall be of empty intersection - nums:String:="0123456789" - ALPHAS:String:="ABCDEFGHIJKLMNOPQRSTUVWXYZ" - alphas:String:="abcdefghijklmnopqrstuvwxyz" - - writeOMSym(dev: OpenMathDevice, x: %): Void == - scripted? x => - error "Cannot convert a scripted symbol to OpenMath" - OMputVariable(dev, x pretend Symbol) - - OMwrite(x: %): String == - s: String := "" - sp := OM_-STRINGTOSTRINGPTR(s)$Lisp - dev: OpenMathDevice := OMopenString(sp pretend String, OMencodingXML) - OMputObject(dev) - writeOMSym(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) - writeOMSym(dev, x) - if wholeObj then - OMputEndObject(dev) - OMclose(dev) - s := OM_-STRINGPTRTOSTRING(sp)$Lisp pretend String - s - - OMwrite(dev: OpenMathDevice, x: %): Void == - OMputObject(dev) - writeOMSym(dev, x) - OMputEndObject(dev) - - OMwrite(dev: OpenMathDevice, x: %, wholeObj: Boolean): Void == - if wholeObj then - OMputObject(dev) - writeOMSym(dev, x) - if wholeObj then - OMputEndObject(dev) - - hd:String := "*" - lhd := #hd - ord0 := ord char("0")$Character - - istring : Integer -> String - syprefix : Scripts -> String - syscripts: Scripts -> L - - convert(s:%):InputForm == convert(s pretend Symbol)$InputForm - convert(s:%):Symbol == s pretend Symbol - coerce(s:String):% == VALUES(INTERN(s)$Lisp)$Lisp - x = y == EQUAL(x,y)$Lisp - x < y == GGREATERP(y, x)$Lisp - coerce(x:%):OutputForm == outputForm(x pretend Symbol) - subscript(sy, lx) == script(sy, [lx, nil, nil(), nil(), nil()]) - elt(sy,lx) == subscript(sy,lx) - superscript(sy, lx) == script(sy,[nil(),lx, nil(), nil(), nil()]) - argscript(sy, lx) == script(sy,[nil(),nil(), nil(), nil(), lx]) - - patternMatch(x:%,p:Pattern Integer,l:PatternMatchResult(Integer,%))== - (patternMatch(x pretend Symbol, p, l pretend - PatternMatchResult(Integer, Symbol))$PatternMatchSymbol(Integer)) - pretend PatternMatchResult(Integer, %) - - patternMatch(x:%, p:Pattern Float, l:PatternMatchResult(Float, %)) == - (patternMatch(x pretend Symbol, p, l pretend - PatternMatchResult(Float, Symbol))$PatternMatchSymbol(Float)) - pretend PatternMatchResult(Float, %) - - convert(x:%):Pattern(Float) == - coerce(x pretend Symbol)$Pattern(Float) - - convert(x:%):Pattern(Integer) == - coerce(x pretend Symbol)$Pattern(Integer) - - syprefix sc == - ns: List Integer := [#sc.presub, #sc.presup, #sc.sup, #sc.sub] - while #ns >= 2 and zero? first ns repeat ns := rest ns - concat concat(concat(hd, istring(#sc.args)), - [istring n for n in reverse_! ns]) - - syscripts sc == - all := sc.presub - all := concat(sc.presup, all) - all := concat(sc.sup, all) - all := concat(sc.sub, all) - concat(all, sc.args) - - script(sy: %, ls: List L) == - sc: Scripts := [nil(), nil(), nil(), nil(), nil()] - if not null ls then (sc.sub := first ls; ls := rest ls) - if not null ls then (sc.sup := first ls; ls := rest ls) - if not null ls then (sc.presup := first ls; ls := rest ls) - if not null ls then (sc.presub := first ls; ls := rest ls) - if not null ls then (sc.args := first ls; ls := rest ls) - script(sy, sc) - - script(sy: %, sc: Scripts) == - scripted? sy => error "Cannot add scripts to a scripted symbol" - (concat(concat(syprefix sc, string name sy)::%::OutputForm, - syscripts sc)) pretend % - - string e == - not scripted? e => PNAME(e)$Lisp - error "Cannot form string from non-atomic symbols." - --- Scripts ==> Record(sub:L,sup:L,presup:L,presub:L,args:L) - latex e == - s : String := (PNAME(name e)$Lisp) pretend String - if #s > 1 and s.1 ^= char "\" then - s := concat("\mbox{\it ", concat(s, "}")$String)$String - not scripted? e => s - ss : Scripts := scripts e - lo : List OutputForm := ss.sub - sc : String - if not empty? lo then - sc := "__{" - while not empty? lo repeat - sc := concat(sc, latex first lo)$String - lo := rest lo - if not empty? lo then sc := concat(sc, ", ")$String - sc := concat(sc, "}")$String - s := concat(s, sc)$String - lo := ss.sup - if not empty? lo then - sc := "^{" - while not empty? lo repeat - sc := concat(sc, latex first lo)$String - lo := rest lo - if not empty? lo then sc := concat(sc, ", ")$String - sc := concat(sc, "}")$String - s := concat(s, sc)$String - lo := ss.presup - if not empty? lo then - sc := "{}^{" - while not empty? lo repeat - sc := concat(sc, latex first lo)$String - lo := rest lo - if not empty? lo then sc := concat(sc, ", ")$String - sc := concat(sc, "}")$String - s := concat(sc, s)$String - lo := ss.presub - if not empty? lo then - sc := "{}__{" - while not empty? lo repeat - sc := concat(sc, latex first lo)$String - lo := rest lo - if not empty? lo then sc := concat(sc, ", ")$String - sc := concat(sc, "}")$String - s := concat(sc, s)$String - lo := ss.args - if not empty? lo then - sc := "\left( {" - while not empty? lo repeat - sc := concat(sc, latex first lo)$String - lo := rest lo - if not empty? lo then sc := concat(sc, ", ")$String - sc := concat(sc, "} \right)")$String - s := concat(s, sc)$String - s - - anyRadix(n:Integer,s:String):String == - ns:String:="" - repeat - qr := divide(n,#s) - n := qr.quotient - ns := concat(s.(qr.remainder+minIndex s),ns) - if zero?(n) then return ns - - new() == - sym := anyRadix(count()::Integer,ALPHAS) - count() := count() + 1 - concat("%",sym)::% - - new x == - n:Integer := - (u := search(x, xcount)) case "failed" => 0 - inc(u::Integer) - xcount(x) := n - xx := - not scripted? x => string x - string name x - xx := concat("%",xx) - xx := - (position(xx.maxIndex(xx),nums)>=minIndex(nums)) => - concat(xx, anyRadix(n,alphas)) - concat(xx, anyRadix(n,nums)) - not scripted? x => xx::% - script(xx::%,scripts x) - - resetNew() == - count() := 0 - for k in keys xcount repeat remove_!(k, xcount) - void - - scripted? sy == - not ATOM(sy)$Lisp - - name sy == - not scripted? sy => sy - str := string first list sy - for i in lhd+1..#str repeat - not digit?(str.i) => return((str.(i..#str))::%) - error "Improper scripted symbol" - - scripts sy == - not scripted? sy => [nil(), nil(), nil(), nil(), nil()] - nscripts: List NonNegativeInteger := [0, 0, 0, 0, 0] - lscripts: List L := [nil(), nil(), nil(), nil(), nil()] - str := string first list sy - nstr := #str - m := minIndex nscripts - for i in m.. for j in lhd+1..nstr while digit?(str.j) repeat - nscripts.i := (ord(str.j) - ord0)::NonNegativeInteger - -- Put the number of function scripts at the end. - nscripts := concat(rest nscripts, first nscripts) - allscripts := rest list sy - m := minIndex lscripts - for i in m.. for n in nscripts repeat - #allscripts < n => error "Improper script count in symbol" - lscripts.i := [a::OutputForm for a in first(allscripts, n)] - allscripts := rest(allscripts, n) - [lscripts.m, lscripts.(m+1), lscripts.(m+2), - lscripts.(m+3), lscripts.(m+4)] - - istring n == - n > 9 => error "Can have at most 9 scripts of each kind" - istrings.(n + minIndex istrings) - - list sy == - not scripted? sy => - error "Cannot convert a symbol to a list if it is not subscripted" - sy pretend List(%) - - sample() == "aSymbol"::% - -@ -\section{SYMBOL.lsp BOOTSTRAP} -{\bf SYMBOL} depends on a chain of -files. We need to break this cycle to build the algebra. So we keep a -cached copy of the translated {\bf SYMBOL} category which we can write -into the {\bf MID} directory. We compile the lisp code and copy the -{\bf SYMBOL.o} file to the {\bf OUT} directory. This is eventually -forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<>= - -(|/VERSIONCHECK| 2) - -(DEFUN |SYMBOL;writeOMSym| (|dev| |x| |$|) (COND ((SPADCALL |x| (QREFELT |$| 21)) (|error| "Cannot convert a scripted symbol to OpenMath")) ((QUOTE T) (SPADCALL |dev| |x| (QREFELT |$| 25))))) - -(DEFUN |SYMBOL;OMwrite;$S;2| (|x| |$|) (PROG (|sp| |dev| |s|) (RETURN (SEQ (LETT |s| "" |SYMBOL;OMwrite;$S;2|) (LETT |sp| (|OM-STRINGTOSTRINGPTR| |s|) |SYMBOL;OMwrite;$S;2|) (LETT |dev| (SPADCALL |sp| (SPADCALL (QREFELT |$| 27)) (QREFELT |$| 29)) |SYMBOL;OMwrite;$S;2|) (SPADCALL |dev| (QREFELT |$| 30)) (|SYMBOL;writeOMSym| |dev| |x| |$|) (SPADCALL |dev| (QREFELT |$| 31)) (SPADCALL |dev| (QREFELT |$| 32)) (LETT |s| (|OM-STRINGPTRTOSTRING| |sp|) |SYMBOL;OMwrite;$S;2|) (EXIT |s|))))) - -(DEFUN |SYMBOL;OMwrite;$BS;3| (|x| |wholeObj| |$|) (PROG (|sp| |dev| |s|) (RETURN (SEQ (LETT |s| "" |SYMBOL;OMwrite;$BS;3|) (LETT |sp| (|OM-STRINGTOSTRINGPTR| |s|) |SYMBOL;OMwrite;$BS;3|) (LETT |dev| (SPADCALL |sp| (SPADCALL (QREFELT |$| 27)) (QREFELT |$| 29)) |SYMBOL;OMwrite;$BS;3|) (COND (|wholeObj| (SPADCALL |dev| (QREFELT |$| 30)))) (|SYMBOL;writeOMSym| |dev| |x| |$|) (COND (|wholeObj| (SPADCALL |dev| (QREFELT |$| 31)))) (SPADCALL |dev| (QREFELT |$| 32)) (LETT |s| (|OM-STRINGPTRTOSTRING| |sp|) |SYMBOL;OMwrite;$BS;3|) (EXIT |s|))))) - -(DEFUN |SYMBOL;OMwrite;Omd$V;4| (|dev| |x| |$|) (SEQ (SPADCALL |dev| (QREFELT |$| 30)) (|SYMBOL;writeOMSym| |dev| |x| |$|) (EXIT (SPADCALL |dev| (QREFELT |$| 31))))) - -(DEFUN |SYMBOL;OMwrite;Omd$BV;5| (|dev| |x| |wholeObj| |$|) (SEQ (COND (|wholeObj| (SPADCALL |dev| (QREFELT |$| 30)))) (|SYMBOL;writeOMSym| |dev| |x| |$|) (EXIT (COND (|wholeObj| (SPADCALL |dev| (QREFELT |$| 31))))))) - -(DEFUN |SYMBOL;convert;$If;6| (|s| |$|) (SPADCALL |s| (QREFELT |$| 44))) - -(PUT (QUOTE |SYMBOL;convert;2$;7|) (QUOTE |SPADreplace|) (QUOTE (XLAM (|s|) |s|))) - -(DEFUN |SYMBOL;convert;2$;7| (|s| |$|) |s|) - -(DEFUN |SYMBOL;coerce;S$;8| (|s| |$|) (VALUES (INTERN |s|))) - -(PUT (QUOTE |SYMBOL;=;2$B;9|) (QUOTE |SPADreplace|) (QUOTE EQUAL)) - -(DEFUN |SYMBOL;=;2$B;9| (|x| |y| |$|) (EQUAL |x| |y|)) - -(PUT (QUOTE |SYMBOL;<;2$B;10|) (QUOTE |SPADreplace|) (QUOTE (XLAM (|x| |y|) (GGREATERP |y| |x|)))) - -(DEFUN |SYMBOL;<;2$B;10| (|x| |y| |$|) (GGREATERP |y| |x|)) - -(DEFUN |SYMBOL;coerce;$Of;11| (|x| |$|) (SPADCALL |x| (QREFELT |$| 51))) - -(DEFUN |SYMBOL;subscript;$L$;12| (|sy| |lx| |$|) (SPADCALL |sy| (LIST |lx| NIL NIL NIL NIL) (QREFELT |$| 54))) - -(DEFUN |SYMBOL;elt;$L$;13| (|sy| |lx| |$|) (SPADCALL |sy| |lx| (QREFELT |$| 56))) - -(DEFUN |SYMBOL;superscript;$L$;14| (|sy| |lx| |$|) (SPADCALL |sy| (LIST NIL |lx| NIL NIL NIL) (QREFELT |$| 54))) - -(DEFUN |SYMBOL;argscript;$L$;15| (|sy| |lx| |$|) (SPADCALL |sy| (LIST NIL NIL NIL NIL |lx|) (QREFELT |$| 54))) - -(DEFUN |SYMBOL;patternMatch;$P2Pmr;16| (|x| |p| |l| |$|) (SPADCALL |x| |p| |l| (QREFELT |$| 63))) - -(DEFUN |SYMBOL;patternMatch;$P2Pmr;17| (|x| |p| |l| |$|) (SPADCALL |x| |p| |l| (QREFELT |$| 69))) - -(DEFUN |SYMBOL;convert;$P;18| (|x| |$|) (SPADCALL |x| (QREFELT |$| 72))) - -(DEFUN |SYMBOL;convert;$P;19| (|x| |$|) (SPADCALL |x| (QREFELT |$| 74))) - -(DEFUN |SYMBOL;syprefix| (|sc| |$|) (PROG (|ns| #1=#:G108218 |n| #2=#:G108219) (RETURN (SEQ (LETT |ns| (LIST (LENGTH (QVELT |sc| 3)) (LENGTH (QVELT |sc| 2)) (LENGTH (QVELT |sc| 1)) (LENGTH (QVELT |sc| 0))) |SYMBOL;syprefix|) (SEQ G190 (COND ((NULL (COND ((|<| (LENGTH |ns|) 2) (QUOTE NIL)) ((QUOTE T) (ZEROP (|SPADfirst| |ns|))))) (GO G191))) (SEQ (EXIT (LETT |ns| (CDR |ns|) |SYMBOL;syprefix|))) NIL (GO G190) G191 (EXIT NIL)) (EXIT (SPADCALL (CONS (STRCONC (QREFELT |$| 37) (|SYMBOL;istring| (LENGTH (QVELT |sc| 4)) |$|)) (PROGN (LETT #1# NIL |SYMBOL;syprefix|) (SEQ (LETT |n| NIL |SYMBOL;syprefix|) (LETT #2# (NREVERSE |ns|) |SYMBOL;syprefix|) G190 (COND ((OR (ATOM #2#) (PROGN (LETT |n| (CAR #2#) |SYMBOL;syprefix|) NIL)) (GO G191))) (SEQ (EXIT (LETT #1# (CONS (|SYMBOL;istring| |n| |$|) #1#) |SYMBOL;syprefix|))) (LETT #2# (CDR #2#) |SYMBOL;syprefix|) (GO G190) G191 (EXIT (NREVERSE0 #1#))))) (QREFELT |$| 77))))))) - -(DEFUN |SYMBOL;syscripts| (|sc| |$|) (PROG (|all|) (RETURN (SEQ (LETT |all| (QVELT |sc| 3) |SYMBOL;syscripts|) (LETT |all| (SPADCALL (QVELT |sc| 2) |all| (QREFELT |$| 78)) |SYMBOL;syscripts|) (LETT |all| (SPADCALL (QVELT |sc| 1) |all| (QREFELT |$| 78)) |SYMBOL;syscripts|) (LETT |all| (SPADCALL (QVELT |sc| 0) |all| (QREFELT |$| 78)) |SYMBOL;syscripts|) (EXIT (SPADCALL |all| (QVELT |sc| 4) (QREFELT |$| 78))))))) - -(DEFUN |SYMBOL;script;$L$;22| (|sy| |ls| |$|) (PROG (|sc|) (RETURN (SEQ (LETT |sc| (VECTOR NIL NIL NIL NIL NIL) |SYMBOL;script;$L$;22|) (COND ((NULL (NULL |ls|)) (SEQ (QSETVELT |sc| 0 (|SPADfirst| |ls|)) (EXIT (LETT |ls| (CDR |ls|) |SYMBOL;script;$L$;22|))))) (COND ((NULL (NULL |ls|)) (SEQ (QSETVELT |sc| 1 (|SPADfirst| |ls|)) (EXIT (LETT |ls| (CDR |ls|) |SYMBOL;script;$L$;22|))))) (COND ((NULL (NULL |ls|)) (SEQ (QSETVELT |sc| 2 (|SPADfirst| |ls|)) (EXIT (LETT |ls| (CDR |ls|) |SYMBOL;script;$L$;22|))))) (COND ((NULL (NULL |ls|)) (SEQ (QSETVELT |sc| 3 (|SPADfirst| |ls|)) (EXIT (LETT |ls| (CDR |ls|) |SYMBOL;script;$L$;22|))))) (COND ((NULL (NULL |ls|)) (SEQ (QSETVELT |sc| 4 (|SPADfirst| |ls|)) (EXIT (LETT |ls| (CDR |ls|) |SYMBOL;script;$L$;22|))))) (EXIT (SPADCALL |sy| |sc| (QREFELT |$| 80))))))) - -(DEFUN |SYMBOL;script;$R$;23| (|sy| |sc| |$|) (COND ((SPADCALL |sy| (QREFELT |$| 21)) (|error| "Cannot add scripts to a scripted symbol")) ((QUOTE T) (CONS (SPADCALL (SPADCALL (STRCONC (|SYMBOL;syprefix| |sc| |$|) (SPADCALL (SPADCALL |sy| (QREFELT |$| 81)) (QREFELT |$| 82))) (QREFELT |$| 47)) (QREFELT |$| 52)) (|SYMBOL;syscripts| |sc| |$|))))) - -(DEFUN |SYMBOL;string;$S;24| (|e| |$|) (COND ((NULL (SPADCALL |e| (QREFELT |$| 21))) (PNAME |e|)) ((QUOTE T) (|error| "Cannot form string from non-atomic symbols.")))) - -(DEFUN |SYMBOL;latex;$S;25| (|e| |$|) (PROG (|ss| |lo| |sc| |s|) (RETURN (SEQ (LETT |s| (PNAME (SPADCALL |e| (QREFELT |$| 81))) |SYMBOL;latex;$S;25|) (COND ((|<| 1 (QCSIZE |s|)) (COND ((NULL (SPADCALL (SPADCALL |s| 1 (QREFELT |$| 83)) (SPADCALL "\\" (QREFELT |$| 40)) (QREFELT |$| 84))) (LETT |s| (STRCONC "\\mbox{\\it " (STRCONC |s| "}")) |SYMBOL;latex;$S;25|))))) (COND ((NULL (SPADCALL |e| (QREFELT |$| 21))) (EXIT |s|))) (LETT |ss| (SPADCALL |e| (QREFELT |$| 85)) |SYMBOL;latex;$S;25|) (LETT |lo| (QVELT |ss| 0) |SYMBOL;latex;$S;25|) (COND ((NULL (NULL |lo|)) (SEQ (LETT |sc| "_{" |SYMBOL;latex;$S;25|) (SEQ G190 (COND ((NULL (COND ((NULL |lo|) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) (GO G191))) (SEQ (LETT |sc| (STRCONC |sc| (SPADCALL (|SPADfirst| |lo|) (QREFELT |$| 86))) |SYMBOL;latex;$S;25|) (LETT |lo| (CDR |lo|) |SYMBOL;latex;$S;25|) (EXIT (COND ((NULL (NULL |lo|)) (LETT |sc| (STRCONC |sc| ", ") |SYMBOL;latex;$S;25|))))) NIL (GO G190) G191 (EXIT NIL)) (LETT |sc| (STRCONC |sc| "}") |SYMBOL;latex;$S;25|) (EXIT (LETT |s| (STRCONC |s| |sc|) |SYMBOL;latex;$S;25|))))) (LETT |lo| (QVELT |ss| 1) |SYMBOL;latex;$S;25|) (COND ((NULL (NULL |lo|)) (SEQ (LETT |sc| "^{" |SYMBOL;latex;$S;25|) (SEQ G190 (COND ((NULL (COND ((NULL |lo|) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) (GO G191))) (SEQ (LETT |sc| (STRCONC |sc| (SPADCALL (|SPADfirst| |lo|) (QREFELT |$| 86))) |SYMBOL;latex;$S;25|) (LETT |lo| (CDR |lo|) |SYMBOL;latex;$S;25|) (EXIT (COND ((NULL (NULL |lo|)) (LETT |sc| (STRCONC |sc| ", ") |SYMBOL;latex;$S;25|))))) NIL (GO G190) G191 (EXIT NIL)) (LETT |sc| (STRCONC |sc| "}") |SYMBOL;latex;$S;25|) (EXIT (LETT |s| (STRCONC |s| |sc|) |SYMBOL;latex;$S;25|))))) (LETT |lo| (QVELT |ss| 2) |SYMBOL;latex;$S;25|) (COND ((NULL (NULL |lo|)) (SEQ (LETT |sc| "{}^{" |SYMBOL;latex;$S;25|) (SEQ G190 (COND ((NULL (COND ((NULL |lo|) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) (GO G191))) (SEQ (LETT |sc| (STRCONC |sc| (SPADCALL (|SPADfirst| |lo|) (QREFELT |$| 86))) |SYMBOL;latex;$S;25|) (LETT |lo| (CDR |lo|) |SYMBOL;latex;$S;25|) (EXIT (COND ((NULL (NULL |lo|)) (LETT |sc| (STRCONC |sc| ", ") |SYMBOL;latex;$S;25|))))) NIL (GO G190) G191 (EXIT NIL)) (LETT |sc| (STRCONC |sc| "}") |SYMBOL;latex;$S;25|) (EXIT (LETT |s| (STRCONC |sc| |s|) |SYMBOL;latex;$S;25|))))) (LETT |lo| (QVELT |ss| 3) |SYMBOL;latex;$S;25|) (COND ((NULL (NULL |lo|)) (SEQ (LETT |sc| "{}_{" |SYMBOL;latex;$S;25|) (SEQ G190 (COND ((NULL (COND ((NULL |lo|) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) (GO G191))) (SEQ (LETT |sc| (STRCONC |sc| (SPADCALL (|SPADfirst| |lo|) (QREFELT |$| 86))) |SYMBOL;latex;$S;25|) (LETT |lo| (CDR |lo|) |SYMBOL;latex;$S;25|) (EXIT (COND ((NULL (NULL |lo|)) (LETT |sc| (STRCONC |sc| ", ") |SYMBOL;latex;$S;25|))))) NIL (GO G190) G191 (EXIT NIL)) (LETT |sc| (STRCONC |sc| "}") |SYMBOL;latex;$S;25|) (EXIT (LETT |s| (STRCONC |sc| |s|) |SYMBOL;latex;$S;25|))))) (LETT |lo| (QVELT |ss| 4) |SYMBOL;latex;$S;25|) (COND ((NULL (NULL |lo|)) (SEQ (LETT |sc| "\\left( {" |SYMBOL;latex;$S;25|) (SEQ G190 (COND ((NULL (COND ((NULL |lo|) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) (GO G191))) (SEQ (LETT |sc| (STRCONC |sc| (SPADCALL (|SPADfirst| |lo|) (QREFELT |$| 86))) |SYMBOL;latex;$S;25|) (LETT |lo| (CDR |lo|) |SYMBOL;latex;$S;25|) (EXIT (COND ((NULL (NULL |lo|)) (LETT |sc| (STRCONC |sc| ", ") |SYMBOL;latex;$S;25|))))) NIL (GO G190) G191 (EXIT NIL)) (LETT |sc| (STRCONC |sc| "} \\right)") |SYMBOL;latex;$S;25|) (EXIT (LETT |s| (STRCONC |s| |sc|) |SYMBOL;latex;$S;25|))))) (EXIT |s|))))) - -(DEFUN |SYMBOL;anyRadix| (|n| |s| |$|) (PROG (|qr| |ns| #1=#:G108274) (RETURN (SEQ (EXIT (SEQ (LETT |ns| "" |SYMBOL;anyRadix|) (EXIT (SEQ G190 NIL (SEQ (LETT |qr| (DIVIDE2 |n| (QCSIZE |s|)) |SYMBOL;anyRadix|) (LETT |n| (QCAR |qr|) |SYMBOL;anyRadix|) (LETT |ns| (SPADCALL (SPADCALL |s| (|+| (QCDR |qr|) (SPADCALL |s| (QREFELT |$| 88))) (QREFELT |$| 83)) |ns| (QREFELT |$| 89)) |SYMBOL;anyRadix|) (EXIT (COND ((ZEROP |n|) (PROGN (LETT #1# |ns| |SYMBOL;anyRadix|) (GO #1#)))))) NIL (GO G190) G191 (EXIT NIL))))) #1# (EXIT #1#))))) - -(DEFUN |SYMBOL;new;$;27| (|$|) (PROG (|sym|) (RETURN (SEQ (LETT |sym| (|SYMBOL;anyRadix| (SPADCALL (QREFELT |$| 9) (QREFELT |$| 90)) (QREFELT |$| 18) |$|) |SYMBOL;new;$;27|) (SPADCALL (QREFELT |$| 9) (|+| (SPADCALL (QREFELT |$| 9) (QREFELT |$| 90)) 1) (QREFELT |$| 91)) (EXIT (SPADCALL (STRCONC "%" |sym|) (QREFELT |$| 47))))))) - -(DEFUN |SYMBOL;new;2$;28| (|x| |$|) (PROG (|u| |n| |xx|) (RETURN (SEQ (LETT |n| (SEQ (LETT |u| (SPADCALL |x| (QREFELT |$| 12) (QREFELT |$| 94)) |SYMBOL;new;2$;28|) (EXIT (COND ((QEQCAR |u| 1) 0) ((QUOTE T) (|+| (QCDR |u|) 1))))) |SYMBOL;new;2$;28|) (SPADCALL (QREFELT |$| 12) |x| |n| (QREFELT |$| 95)) (LETT |xx| (COND ((NULL (SPADCALL |x| (QREFELT |$| 21))) (SPADCALL |x| (QREFELT |$| 82))) ((QUOTE T) (SPADCALL (SPADCALL |x| (QREFELT |$| 81)) (QREFELT |$| 82)))) |SYMBOL;new;2$;28|) (LETT |xx| (STRCONC "%" |xx|) |SYMBOL;new;2$;28|) (LETT |xx| (COND ((NULL (|<| (SPADCALL (SPADCALL |xx| (SPADCALL |xx| (QREFELT |$| 96)) (QREFELT |$| 83)) (QREFELT |$| 17) (QREFELT |$| 97)) (SPADCALL (QREFELT |$| 17) (QREFELT |$| 88)))) (STRCONC |xx| (|SYMBOL;anyRadix| |n| (QREFELT |$| 19) |$|))) ((QUOTE T) (STRCONC |xx| (|SYMBOL;anyRadix| |n| (QREFELT |$| 17) |$|)))) |SYMBOL;new;2$;28|) (COND ((NULL (SPADCALL |x| (QREFELT |$| 21))) (EXIT (SPADCALL |xx| (QREFELT |$| 47))))) (EXIT (SPADCALL (SPADCALL |xx| (QREFELT |$| 47)) (SPADCALL |x| (QREFELT |$| 85)) (QREFELT |$| 80))))))) - -(DEFUN |SYMBOL;resetNew;V;29| (|$|) (PROG (|k| #1=#:G108297) (RETURN (SEQ (SPADCALL (QREFELT |$| 9) 0 (QREFELT |$| 91)) (SEQ (LETT |k| NIL |SYMBOL;resetNew;V;29|) (LETT #1# (SPADCALL (QREFELT |$| 12) (QREFELT |$| 100)) |SYMBOL;resetNew;V;29|) G190 (COND ((OR (ATOM #1#) (PROGN (LETT |k| (CAR #1#) |SYMBOL;resetNew;V;29|) NIL)) (GO G191))) (SEQ (EXIT (SPADCALL |k| (QREFELT |$| 12) (QREFELT |$| 101)))) (LETT #1# (CDR #1#) |SYMBOL;resetNew;V;29|) (GO G190) G191 (EXIT NIL)) (EXIT (SPADCALL (QREFELT |$| 102))))))) - -(DEFUN |SYMBOL;scripted?;$B;30| (|sy| |$|) (COND ((ATOM |sy|) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) - -(DEFUN |SYMBOL;name;2$;31| (|sy| |$|) (PROG (|str| |i| #1=#:G108304 #2=#:G108303 #3=#:G108301) (RETURN (SEQ (EXIT (COND ((NULL (SPADCALL |sy| (QREFELT |$| 21))) |sy|) ((QUOTE T) (SEQ (LETT |str| (SPADCALL (SPADCALL (SPADCALL |sy| (QREFELT |$| 104)) (QREFELT |$| 105)) (QREFELT |$| 82)) |SYMBOL;name;2$;31|) (SEQ (EXIT (SEQ (LETT |i| (|+| (QREFELT |$| 38) 1) |SYMBOL;name;2$;31|) (LETT #1# (QCSIZE |str|) |SYMBOL;name;2$;31|) G190 (COND ((|>| |i| #1#) (GO G191))) (SEQ (EXIT (COND ((NULL (SPADCALL (SPADCALL |str| |i| (QREFELT |$| 83)) (QREFELT |$| 106))) (PROGN (LETT #3# (PROGN (LETT #2# (SPADCALL (SPADCALL |str| (SPADCALL |i| (QCSIZE |str|) (QREFELT |$| 108)) (QREFELT |$| 109)) (QREFELT |$| 47)) |SYMBOL;name;2$;31|) (GO #2#)) |SYMBOL;name;2$;31|) (GO #3#)))))) (LETT |i| (|+| |i| 1) |SYMBOL;name;2$;31|) (GO G190) G191 (EXIT NIL))) #3# (EXIT #3#)) (EXIT (|error| "Improper scripted symbol")))))) #2# (EXIT #2#))))) - -(DEFUN |SYMBOL;scripts;$R;32| (|sy| |$|) (PROG (|lscripts| |str| |nstr| |j| #1=#:G108307 |nscripts| |m| |n| #2=#:G108316 |i| #3=#:G108317 |a| #4=#:G108318 |allscripts|) (RETURN (SEQ (COND ((NULL (SPADCALL |sy| (QREFELT |$| 21))) (VECTOR NIL NIL NIL NIL NIL)) ((QUOTE T) (SEQ (LETT |nscripts| (LIST 0 0 0 0 0) |SYMBOL;scripts;$R;32|) (LETT |lscripts| (LIST NIL NIL NIL NIL NIL) |SYMBOL;scripts;$R;32|) (LETT |str| (SPADCALL (SPADCALL (SPADCALL |sy| (QREFELT |$| 104)) (QREFELT |$| 105)) (QREFELT |$| 82)) |SYMBOL;scripts;$R;32|) (LETT |nstr| (QCSIZE |str|) |SYMBOL;scripts;$R;32|) (LETT |m| (SPADCALL |nscripts| (QREFELT |$| 111)) |SYMBOL;scripts;$R;32|) (SEQ (LETT |j| (|+| (QREFELT |$| 38) 1) |SYMBOL;scripts;$R;32|) (LETT |i| |m| |SYMBOL;scripts;$R;32|) G190 (COND ((OR (|>| |j| |nstr|) (NULL (SPADCALL (SPADCALL |str| |j| (QREFELT |$| 83)) (QREFELT |$| 106)))) (GO G191))) (SEQ (EXIT (SPADCALL |nscripts| |i| (PROG1 (LETT #1# (|-| (SPADCALL (SPADCALL |str| |j| (QREFELT |$| 83)) (QREFELT |$| 41)) (QREFELT |$| 42)) |SYMBOL;scripts;$R;32|) (|check-subtype| (|>=| #1# 0) (QUOTE (|NonNegativeInteger|)) #1#)) (QREFELT |$| 113)))) (LETT |i| (PROG1 (|+| |i| 1) (LETT |j| (|+| |j| 1) |SYMBOL;scripts;$R;32|)) |SYMBOL;scripts;$R;32|) (GO G190) G191 (EXIT NIL)) (LETT |nscripts| (SPADCALL (CDR |nscripts|) (|SPADfirst| |nscripts|) (QREFELT |$| 114)) |SYMBOL;scripts;$R;32|) (LETT |allscripts| (SPADCALL (SPADCALL |sy| (QREFELT |$| 104)) (QREFELT |$| 115)) |SYMBOL;scripts;$R;32|) (LETT |m| (SPADCALL |lscripts| (QREFELT |$| 116)) |SYMBOL;scripts;$R;32|) (SEQ (LETT |n| NIL |SYMBOL;scripts;$R;32|) (LETT #2# |nscripts| |SYMBOL;scripts;$R;32|) (LETT |i| |m| |SYMBOL;scripts;$R;32|) G190 (COND ((OR (ATOM #2#) (PROGN (LETT |n| (CAR #2#) |SYMBOL;scripts;$R;32|) NIL)) (GO G191))) (SEQ (EXIT (COND ((|<| (SPADCALL |allscripts| (QREFELT |$| 117)) |n|) (|error| "Improper script count in symbol")) ((QUOTE T) (SEQ (SPADCALL |lscripts| |i| (PROGN (LETT #3# NIL |SYMBOL;scripts;$R;32|) (SEQ (LETT |a| NIL |SYMBOL;scripts;$R;32|) (LETT #4# (SPADCALL |allscripts| |n| (QREFELT |$| 118)) |SYMBOL;scripts;$R;32|) G190 (COND ((OR (ATOM #4#) (PROGN (LETT |a| (CAR #4#) |SYMBOL;scripts;$R;32|) NIL)) (GO G191))) (SEQ (EXIT (LETT #3# (CONS (SPADCALL |a| (QREFELT |$| 52)) #3#) |SYMBOL;scripts;$R;32|))) (LETT #4# (CDR #4#) |SYMBOL;scripts;$R;32|) (GO G190) G191 (EXIT (NREVERSE0 #3#)))) (QREFELT |$| 119)) (EXIT (LETT |allscripts| (SPADCALL |allscripts| |n| (QREFELT |$| 120)) |SYMBOL;scripts;$R;32|))))))) (LETT |i| (PROG1 (|+| |i| 1) (LETT #2# (CDR #2#) |SYMBOL;scripts;$R;32|)) |SYMBOL;scripts;$R;32|) (GO G190) G191 (EXIT NIL)) (EXIT (VECTOR (SPADCALL |lscripts| |m| (QREFELT |$| 121)) (SPADCALL |lscripts| (|+| |m| 1) (QREFELT |$| 121)) (SPADCALL |lscripts| (|+| |m| 2) (QREFELT |$| 121)) (SPADCALL |lscripts| (|+| |m| 3) (QREFELT |$| 121)) (SPADCALL |lscripts| (|+| |m| 4) (QREFELT |$| 121))))))))))) - -(DEFUN |SYMBOL;istring| (|n| |$|) (COND ((|<| 9 |n|) (|error| "Can have at most 9 scripts of each kind")) ((QUOTE T) (ELT (QREFELT |$| 16) (|+| |n| 0))))) - -(DEFUN |SYMBOL;list;$L;34| (|sy| |$|) (COND ((NULL (SPADCALL |sy| (QREFELT |$| 21))) (|error| "Cannot convert a symbol to a list if it is not subscripted")) ((QUOTE T) |sy|))) - -(DEFUN |SYMBOL;sample;$;35| (|$|) (SPADCALL "aSymbol" (QREFELT |$| 47))) - -(DEFUN |Symbol| NIL (PROG NIL (RETURN (PROG (#1=#:G108325) (RETURN (COND ((LETT #1# (HGET |$ConstructorCache| (QUOTE |Symbol|)) |Symbol|) (|CDRwithIncrement| (CDAR #1#))) ((QUOTE T) (|UNWIND-PROTECT| (PROG1 (CDDAR (HPUT |$ConstructorCache| (QUOTE |Symbol|) (LIST (CONS NIL (CONS 1 (|Symbol;|)))))) (LETT #1# T |Symbol|)) (COND ((NOT #1#) (HREM |$ConstructorCache| (QUOTE |Symbol|)))))))))))) - -(DEFUN |Symbol;| NIL (PROG (|dv$| |$| |pv$|) (RETURN (PROGN (LETT |dv$| (QUOTE (|Symbol|)) . #1=(|Symbol|)) (LETT |$| (GETREFV 124) . #1#) (QSETREFV |$| 0 |dv$|) (QSETREFV |$| 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #1#)) (|haddProp| |$ConstructorCache| (QUOTE |Symbol|) NIL (CONS 1 |$|)) (|stuffDomainSlots| |$|) (QSETREFV |$| 9 (SPADCALL 0 (QREFELT |$| 8))) (QSETREFV |$| 12 (SPADCALL (QREFELT |$| 11))) (QSETREFV |$| 16 (SPADCALL (LIST #2="0" "1" "2" "3" "4" "5" "6" "7" "8" "9") (QREFELT |$| 15))) (QSETREFV |$| 17 "0123456789") (QSETREFV |$| 18 "ABCDEFGHIJKLMNOPQRSTUVWXYZ") (QSETREFV |$| 19 "abcdefghijklmnopqrstuvwxyz") (QSETREFV |$| 37 "*") (QSETREFV |$| 38 (QCSIZE (QREFELT |$| 37))) (QSETREFV |$| 42 (SPADCALL (SPADCALL #2# (QREFELT |$| 40)) (QREFELT |$| 41))) |$|)))) - -(MAKEPROP (QUOTE |Symbol|) (QUOTE |infovec|) (LIST (QUOTE #(NIL NIL NIL NIL NIL NIL (|Integer|) (|Reference| 6) (0 . |ref|) (QUOTE |count|) (|AssociationList| |$$| 6) (5 . |empty|) (QUOTE |xcount|) (|List| 28) (|PrimitiveArray| 28) (9 . |construct|) (QUOTE |istrings|) (QUOTE |nums|) (QUOTE ALPHAS) (QUOTE |alphas|) (|Boolean|) |SYMBOL;scripted?;$B;30| (|Void|) (|Symbol|) (|OpenMathDevice|) (14 . |OMputVariable|) (|OpenMathEncoding|) (20 . |OMencodingXML|) (|String|) (24 . |OMopenString|) (30 . |OMputObject|) (35 . |OMputEndObject|) (40 . |OMclose|) |SYMBOL;OMwrite;$S;2| |SYMBOL;OMwrite;$BS;3| |SYMBOL;OMwrite;Omd$V;4| |SYMBOL;OMwrite;Omd$BV;5| (QUOTE |hd|) (QUOTE |lhd|) (|Character|) (45 . |char|) (50 . |ord|) (QUOTE |ord0|) (|InputForm|) (55 . |convert|) |SYMBOL;convert;$If;6| |SYMBOL;convert;2$;7| |SYMBOL;coerce;S$;8| |SYMBOL;=;2$B;9| |SYMBOL;<;2$B;10| (|OutputForm|) (60 . |outputForm|) |SYMBOL;coerce;$Of;11| (|List| 55) |SYMBOL;script;$L$;22| (|List| 50) |SYMBOL;subscript;$L$;12| |SYMBOL;elt;$L$;13| |SYMBOL;superscript;$L$;14| |SYMBOL;argscript;$L$;15| (|PatternMatchResult| 6 23) (|Pattern| 6) (|PatternMatchSymbol| 6) (65 . |patternMatch|) (|PatternMatchResult| 6 |$|) |SYMBOL;patternMatch;$P2Pmr;16| (|PatternMatchResult| (|Float|) 23) (|Pattern| (|Float|)) (|PatternMatchSymbol| (|Float|)) (72 . |patternMatch|) (|PatternMatchResult| (|Float|) |$|) |SYMBOL;patternMatch;$P2Pmr;17| (79 . |coerce|) |SYMBOL;convert;$P;18| (84 . |coerce|) |SYMBOL;convert;$P;19| (|List| |$|) (89 . |concat|) (94 . |concat|) (|Record| (|:| |sub| 55) (|:| |sup| 55) (|:| |presup| 55) (|:| |presub| 55) (|:| |args| 55)) |SYMBOL;script;$R$;23| |SYMBOL;name;2$;31| |SYMBOL;string;$S;24| (100 . |elt|) (106 . |=|) |SYMBOL;scripts;$R;32| (112 . |latex|) |SYMBOL;latex;$S;25| (117 . |minIndex|) (122 . |concat|) (128 . |elt|) (133 . |setelt|) |SYMBOL;new;$;27| (|Union| 6 (QUOTE "failed")) (139 . |search|) (145 . |setelt|) (152 . |maxIndex|) (157 . |position|) |SYMBOL;new;2$;28| (|List| |$$|) (163 . |keys|) (168 . |remove!|) (174 . |void|) |SYMBOL;resetNew;V;29| |SYMBOL;list;$L;34| (178 . |first|) (183 . |digit?|) (|UniversalSegment| 6) (188 . SEGMENT) (194 . |elt|) (|List| 112) (200 . |minIndex|) (|NonNegativeInteger|) (205 . |setelt|) (212 . |concat|) (218 . |rest|) (223 . |minIndex|) (228 . |#|) (233 . |first|) (239 . |setelt|) (246 . |rest|) (252 . |elt|) (CONS IDENTITY (FUNCALL (|dispatchFunction| |SYMBOL;sample;$;35|) |$|)) (|SingleInteger|))) (QUOTE #(|~=| 258 |superscript| 264 |subscript| 270 |string| 276 |scripts| 281 |scripted?| 286 |script| 291 |sample| 303 |resetNew| 307 |patternMatch| 311 |new| 325 |name| 334 |min| 339 |max| 345 |list| 351 |latex| 356 |hash| 361 |elt| 366 |convert| 372 |coerce| 392 |argscript| 402 |OMwrite| 408 |>=| 432 |>| 438 |=| 444 |<=| 450 |<| 456)) (QUOTE NIL) (CONS (|makeByteWordVec2| 1 (QUOTE (0 0 0 0 0 0 0 0 0 0 0))) (CONS (QUOTE #(|OrderedSet&| NIL NIL |SetCategory&| |BasicType&| NIL NIL NIL NIL NIL NIL)) (CONS (QUOTE #((|OrderedSet|) (|PatternMatchable| (|Float|)) (|PatternMatchable| 6) (|SetCategory|) (|BasicType|) (|ConvertibleTo| 67) (|ConvertibleTo| 61) (|ConvertibleTo| 23) (|OpenMath|) (|ConvertibleTo| 43) (|CoercibleTo| 50))) (|makeByteWordVec2| 123 (QUOTE (1 7 0 6 8 0 10 0 11 1 14 0 13 15 2 24 22 0 23 25 0 26 0 27 2 24 0 28 26 29 1 24 22 0 30 1 24 22 0 31 1 24 22 0 32 1 39 0 28 40 1 39 6 0 41 1 43 0 23 44 1 50 0 23 51 3 62 60 23 61 60 63 3 68 66 23 67 66 69 1 67 0 23 72 1 61 0 23 74 1 28 0 76 77 2 55 0 0 0 78 2 28 39 0 6 83 2 39 20 0 0 84 1 50 28 0 86 1 28 6 0 88 2 28 0 39 0 89 1 7 6 0 90 2 7 6 0 6 91 2 10 93 2 0 94 3 10 6 0 2 6 95 1 28 6 0 96 2 28 6 39 0 97 1 10 99 0 100 2 10 93 2 0 101 0 22 0 102 1 99 2 0 105 1 39 20 0 106 2 107 0 6 6 108 2 28 0 0 107 109 1 110 6 0 111 3 110 112 0 6 112 113 2 110 0 0 112 114 1 99 0 0 115 1 53 6 0 116 1 99 112 0 117 2 99 0 0 112 118 3 53 55 0 6 55 119 2 99 0 0 112 120 2 53 55 0 6 121 2 0 20 0 0 1 2 0 0 0 55 58 2 0 0 0 55 56 1 0 28 0 82 1 0 79 0 85 1 0 20 0 21 2 0 0 0 53 54 2 0 0 0 79 80 0 0 0 122 0 0 22 103 3 0 64 0 61 64 65 3 0 70 0 67 70 71 1 0 0 0 98 0 0 0 92 1 0 0 0 81 2 0 0 0 0 1 2 0 0 0 0 1 1 0 76 0 104 1 0 28 0 87 1 0 123 0 1 2 0 0 0 55 57 1 0 61 0 75 1 0 67 0 73 1 0 23 0 46 1 0 43 0 45 1 0 0 28 47 1 0 50 0 52 2 0 0 0 55 59 3 0 22 24 0 20 36 2 0 28 0 20 34 2 0 22 24 0 35 1 0 28 0 33 2 0 20 0 0 1 2 0 20 0 0 1 2 0 20 0 0 48 2 0 20 0 0 1 2 0 20 0 0 49)))))) (QUOTE |lookupComplete|))) - -(MAKEPROP (QUOTE |Symbol|) (QUOTE NILADIC) T) -@ -\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 269373e..3452f13 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -805,6 +805,8 @@ bookvol10.3 add domains
bookvol10.3 add domains
20081215.01.tpd.patch download.html add vector linux
+20081215.02.tpd.patch +bookvol10.3 add domains
\ No newline at end of file