From: Stephen Adams Date: Mon, 28 Jul 1997 18:19:05 +0000 (+0000) Subject: The previous change to make the output with '(ABSOLUTE ...) X-Git-Tag: 20090517-FFI~5032 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=34ec2b7a2b5c66ac64fefc3d0a7cca036d066bcd;p=mit-scheme.git The previous change to make the output with '(ABSOLUTE ...) produce the correct number of digits for numbers with no significant digits introduced problems with NORMAL rounded and ENGINEERING formatted output. All NORMAL rounded output for numbers of the form ddd.ff were being output as "000.". Some numbers formatted with '(ABSOLUTE ENGINEERING) looked like "000e-3". This has been fixed by (1) setting the cutoff for NORMAL rounded numbers to be a value that will allow the digit production to run to completion (flo:significand-digits - 2). (2) adding special cases in the output procedures to deal with empty digit strings. Currently: Zero still prints as "0." by the initial sign/infinity/NaN dispatch. Rounded output in NORMAL style for numbers with no significant digits prints as "0." or "-0.". Rounded output in SCIENTIFIC / ENGINEERING style for numbers with no significant digits prints as "0eE" or "-0eE", e.g. "-0e3". It might be preferable to keep "0." distinguished for zero, but I'm not sure how for NORMAL formatted output. (To my eyes, "0.0" looks more `zero' than "0.", and ".0" implies a small magnitude.) A small regression test has been appended in a comment to help avoid problems in future. Feel free to add tests. --- diff --git a/v7/src/runtime/dragon4.scm b/v7/src/runtime/dragon4.scm index e68015e0c..dcecccf1d 100644 --- a/v7/src/runtime/dragon4.scm +++ b/v7/src/runtime/dragon4.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: dragon4.scm,v 1.12 1997/07/26 07:39:07 cph Exp $ +$Id: dragon4.scm,v 1.13 1997/07/28 18:19:05 adams Exp $ Copyright (c) 1989-97 Massachusetts Institute of Technology @@ -95,7 +95,9 @@ not much different to numbers within a few orders of magnitude of 1. (let ((k+1 (+ k 1))) (let ((k+1-l (- k+1 (string-length digits))) (n (flo:significand-digits radix))) - (cond ((< k+1-l (- n)) + (cond ((zero? (string-length digits)) + (string-copy "0.")) + ((< k+1-l (- n)) (scientific-output digits k radix 0)) ((negative? k) (string-append "." (make-string (- k+1) #\0) digits)) @@ -118,7 +120,9 @@ not much different to numbers within a few orders of magnitude of 1. (let ((l (string-length digits)) (i (+ kr 1)) (exponent (int:->string (- k kr) radix))) - (cond ((< l i) + (cond ((= l 0) + (string-append "0e" exponent)) + ((< l i) (string-append digits (make-string (- i l) #\0) "e" exponent)) ((= l i) (string-append digits "e" exponent)) @@ -242,7 +246,10 @@ not much different to numbers within a few orders of magnitude of 1. (loop k s m- m+ round-up?) (values k r s m- m+ cutoff round-up?))))))) (case cutoff-mode - ((NORMAL) (values k r s m- m+ k round-up?)) + ((NORMAL) + (values k r s m- m+ + (- k (flo:significand-digits radix) 2) ; i.e. ignore cutoff + round-up?)) ((ABSOLUTE) (cutoff-adjust cutoff)) ((RELATIVE) (cutoff-adjust (+ k cutoff))) (else (error:wrong-type-datum cutoff-mode #f)))) @@ -256,7 +263,7 @@ not much different to numbers within a few orders of magnitude of 1. (define (scale r s m+) (let ((est-k (ceiling->exact (- (* (+ e p -1) (/ (flo:log 2.) (log radix))) - 1e-9)))) ; fudge factor ensures K bever too big + 1e-9)))) ; fudge factor ensures K never too big (if (< est-k 0) (let ((factor (expt-radix radix (- est-k)))) (let loop ((k est-k) @@ -283,4 +290,73 @@ not much different to numbers within a few orders of magnitude of 1. (>= exponent 0) (< exponent (vector-length v))) (vector-ref v exponent) - (rat:expt base exponent))))) \ No newline at end of file + (rat:expt base exponent))))) + +#| Test code. Re-run after changing anything. + +(define (test) + (define (try n settings . expecteds) + (let ((got (fluid-let ((flonum-unparser-cutoff settings)) + (number->string (exact->inexact n))))) + (if (member got expecteds) + (set! successes (+ successes 1)) + (begin + (set! failures (+ failures 1)) + (display "\nTest failed ") (write n) (display " ") (write settings) + (display "\n expected:") + (for-each (lambda (s) (display " ") (write s)) + expecteds) + (display "\n got: ") (write got))))) + + (define failures 0) + (define successes 0) + + ;; From the MIT Scheme Reference Manual: + (try (* 4 (atan 1 1)) '(relative 5) "3.1416") + (try (* 4000 (atan 1 1)) '(relative 5) "3141.6") + (try (* 4000 (atan 1 1)) '(relative 5 scientific) "3.1416e3") + (try (* 40000 (atan 1 1)) '(relative 5 scientific) "3.1416e4") + (try (* 40000 (atan 1 1)) '(relative 5 engineering) "31.416e3") + (try (* 4 (atan 1 1)) '(absolute 5) "3.14159") + (try (* 4000 (atan 1 1)) '(absolute 5) "3141.59265") + (try (* 4e10 (atan 1 1)) '(absolute -4) "31415930000.") + (try (* 4e10 (atan 1 1)) '(absolute -4 scientific) "3.141593e10") + (try (* 4e10 (atan 1 1)) '(absolute -4 engineering) "31.41593e9") + (try (* 4e10 (atan 1 1)) '(absolute -5) "31415900000.") + + ;; Harder tests: + (try 0. 'normal "0.") + (try 0.0123456 'normal ".0123456") + (try 0.000123456 'normal ".000123456") + + (try 1/3 '(relative 4) ".3333") + (try 2/3 '(relative 4) ".6667") + + (try 12345.67 '(absolute 1 normal) "12345.7") + (try 12345.67 '(absolute -4 normal) "10000.") + (try 4999. '(absolute -4 normal) "0.") + (try 5001. '(absolute -4 normal) "10000.") + + (try 12345.67 '(absolute 1 scientific) "1.23457e4") + (try 12345.67 '(absolute -4 scientific) "1e4") + (try 4999. '(absolute -4 scientific) "0." "0e4" "0e3") + (try 5001. '(absolute -4 scientific) "1e4") + + (try 12345.67 '(absolute 1 engineering) "12.3457e3") + (try 12345.67 '(absolute -4 engineering) "10e3") + (try 4999. '(absolute -4 engineering) "0." "0e3") + (try 5001. '(absolute -4 engineering) "10e3") + (try 5001. '(absolute -5 engineering) "0." "0e3") + (try 5001. '(absolute -6 engineering) "0." "0e3") + (try -5001. '(absolute -6 engineering) "0." "-0e3") + + (try 0.00499 '(absolute 2 normal) "0." ".00") ; "0." would be prefereable + + (try 0.00500 '(absolute 2 normal) ".01") ; (rounds up in binary) + (try 0.00501 '(absolute 2 normal) ".01") + (try 0.00499 '(absolute -3 normal) "0.") + + + (display "\n\nSuccesses: ") (display successes) + (display " Failures: ") (display failures)) +|#