suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Sped up floor-log/base and ceiling-log/base, and made them correct on flonum inputs.

Browse Source 
This change significantly increases the speed of number formatting, making extreme-bounds-tests.rkt run in about 1/4 the time.

Should consider moving these into racket/math, since floor-log/base generalizes order-of-magnitude.
This commit is contained in:
Neil Toronto 2012-01-27 11:48:25 -07:00
parent 713772959f
commit 47fcdd4916
1 changed files with 19 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
collects/plot/common/math.rkt
View File

@ -168,27 +168,28 @@
[xs (cond [(not (andmap real? xs)) (raise-type-error 'distance "real numbers" xs)] [xs (cond [(not (andmap real? xs)) (raise-type-error 'distance "real numbers" xs)]
[else (sqrt (sum sqr xs))])])) [else (sqrt (sum sqr xs))])]))
(define (exact∘log x)
(define y (log x))
(cond [(infinite? y) (- (inexact->exact (log (numerator x)))
(inexact->exact (log (denominator x))))]
[else (inexact->exact y)]))
(defproc (floor-log/base [b (and/c exact-integer? (>=/c 2))] [x (>/c 0)]) exact-integer? (defproc (floor-log/base [b (and/c exact-integer? (>=/c 2))] [x (>/c 0)]) exact-integer?
(cond [(not (and (exact-integer? b) (b . >= . 2))) (raise-type-error 'floor-log/base (cond [(not (and (exact-integer? b) (b . >= . 2)))
"exact integer >= 2" 0 b x)] (raise-type-error 'floor-log/base "exact integer >= 2" 0 b x)]
[(not (and (real? x) (x . > . 0))) (raise-type-error 'floor-log/base "real > 0" 1 b x)] [(not (and (real? x) (x . > . 0)))
[else (cond [(exact? x) (raise-type-error 'floor-log/base "real > 0" 1 b x)]
(let loop ([y 0] [x x]) [else
(cond [(x . >= . b) (loop (add1 y) (/ x b))] (define q (inexact->exact x))
[(x . < . 1) (loop (sub1 y) (* x b))] (define m (floor (/ (exact∘log q) (inexact->exact (log b)))))
[else y]))] (let loop ([m m] [p (expt b m)])
[else (inexact->exact (floor (/ (log x) (log b))))])])) (cond [(q . < . p) (loop (sub1 m) (/ p b))]
[else (define u (* p b))
(cond [(q . >= . u) (loop (add1 m) u)]
[else m])]))]))
(defproc (ceiling-log/base [b (and/c exact-integer? (>=/c 2))] [x (>/c 0)]) exact-integer? (defproc (ceiling-log/base [b (and/c exact-integer? (>=/c 2))] [x (>/c 0)]) exact-integer?
(cond [(not (and (exact-integer? b) (b . >= . 2))) (raise-type-error 'floor-log/base (- (floor-log/base b (/ (inexact->exact x)))))
"exact integer >= 2" 0 b x)]
[(not (and (real? x) (x . > . 0))) (raise-type-error 'floor-log/base "real > 0" 1 b x)]
[else (cond [(exact? x)
(let loop ([y 0] [x x])
(cond [(x . > . 1) (loop (add1 y) (/ x b))]
[(x . <= . (/ 1 b)) (loop (sub1 y) (* x b))]
[else y]))]
[else (inexact->exact (ceiling (/ (log x) (log b))))])]))
(defproc (polar->cartesian [θ real?] [r real?]) (vector/c real? real?) (defproc (polar->cartesian [θ real?] [r real?]) (vector/c real? real?)
(cond [(not (real? θ)) (raise-type-error 'polar->cartesian "real number" 0 θ r)] (cond [(not (real? θ)) (raise-type-error 'polar->cartesian "real number" 0 θ r)]