Neat Fractals in Racket

1_koch.png

1_koch_curve.rkt

#lang racket
(require 2htdp/image)

(define (koch-curve n)
  (cond
    [(zero? n) (line 20 0 (pen "black" 8 "solid" "butt" "miter"))]
    [else
     (local [(define smaller (koch-curve (- n 1)))]
       (beside/align "bottom"
                     smaller
                     (rotate 60 smaller)
                     (rotate -60 smaller)
                     smaller))]))

(define curve (koch-curve 7))
(define bg (rectangle (image-width curve) (image-height curve) "solid" "white"))
(save-svg-image (overlay/align "center" "bottom" curve bg) "koch.svg")

2_mandelbrot.png

2_mandelbrot.rkt

#lang racket
(require racket/draw)

(define (make-mandelbrot-bitmap #:width w #:height h #:filename filename)
  (define bmp (make-bitmap w h))
  (make-mandelbrot-dc #:bitmap bmp)
  (send bmp save-file filename 'png))

(define (make-mandelbrot-dc #:bitmap bmp #:z [z 0] #:i [i 30])
  (define dc (new bitmap-dc% [bitmap bmp]))
  (define w (send bmp get-width))
  (define h (send bmp get-height))
  (for* ([x (in-range 0 w)]
         [y (in-range 0 h)])
    (when (converges? (make-rectangular
                       (x-pos->x-coord x w) (y-pos->y-coord y h)) z i)
      (send dc set-pixel x y (make-color 100 100 100)))))

(define (converges? c z i)
  (cond
    [(> (magnitude z) 2) #f]
    [(zero? i) #t]
    [else (converges? c (f z c) (sub1 i))]))

(define (x-pos->x-coord x width)
  (* (- x (/ width 2)) 0.001))

(define (y-pos->y-coord y height)
  (* (- y (/ height 2)) 0.001))

(define (f z c) (+ (expt z 2) c))

(make-mandelbrot-bitmap
 #:width 4000
 #:height 2000
 #:filename "mandelbrot.png")

3_sierpinski_carpet.png

3_sierpinski_carpet.rkt

#lang racket
(require 2htdp/image)

(define (sierpinski-carpet n)
  (cond
    [(zero? n) (square 1 "solid" "black")]
    [else
     (local [(define c (sierpinski-carpet (- n 1)))
             (define i (square (image-width c) "solid" "white"))]
       (above (beside c c c)
              (beside c i c)
              (beside c c c)))]))

(save-image (sierpinski-carpet 5) "scarpet.png")