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