e55a31480e
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)
191 lines
6.4 KiB
Racket
191 lines
6.4 KiB
Racket
#lang typed/racket/base
|
|
|
|
(require racket/performance-hint
|
|
"flonum-functions.rkt"
|
|
"flonum-constants.rkt"
|
|
"flonum-exp.rkt"
|
|
"flonum-log.rkt"
|
|
"flonum-error.rkt"
|
|
"flvector.rkt")
|
|
|
|
(provide flsqrt1pm1
|
|
flsinh flcosh fltanh
|
|
flasinh flacosh flatanh
|
|
make-flexpt flexpt+ flexpt1p)
|
|
|
|
;; ---------------------------------------------------------------------------------------------------
|
|
;; sqrt(1+x)-1
|
|
|
|
(: flsqrt1pm1 (Float -> Float))
|
|
(define (flsqrt1pm1 x)
|
|
(cond [((flabs x) . fl> . 0.75)
|
|
(fl- (flsqrt (fl+ 1.0 x)) 1.0)]
|
|
[else
|
|
(flexpm1 (fl* 0.5 (fllog1p x)))]))
|
|
|
|
;; ---------------------------------------------------------------------------------------------------
|
|
;; Hyperbolic sine
|
|
|
|
(: flsinh (Float -> Float))
|
|
(define (flsinh x)
|
|
(cond [(x . fl< . 0.0)
|
|
;; Odd function
|
|
(- (flsinh (- x)))]
|
|
[(x . fl< . (flexpt 2.0 -26.0))
|
|
;; sinh(x) ~ x
|
|
x]
|
|
[(x . fl< . 18.5)
|
|
;; sinh(x) = (exp(2*x) - 1) / (2*exp(x))
|
|
(define y (flexpm1 x))
|
|
(fl* 0.5 (fl+ y (fl/ y (fl+ y 1.0))))]
|
|
[(x . fl< . (fllog +max.0))
|
|
;; sinh(x) ~ exp(x) / 2
|
|
(fl* 0.5 (flexp x))]
|
|
[else
|
|
;; sinh(x) ~ exp(x) / 2 = (exp(x/2) / 2) * exp(x/2)
|
|
(define y (flexp (fl* 0.5 x)))
|
|
(fl* (fl* 0.5 y) y)]))
|
|
|
|
;; ---------------------------------------------------------------------------------------------------
|
|
;; Hyperbolic cosine
|
|
|
|
(: flcosh (Float -> Float))
|
|
(define (flcosh x)
|
|
;; cosh(x) = cosh(-x)
|
|
(let ([x (flabs x)])
|
|
(cond [(x . fl< . (flexpt 2.0 -26.0))
|
|
;; cosh(x) ~ 1
|
|
1.0]
|
|
[(x . fl< . (fl* 0.5 (fllog 2.0)))
|
|
;; cosh(x) = 1 + (exp(x) - 1)^2 / (2*exp(x))
|
|
(define y (flexpm1 x))
|
|
(fl+ 1.0 (fl/ (fl* y y) (fl* 2.0 (fl+ 1.0 y))))]
|
|
[(x . fl< . 18.5)
|
|
;; cosh(x) = (exp(x) + 1/exp(x)) / 2
|
|
(define y (flexp x))
|
|
(fl+ (fl* 0.5 y) (fl/ 0.5 y))]
|
|
[(x . fl< . (fllog +max.0))
|
|
;; cosh(x) ~ exp(x) / 2
|
|
(fl* 0.5 (flexp x))]
|
|
[else
|
|
;; cosh(x) ~ exp(x) / 2 = (exp(x/2) / 2) * exp(x/2)
|
|
(define y (flexp (fl* 0.5 x)))
|
|
(fl* (fl* 0.5 y) y)])))
|
|
|
|
;; ---------------------------------------------------------------------------------------------------
|
|
;; Hyperbolic tangent
|
|
|
|
(: fltanh (Float -> Float))
|
|
(define (fltanh x)
|
|
(cond [(x . fl< . 0.0)
|
|
;; tanh(x) = -tanh(-x)
|
|
(- (fltanh (- x)))]
|
|
[(x . fl< . 1e-16)
|
|
;; tanh(x) ~ x + x^2
|
|
(fl* x (fl+ 1.0 x))]
|
|
[(x . fl< . 0.5)
|
|
;; tanh(x) = (exp(2*x) - 1) / (exp(2*x) + 1)
|
|
(define y (flexpm1 (fl* -2.0 x)))
|
|
(- (fl/ y (fl+ 2.0 y)))]
|
|
[(x . fl< . 19.5)
|
|
;; tanh(x) = (exp(2*x) - 1) / (exp(2*x) + 1)
|
|
(define y (flexp (fl* 2.0 x)))
|
|
(fl/ (fl- y 1.0) (fl+ y 1.0))]
|
|
[(x . fl<= . +inf.0)
|
|
;; tanh(x) ~ 1
|
|
1.0]
|
|
[else +nan.0]))
|
|
|
|
;; ---------------------------------------------------------------------------------------------------
|
|
;; Inverse hyperbolic sine
|
|
|
|
(: flasinh (Float -> Float))
|
|
(define (flasinh x)
|
|
(cond [(x . fl< . 0.0) (- (flasinh (- x)))]
|
|
[(x . fl< . 2e-8) x]
|
|
[(x . fl< . 0.00018)
|
|
;; Taylor series order 3
|
|
(fl* x (fl+ 1.0 (fl* (fl* #i-1/6 x) x)))]
|
|
[(x . fl< . 1.0)
|
|
;; Standard definition, rearranged to preserve digits
|
|
(fllog1p (fl+ x (flsqrt1pm1 (fl* x x))))]
|
|
[(x . fl< . 3e3)
|
|
;; Standard definition
|
|
(fllog (fl+ x (flsqrt (fl+ (fl* x x) 1.0))))]
|
|
[(x . fl< . 1e307)
|
|
;; Laurent series in 1/x at 0+ order from -1 to 1
|
|
(fl+ (fllog (fl* x 2.0)) (fl/ 1.0 (fl* (fl* 4.0 x) x)))]
|
|
[else
|
|
;; Laurent series, rearranged to not overflow
|
|
(fl+ (fllog x) (fllog 2.0))]))
|
|
|
|
;; ---------------------------------------------------------------------------------------------------
|
|
;; Inverse hyperbolic cosine
|
|
|
|
(: flacosh (Float -> Float))
|
|
(define (flacosh x)
|
|
(cond [(x . fl< . 1.0) +nan.0]
|
|
[(x . fl< . 1.5)
|
|
;; Standard definition, rearranged to preserve digits when x is near 1.0
|
|
(define y (fl- x 1.0))
|
|
(fllog1p (fl+ y (flsqrt (fl+ (fl* y y) (fl* 2.0 y)))))]
|
|
[(x . fl< . 1e8)
|
|
;; Standard definition
|
|
(fllog (fl+ x (flsqrt (fl- (fl* x x) 1.0))))]
|
|
[(x . fl< . 1e307)
|
|
;; Laurent series in 1/x at 0+ order from -1 to 0
|
|
(fllog (fl* x 2.0))]
|
|
[else
|
|
;; Laurent series, rearranged to avoid overflow
|
|
(fl+ (fllog x) (fllog 2.0))]))
|
|
|
|
;; ---------------------------------------------------------------------------------------------------
|
|
;; Inverse hyperbolic tangent
|
|
|
|
(: flatanh (Float -> Float))
|
|
(define (flatanh x)
|
|
(cond [(x . fl< . 0.0) (- (flatanh (- x)))]
|
|
[(x . fl< . 1e-8) x]
|
|
[(x . fl< . 0.00015)
|
|
;; Taylor series order 2
|
|
(fl+ x (fl* (fl* (fl* #i1/3 x) x) x))]
|
|
[(x . fl< . 0.5)
|
|
;; Standard definition, rearranged to preserve digits when x is near 0.0
|
|
(fl* 0.5 (fl- (fllog1p x) (fllog1p (- x))))]
|
|
[(x . fl< . 1.0)
|
|
;; Standard definition
|
|
(fl* 0.5 (fllog (fl/ (fl+ 1.0 x) (fl- 1.0 x))))]
|
|
[(x . fl= . 1.0) +inf.0]
|
|
[else +nan.0]))
|
|
|
|
;; ---------------------------------------------------------------------------------------------------
|
|
;; Exponential with high-precision bases
|
|
|
|
(begin-encourage-inline
|
|
|
|
(: make-flexpt (Positive-Exact-Rational -> (Flonum -> Flonum)))
|
|
(define (make-flexpt b)
|
|
(define b-hi (fl b))
|
|
(define b-lo (fl (- (/ (inexact->exact b-hi) b) 1)))
|
|
(cond [(fl= b-lo 0.0) (λ: ([x : Flonum]) (flexpt b-hi x))]
|
|
[else
|
|
(λ: ([x : Flonum])
|
|
(fl/ (flexpt b-hi x)
|
|
(flexp (fl* x (fllog1p b-lo)))))]))
|
|
|
|
(: flexpt+ (Flonum Flonum Flonum -> Flonum))
|
|
(define (flexpt+ a b y)
|
|
(define-values (x-hi x-lo) (fast-fl+/error a b))
|
|
(fl/ (flexpt x-hi y)
|
|
(flexp (fl* y (fllog1p (- (/ x-lo x-hi)))))))
|
|
|
|
(: flexpt1p (Flonum Flonum -> Flonum))
|
|
(define (flexpt1p x y)
|
|
(cond [(and (x . > . -0.5) (x . < . +inf.0))
|
|
(define-values (a-hi a-lo) (fast-fl+/error 1.0 x))
|
|
(fl/ (flexpt a-hi y)
|
|
(flexp (fl* y (fllog1p (- (/ a-lo a-hi))))))]
|
|
[else (flexpt (+ 1.0 x) y)]))
|
|
|
|
) ; begin-encourage-inline
|