Ticket #164: mbrot.scm

File mbrot.scm, 1.4 KB (added by felix winkelmann, 13 years ago)
Line 
1;;; MBROT -- Generation of Mandelbrot set fractal.
2
3(define (count r i step x y)
4
5  (let ((max-count 64)
6        (radius^2  16.0))
7
8    (let ((cr (FLOAT+ r (FLOAT* (exact->inexact x) step)))
9          (ci (FLOAT+ i (FLOAT* (exact->inexact y) step))))
10     
11      (let loop ((zr cr)
12                 (zi ci)
13                 (c 0))
14        (if (= c max-count)
15          c
16          (let ((zr^2 (FLOAT* zr zr))
17                (zi^2 (FLOAT* zi zi)))
18            (if (FLOAT> (FLOAT+ zr^2 zi^2) radius^2)
19              c
20              (let ((new-zr (FLOAT+ (FLOAT- zr^2 zi^2) cr))
21                    (new-zi (FLOAT+ (FLOAT* 2.0 (FLOAT* zr zi)) ci)))
22                (loop new-zr new-zi (+ c 1))))))))))
23
24(define (mbrot matrix r i step n)
25  (let loop1 ((y (- n 1)))
26    (if (>= y 0)
27      (let loop2 ((x (- n 1)))
28        (if (>= x 0)
29          (begin
30            (vector-set! (vector-ref matrix x) y (count r i step x y))
31            (loop2 (- x 1)))
32          (loop1 (- y 1)))))))
33
34(define (test n)
35  (let ((matrix (make-vector n)))
36    (let loop ((i (- n 1)))
37      (if (>= i 0)
38        (begin
39          (vector-set! matrix i (make-vector n))
40          (loop (- i 1)))))
41    (mbrot matrix -1.0 -0.5 0.005 n)
42    (vector-ref (vector-ref matrix 0) 0)))
43
44(define (main . args)
45  (run-benchmark
46    "mbrot"
47    mbrot-iters
48    (lambda (result) (equal? result 5))
49    (lambda (n) (lambda () (test n)))
50    75))