Graph.hs

{-|
Module      : Graphics.Mars.Graph
Description : Brings together the random walk and graph stamping functionaliy.
Copyright   : (c) Christopher Howard, 2016
License     : GPL-3
Maintainer  : ch.howard@zoho.com

Use the 'graph' function here to generate the raw graph array data based on
various parameters.
-}
module Graphics.Mars.Graph where

import Prelude
  ((+), (*), fromIntegral, round, Float, Int, take, IO, map,
   (-), return, sequence, max, (/=), error, zip)
import Data.Array.IO (newArray, IOUArray, freeze)
import Data.Array.Unboxed (UArray)
import Data.Array.IArray (elems, bounds, listArray)
import Graphics.Mars.Stamp
import Graphics.Mars.Walk
import System.Random (mkStdGen)
import Control.Monad.Random (getRandomR, evalRand)

-- |Beginning in the center, follows a random walk path, and stamps a circle
-- shape onto the array at each step. Internally uses a mutable unboxed array
-- for efficiency, but returns the results in a frozen array.
graph
  :: Int      -- ^ height (array rows)
     -> Int   -- ^ width (array columns)
     -> Float -- ^ stamped circle radius
     -> Float -- ^ jitter factor of walk, usually nearly the same as radius
     -> Int   -- ^ a seed value for the random number generator
     -> Int   -- ^ numbers of steps to take in random walk
     -> Float -- ^ magnification factor
     -> (Float, Float) -- ^ starting point
     -> IO (UArray (Int, Int) Float)
graph height width radius walkfactor seed iterations scalefactor sp
  = do a <- (newArray ((0, 0), (height, width)) 0.0 :: IO (IOUArray (Int, Int) Float))
       stampL a (circleStamp (radius * scalefactor) :: UArray (Int, Int) Float)
         (take iterations
          [ (round (f1 + (fromIntegral height) * 0.5), round (f2 + (fromIntegral width) * 0.5))
          | (f1, f2) <- walk walkfactor sp (mkStdGen seed) ])
       freeze a

-- |Adjust each float value in a UArray by some random value between
-- negative 'delta' and 'delta'.
zRandomize :: Float -- ^ delta
              -> Int -- ^ seed value for random number generator
              -> UArray (Int, Int) Float -- ^ input UArray
              -> UArray (Int, Int) Float
zRandomize delta seed a =
  listArray (bounds a)
    (evalRand m (mkStdGen seed))
  where m = sequence (map f (elems a))
        f e = do r <- getRandomR ((0 - delta), delta)
                 return (e + r)


-- |From each pair of corresponding points on the two input UArrays, select the
-- the higher point, to create a new UArray. The two arrays must have the same
-- bounds, or an error is thrown.
meldGraphs :: UArray (Int, Int) Float
           -> UArray (Int, Int) Float
           -> UArray (Int, Int) Float
meldGraphs a1 a2 =
  if bounds a1 /= bounds a2
  then error "UArray bounds must be equal"
  else listArray (bounds a1)
         (map (\(x, y) -> max x y) (zip (elems a1) (elems a2)))