aivika 0.5 → 0.5.1

raw patch · 7 files changed

+241/−63 lines, 7 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Simulation/Aivika/Dynamics/Buffer.hs +45/−3
• Simulation/Aivika/Dynamics/EventQueue.hs +84/−1
• Simulation/Aivika/Dynamics/FIFO.hs +45/−3
• Simulation/Aivika/Dynamics/LIFO.hs +46/−3
• Simulation/Aivika/Dynamics/Signal.hs +18/−51
• Simulation/Aivika/Statistics.hs +2/−1
• aivika.cabal +1/−1

@@ -19,6 +19,9 @@         bufferMaxCount,         bufferCount,         bufferLostCount,+        bufferEnqueue,+        bufferDequeue,+        bufferEnqueueLost,         newBuffer,         dequeueBuffer,         tryDequeueBuffer,@@ -36,6 +39,7 @@ import Simulation.Aivika.Dynamics.EventQueue import Simulation.Aivika.Dynamics.Process import Simulation.Aivika.Dynamics.Resource+import Simulation.Aivika.Dynamics.Internal.Signal  import Simulation.Aivika.Dynamics.LIFO import Simulation.Aivika.Dynamics.FIFO@@ -48,7 +52,11 @@            bufferReadRes  :: Resource,            bufferWriteRes :: Resource,            bufferCountRef :: IORef Int,-           bufferLostCountRef :: IORef Int }+           bufferLostCountRef :: IORef Int, +           bufferEnqueueSource :: SignalSource (),+           bufferEnqueueLostSource :: SignalSource (),+           bufferDequeueSource :: SignalSource (),+           bufferUpdatedSource :: SignalSource () }    -- | Create a new queue with the specified maximum available number of items.   newBuffer :: EventQueue -> Int -> Simulation Buffer  @@ -57,12 +65,20 @@      l <- liftIO $ newIORef 0      r <- newResourceWithCount q count 0      w <- newResourceWithCount q count count+     s1 <- newSignalSourceUnsafe+     s2 <- newSignalSourceUnsafe+     s3 <- newSignalSourceUnsafe+     s4 <- newSignalSourceWithUpdate (runQueue q)      return Buffer { bufferQueue = q,                      bufferMaxCount = count,                      bufferReadRes  = r,                      bufferWriteRes = w,                      bufferCountRef = i,-                     bufferLostCountRef = l }+                     bufferLostCountRef = l, +                     bufferEnqueueSource = s1,+                     bufferEnqueueLostSource = s2,+                     bufferDequeueSource = s3,+                     bufferUpdatedSource = s4 }    -- | Test whether the queue is empty. bufferNull :: Buffer -> Dynamics Bool@@ -92,6 +108,7 @@   do requestResource (bufferReadRes q)      liftIO $ dequeueImpl q      releaseResource (bufferWriteRes q)+     liftDynamics $ triggerSignal (bufferDequeueSource q) ()    -- | Try to dequeue immediately.   tryDequeueBuffer :: Buffer -> Dynamics Bool@@ -100,6 +117,7 @@      if x         then do liftIO $ dequeueImpl q                releaseResourceInDynamics (bufferWriteRes q)+               triggerSignal (bufferDequeueSource q) ()                return True        else return False @@ -110,6 +128,7 @@   do requestResource (bufferWriteRes q)      liftIO $ enqueueImpl q      releaseResource (bufferReadRes q)+     liftDynamics $ triggerSignal (bufferEnqueueSource q) ()       -- | Try to enqueue the item immediately.   tryEnqueueBuffer :: Buffer -> Dynamics Bool@@ -118,6 +137,7 @@      if x         then do liftIO $ enqueueImpl q                releaseResourceInDynamics (bufferReadRes q)+               triggerSignal (bufferEnqueueSource q) ()                return True        else return False @@ -129,7 +149,29 @@      if x        then do liftIO $ enqueueImpl q                releaseResourceInDynamics (bufferReadRes q)-       else liftIO $ modifyIORef (bufferLostCountRef q) $ (+) 1+               triggerSignal (bufferEnqueueSource q) ()+       else do liftIO $ modifyIORef (bufferLostCountRef q) $ (+) 1+               triggerSignal (bufferEnqueueLostSource q) ()++-- | Return a signal that notifies when any item is enqueued.+bufferEnqueue :: Buffer -> Signal ()+bufferEnqueue q = merge2Signals m1 m2    -- N.B. The order is important!+  where m1 = publishSignal (bufferUpdatedSource q)+        m2 = publishSignal (bufferEnqueueSource q)++-- | Return a signal which notifies that the item was lost when+-- attempting to add it to the full queue with help of +-- 'enqueueBufferOrLost'.+bufferEnqueueLost :: Buffer -> Signal ()+bufferEnqueueLost q = merge2Signals m1 m2    -- N.B. The order is important!+  where m1 = publishSignal (bufferUpdatedSource q)+        m2 = publishSignal (bufferEnqueueLostSource q)++-- | Return a signal that notifies when any item is dequeued.+bufferDequeue :: Buffer -> Signal ()+bufferDequeue q = merge2Signals m1 m2    -- N.B. The order is important!+  where m1 = publishSignal (bufferUpdatedSource q)+        m2 = publishSignal (bufferDequeueSource q)  -- | An implementation method. dequeueImpl :: Buffer -> IO ()

@@ -16,8 +16,14 @@        (EventQueue,         newQueue,         enqueue,+        enqueueWithTimes,+        enqueueWithIntegTimes,+        enqueueWithStartTime,+        enqueueWithStopTime,+        enqueueWithCurrentTime,         runQueue,-        runQueueSync) where+        runQueueSync,+        queueCount) where  import Data.IORef import Control.Monad@@ -103,3 +109,80 @@          else let Dynamics m = runQueue q               in m p   +-- | Return the number of pending events that should+-- be yet actuated.+queueCount :: EventQueue -> Dynamics Int+queueCount q = Dynamics r where+  r p = +    do let Dynamics m = runQueueSync q+       m p+       PQ.queueCount $ queuePQ q+       +-- | Actuate the event handler in the specified time points.+enqueueWithTimes :: EventQueue -> [Double] -> Dynamics () -> Dynamics ()+enqueueWithTimes q ts m = loop ts+  where loop []       = return ()+        loop (t : ts) = enqueue q t $ m >> loop ts+       +-- | Actuate the event handler in the specified time points.+enqueueWithPoints :: EventQueue -> [Point] -> Dynamics () -> Dynamics ()+enqueueWithPoints q xs (Dynamics m) = loop xs+  where loop []       = return ()+        loop (x : xs) = enqueue q (pointTime x) $ +                        Dynamics $ \p ->+                        do m x    -- N.B. we substitute the time point!+                           let Dynamics m' = loop xs+                           m' p++-- | Actuate the event handler in the integration time points.+enqueueWithIntegTimes :: EventQueue -> Dynamics () -> Dynamics ()+enqueueWithIntegTimes q m =+  Dynamics $ \p ->+  do let sc  = pointSpecs p+         (nl, nu) = integIterationBnds sc+         points  = map point [nl .. nu]+         point n = Point { pointSpecs = sc,+                           pointRun = pointRun p,+                           pointTime = basicTime sc n 0,+                           pointIteration = n,+                           pointPhase = 0 }+         Dynamics m' = enqueueWithPoints q points m+     m' p++-- | Actuate the event handler in the start time.+enqueueWithStartTime :: EventQueue -> Dynamics () -> Dynamics ()+enqueueWithStartTime q m =+  Dynamics $ \p ->+  do let sc  = pointSpecs p+         (nl, nu) = integIterationBnds sc+         point n = Point { pointSpecs = sc,+                           pointRun = pointRun p,+                           pointTime = basicTime sc n 0,+                           pointIteration = n,+                           pointPhase = 0 }+         Dynamics m' = enqueueWithPoints q [point nl] m+     m' p++-- | Actuate the event handler in the stop time.+enqueueWithStopTime :: EventQueue -> Dynamics () -> Dynamics ()+enqueueWithStopTime q m =+  Dynamics $ \p ->+  do let sc  = pointSpecs p+         (nl, nu) = integIterationBnds sc+         point n = Point { pointSpecs = sc,+                           pointRun = pointRun p,+                           pointTime = basicTime sc n 0,+                           pointIteration = n,+                           pointPhase = 0 }+         Dynamics m' = enqueueWithPoints q [point nu] m+     m' p++-- | Actuate the event handler in the current time but +-- through the event queue, which allows continuing the +-- current tasks and then calling the handler after the +-- tasks are finished. The simulation time will be the same.+enqueueWithCurrentTime :: EventQueue -> Dynamics () -> Dynamics ()+enqueueWithCurrentTime q m =+  Dynamics $ \p ->+  do let Dynamics m' = enqueue q (pointTime p) m+     m' p

@@ -17,6 +17,9 @@         fifoMaxCount,         fifoCount,         fifoLostCount,+        fifoEnqueue,+        fifoDequeue,+        fifoEnqueueLost,         newFIFO,         dequeueFIFO,         tryDequeueFIFO,@@ -36,6 +39,7 @@ import Simulation.Aivika.Dynamics.EventQueue import Simulation.Aivika.Dynamics.Process import Simulation.Aivika.Dynamics.Resource+import Simulation.Aivika.Dynamics.Internal.Signal  -- | Represents the FIFO queue with rule: first input - first output. data FIFO a =@@ -47,7 +51,11 @@          fifoLostCountRef :: IORef Int,          fifoStartRef :: IORef Int,          fifoEndRef   :: IORef Int,-         fifoArray :: IOArray Int a }+         fifoArray :: IOArray Int a, +         fifoEnqueueSource :: SignalSource a,+         fifoEnqueueLostSource :: SignalSource a,+         fifoDequeueSource :: SignalSource a,+         fifoUpdatedSource :: SignalSource a }    -- | Create a new FIFO queue with the specified maximum available number of items.   newFIFO :: EventQueue -> Int -> Simulation (FIFO a)  @@ -59,6 +67,10 @@      a <- liftIO $ newArray_ (0, count - 1)      r <- newResourceWithCount q count 0      w <- newResourceWithCount q count count+     s1 <- newSignalSourceUnsafe+     s2 <- newSignalSourceUnsafe+     s3 <- newSignalSourceUnsafe+     s4 <- newSignalSourceWithUpdate (runQueue q)      return FIFO { fifoQueue = q,                    fifoMaxCount = count,                    fifoReadRes  = r,@@ -67,7 +79,11 @@                    fifoLostCountRef = l,                    fifoStartRef = s,                    fifoEndRef   = e,-                   fifoArray = a }+                   fifoArray = a, +                   fifoEnqueueSource = s1,+                   fifoEnqueueLostSource = s2,+                   fifoDequeueSource = s3,+                   fifoUpdatedSource = s4 }    -- | Test whether the FIFO queue is empty. fifoNull :: FIFO a -> Dynamics Bool@@ -98,6 +114,7 @@   do requestResource (fifoReadRes fifo)      a <- liftIO $ dequeueImpl fifo      releaseResource (fifoWriteRes fifo)+     liftDynamics $ triggerSignal (fifoDequeueSource fifo) a      return a    -- | Try to dequeue from the FIFO queue immediately.  @@ -107,6 +124,7 @@      if x         then do a <- liftIO $ dequeueImpl fifo                releaseResourceInDynamics (fifoWriteRes fifo)+               triggerSignal (fifoDequeueSource fifo) a                return $ Just a        else return Nothing @@ -117,6 +135,7 @@   do requestResource (fifoWriteRes fifo)      liftIO $ enqueueImpl fifo a      releaseResource (fifoReadRes fifo)+     liftDynamics $ triggerSignal (fifoEnqueueSource fifo) a       -- | Try to enqueue the item in the FIFO queue. Return 'False' in -- the monad if the queue is full.@@ -126,6 +145,7 @@      if x         then do liftIO $ enqueueImpl fifo a                releaseResourceInDynamics (fifoReadRes fifo)+               triggerSignal (fifoEnqueueSource fifo) a                return True        else return False @@ -137,7 +157,29 @@      if x        then do liftIO $ enqueueImpl fifo a                releaseResourceInDynamics (fifoReadRes fifo)-       else liftIO $ modifyIORef (fifoLostCountRef fifo) $ (+) 1+               triggerSignal (fifoEnqueueSource fifo) a+       else do liftIO $ modifyIORef (fifoLostCountRef fifo) $ (+) 1+               triggerSignal (fifoEnqueueLostSource fifo) a++-- | Return a signal that notifies when any item is enqueued.+fifoEnqueue :: FIFO a -> Signal a+fifoEnqueue fifo = merge2Signals m1 m2    -- N.B. The order is important!+  where m1 = publishSignal (fifoUpdatedSource fifo)+        m2 = publishSignal (fifoEnqueueSource fifo)++-- | Return a signal which notifies that the item was lost when +-- attempting to add it to the full queue with help of+-- 'enqueueFIFOOrLost'.+fifoEnqueueLost :: FIFO a -> Signal a+fifoEnqueueLost fifo = merge2Signals m1 m2    -- N.B. The order is important!+  where m1 = publishSignal (fifoUpdatedSource fifo)+        m2 = publishSignal (fifoEnqueueLostSource fifo)++-- | Return a signal that notifies when any item is dequeued.+fifoDequeue :: FIFO a -> Signal a+fifoDequeue fifo = merge2Signals m1 m2    -- N.B. The order is important!+  where m1 = publishSignal (fifoUpdatedSource fifo)+        m2 = publishSignal (fifoDequeueSource fifo)  -- | An implementation method. dequeueImpl :: FIFO a -> IO a

@@ -17,6 +17,9 @@         lifoMaxCount,         lifoCount,         lifoLostCount,+        lifoEnqueue,+        lifoDequeue,+        lifoEnqueueLost,         newLIFO,         dequeueLIFO,         tryDequeueLIFO,@@ -36,6 +39,7 @@ import Simulation.Aivika.Dynamics.EventQueue import Simulation.Aivika.Dynamics.Process import Simulation.Aivika.Dynamics.Resource+import Simulation.Aivika.Dynamics.Internal.Signal  -- | Represents the LIFO queue with rule: last input - first output. data LIFO a =@@ -45,7 +49,11 @@          lifoWriteRes :: Resource,          lifoCountRef :: IORef Int,          lifoLostCountRef :: IORef Int,-         lifoArray :: IOArray Int a }+         lifoArray :: IOArray Int a, +         lifoEnqueueSource :: SignalSource a,+         lifoEnqueueLostSource :: SignalSource a,+         lifoDequeueSource :: SignalSource a,+         lifoUpdatedSource :: SignalSource a }    -- | Create a new LIFO queue with the specified maximum available number of items.   newLIFO :: EventQueue -> Int -> Simulation (LIFO a)  @@ -55,13 +63,21 @@      a <- liftIO $ newArray_ (0, count - 1)      r <- newResourceWithCount q count 0      w <- newResourceWithCount q count count+     s1 <- newSignalSourceUnsafe+     s2 <- newSignalSourceUnsafe+     s3 <- newSignalSourceUnsafe+     s4 <- newSignalSourceWithUpdate (runQueue q)      return LIFO { lifoQueue = q,                    lifoMaxCount = count,                    lifoReadRes  = r,                    lifoWriteRes = w,                    lifoCountRef = i,                    lifoLostCountRef = l,-                   lifoArray = a }+                   lifoArray = a,+                   lifoEnqueueSource = s1,+                   lifoEnqueueLostSource = s2,+                   lifoDequeueSource = s3,+                   lifoUpdatedSource = s4 }    -- | Test whether the LIFO queue is empty. lifoNull :: LIFO a -> Dynamics Bool@@ -92,6 +108,7 @@   do requestResource (lifoReadRes lifo)      a <- liftIO $ dequeueImpl lifo      releaseResource (lifoWriteRes lifo)+     liftDynamics $ triggerSignal (lifoDequeueSource lifo) a      return a    -- | Try to dequeue from the LIFO queue immediately.  @@ -101,6 +118,7 @@      if x         then do a <- liftIO $ dequeueImpl lifo                releaseResourceInDynamics (lifoWriteRes lifo)+               triggerSignal (lifoDequeueSource lifo) a                return $ Just a        else return Nothing @@ -111,6 +129,7 @@   do requestResource (lifoWriteRes lifo)      liftIO $ enqueueImpl lifo a      releaseResource (lifoReadRes lifo)+     liftDynamics $ triggerSignal (lifoEnqueueSource lifo) a       -- | Try to enqueue the item in the LIFO queue. Return 'False' in -- the monad if the queue is full.@@ -120,6 +139,7 @@      if x         then do liftIO $ enqueueImpl lifo a                releaseResourceInDynamics (lifoReadRes lifo)+               triggerSignal (lifoEnqueueSource lifo) a                return True        else return False @@ -131,7 +151,30 @@      if x        then do liftIO $ enqueueImpl lifo a                releaseResourceInDynamics (lifoReadRes lifo)-       else liftIO $ modifyIORef (lifoLostCountRef lifo) $ (+) 1+               triggerSignal (lifoEnqueueSource lifo) a+       else do liftIO $ modifyIORef (lifoLostCountRef lifo) $ (+) 1+               triggerSignal (lifoEnqueueLostSource lifo) a++-- | Return a signal that notifies when any item is enqueued.+lifoEnqueue :: LIFO a -> Signal a+lifoEnqueue lifo = merge2Signals m1 m2    -- N.B. The order is important!+  where m1 = publishSignal (lifoUpdatedSource lifo)+        m2 = publishSignal (lifoEnqueueSource lifo)++-- | Return a signal which notifies that the item was lost when+-- attempting to add it to the full queue with help of+-- 'enqueueLIFOOrLost'.+lifoEnqueueLost :: LIFO a -> Signal a+lifoEnqueueLost lifo = merge2Signals m1 m2    -- N.B. The order is important!+  where m1 = publishSignal (lifoUpdatedSource lifo)+        m2 = publishSignal (lifoEnqueueLostSource lifo)++-- | Return a signal that notifies when any item is dequeued.+lifoDequeue :: LIFO a -> Signal a+lifoDequeue lifo = merge2Signals m1 m2    -- N.B. The order is important!+  where m1 = publishSignal (lifoUpdatedSource lifo)+        m2 = publishSignal (lifoDequeueSource lifo)+  -- | An implementation method. dequeueImpl :: LIFO a -> IO a

@@ -122,8 +122,7 @@ newSignalHistoryThrough q signal =   do ts <- liftIO UV.newVector      xs <- liftIO V.newVector-     t  <- time-     enqueue q t $+     enqueueWithCurrentTime q $        handleSignal_ signal $ \a ->        Dynamics $ \p ->        do liftIO $ UV.appendVector ts (pointTime p)@@ -139,72 +138,40 @@      xs <- liftIO $ UV.freezeVector (signalHistoryTimes history)      ys <- liftIO $ V.freezeVector (signalHistoryValues history)      return (xs, ys)     +     +-- | Trigger the signal with the current time.+triggerSignalWithTime :: SignalSource Double -> Dynamics ()+triggerSignalWithTime s =+  Dynamics $ \p ->+  do let Dynamics m = triggerSignal s (pointTime p)+     m p  -- | Return a signal that is triggered in the specified time points. newSignalInTimes :: EventQueue -> [Double] -> Dynamics (Signal Double) newSignalInTimes q xs =   do s <- liftSimulation $ newSignalSource q-     let loop []       = return ()-         loop (x : xs) = enqueue q x $ -                         do triggerSignal s x -                            loop xs-     loop xs-     return $ publishSignal s-       --- | Return a signal that is triggered in the specified time points.-newSignalInPoints :: EventQueue -> [Point] -> Dynamics (Signal Double)-newSignalInPoints q xs =-  do s <- liftSimulation $ newSignalSource q-     let loop []       = return ()-         loop (x : xs) = enqueue q (pointTime x) $ -                         Dynamics $ \p ->-                         do let Dynamics m = triggerSignal s (pointTime x) -                            m x    -- N.B. we substitute the time point!-                            let Dynamics m = loop xs-                            m p-     loop xs+     enqueueWithTimes q xs $ triggerSignalWithTime s      return $ publishSignal s         -- | Return a signal that is triggered in the integration time points. -- It should be called with help of 'runDynamicsInStartTime'. newSignalInIntegTimes :: EventQueue -> Dynamics (Signal Double) newSignalInIntegTimes q =-  Dynamics $ \p ->-  do let sc  = pointSpecs p-         (nl, nu) = integIterationBnds sc-         point n = Point { pointSpecs = sc,-                           pointRun = pointRun p,-                           pointTime = basicTime sc n 0,-                           pointIteration = n,-                           pointPhase = 0 }-         Dynamics m = newSignalInPoints q $ map point [nl .. nu]-     m p+  do s <- liftSimulation $ newSignalSource q+     enqueueWithIntegTimes q $ triggerSignalWithTime s+     return $ publishSignal s       -- | Return a signal that is triggered in the start time. -- It should be called with help of 'runDynamicsInStartTime'. newSignalInStartTime :: EventQueue -> Dynamics (Signal Double) newSignalInStartTime q =-  Dynamics $ \p ->-  do let sc  = pointSpecs p-         (nl, nu) = integIterationBnds sc-         point n = Point { pointSpecs = sc,-                           pointRun = pointRun p,-                           pointTime = basicTime sc n 0,-                           pointIteration = n,-                           pointPhase = 0 }-         Dynamics m = newSignalInPoints q [point nl]-     m p+  do s <- liftSimulation $ newSignalSource q+     enqueueWithStartTime q $ triggerSignalWithTime s+     return $ publishSignal s  -- | Return a signal that is triggered in the stop time. newSignalInStopTime :: EventQueue -> Dynamics (Signal Double) newSignalInStopTime q =-  Dynamics $ \p ->-  do let sc  = pointSpecs p-         (nl, nu) = integIterationBnds sc-         point n = Point { pointSpecs = sc,-                           pointRun = pointRun p,-                           pointTime = basicTime sc n 0,-                           pointIteration = n,-                           pointPhase = 0 }-         Dynamics m = newSignalInPoints q [point nu]-     m p+  do s <- liftSimulation $ newSignalSource q+     enqueueWithStopTime q $ triggerSignalWithTime s+     return $ publishSignal s

@@ -106,7 +106,7 @@ -- | Return the variance. samplingStatsVariance :: SamplingStats a -> Double samplingStatsVariance stats-  | count == 1 = meanX2 - meanX * meanX+  | count == 1 = 0   | otherwise  = (meanX2 - meanX * meanX) * (n / (n - 1))     where count  = samplingStatsCount stats           meanX  = samplingStatsMean stats@@ -294,6 +294,7 @@      showString "maximum   = " . shows (timingStatsMax stats) .      showString " at t = " . shows (timingStatsMaxTime stats) .      showString "\n" .+     showString tab .      showString "t in [" . shows (timingStatsStartTime stats) .      showString ", " . shows (timingStatsLastTime stats) .      showString "]"

@@ -1,5 +1,5 @@ name:            aivika-version:         0.5+version:         0.5.1 synopsis:        A multi-paradigm simulation library description:     Aivika is a small simulation library that covers many paradigms.