aivika-0.5.4: A multi-paradigm simulation library

Stabilityexperimental
MaintainerDavid Sorokin <david.sorokin@gmail.com>
Safe HaskellSafe-Inferred

Simulation.Aivika.Dynamics.SystemDynamics

Contents

Description

Tested with: GHC 7.6.3

This module defines integrals and other functions of System Dynamics.

Synopsis

Equality and Ordering

(.==.) :: Eq a => Dynamics a -> Dynamics a -> Dynamics BoolSource

Compare for equality.

(./=.) :: Eq a => Dynamics a -> Dynamics a -> Dynamics BoolSource

Compare for inequality.

(.<.) :: Ord a => Dynamics a -> Dynamics a -> Dynamics BoolSource

Compare for ordering.

(.>=.) :: Ord a => Dynamics a -> Dynamics a -> Dynamics BoolSource

Compare for ordering.

(.>.) :: Ord a => Dynamics a -> Dynamics a -> Dynamics BoolSource

Compare for ordering.

(.<=.) :: Ord a => Dynamics a -> Dynamics a -> Dynamics BoolSource

Compare for ordering.

maxDynamics :: Ord a => Dynamics a -> Dynamics a -> Dynamics aSource

Return the maximum.

minDynamics :: Ord a => Dynamics a -> Dynamics a -> Dynamics aSource

Return the minimum.

ifDynamics :: Dynamics Bool -> Dynamics a -> Dynamics a -> Dynamics aSource

Implement the if-then-else operator.

Integrals

data Integ Source

Deprecated: Use the integ function instead

The Integ type represents an integral.

newInteg :: Dynamics Double -> Simulation IntegSource

Deprecated: Use the integ function instead

Create a new integral with the specified initial value.

integInit :: Integ -> Dynamics DoubleSource

Deprecated: Use the integ function instead

The initial value.

integValue :: Integ -> Dynamics DoubleSource

Deprecated: Use the integ function instead

Return the integral's value.

integDiff :: Integ -> Dynamics Double -> Simulation ()Source

Deprecated: Use the integ function instead

Set the derivative for the integral.

Integral Functions

integSource

Arguments

:: Dynamics Double

the derivative

-> Dynamics Double

the initial value

-> Simulation (Dynamics Double)

the integral

Return an integral with the specified derivative and initial value.

To create a loopback, you should use the recursive do-notation. It allows defining the differential equations unordered as in mathematics:

 model :: Simulation [Double]
 model = 
   mdo a <- integ (- ka * a) 100
       b <- integ (ka * a - kb * b) 0
       c <- integ (kb * b) 0
       let ka = 1
           kb = 1
       runDynamicsInStopTime $ sequence [a, b, c]

smoothISource

Arguments

:: Dynamics Double

the value to smooth over time

-> Dynamics Double

time

-> Dynamics Double

the initial value

-> Simulation (Dynamics Double)

the first order exponential smooth

Return the first order exponential smooth.

To create a loopback, you should use the recursive do-notation with help of which the function itself is defined:

 smoothI x t i =
   mdo y <- integ ((x - y) / t) i
       return y

smoothSource

Arguments

:: Dynamics Double

the value to smooth over time

-> Dynamics Double

time

-> Simulation (Dynamics Double)

the first order exponential smooth

Return the first order exponential smooth.

This is a simplified version of the smoothI function without specifing the initial value.

smooth3ISource

Arguments

:: Dynamics Double

the value to smooth over time

-> Dynamics Double

time

-> Dynamics Double

the initial value

-> Simulation (Dynamics Double)

the third order exponential smooth

Return the third order exponential smooth.

To create a loopback, you should use the recursive do-notation with help of which the function itself is defined:

 smooth3I x t i =
   mdo y  <- integ ((s2 - y) / t') i
       s2 <- integ ((s1 - s2) / t') i
       s1 <- integ ((x - s1) / t') i
       let t' = t / 3.0
       return y

smooth3Source

Arguments

:: Dynamics Double

the value to smooth over time

-> Dynamics Double

time

-> Simulation (Dynamics Double)

the third order exponential smooth

Return the third order exponential smooth.

This is a simplified version of the smooth3I function without specifying the initial value.

smoothNISource

Arguments

:: Dynamics Double

the value to smooth over time

-> Dynamics Double

time

-> Int

the order

-> Dynamics Double

the initial value

-> Simulation (Dynamics Double)

the n'th order exponential smooth

Return the n'th order exponential smooth.

The result is not discrete in that sense that it may change within the integration time interval depending on the integration method used. Probably, you should apply the discrete function to the result if you want to achieve an effect when the value is not changed within the time interval, which is used sometimes.

smoothNSource

Arguments

:: Dynamics Double

the value to smooth over time

-> Dynamics Double

time

-> Int

the order

-> Simulation (Dynamics Double)

the n'th order exponential smooth

Return the n'th order exponential smooth.

This is a simplified version of the smoothNI function without specifying the initial value.

delay1ISource

Arguments

:: Dynamics Double

the value to conserve

-> Dynamics Double

time

-> Dynamics Double

the initial value

-> Simulation (Dynamics Double)

the first order exponential delay

Return the first order exponential delay.

To create a loopback, you should use the recursive do-notation with help of which the function itself is defined:

 delay1I x t i =
   mdo y <- integ (x - y / t) (i * t)
       return $ y / t

delay1Source

Arguments

:: Dynamics Double

the value to conserve

-> Dynamics Double

time

-> Simulation (Dynamics Double)

the first order exponential delay

Return the first order exponential delay.

This is a simplified version of the delay1I function without specifying the initial value.

delay3ISource

Arguments

:: Dynamics Double

the value to conserve

-> Dynamics Double

time

-> Dynamics Double

the initial value

-> Simulation (Dynamics Double)

the third order exponential delay

Return the third order exponential delay.

delay3Source

Arguments

:: Dynamics Double

the value to conserve

-> Dynamics Double

time

-> Simulation (Dynamics Double)

the third order exponential delay

Return the third order exponential delay.

This is a simplified version of the delay3I function without specifying the initial value.

delayNISource

Arguments

:: Dynamics Double

the value to conserve

-> Dynamics Double

time

-> Int

the order

-> Dynamics Double

the initial value

-> Simulation (Dynamics Double)

the n'th order exponential delay

Return the n'th order exponential delay.

delayNSource

Arguments

:: Dynamics Double

the value to conserve

-> Dynamics Double

time

-> Int

the order

-> Simulation (Dynamics Double)

the n'th order exponential delay

Return the n'th order exponential delay.

This is a simplified version of the delayNI function without specifying the initial value.

forecastSource

Arguments

:: Dynamics Double

the value to forecast

-> Dynamics Double

the average time

-> Dynamics Double

the time horizon

-> Simulation (Dynamics Double)

the forecast

Return the forecast.

The function has the following definition:

 forecast x at hz =
   do y <- smooth x at
      return $ x * (1.0 + (x / y - 1.0) / at * hz)

trendSource

Arguments

:: Dynamics Double

the value for which the trend is calculated

-> Dynamics Double

the average time

-> Dynamics Double

the initial value

-> Simulation (Dynamics Double)

the fractional change rate

Return the trend.

The function has the following definition:

 trend x at i =
   do y <- smoothI x at (x / (1.0 + i * at))
      return $ (x / y - 1.0) / at

Difference Equations

data Sum a Source

Deprecated: Use the sumDynamics function instead

The Sum type represents a sum defined by some difference equation.

newSum :: (MArray IOUArray a IO, Num a) => Dynamics a -> Simulation (Sum a)Source

Deprecated: Use the sumDynamics function instead

Create a new sum with the specified initial value.

sumInit :: Sum a -> Dynamics aSource

Deprecated: Use the sumDynamics function instead

The initial value.

sumValue :: Sum a -> Dynamics aSource

Deprecated: Use the sumDynamics function instead

Return the total sum defined by the difference equation.

sumDiff :: (MArray IOUArray a IO, Num a) => Sum a -> Dynamics a -> Simulation ()Source

Deprecated: Use the sumDynamics function instead

Set the difference equation for the sum.

sumDynamicsSource

Arguments

:: (MArray IOUArray a IO, Num a) 
=> Dynamics a

the difference

-> Dynamics a

the initial value

-> Simulation (Dynamics a)

the sum

Retun the sum for the difference equation. It is like an integral returned by the integ function, only now the difference is used instead of derivative.

As usual, to create a loopback, you should use the recursive do-notation.

Table Functions

lookupD :: Dynamics Double -> Array Int (Double, Double) -> Dynamics DoubleSource

Deprecated: Use the lookupDynamics function instead

Lookup x in a table of pairs (x, y) using linear interpolation.

lookupStepwiseD :: Dynamics Double -> Array Int (Double, Double) -> Dynamics DoubleSource

Deprecated: Use the lookupStepwiseDynamics function instead

Lookup x in a table of pairs (x, y) using stepwise function.

lookupDynamics :: Dynamics Double -> Array Int (Double, Double) -> Dynamics DoubleSource

Lookup x in a table of pairs (x, y) using linear interpolation.

lookupStepwiseDynamics :: Dynamics Double -> Array Int (Double, Double) -> Dynamics DoubleSource

Lookup x in a table of pairs (x, y) using stepwise function.

Discrete Functions

delayTransSource

Arguments

:: Dynamics a

the value to delay

-> Dynamics Double

the lag time

-> Dynamics a

the initial value

-> (Dynamics a -> Simulation (Dynamics a))

the transform (usually, a memoization)

-> Simulation (Dynamics a)

the delayed value

Return the delayed value. This is a general version using the specified transform, usually a memoization.

delaySource

Arguments

:: Dynamics a

the value to delay

-> Dynamics Double

the lag time

-> Simulation (Dynamics a)

the delayed value

Return the delayed value.

It is defined in the following way:

 delay x d = delayTrans x d x memo0

delayISource

Arguments

:: Dynamics a

the value to delay

-> Dynamics Double

the lag time

-> Dynamics a

the initial value

-> Simulation (Dynamics a)

the delayed value

Return the delayed value.

It is defined in the following way:

 delayI x d i = delayTrans x d i memo0

udelaySource

Arguments

:: (MArray IOUArray a IO, Num a) 
=> Dynamics a

the value to delay

-> Dynamics Double

the lag time

-> Simulation (Dynamics a)

the delayed value

Return the delayed value. This is a more efficient unboxed version of the delay function.

It is defined in the following way:

 udelay x d = delayTrans x d x umemo0

udelayISource

Arguments

:: (MArray IOUArray a IO, Num a) 
=> Dynamics a

the value to delay

-> Dynamics Double

the lag time

-> Dynamics a

the initial value

-> Simulation (Dynamics a)

the delayed value

Return the delayed value. This is a more efficient unboxed version of the delayI function.

It is defined in the following way:

 udelayI x d i = delayTrans x d i umemo0

Financial Functions

npvSource

Arguments

:: Dynamics Double

the stream

-> Dynamics Double

the discount rate

-> Dynamics Double

the initial value

-> Dynamics Double

factor

-> Simulation (Dynamics Double)

the Net Present Value (NPV)

Return the Net Present Value (NPV) of the stream computed using the specified discount rate, the initial value and some factor (usually 1).

It is defined in the following way:

 npv stream rate init factor =
   mdo df <- integ (- df * rate) 1
       accum <- integ (stream * df) init
       return $ (accum + dt * stream * df) * factor

npveSource

Arguments

:: Dynamics Double

the stream

-> Dynamics Double

the discount rate

-> Dynamics Double

the initial value

-> Dynamics Double

factor

-> Simulation (Dynamics Double)

the Net Present Value End (NPVE)

Return the Net Present Value End of period (NPVE) of the stream computed using the specified discount rate, the initial value and some factor.

It is defined in the following way:

 npve stream rate init factor =
   mdo df <- integ (- df * rate / (1 + rate * dt)) (1 / (1 + rate * dt))
       accum <- integ (stream * df) init
       return $ (accum + dt * stream * df) * factor