
additions/changes * More accurate `flulp-error' * Added `flonum->fields', `fields->flonum', `flonum->sig+exp', `sig+exp->flonum' (currently undocumented) * Correctly rounded, robust `bigfloat->fl2' and `fl2' * Correctly rounded, robust `fl+/error', `fl-/error', `fl*/error', `flsqr/error', `fl//error' * Much faster but slightly less accurate fl2 ops (shamelessly stolen from crlibm, which is LGPL) * Added `fl2ulp', `fl2ulp-error', `fl2?' (which detects overlap), `+max-fl2-subnormal.0' (which was tricky), `fl2abs' * Added deterministic and randomized flonum op tests (against MPFR) * Added deterministic and randomized flonum/error op tests (against MPFR) * Added deterministic and randomized fl2 op tests (against MPFR) * Exposed FPU tests in `math/utils' (currently undocumented)
152 lines
5.1 KiB
Racket
152 lines
5.1 KiB
Racket
#lang racket
|
|
|
|
(require math/flonum
|
|
math/base
|
|
math/utils
|
|
rackunit)
|
|
|
|
;; ===================================================================================================
|
|
;; Test `flulp-error' heavily; it MUST be correct, or all the FPU tests are suspect
|
|
|
|
;; Both arguments eqv?
|
|
(check-equal? (flulp-error -inf.0 -inf.0) 0.0)
|
|
(check-equal? (flulp-error -max.0 -max.0) 0.0)
|
|
(check-equal? (flulp-error -1.0 -1.0) 0.0)
|
|
(check-equal? (flulp-error -min.0 -min.0) 0.0)
|
|
(check-equal? (flulp-error -0.0 -0.0) 0.0)
|
|
(check-equal? (flulp-error +0.0 +0.0) 0.0)
|
|
(check-equal? (flulp-error +min.0 +min.0) 0.0)
|
|
(check-equal? (flulp-error +1.0 +1.0) 0.0)
|
|
(check-equal? (flulp-error +max.0 +max.0) 0.0)
|
|
(check-equal? (flulp-error +inf.0 +inf.0) 0.0)
|
|
|
|
;; Both arguments zero
|
|
(check-equal? (flulp-error -0.0 +0.0) 0.0)
|
|
(check-equal? (flulp-error +0.0 -0.0) 0.0)
|
|
|
|
;; LHS argument +inf.0
|
|
(check-equal? (flulp-error +inf.0 -inf.0) +inf.0)
|
|
(check-equal? (flulp-error +inf.0 -max.0) +inf.0)
|
|
(check-equal? (flulp-error +inf.0 -1.0) +inf.0)
|
|
(check-equal? (flulp-error +inf.0 -min.0) +inf.0)
|
|
(check-equal? (flulp-error +inf.0 -0.0) +inf.0)
|
|
(check-equal? (flulp-error +inf.0 +0.0) +inf.0)
|
|
(check-equal? (flulp-error +inf.0 +min.0) +inf.0)
|
|
(check-equal? (flulp-error +inf.0 +1.0) +inf.0)
|
|
(check-equal? (flulp-error +inf.0 +max.0) +inf.0)
|
|
|
|
;; LHS argument -inf.0
|
|
(check-equal? (flulp-error -inf.0 -max.0) +inf.0)
|
|
(check-equal? (flulp-error -inf.0 -1.0) +inf.0)
|
|
(check-equal? (flulp-error -inf.0 -min.0) +inf.0)
|
|
(check-equal? (flulp-error -inf.0 -0.0) +inf.0)
|
|
(check-equal? (flulp-error -inf.0 +0.0) +inf.0)
|
|
(check-equal? (flulp-error -inf.0 +min.0) +inf.0)
|
|
(check-equal? (flulp-error -inf.0 +1.0) +inf.0)
|
|
(check-equal? (flulp-error -inf.0 +max.0) +inf.0)
|
|
(check-equal? (flulp-error -inf.0 +inf.0) +inf.0)
|
|
|
|
;; RHS argument +inf.0
|
|
(check-equal? (flulp-error -max.0 +inf.0) +inf.0)
|
|
(check-equal? (flulp-error -1.0 +inf.0) +inf.0)
|
|
(check-equal? (flulp-error -min.0 +inf.0) +inf.0)
|
|
(check-equal? (flulp-error -0.0 +inf.0) +inf.0)
|
|
(check-equal? (flulp-error +0.0 +inf.0) +inf.0)
|
|
(check-equal? (flulp-error +min.0 +inf.0) +inf.0)
|
|
(check-equal? (flulp-error +1.0 +inf.0) +inf.0)
|
|
(check-equal? (flulp-error +max.0 +inf.0) +inf.0)
|
|
|
|
;; RHS argument -inf.0
|
|
(check-equal? (flulp-error -max.0 -inf.0) +inf.0)
|
|
(check-equal? (flulp-error -1.0 -inf.0) +inf.0)
|
|
(check-equal? (flulp-error -min.0 -inf.0) +inf.0)
|
|
(check-equal? (flulp-error -0.0 -inf.0) +inf.0)
|
|
(check-equal? (flulp-error +0.0 -inf.0) +inf.0)
|
|
(check-equal? (flulp-error +min.0 -inf.0) +inf.0)
|
|
(check-equal? (flulp-error +1.0 -inf.0) +inf.0)
|
|
(check-equal? (flulp-error +max.0 -inf.0) +inf.0)
|
|
|
|
;; RHS argument 0.0
|
|
(check-equal? (flulp-error -max.0 +0.0) +inf.0)
|
|
(check-equal? (flulp-error -1.0 +0.0) +inf.0)
|
|
(check-equal? (flulp-error -min.0 +0.0) +inf.0)
|
|
(check-equal? (flulp-error +min.0 +0.0) +inf.0)
|
|
(check-equal? (flulp-error +1.0 +0.0) +inf.0)
|
|
(check-equal? (flulp-error +max.0 +0.0) +inf.0)
|
|
|
|
;; RHS argument -0.0
|
|
(check-equal? (flulp-error -max.0 -0.0) +inf.0)
|
|
(check-equal? (flulp-error -1.0 -0.0) +inf.0)
|
|
(check-equal? (flulp-error -min.0 -0.0) +inf.0)
|
|
(check-equal? (flulp-error +min.0 -0.0) +inf.0)
|
|
(check-equal? (flulp-error +1.0 -0.0) +inf.0)
|
|
(check-equal? (flulp-error +max.0 -0.0) +inf.0)
|
|
|
|
;; Small errors
|
|
(check-equal? (flulp-error +0.0 -min.0) 1.0)
|
|
(check-equal? (flulp-error +0.0 +min.0) 1.0)
|
|
(check-equal? (flulp-error -0.0 -min.0) 1.0)
|
|
(check-equal? (flulp-error -0.0 +min.0) 1.0)
|
|
(check-equal? (flulp-error -min.0 +min.0) 2.0)
|
|
(check-equal? (flulp-error +min.0 -min.0) 2.0)
|
|
|
|
(define large-flulp-error-xys
|
|
(list (list -1.0 -max.0)
|
|
(list -1.0 +max.0)
|
|
(list -min.0 -max.0)
|
|
(list -min.0 +max.0)
|
|
(list -1.0 +1.0)
|
|
(list -max.0 +max.0)
|
|
(list -max.0 -1.0)
|
|
(list -max.0 -min.0)
|
|
(list -max.0 +min.0)
|
|
(list -max.0 +1.0)
|
|
(list -1.0 -min.0)
|
|
(list -1.0 +min.0)
|
|
(list -min.0 -1.0)
|
|
(list -min.0 +1.0)
|
|
(list -0.0 -max.0)
|
|
(list -0.0 -1.0)
|
|
(list -0.0 +1.0)
|
|
(list -0.0 +max.0)
|
|
(list +0.0 -max.0)
|
|
(list +0.0 -1.0)
|
|
(list +0.0 +1.0)
|
|
(list +0.0 +max.0)
|
|
(list +min.0 -max.0)
|
|
(list +min.0 -1.0)
|
|
(list +min.0 +1.0)
|
|
(list +min.0 +max.0)
|
|
(list +1.0 -max.0)
|
|
(list +1.0 -1.0)
|
|
(list +1.0 -min.0)
|
|
(list +1.0 +min.0)
|
|
(list +1.0 +max.0)
|
|
(list +max.0 -max.0)
|
|
(list +max.0 -1.0)
|
|
(list +max.0 -min.0)
|
|
(list +max.0 +min.0)
|
|
(list +max.0 +1.0)))
|
|
|
|
;; Large errors
|
|
(for ([xy (in-list large-flulp-error-xys)])
|
|
(match-define (list x y) xy)
|
|
(check-true ((flulp-error x y) . >= . (expt 2 52))
|
|
(format "x = ~a y = ~a" x y)))
|
|
|
|
(check-equal? (flulp-error 1.0 (flnext 1.0)) 1.0)
|
|
(check-equal? (flulp-error +max.0 (flprev +max.0)) 1.0)
|
|
|
|
(for ([_ (in-range 1000)])
|
|
(define s (random))
|
|
(define e (fl (random-integer -1074 1024)))
|
|
(define x (* s (flexpt 2.0 e)))
|
|
(check-equal? (flulp-error x (flnext x)) 1.0
|
|
(format "x = ~a" x)))
|
|
|
|
;; ===================================================================================================
|
|
;; FPU testing
|
|
|
|
(parameterize ([print-test-progress? #f])
|
|
(test-fpu 1000))
|