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@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]?
PPS. Sorry if I sent it twice but original message seems to disappear
between my computer and gmane.
