5a43f2c6bc
Cleaned up other docs in preparation for alpha-testing announcement Created `math/utils' module for stuff that doesn't go anywhere else (e.g. FFT scaling convention, max-math-threads parameters) Reduced the number of macros that expand to applications of `array-map' Added `flvector-sum', defined `flsum' in terms of it Reduced the number of pointwise `flvector', `flarray' and `fcarray' operations Reworked `inline-build-flvector' and `inline-flvector-map' to be faster and expand to less code in both typed and untyped Racket Redefined conversions like `list->flvector' in terms of for loops (can do it now that TR has working `for/flvector:', etc.)
138 lines
4.6 KiB
Racket
138 lines
4.6 KiB
Racket
#lang typed/racket/base
|
|
|
|
(require racket/flonum
|
|
"../flonum/flvector.rkt"
|
|
"../flonum/flonum-functions.rkt"
|
|
"../flonum/flonum-more-functions.rkt")
|
|
|
|
(provide power-of-two?
|
|
absolute-error
|
|
relative-error
|
|
sum
|
|
asinh acosh atanh
|
|
float-complex?
|
|
inline-number->float-complex
|
|
number->float-complex)
|
|
|
|
;; Returns #t if x is an integer power of 2
|
|
(: power-of-two? (Real -> Boolean))
|
|
(define (power-of-two? x)
|
|
(cond [(not (positive? x)) #f]
|
|
[(flonum? x) (fl= x (flexpt 2.0 (flround (fl/ (fllog x) (fllog 2.0)))))]
|
|
[(single-flonum? x) (power-of-two? (fl x))]
|
|
[(integer? x) (= x (expt 2 (- (integer-length x) 1)))]
|
|
[else (and (= 1 (numerator x))
|
|
(power-of-two? (denominator x)))]))
|
|
|
|
(: fix-exact-return (Real Real Real -> Real))
|
|
(define (fix-exact-return x r e)
|
|
(cond [(or (single-flonum? x) (single-flonum? r)) (real->single-flonum e)]
|
|
[(or (flonum? x) (flonum? r)) (fl e)]
|
|
[else e]))
|
|
|
|
(: absolute-error (Real Real -> Real))
|
|
(define (absolute-error x r)
|
|
(fix-exact-return
|
|
x r (cond [(eqv? x r) 0]
|
|
[(and (rational? x) (rational? r))
|
|
(abs (- (inexact->exact x) (inexact->exact r)))]
|
|
[else +inf.0])))
|
|
|
|
(: relative-error (Real Real -> Real))
|
|
(define (relative-error x r)
|
|
(fix-exact-return
|
|
x r (cond [(eqv? x r) 0]
|
|
[(and (zero? x) (zero? r)) 0]
|
|
[(zero? r) +inf.0]
|
|
[(and (rational? x) (rational? r))
|
|
(define exact-r (inexact->exact r))
|
|
(abs (/ (- (inexact->exact x) exact-r) exact-r))]
|
|
[else +inf.0])))
|
|
|
|
(: sum ((Listof Real) -> Real))
|
|
(define (sum xs)
|
|
(let loop ([xs xs]
|
|
[#{r : Exact-Rational} 0]
|
|
[#{fs : (Listof Flonum)} null])
|
|
(cond [(null? xs)
|
|
(cond [(null? fs) r]
|
|
[(zero? r) (flsum fs)]
|
|
[else (fl (+ r (inexact->exact (flsum fs))))])]
|
|
[else
|
|
(let ([x (car xs)]
|
|
[xs (cdr xs)])
|
|
(cond [(double-flonum? x) (loop xs r (cons x fs))]
|
|
[(single-flonum? x) (loop xs r (cons (fl x) fs))]
|
|
[else (loop xs (+ x r) fs)]))])))
|
|
|
|
;; ===================================================================================================
|
|
;; Inverse hyperbolic
|
|
|
|
(: asinh (case-> (Zero -> Zero)
|
|
(Float -> Float)
|
|
(Real -> Real)
|
|
(Float-Complex -> Float-Complex)
|
|
(Number -> Number)))
|
|
(define (asinh x)
|
|
(cond [(flonum? x) (flasinh x)]
|
|
[(eqv? x 0) 0]
|
|
[(real? x) (flasinh (fl x))]
|
|
[(float-complex? x) (log (+ x (sqrt (+ (* x x) 1.0))))]
|
|
[else (log (+ x (sqrt (+ (* x x) 1))))]))
|
|
|
|
(: acosh (case-> (One -> Zero)
|
|
(Float -> Float)
|
|
(Real -> Number)
|
|
(Float-Complex -> Float-Complex)
|
|
(Number -> Number)))
|
|
(define (acosh x)
|
|
(cond [(flonum? x) (flacosh x)]
|
|
[(eqv? x 1) 0]
|
|
[(and (real? x) (x . >= . 1)) (flacosh (fl x))]
|
|
[(float-complex? x) (log (+ x (* (sqrt (+ x 1.0)) (sqrt (- x 1.0)))))]
|
|
[else (log (+ x (* (sqrt (+ x 1)) (sqrt (- x 1)))))]))
|
|
|
|
(: atanh (case-> (Zero -> Zero)
|
|
(Float -> Float)
|
|
(Real -> Real)
|
|
(Float-Complex -> Float-Complex)
|
|
(Number -> Number)))
|
|
(define (atanh x)
|
|
(cond [(flonum? x) (flatanh x)]
|
|
[(eqv? x 0) 0]
|
|
[(real? x) (flatanh (fl x))]
|
|
[(float-complex? x) (* 0.5 (- (log (+ 1.0 x)) (log (- 1.0 x))))]
|
|
[else (* 1/2 (- (log (+ 1 x)) (log (- 1 x))))]))
|
|
|
|
;; ===================================================================================================
|
|
;; Float-Complex functions
|
|
|
|
(define-predicate float-complex? Float-Complex)
|
|
|
|
(module syntax-defs racket/base
|
|
(require (for-syntax racket/base
|
|
typed/untyped-utils)
|
|
(only-in typed/racket/base : Number let:)
|
|
racket/flonum)
|
|
|
|
(provide inline-number->float-complex)
|
|
|
|
(define-syntax (inline-number->float-complex stx)
|
|
(syntax-case stx ()
|
|
[(_ z-expr)
|
|
(syntax/loc stx
|
|
(let: ([z : Number z-expr])
|
|
(if (number? z)
|
|
(make-rectangular (real->double-flonum (real-part z))
|
|
(real->double-flonum (imag-part z)))
|
|
(raise-argument-error 'number->float-complex "number?" z))))]))
|
|
|
|
) ; module
|
|
|
|
(require 'syntax-defs)
|
|
|
|
(: number->float-complex (Number -> Float-Complex))
|
|
(define (number->float-complex z)
|
|
(make-rectangular (fl (real-part z))
|
|
(fl (imag-part z))))
|