[Haskell-beginners] Fractal map generator in Haskell - can it be simplified?

[Maciej Piechotka]

I tried to implement fractal map generator in Haskell. While the code is
correct (I believe) it is not nice:

> {-# LANGUAGE FlexibleContexts #-}
> import Control.Applicative
> import Data.Array
> import Data.Bits
> import Data.Foldable
> import Data.Ix
> import Data.Random
> import Data.Traversable
> import Debug.Trace
> import Text.Printf
> import Prelude hiding (sum)
> 
> ctz :: Bits a => a -> Int
> ctz x at 0 = bitSize x
> ctz x   = let ctz' n | x .&. bit n /= 0 = n
>                      | otherwise        = ctz' (n+1)
>           in ctz' 0
> 

Count trailing zeros.

> imLog :: Integral a => a -> a -> a
> imLog b x | x < b     = 0
>           | otherwise = doDiv (x`div`(b^l)) l
>           where l = 2 * imLog (b*b) x
>                 doDiv x l | x < b = l 
>                           | otherwise = doDiv (x`div`b) (l+1)
> 

Integer logarithm (from Haskell report)
 
> genArray :: Ix i => (i, i) -> (i -> a) -> Array i a
> genArray r f = listArray r (map f (range r))
>

Helper function (generate array using function taking index)
 
> randArray :: Ix i => (i, i) -> RVar a -> RVar (Array i a)
> randArray r v = listArray r <$> sequenceA (replicate (rangeSize r) v)
> 

Generate array from random value generator.

> sizeArray :: (Bits i, Ix (i, i), Ord i) => ((i, i), (i, i)) -> Array
(i, i) i
> sizeArray r =
>     genArray r (\(x, y) -> fromIntegral (min (findSize x) (findSize
y)))
>     where findSize = fromIntegral . ctz
> 

Generate array how far we should look from this point.

> data FType = Box | Cross deriving (Eq, Show)
> 
> ftypeArray :: (Bits i, Ix (i, i), Ord i, Integral i) =>
>               (i, i) -> Array (i, i) FType
> ftypeArray n = let arr = genArray ((0, 0), n) arrF
>                    arrF (x, y)
>                         | x == y = Box
>                         | x == 0 || y == 0 = Cross
>                         | x <= 2 && y <= 2 = Cross
>                         | x > y = arr ! (x - 2^(imLog 2 x), y)
>                         | x < y = arr ! (x, y - 2^(imLog 2 y))
>                in arr
> 

Generate array should we look on diagonals or columns/rows

> fracArray :: (Bits i, Ix (i, i), Ord i, Fractional v, Integral i)
>           => i -> v -> RVar v -> RVar (Array (i, i) v)
> fracArray n d v = do
>     let size = 2^n
>     ra <- randArray ((0, 0), (size - 1, size)) v
>     let s = sizeArray ((0, 0), (size, size))
>         ft = ftypeArray (size, size)
>         arr = genArray ((0, 0), (size, size)) arrF
>         randF (x, y) = d*(ra ! (x, y))*2^(size - (s ! (x, y)))
>         average l = sum l / fromIntegral (length l)
>         arrF (x, y)
>             | x == 0 && y == 0
>                  = ra ! (0, 0)
>             | x == 0 && y == size
>                  = ra ! (0, size)
>             | x == size
>                  = arr ! (0, y)
>             | x == 0
>                  = randF (x, y) + average [arr ! (x, y - cs), 
>                                            arr ! (x, y + cs),
>                                            arr ! (x + cs, x)]
>             | y == 0
>                  = randF (x, y) + average [arr ! (x - cs, y),
>                                            arr ! (x + cs, y),
>                                            arr ! (x, y + cs)]
>             | y == size
>                  = randF (x, y) + average [arr ! (x - cs, y),
>                                            arr ! (x + cs, y),
>                                            arr ! (x, y - cs)]
>             | ft ! (x, y) == Cross
>                  = randF (x, y) + average [arr ! (x - cs, y),
>                                            arr ! (x + cs, y),
>                                            arr ! (x, y - cs),
>                                            arr ! (x, y + cs)]
>             | ft ! (x, y) == Box
>                  = randF (x, y) + average [arr ! (x - cs, y - cs),
>                                            arr ! (x - cs, y + cs),
>                                            arr ! (x + cs, y - cs),
>                                            arr ! (x + cs, y + cs)]
>             where cs = 2 ^ (s ! (x, y))
>     return arr
> 

Any advice how to improve it?

Regards

PS. Am I correct that it has O(size^2) complexity i.e. O(2^n) [which is
optimal]?
-------------- next part --------------
A non-text attachment was scrubbed...
Name: not available
Type: application/pgp-signature
Size: 836 bytes
Desc: This is a digitally signed message part
Url : http://www.haskell.org/pipermail/beginners/attachments/20100607/e8c06f2f/attachment.bin