aivika-lattice 0.3 → 0.4

raw patch · 13 files changed

+140/−46 lines, 13 filesdep +arrayPVP ok

version bump matches the API change (PVP)

Dependencies added: array

API changes (from Hackage documentation)

Files

• CHANGELOG.md +5/−0
• Simulation/Aivika/Lattice/Estimate.hs +1/−1
• Simulation/Aivika/Lattice/Internal/LIO.hs +44/−28
• Simulation/Aivika/Lattice/Internal/Lattice.hs +61/−0
• Simulation/Aivika/Lattice/LIO.hs +3/−0
• aivika-lattice.cabal +3/−1
• tests/EstimatingMachRep1.hs +3/−2
• tests/MachRep1.hs +6/−5
• tests/TraversingLattice1.hs +3/−2
• tests/TraversingLattice2.hs +3/−2
• tests/TraversingLattice3.hs +3/−2
• tests/TraversingLattice4.hs +3/−2
• tests/TraversingMachRep1.hs +2/−1

@@ -1,4 +1,9 @@ +Version 0.4+-----++* Allow specifying the lattice.+ Version 0.3 ----- 

@@ -158,7 +158,7 @@ estimateAt i k m =   Estimate $ \p ->   LIO $ \ps ->-  do let ps' = lioParamsAt i k+  do let ps' = lioParamsAt i k ps          r   = pointRun p      p' <- invokeLIO ps' $            invokeParameter r

@@ -14,6 +14,9 @@ module Simulation.Aivika.Lattice.Internal.LIO        (LIOParams(..),         LIO(..),+        LIOLattice(..),+        lattice,+        newRandomLattice,         invokeLIO,         runLIO,         lioParams,@@ -44,6 +47,8 @@ import Simulation.Aivika.Trans.Internal.Types import Simulation.Aivika.Trans.Parameter +import Simulation.Aivika.Lattice.Internal.Lattice+ -- | The 'LIO' computation that can be run as nested one on the lattice node. newtype LIO a = LIO { unLIO :: LIOParams -> IO a                       -- ^ Unwrap the computation.@@ -51,11 +56,13 @@  -- | The parameters of the 'LIO' computation. data LIOParams =-  LIOParams { lioTimeIndex :: !Int,+  LIOParams { lioLattice :: LIOLattice,+              -- ^ The lattice.+              lioTimeIndex :: !Int,               -- ^ The time index.               lioMemberIndex :: !Int               -- ^ The member index.-            } deriving (Eq, Ord, Show)+            }  instance Monad LIO where @@ -107,26 +114,29 @@ {-# INLINE invokeLIO #-} invokeLIO ps (LIO m) = m ps --- | Run the 'LIO' computation using the integration times points as lattice nodes.-runLIO :: LIO a -> IO a-runLIO m = unLIO m rootLIOParams+-- | Run the 'LIO' computation using the specified lattice.+runLIO :: LIOLattice -> LIO a -> IO a+runLIO lattice m = unLIO m $ rootLIOParams lattice  -- | Return the parameters of the computation. lioParams :: LIO LIOParams lioParams = LIO return  -- | Return the root node parameters.-rootLIOParams :: LIOParams-rootLIOParams = LIOParams { lioTimeIndex = 0,-                            lioMemberIndex = 0 }+rootLIOParams :: LIOLattice -> LIOParams+rootLIOParams lattice =+  LIOParams { lioLattice = lattice,+              lioTimeIndex = 0,+              lioMemberIndex = 0 }  -- | Return the parent parameters. parentLIOParams :: LIOParams -> Maybe LIOParams parentLIOParams ps   | i == 0    = Nothing-  | otherwise = Just $ ps { lioTimeIndex = i - 1, lioMemberIndex = max 0 (k - 1) }-  where i = lioTimeIndex ps-        k = lioMemberIndex ps+  | otherwise = Just $ ps { lioTimeIndex = i - 1, lioMemberIndex = k' }+  where i  = lioTimeIndex ps+        k  = lioMemberIndex ps+        k' = lioParentMemberIndex (lioLattice ps) i k  -- | Return the next up side parameters. upSideLIOParams :: LIOParams -> LIOParams@@ -164,14 +174,15 @@                -> Int                -- ^ the lattice member index                -> LIOParams-lioParamsAt i k+               -- ^ the source parameters+               -> LIOParams+lioParamsAt i k ps   | i < 0     = error "The time index cannot be negative: lioParamsAt"   | k < 0     = error "The member index cannot be negative: lioParamsAt"   | k > i     = error "The member index cannot be greater than the time index: lioParamsAt"-  | otherwise = LIOParams { lioTimeIndex = i, lioMemberIndex = k }+  | otherwise = ps { lioTimeIndex = i, lioMemberIndex = k } --- | Return the lattice time index starting from 0. It corresponds to the integration time point.--- The index should be less than 'latticeSize'. +-- | Return the lattice time index starting from 0. The index should be less than or equaled to 'latticeSize'.  latticeTimeIndex :: LIO Int latticeTimeIndex = LIO $ return . lioTimeIndex @@ -186,7 +197,9 @@   LIO $ \ps ->   let sc = runSpecs r       t0 = spcStartTime sc-      dt = spcDT sc+      t2 = spcStopTime sc+      m  = lioSize $ lioLattice ps+      dt = (t2 - t0) / (fromIntegral m)       i  = lioTimeIndex ps       t  = t0 + (fromInteger $ toInteger i) * dt   in return t@@ -206,27 +219,30 @@                     pointIteration = n,                     pointPhase = -1 } --- | The time step used when constructing the lattice. Currently, it is equivalent to 'dt'.+-- | Return the lattice time step. latticeTimeStep :: Parameter LIO Double-latticeTimeStep = dt---- | Return the lattice size.-latticeSize :: Parameter LIO Int-latticeSize =+latticeTimeStep =   Parameter $ \r ->+  LIO $ \ps ->   do let sc = runSpecs r          t0 = spcStartTime sc          t2 = spcStopTime sc-         dt = spcDT sc-         i  = fromIntegral $ floor ((t2 - t0) / dt)-     return (i + 1)+         m  = lioSize $ lioLattice ps+         dt = (t2 - t0) / (fromIntegral m)+     return dt --- | Find the lattice time index for the specified modeling time.+-- | Return the lattice size.+latticeSize :: LIO Int+latticeSize = LIO $ return . lioSize . lioLattice++-- | Find the lattice time index by the specified modeling time. findLatticeTimeIndex :: Double -> Parameter LIO Double findLatticeTimeIndex t =   Parameter $ \r ->+  LIO $ \ps ->   do let sc = runSpecs r          t0 = spcStartTime sc-         dt = spcDT sc-         i  = fromIntegral $ floor ((t - t0) / dt)+         t2 = spcStopTime sc+         m  = lioSize $ lioLattice ps+         i  = fromIntegral $ floor (fromIntegral m * ((t - t0) / (t2 - t0)))      return i

@@ -0,0 +1,61 @@++-- |+-- 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) where++import Control.Monad+import Control.Monad.Trans++import Data.Array++import qualified System.Random.MWC as MWC++-- | Specifies the lattice.+data LIOLattice =+  LIOLattice { lioParentMemberIndex :: Int -> Int -> Int,+               -- ^ Get the parent member index by the specified+               -- time and member indices.+               lioSize :: Int+               -- ^ Tha lattice size.+             }++-- | Create a new random lattice by the specified size.+newRandomLattice :: Int -> IO LIOLattice+newRandomLattice m =+  do g <- MWC.withSystemRandom (return :: MWC.GenIO -> IO MWC.GenIO)+     xss0 <- forM [0 .. m] $ \i ->+       do xs0 <- forM [0 .. i] $ \k ->+            if k == 0+            then return k+            else if k == i+                 then return (k - 1)+                 else do x <- MWC.uniform g :: IO Double+                         if x <= 0.5+                           then return (k - 1)+                           else return k+          return $ listArray (0, i) xs0+     let xss = listArray (0, m) xss0+     return LIOLattice { lioParentMemberIndex = \i k -> (xss ! i) ! k,+                         lioSize = m+                       }++-- | 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 m f = LIOLattice f m+

@@ -11,6 +11,9 @@ -- module Simulation.Aivika.Lattice.LIO        (LIO,+        LIOLattice,+        lattice,+        newRandomLattice,         runLIO,         latticeTimeIndex,         latticeMemberIndex,

@@ -1,5 +1,5 @@ name:            aivika-lattice-version:         0.3+version:         0.4 synopsis:        Nested discrete event simulation module for the Aivika library using lattice description:     This experimental package extends the aivika-transformers [1] library and allows @@ -42,12 +42,14 @@      other-modules:   Simulation.Aivika.Lattice.Internal.Event                      Simulation.Aivika.Lattice.Internal.Estimate+                     Simulation.Aivika.Lattice.Internal.Lattice                      Simulation.Aivika.Lattice.Internal.LIO                      Simulation.Aivika.Lattice.Internal.Ref                      Simulation.Aivika.Lattice.Internal.Ref.Lazy                      Simulation.Aivika.Lattice.Internal.Ref.Strict      build-depends:   base >= 3 && < 6,+                     array >= 0.3.0.0,                      mtl >= 2.1.1,                      containers >= 0.4.0.0,                      random >= 1.0.0.3,

@@ -26,7 +26,7 @@  specs = Specs { spcStartTime = 0.0,                 spcStopTime = 1000.0,-                spcDT = 100.0,+                spcDT = 0.1,                 spcMethod = RungeKutta4,                 spcGeneratorType = SimpleGenerator }         @@ -71,6 +71,7 @@  main :: IO () main =-  do a <- runLIO $+  do lattice <- newRandomLattice 10+     a <- runLIO lattice $           runSimulation model specs      print a

@@ -26,7 +26,7 @@  specs = Specs { spcStartTime = 0.0,                 spcStopTime = 1000.0,-                spcDT = 100.0,+                spcDT = 0.1,                 spcMethod = RungeKutta4,                 spcGeneratorType = SimpleGenerator }         @@ -67,7 +67,8 @@  main :: IO () main =-  runLIO $-  printSimulationResultsInStopTime-  printResultSourceInEnglish-  model specs+  do lattice <- newRandomLattice 10+     runLIO lattice $+       printSimulationResultsInStopTime+       printResultSourceInEnglish+       model specs

@@ -36,5 +36,6 @@  main :: IO () main =-  runLIO $-  runSimulation model specs+  do lattice <- newRandomLattice 5+     runLIO lattice $+       runSimulation model specs

@@ -48,5 +48,6 @@  main :: IO () main =-  runLIO $-  runSimulation model specs+  do lattice <- newRandomLattice 5+     runLIO lattice $+       runSimulation model specs

@@ -48,5 +48,6 @@  main :: IO () main =-  runLIO $-  runSimulation model specs+  do lattice <- newRandomLattice 5+     runLIO lattice $+       runSimulation model specs

@@ -59,5 +59,6 @@  main :: IO () main =-  runLIO $-  runSimulation model specs+  do lattice <- newRandomLattice 5+     runLIO lattice $+       runSimulation model specs

@@ -74,6 +74,7 @@  main :: IO () main =-  do a <- runLIO $+  do lattice <- newRandomLattice 5+     a <- runLIO lattice $           runSimulation model specs      print a