fix rounding in ~r, docs
Merge to 5.3.2.
(cherry picked from commit 1109e0f86d
)
This commit is contained in:
parent
665d627f9e
commit
35879ebfb2
|
@ -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))))
|
||||
|
|
|
@ -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)))
|
||||
|
|
|
@ -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")
|
||||
|
|
Loading…
Reference in New Issue
Block a user