source: project/demonstrations/numerical-performance/mandelbrot-scheme-slow.scm @ 20563

Last change on this file since 20563 was 20563, checked in by felix winkelmann, 10 years ago

added mandelbrot benchmark

File size: 1.5 KB
Line 
1;;; The Computer Language Benchmarks Game
2;;; http://shootout.alioth.debian.org/
3;;;
4;;; contributed by Anthony Borla
5
6(use extras)
7
8(define-constant +limit-sqr+ 4.0)
9
10(define-constant +iterations+ 50)
11
12(define (mandelbrot iterations x y n)
13  (let ((cr (- (/ (* 2.0 x) n) 1.5)) (ci (- (/ (* 2.0 y) n) 1.0)))
14    (let loop ((i 0) (zr 0.0) (zi 0.0))
15      (let ((zrq (* zr zr)) (ziq (* zi zi)))
16        (cond
17          ((> i iterations) 1)
18          ((> (+ zrq ziq) +limit-sqr+) 0)
19          (else (loop (add1 i) (+ (- zrq ziq) cr) (+ (* 2.0 zr zi) ci)))) ))))
20
21(define (main args)
22  (let ((n (if (null? args)
23               1
24               (string->number (car args))))
25
26    (bitnum 0) (byteacc 0))
27
28    (write-line (string-append "P4\n" (number->string n) " " (number->string n)))
29
30    (let loop-y ((y 0))
31
32      (if (> y (- n 1)) '()
33      ; else
34      (begin
35        (let loop-x ((x 0))
36
37          (if (> x (- n 1)) '()
38          ; else
39          (begin
40            (set! bitnum (add1 bitnum))
41            (set! byteacc (+ (* 2 byteacc) (mandelbrot +iterations+ x y n)))
42
43            (cond
44              ((= bitnum 8)
45                (write-char (integer->char byteacc))
46                (set! bitnum 0)
47                (set! byteacc 0))
48
49              ((= x (- n 1))
50                (write-char (integer->char (* byteacc (expt 2 (- 8 (modulo n 8))))))
51                (set! bitnum 0)
52                (set! byteacc 0)))
53
54            (loop-x (add1 x)) )))
55
56        (loop-y (add1 y)) ))) ))
57
58(main (command-line-arguments))
Note: See TracBrowser for help on using the repository browser.