module Simulation.Aivika.Dynamics.Internal.Memo
(memo,
umemo,
memo0,
umemo0,
iterateDynamics) where
import Data.Array
import Data.Array.IO
import Data.IORef
import Control.Monad
import Simulation.Aivika.Dynamics.Internal.Simulation
import Simulation.Aivika.Dynamics.Internal.Dynamics
import Simulation.Aivika.Dynamics.Internal.Interpolate
newMemoArray_ :: Ix i => (i, i) -> IO (IOArray i e)
newMemoArray_ = newArray_
newMemoUArray_ :: (MArray IOUArray e IO, Ix i) => (i, i) -> IO (IOUArray i e)
newMemoUArray_ = newArray_
memo :: Dynamics e -> Simulation (Dynamics e)
memo (Dynamics m) =
Simulation $ \r ->
do let sc = runSpecs r
(phl, phu) = phaseBnds sc
(nl, nu) = iterationBnds sc
arr <- newMemoArray_ ((phl, nl), (phu, nu))
nref <- newIORef 0
phref <- newIORef 0
let r p =
do let sc = pointSpecs p
n = pointIteration p
ph = pointPhase p
phu = phaseHiBnd sc
loop n' ph' =
if (n' > n) || ((n' == n) && (ph' > ph))
then
readArray arr (ph, n)
else
let p' = p { pointIteration = n', pointPhase = ph',
pointTime = basicTime sc n' ph' }
in do a <- m p'
a `seq` writeArray arr (ph', n') a
if ph' >= phu
then do writeIORef phref 0
writeIORef nref (n' + 1)
loop (n' + 1) 0
else do writeIORef phref (ph' + 1)
loop n' (ph' + 1)
n' <- readIORef nref
ph' <- readIORef phref
loop n' ph'
return $ interpolate $ Dynamics r
umemo :: (MArray IOUArray e IO) => Dynamics e -> Simulation (Dynamics e)
umemo (Dynamics m) =
Simulation $ \r ->
do let sc = runSpecs r
(phl, phu) = phaseBnds sc
(nl, nu) = iterationBnds sc
arr <- newMemoUArray_ ((phl, nl), (phu, nu))
nref <- newIORef 0
phref <- newIORef 0
let r p =
do let sc = pointSpecs p
n = pointIteration p
ph = pointPhase p
phu = phaseHiBnd sc
loop n' ph' =
if (n' > n) || ((n' == n) && (ph' > ph))
then
readArray arr (ph, n)
else
let p' = p { pointIteration = n',
pointPhase = ph',
pointTime = basicTime sc n' ph' }
in do a <- m p'
a `seq` writeArray arr (ph', n') a
if ph' >= phu
then do writeIORef phref 0
writeIORef nref (n' + 1)
loop (n' + 1) 0
else do writeIORef phref (ph' + 1)
loop n' (ph' + 1)
n' <- readIORef nref
ph' <- readIORef phref
loop n' ph'
return $ interpolate $ Dynamics r
memo0 :: Dynamics e -> Simulation (Dynamics e)
memo0 (Dynamics m) =
Simulation $ \r ->
do let sc = runSpecs r
bnds = iterationBnds sc
arr <- newMemoArray_ bnds
nref <- newIORef 0
let r p =
do let sc = pointSpecs p
n = pointIteration p
loop n' =
if n' > n
then
readArray arr n
else
let p' = p { pointIteration = n', pointPhase = 0,
pointTime = basicTime sc n' 0 }
in do a <- m p'
a `seq` writeArray arr n' a
writeIORef nref (n' + 1)
loop (n' + 1)
n' <- readIORef nref
loop n'
return $ discrete $ Dynamics r
umemo0 :: (MArray IOUArray e IO) => Dynamics e -> Simulation (Dynamics e)
umemo0 (Dynamics m) =
Simulation $ \r ->
do let sc = runSpecs r
bnds = iterationBnds sc
arr <- newMemoUArray_ bnds
nref <- newIORef 0
let r p =
do let sc = pointSpecs p
n = pointIteration p
loop n' =
if n' > n
then
readArray arr n
else
let p' = p { pointIteration = n', pointPhase = 0,
pointTime = basicTime sc n' 0 }
in do a <- m p'
a `seq` writeArray arr n' a
writeIORef nref (n' + 1)
loop (n' + 1)
n' <- readIORef nref
loop n'
return $ discrete $ Dynamics r
iterateDynamics :: Dynamics () -> Simulation (Dynamics ())
iterateDynamics (Dynamics m) =
Simulation $ \r ->
do let sc = runSpecs r
nref <- newIORef 0
let r p =
do let sc = pointSpecs p
n = pointIteration p
loop n' =
unless (n' > n) $
let p' = p { pointIteration = n', pointPhase = 0,
pointTime = basicTime sc n' 0 }
in do a <- m p'
a `seq` writeIORef nref (n' + 1)
loop (n' + 1)
n' <- readIORef nref
loop n'
return $ discrete $ Dynamics r