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

Some style things.

Browse Source
This commit is contained in:
Eli Barzilay 2012-06-14 17:27:32 -04:00
parent 2d902e8bf1
commit fac76a56f8
1 changed files with 90 additions and 96 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

68
collects/racket/math.rkt
View File

@ -104,24 +104,23 @@
(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)))]
[inverse-exact-log10 (/ (exact-log 10))])
(λ (r)
(unless (and (real? r) (positive? r)
(not (= r +inf.0)))
(unless (and (real? r) (positive? r) (not (= r +inf.0)))
(raise-argument-error 'order-of-magnitude "(and/c (>/c 0.0) (not/c +inf.0))" r))
(let* ([q (inexact->exact r)]
[m
(floor
(* (- (exact-log (numerator q)) (exact-log (denominator q)))
inverse-exact-log10))])
(let loop ((m m) (p (expt 10 m)))
(if (< q p) (loop (sub1 m) (* p 1/10))
(let ((u (* p 10)))
(if (>= q u) (loop (add1 m) u) m))))))))
(define q (inexact->exact r))
(define m
(floor (* (- (exact-log (numerator q)) (exact-log (denominator q)))
inverse-exact-log10)))
(let loop ([m m] [p (expt 10 m)])
(if (< q p)
(loop (sub1 m) (* p 1/10))
(let ([u (* p 10)])
(if (>= q u) (loop (add1 m) u) m)))))))
#|
;; Timing tests below provided by Jos Koot for the order-of-magnitude function
@ -136,19 +135,16 @@
(define-syntax timer
(syntax-rules ()
((_ type iter k expr)
(let*
((output-string (open-output-string))
(result expr)
(dummy
(parameterize ((current-output-port output-string))
(time (for ((k (in-range iter))) expr))))
(input-string (open-input-string (get-output-string output-string))))
(parameterize ((current-input-port input-string))
(let
((cpu (begin (read) (read) (read)))
(real (begin (read) (read) (read)))
(gc (begin (read) (read) (read)))
(micro (/ iter 1000)))
(let* ([output-string (open-output-string)]
[result expr]
[dummy (parameterize ([current-output-port output-string])
(time (for ([k (in-range iter)]) expr)))]
[input-string (open-input-string (get-output-string output-string))])
(parameterize ([current-input-port input-string])
(let ([cpu (begin (read) (read) (read))]
[real (begin (read) (read) (read))]
[gc (begin (read) (read) (read))]
[micro (/ iter 1000)])
(if (and (>= cpu 0) (>= real 0) (>= gc 0))
((fmt
"'test type : ' d/
@ -168,20 +164,18 @@
((fmt "'incorrect times for k='i//" 'current) k))))
result))))
(let* ((max-expt 10000) (small (expt 10 (- (* 2 max-expt)))) (iter 1000))
(for ((k (in-range (- max-expt) (add1 max-expt) (/ max-expt 10))))
(let* ((q (expt 10 k)) (qq (- q small)) (qqq (+ q small)))
(unless
(= k (timer "exact power of 10" iter k (order-of-magnitude q)))
(let* ([max-expt 10000] [small (expt 10 (- (* 2 max-expt)))] [iter 1000])
(for ([k (in-range (- max-expt) (add1 max-expt) (/ max-expt 10))])
(let* ([q (expt 10 k)] [qq (- q small)] [qqq (+ q small)])
(unless (= k (timer "exact power of 10" iter k (order-of-magnitude q)))
(error 'test-1 "~s" k))
(unless
(= (sub1 k)
(timer "slightly less than power of 10" iter k (order-of-magnitude qq)))
(unless (= (sub1 k)
(timer "slightly less than power of 10"
iter k (order-of-magnitude qq)))
(error 'test-2 "~s" k))
(unless
(= k
(timer "slightly more than power of 10" iter k (order-of-magnitude qqq)))
(unless (= k
(timer "slightly more than power of 10"
iter k (order-of-magnitude qqq)))
(error 'test-3 "~s" k)))))
|#