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

Propagated Eli's changes to the mandelbrot benchmark to the generic

Browse Source 
and typed versions.
This commit is contained in:
Vincent St-Amour 2010-06-21 16:57:47 -04:00
parent 192c1fa995
commit bc794b443c
3 changed files with 124 additions and 199 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

107
collects/tests/racket/benchmarks/shootout/mandelbrot-generic.rkt
View File

@ -2,78 +2,49 @@
;; The Computer Language Benchmarks Game ;; The Computer Language Benchmarks Game
;; http://shootout.alioth.debian.org/ ;; http://shootout.alioth.debian.org/
;;
;; Derived from the Chicken variant, which was
;; Contributed by Anthony Borla
;; The version that uses complex number is a little (require (for-syntax racket/base))
;; more elegant, but much slower:
;; (define (mandelbrot iterations x y n ci)
;; (let ((c (+ (- (/ (* 2.0 x) n) 1.5)
;; (* ci 0.0+1.0i))))
;; (let loop ((i 0) (z 0.0+0.0i))
;; (cond
;; [(> i iterations) 1]
;; [(> (magnitude z) 2.0) 0]
;; [else (loop (add1 i) (+ (* z z) c))]))))
(require racket/cmdline) (require racket/cmdline)
(define +limit-sqr+ 4.0) (define O (current-output-port))
(define +iterations+ 50) (define LIMIT-SQR 4.0)
(define ITERATIONS 50)
(define N (command-line #:args (n) (string->number n)))
(define N.0 (exact->inexact N))
(define 2/N (/ 2.0 N.0))
(define Crs
(let ([v (make-vector N)])
(for ([x (in-range N)])
(vector-set! v x (- (/ (* 2 x) N.0) 1.5)))
v))
;; ------------------------------- (define-syntax (let-n stx)
(syntax-case stx ()
[(_ N bindings E)
(let loop ([N (syntax-e #'N)] [E #'E])
(if (zero? N) E (loop (sub1 N) #`(let bindings #,E))))]))
(define (mandelbrot iterations x y n ci) (define-syntax-rule (mandelbrot Cr Ci)
(let ((cr (- (/ (* 2.0 x) n) 1.5))) (let loop ([i 0] [Zr 0.0] [Zi 0.0])
(let loop ((i 0) (zr 0.0) (zi 0.0)) (cond [(> (+ (* Zr Zr) (* Zi Zi)) LIMIT-SQR) 0]
(if (> i iterations) [(= i ITERATIONS) 1]
1 [else (let-n 5 ([Zr (+ (- (* Zr Zr) (* Zi Zi)) Cr)]
(let ((zrq (* zr zr)) [Zi (+ (* 2.0 (* Zr Zi)) Ci)])
(ziq (* zi zi))) (loop (+ i 5) Zr Zi))])))
(cond
((> (+ zrq ziq) +limit-sqr+) 0)
(else (loop (add1 i)
(+ (- zrq ziq) cr)
(+ (* 2.0 zr zi) ci)))))))))
;; ------------------------------- (fprintf O "P4\n~a ~a\n" N N)
(let loop-y ([y N])
(define (main n) (let ([Ci (- (* 2/N y) 1.0)])
(let ((out (current-output-port))) (let loop-x ([x 0] [bitnum 0] [byteacc 0])
(if (< x N)
(fprintf out "P4\n~a ~a\n" n n) (let* ([Cr (vector-ref Crs x)]
[bitnum (+ bitnum 1)]
(let loop-y ((y 0)) [byteacc (+ (arithmetic-shift byteacc 1) (mandelbrot Cr Ci))])
(cond [(= bitnum 8)
(when (< y n) (write-byte byteacc O)
(loop-x (+ x 1) 0 0)]
(let ([ci (- (/ (* 2.0 y) n) 1.0)]) [else (loop-x (+ x 1) bitnum byteacc)]))
(begin (when (> bitnum 0)
(let loop-x ((x 0) (bitnum 0) (byteacc 0)) (write-byte (arithmetic-shift byteacc (- 8 (bitwise-and N #x7))) O))
(when (> y 1) (loop-y (- y 1))))))))
(if (< x n)
(let ([bitnum (add1 bitnum)]
[byteacc (+ (arithmetic-shift byteacc 1)
(mandelbrot +iterations+ x y n ci))])
(cond
((= bitnum 8)
(write-byte byteacc out)
(loop-x (add1 x) 0 0))
[else (loop-x (add1 x) bitnum byteacc)]))
(begin
(when (positive? bitnum)
(write-byte (arithmetic-shift byteacc
(- 8 (bitwise-and n #x7)))
out))
(loop-y (add1 y))))))))))
;; -------------------------------
(command-line #:args (n)
(main (string->number n)))

110
collects/tests/racket/benchmarks/shootout/typed/mandelbrot-generic.rktl
View File

@ -1,80 +1,48 @@
;; The Computer Language Benchmarks Game ;; The Computer Language Benchmarks Game
;; http://shootout.alioth.debian.org/ ;; http://shootout.alioth.debian.org/
;;
;; Derived from the Chicken variant, which was
;; Contributed by Anthony Borla
;; The version that uses complex number is a little (require (for-syntax racket/base))
;; more elegant, but much slower:
;; (define (mandelbrot iterations x y n ci)
;; (let ((c (+ (- (/ (* 2.0 x) n) 1.5)
;; (* ci 0.0+1.0i))))
;; (let loop ((i 0) (z 0.0+0.0i))
;; (cond
;; [(> i iterations) 1]
;; [(> (magnitude z) 2.0) 0]
;; [else (loop (add1 i) (+ (* z z) c))]))))
(require racket/cmdline) (require racket/cmdline)
(define +limit-sqr+ 4.0) (define O (current-output-port))
(define +iterations+ 50) (define LIMIT-SQR 4.0)
(define ITERATIONS 50)
(define N (command-line #:args (n) (assert (string->number (assert n string?)) exact-integer?)))
(define N.0 (exact->inexact N))
(define 2/N (/ 2.0 N.0))
(define Crs
(let ([v (make-vector N 0.0)])
(for ([x (in-range N)])
(vector-set! v x (- (/ (* 2 x) N.0) 1.5)))
v))
;; ------------------------------- (define-syntax (let-n stx)
(syntax-case stx ()
[(_ N bindings E)
(let loop ([N (syntax-e #'N)] [E #'E])
(if (zero? N) E (loop (sub1 N) #`(let bindings #,E))))]))
(: mandelbrot (Integer Integer Integer Integer Float -> (U 0 1))) (define-syntax-rule (mandelbrot Cr Ci)
(define (mandelbrot iterations x y n ci) (let: loop : Integer ([i : Integer 0] [Zr : Float 0.0] [Zi : Float 0.0])
(let ((cr (- (/ (* 2.0 x) n) 1.5))) (cond [(> (+ (* Zr Zr) (* Zi Zi)) LIMIT-SQR) 0]
(let loop ((i 0) (zr 0.0) (zi 0.0)) [(= i ITERATIONS) 1]
(if (> i iterations) [else (let-n 5 ([Zr (+ (- (* Zr Zr) (* Zi Zi)) Cr)]
1 [Zi (+ (* 2.0 (* Zr Zi)) Ci)])
(let ((zrq (* zr zr)) (loop (+ i 5) Zr Zi))])))
(ziq (* zi zi)))
(cond
((> (+ zrq ziq) +limit-sqr+) 0)
(else (loop (add1 i)
(+ (- zrq ziq) cr)
(+ (* 2.0 zr zi) ci)))))))))
;; ------------------------------- (fprintf O "P4\n~a ~a\n" N N)
(let: loop-y : Void ([y : Integer N])
(: main (Integer -> Void)) (let ([Ci (- (* 2/N y) 1.0)])
(define (main n) (let: loop-x : Void ([x : Integer 0] [bitnum : Integer 0] [byteacc : Integer 0])
(let ((out (current-output-port))) (if (< x N)
(let* ([Cr (vector-ref Crs x)]
(fprintf out "P4\n~a ~a\n" n n) [bitnum (+ bitnum 1)]
[byteacc (+ (arithmetic-shift byteacc 1) (mandelbrot Cr Ci))])
(let loop-y ((y 0)) (cond [(= bitnum 8)
(write-byte byteacc O)
(when (< y n) (loop-x (+ x 1) 0 0)]
[else (loop-x (+ x 1) bitnum byteacc)]))
(let ([ci (- (/ (* 2.0 y) n) 1.0)]) (begin (when (> bitnum 0)
(write-byte (arithmetic-shift byteacc (- 8 (bitwise-and N #x7))) O))
(let: loop-x : Void (when (> y 1) (loop-y (- y 1))))))))
((x : Integer 0) (bitnum : Integer 0) (byteacc : Integer 0))
(if (< x n)
(let ([bitnum (add1 bitnum)]
[byteacc (+ (arithmetic-shift byteacc 1)
(mandelbrot +iterations+ x y n ci))])
(cond
((= bitnum 8)
(write-byte byteacc out)
(loop-x (add1 x) 0 0))
[else (loop-x (add1 x) bitnum byteacc)]))
(begin
(when (positive? bitnum)
(write-byte (arithmetic-shift byteacc
(- 8 (bitwise-and n #x7)))
out))
(loop-y (add1 y))))))))))
;; -------------------------------
(command-line #:args (n)
(main (assert (string->number (assert n string?)) exact-integer?)))

106
collects/tests/racket/benchmarks/shootout/typed/mandelbrot.rktl
View File

@ -1,68 +1,54 @@
;; The Computer Language Benchmarks Game ;; The Computer Language Benchmarks Game
;; http://shootout.alioth.debian.org/ ;; http://shootout.alioth.debian.org/
;;
;; Derived from the Chicken variant, which was
;; Contributed by Anthony Borla
(require racket/cmdline
racket/flonum)
(define +limit-sqr+ 4.0) (require racket/require racket/require-syntax (for-syntax racket/base))
(define-require-syntax overriding-in
(syntax-rules () [(_ R1 R2) (combine-in R2 (subtract-in R1 R2))]))
(require (overriding-in
racket/flonum
(filtered-in (lambda (name) (regexp-replace #rx"unsafe-" name ""))
racket/unsafe/ops))
racket/cmdline)
(define +iterations+ 50) (define O (current-output-port))
;; ------------------------------- (define LIMIT-SQR 4.0)
(define ITERATIONS 50)
(define N (command-line #:args (n) (assert (string->number (assert n string?)) exact-integer?)))
(define N.0 (fx->fl N))
(define 2/N (fl/ 2.0 N.0))
(define Crs
(let ([v (make-flvector N)])
(for ([x (in-range N)])
(flvector-set! v x (fl- (fl/ (fx->fl (fx* 2 x)) N.0) 1.5)))
v))
(: mandelbrot (Integer Integer Integer Float -> (U 1 0))) (define-syntax (let-n stx)
(define (mandelbrot x y n ci) (syntax-case stx ()
(let ((cr (fl- (fl/ (fl* 2.0 (->fl x)) (->fl n)) 1.5))) [(_ N bindings E)
(let loop ((i 0) (zr 0.0) (zi 0.0)) (let loop ([N (syntax-e #'N)] [E #'E])
(if (> i +iterations+) (if (zero? N) E (loop (sub1 N) #`(let bindings #,E))))]))
1
(cond
((fl> (fl+ (fl* zr zr) (fl* zi zi)) +limit-sqr+) 0)
(else (loop (+ 1 i)
(fl+ (fl- (fl* zr zr) (fl* zi zi)) cr)
(fl+ (fl* 2.0 (fl* zr zi)) ci))))))))
;; ------------------------------- (define-syntax-rule (mandelbrot Cr Ci)
(let: loop : Integer ([i : Integer 0] [Zr : Float 0.0] [Zi : Float 0.0])
(cond [(fl> (fl+ (fl* Zr Zr) (fl* Zi Zi)) LIMIT-SQR) 0]
[(fx= i ITERATIONS) 1]
[else (let-n 5 ([Zr (fl+ (fl- (fl* Zr Zr) (fl* Zi Zi)) Cr)]
[Zi (fl+ (fl* 2.0 (fl* Zr Zi)) Ci)])
(loop (fx+ i 5) Zr Zi))])))
(: main (Integer -> Void)) (fprintf O "P4\n~a ~a\n" N N)
(define (main n) (let: loop-y : Void ([y : Integer N])
(let ((out (current-output-port))) (let ([Ci (fl- (fl* 2/N (fx->fl y)) 1.0)])
(let: loop-x : Void ([x : Integer 0] [bitnum : Integer 0] [byteacc : Integer 0])
(fprintf out "P4\n~a ~a\n" n n) (if (fx< x N)
(let* ([Cr (flvector-ref Crs x)]
(let loop-y ((y 0)) [bitnum (fx+ bitnum 1)]
[byteacc (fx+ (fxlshift byteacc 1) (mandelbrot Cr Ci))])
(when (< y n) (cond [(fx= bitnum 8)
(write-byte byteacc O)
(let ([ci (fl- (fl/ (fl* 2.0 (->fl y)) (->fl n)) 1.0)]) (loop-x (fx+ x 1) 0 0)]
[else (loop-x (fx+ x 1) bitnum byteacc)]))
(let: loop-x : Void (begin (when (fx> bitnum 0)
((x : Natural 0) (bitnum : Natural 0) (byteacc : Natural 0)) (write-byte (fxlshift byteacc (fx- 8 (fxand N #x7))) O))
(when (fx> y 1) (loop-y (fx- y 1))))))))
(if (< x n)
(let: ([bitnum : Natural (+ 1 bitnum)]
[byteacc : Natural (+ (arithmetic-shift byteacc 1)
(mandelbrot x y n ci))])
(cond
((= bitnum 8)
(write-byte byteacc out)
(loop-x (+ 1 x) 0 0))
[else (loop-x (+ 1 x) bitnum byteacc)]))
(begin
(when (positive? bitnum)
(write-byte (arithmetic-shift byteacc
(- 8 (bitwise-and n #x7)))
out))
(loop-y (add1 y))))))))))
;; -------------------------------
(command-line #:args (n)
(main (assert (string->number (assert n string?)) exact-integer?)))