aivika-lattice 0.4 → 0.5

raw patch · 12 files changed

+129/−44 lines, 12 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +7/−0
• Simulation/Aivika/Lattice/Internal/LIO.hs +42/−19
• Simulation/Aivika/Lattice/LIO.hs +11/−1
• aivika-lattice.cabal +2/−1
• tests/Distribution.hs +44/−0
• tests/EstimatingMachRep1.hs +2/−2
• tests/MachRep1.hs +2/−2
• tests/TraversingLattice1.hs +4/−4
• tests/TraversingLattice2.hs +4/−4
• tests/TraversingLattice3.hs +4/−4
• tests/TraversingLattice4.hs +4/−4
• tests/TraversingMachRep1.hs +3/−3

@@ -1,4 +1,11 @@ +Version 0.5+-----++* Added the latticeTimes and enqueueWithLatticeTimes functions.++* Added the latticeParentMemberIndex function.+ Version 0.4 ----- 

@@ -28,7 +28,9 @@         lioParamsAt,         latticeTimeIndex,         latticeMemberIndex,+        latticeParentMemberIndex,         latticeTime,+        latticeTimes,         latticeTimeStep,         latticePoint,         latticeSize,@@ -45,6 +47,7 @@  import Simulation.Aivika.Trans.Exception import Simulation.Aivika.Trans.Internal.Types+import Simulation.Aivika.Trans.Internal.Specs import Simulation.Aivika.Trans.Parameter  import Simulation.Aivika.Lattice.Internal.Lattice@@ -190,34 +193,37 @@ latticeMemberIndex :: LIO Int latticeMemberIndex = LIO $ return . lioMemberIndex +-- | Return the parent member index starting from 0 for non-root lattice nodes.+latticeParentMemberIndex :: LIO (Maybe Int)+latticeParentMemberIndex = LIO $ return . fmap lioMemberIndex . parentLIOParams+ -- | Return the time for the current lattice node. latticeTime :: Parameter LIO Double latticeTime =   Parameter $ \r ->   LIO $ \ps ->-  let sc = runSpecs r-      t0 = spcStartTime 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+  let i = lioTimeIndex ps+  in invokeLIO ps $+     invokeParameter r $+     getLatticeTimeByIndex i +-- | Return the time values in the lattice nodes.+latticeTimes :: Parameter LIO [Double]+latticeTimes =+  Parameter $ \r ->+  LIO $ \ps ->+  let m  = lioSize $ lioLattice ps+  in forM [0 .. m] $ \i ->+     invokeLIO ps $+     invokeParameter r $+     getLatticeTimeByIndex i+ -- | Return the point in the corresponding lattice node. latticePoint :: Parameter LIO (Point LIO) latticePoint =   Parameter $ \r ->   do t <- invokeParameter r latticeTime-     let sc = runSpecs r-         t0 = spcStartTime sc-         dt = spcDT sc-         n  = fromIntegral $ floor ((t - t0) / dt)-     return Point { pointSpecs = sc,-                    pointRun = r,-                    pointTime = t,-                    pointIteration = n,-                    pointPhase = -1 }+     return $ pointAt r t  -- | Return the lattice time step. latticeTimeStep :: Parameter LIO Double@@ -236,7 +242,7 @@ latticeSize = LIO $ return . lioSize . lioLattice  -- | Find the lattice time index by the specified modeling time.-findLatticeTimeIndex :: Double -> Parameter LIO Double+findLatticeTimeIndex :: Double -> Parameter LIO Int findLatticeTimeIndex t =   Parameter $ \r ->   LIO $ \ps ->@@ -244,5 +250,22 @@          t0 = spcStartTime sc          t2 = spcStopTime sc          m  = lioSize $ lioLattice ps-         i  = fromIntegral $ floor (fromIntegral m * ((t - t0) / (t2 - t0)))+         i | t == t0   = 0+           | t == t2   = m+           | otherwise = floor (fromIntegral m * ((t - t0) / (t2 - t0)))      return i++-- | Get the modeling time in the lattice node by the specified time index. +getLatticeTimeByIndex :: Int -> Parameter LIO Double+getLatticeTimeByIndex i =+  Parameter $ \r ->+  LIO $ \ps ->+  let sc = runSpecs r+      t0 = spcStartTime sc+      t2 = spcStopTime sc+      m  = lioSize $ lioLattice ps+      dt = (t2 - t0) / (fromIntegral m)+      t | i == 0    = t0+        | i == m    = t2+        | otherwise = t0 + (fromInteger $ toInteger i) * dt+  in return t

@@ -17,11 +17,15 @@         runLIO,         latticeTimeIndex,         latticeMemberIndex,+        latticeParentMemberIndex,         latticeSize,         latticeTime,+        latticeTimes,         latticeTimeStep,-        findLatticeTimeIndex) where+        findLatticeTimeIndex,+        enqueueEventWithLatticeTimes) where +import Simulation.Aivika.Trans import Simulation.Aivika.Trans.Comp import Simulation.Aivika.Trans.DES import Simulation.Aivika.Trans.Exception@@ -45,4 +49,10 @@ instance EventIOQueueing LIO where    enqueueEventIO = enqueueEvent++-- | Actuate the event handler in the lattice node time points.+enqueueEventWithLatticeTimes :: Event LIO () -> Event LIO ()+enqueueEventWithLatticeTimes m =+  do ts <- liftParameter latticeTimes+     enqueueEventWithTimes ts m   

@@ -1,5 +1,5 @@ name:            aivika-lattice-version:         0.4+version:         0.5 synopsis:        Nested discrete event simulation module for the Aivika library using lattice description:     This experimental package extends the aivika-transformers [1] library and allows @@ -20,6 +20,7 @@ tested-with:     GHC == 7.10.3  extra-source-files:  CHANGELOG.md+                     tests/Distribution.hs                      tests/MachRep1.hs                      tests/TraversingLattice1.hs                      tests/TraversingLattice2.hs

@@ -0,0 +1,44 @@++import Control.Monad+import Control.Monad.Trans++import Simulation.Aivika.Trans+import Simulation.Aivika.Lattice+import Simulation.Aivika.Experiment.Histogram++meanUpTime = 1.0+meanRepairTime = 0.5++specs = Specs { spcStartTime = 0.0,+                spcStopTime = 1000.0,+                spcDT = 0.1,+                spcMethod = RungeKutta4,+                spcGeneratorType = SimpleGenerator }+        +model :: Simulation LIO Histogram+model =+  do let latticeDistribution :: Estimate LIO [Int]+         latticeDistribution =+           do k <- liftComp latticeMemberIndex+              return [k]++     let reduce :: [Int] -> [Int] -> Estimate LIO [Int]+         reduce ks1 ks2 = return $ ks1 ++ ks2 + +     let leaf = latticeDistribution++     ks <- foldEstimate reduce leaf++     runEstimateInStartTime $+       do xs <- ks+          let ys = fmap (fromIntegral) xs+              hs = histogram binScott [ys]+          return hs++main :: IO ()+main =+  do lat <- newRandomLattice 10+     hs <- runLIO lat $+           runSimulation model specs+     putStrLn "Histogram:"+     putStrLn (show hs)

@@ -71,7 +71,7 @@  main :: IO () main =-  do lattice <- newRandomLattice 10-     a <- runLIO lattice $+  do lat <- newRandomLattice 10+     a <- runLIO lat $           runSimulation model specs      print a

@@ -67,8 +67,8 @@  main :: IO () main =-  do lattice <- newRandomLattice 10-     runLIO lattice $+  do lat <- newRandomLattice 10+     runLIO lat $        printSimulationResultsInStopTime        printResultSourceInEnglish        model specs

@@ -10,7 +10,7 @@  specs = Specs { spcStartTime = 0.0,                 spcStopTime = 1000.0,-                spcDT = 100.0,+                spcDT = 0.1,                 spcMethod = RungeKutta4,                 spcGeneratorType = SimpleGenerator }         @@ -28,7 +28,7 @@                    putStrLn ""                          runEventInStartTime $-       enqueueEventWithIntegTimes+       enqueueEventWithLatticeTimes        showLatticeNode       runEventInStopTime $@@ -36,6 +36,6 @@  main :: IO () main =-  do lattice <- newRandomLattice 5-     runLIO lattice $+  do lat <- newRandomLattice 4+     runLIO lat $        runSimulation model specs

@@ -10,7 +10,7 @@  specs = Specs { spcStartTime = 0.0,                 spcStopTime = 1000.0,-                spcDT = 400.0,+                spcDT = 0.1,                 spcMethod = RungeKutta4,                 spcGeneratorType = SimpleGenerator }         @@ -29,7 +29,7 @@                    putStrLn ""                          runEventInStartTime $-       enqueueEventWithIntegTimes $+       enqueueEventWithLatticeTimes $        showLatticeNode "enqueue"       let reduce a b =@@ -48,6 +48,6 @@  main :: IO () main =-  do lattice <- newRandomLattice 5-     runLIO lattice $+  do lat <- newRandomLattice 4+     runLIO lat $        runSimulation model specs

@@ -10,7 +10,7 @@  specs = Specs { spcStartTime = 0.0,                 spcStopTime = 1000.0,-                spcDT = 400.0,+                spcDT = 0.1,                 spcMethod = RungeKutta4,                 spcGeneratorType = SimpleGenerator }         @@ -29,7 +29,7 @@                    putStrLn ""                          runEventInStartTime $-       enqueueEventWithIntegTimes $+       enqueueEventWithLatticeTimes $        showLatticeNode "enqueue"       let reduce a b =@@ -48,6 +48,6 @@  main :: IO () main =-  do lattice <- newRandomLattice 5-     runLIO lattice $+  do lat <- newRandomLattice 4+     runLIO lat $        runSimulation model specs

@@ -10,7 +10,7 @@  specs = Specs { spcStartTime = 0.0,                 spcStopTime = 1000.0,-                spcDT = 400.0,+                spcDT = 0.1,                 spcMethod = RungeKutta4,                 spcGeneratorType = SimpleGenerator }         @@ -31,7 +31,7 @@      r <- newRef 0                          runEventInStartTime $-       enqueueEventWithIntegTimes $+       enqueueEventWithLatticeTimes $        do x <- liftParameter $ randomUniform 0 1           writeRef r x           showLatticeNode ("enqueue (x = " ++ show x ++ ")") @@ -59,6 +59,6 @@  main :: IO () main =-  do lattice <- newRandomLattice 5-     runLIO lattice $+  do lat <- newRandomLattice 4+     runLIO lat $        runSimulation model specs

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