Added nan?, infinite?, degrees->radians, radians->degrees, exact-round, exact-floor, exact-ceiling, exact-truncate to racket/math
Altered TR's random arithmetic testing to generate single-flonums and very small flonums; fails now because of erroneous types Fixes to sgn, sinh, cosh, and tanh: * preserve single-flonum-ness * correct zero sign (-0.0) for negative return values that are smaller than epsilon * correct behavior with NaN and infinite inputs
This commit is contained in:
Neil Toronto
parent
c089b2fa50
commit
a713ca8a8b
|
|
@ -1132,9 +1132,6 @@ the mask bitmap and the original bitmap are all together in a single bytes!
|
|||
(values (abs rotated-width)
|
||||
(abs rotated-height)))]))
|
||||
|
||||
(define (degrees->radians θ)
|
||||
(* θ 2 pi (/ 360)))
|
||||
|
||||
(define (mode-color->smoothing mode color)
|
||||
(cond
|
||||
[(and (eq? mode 'outline)
|
||||
|
|
|
|||
|
|
@ -1,6 +1,7 @@
|
|||
#lang racket
|
||||
|
||||
(require racket/contract racket/unsafe/ops unstable/flonum unstable/latent-contract/defthing)
|
||||
(require racket/contract racket/unsafe/ops
|
||||
unstable/flonum unstable/latent-contract/defthing)
|
||||
|
||||
(provide (all-defined-out))
|
||||
|
||||
|
|
@ -13,12 +14,6 @@
|
|||
;; ===================================================================================================
|
||||
;; Flonums
|
||||
|
||||
(defproc (nan? [x any/c]) boolean?
|
||||
(eqv? x +nan.0))
|
||||
|
||||
(defproc (infinite? [x any/c]) boolean?
|
||||
(and (flonum? x) (or (unsafe-fl= x +inf.0) (unsafe-fl= x -inf.0))))
|
||||
|
||||
(defproc (flblend [x flonum?] [y flonum?] [α flonum?]) flonum?
|
||||
(cond [(not (flonum? x)) (raise-type-error 'flblend "flonum" 0 x y α)]
|
||||
[(not (flonum? y)) (raise-type-error 'flblend "flonum" 1 x y α)]
|
||||
|
|
@ -121,17 +116,6 @@
|
|||
(cond [(real? y) (max2* m y)]
|
||||
[else (apply raise-type-error 'max* "real number" i x xs)]))])]))
|
||||
|
||||
(define 180/pi (/ 180 pi))
|
||||
(define pi/180 (/ pi 180))
|
||||
|
||||
(defproc (degrees->radians [d real?]) real?
|
||||
(cond [(not (real? d)) (raise-type-error 'degrees->radians "real number" d)]
|
||||
[else (* d pi/180)]))
|
||||
|
||||
(defproc (radians->degrees [r real?]) real?
|
||||
(cond [(not (real? r)) (raise-type-error 'radians->degrees "real number" r)]
|
||||
[else (* r 180/pi)]))
|
||||
|
||||
(defproc (blend [x real?] [y real?] [α real?]) real?
|
||||
(cond [(not (real? x)) (raise-type-error 'blend "real number" 0 x y α)]
|
||||
[(not (real? y)) (raise-type-error 'blend "real number" 1 x y α)]
|
||||
|
|
@ -475,17 +459,21 @@
|
|||
(if x (if y (max* x y) x)
|
||||
(if y y #f)))
|
||||
|
||||
(define (maybe-real? x)
|
||||
(or (real? x) (not x)))
|
||||
|
||||
(struct ivl (min max) #:transparent
|
||||
#:guard (λ (a b _)
|
||||
(cond [(or (nan? a) (nan? b)) (values +nan.0 +nan.0)]
|
||||
[(and a b) (values (min* a b) (max* a b))]
|
||||
[else (values a b)])))
|
||||
(cond [(or (and a (nan? a)) (and b (nan? b))) (values +nan.0 +nan.0)]
|
||||
[(and a b) (values (min* a b) (max* a b))]
|
||||
[else (values a b)])))
|
||||
|
||||
(defthing empty-ivl ivl? (ivl +nan.0 +nan.0))
|
||||
(defthing unknown-ivl ivl? (ivl #f #f))
|
||||
|
||||
(defproc (ivl-empty? [i ivl?]) boolean?
|
||||
(nan? (ivl-min i)))
|
||||
(define a (ivl-min i))
|
||||
(and a (nan? a)))
|
||||
|
||||
(defproc (ivl-known? [i ivl?]) boolean?
|
||||
(match-define (ivl a b) i)
|
||||
|
|
|
|||
|
|
@ -5,10 +5,10 @@
|
|||
(require "../common/math.rkt")
|
||||
(provide equal?*
|
||||
;; Flonums
|
||||
nan? infinite? flblend flsum fldistance (activate-contract-out flonum-ok-for-range?)
|
||||
flblend flsum fldistance (activate-contract-out flonum-ok-for-range?)
|
||||
;; Reals
|
||||
maybe-inexact->exact
|
||||
min* max* degrees->radians radians->degrees blend atan2 sum real-modulo distance
|
||||
min* max* blend atan2 sum real-modulo distance
|
||||
floor-log/base ceiling-log/base
|
||||
polar->cartesian 3d-polar->3d-cartesian
|
||||
;; Vectors
|
||||
|
|
|
|||
|
|
@ -238,14 +238,6 @@ Integer brush styles repeat starting at @(racket 7).
|
|||
@;----------------------------------------------------------------------------------------------------
|
||||
@subsection{Real Functions}
|
||||
|
||||
@doc-apply[degrees->radians]{
|
||||
Converts degrees to radians.
|
||||
}
|
||||
|
||||
@doc-apply[radians->degrees]{
|
||||
Converts radians to degrees.
|
||||
}
|
||||
|
||||
@doc-apply[polar->cartesian]{
|
||||
Converts 2D polar coordinates to 3D cartesian coordinates.
|
||||
}
|
||||
|
|
@ -255,18 +247,6 @@ Converts 3D polar coordinates to 3D cartesian coordinates.
|
|||
See @racket[parametric3d] for an example of use.
|
||||
}
|
||||
|
||||
@doc-apply[infinite?]{
|
||||
Returns @racket[#t] if @racket[x] is either @racket[+inf.0] or @racket[-inf.0].
|
||||
@examples[#:eval plot-eval
|
||||
(map infinite? (list +inf.0 -inf.0 0 'bob))]
|
||||
}
|
||||
|
||||
@doc-apply[nan?]{
|
||||
Returns @racket[#t] if @racket[x] is @racket[+nan.0].
|
||||
@examples[#:eval plot-eval
|
||||
(map nan? (list +nan.0 +inf.0 0 'bob))]
|
||||
}
|
||||
|
||||
@doc-apply[ceiling-log/base]{
|
||||
Like @racket[(ceiling (/ (log x) (log b)))], but @racket[ceiling-log/base] is not susceptible to floating-point error.
|
||||
@examples[#:eval plot-eval
|
||||
|
|
|
|||
|
|
@ -4,42 +4,105 @@
|
|||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
#lang racket/base
|
||||
(provide pi
|
||||
|
||||
(require "unsafe/ops.rkt"
|
||||
"performance-hint.rkt")
|
||||
|
||||
(provide pi pi.f
|
||||
nan? infinite?
|
||||
sqr
|
||||
sgn conjugate
|
||||
sinh cosh tanh
|
||||
degrees->radians radians->degrees
|
||||
exact-round exact-floor exact-ceiling exact-truncate
|
||||
order-of-magnitude)
|
||||
|
||||
(define (sqr z)
|
||||
(unless (number? z) (raise-argument-error 'sqr "number?" z))
|
||||
(* z z))
|
||||
|
||||
(define pi (atan 0 -1))
|
||||
(define pi.f (atan 0.0f0 -1.0f0))
|
||||
|
||||
;; sgn function
|
||||
(define (sgn x)
|
||||
(unless (real? x) (raise-argument-error 'sgn "real?" x))
|
||||
(if (exact? x)
|
||||
(cond [(< x 0) -1] [(> x 0) 1] [else 0])
|
||||
(cond [(< x 0.0) -1.0] [(> x 0.0) 1.0] [else 0.0])))
|
||||
|
||||
;; complex conjugate
|
||||
(define (conjugate z)
|
||||
(unless (number? z) (raise-argument-error 'conjugate "number?" z))
|
||||
(make-rectangular (real-part z) (- (imag-part z))))
|
||||
|
||||
;; real hyperbolic functions
|
||||
(define (sinh x)
|
||||
(unless (number? x) (raise-argument-error 'sinh "number?" x))
|
||||
(/ (- (exp x) (exp (- x))) 2.0))
|
||||
|
||||
(define (cosh x)
|
||||
(unless (number? x) (raise-argument-error 'cosh "number?" x))
|
||||
(/ (+ (exp x) (exp (- x))) 2.0))
|
||||
|
||||
(define (tanh x)
|
||||
(unless (number? x) (raise-argument-error 'tanh "number?" x))
|
||||
(/ (sinh x) (cosh x)))
|
||||
(begin-encourage-inline
|
||||
|
||||
;; real predicates
|
||||
(define (nan? x)
|
||||
(unless (real? x) (raise-argument-error 'nan? "real?" x))
|
||||
(or (eqv? x +nan.0) (eqv? x +nan.f)))
|
||||
|
||||
(define (infinite? x)
|
||||
(unless (real? x) (raise-argument-error 'infinite? "real?" x))
|
||||
(or (= x +inf.0) (= x -inf.0)))
|
||||
|
||||
;; z^2
|
||||
(define (sqr z)
|
||||
(unless (number? z) (raise-argument-error 'sqr "number?" z))
|
||||
(* z z))
|
||||
|
||||
;; sgn function
|
||||
(define (sgn x)
|
||||
(unless (real? x) (raise-argument-error 'sgn "real?" x))
|
||||
(cond [(= 0 x) x] ; preserve 0, 0.0 and 0.0f0
|
||||
[(double-flonum? x) (cond [(unsafe-fl> x 0.0) 1.0]
|
||||
[(unsafe-fl< x 0.0) -1.0]
|
||||
[else +nan.0])]
|
||||
[(single-flonum? x) (cond [(> x 0.0f0) 1.0f0]
|
||||
[(< x 0.0f0) -1.0f0]
|
||||
[else +nan.f])]
|
||||
[else (if (> x 0) 1 -1)]))
|
||||
|
||||
;; complex conjugate
|
||||
(define (conjugate z)
|
||||
(unless (number? z) (raise-argument-error 'conjugate "number?" z))
|
||||
(make-rectangular (real-part z) (- (imag-part z))))
|
||||
|
||||
;; complex hyperbolic functions
|
||||
(define (sinh z)
|
||||
(unless (number? z) (raise-argument-error 'sinh "number?" z))
|
||||
(cond [(real? z)
|
||||
(let loop ([z z])
|
||||
(cond [(z . < . 0) (- (loop (- z)))]
|
||||
[else (/ (- (exp z) (exp (- z))) 2)]))]
|
||||
[else (/ (- (exp z) (exp (- z))) 2)]))
|
||||
|
||||
(define (cosh z)
|
||||
(unless (number? z) (raise-argument-error 'cosh "number?" z))
|
||||
(/ (+ (exp z) (exp (- z))) 2))
|
||||
|
||||
(define (tanh z)
|
||||
(unless (number? z) (raise-argument-error 'tanh "number?" z))
|
||||
(cond [(= z 0) z] ; preserve 0, 0.0, -0.0, 0.0f0, 0.0+0.0i, etc.
|
||||
[(real? z)
|
||||
(let loop ([z z])
|
||||
(cond [(z . < . 0) (- (loop (- z)))]
|
||||
[(z . < . 20) (define exp2z (exp (* 2 z)))
|
||||
(/ (- exp2z 1) (+ exp2z 1))]
|
||||
[(z . >= . 20) (if (single-flonum? z) 1.0f0 1.0)]
|
||||
[else z]))] ; +nan.0 or +nan.f
|
||||
[else
|
||||
(define exp2z (exp (* 2 z)))
|
||||
(/ (- exp2z 1) (+ exp2z 1))]))
|
||||
|
||||
;; angle conversion
|
||||
(define (degrees->radians x)
|
||||
(unless (real? x) (raise-argument-error 'degrees->radians "real?" x))
|
||||
(cond [(single-flonum? x) (* x (/ pi.f 180f0))]
|
||||
[else (* x (/ pi 180.0))]))
|
||||
|
||||
(define (radians->degrees x)
|
||||
(unless (real? x) (raise-argument-error 'radians->degrees "real?" x))
|
||||
(cond [(single-flonum? x) (* x (/ 180f0 pi.f))]
|
||||
[else (* x (/ 180.0 pi))]))
|
||||
|
||||
;; inexact->exact composed with round, floor, ceiling, truncate
|
||||
(define-syntax-rule (define-integer-conversion name convert)
|
||||
(define (name x)
|
||||
(unless (real? x) (raise-argument-error 'name "real?" x))
|
||||
(inexact->exact (convert x))))
|
||||
|
||||
(define-integer-conversion exact-round round)
|
||||
(define-integer-conversion exact-floor floor)
|
||||
(define-integer-conversion exact-ceiling ceiling)
|
||||
(define-integer-conversion exact-truncate truncate)
|
||||
|
||||
) ; begin-encourage-inline
|
||||
|
||||
(define order-of-magnitude
|
||||
(let* ([exact-log (λ (x) (inexact->exact (log x)))]
|
||||
|
|
|
|||
|
|
@ -1,6 +1,426 @@
|
|||
(load-relative "loadtest.rktl")
|
||||
(Section 'math)
|
||||
(require scheme/math)
|
||||
(require scheme/math
|
||||
racket/flonum
|
||||
unstable/flonum)
|
||||
|
||||
(define (double=? x y)
|
||||
(and (flonum? y)
|
||||
(let ([x (inexact->exact x)]
|
||||
[y (inexact->exact y)])
|
||||
((abs (- x y)) . < . #e1e-10))))
|
||||
|
||||
(define (single=? x y)
|
||||
(and (single-flonum? y)
|
||||
(let ([x (inexact->exact x)]
|
||||
[y (inexact->exact y)])
|
||||
((abs (- x y)) . < . #e1e-6))))
|
||||
|
||||
;; =========================================================================
|
||||
;; pi
|
||||
|
||||
(test #t single=? #e3.141592653589793238462643383279502884197169399 pi.f)
|
||||
(test #t double=? #e3.141592653589793238462643383279502884197169399 pi)
|
||||
(test pi.f real->single-flonum pi)
|
||||
|
||||
;; =========================================================================
|
||||
;; nan?
|
||||
|
||||
(test #f nan? -1)
|
||||
(test #f nan? 0)
|
||||
(test #f nan? 1)
|
||||
|
||||
(test #t nan? +nan.f)
|
||||
(test #f nan? -inf.f)
|
||||
(test #f nan? -1.0f0)
|
||||
(test #f nan? -0.0f0)
|
||||
(test #f nan? 0.0f0)
|
||||
(test #f nan? 1.0f0)
|
||||
(test #f nan? +inf.f)
|
||||
|
||||
(test #t nan? +nan.0)
|
||||
(test #f nan? -inf.0)
|
||||
(test #f nan? -max.0)
|
||||
(test #f nan? -1.0)
|
||||
(test #f nan? -min.0)
|
||||
(test #f nan? -0.0)
|
||||
(test #f nan? 0.0)
|
||||
(test #f nan? +min.0)
|
||||
(test #f nan? 1.0)
|
||||
(test #f nan? +max.0)
|
||||
(test #f nan? +inf.0)
|
||||
|
||||
;; =========================================================================
|
||||
;; infinite?
|
||||
|
||||
(test #f infinite? -1)
|
||||
(test #f infinite? 0)
|
||||
(test #f infinite? 1)
|
||||
|
||||
(test #f infinite? +nan.f)
|
||||
(test #t infinite? -inf.f)
|
||||
(test #f infinite? -1.0f0)
|
||||
(test #f infinite? -0.0f0)
|
||||
(test #f infinite? 0.0f0)
|
||||
(test #f infinite? 1.0f0)
|
||||
(test #t infinite? +inf.f)
|
||||
|
||||
(test #f infinite? +nan.0)
|
||||
(test #t infinite? -inf.0)
|
||||
(test #f infinite? -max.0)
|
||||
(test #f infinite? -1.0)
|
||||
(test #f infinite? -min.0)
|
||||
(test #f infinite? -0.0)
|
||||
(test #f infinite? 0.0)
|
||||
(test #f infinite? +min.0)
|
||||
(test #f infinite? 1.0)
|
||||
(test #f infinite? +max.0)
|
||||
(test #t infinite? +inf.0)
|
||||
|
||||
;; =========================================================================
|
||||
;; sqr
|
||||
|
||||
(test 4 sqr -2)
|
||||
(test 1 sqr -1)
|
||||
(test 0 sqr 0)
|
||||
(test 1 sqr 1)
|
||||
(test 4 sqr 2)
|
||||
|
||||
(test +nan.f sqr +nan.f)
|
||||
(test +inf.f sqr -inf.f)
|
||||
(test 4.0f0 sqr -2.0f0)
|
||||
(test 1.0f0 sqr -1.0f0)
|
||||
(test 0.0f0 sqr -0.0f0)
|
||||
(test 0.0f0 sqr 0.0f0)
|
||||
(test 1.0f0 sqr 1.0f0)
|
||||
(test 4.0f0 sqr 2.0f0)
|
||||
(test +inf.f sqr +inf.f)
|
||||
|
||||
(test +nan.0 sqr +nan.0)
|
||||
(test +inf.0 sqr -inf.0)
|
||||
(test +inf.0 sqr -max.0)
|
||||
(test 4.0 sqr -2.0)
|
||||
(test 1.0 sqr -1.0)
|
||||
(test 0.0 sqr -min.0)
|
||||
(test 0.0 sqr -0.0)
|
||||
(test 0.0 sqr 0.0)
|
||||
(test 0.0 sqr +min.0)
|
||||
(test 1.0 sqr 1.0)
|
||||
(test 4.0 sqr 2.0)
|
||||
(test +inf.0 sqr +max.0)
|
||||
(test +inf.0 sqr +inf.0)
|
||||
|
||||
;; =========================================================================
|
||||
;; sgn
|
||||
|
||||
(test -1 sgn -2)
|
||||
(test -1 sgn -1)
|
||||
(test 0 sgn 0)
|
||||
(test 1 sgn 1)
|
||||
(test 1 sgn 2)
|
||||
|
||||
(test +nan.f sgn +nan.f)
|
||||
(test -1.0f0 sgn -inf.f)
|
||||
(test -1.0f0 sgn -1.0f0)
|
||||
(test -0.0f0 sgn -0.0f0)
|
||||
(test 0.0f0 sgn 0.0f0)
|
||||
(test 1.0f0 sgn 1.0f0)
|
||||
(test 1.0f0 sgn +inf.f)
|
||||
|
||||
(test +nan.0 sgn +nan.0)
|
||||
(test -1.0 sgn -inf.0)
|
||||
(test -1.0 sgn -max.0)
|
||||
(test -1.0 sgn -1.0)
|
||||
(test -1.0 sgn -min.0)
|
||||
(test -0.0 sgn -0.0)
|
||||
(test 0.0 sgn 0.0)
|
||||
(test 1.0 sgn +min.0)
|
||||
(test 1.0 sgn 1.0)
|
||||
(test 1.0 sgn +max.0)
|
||||
(test 1.0 sgn +inf.0)
|
||||
|
||||
;; =========================================================================
|
||||
;; sinh
|
||||
|
||||
(define sinh+1 1.1752011936438014568823818505956008151557179813341)
|
||||
(define sinh-1 (- sinh+1))
|
||||
|
||||
(test #t double=? sinh-1 (sinh -1))
|
||||
(test 0 sinh 0)
|
||||
(test #t double=? sinh+1 (sinh 1))
|
||||
|
||||
(test +nan.f sinh +nan.f)
|
||||
(test -inf.f sinh -inf.f)
|
||||
(test #t single=? sinh-1 (sinh -1.0f0))
|
||||
(test 0.0f0 sinh 0.0f0)
|
||||
(test #t single=? sinh+1 (sinh 1.0f0))
|
||||
(test +inf.f sinh +inf.f)
|
||||
|
||||
(test +nan.0 sinh +nan.0)
|
||||
(test -inf.0 sinh -inf.0)
|
||||
(test -inf.0 sinh -max.0)
|
||||
(test #t double=? sinh-1 (sinh -1.0))
|
||||
(test -0.0 sinh -min.0)
|
||||
(test -0.0 sinh -0.0)
|
||||
(test 0.0 sinh 0.0)
|
||||
(test 0.0 sinh +min.0)
|
||||
(test #t double=? sinh+1 (sinh 1.0))
|
||||
(test +inf.0 sinh +max.0)
|
||||
(test +inf.0 sinh +inf.0)
|
||||
|
||||
;; =========================================================================
|
||||
;; cosh
|
||||
|
||||
(define cosh+1 #e1.5430806348152437784779056207570616826015291123659)
|
||||
|
||||
(test #t double=? cosh+1 (cosh -1))
|
||||
(test 1 cosh 0)
|
||||
(test #t double=? cosh+1 (cosh 1))
|
||||
|
||||
(test +nan.f cosh +nan.f)
|
||||
(test +inf.f cosh -inf.f)
|
||||
(test #t single=? cosh+1 (cosh -1.0f0))
|
||||
(test 1.0f0 cosh -0.0f0)
|
||||
(test 1.0f0 cosh 0.0f0)
|
||||
(test #t single=? cosh+1 (cosh 1.0f0))
|
||||
(test +inf.f cosh +inf.f)
|
||||
|
||||
(test +nan.0 cosh +nan.0)
|
||||
(test +inf.0 cosh -inf.0)
|
||||
(test +inf.0 cosh -max.0)
|
||||
(test #t double=? cosh+1 (cosh -1.0))
|
||||
(test 1.0 cosh -min.0)
|
||||
(test 1.0 cosh -0.0)
|
||||
(test 1.0 cosh 0.0)
|
||||
(test 1.0 cosh +min.0)
|
||||
(test #t double=? cosh+1 (cosh 1.0))
|
||||
(test +inf.0 cosh +max.0)
|
||||
(test +inf.0 cosh +inf.0)
|
||||
|
||||
;; =========================================================================
|
||||
;; tanh
|
||||
|
||||
(define tanh+1 #e0.76159415595576488811945828260479359041276859725794)
|
||||
(define tanh-1 (- tanh+1))
|
||||
|
||||
(test -1.0 tanh -20)
|
||||
(test #t double=? tanh-1 (tanh -1))
|
||||
(test 0 tanh 0)
|
||||
(test #t double=? tanh+1 (tanh 1))
|
||||
(test 1.0 tanh 20)
|
||||
|
||||
(test +nan.f tanh +nan.f)
|
||||
(test -1.0f0 tanh -inf.f)
|
||||
(test -1.0f0 tanh -20.0f0)
|
||||
(test #t single=? tanh-1 (tanh -1.0f0))
|
||||
(test -0.0f0 tanh -0.0f0)
|
||||
(test 0.0f0 tanh 0.0f0)
|
||||
(test #t single=? tanh+1 (tanh 1.0f0))
|
||||
(test 1.0f0 tanh 20.0f0)
|
||||
(test 1.0f0 tanh +inf.f)
|
||||
|
||||
(test +nan.0 tanh +nan.0)
|
||||
(test -1.0 tanh -inf.0)
|
||||
(test -1.0 tanh -max.0)
|
||||
(test -1.0 tanh -20.0)
|
||||
(test #t double=? tanh-1 (tanh -1.0))
|
||||
(test -0.0 tanh -min.0)
|
||||
(test -0.0 tanh -0.0)
|
||||
(test 0.0 tanh 0.0)
|
||||
(test 0.0 tanh +min.0)
|
||||
(test #t double=? tanh+1 (tanh 1.0))
|
||||
(test 1.0 tanh 20.0)
|
||||
(test 1.0 tanh +max.0)
|
||||
(test 1.0 tanh +inf.0)
|
||||
|
||||
;; =========================================================================
|
||||
;; degrees->radians
|
||||
|
||||
(test #t double=? (- pi) (degrees->radians -180))
|
||||
(test #t double=? (* -1/2 pi) (degrees->radians -90))
|
||||
(test 0 degrees->radians 0)
|
||||
(test #t double=? (* 1/2 pi) (degrees->radians 90))
|
||||
(test #t double=? pi (degrees->radians 180))
|
||||
|
||||
(test +nan.f degrees->radians +nan.f)
|
||||
(test -inf.f degrees->radians -inf.f)
|
||||
(test #t single=? (- pi) (degrees->radians -180.0f0))
|
||||
(test #t single=? (* -1/2 pi) (degrees->radians -90.0f0))
|
||||
(test -0.0f0 degrees->radians -0.0f0)
|
||||
(test 0.0f0 degrees->radians 0.0f0)
|
||||
(test #t single=? (* 1/2 pi) (degrees->radians 90.0f0))
|
||||
(test #t single=? pi (degrees->radians 180.0f0))
|
||||
(test +inf.f degrees->radians +inf.f)
|
||||
|
||||
(test +nan.0 degrees->radians +nan.0)
|
||||
(test -inf.0 degrees->radians -inf.0)
|
||||
(test #t double=? (- pi) (degrees->radians -180.0))
|
||||
(test #t double=? (* -1/2 pi) (degrees->radians -90.0))
|
||||
(test -0.0 degrees->radians -min.0)
|
||||
(test -0.0 degrees->radians -0.0)
|
||||
(test 0.0 degrees->radians 0.0)
|
||||
(test 0.0 degrees->radians +min.0)
|
||||
(test #t double=? (* 1/2 pi) (degrees->radians 90.0))
|
||||
(test #t double=? pi (degrees->radians 180.0))
|
||||
(test +inf.0 degrees->radians +inf.0)
|
||||
|
||||
;; =========================================================================
|
||||
;; radians->degrees
|
||||
|
||||
(test 0 radians->degrees 0)
|
||||
|
||||
(test +nan.f radians->degrees +nan.f)
|
||||
(test -inf.f radians->degrees -inf.f)
|
||||
(test #t single=? -180 (radians->degrees (- pi.f)))
|
||||
(test #t single=? -90 (radians->degrees (* -1/2 pi.f)))
|
||||
(test -0.0f0 radians->degrees -0.0f0)
|
||||
(test 0.0f0 radians->degrees 0.0f0)
|
||||
(test #t single=? 90 (radians->degrees (* 1/2 pi.f)))
|
||||
(test #t single=? 180 (radians->degrees pi.f))
|
||||
(test +inf.f radians->degrees +inf.f)
|
||||
|
||||
(test +nan.0 radians->degrees +nan.0)
|
||||
(test -inf.0 radians->degrees -inf.0)
|
||||
(test -inf.0 radians->degrees -max.0)
|
||||
(test #t double=? -180 (radians->degrees (- pi)))
|
||||
(test #t double=? -90 (radians->degrees (* -1/2 pi)))
|
||||
(test -0.0 radians->degrees -0.0)
|
||||
(test 0.0 radians->degrees 0.0)
|
||||
(test #t double=? 90 (radians->degrees (* 1/2 pi)))
|
||||
(test #t double=? 180 (radians->degrees pi))
|
||||
(test +inf.0 radians->degrees +max.0)
|
||||
(test +inf.0 radians->degrees +inf.0)
|
||||
|
||||
;; =========================================================================
|
||||
;; exact-round
|
||||
|
||||
(test -2 exact-round #e-1.5)
|
||||
(test 0 exact-round #e-0.5)
|
||||
(test 0 exact-round #e0.5)
|
||||
(test 2 exact-round #e1.5)
|
||||
|
||||
(err/rt-test (exact-round +nan.f))
|
||||
(err/rt-test (exact-round -inf.f))
|
||||
(test -2 exact-round -1.5f0)
|
||||
(test 0 exact-round -0.5f0)
|
||||
(test 0 exact-round 0.5f0)
|
||||
(test 2 exact-round 1.5f0)
|
||||
(err/rt-test (exact-round +inf.f))
|
||||
|
||||
(err/rt-test (exact-round +nan.0))
|
||||
(err/rt-test (exact-round -inf.0))
|
||||
(test (inexact->exact -max.0) exact-round -max.0)
|
||||
(test -2 exact-round -1.5)
|
||||
(test 0 exact-round -0.5)
|
||||
(test 0 exact-round -min.0)
|
||||
(test 0 exact-round +min.0)
|
||||
(test 0 exact-round 0.5)
|
||||
(test 2 exact-round 1.5)
|
||||
(test (inexact->exact +max.0) exact-round +max.0)
|
||||
(err/rt-test (exact-round +inf.0))
|
||||
|
||||
;; =========================================================================
|
||||
;; exact-floor
|
||||
|
||||
(test -2 exact-floor #e-1.5)
|
||||
(test -1 exact-floor #e-0.5)
|
||||
(test 0 exact-floor #e0.5)
|
||||
(test 1 exact-floor #e1.5)
|
||||
|
||||
(err/rt-test (exact-floor +nan.f))
|
||||
(err/rt-test (exact-floor -inf.f))
|
||||
(test -2 exact-floor -1.5f0)
|
||||
(test -1 exact-floor -0.5f0)
|
||||
(test 0 exact-floor 0.5f0)
|
||||
(test 1 exact-floor 1.5f0)
|
||||
(err/rt-test (exact-floor +inf.f))
|
||||
|
||||
(err/rt-test (exact-floor +nan.0))
|
||||
(err/rt-test (exact-floor -inf.0))
|
||||
(test (inexact->exact -max.0) exact-floor -max.0)
|
||||
(test -2 exact-floor -1.5)
|
||||
(test -1 exact-floor -0.5)
|
||||
(test -1 exact-floor -min.0)
|
||||
(test 0 exact-floor +min.0)
|
||||
(test 0 exact-floor 0.5)
|
||||
(test 1 exact-floor 1.5)
|
||||
(test (inexact->exact +max.0) exact-floor +max.0)
|
||||
(err/rt-test (exact-floor +inf.0))
|
||||
|
||||
;; =========================================================================
|
||||
;; exact-ceiling
|
||||
|
||||
(test -1 exact-ceiling #e-1.5)
|
||||
(test 0 exact-ceiling #e-0.5)
|
||||
(test 1 exact-ceiling #e0.5)
|
||||
(test 2 exact-ceiling #e1.5)
|
||||
|
||||
(err/rt-test (exact-ceiling +nan.f))
|
||||
(err/rt-test (exact-ceiling -inf.f))
|
||||
(test -1 exact-ceiling -1.5f0)
|
||||
(test 0 exact-ceiling -0.5f0)
|
||||
(test 1 exact-ceiling 0.5f0)
|
||||
(test 2 exact-ceiling 1.5f0)
|
||||
(err/rt-test (exact-ceiling +inf.f))
|
||||
|
||||
(err/rt-test (exact-ceiling +nan.0))
|
||||
(err/rt-test (exact-ceiling -inf.0))
|
||||
(test (inexact->exact -max.0) exact-ceiling -max.0)
|
||||
(test -1 exact-ceiling -1.5)
|
||||
(test 0 exact-ceiling -0.5)
|
||||
(test 0 exact-ceiling -min.0)
|
||||
(test 1 exact-ceiling +min.0)
|
||||
(test 1 exact-ceiling 0.5)
|
||||
(test 2 exact-ceiling 1.5)
|
||||
(test (inexact->exact +max.0) exact-ceiling +max.0)
|
||||
(err/rt-test (exact-ceiling +inf.0))
|
||||
|
||||
;; =========================================================================
|
||||
;; exact-truncate
|
||||
|
||||
(test -1 exact-truncate #e-1.5)
|
||||
(test 0 exact-truncate #e-0.5)
|
||||
(test 0 exact-truncate #e0.5)
|
||||
(test 1 exact-truncate #e1.5)
|
||||
|
||||
(err/rt-test (exact-truncate +nan.f))
|
||||
(err/rt-test (exact-truncate -inf.f))
|
||||
(test -1 exact-truncate -1.5f0)
|
||||
(test 0 exact-truncate -0.5f0)
|
||||
(test 0 exact-truncate 0.5f0)
|
||||
(test 1 exact-truncate 1.5f0)
|
||||
(err/rt-test (exact-truncate +inf.f))
|
||||
|
||||
(err/rt-test (exact-truncate +nan.0))
|
||||
(err/rt-test (exact-truncate -inf.0))
|
||||
(test (inexact->exact -max.0) exact-truncate -max.0)
|
||||
(test -1 exact-truncate -1.5)
|
||||
(test 0 exact-truncate -0.5)
|
||||
(test 0 exact-truncate -min.0)
|
||||
(test 0 exact-truncate +min.0)
|
||||
(test 0 exact-truncate 0.5)
|
||||
(test 1 exact-truncate 1.5)
|
||||
(test (inexact->exact +max.0) exact-truncate +max.0)
|
||||
(err/rt-test (exact-truncate +inf.0))
|
||||
|
||||
;; =========================================================================
|
||||
;; comparison with conversion to exact BEFORE integer conversion, in the
|
||||
;; range near where floating-point numbers become integer-only
|
||||
|
||||
(define (test-integer-conversion convert exact-convert)
|
||||
(for* ([y '(-0.75 -0.5 -0.25 0.0 0.25 0.5 0.75)]
|
||||
[e (in-range 50 54)]
|
||||
[i (in-range -1 2)])
|
||||
(define x (+ y (ordinal->flonum (+ i (flonum->ordinal (expt 2.0 e))))))
|
||||
(test (convert (inexact->exact x)) exact-convert x)))
|
||||
|
||||
(test-integer-conversion round exact-round)
|
||||
(test-integer-conversion floor exact-floor)
|
||||
(test-integer-conversion ceiling exact-ceiling)
|
||||
(test-integer-conversion truncate exact-truncate)
|
||||
|
||||
;; =========================================================================
|
||||
;; order-of-magnitude
|
||||
|
||||
(test 0 order-of-magnitude 1)
|
||||
(test 0 order-of-magnitude 9)
|
||||
|
|
@ -16,14 +436,3 @@
|
|||
(test 4 order-of-magnitude 10000)
|
||||
(test -2 order-of-magnitude 1/100)
|
||||
(test -3 order-of-magnitude 1/101)
|
||||
|
||||
(test 25 sqr 5)
|
||||
(test 25 sqr -5)
|
||||
|
||||
(test #t <= (abs (sin pi)) 0.0001)
|
||||
|
||||
(test 1 sgn 1)
|
||||
(test -1 sgn -1)
|
||||
(test 0 sgn 0)
|
||||
(test 1 sgn 999)
|
||||
(test -1 sgn -999)
|
||||
|
|
|
|||
|
|
@ -3,7 +3,7 @@
|
|||
;; Random testing of type preservation for floats.
|
||||
|
||||
(require redex
|
||||
racket/flonum racket/unsafe/ops
|
||||
racket/flonum racket/unsafe/ops unstable/flonum
|
||||
racket/sandbox)
|
||||
|
||||
(require (except-in typed-racket/utils/utils infer)
|
||||
|
|
@ -18,6 +18,8 @@
|
|||
(b:init) (n:init)
|
||||
(define-namespace-anchor anch)
|
||||
|
||||
todo: exact numbers
|
||||
|
||||
(define-language tr-arith ; to stay within floats, removed some numeric ops
|
||||
[n real]
|
||||
[E n
|
||||
|
|
@ -99,10 +101,33 @@
|
|||
(define subtype? (subtype type-after type-before))
|
||||
subtype?)
|
||||
|
||||
(define (random-integer->random-float E)
|
||||
(define r (random))
|
||||
(cond
|
||||
;; probability 1/4: noisify and convert to single flonum
|
||||
[(r . < . 0.25)
|
||||
(real->single-flonum (* (random) E))]
|
||||
;; probability 1/4: noisify and convert to double flonum
|
||||
[(r . < . 0.5)
|
||||
(real->double-flonum (* (random) E))]
|
||||
;; probability 1/4: convert to very small double flonum
|
||||
[(r . < . 0.75)
|
||||
(define x (ordinal->flonum E))
|
||||
(cond [(= x 0.0) (if ((random) . < . 0.5) 0.0 -0.0)]
|
||||
[else x])]
|
||||
;; probability 1/20: +nan.0
|
||||
[(r . < . 0.8)
|
||||
+nan.0]
|
||||
;; remaining probability: convert to very large double flonum
|
||||
[else
|
||||
(if ((random) . < . 0.5)
|
||||
(flstep -inf.0 E)
|
||||
(flstep +inf.0 (- E)))]))
|
||||
|
||||
;; Redex can't generate floats, so we convert ints to floats.
|
||||
(define (exp->float-exp E) ; numbers or symbols or lists
|
||||
(cond [(number? E)
|
||||
(exact->inexact (* (random) E))] ; add noise
|
||||
(random-integer->random-float E)]
|
||||
[(list? E)
|
||||
(map exp->float-exp E)]
|
||||
[else
|
||||
|
|
|
|||
|
|
@ -1808,7 +1808,8 @@
|
|||
(-NegRat . -> . -NegFixnum) ; -1
|
||||
(-NonPosRat . -> . -NonPosFixnum) ; 0 or -1
|
||||
(-Rat . -> . -Fixnum)
|
||||
(-InexactReal . -> . -Flonum) ; single-flonums give a flonum result
|
||||
(-Flonum . -> . -Flonum)
|
||||
(-SingleFlonum . -> . -SingleFlonum)
|
||||
(-Real . -> . -Real))]
|
||||
|
||||
[pi -PosFlonum]
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user