\documentclass{article} \usepackage{axiom} \begin{document} \title{\$SPAD/src/algebra outform.spad} \author{Stephen M. Watt} \maketitle \begin{abstract} \end{abstract} \eject \tableofcontents \eject \section{package NUMFMT NumberFormats} <>= )abbrev package NUMFMT NumberFormats ++ SMW March 88 ++ Keywords: string manipulation, roman numerals, format ++ Description: ++ NumberFormats provides function to format and read arabic and ++ roman numbers, to convert numbers to strings and to read ++ floating-point numbers. NumberFormats(): NFexports == NFimplementation where PI ==> PositiveInteger I ==> Integer C ==> Character F ==> Float S ==> String V ==> PrimitiveArray NFexports ==> with FormatArabic: PI -> S ++ FormatArabic(n) forms an Arabic numeral ++ string from an integer n. ScanArabic: S -> PI ++ ScanArabic(s) forms an integer from an Arabic numeral string s. FormatRoman: PI -> S ++ FormatRoman(n) forms a Roman numeral string from an integer n. ScanRoman: S -> PI ++ ScanRoman(s) forms an integer from a Roman numeral string s. ScanFloatIgnoreSpaces: S -> F ++ ScanFloatIgnoreSpaces(s) forms a floating point number from ++ the string s ignoring any spaces. Error is generated if the ++ string is not recognised as a floating point number. ScanFloatIgnoreSpacesIfCan: S -> Union(F, "failed") ++ ScanFloatIgnoreSpacesIfCan(s) tries to form a floating point number from ++ the string s ignoring any spaces. NFimplementation ==> add import SExpression import Symbol replaceD: C -> C replaced: C -> C contract: S -> S check: S ->Boolean replaceD c == if c = char "D" then char "E" else c replaced c == if c = char "d" then char "E" else c contract s == s:= map(replaceD,s) s:= map(replaced,s) ls:List S := split(s,char " ")$String s:= concat ls check s == NUMBERP(READ_-FROM_-STRING(s)$Lisp)$Lisp and -- if there is an "E" then there must be a "." -- this is not caught by code above -- also if the exponent is v.big the above returns false not (any?(#1=char "E",s) and not any?(#1=char ".",s) ) -- Original interpreter function: -- )lis (defun scanstr(x) (spadcomp::|parseFromString| x)) sexfloat:SExpression:=convert(coerce("Float")@Symbol)$SExpression ScanFloatIgnoreSpaces s == s := contract s not check s => error "Non-numeric value" sex := interpret(packageTran(ncParseFromString(s)$Lisp)$Lisp)$Lisp sCheck := car(car(sex)) if (sCheck=sexfloat) = true then f := (cdr cdr sex) pretend Float else if integer?(cdr sex) = true then f := (cdr sex) pretend Integer f::F else error "Non-numeric value" ScanFloatIgnoreSpacesIfCan s == s := contract s not check s => "failed" sex := interpret(packageTran(ncParseFromString(s)$Lisp)$Lisp)$Lisp sCheck := car(car(sex)) if (sCheck=sexfloat) = true then f := (cdr cdr sex) pretend Float else if integer?(cdr sex) = true then f := (cdr sex) pretend Integer f::F else "failed" units:V S := construct ["","I","II","III","IV","V","VI","VII","VIII","IX"] tens :V S := construct ["","X","XX","XXX","XL","L","LX","LXX","LXXX","XC"] hunds:V S := construct ["","C","CC","CCC","CD","D","DC","DCC","DCCC","CM"] umin := minIndex units tmin := minIndex tens hmin := minIndex hunds romval:V I := new(256, -1) romval ord char(" ")$C := 0 romval ord char("I")$C := 1 romval ord char("V")$C := 5 romval ord char("X")$C := 10 romval ord char("L")$C := 50 romval ord char("C")$C := 100 romval ord char("D")$C := 500 romval ord char("M")$C := 1000 thou:C := char "M" plen:C := char "(" pren:C := char ")" ichar:C := char "I" FormatArabic n == STRINGIMAGE(n)$Lisp ScanArabic s == PARSE_-INTEGER(s)$Lisp FormatRoman pn == n := pn::Integer -- Units d := (n rem 10) + umin n := n quo 10 s := units.d zero? n => s -- Tens d := (n rem 10) + tmin n := n quo 10 s := concat(tens.d, s) zero? n => s -- Hundreds d := (n rem 10) + hmin n := n quo 10 s := concat(hunds.d, s) zero? n => s -- Thousands d := n rem 10 n := n quo 10 s := concat(new(d::NonNegativeInteger, thou), s) zero? n => s -- Ten thousand and higher for i in 2.. while not zero? n repeat -- Coefficient of 10**(i+2) d := n rem 10 n := n quo 10 zero? d => "iterate" m0:String := concat(new(i,plen),concat("I",new(i,pren))) mm := concat([m0 for j in 1..d]$List(String)) -- strictly speaking the blank is gratuitous if #s > 0 then s := concat(" ", s) s := concat(mm, s) s -- ScanRoman -- -- The Algorithm: -- Read number from right to left. When the current -- numeral is lower in magnitude than the previous maximum -- then subtract otherwise add. -- Shift left and repeat until done. ScanRoman s == s := upperCase s tot: I := 0 Max: I := 0 i: I := maxIndex s while i >= minIndex s repeat -- Read a single roman digit c := s.i; i := i-1 n := romval ord c -- (I)=1000, ((I))=10000, (((I)))=100000, etc if n < 0 then c ~= pren => error ["Improper character in Roman numeral: ",c] nprens: PI := 1 while c = pren and i >= minIndex s repeat c := s.i; i := i-1 if c = pren then nprens := nprens+1 c ~= ichar => error "Improper Roman numeral: (x)" for k in 1..nprens while i >= minIndex s repeat c := s.i; i := i-1 c ~= plen => error "Improper Roman numeral: unbalanced ')'" n := 10**(nprens + 2) if n < Max then tot := tot - n else tot := tot + n Max := n tot < 0 => error ["Improper Roman numeral: ", tot] tot::PI @ \section{domain OUTFORM OutputForm} <>= import Void import Boolean import Integer import NonNegativeInteger import DoubleFloat import Symbol import String import List )abbrev domain OUTFORM OutputForm ++ Keywords: output, I/O, expression ++ SMW March/88 ++ Description: ++ This domain is used to create and manipulate mathematical expressions ++ for output. It is intended to provide an insulating layer between ++ the expression rendering software (e.g.FORTRAN, TeX, or Script) and ++ the output coercions in the various domains. OutputForm(): SetCategory with --% Printing print : % -> Void ++ print(u) prints the form u. message: String -> % ++ message(s) creates an form with no string quotes ++ from string s. messagePrint: String -> Void ++ messagePrint(s) prints s without string quotes. Note: ++ \spad{messagePrint(s)} is equivalent to \spad{print message(s)}. --% Creation of atomic forms outputForm: Integer -> % ++ outputForm(n) creates an form for integer n. outputForm: Symbol -> % ++ outputForm(s) creates an form for symbol s. outputForm: String -> % ++ outputForm(s) creates an form for string s. outputForm: DoubleFloat -> % ++ outputForm(sf) creates an form for small float sf. empty : () -> % ++ empty() creates an empty form. --% Sizings width: % -> Integer ++ width(f) returns the width of form f (an integer). height: % -> Integer ++ height(f) returns the height of form f (an integer). width: -> Integer ++ width() returns the width of the display area (an integer). height: -> Integer ++ height() returns the height of the display area (an integer). subHeight: % -> Integer ++ subHeight(f) returns the height of form f below the base line. superHeight: % -> Integer ++ superHeight(f) returns the height of form f above the base line. --% Space manipulations hspace: Integer -> % ++ hspace(n) creates white space of width n. vspace: Integer -> % ++ vspace(n) creates white space of height n. rspace: (Integer,Integer) -> % ++ rspace(n,m) creates rectangular white space, n wide by m high. --% Area adjustments left: (%,Integer) -> % ++ left(f,n) left-justifies form f within space of width n. right: (%,Integer) -> % ++ right(f,n) right-justifies form f within space of width n. center: (%,Integer) -> % ++ center(f,n) centers form f within space of width n. left: % -> % ++ left(f) left-justifies form f in total space. right: % -> % ++ right(f) right-justifies form f in total space. center: % -> % ++ center(f) centers form f in total space. --% Area manipulations hconcat: (%,%) -> % ++ hconcat(f,g) horizontally concatenate forms f and g. vconcat: (%,%) -> % ++ vconcat(f,g) vertically concatenates forms f and g. hconcat: List % -> % ++ hconcat(u) horizontally concatenates all forms in list u. vconcat: List % -> % ++ vconcat(u) vertically concatenates all forms in list u. --% Application formers prefix: (%, List %) -> % ++ prefix(f,l) creates a form depicting the n-ary prefix ++ application of f to a tuple of arguments given by list l. infix: (%, List %) -> % ++ infix(f,l) creates a form depicting the n-ary application ++ of infix operation f to a tuple of arguments l. infix: (%, %, %) -> % ++ infix(op, a, b) creates a form which prints as: a op b. postfix: (%, %) -> % ++ postfix(op, a) creates a form which prints as: a op. infix?: % -> Boolean ++ infix?(op) returns true if op is an infix operator, ++ and false otherwise. elt: (%, List %) -> % ++ elt(op,l) creates a form for application of op ++ to list of arguments l. --% Special forms string: % -> % ++ string(f) creates f with string quotes. label: (%, %) -> % ++ label(n,f) gives form f an equation label n. box: % -> % ++ box(f) encloses f in a box. matrix: List List % -> % ++ matrix(llf) makes llf (a list of lists of forms) into ++ a form which displays as a matrix. zag: (%, %) -> % ++ zag(f,g) creates a form for the continued fraction form for f over g. root: % -> % ++ root(f) creates a form for the square root of form f. root: (%, %) -> % ++ root(f,n) creates a form for the nth root of form f. over: (%, %) -> % ++ over(f,g) creates a form for the vertical fraction of f over g. slash: (%, %) -> % ++ slash(f,g) creates a form for the horizontal fraction of f over g. assign: (%, %) -> % ++ assign(f,g) creates a form for the assignment \spad{f := g}. rarrow: (%, %) -> % ++ rarrow(f,g) creates a form for the mapping \spad{f -> g}. differentiate: (%, NonNegativeInteger) -> % ++ differentiate(f,n) creates a form for the nth derivative of f, ++ e.g. \spad{f'}, \spad{f''}, \spad{f'''}, ++ "f super \spad{iv}". binomial: (%, %) -> % ++ binomial(n,m) creates a form for the binomial coefficient of n and m. --% Scripts sub: (%, %) -> % ++ sub(f,n) creates a form for f subscripted by n. super: (%, %) -> % ++ super(f,n) creates a form for f superscripted by n. presub: (%, %) -> % ++ presub(f,n) creates a form for f presubscripted by n. presuper:(%, %) -> % ++ presuper(f,n) creates a form for f presuperscripted by n. scripts: (%, List %) -> % ++ \spad{scripts(f, [sub, super, presuper, presub])} ++ creates a form for f with scripts on all 4 corners. supersub:(%, List %) -> % ++ supersub(a,[sub1,super1,sub2,super2,...]) ++ creates a form with each subscript aligned ++ under each superscript. --% Diacritical marks quote: % -> % ++ quote(f) creates the form f with a prefix quote. dot: % -> % ++ dot(f) creates the form with a one dot overhead. dot: (%, NonNegativeInteger) -> % ++ dot(f,n) creates the form f with n dots overhead. prime: % -> % ++ prime(f) creates the form f followed by a suffix prime (single quote). prime: (%, NonNegativeInteger) -> % ++ prime(f,n) creates the form f followed by n primes. overbar: % -> % ++ overbar(f) creates the form f with an overbar. overlabel: (%, %) -> % ++ overlabel(x,f) creates the form f with "x overbar" over the top. --% Plexes sum: (%) -> % ++ sum(expr) creates the form prefixing expr by a capital sigma. sum: (%, %) -> % ++ sum(expr,lowerlimit) creates the form prefixing expr by ++ a capital sigma with a lowerlimit. sum: (%, %, %) -> % ++ sum(expr,lowerlimit,upperlimit) creates the form prefixing expr by ++ a capital sigma with both a lowerlimit and upperlimit. prod: (%) -> % ++ prod(expr) creates the form prefixing expr by a capital pi. prod: (%, %) -> % ++ prod(expr,lowerlimit) creates the form prefixing expr by ++ a capital pi with a lowerlimit. prod: (%, %, %) -> % ++ prod(expr,lowerlimit,upperlimit) creates the form prefixing expr by ++ a capital pi with both a lowerlimit and upperlimit. int: (%) -> % ++ int(expr) creates the form prefixing expr with an integral sign. int: (%, %) -> % ++ int(expr,lowerlimit) creates the form prefixing expr by an ++ integral sign with a lowerlimit. int: (%, %, %) -> % ++ int(expr,lowerlimit,upperlimit) creates the form prefixing expr by ++ an integral sign with both a lowerlimit and upperlimit. --% Matchfix forms brace: % -> % ++ brace(f) creates the form enclosing f in braces (curly brackets). brace: List % -> % ++ brace(lf) creates the form separating the elements of lf ++ by commas and encloses the result in curly brackets. bracket: % -> % ++ bracket(f) creates the form enclosing f in square brackets. bracket: List % -> % ++ bracket(lf) creates the form separating the elements of lf ++ by commas and encloses the result in square brackets. paren: % -> % ++ paren(f) creates the form enclosing f in parentheses. paren: List % -> % ++ paren(lf) creates the form separating the elements of lf ++ by commas and encloses the result in parentheses. --% Separators for aggregates pile: List % -> % ++ pile(l) creates the form consisting of the elements of l which ++ displays as a pile, i.e. the elements begin on a new line and ++ are indented right to the same margin. commaSeparate: List % -> % ++ commaSeparate(l) creates the form separating the elements of l ++ by commas. semicolonSeparate: List % -> % ++ semicolonSeparate(l) creates the form separating the elements of l ++ by semicolons. blankSeparate: List % -> % ++ blankSeparate(l) creates the form separating the elements of l ++ by blanks. --% Specific applications "=": (%, %) -> % ++ f = g creates the equivalent infix form. "~=": (%, %) -> % ++ f ~= g creates the equivalent infix form. "<": (%, %) -> % ++ f < g creates the equivalent infix form. ">": (%, %) -> % ++ f > g creates the equivalent infix form. "<=": (%, %) -> % ++ f <= g creates the equivalent infix form. ">=": (%, %) -> % ++ f >= g creates the equivalent infix form. "+": (%, %) -> % ++ f + g creates the equivalent infix form. "-": (%, %) -> % ++ f - g creates the equivalent infix form. "-": (%) -> % ++ - f creates the equivalent prefix form. "*": (%, %) -> % ++ f * g creates the equivalent infix form. "/": (%, %) -> % ++ f / g creates the equivalent infix form. "**": (%, %) -> % ++ f ** g creates the equivalent infix form. "div": (%, %) -> % ++ f div g creates the equivalent infix form. "rem": (%, %) -> % ++ f rem g creates the equivalent infix form. "quo": (%, %) -> % ++ f quo g creates the equivalent infix form. "exquo": (%, %) -> % ++ exquo(f,g) creates the equivalent infix form. "and": (%, %) -> % ++ f and g creates the equivalent infix form. "or": (%, %) -> % ++ f or g creates the equivalent infix form. "not": (%) -> % ++ not f creates the equivalent prefix form. SEGMENT: (%,%) -> % ++ SEGMENT(x,y) creates the infix form: \spad{x..y}. SEGMENT: (%) -> % ++ SEGMENT(x) creates the prefix form: \spad{x..}. == add import NumberFormats -- Todo: -- program forms, greek letters -- infix, prefix, postfix, matchfix support in OUT BOOT -- labove rabove, corresponding overs. -- better super script, overmark, undermark -- bug in product, paren blankSeparate [] -- uniformize integrals, products, etc as plexes. cons ==> CONS$Lisp car ==> CAR$Lisp cdr ==> CDR$Lisp a, b: % l: List % s: String e: Symbol n: Integer nn:NonNegativeInteger sform(s: String): % == s pretend % eform(e: Symbol): % == e pretend % iform(i: Integer): % == i pretend % bless(x: List %): % == x pretend % print x == mathprint(x)$Lisp message s == (empty? s => empty(); s pretend %) messagePrint s == print message s (a:% = b:%): Boolean == EQUAL(a, b)$Lisp (a:% = b:%):% == bless [sform "=", a, b] coerce(a):OutputForm == a pretend OutputForm outputForm n == n pretend % outputForm e == e pretend % outputForm(f:DoubleFloat) == f pretend % outputForm s == sform concat(quote()$Character, concat(s, quote()$Character)) width(a) == outformWidth(a)$Lisp height(a) == height(a)$Lisp subHeight(a) == subspan(a)$Lisp superHeight(a) == superspan(a)$Lisp height() == 20 width() == 66 center(a,w) == hconcat(hspace((w - width(a)) quo 2),a) left(a,w) == hconcat(a,hspace((w - width(a)))) right(a,w) == hconcat(hspace(w - width(a)),a) center(a) == center(a,width()) left(a) == left(a,width()) right(a) == right(a,width()) vspace(n) == n = 0 => empty() vconcat(sform " ",vspace(n - 1)) hspace(n) == n = 0 => empty() sform(fillerSpaces(n)$Lisp) rspace(n, m) == n = 0 or m = 0 => empty() vconcat(hspace n, rspace(n, m - 1)) matrix ll == lv := bless [LIST2VEC$Lisp l for l in ll] CONS(eform MATRIX, LIST2VEC$Lisp lv)$Lisp pile l == cons(eform SC, l) commaSeparate l == cons(eform AGGLST, l) semicolonSeparate l == cons(eform AGGSET, l) blankSeparate l == c:=eform CONCATB l1: List % :=[] for u in reverse l repeat if EQCAR(u,c)$Lisp then l1:=[:cdr u,:l1] else l1:=[u,:l1] cons(c, l1) brace a == bless [eform BRACE, a] brace l == brace commaSeparate l bracket a == bless [eform BRACKET, a] bracket l == bracket commaSeparate l paren a == bless [eform PAREN, a] paren l == paren commaSeparate l sub (a,b) == bless [eform SUB, a, b] super (a, b) == bless [eform SUPERSUB,a,sform " ",b] presub(a,b) == bless [eform SUPERSUB,a,sform " ",sform " ",sform " ",b] presuper(a, b) == bless [eform SUPERSUB,a,sform " ",sform " ",b] scripts (a, l) == null l => a null rest l => sub(a, first l) cons(eform SUPERSUB, cons(a, l)) supersub(a, l) == if odd?(#l) then l := append(l, [empty()]) cons(eform ALTSUPERSUB, cons(a, l)) hconcat(a,b) == bless [eform CONCAT, a, b] hconcat l == cons(eform CONCAT, l) vconcat(a,b) == bless [eform VCONCAT, a, b] vconcat l == cons(eform VCONCAT, l) (a:% ~= b:%): % == bless [sform "~=", a, b] a < b == bless [sform "<", a, b] a > b == bless [sform ">", a, b] a <= b == bless [sform "<=", a, b] a >= b == bless [sform ">=", a, b] a + b == bless [sform "+", a, b] a - b == bless [sform "-", a, b] - a == bless [sform "-", a] a * b == bless [sform "*", a, b] a / b == bless [sform "/", a, b] a ** b == bless [sform "**", a, b] a div b == bless [sform "div", a, b] a rem b == bless [sform "rem", a, b] a quo b == bless [sform "quo", a, b] a exquo b == bless [sform "exquo", a, b] a and b == bless [sform "and", a, b] a or b == bless [sform "or", a, b] not a == bless [sform "not", a] SEGMENT(a,b)== bless [eform SEGMENT, a, b] SEGMENT(a) == bless [eform SEGMENT, a] binomial(a,b)== bless [eform BINOMIAL, a, b] empty() == bless [eform NOTHING] infix? a == e:$ := IDENTP$Lisp a => a STRINGP$Lisp a => INTERN$Lisp a return false if GET(e,QUOTE(INFIXOP$Lisp)$Lisp)$Lisp then true else false elt(a, l) == cons(a, l) prefix(a,l) == not infix? a => cons(a, l) hconcat(a, paren commaSeparate l) infix(a, l) == null l => empty() null rest l => first l infix? a => cons(a, l) hconcat [first l, a, infix(a, rest l)] infix(a,b,c) == infix? a => bless [a, b, c] hconcat [b, a, c] postfix(a, b) == hconcat(b, a) string a == bless [eform STRING, a] quote a == bless [eform QUOTE, a] overbar a == bless [eform OVERBAR, a] dot a == super(a, sform ".") prime a == super(a, sform ",") dot(a,nn) == (s := new(nn, char "."); super(a, sform s)) prime(a,nn) == (s := new(nn, char ","); super(a, sform s)) overlabel(a,b) == bless [eform OVERLABEL, a, b] box a == bless [eform BOX, a] zag(a,b) == bless [eform ZAG, a, b] root a == bless [eform ROOT, a] root(a,b) == bless [eform ROOT, a, b] over(a,b) == bless [eform OVER, a, b] slash(a,b) == bless [eform SLASH, a, b] assign(a,b)== bless [eform LET, a, b] label(a,b) == bless [eform EQUATNUM, a, b] rarrow(a,b)== bless [eform TAG, a, b] differentiate(a, nn)== zero? nn => a nn < 4 => prime(a, nn) r := FormatRoman(nn::PositiveInteger) s := lowerCase(r::String) super(a, paren sform s) sum(a) == bless [eform SIGMA, empty(), a] sum(a,b) == bless [eform SIGMA, b, a] sum(a,b,c) == bless [eform SIGMA2, b, c, a] prod(a) == bless [eform PI, empty(), a] prod(a,b) == bless [eform PI, b, a] prod(a,b,c)== bless [eform PI2, b, c, a] int(a) == bless [eform INTSIGN,empty(), empty(), a] int(a,b) == bless [eform INTSIGN,b, empty(), a] int(a,b,c) == bless [eform INTSIGN,b, c, a] @ \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}