Fractal-ish Thing

gistfile1.hs

import Data.Array.Repa ( Array, DIM2, DIM3, Z(..), (:.)(..) )
import qualified Data.Array.Repa          as R
import qualified Data.Array.Repa.IO.DevIL as IO
import Data.Word  (Word8)
import Data.Array.Repa.Repr.Delayed (D)

positionToPre :: Int -> Int -> Double -> DIM2 -> (Double,Double,Double)
positionToPre dx dy size (Z :. x :. y) = 
    let c = (fromIntegral $ x + dx) / size
        d = (fromIntegral $ y + dy) / size 
    in (1/ (d*d+c*c), c + d, c - d)

percent :: Double -> Double -> (Double,Double,Double) -> Double
percent ε i (c2d2, dc, cd)  = loop i 0
    where loop j acc 
              | j <= 0.9 = acc / i
              | isInt (c2d2 * dc * j) && isInt (c2d2 * cd * j) = loop (j-1) $ acc + 1
              | otherwise = loop (j-1) acc
          isInt x = abs (x - (fromIntegral $ round x)) <= ε

square :: Int -> DIM2
square x = x `R.ix2` x

scale :: Double -> Word8
scale =  floor . (* 256) . min 1 . max 0

toImage :: (Monad m, Functor m) => Array D DIM2 Word8 -> m IO.Image
toImage = fmap IO.RGB . R.computeP . dup
    where dup a = R.traverse a (:. 3) trans
          trans f (Z :. x :. y :. _) = f (Z :. x :. y)

main = do
  let ε = 0.2
  let array = R.fromFunction (square 2000) $ scale . percent ε 50 . positionToPre 0 0 2000
  IO.runIL $ toImage array >>= IO.writeImage "fractalish.png"