Mandelbrot with futures, one future per processor

mandelbrot-futures.rkt

#lang racket/base
(require racket/future
         racket/flonum)

;;; Author: Laurent Orseau https://github.com/Metaxal
;;; License: [Apache License, Version 2.0](http://www.apache.org/licenses/LICENSE-2.0) or
;;;          [MIT license](http://opensource.org/licenses/MIT) at your option.
;;;
;;; Based on the docs for racket/future,
;;; with one future per cpu

(define n-proc (processor-count))

(define (mandelbrot iterations x y n)
  (let ([ci (fl- (fl/ (* 2.0 (->fl y)) (->fl n)) 1.0)]
        [cr (fl- (fl/ (* 2.0 (->fl x)) (->fl n)) 1.5)])
    (let loop ([i 0] [zr 0.0] [zi 0.0])
      (if (> i iterations)
          i
          (let ([zrq (fl* zr zr)]
                [ziq (fl* zi zi)])
            (cond
              [(fl> (fl+ zrq ziq) 4.0) i]
              [else (loop (add1 i)
                          (fl+ (fl- zrq ziq) cr)
                          (fl+ (fl* 2.0 (fl* zr zi)) ci))]))))))

(begin
  (require racket/draw
           pict
           racket/class
           racket/math)
  
  (define iters 255)
  (define size 1000)

  (define bmp (make-object bitmap% size size))
  (define palette
    (apply bytes
           (for*/list ([i (in-range (+ iters 2))]
                       [ch (in-range 4)])
             (if (= i (+ 1 iters))
                 0
                 (case ch
                   [(0) 255]
                   [(3) (* 5 (modulo i 15))]
                   [(1) (* 32 (modulo i 7))]
                   [(2) (* 8 (modulo i 31))])))))

  (define segment (quotient size n-proc))
  (define bts (make-bytes (* size size 4) 0))
  (time
   (for/async ([x0 (in-range 0 size segment)]
               #:when #t
               [y0 (in-range 0 size segment)])
     (for* ([x (in-range x0 (min size (+ x0 segment)))]
            [y (in-range y0 (min size (+ y0 segment)))])
       (define z (mandelbrot iters x y size))
       (define c (bytes-ref palette z))
       (define i (* 4 (+ x (* y size))))
       (bytes-copy! bts i palette (* z 4) (+ (* z 4) 4)))))
  (time (send bmp set-argb-pixels 0 0 size size bts))
  (dynamic-require 'racket/gui #f)
  (show-pict (bitmap bmp)))

size 1000, depth 255
processor-count=16 (but only 8 cores): 63ms
With (define n-proc 8): 69ms
With (define n-proc 1): 411ms