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]?