111 lines
3.7 KiB
Racket
111 lines
3.7 KiB
Racket
#lang typed/racket/base
|
|
|
|
#|
|
|
Compute log and log1p with 105-bit accuracy
|
|
|
|
Both implementations do some argument reduction, find excellent 53-bit initial estimates, and then
|
|
perform one Newton step.
|
|
|#
|
|
|
|
(require "../flonum-functions.rkt"
|
|
"../flonum-error.rkt"
|
|
"../flonum-log.rkt"
|
|
"expansion-base.rkt"
|
|
"expansion-exp.rkt")
|
|
|
|
(provide fl2log fl2log1p)
|
|
|
|
;; ===================================================================================================
|
|
;; log
|
|
|
|
#|
|
|
Argument reduction for log:
|
|
|
|
log(x) = log(x*2^k) - k*log(2)
|
|
|
|
A value of k that reduces any x to [0.5, 1.0] is
|
|
|
|
k = -truncate(log(x)/log(2))
|
|
|#
|
|
|
|
(define-values (log2-hi log2-lo) (values 0.6931471805599453 2.3190468138462996e-17))
|
|
|
|
(: fl2log-reduction (Flonum Flonum -> (Values Flonum Flonum Flonum)))
|
|
(define (fl2log-reduction x2 x1)
|
|
(define k (- (fltruncate (fl/ (fllog+ x1 x2) (fllog 2.0)))))
|
|
(cond [(k . fl> . 1023.0)
|
|
;; This can happen if x is subnormal; just multiply in pieces
|
|
(define k0 1023.0)
|
|
(define k1 (fl- k k0))
|
|
(define 2^k0 (flexpt 2.0 k0))
|
|
(define 2^k1 (flexpt 2.0 k1))
|
|
(let*-values ([(x2 x1) (values (* x2 2^k0 2^k1) (* x1 2^k0 2^k1))])
|
|
(values k x2 x1))]
|
|
[else
|
|
(define 2^k (flexpt 2.0 k))
|
|
(let*-values ([(x2 x1) (values (fl* x2 2^k) (fl* x1 2^k))])
|
|
(values k x2 x1))]))
|
|
|
|
(: fl2log (Flonum Flonum -> (Values Flonum Flonum)))
|
|
(define (fl2log x2 x1)
|
|
(define x (fl+ x1 x2))
|
|
(cond [(x . fl<= . 0.0) (cond [(fl= x 0.0) (values -inf.0 0.0)]
|
|
[else (values +nan.0 0.0)])]
|
|
[(x . fl= . +inf.0) (values +inf.0 0.0)]
|
|
[(or (x . fl< . 0.5) (x . fl> . 2.5))
|
|
;; Reduce arguments
|
|
(let*-values ([(k x2 x1) (fl2log-reduction x2 x1)]
|
|
[(y2 y1) (fl2log x2 x1)]
|
|
[(z2 z1) (fl2* log2-hi log2-lo k)])
|
|
(fl2- y2 y1 z2 z1))]
|
|
[else
|
|
;; Estimate log(x) and do a Newton iteration using expm1
|
|
(let*-values ([(y) (fllog+ x2 x1)]
|
|
[(x2 x1) (fl2+ x2 x1 -1.0)]
|
|
[(z2 z1) (flexpm1/error y)]
|
|
[(w2 w1) (fl2+ z2 z1 1.0)]
|
|
[(dy2 dy1) (fl2- x2 x1 z2 z1)]
|
|
[(dy2 dy1) (fl2/ dy2 dy1 w2 w1)])
|
|
(fl2+ dy2 dy1 y))]))
|
|
|
|
;; ===================================================================================================
|
|
;; log1p
|
|
|
|
#|
|
|
Argument reduction for log1p:
|
|
|
|
log1p(x) = k*log(2) + log1p(x/2^k + (1/2^k - 1))
|
|
|
|
A `k' that reduces any argument `x' to (-1/2,1/2) is
|
|
|
|
k = round(log1p(x)/log(2))
|
|
|#
|
|
|
|
(: fl2log1p-reduction (Flonum Flonum Flonum Flonum Flonum -> (Values Flonum Flonum Flonum)))
|
|
(define (fl2log1p-reduction x2 x1 a2 a1 y)
|
|
(define k (flround (fl/ y (fllog 2.0))))
|
|
(define 2^k (flexpt 2.0 k))
|
|
(define-values (j2 j1) (fast-fl-/error (/ 1.0 2^k) 1.0))
|
|
(let*-values ([(x2 x1) (values (/ x2 2^k) (/ x1 2^k))]
|
|
[(x2 x1) (fl2+ x2 x1 j2 j1)])
|
|
(values k x2 x1)))
|
|
|
|
(: fl2log1p (Flonum Flonum -> (Values Flonum Flonum)))
|
|
(define (fl2log1p x2 x1)
|
|
(define-values (a2 a1) (fl2+ x2 x1 1.0))
|
|
(define y (fllog+ a2 a1))
|
|
(cond
|
|
[(or (y . fl< . -0.5) (a2 . fl> . 2.0)) (fl2log a2 a1)]
|
|
[(fl= (fl+ x2 x1) 0.0) (values x2 0.0)]
|
|
[(y . fl> . 0.5)
|
|
(let*-values ([(k x2 x1) (fl2log1p-reduction x2 x1 a2 a1 y)]
|
|
[(y2 y1) (fl2log1p x2 x1)]
|
|
[(z2 z1) (fl2* log2-hi log2-lo k)])
|
|
(fl2+ y2 y1 z2 z1))]
|
|
[else
|
|
(let*-values ([(z2 z1) (flexpm1/error y)]
|
|
[(w2 w1) (fl2+ z2 z1 1.0)]
|
|
[(dy2 dy1) (fl2- x2 x1 z2 z1)]
|
|
[(dy2 dy1) (fl2/ dy2 dy1 w2 w1)])
|
|
(fl2+ dy2 dy1 y))]))
|