-- |
-- Module     : Simulation.Aivika.Lattice.Internal.Lattice
-- Copyright  : Copyright (c) 2016-2017, David Sorokin <david.sorokin@gmail.com>
-- License    : BSD3
-- Maintainer : David Sorokin <david.sorokin@gmail.com>
-- Stability  : experimental
-- Tested with: GHC 7.10.3
--
-- This module defines the lattice.
--
module Simulation.Aivika.Lattice.Internal.Lattice
       (LIOLattice(..),
        lattice,
        newRandomLattice,
        newRandomLatticeWithProb) where

import Control.Monad
import Control.Monad.Trans

import Data.Array

import qualified System.Random.MWC as MWC

-- | Specifies the lattice.
data LIOLattice =
  LIOLattice { LIOLattice -> Int -> Int -> Int
lioParentMemberIndex :: Int -> Int -> Int,
               -- ^ Get the parent member index by the specified
               -- time and member indices.
               LIOLattice -> Int
lioSize :: Int
               -- ^ Tha lattice size.
             }

-- | Create a new random lattice by the specified probability and size,
-- where the probability defines whether the interior child node derives
-- from the right parent.
newRandomLatticeWithProb :: Double -> Int -> IO LIOLattice
newRandomLatticeWithProb :: Double -> Int -> IO LIOLattice
newRandomLatticeWithProb Double
p Int
m =
  do Gen RealWorld
g <- IO GenIO
MWC.createSystemRandom
     [Array Int Int]
xss0 <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Int
0 .. Int
m] forall a b. (a -> b) -> a -> b
$ \Int
i ->
       do [Int]
xs0 <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Int
0 .. Int
i] forall a b. (a -> b) -> a -> b
$ \Int
k ->
            if Int
k forall a. Eq a => a -> a -> Bool
== Int
0
            then forall (m :: * -> *) a. Monad m => a -> m a
return Int
k
            else if Int
k forall a. Eq a => a -> a -> Bool
== Int
i
                 then forall (m :: * -> *) a. Monad m => a -> m a
return (Int
k forall a. Num a => a -> a -> a
- Int
1)
                 else do Double
x <- forall a (m :: * -> *).
(Variate a, PrimMonad m) =>
Gen (PrimState m) -> m a
MWC.uniform Gen RealWorld
g :: IO Double
                         if Double
x forall a. Ord a => a -> a -> Bool
> Double
p
                           then forall (m :: * -> *) a. Monad m => a -> m a
return (Int
k forall a. Num a => a -> a -> a
- Int
1)
                           else forall (m :: * -> *) a. Monad m => a -> m a
return Int
k
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0, Int
i) [Int]
xs0
     let xss :: Array Int (Array Int Int)
xss = forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0, Int
m) [Array Int Int]
xss0
     forall (m :: * -> *) a. Monad m => a -> m a
return LIOLattice { lioParentMemberIndex :: Int -> Int -> Int
lioParentMemberIndex = \Int
i Int
k -> (Array Int (Array Int Int)
xss forall i e. Ix i => Array i e -> i -> e
! Int
i) forall i e. Ix i => Array i e -> i -> e
! Int
k,
                         lioSize :: Int
lioSize = Int
m
                       }

-- | Create a new random lattice by the specified size with equal probabilities,
-- whether the interior child node derives from the left or right parents.
newRandomLattice :: Int -> IO LIOLattice
newRandomLattice :: Int -> IO LIOLattice
newRandomLattice = Double -> Int -> IO LIOLattice
newRandomLatticeWithProb Double
0.5

-- | Return a lattice by the specifed size and the parent member function.
lattice :: Int
           -- ^ the lattice size
           -> (Int -> Int -> Int)
           -- ^ get the parent member index by the specified
           -- time and member indices
           -> LIOLattice
lattice :: Int -> (Int -> Int -> Int) -> LIOLattice
lattice Int
m Int -> Int -> Int
f = (Int -> Int -> Int) -> Int -> LIOLattice
LIOLattice Int -> Int -> Int
f Int
m