{-# LANGUAGE FlexibleContexts #-}
module Simulation.Aivika.Dynamics.Memo.Unboxed
(memoDynamics,
memo0Dynamics) where
import Data.Array
import Data.Array.IO.Safe
import Data.IORef
import Control.Monad
import Simulation.Aivika.Internal.Specs
import Simulation.Aivika.Internal.Parameter
import Simulation.Aivika.Internal.Simulation
import Simulation.Aivika.Internal.Dynamics
import Simulation.Aivika.Dynamics.Extra
import Simulation.Aivika.Unboxed
memoDynamics :: Unboxed e => Dynamics e -> Simulation (Dynamics e)
{-# INLINE memoDynamics #-}
memoDynamics :: forall e. Unboxed e => Dynamics e -> Simulation (Dynamics e)
memoDynamics (Dynamics Point -> IO e
m) =
forall a. (Run -> IO a) -> Simulation a
Simulation forall a b. (a -> b) -> a -> b
$ \Run
r ->
do let sc :: Specs
sc = Run -> Specs
runSpecs Run
r
(Int
phl, Int
phu) = Specs -> (Int, Int)
integPhaseBnds Specs
sc
(Int
nl, Int
nu) = Specs -> (Int, Int)
integIterationBnds Specs
sc
IOUArray (Int, Int) e
arr <- forall e i. (Unboxed e, Ix i) => (i, i) -> IO (IOUArray i e)
newUnboxedArray_ ((Int
phl, Int
nl), (Int
phu, Int
nu))
IORef Int
nref <- forall a. a -> IO (IORef a)
newIORef Int
0
IORef Int
phref <- forall a. a -> IO (IORef a)
newIORef Int
0
let r :: Point -> IO e
r Point
p =
do let sc :: Specs
sc = Point -> Specs
pointSpecs Point
p
n :: Int
n = Point -> Int
pointIteration Point
p
ph :: Int
ph = Point -> Int
pointPhase Point
p
phu :: Int
phu = Specs -> Int
integPhaseHiBnd Specs
sc
loop :: Int -> Int -> IO e
loop Int
n' Int
ph' =
if (Int
n' forall a. Ord a => a -> a -> Bool
> Int
n) Bool -> Bool -> Bool
|| ((Int
n' forall a. Eq a => a -> a -> Bool
== Int
n) Bool -> Bool -> Bool
&& (Int
ph' forall a. Ord a => a -> a -> Bool
> Int
ph))
then
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray IOUArray (Int, Int) e
arr (Int
ph, Int
n)
else
let p' :: Point
p' = Point
p { pointIteration :: Int
pointIteration = Int
n',
pointPhase :: Int
pointPhase = Int
ph',
pointTime :: Double
pointTime = Specs -> Int -> Int -> Double
basicTime Specs
sc Int
n' Int
ph' }
in do e
a <- Point -> IO e
m Point
p'
e
a seq :: forall a b. a -> b -> b
`seq` forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray IOUArray (Int, Int) e
arr (Int
ph', Int
n') e
a
if Int
ph' forall a. Ord a => a -> a -> Bool
>= Int
phu
then do forall a. IORef a -> a -> IO ()
writeIORef IORef Int
phref Int
0
forall a. IORef a -> a -> IO ()
writeIORef IORef Int
nref (Int
n' forall a. Num a => a -> a -> a
+ Int
1)
Int -> Int -> IO e
loop (Int
n' forall a. Num a => a -> a -> a
+ Int
1) Int
0
else do forall a. IORef a -> a -> IO ()
writeIORef IORef Int
phref (Int
ph' forall a. Num a => a -> a -> a
+ Int
1)
Int -> Int -> IO e
loop Int
n' (Int
ph' forall a. Num a => a -> a -> a
+ Int
1)
Int
n' <- forall a. IORef a -> IO a
readIORef IORef Int
nref
Int
ph' <- forall a. IORef a -> IO a
readIORef IORef Int
phref
Int -> Int -> IO e
loop Int
n' Int
ph'
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Dynamics a -> Dynamics a
interpolateDynamics forall a b. (a -> b) -> a -> b
$ forall a. (Point -> IO a) -> Dynamics a
Dynamics Point -> IO e
r
memo0Dynamics :: Unboxed e => Dynamics e -> Simulation (Dynamics e)
{-# INLINE memo0Dynamics #-}
memo0Dynamics :: forall e. Unboxed e => Dynamics e -> Simulation (Dynamics e)
memo0Dynamics (Dynamics Point -> IO e
m) =
forall a. (Run -> IO a) -> Simulation a
Simulation forall a b. (a -> b) -> a -> b
$ \Run
r ->
do let sc :: Specs
sc = Run -> Specs
runSpecs Run
r
bnds :: (Int, Int)
bnds = Specs -> (Int, Int)
integIterationBnds Specs
sc
IOUArray Int e
arr <- forall e i. (Unboxed e, Ix i) => (i, i) -> IO (IOUArray i e)
newUnboxedArray_ (Int, Int)
bnds
IORef Int
nref <- forall a. a -> IO (IORef a)
newIORef Int
0
let r :: Point -> IO e
r Point
p =
do let sc :: Specs
sc = Point -> Specs
pointSpecs Point
p
n :: Int
n = Point -> Int
pointIteration Point
p
loop :: Int -> IO e
loop Int
n' =
if Int
n' forall a. Ord a => a -> a -> Bool
> Int
n
then
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray IOUArray Int e
arr Int
n
else
let p' :: Point
p' = Point
p { pointIteration :: Int
pointIteration = Int
n', pointPhase :: Int
pointPhase = Int
0,
pointTime :: Double
pointTime = Specs -> Int -> Int -> Double
basicTime Specs
sc Int
n' Int
0 }
in do e
a <- Point -> IO e
m Point
p'
e
a seq :: forall a b. a -> b -> b
`seq` forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray IOUArray Int e
arr Int
n' e
a
forall a. IORef a -> a -> IO ()
writeIORef IORef Int
nref (Int
n' forall a. Num a => a -> a -> a
+ Int
1)
Int -> IO e
loop (Int
n' forall a. Num a => a -> a -> a
+ Int
1)
Int
n' <- forall a. IORef a -> IO a
readIORef IORef Int
nref
Int -> IO e
loop Int
n'
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Dynamics a -> Dynamics a
discreteDynamics forall a b. (a -> b) -> a -> b
$ forall a. (Point -> IO a) -> Dynamics a
Dynamics Point -> IO e
r