Propagated Eli's changes to the mandelbrot benchmark to the generic
and typed versions.
This commit is contained in:
Vincent St-Amour
parent
192c1fa995
commit
bc794b443c
|
|
@ -2,78 +2,49 @@
|
|||
|
||||
;; The Computer Language Benchmarks Game
|
||||
;; 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
|
||||
;; 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 (for-syntax racket/base))
|
||||
(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)
|
||||
(let ((cr (- (/ (* 2.0 x) n) 1.5)))
|
||||
(let loop ((i 0) (zr 0.0) (zi 0.0))
|
||||
(if (> i iterations)
|
||||
1
|
||||
(let ((zrq (* zr zr))
|
||||
(ziq (* zi zi)))
|
||||
(cond
|
||||
((> (+ zrq ziq) +limit-sqr+) 0)
|
||||
(else (loop (add1 i)
|
||||
(+ (- zrq ziq) cr)
|
||||
(+ (* 2.0 zr zi) ci)))))))))
|
||||
(define-syntax-rule (mandelbrot Cr Ci)
|
||||
(let loop ([i 0] [Zr 0.0] [Zi 0.0])
|
||||
(cond [(> (+ (* Zr Zr) (* Zi Zi)) LIMIT-SQR) 0]
|
||||
[(= i ITERATIONS) 1]
|
||||
[else (let-n 5 ([Zr (+ (- (* Zr Zr) (* Zi Zi)) Cr)]
|
||||
[Zi (+ (* 2.0 (* Zr Zi)) Ci)])
|
||||
(loop (+ i 5) Zr Zi))])))
|
||||
|
||||
;; -------------------------------
|
||||
|
||||
(define (main n)
|
||||
(let ((out (current-output-port)))
|
||||
|
||||
(fprintf out "P4\n~a ~a\n" n n)
|
||||
|
||||
(let loop-y ((y 0))
|
||||
|
||||
(when (< y n)
|
||||
|
||||
(let ([ci (- (/ (* 2.0 y) n) 1.0)])
|
||||
|
||||
(let loop-x ((x 0) (bitnum 0) (byteacc 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 (string->number n)))
|
||||
(fprintf O "P4\n~a ~a\n" N N)
|
||||
(let loop-y ([y N])
|
||||
(let ([Ci (- (* 2/N y) 1.0)])
|
||||
(let loop-x ([x 0] [bitnum 0] [byteacc 0])
|
||||
(if (< x N)
|
||||
(let* ([Cr (vector-ref Crs x)]
|
||||
[bitnum (+ bitnum 1)]
|
||||
[byteacc (+ (arithmetic-shift byteacc 1) (mandelbrot Cr Ci))])
|
||||
(cond [(= bitnum 8)
|
||||
(write-byte byteacc O)
|
||||
(loop-x (+ x 1) 0 0)]
|
||||
[else (loop-x (+ x 1) bitnum byteacc)]))
|
||||
(begin (when (> bitnum 0)
|
||||
(write-byte (arithmetic-shift byteacc (- 8 (bitwise-and N #x7))) O))
|
||||
(when (> y 1) (loop-y (- y 1))))))))
|
||||
|
|
|
|||
|
|
@ -1,80 +1,48 @@
|
|||
;; The Computer Language Benchmarks Game
|
||||
;; 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
|
||||
;; 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 (for-syntax racket/base))
|
||||
(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 (mandelbrot iterations x y n ci)
|
||||
(let ((cr (- (/ (* 2.0 x) n) 1.5)))
|
||||
(let loop ((i 0) (zr 0.0) (zi 0.0))
|
||||
(if (> i iterations)
|
||||
1
|
||||
(let ((zrq (* zr zr))
|
||||
(ziq (* zi zi)))
|
||||
(cond
|
||||
((> (+ zrq ziq) +limit-sqr+) 0)
|
||||
(else (loop (add1 i)
|
||||
(+ (- zrq ziq) cr)
|
||||
(+ (* 2.0 zr zi) ci)))))))))
|
||||
(define-syntax-rule (mandelbrot Cr Ci)
|
||||
(let: loop : Integer ([i : Integer 0] [Zr : Float 0.0] [Zi : Float 0.0])
|
||||
(cond [(> (+ (* Zr Zr) (* Zi Zi)) LIMIT-SQR) 0]
|
||||
[(= i ITERATIONS) 1]
|
||||
[else (let-n 5 ([Zr (+ (- (* Zr Zr) (* Zi Zi)) Cr)]
|
||||
[Zi (+ (* 2.0 (* Zr Zi)) Ci)])
|
||||
(loop (+ i 5) Zr Zi))])))
|
||||
|
||||
;; -------------------------------
|
||||
|
||||
(: main (Integer -> Void))
|
||||
(define (main n)
|
||||
(let ((out (current-output-port)))
|
||||
|
||||
(fprintf out "P4\n~a ~a\n" n n)
|
||||
|
||||
(let loop-y ((y 0))
|
||||
|
||||
(when (< y n)
|
||||
|
||||
(let ([ci (- (/ (* 2.0 y) n) 1.0)])
|
||||
|
||||
(let: loop-x : Void
|
||||
((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?)))
|
||||
(fprintf O "P4\n~a ~a\n" N N)
|
||||
(let: loop-y : Void ([y : Integer N])
|
||||
(let ([Ci (- (* 2/N y) 1.0)])
|
||||
(let: loop-x : Void ([x : Integer 0] [bitnum : Integer 0] [byteacc : Integer 0])
|
||||
(if (< x N)
|
||||
(let* ([Cr (vector-ref Crs x)]
|
||||
[bitnum (+ bitnum 1)]
|
||||
[byteacc (+ (arithmetic-shift byteacc 1) (mandelbrot Cr Ci))])
|
||||
(cond [(= bitnum 8)
|
||||
(write-byte byteacc O)
|
||||
(loop-x (+ x 1) 0 0)]
|
||||
[else (loop-x (+ x 1) bitnum byteacc)]))
|
||||
(begin (when (> bitnum 0)
|
||||
(write-byte (arithmetic-shift byteacc (- 8 (bitwise-and N #x7))) O))
|
||||
(when (> y 1) (loop-y (- y 1))))))))
|
||||
|
|
|
|||
|
|
@ -1,68 +1,54 @@
|
|||
;; The Computer Language Benchmarks Game
|
||||
;; 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 (mandelbrot x y n ci)
|
||||
(let ((cr (fl- (fl/ (fl* 2.0 (->fl x)) (->fl n)) 1.5)))
|
||||
(let loop ((i 0) (zr 0.0) (zi 0.0))
|
||||
(if (> i +iterations+)
|
||||
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 (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-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))
|
||||
(define (main n)
|
||||
(let ((out (current-output-port)))
|
||||
|
||||
(fprintf out "P4\n~a ~a\n" n n)
|
||||
|
||||
(let loop-y ((y 0))
|
||||
|
||||
(when (< y n)
|
||||
|
||||
(let ([ci (fl- (fl/ (fl* 2.0 (->fl y)) (->fl n)) 1.0)])
|
||||
|
||||
(let: loop-x : Void
|
||||
((x : Natural 0) (bitnum : Natural 0) (byteacc : Natural 0))
|
||||
|
||||
(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?)))
|
||||
(fprintf O "P4\n~a ~a\n" N N)
|
||||
(let: loop-y : Void ([y : Integer N])
|
||||
(let ([Ci (fl- (fl* 2/N (fx->fl y)) 1.0)])
|
||||
(let: loop-x : Void ([x : Integer 0] [bitnum : Integer 0] [byteacc : Integer 0])
|
||||
(if (fx< x N)
|
||||
(let* ([Cr (flvector-ref Crs x)]
|
||||
[bitnum (fx+ bitnum 1)]
|
||||
[byteacc (fx+ (fxlshift byteacc 1) (mandelbrot Cr Ci))])
|
||||
(cond [(fx= bitnum 8)
|
||||
(write-byte byteacc O)
|
||||
(loop-x (fx+ x 1) 0 0)]
|
||||
[else (loop-x (fx+ x 1) bitnum byteacc)]))
|
||||
(begin (when (fx> bitnum 0)
|
||||
(write-byte (fxlshift byteacc (fx- 8 (fxand N #x7))) O))
|
||||
(when (fx> y 1) (loop-y (fx- y 1))))))))
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user