Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
ansi-test
ansi-test
Commits
4fb02ed4
Commit
4fb02ed4
authored
Feb 09, 2019
by
Marius Gerbershagen
Browse files
format: add test verifying correct rounding for ~e directive
parent
52d21992
Changes
2
Hide whitespace changes
Inline
Side-by-side
auxiliary/printer-aux.lsp
View file @
4fb02ed4
...
...
@@ -449,3 +449,49 @@
`(with-output-to-string
(,stream)
(assert (equal (funcall ,fn ,stream ,@args 'a) '(a))))))
;;; Function used in checking correct rounding for floating point printing
(defun round-ratio-to-n-digits (ratio n)
"Returns a string with the first n significant digits of the decimal
representation of ratio."
(check-type ratio rational)
(check-type n (integer 1 *))
(let* ((exp (floor (* (- (integer-length (numerator ratio))
(integer-length (denominator ratio)))
#.(log 2d0 10))))
(10^n (expt 10 n))
;; We first scale the ratio down to the range
;; 10^n <= x < 10^(n+1). This allows us to use integer
;; arithmetic to compute the number below satisfying
;; below <= x <= below + 10.
(x (loop with x = (/ ratio (expt 10 (- exp n)))
until (<= 10^n x (* 10 10^n))
do (setf x (if (< x 10^n) (* x 10) (/ x 10)))
finally (return x)))
(below 10^n))
(loop for i below n
with 10^n-i = below
do (loop until (and (<= below x)
(< x (+ below 10^n-i)))
do (if (> below x)
(setf below (- below 10^n-i))
(setf below (+ below 10^n-i))))
(setf 10^n-i (/ 10^n-i 10)))
(let ((halfway (+ below 5)))
(cond ((< x halfway)
(values (write-to-string (/ below 10))))
((> x halfway)
(values (write-to-string (let ((rounded (+ (/ below 10) 1)))
(if (>= rounded 10^n)
(/ rounded 10)
rounded)))))
(t ;; "When rounding up and rounding down would
;; produce printed values equidistant from the
;; scaled value of arg, then the implementation is
;; free to use either one"
(values (write-to-string (/ below 10))
(write-to-string (let ((rounded (+ (/ below 10) 1)))
(if (>= rounded 10^n)
(/ rounded 10)
rounded)))))))))
printer/format/format-e.lsp
View file @
4fb02ed4
...
...
@@ -77,11 +77,11 @@
;;; If the parameter d is omitted, [...] a value is chosen for d in
;;;
"
If the parameter d is omitted, [...] a value is chosen for d in
;;; such a way that as many digits as possible may be printed subject
;;; to [...] the constraint that no trailing zero digits may appear in
;;; the fraction, except that if the fraction to be printed is zero
;;; then a single zero digit should appear after the decimal point.
;;; then a single zero digit should appear after the decimal point.
"
(deftest format.e.3
(let ((fn (formatter "~6e")))
...
...
@@ -397,3 +397,40 @@
unless (and (string= s "5.00^-1") (string= s s2))
collect (list x s s2)))
nil)
;;; verify correct rounding
(deftest format.e.26
(loop
for i = (random 4)
for type = (elt #(short-float single-float double-float long-float) i)
for min-value = (elt (vector least-positive-short-float least-positive-single-float
least-positive-double-float least-positive-long-float)
i)
for max-value = (elt (vector most-positive-short-float most-positive-single-float
most-positive-double-float most-positive-long-float)
i)
;; create a random float ...
for x = (exp (+ (random (- (log max-value) (log min-value)))
(log min-value)))
;; ... and check the correct rounding for as many significant
;; digits as the precision of the float allows
for incorrect-roundings =
(loop for d from 1 upto (floor (* (float-precision x)
(log (float-radix x) 10)))
for format-string = (format nil "~~,~d,,0e" d)
for s1 = (let* ((*read-default-float-format* type)
(s1 (format nil format-string x)))
(subseq s1 (1+ (position #\. s1)) (position #\e s1)))
with ret = nil
do (multiple-value-bind (s2 s3)
(round-ratio-to-n-digits (rationalize x) d)
(unless (or (string= s1 s2)
(and s3 (string= s1 s3)))
(push (list x (format nil format-string x) s1 s2 s3) ret)))
finally (return ret))
repeat 20
if incorrect-roundings
collect incorrect-roundings)
nil)
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment