-- |
-- Module     : Simulation.Aivika.Table
-- Copyright  : Copyright (c) 2009-2017, David Sorokin <david.sorokin@gmail.com>
-- License    : BSD3
-- Maintainer : David Sorokin <david.sorokin@gmail.com>
-- Stability  : experimental
-- Tested with: GHC 8.0.1
--
-- It defines the table functions.
--
module Simulation.Aivika.Table
       (tableLookup,
        tableLookupStepwise) where

import Data.Array

-- | Lookup @x@ in a table of pairs @(x, y)@ using linear interpolation.
tableLookup :: Double -> Array Int (Double, Double) -> Double
tableLookup :: Double -> Array Int (Double, Double) -> Double
tableLookup Double
x Array Int (Double, Double)
tbl = Int -> Int -> Double -> Double
find Int
first Int
last Double
x
  where
    (Int
first, Int
last) = Array Int (Double, Double) -> (Int, Int)
forall i e. Array i e -> (i, i)
bounds Array Int (Double, Double)
tbl
    find :: Int -> Int -> Double -> Double
find Int
left Int
right Double
x =
      if Int
left Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
right then
        [Char] -> Double
forall a. HasCallStack => [Char] -> a
error [Char]
"Incorrect index: tableLookup"
      else
        let index :: Int
index = (Int
left Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
right) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
            x1 :: Double
x1    = (Double, Double) -> Double
forall a b. (a, b) -> a
fst ((Double, Double) -> Double) -> (Double, Double) -> Double
forall a b. (a -> b) -> a -> b
$ Array Int (Double, Double)
tbl Array Int (Double, Double) -> Int -> (Double, Double)
forall i e. Ix i => Array i e -> i -> e
! Int
index
        in if Double
x1 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
x then 
             let y :: Double
y | Int
index Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
right = Int -> Int -> Double -> Double
find Int
index Int
right Double
x
                   | Int
right Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
last = (Double, Double) -> Double
forall a b. (a, b) -> b
snd ((Double, Double) -> Double) -> (Double, Double) -> Double
forall a b. (a -> b) -> a -> b
$ Array Int (Double, Double)
tbl Array Int (Double, Double) -> Int -> (Double, Double)
forall i e. Ix i => Array i e -> i -> e
! Int
right
                   | Bool
otherwise     = 
                     let x2 :: Double
x2 = (Double, Double) -> Double
forall a b. (a, b) -> a
fst ((Double, Double) -> Double) -> (Double, Double) -> Double
forall a b. (a -> b) -> a -> b
$ Array Int (Double, Double)
tbl Array Int (Double, Double) -> Int -> (Double, Double)
forall i e. Ix i => Array i e -> i -> e
! (Int
index Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                         y1 :: Double
y1 = (Double, Double) -> Double
forall a b. (a, b) -> b
snd ((Double, Double) -> Double) -> (Double, Double) -> Double
forall a b. (a -> b) -> a -> b
$ Array Int (Double, Double)
tbl Array Int (Double, Double) -> Int -> (Double, Double)
forall i e. Ix i => Array i e -> i -> e
! Int
index
                         y2 :: Double
y2 = (Double, Double) -> Double
forall a b. (a, b) -> b
snd ((Double, Double) -> Double) -> (Double, Double) -> Double
forall a b. (a -> b) -> a -> b
$ Array Int (Double, Double)
tbl Array Int (Double, Double) -> Int -> (Double, Double)
forall i e. Ix i => Array i e -> i -> e
! (Int
index Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                     in Double
y1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Double
y2 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
y1) Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
x1) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
x2 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
x1) 
             in Double
y
           else
             let y :: Double
y | Int
left Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
index  = Int -> Int -> Double -> Double
find Int
left (Int
index Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Double
x
                   | Int
left Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
first = (Double, Double) -> Double
forall a b. (a, b) -> b
snd ((Double, Double) -> Double) -> (Double, Double) -> Double
forall a b. (a -> b) -> a -> b
$ Array Int (Double, Double)
tbl Array Int (Double, Double) -> Int -> (Double, Double)
forall i e. Ix i => Array i e -> i -> e
! Int
left
                   | Bool
otherwise     = [Char] -> Double
forall a. HasCallStack => [Char] -> a
error [Char]
"Incorrect index: tableLookup"
             in Double
y

-- | Lookup @x@ in a table of pairs @(x, y)@ using stepwise function.
tableLookupStepwise :: Double -> Array Int (Double, Double) -> Double
tableLookupStepwise :: Double -> Array Int (Double, Double) -> Double
tableLookupStepwise Double
x Array Int (Double, Double)
tbl = Int -> Int -> Double -> Double
find Int
first Int
last Double
x
  where
    (Int
first, Int
last) = Array Int (Double, Double) -> (Int, Int)
forall i e. Array i e -> (i, i)
bounds Array Int (Double, Double)
tbl
    find :: Int -> Int -> Double -> Double
find Int
left Int
right Double
x =
      if Int
left Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
right then
        [Char] -> Double
forall a. HasCallStack => [Char] -> a
error [Char]
"Incorrect index: tableLookupStepwise"
      else
        let index :: Int
index = (Int
left Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
right) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
            x1 :: Double
x1    = (Double, Double) -> Double
forall a b. (a, b) -> a
fst ((Double, Double) -> Double) -> (Double, Double) -> Double
forall a b. (a -> b) -> a -> b
$ Array Int (Double, Double)
tbl Array Int (Double, Double) -> Int -> (Double, Double)
forall i e. Ix i => Array i e -> i -> e
! Int
index
        in if Double
x1 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
x then 
             let y :: Double
y | Int
index Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
right = Int -> Int -> Double -> Double
find Int
index Int
right Double
x
                   | Int
right Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
last = (Double, Double) -> Double
forall a b. (a, b) -> b
snd ((Double, Double) -> Double) -> (Double, Double) -> Double
forall a b. (a -> b) -> a -> b
$ Array Int (Double, Double)
tbl Array Int (Double, Double) -> Int -> (Double, Double)
forall i e. Ix i => Array i e -> i -> e
! Int
right
                   | Bool
otherwise     = (Double, Double) -> Double
forall a b. (a, b) -> b
snd ((Double, Double) -> Double) -> (Double, Double) -> Double
forall a b. (a -> b) -> a -> b
$ Array Int (Double, Double)
tbl Array Int (Double, Double) -> Int -> (Double, Double)
forall i e. Ix i => Array i e -> i -> e
! Int
right
             in Double
y
           else
             let y :: Double
y | Int
left Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
index  = Int -> Int -> Double -> Double
find Int
left (Int
index Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Double
x
                   | Int
left Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
first = (Double, Double) -> Double
forall a b. (a, b) -> b
snd ((Double, Double) -> Double) -> (Double, Double) -> Double
forall a b. (a -> b) -> a -> b
$ Array Int (Double, Double)
tbl Array Int (Double, Double) -> Int -> (Double, Double)
forall i e. Ix i => Array i e -> i -> e
! Int
left
                   | Bool
otherwise     = [Char] -> Double
forall a. HasCallStack => [Char] -> a
error [Char]
"Incorrect index: tableLookupStepwise"
             in Double
y