fix rounding in ~r, docs

Merge to 5.3.2.
(cherry picked from commit 1109e0f86d)
This commit is contained in:
Ryan Culpepper 2013-01-13 15:52:08 -05:00
parent 665d627f9e
commit 35879ebfb2
3 changed files with 58 additions and 19 deletions

View File

@ -259,26 +259,45 @@
(values #f precision)))
(define (%positional N-abs base upper? precision exactly?)
(let* ([Nw (inexact->exact (floor N-abs))]
[Nf (- N-abs Nw)]
[whole-part (number->string* Nw base upper?)]
(define-values (Nw Nf) (decompose-positional N-abs base precision))
(let* ([whole-part (number->string* Nw base upper?)]
[frac-part
(let* ([Nf* (inexact->exact (round (* Nf (expt base precision))))])
(cond [(and exactly? (= precision 0)) ""]
[exactly? (number->fraction-string Nf* base upper? precision)]
[(= Nf* 0) #f]
[else
(let-values ([(needed-precision Nf**)
(let loop ([np precision] [Nf* Nf*])
(let-values ([(q r) (quotient/remainder Nf* base)])
(cond [(zero? r) (loop (sub1 np) q)]
[else (values np Nf*)])))])
(number->fraction-string Nf** base upper? needed-precision))]))]
(cond [(and exactly? (= precision 0)) ""]
[exactly? (number->fraction-string Nf base upper? precision)]
[(= Nf 0) #f]
[else
(let-values ([(needed-precision Nf*)
(reduce-precision base precision Nf)])
(number->fraction-string Nf* base upper? needed-precision))])]
[digits-part
(cond [frac-part (string-append whole-part "." frac-part)]
[else whole-part])])
digits-part))
;; decompose-positional : nonnegative-real positive-nat nat -> (values nat nat)
;; Returns (values whole fraction) where
;; N-abs is approximately (+ whole (/ fraction (expt base precision)))
(define (decompose-positional N-abs base precision)
(let* ([Nw (inexact->exact (floor N-abs))]
[Nf (- N-abs Nw)]
[base^prec (expt base precision)]
[Nf* (inexact->exact (round* (* Nf base^prec)))])
(cond [(< Nf* base^prec)
(values Nw Nf*)]
[else
(values (add1 Nw) 0)])))
;; reduce-precision : nat nat nat -> (values nat nat)
;; Returns (values needed-precision N*) where
;; (/ N (expt base precision)) = (/ N* (expt base needed-precision))
(define (reduce-precision base precision N)
(if (zero? N)
(values 0 0)
(let loop ([np precision] [N* N])
(let-values ([(q r) (quotient/remainder N* base)])
(cond [(zero? r) (loop (sub1 np) q)]
[else (values np N*)])))))
(define (%exponential N-abs base upper? format-exponent significand-precision exactly?)
(define-values (N* e-adjust actual-precision)
(scale N-abs base significand-precision exactly?))
@ -385,8 +404,10 @@
(cond [(< d 10) (integer->char (+ d (char->integer #\0)))]
[else (integer->char (+ (- d 10) (char->integer (if upper? #\A #\a))))]))
;; round* : nonnegative-real -> nonnegative-integer (preserving exactness)
;; Implements "round half up" rounding (thus this library formats using
;; "round half away from zero", since it applies round* to absolute values)
(define (round* x) ;; round is round-to-even :(
(if (integer? x)
x
(+ (truncate x)
(if (even? (truncate (+ x x))) 0 1))))
(truncate (+ x 1/2))))

View File

@ -215,7 +215,7 @@ marker is @racket["..."].
[#:precision precision
(or/c exact-nonnegative-integer?
(list/c '= exact-nonnegative-integer?))
3]
6]
[#:notation notation
(or/c 'positional 'exponential
(-> rational? (or/c 'positional 'exponential)))

View File

@ -270,6 +270,24 @@
"D.EADBEF×16^+07")
(tc (~r 33.99508664763296 #:precision 1 #:min-width 5)
" 33.1")
" 34")
(tc (~r 33.99508664763296 #:precision 2 #:min-width 7)
" 33.1")
" 34")
(tc (~r 33.99508664763296 #:precision 1)
"34")
(tc (~r 33.99508664763296 #:precision '(= 1))
"34.0")
(tc (~r 33.99508664763296 #:precision '(= 2))
"34.00")
(tc (~r 33.99508664763296 #:precision '(= 3))
"33.995")
(tc (~r -33.99508664763296 #:precision 1)
"-34")
(tc (~r -33.99508664763296 #:precision '(= 1))
"-34.0")
(tc (~r -33.99508664763296 #:precision '(= 2))
"-34.00")
(tc (~r -33.99508664763296 #:precision '(= 3))
"-33.995")