\ \\\\\\\\\\\\\ start of VULGAR.FTH \\\\\\\\\\\\\\\\ CR .( Vulgar Maths Words. Version FSL1.1 23rd April 1996) CR .( Gordon Charlton - gordon@charlton.demon.co.uk) CR CR \ Forth Scientific Library Algorithm #46 \ (c) Copyright 1996 Gordon R Charlton. Permission is granted by \ the author to use this software for any application provided this \ copyright notice is preserved. \ \ ANS Forth Program with environmental dependancies. \ \ Requiring the Double-Number word set (namely 2CONSTANT 2LITERAL D+ D- D0= D>S \ D< D= DABS DNEGATE and M+). \ \ Requiring the Floating-Point wordset (namely D>F F* F- F/ F>D FDUP FLITERAL \ FLOOR FOVER and FSWAP). \ \ Requiring the String word set (namely /STRING). \ \ Requiring 0<> <> ?DO 2>R 2R> FALSE MARKER NIP PICK TO TRUE TUCK VALUE \ \ from the Core Extensions word set. \ \ Requiring DU< from the Double-Number Extensions word set. \ \ Requiring CS-ROLL from the Programming-Tools Extensions word set. \ \ With an environmental dependancy on two's complement arithmetic. \ \ With an environmental dependancy that the largest usable signed double \ number be within the range of usable floating point numbers if this is \ available from ENVIRONMENT? or that 2147483647 be within the range of \ usable floating numbers if it is not. \ \ A Standard System exists after the program is loaded. \ ----- Description ----- \ This word set provides the basic arithmetic, logical, type conversion and \ numerical output routines necessary for handling rational numbers. \ Throughout the suite the data type "rational number" is referred to by the \ popular name, "vulgar" as the use of the prefix V to indicate a vulgar \ is less ambiguous than the prefix R, which may be confused with Real, by \ which name Floating Point numbers are sometimes known. \ In this implementation vulgars are represented by two integers, which \ are held on the data stack in the order Numerator Denominator. The numerator \ and denominator are always relatively prime. \ The numerator is a signed integer, and the denominator a non-negative \ integer. \ Numbers to large to be represented are indicated by the special value 0 0, \ which will propagate through a program. Most words in this suite are tolerant \ of the overflow indicator, with the exception of those that convert vulgar \ numbers to other numerical data types. These are flagged in the listing. In \ general programming techniques which depend on the propogation of overflow \ errors are discouraged by the author. \ Zero is represented by the vulgar number 0 1. \ Numbers which cannot be represented exactly are rounded by a mediant \ rounding scheme as described in The Art of Compuer Programming by D E Knuth. \ (Volume 2, Seminumerical Algorithms 2nd Edition (1981, Addison Wesley), \ 4.5.3 Analysis of Euclids Algorithm, page 363, exercise 40) which has been \ shown to generate best possible approximations. (A less rigorous but more \ accessible description may be found in the hobbyist book "Recreactions in \ the Theory of Numbers" by A H Beiler, Dover Publications Ltd, 1966.) \ ----- Rational Representations ----- \ The range and distribution of rational numbers will vary according to the \ stack width of a Forth system. In a 16bit system, considering positive \ numbers only (the same arguments are applicable to negative numbers), the \ largest representable number is 32767, and the smallest 1/32767. \ Approximately 654,942,536 different positive numbers can be represented. \ (This is calculated using the rule of thumb estimate 32767*32767*0.61, \ (number of different integer pairs * approximate probability that they are \ relatively prime). Knuth, Seminumerical Algorithms 4.5.2 Theorum D, p 324.) \ \ However these are not evenly distributed. Half lie in the range 01) the difference between successive representable numbers \ increases as the absolute value of the fraction increases (eg above 16384 \ only integers are representable without overflow). \ \ For this reason, the word vsplit is provided, which separates the fractional \ and the integral component of a vulgar fraction. If the loss of precision \ associated with large numbers is not acceptable vsplit can be used to deal \ with the fractional component separately, thus maintaining absolute precision. \ On the subject of accuracy and precision is is worth noting that rational \ representations are capable of maintaining total accuracy with simple \ fractions, such as one third, which cannot be precisely represented in a \ floating point representation. Knuth, amongst others, contends that \ arithmetic using a rational representation and mediant rounding is not \ subject to cumulative rounding errors, as it "tends to make the intermediate \ rounding errors cancel out" (Seminumerical algorithms, 4.5.1 Fractions, page \ 315). \ ----- Key Words ----- \ This is a brief description of a selection of the words provided. \ The letter v in a stack comment indicates a vulgar number as described \ above. More detailed descriptions are embedded within the code. \ v+ ( v1 v2--v3) v3 is the sum of v1 and v2. \ v* ( v1 v2--v3) v3 is the product of v1 and v2. \ v- ( v1 v2--v3) v3 is v1 minus v2. \ v/ ( v1 v2--v3) v3 is v1 divided by v2. \ vnegate ( v1--v2) v2 is the product of v1 and -1. \ vreciprocal ( v1--v2) v2 is 1 divided by v1 v2 is the absolute value of v1. \ v0< ( v--f) f is TRUE if v is negative. \ v0= ( v--f) f is TRUE if v is zero. \ v= ( v1 v2--f) f is TRUE if v1 is exactly equal to v2. \ v~ ( v1 v2--f) f is TRUE if v1 is approximately equal to v2. \ v< ( v1 v2--f) f is TRUE if v1 is less than v2. \ v> ( v1 v2--f) f is TRUE if v1 is greater than v2. \ vmax ( v1 v2--v3) v3 is the larger of v1 and v2. \ vmin ( v1 v2--v3) v3 is the smaller of v1 and v2. \ voverflow ( v--f) f is TRUE if v is the special vulgar indicating \ that overflow has occurred in an earlier calculation. \ s>v ( n--v) v is the vulgar equivalent of the signed integer n. \ v>s ( v--n) n is the integral component of v as a signed integer \ Rounding is floored (ie to negative infinity). \ f>v ( r--v) v is a vulgar approximation to the floating point \ or ( --v) (F: r) number r \ v>f ( v--r) r is a floating point approximation to the vulgar \ or ( v) (F: --r) number v \ str>v ( addr n1 n2--v) v is an approximation of the number represented by \ the string of length n1 that starts at the address \ addr when interpreted in base n2. The string may have \ a leading minus sign and an embedded point. \ vfrac ( v1--v2 ) v2 is the fractional component of v1. v2 is non- \ negative \ vsplit (v1--v2 v3) v2 is the integral component of v1 rounded as above \ v3 is the non-negative fractional component. \ vulgar ( "number"--v) v is an approximation to the number represented by \ the space delimited character string following in \ the input stream. The string is as per str>v, the \ global variable BASE determines the base. \ [vulgar] ( "number") Embeds the following space delimited string as a \ vulgar literal within a colon definition. Compiling \ version of "vulgar" (above). \ vround ( v1 +n--v2) v2 is an approximation to v1 such that neither the \ absolute value of the numerator nor the denominator \ exceeds +n. \ vsimplify ( v1 +n--v2) v2 is an approximation to v1 such that neither the \ numerator nor the denominator of the fractional \ component of v1 exceeds +n. \ places (-- n) n is the maximum number of digits after the point \ that will be displayed when a vulgar is displayed in \ floating point format. \ set-places ( n) n specifies the maximum number of digits after the \ point that will be displayed when a vulgar is \ displayed in floating point format. \ truncation ( --f) f is TRUE if trailing zeroes will be suppressed when \ a vulgar is displayed in floating point format. \ set-truncation ( f) f specifies whether trailing zeroes will be suppressed \ when a vulgar is displayed in floating point format. \ TRUE turns suppression on, FALSE turns it off. \ v.fj ( v n1 n2) display v in floating point format, justified to the \ left and right with spaces so that there are n1 \ characters to the left of the point, and n2 characters \ to the right. No trailing zeroes. Display "Overflow" \ if v is the overflow indicator. \ v.f ( v) display v in floating point format with no \ justification and one trailing space. Display \ "Overflow" if v is the overflow indicator. \ digits ( n) n is the maximum number of digits that will be \ displayed in the numerator or denominator of the \ fractional part when a number is displayed in vulgar \ format. \ set-digits ( --n) n specifies the maximum number of digits that will be \ displayed in the numerator or denominator of the \ fractional part when a number is displayed in vulgar \ format. \ v.j ( v n1 n2) display v in vulgar format, justified to the left and \ with spaces so that there are n1 characters to the \ left of the space between the space between the \ integeral and fractional components, and n2 \ characters to the right. Display "Overflow" if v is \ the overflow indicator. \ v. ( v) display v in vulgar format with no justification and \ one trailing space. Display "Overflow" if v is the \ overflow indicator. \ ----- Source Code ----- \ Non-standard Core Extensions : 4dup ( a b c d--a b c d a b c d) 2OVER 2OVER ; \ \ Copy top four items on stack. : not ( f--f) 0= ; \ \ could be defined as 0= or INVERT, as is only used on normalised booleans \ in this code. : ?negate ( n f-- -n) IF NEGATE THEN ; \ \ n is negated if f is true. : mu* ( ud1 u--ud2) TUCK * >R UM* R> + ; \ \ multiply unsigned double by unsigned single, giving unsigned double result. : um/ ( ud u--u) UM/MOD NIP ; \ \ divide unsigned double by unsigned single, giving unsigned single result. : mu/ ( ud u--ud) >R 0 R@ UM/MOD R> SWAP >R um/ R> ; \ \ divide unsigned double by unsigned single, giving unsigned double result. : um*/ ( u1 u2 u3--ud) >R UM* R> mu/ ; \ \ multiply unsigned single u1 by unsigned single u2, then divide by unsigned \ single u3, giving unsigned double result. : um** ( u1 u2--ud) 1. ROT 0 ?DO 2 PICK mu* LOOP ROT DROP ; \ \ raise unsigned single u1 to the power specified by unsigned single u2, \ giving unsigned double result. 0 1 2 um/ CONSTANT highbit \ \ this is a bitmask which, in a twos complement system, is the largest \ representable signed single (in 16bit = 8000 hex or -8000 hex). : DONE ( compilation: dest orig1--orig2 dest) ( run-time: --) POSTPONE ELSE 1 CS-ROLL ; IMMEDIATE \ \ control flow word. Used in conjunction with IF to force an untimely exit \ from a structure started with BEGIN eg; \ \ BEGIN ... ( f) IF ... ( this code executed on exit) DONE \ ... ( otherwise loop continues) \ AGAIN THEN ( DONE forces branch to nearest unresolved THEN after AGAIN ) \ ( or UNTIL. WHILE is treated as AGAIN THEN ) CHAR . VALUE point \ for portablility. In environments where the decimal point is not a period \ this can be changed after a program using it is loaded. E.g. in Europe one \ might issue "CHAR , TO point". \ Non-standard Double Extensions : d0<> ( d--f) D0= not ; \ \ returns TRUE if double number d is non-zero. : ud* ( ud ud--ud) DUP IF 2SWAP THEN DROP mu* ; \ \ multiply unsigned double by unsigned double, giving double result. : d* ( d d--d) DUP 0< >R DABS 2SWAP DUP 0< >R DABS ud* R> R> XOR IF DNEGATE THEN ; \ \ multiply signed double by signed double, giving signed double result. : ut* ( ud u--ut) TUCK UM* 2SWAP UM* SWAP >R 0 D+ R> ROT ROT ; \ \ multiply unsigned double by unsigned single, giving unsigned triple \ result. : ut/ ( ut u--ud) DUP >R UM/MOD ROT ROT R> UM/MOD NIP SWAP ; \ \ divide unsigned triple by unsigned single, ugiving unsigned double \ result. : mu*/ ( ud1 u1 u2--ud2) >R ut* R> ut/ ; \ \ Multiply ud1 by u1 producing the triple-cell intermediate result t. \ Divide t by u2 giving quotient ud2. : +d/ ( +d1 +d2--+d3) ?DUP IF DUP 1+ 0 1 ROT um/ DUP >R mu* >R OVER SWAP R@ um*/ D- 2R> mu*/ NIP 0 ELSE mu/ THEN ; \ divide non-negative double +d1 by strictly positive double +d2, \ giving double quotient d3. \ \ The algorithm is described in "Long Divisors and Short Fractions \ by Prof. Nathaniel Grossman, in Forth Dimensions Volume VI No. 3. \ \ Grossman cites Abramowitz M and I A Stegun, Handbook of Mathematical \ Functions, National Bureau of Standards Applied Mathematics Series, 55. \ (Reprinted by Dover Publications) page 21 and Knuth, Seminumerical Algorithms \ as his references. : +d/mod ( +d1 +d2--+d3 +d4) 4dup +d/ 2DUP 2>R ud* D- 2R> ; \ \ divide non-negative double +d1 by strictly positive double +d2, \ giving double remainder d3 and double quotient d4. : >double ( addr n1--d n2 true|false) DUP IF OVER C@ [CHAR] - = DUP >R IF 1 /STRING THEN 0. 2SWAP >NUMBER OVER C@ point = OVER AND IF 1 /STRING THEN DUP >R >NUMBER IF 2R> 2DROP 2DROP DROP FALSE ELSE DROP 2R> >R IF DNEGATE THEN R> TRUE THEN ELSE 2DROP 0. 0 TRUE THEN ; \ \ translate string at addr of length n to double number d in the current base \ If string starts with - then d is negative. One embedded point is allowed. If \ present then n2 is equal to the position of the point in the string. If no \ point is present then dpl is equal to n1. TRUE indicates that conversion was \ successful. FALSE indicates that an illegal character was present in the \ string. If FALSE is returned d and dpl are not present on the stack. A null \ string is interpreted as zero. (As are the strings "." "-" and ".-".) \ Non-Standard String Extensions : >ch ( addr n1 ch--n2) OVER SWAP 2SWAP 0 ?DO 2DUP C@ = IF ROT DROP I ROT ROT LEAVE THEN CHAR+ LOOP 2DROP ; \ \ search string at addr of length n1 for character ch. If it is present then \ n2 is the position of the first occurance of ch in the string. If it is not \ present then n2 is equal to n1. : hasch ( addr n ch--f) OVER >R >ch R> <> ; \ \ f is TRUE if character ch is present in the string of length n that starts at \ address addr. \ Vulgar Simplification : gcd ( n n--n) ABS SWAP ABS BEGIN DUP WHILE TUCK MOD REPEAT DROP ; \ \ returns the single greatest common denominator of the absolute value \ of two signed single numbers. If either number is zero, returns the absolute \ value of the other number. Uses Euclids Algorithm. : normal ( v--v) 2DUP gcd TUCK / >R / R> ; \ \ normalises a vulgar by ensuring the numerator and denominator are relatively \ prime. : ud>+n? ( ud--+n f) OVER highbit AND OR 0<> ; \ \ converts unsigned double ud to non-negative single +n. f is TRUE if the \ conversion was not successful. VARIABLE numerator \ private to the vulgar approximation routines. VARIABLE prev.numerator \ private to the vulgar approximation routines. VARIABLE denominator \ private to the vulgar approximation routines. VARIABLE prev.denominator \ private to the vulgar approximation routines. : setvars ( ) 0 numerator ! 1 prev.numerator ! 1 denominator ! 0 prev.denominator ! ; \ \ the first approximation to a vulgar number is 1. Approximations are held \ in the variables numerator and denominator. The "zeroth" approximation \ is the overflow condition, which is represented by the vulgar 0 1. (This \ will be adjusted to 0 0 on exit from the approximation routine.) \ \ When a new approximation is generated the previous one \ is stashed in the variables prev.numerator and prev.demoninator. \ \ setvars initialises these prior to generating approximations. : num>? ( ud--u f) numerator @ mu* prev.numerator @ 0 D+ ud>+n? ; \ \ the next approximation to the numerator u is the current approximation \ multiplied by ud, which is the next number in the continued fraction of \ the vulgar being approximated, plus the previous approximation. \ flag is true if the next approximation cannot be represented as a non- \ negative single integer (ie the approximation is as good as it can get). : den>? ( ud--u f) denominator @ mu* prev.denominator @ 0 D+ ud>+n? ; \ \ the next approximation to the denominator u, is the current approximation \ multiplied by ud, which is the next number in the continued fraction of \ the vulgar being approximated, plus the previous approximation. \ flag is true if the next approximation cannot be represented as a non- \ negative single integer (ie the approximation is as good as it can get). : next! ( +v) denominator @ prev.denominator ! denominator ! numerator @ prev.numerator ! numerator ! ; \ \ make the new approximation the current approximation, and the current \ approximation the previous approxinmation. : dv>udv? ( dv--+dv f) 2SWAP DUP 0< >R DABS 2SWAP R> ; \ \ return the absolute value a signed double vulgar. f is true if the argument \ was negative. A double vulgar is represented on the stack as dnumerator \ +ddenominator, where the sign is held in the numerator as per single vulgars : reduce ( dv--v) setvars dv>udv? >R BEGIN 2DUP d0<> WHILE 2OVER 2DUP d0<> IF +d/mod THEN 2DUP num>? IF next! DROP DONE ROT ROT den>? IF next! DONE next! 2SWAP REPEAT THEN THEN 2DROP 2DROP prev.numerator @ R> ?negate prev.denominator @ ; \ \ return the normalised vulgar which most closely approximates the signed \ double vulgar passed to it. Returns 1 0 if the double vulgar was too large \ and positive to be represented or -1 0 if too large and negative. Numbers \ too small to be represented are rounded to zero (0 1). \ \ Works by generating approximations from successive numbers in the continued \ fraction expansion of dv, until no more numbers are available, or overflow \ occurs. \ \ The first number in the continued fraction expansion is the integral \ component and the next the integral component of the reciprocal of the \ fractional component and so on. This is best demonstrated with a pocket \ calculator. Pi is 3.14159... so the continued fraction starts with 3 (the \ integral component. The reciprocal of the fractional component (0.14159..) \ is 7.06251..., so the next number in the expansion is 7. The reciprocal of \ 0.06251 is 15.99659..) so the next number is 15 and so on. \ \ The continued fraction of any rational number terminates when the fractional \ component becomes zero. : small? ( dv--f) highbit 0 DU< >R DABS highbit 0 DU< R> AND ; \ \ returns TRUE if double vulgar dv can be normalised by "normal", rather than \ the slower "reduce". : dv>v ( dv--v) 4dup small? IF DROP NIP normal ELSE reduce THEN DUP 0= IF NIP 0 THEN ; \ \ returns the vulgar that most closely approximates the unnormalised double \ vulgar dv. If overflow is detected (denominator is zero) action is taken to \ ensure the overflow indicator 0 0 is returned. \ Vulgar Arithmetic : v+ ( v v--v) ROT 2DUP UM* 2>R ROT M* 2SWAP M* D+ 2R> dv>v ; \ \ add two vulgars using naive algorithm, generating double length result, then \ round to single. Empirical tests showed that on the development system the \ naive method was a little faster than the method recommended by Knuth \ (Seminumerical algorithms 4.5.1 Fractions). : v* ( v v--v) ROT UM* 2SWAP M* 2SWAP dv>v ; \ \ multiply two vulgars using naive algorithm, generating double length result, \ then round to single. Empirical tests show that on the development system \ the naive method was a little faster than the method recommended by Knuth \ (seminumerical algorithms 4.5.1 Fractions). : vnegate ( v--v) SWAP NEGATE SWAP ; \ \ return vulgar * -1. The sign bit is in the numerator. : vreciprocal ( v--v) SWAP DUP 0< IF ABS vnegate THEN ; \ \ the reciprocal of a vulgar is trivial (SWAP). The sign bit needs moving \ back to the numerator. : v- ( v1 v2--v3) vnegate v+ ; \ \ subract vulgar v2 from vulgar v1 giving vulgar result. : v/ ( v1 v2--v3) vreciprocal v* ; \ \ divide vulgar v2 by vulgar v1 giving vulgar result. : vabs ( v--v) SWAP ABS SWAP ; \ \ return absolute value of vulgar argument. \ Vulgar Comparison : v0< ( v--f) DROP 0< ; \ \ flag is TRUE if vulgar v is negative. : v0= ( v--f) 0 1 D= ; \ \ flag is true if vulgar v is zero. : v= ( v v--f) D= ; \ \ flag is true if the two vulgar arguments are equal. This test is trivial \ as vulgars are kept in normalised form. : v~ ( v v--f) v- v0= ; \ \ f is TRUE if the two vulgar arguments are approximately equal \ \ The difference between two vulgars may be less than the smallest vulgar that \ is representable with a single length denominator. In this instance the two \ vulgars may be reasonably described as approximately equal. Note that two \ overflow indicators are equal, but are not approximately equal! : v< ( v1 v2--f) ROT ROT M* 2SWAP M* 2SWAP D< ; \ \ f is TRUE if vulgar v1 is less than vulgar v2. Returns FALSE if either \ argument is the overflow condition. \ \ It is not possible to determine if one vulgar is larger than another by \ subtracting one from another and examining the sign of the difference, as \ they may be approximately equal, so the difference would be rounded to zero. \ This avoids that problem and is faster. See Knuth, Seminumerical Algorithms \ 4.5 Rational Arithmetic, Exercise 1. : v> ( v1 v2--f) 2SWAP v< ; \ \ f is TRUE if vulgar v1 is greater than vulgar v2. Returns FALSE if either \ argument is the overflow condition. : voverflow ( v--f) D0= ; \ \ f is TRUE if vulgar v indicates overflow has occurred previously. \ \ This word should be used where overflow is possible. (Although propagation \ of overflow is possible, the author does not endorse it.) : vmax ( v1 v2--v3) 2DUP voverflow >R 4DUP v< R> OR IF 2SWAP THEN 2DROP ; \ \ returns the larger of the two vulgar arguments. Will always return the \ overflow condition, if present. : vmin ( v1 v2--v3) 2DUP voverflow >R 4DUP v> R> OR IF 2SWAP THEN 2DROP ; \ \ returns the smaller of the two vulgar arguments. Will always return the \ overflow condition, if present. \ Vulgar Conversion 1 CONSTANT s>v ( n--v) \ \ promote single integer to vulgar equivalent. n --> n 1 : v>s ( v--n) >R S>D R> FM/MOD NIP ; \ \ return the integral component of vulgar v as a signed integer. \ \ Floored rounding (to negative infinity) is used as other parts of the \ suite require it. \ \ ***** This word may be intolerant of overflow on some systems. ***** : str>v ( addr n1 n2--v) >R >double not ABORT" Non-numerical string" R> SWAP um** dv>v ; \ \ convert character string at addr of length n1 to vulgar v using n2 as the \ radix (base). The string should conform with the description in >double. : vfrac ( v1--v2) DUP IF TUCK >R S>D R> FM/MOD DROP SWAP THEN ; \ \ return the fractional component of vulgar v1 as non-negative vulgar v2. \ \ Floored rounding (to negative infinity) is used as other parts of the \ suite require it. This ensures v2 is positive. The test for non-zero \ ensures this word is tolerant of the overflow condition. : vsplit ( v1--v2 v3) 2DUP DUP IF v>s s>v THEN 2SWAP vfrac ; \ \ return the integral component of vulgar v1 as vulgar v2 and the fractional \ component as non-negative vulgar v2. \ \ Floored rounding (to negative infinity) is used as other parts of the \ suite require it. The test for non-zero ensures this word is tolerant of the \ overflow condition. \ : v>f ( v--r or: ( v) ( F: --r) >R S>D D>F R> S>D D>F F/ ; \ \ convert vulgar v to floating point number r. v should be within the range \ of representable floating point numbers. \ \ ***** This word may be intolerant of overflow on some systems. ***** MARKER discard : get-dbig S" MAX-D" ENVIRONMENT? not IF 2147483647. THEN ; get-dbig discard 2CONSTANT dbig \ \ The 2constant dbig represents the largest usable positive double number. \ If, on a given system, this is larger than 2,147,483,647 but not known by \ ENVIRONMENT? the source should be edited to show the correct value. The \ number dbig should be representable as a floating point number. \ \ get-dbig is discarded after use as it is not required beyond this point. \ : f>v ( r--v or: ( --v) ( F: r) FDUP FLOOR FSWAP FOVER F- \ [ dbig D>F ] FLITERAL F* \ F>D dbig dv>v 2>R \ F>D D>S s>v 2R> v+ ; \ \ convert floating point number r to vulgar v. r should be in the range of \ representable vulgars. \ \ The method used here was chosen for minimal impact on environmental \ dependancies. On some systems it may not give the best possible \ approximations. Where the internal structure of a floating point number is \ known (this should be described in the documentation accompanying a standard \ system) there may be some benefit to reading the exponent and mantissa \ directly and generating an approximation from that using a method broadly \ equivalent to that used in str>v, (above). If the internal representation is \ not available, or is inappropriate, there may be some benefit to converting \ the internal representation to IEEE 64bit, using DF! in the Floating-Point \ Numbers Extensions word set, and reading that directly. It is most likely \ that only very unusual systems will have recourse to these techniques. \ Vulgar Literals : vulgar ( "number"--v) BL WORD COUNT BASE @ str>v ; \ \ translate the space delimited character string following vulgar in the input \ stream into a vulgar using the current value of BASE as the radix. ie, \ assuming DECIMAL ; \ \ vulgar 3.14159265 2CONSTANT pi \ \ \ pi will return 355 133 (in a 16bit system) which has an error \ \ of 8.5 * 10^-8 \ \ See Starting Forth by Leo Brodie (2nd edition 1987 Prentice Hall) page 102 \ et seq. for a discussion of the use of rational approximations in Forth \ outside of this suite. : [vulgar] ( compilation: "number"--) ( run-time: --v) vulgar POSTPONE 2LITERAL ; IMMEDIATE \ \ during compilation translate the space delimited character string following \ [vulgar] in the input stream into a vulgar using the current value of BASE \ as the radix and compile into the definition as a literal. ie, assuming \ DECIMAL ; \ \ : CIRCUMFERENCE ( n1--n2) [vulgar] 3.14159265 */ ; \ \ \ given the diameter of a circle n1, return the circumference n2. \ Vulgar Rounding : v>uv? ( v--uv f) 2DUP vabs 2SWAP v0< ; \ \ uv is the absolute value of the vulgar v, f is TRUE if v was negative. : snum>? ( u1 u2--u3 f) >R numerator @ * prev.numerator @ + DUP R> U> ; \ \ the next approximation to the numerator u3, is the current approximation \ multiplied by u1, which is the next number in the continued fraction of \ the vulgar being approximated, plus the previous approximation. flag is true \ if the next approximation is greater than u2. \ \ There is no need for double length results here, as the vulgar being \ approximated is single length, so an approximation cannot generate an \ overflow. : sden>? ( u1 u2--u3 f) >R denominator @ * prev.denominator @ + DUP R> U> ; \ \ the next approximation to the denominator u3, is the current approximation \ multiplied by u1, which is the next number in the continued fraction of \ the vulgar being approximated, plus the previous approximation. flag is true \ if the next approximation is greater than u2. \ \ There is no need for double length results here, as the vulgar being \ approximated is single length, so an approximation cannot generate an \ overflow. : vround ( v1 +n--v2) >R 2DUP voverflow IF R> DROP ELSE setvars v>uv? R> 2>R BEGIN DUP WHILE OVER DUP IF /MOD THEN DUP R@ snum>? IF next! DONE SWAP R@ sden>? IF next! DONE next! SWAP REPEAT THEN THEN 2DROP R> DROP prev.numerator @ R> ?negate prev.denominator @ THEN ; \ \ returns an approximation to the vulgar number v1 such that neither the \ numerator nor the denominator exceeds the positive integer n. \ This is the same algorithm as "reduce" (above), restricted to a single length \ argument and thus avoiding the inefficiencies of the double length maths. \ The intent is that, where high precision is not an issue, vround can be \ inserted at key points in the code to ensure the quicker "normalise" path is \ taken in subsequent words that call DV>V : vsimplify ( v1 +n--v2) >R vsplit R> vround v+ ; \ \ returns an approximation to the vulgar number v1 such that neither the \ numerator nor the denominator of the fractional component of v1 exceeds the \ positive integer n. \ \ This word is intended primarily for use in the vulgar output routines, but \ may be of use elsewhere. \ Vulgar Output 5 VALUE places \ \ returns the maximum number of digits after the point that will be included \ in the pictured numeric output string by #vf (below) and hence displayed by \ those words that use it. : set-places ( n) TO places ; \ \ n is the maximum number of digits to be displayed after the decimal point \ in words that display vulgar numbers in floating point format. \ \ Caution should be exercised in setting this to large values, as it has the \ potential for causing the pictured numerical output buffer to overflow. \ \ The names and behaviour of places and set-places were chosen for consistency \ with the words PRECISION and SET-PRECISION in the Floating-Point Numbers \ Extensions word set. This is also true of truncation and set-truncation, and \ of places and set-places (below). TRUE VALUE truncation \ \ returns TRUE if trailing zeroes will be truncated when displaying a vulgar \ number in floating point format. : set-truncation ( f) TO truncation ; \ \ If f is TRUE trailing zeroes will be truncated when displaying a vulgar \ number in floating point format. : #vf ( +v--0 0) 0 SWAP places 1+ 0 DO DUP >R UM/MOD SWAP BASE @ UM* R> LOOP 2DROP DROP places ?DUP IF 0 DO S>D # 2DROP LOOP point HOLD THEN S>D #S ; \ \ append the positive vulgar +v to the pictured numeric output string as a \ floating point number. That is to say, the integral component, followed by \ a point, followed by as many digits as specified by places. If places is zero \ no point is included. Returns 0 0 for consistency with other pictured numeric \ output conversion words. The conversion is done according to the current \ value of BASE. \ \ Note that the conversion routine yields digits after the point in the order \ natural for displaying them, which is in reverse order for #. The numbers \ yielded are therefore placed on the stack in the first loop and removed by \ # in the second loop. In a system which has a limited stack space it may be \ necessary to rewrite this routine to use an ancilliary stack to perform this \ reversal, if a large number of digits after the point are required (but see \ also the note following set-places (above)). : <#vf#> ( v--addr n) 2DUP voverflow IF 2DROP S" Overflow" ELSE OVER ABS SWAP <# #vf ROT SIGN #> THEN ; \ \ Returns a string representing the vulgar v at the address addr, and of length \ n. The string is as described in #vf (above), but will have a preceding minus \ sign if v was negative. If v is the overflow indicator, returns the string \ "Overflow". : -zeroes ( addr n1--addr n2) 2DUP point hasch IF BEGIN 1- 2DUP CHARS + C@ [CHAR] 0 <> UNTIL 2DUP CHARS + C@ point = IF 2 ELSE 1 THEN + THEN ; \ \ the string at addr of length n1 is stripped of trailing "0"s, returning a \ string of length n2. If there is no point in the string no stripping takes \ place. At least one character will remain after the point. : v.fj ( v n1 n2) >R >R <#vf#> truncation IF -zeroes THEN 2DUP point >ch R> OVER - SPACES OVER 2SWAP TYPE 2DUP = IF 2DROP R> 1+ ELSE - 1+ R> + THEN SPACES ; \ \ display vulgar v according to the rules described in <#vf#> (above) The \ display string will be padded with leading spaces until there are n1 \ characters before the point and padded with trailing spaces until there are \ n2 characters after the point. This allows numbers to be aligned about the \ point for display in tabular form. If there is no point in the string it will \ be padded with n2+1 trailing spaces for consistency. Trailing zeroes will be \ truncated according to the rules described in -zeroes (above). If n1 is less \ than the number of characters to be displayed before the point no spaces will \ be displayed, but the string will not be foreshortened. Therefore setting n1 \ to zero will switch off right justification. If n2 is less than the number of \ characters to the right of the point no spaces will be displayed, but the \ string will not be truncated. If n2 is zero and places is also zero one \ trailing space will be displayed in lieu of the point. Therefore n2 should be \ -1 to switch off left justification, as this will inhibit all trailing \ spaces. : v.f ( v) 0 -1 v.fj SPACE ; \ \ display a vulgar number in floating point format as described in v.fj (above) \ but without left or right justification, and with one trailing space. : #v ( +v--0 0) 2DUP v0= IF [CHAR] 0 HOLD ELSE DUP 1 = not IF DUP S>D #S 2DROP [CHAR] / HOLD 2DUP MOD S>D #S 2DROP 2DUP < not IF BL HOLD THEN THEN 2DUP < not IF v>s S>D #S THEN THEN 2DROP 0. ; \ \ append positive vulgar +v to the pictured numeric output string according to \ the following rules. \ If +v is zero append "0". \ If +v has an integral component but no fractional component, append that \ number. \ If +v has a fractional component but no integral component append "a/b" \ where a is the numerator, and b the denominator. \ If +v has both a an integral and a fractional component append "a b/c" \ where a is the integral component, b the numerator and c the \ denominator of the fractional component. There is a space between \ the integral and fractional components. \ \ The conversion is done according to the current value of BASE. : <#v#> ( v--addr len) 2DUP voverflow IF 2DROP S" Overflow" ELSE OVER ABS SWAP <# #v ROT SIGN #> THEN ; \ \ Returns a string representing the vulgar v at the address addr, and of length \ n. The string is as described in #v (above), but will have a preceding minus \ sign if v was negative. If v is the overflow indicator, returns the string \ "Overflow". 3 VALUE digits \ \ return the maximum number of digits to be displayed in the numerator or \ denominator of a vulgar number, when displayed in vulgar format. : set-digits ( n) TO digits ; \ \ n is the maximum number of digits to be displayed in the numerator or \ denominator of a vulgar number, when displayed in vulgar format. : digits> ( --u) digits BASE @ SWAP um** -1 M+ DROP ; \ \ u is the largest number that can be represented in the current base that \ does not have more than "digits" number of digits in it. : v.j ( v n1 n2) >R >R digits> vsimplify <#v#> 2DUP [CHAR] / hasch IF 2DUP BL >ch 2DUP >R = IF 2R> >R 1+ SPACES TYPE 2R> - SPACES ELSE 2R> DUP >R - SPACES TUCK TYPE 2R> + 1+ SWAP - SPACES THEN ELSE R> OVER - SPACES TYPE R> 1+ SPACES THEN ; \ \ display vulvar number v in vulgar format, as described in <#v#> (above), \ padded with up to n1 leading spaces, and up to n2 trailing spaces, such that \ the number is justified about the space between the integral and fractional \ component, if present. If there is no integral component an additional \ leading space is displayed in lieu of the central space. If there is no \ fractional component an additional trailing space is displayed in lieu of the \ central space. No more than "digits" number of characters will be displayed \ in the numerator or denominator. n1 should be -1 to switch off leading spaces \ entirely, and likewise n2 for trailing spaces. : v. ( v) -1 -1 v.j SPACE ; \ \ display a vulgar number in vulgar format as described in v.f (above) but \ without left or right justification, and with one trailing space. \ End of vulgar Word Set \ Testing... \ \ The test suite has an environmental dependancy on 32 bit arithmetic. \ It is not comprehensive. MARKER Test-words : v**n ( v +n--v) 1 s>v ROT 0 ?DO 2OVER v* LOOP 2SWAP 2DROP ; \ \ raise vulgar v to power of non-negative single n. : factorial ( n--n) 1 SWAP 1+ 1 ?DO I * LOOP ; \ \ n2 = n1! : e**v ( v1--v2) 0 S>V 13 0 DO 2OVER I v**n I factorial s>v v/ v+ LOOP 2SWAP 2DROP ; \ \ returns vulgar approximation to e^x, where x is the vulgar number v1. \ \ Computed as first thirteen terms of power series. CR .( e^x for various numbers...) CR CR .( e = ) 1 1 e**v v.f .( should be 2.71828) CR .( Square root of e = ) 1 2 e**v v.f .( should be 1.64872) CR .( e squared = ) 2 1 e**v v.f .( should be 7.38905) CR CR .( and now as vulgar fractions...) CR CR .( e = ) 1 1 e**v v. .( should be 2 385/536) CR .( Square root of e = ) 1 2 e**v v. .( should be 1 428/743) CR .( e squared = ) 2 1 e**v v. .( should be 7 263/676) CR CR ( dispose of) Test-words \ \\\\\\\\\\\\\\ end of VULGAR.FTH \\\\\\\\\\\\\\\