[Haskell-cafe] Is there anything manifestly stupid about this
code?
Derek Elkins
derek.a.elkins at gmail.com
Sun Jul 6 21:18:22 EDT 2008
To answer the question in your subject, yes! We have a complex type.
Not only does that make the code simpler and more obvious and idiomatic,
but it's also more efficient because for this use you'd really prefer a
strict pair type for "Point", and complex is strict in it's components.
On Sun, 2008-07-06 at 21:02 -0400, Michael Feathers wrote:
> Decided a while ago to write some code to calculate the Mandelbrot set
> using the escape iterations algorithm. Discovered after mulling it
> about that I could just built it as an infinite list of infinite lists
> and then extract any rectangle of values that I wanted:
>
> type Point = (Double, Double)
> sq :: Double -> Double
> sq x = x ^ 2
>
> translate :: Point -> Point -> Point
> translate (r0, i0) (r1, i1) =
> (r0 + r1, i0 + i1)
>
> mandel :: Point -> Point
> mandel (r, i) =
> (sq r + sq i, 2 * r * i)
>
> notEscaped :: Point -> Bool
> notEscaped (r, i) =
> (sq r + sq i) <= 4.0
>
> trajectory :: (Point -> Point) -> [Point]
> trajectory pointFunction =
> takeWhile notEscaped $ iterate pointFunction seed
> where seed = (0.0, 0.0)
>
> escapeIterations :: (Point -> Point) -> Int
> escapeIterations =
> length . tail . take 1024 . trajectory
>
> mandelbrot :: Double -> [[Int]]
> mandelbrot incrementSize =
> [[ escapeIterations $ translate (x, y) . mandel
> | x <- increments]
> | y <- increments] where
> increments = [0.0, incrementSize .. ]
>
> window :: (Int, Int) -> (Int, Int) -> [[a]] -> [[a]]
> window (x0, y0) (x1, y1) = range x0 x1 . map (range y0 y1) where
> range m n = take (n - m) . drop m
>
>
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
More information about the Haskell-Cafe
mailing list