{-# OPTIONS_GHC -F -pgmF htfpp #-}
{-# OPTIONS_HADDOCK prune #-}
{-# LANGUAGE TemplateHaskell #-}

module Striot.Jackson ( OperatorInfo(..)
                      , calcAll

                      , arrivalRate
                      , arrivalRate'
                      , outputRate

                      , derivePropagationArray
                      , deriveServiceTimes
                      , deriveInputsArray
                      , calcAllSg
                      , isOverUtilised

                      -- defined
                      , taxiQ1Array
                      , taxiQ1Inputs
                      , taxiQ1meanServiceTimes
                      -- calculated
                      , taxiQ1arrivalRates
                      , taxiQ1utilisation
                      , taxiQ1Calc


                      , htf_thisModulesTests) where

-- import FunctionalIoTtypes
-- import FunctionalProcessing
import Data.Array -- cabal install array
import Matrix.LU -- cabal install dsp
import Matrix.Matrix
import Data.List
import Test.Framework
import Data.Maybe (fromMaybe, fromJust)

import Striot.StreamGraph
import Algebra.Graph

-- References & Manuals
-- https://en.wikipedia.org/wiki/Jackson_network
-- http://www.ece.virginia.edu/mv/edu/715/lectures/QNet.pdf
-- https://hackage.haskell.org/package/dsp 
-- http://haskelldsp.sourceforge.net/doc/Matrix.LU.html
-- https://hackage.haskell.org/package/array-0.5.1.1/docs/Data-Array.html
-- http://haskelldsp.sourceforge.net/doc/Matrix.Matrix.html

-- |Derive the identity matrix from a 2D Array
identity:: (Ix a, Integral a, Num b) => Array (a,a) b -> Array (a,a) b
identity :: forall a b.
(Ix a, Integral a, Num b) =>
Array (a, a) b -> Array (a, a) b
identity Array (a, a) b
p = ((a, a), (a, a)) -> [b] -> Array (a, a) b
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Array (a, a) b -> ((a, a), (a, a))
forall i e. Array i e -> (i, i)
bounds Array (a, a) b
p) ([b] -> Array (a, a) b) -> [b] -> Array (a, a) b
forall a b. (a -> b) -> a -> b
$ [if a
rowa -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
column then b
1 else b
0| a
row<-[a
xfrom..a
xto],a
column<-[a
yfrom..a
yto]]
                        where ((a
xfrom,a
yfrom),(a
xto,a
yto)) = Array (a, a) b -> ((a, a), (a, a))
forall i e. Array i e -> (i, i)
bounds Array (a, a) b
p
                        
test_identity :: IO ()
test_identity = Array (Int, Int) Double -> Array (Int, Int) Double -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
assertEqual (Array (Int, Int) Double -> Array (Int, Int) Double
forall a b.
(Ix a, Integral a, Num b) =>
Array (a, a) b -> Array (a, a) b
identity (((Int, Int), (Int, Int)) -> [Double] -> Array (Int, Int) Double
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray ((Int
1,Int
1),(Int
3,Int
3)) ([Double] -> Array (Int, Int) Double)
-> [Double] -> Array (Int, Int) Double
forall a b. (a -> b) -> a -> b
$ [Double
0 | Integer
x <- [Integer
1..Integer
9]])) (Array (Int, Int) Double -> IO ())
-> Array (Int, Int) Double -> IO ()
forall a b. (a -> b) -> a -> b
$
    (((Int, Int), (Int, Int))
-> [((Int, Int), Double)] -> Array (Int, Int) Double
forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
array ((Int
1,Int
1),(Int
3,Int
3)) [((Int
1,Int
1),Double
1.0), ((Int
1,Int
2),Double
0.0), ((Int
1,Int
3),Double
0.0),
                          ((Int
2,Int
1),Double
0.0), ((Int
2,Int
2),Double
1.0), ((Int
2,Int
3),Double
0.0),
                          ((Int
3,Int
1),Double
0.0), ((Int
3,Int
2),Double
0.0), ((Int
3,Int
3),Double
1.0)] :: Array (Int,Int) Double)

test_identity2 :: IO ()
test_identity2= Array (Int, Int) Double -> Array (Int, Int) Double -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
assertEqual (Array (Int, Int) Double -> Array (Int, Int) Double
forall a b.
(Ix a, Integral a, Num b) =>
Array (a, a) b -> Array (a, a) b
identity (((Int, Int), (Int, Int)) -> [Double] -> Array (Int, Int) Double
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray ((Int
0,Int
0),(Int
2,Int
2)) ([Double] -> Array (Int, Int) Double)
-> [Double] -> Array (Int, Int) Double
forall a b. (a -> b) -> a -> b
$ [Double
0 | Integer
x <- [Integer
1..Integer
9]])) (Array (Int, Int) Double -> IO ())
-> Array (Int, Int) Double -> IO ()
forall a b. (a -> b) -> a -> b
$
    (((Int, Int), (Int, Int))
-> [((Int, Int), Double)] -> Array (Int, Int) Double
forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
array ((Int
0,Int
0),(Int
2,Int
2)) [((Int
0,Int
0),Double
1.0), ((Int
0,Int
1),Double
0.0), ((Int
0,Int
2),Double
0.0),
                          ((Int
1,Int
0),Double
0.0), ((Int
1,Int
1),Double
1.0), ((Int
1,Int
2),Double
0.0),
                          ((Int
2,Int
0),Double
0.0), ((Int
2,Int
1),Double
0.0), ((Int
2,Int
2),Double
1.0)] :: Array (Int,Int) Double)

-- |Matrix subtraction.
mm_subtract:: (Ix a, Integral a, Num b) => Array (a, a) b -> Array (a, a) b -> Array (a, a) b
mm_subtract :: forall a b.
(Ix a, Integral a, Num b) =>
Array (a, a) b -> Array (a, a) b -> Array (a, a) b
mm_subtract Array (a, a) b
x Array (a, a) b
y = ((a, a), (a, a)) -> [b] -> Array (a, a) b
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Array (a, a) b -> ((a, a), (a, a))
forall i e. Array i e -> (i, i)
bounds Array (a, a) b
x) ([b] -> Array (a, a) b) -> [b] -> Array (a, a) b
forall a b. (a -> b) -> a -> b
$ [(Array (a, a) b
x Array (a, a) b -> (a, a) -> b
forall i e. Ix i => Array i e -> i -> e
Data.Array.! (a
row,a
column))b -> b -> b
forall a. Num a => a -> a -> a
-(Array (a, a) b
y Array (a, a) b -> (a, a) -> b
forall i e. Ix i => Array i e -> i -> e
Data.Array.! (a
row,a
column))| a
row<-[a
xfrom..a
xto],a
column<-[a
yfrom..a
yto]]
                        where ((a
xfrom,a
yfrom),(a
xto,a
yto)) = Array (a, a) b -> ((a, a), (a, a))
forall i e. Array i e -> (i, i)
bounds Array (a, a) b
x

test_mm_subtract1 :: IO ()
test_mm_subtract1 = Array (Integer, Integer) Double
-> Array (Integer, Integer) Double -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
assertEqual (Array (Integer, Integer) Double
-> Array (Integer, Integer) Double
-> Array (Integer, Integer) Double
forall a b.
(Ix a, Integral a, Num b) =>
Array (a, a) b -> Array (a, a) b -> Array (a, a) b
mm_subtract Array (Integer, Integer) Double
a Array (Integer, Integer) Double
b) Array (Integer, Integer) Double
c
    where
        a :: Array (Integer, Integer) Double
a = ((Integer, Integer), (Integer, Integer))
-> [Double] -> Array (Integer, Integer) Double
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray ((Integer
1,Integer
1),(Integer
3,Integer
3)) [Double
3.0::Double | Integer
x <- [Integer
1..Integer
9]]
        b :: Array (Integer, Integer) Double
b = ((Integer, Integer), (Integer, Integer))
-> [Double] -> Array (Integer, Integer) Double
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray ((Integer
1,Integer
1),(Integer
3,Integer
3)) [Double
2.0::Double | Integer
x <- [Integer
1..Integer
9]]
        c :: Array (Integer, Integer) Double
c = ((Integer, Integer), (Integer, Integer))
-> [Double] -> Array (Integer, Integer) Double
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray ((Integer
1,Integer
1),(Integer
3,Integer
3)) [Double
1.0::Double | Integer
x <- [Integer
1..Integer
9]]

test_mm_subtract2 :: IO ()
test_mm_subtract2 = Array (Integer, Integer) Double
-> Array (Integer, Integer) Double -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
assertEqual (Array (Integer, Integer) Double
-> Array (Integer, Integer) Double
-> Array (Integer, Integer) Double
forall a b.
(Ix a, Integral a, Num b) =>
Array (a, a) b -> Array (a, a) b -> Array (a, a) b
mm_subtract Array (Integer, Integer) Double
a Array (Integer, Integer) Double
b) Array (Integer, Integer) Double
c
    where
        a :: Array (Integer, Integer) Double
a = ((Integer, Integer), (Integer, Integer))
-> [Double] -> Array (Integer, Integer) Double
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray ((Integer
0,Integer
0),(Integer
2,Integer
2)) [Double
3.0::Double | Integer
x <- [Integer
1..Integer
9]]
        b :: Array (Integer, Integer) Double
b = ((Integer, Integer), (Integer, Integer))
-> [Double] -> Array (Integer, Integer) Double
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray ((Integer
0,Integer
0),(Integer
2,Integer
2)) [Double
2.0::Double | Integer
x <- [Integer
1..Integer
9]]
        c :: Array (Integer, Integer) Double
c = ((Integer, Integer), (Integer, Integer))
-> [Double] -> Array (Integer, Integer) Double
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray ((Integer
0,Integer
0),(Integer
2,Integer
2)) [Double
1.0::Double | Integer
x <- [Integer
1..Integer
9]]

-- | Matrix multiplication.
-- The indexes must begin at 1.
ma_mult:: (Ix a, Integral a, Num b) => Array (a, a) b -> b -> Array (a, a) b 
ma_mult :: forall a b.
(Ix a, Integral a, Num b) =>
Array (a, a) b -> b -> Array (a, a) b
ma_mult Array (a, a) b
x b
v   = ((a, a), (a, a)) -> [b] -> Array (a, a) b
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Array (a, a) b -> ((a, a), (a, a))
forall i e. Array i e -> (i, i)
bounds Array (a, a) b
x) ([b] -> Array (a, a) b) -> [b] -> Array (a, a) b
forall a b. (a -> b) -> a -> b
$ [b
vb -> b -> b
forall a. Num a => a -> a -> a
*(Array (a, a) b
x Array (a, a) b -> (a, a) -> b
forall i e. Ix i => Array i e -> i -> e
Data.Array.! (a
row,a
column))| a
row<-[a
1..a
size],a
column<-[a
1..a
size]] 
                          where size :: a
size = (a, a) -> a
forall a b. (a, b) -> a
fst ((a, a) -> a) -> (a, a) -> a
forall a b. (a -> b) -> a -> b
$ ((a, a), (a, a)) -> (a, a)
forall a b. (a, b) -> b
snd (((a, a), (a, a)) -> (a, a)) -> ((a, a), (a, a)) -> (a, a)
forall a b. (a -> b) -> a -> b
$ Array (a, a) b -> ((a, a), (a, a))
forall i e. Array i e -> (i, i)
bounds Array (a, a) b
x
                          
-- | Vector (1D Array) multiplication by value.
va_mult:: (Ix a, Integral a, Num b) => Array a b -> b -> Array a b 
va_mult :: forall a b.
(Ix a, Integral a, Num b) =>
Array a b -> b -> Array a b
va_mult Array a b
x b
val   = (a, a) -> [b] -> Array a b
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Array a b -> (a, a)
forall i e. Array i e -> (i, i)
bounds Array a b
x) [b
valb -> b -> b
forall a. Num a => a -> a -> a
*(Array a b
x Array a b -> a -> b
forall i e. Ix i => Array i e -> i -> e
! a
row) | a
row <- [a
from..a
to]]
                          where (a
from,a
to) = Array a b -> (a, a)
forall i e. Array i e -> (i, i)
bounds Array a b
x

-- | Vector (1D Array) multiplication.
-- The indexes must begin at 1.
vv_mult:: (Ix a, Integral a, Num b) => Array a b -> Array a b -> Array a b
vv_mult :: forall a b.
(Ix a, Integral a, Num b) =>
Array a b -> Array a b -> Array a b
vv_mult Array a b
v1 Array a b
v2 = (a, a) -> [b] -> Array a b
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Array a b -> (a, a)
forall i e. Array i e -> (i, i)
bounds Array a b
v1) ([b] -> Array a b) -> [b] -> Array a b
forall a b. (a -> b) -> a -> b
$ [(Array a b
v1 Array a b -> a -> b
forall i e. Ix i => Array i e -> i -> e
Data.Array.! a
row)b -> b -> b
forall a. Num a => a -> a -> a
*(Array a b
v2 Array a b -> a -> b
forall i e. Ix i => Array i e -> i -> e
Data.Array.!a
row) |a
row <- [a
1..a
size]]
                          where size :: a
size = (a, a) -> a
forall a b. (a, b) -> b
snd ((a, a) -> a) -> (a, a) -> a
forall a b. (a -> b) -> a -> b
$ Array a b -> (a, a)
forall i e. Array i e -> (i, i)
bounds Array a b
v1

-- | Vector (1D Array) equivalent of `take`
v_take:: Int -> Array Int b -> Array Int b
v_take :: forall b. Int -> Array Int b -> Array Int b
v_take Int
max Array Int b
v = (Int, Int) -> [b] -> Array Int b
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
1,Int
max) ([b] -> Array Int b) -> [b] -> Array Int b
forall a b. (a -> b) -> a -> b
$ [Array Int b
v Array Int b -> Int -> b
forall i e. Ix i => Array i e -> i -> e
Data.Array.! Int
row |Int
row <- [Int
1..Int
max]]

-- Jackson Network: lambda = (I-P')^(-1)a where a = (alpha.p0i)i=1..J
arrivalRate:: Array (Int, Int) Double -> Array Int Double -> Double -> Array Int Double  
-- p - selectivities of filters
-- p0i - distribution of input events into the system (i.e. to which nodes, which are the source nodes)
-- alpha- arrival rate into the system
arrivalRate :: Array (Int, Int) Double
-> Array Int Double -> Double -> Array Int Double
arrivalRate Array (Int, Int) Double
p Array Int Double
p0i Double
alpha = Array (Int, Int) Double -> Array Int Double -> Array Int Double
arrivalRate' Array (Int, Int) Double
p Array Int Double
aa
                              where aa :: Array Int Double
aa = Array Int Double -> Double -> Array Int Double
forall a b.
(Ix a, Integral a, Num b) =>
Array a b -> b -> Array a b
va_mult Array Int Double
p0i Double
alpha

arrivalRate' :: Array (Int, Int) Double -> Array Int Double -> Array Int Double
arrivalRate' Array (Int, Int) Double
p Array Int Double
aa = Array (Int, Int) Double -> Array Int Double -> Array Int Double
forall i j a.
(Ix i, Ix j, Num a) =>
Array (i, j) a -> Array j a -> Array i a
mv_mult (Array (Int, Int) Double -> Array (Int, Int) Double
inverse (Array (Int, Int) Double -> Array (Int, Int) Double)
-> Array (Int, Int) Double -> Array (Int, Int) Double
forall a b. (a -> b) -> a -> b
$ Array (Int, Int) Double
-> Array (Int, Int) Double -> Array (Int, Int) Double
forall a b.
(Ix a, Integral a, Num b) =>
Array (a, a) b -> Array (a, a) b -> Array (a, a) b
mm_subtract (Array (Int, Int) Double -> Array (Int, Int) Double
forall a b.
(Ix a, Integral a, Num b) =>
Array (a, a) b -> Array (a, a) b
identity Array (Int, Int) Double
p) (Array (Int, Int) Double -> Array (Int, Int) Double
forall i j a.
(Ix i, Ix j, Num a) =>
Array (i, j) a -> Array (j, i) a
m_trans Array (Int, Int) Double
p)) Array Int Double
aa
 
  
-- ρ = λ/μ is the utilization of the buffer (the average proportion of time which the server is occupied.  
utilisation:: Array Int Double -> Array Int Double -> Array Int Double
utilisation :: Array Int Double -> Array Int Double -> Array Int Double
utilisation Array Int Double
arrivalRates Array Int Double
meanServiceTimes = Array Int Double -> Array Int Double -> Array Int Double
forall a b.
(Ix a, Integral a, Num b) =>
Array a b -> Array a b -> Array a b
vv_mult Array Int Double
arrivalRates Array Int Double
meanServiceTimes

-- the average number of customers in the system is ρ/(1 − ρ)
avgeNumberOfCustomersInSystem:: Array Int Double -> Array Int Double
avgeNumberOfCustomersInSystem :: Array Int Double -> Array Int Double
avgeNumberOfCustomersInSystem Array Int Double
utilisations = (Int, Int) -> [Double] -> Array Int Double
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Array Int Double -> (Int, Int)
forall i e. Array i e -> (i, i)
bounds Array Int Double
utilisations) ([Double] -> Array Int Double) -> [Double] -> Array Int Double
forall a b. (a -> b) -> a -> b
$ 
                                                       [(Array Int Double
utilisations Array Int Double -> Int -> Double
forall i e. Ix i => Array i e -> i -> e
Data.Array.! Int
row)Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/(Double
1.0Double -> Double -> Double
forall a. Num a => a -> a -> a
- (Array Int Double
utilisations Array Int Double -> Int -> Double
forall i e. Ix i => Array i e -> i -> e
Data.Array.!Int
row)) |Int
row <- [Int
1..Int
size]]
                                                 where size :: Int
size = (Int, Int) -> Int
forall a b. (a, b) -> b
snd ((Int, Int) -> Int) -> (Int, Int) -> Int
forall a b. (a -> b) -> a -> b
$ Array Int Double -> (Int, Int)
forall i e. Array i e -> (i, i)
bounds Array Int Double
utilisations
                                                 
-- the average response time (total time a customer spends in the system) is 1/(μ − λ)
avgeResponseTime:: Array Int Double -> Array Int Double -> Array Int Double
avgeResponseTime :: Array Int Double -> Array Int Double -> Array Int Double
avgeResponseTime Array Int Double
arrivalRates Array Int Double
meanServiceTimes = (Int, Int) -> [Double] -> Array Int Double
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Array Int Double -> (Int, Int)
forall i e. Array i e -> (i, i)
bounds Array Int Double
arrivalRates) ([Double] -> Array Int Double) -> [Double] -> Array Int Double
forall a b. (a -> b) -> a -> b
$ 
                                                       [Double
1.0Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/((Double
1.0Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/(Array Int Double
meanServiceTimes Array Int Double -> Int -> Double
forall i e. Ix i => Array i e -> i -> e
Data.Array.! Int
row))Double -> Double -> Double
forall a. Num a => a -> a -> a
-(Array Int Double
arrivalRates Array Int Double -> Int -> Double
forall i e. Ix i => Array i e -> i -> e
Data.Array.!Int
row)) |Int
row <- [Int
1..Int
size]]
                                                 where size :: Int
size = (Int, Int) -> Int
forall a b. (a, b) -> b
snd ((Int, Int) -> Int) -> (Int, Int) -> Int
forall a b. (a -> b) -> a -> b
$ Array Int Double -> (Int, Int)
forall i e. Array i e -> (i, i)
bounds Array Int Double
arrivalRates

stable:: Array Int Double -> Array Int Double -> Array Int Bool
stable :: Array Int Double -> Array Int Double -> Array Int Bool
stable Array Int Double
arrivalRates Array Int Double
meanServiceTimes = let utils :: Array Int Double
utils = Array Int Double -> Array Int Double -> Array Int Double
utilisation Array Int Double
arrivalRates Array Int Double
meanServiceTimes in
                                           (Int, Int) -> [Bool] -> Array Int Bool
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Array Int Double -> (Int, Int)
forall i e. Array i e -> (i, i)
bounds Array Int Double
arrivalRates) ([Bool] -> Array Int Bool) -> [Bool] -> Array Int Bool
forall a b. (a -> b) -> a -> b
$ 
                                                       [(Array Int Double
utils Array Int Double -> Int -> Double
forall i e. Ix i => Array i e -> i -> e
Data.Array.! Int
row) Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
1Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
0 |Int
row <- [Int
1..Int
size]]
                                                 where size :: Int
size = (Int, Int) -> Int
forall a b. (a, b) -> b
snd ((Int, Int) -> Int) -> (Int, Int) -> Int
forall a b. (a -> b) -> a -> b
$ Array Int Double -> (Int, Int)
forall i e. Array i e -> (i, i)
bounds Array Int Double
arrivalRates

--	the average time spent waiting in the queue is ρ/(μ – λ)
avgeTimeInQueue:: Array Int Double -> Array Int Double -> Array Int Double
avgeTimeInQueue :: Array Int Double -> Array Int Double -> Array Int Double
avgeTimeInQueue Array Int Double
arrivalRates Array Int Double
meanServiceTimes = let utils :: Array Int Double
utils = Array Int Double -> Array Int Double -> Array Int Double
utilisation Array Int Double
arrivalRates Array Int Double
meanServiceTimes in
                                                       (Int, Int) -> [Double] -> Array Int Double
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Array Int Double -> (Int, Int)
forall i e. Array i e -> (i, i)
bounds Array Int Double
arrivalRates) ([Double] -> Array Int Double) -> [Double] -> Array Int Double
forall a b. (a -> b) -> a -> b
$ 
                                                       [(Array Int Double
utils Array Int Double -> Int -> Double
forall i e. Ix i => Array i e -> i -> e
Data.Array.! Int
row)Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/
                                                        ((Double
1.0Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/(Array Int Double
meanServiceTimes Array Int Double -> Int -> Double
forall i e. Ix i => Array i e -> i -> e
Data.Array.! Int
row))Double -> Double -> Double
forall a. Num a => a -> a -> a
-(Array Int Double
arrivalRates Array Int Double -> Int -> Double
forall i e. Ix i => Array i e -> i -> e
Data.Array.!Int
row))  |Int
row <- [Int
1..Int
size]]
                                                    where size :: Int
size = (Int, Int) -> Int
forall a b. (a, b) -> b
snd ((Int, Int) -> Int) -> (Int, Int) -> Int
forall a b. (a -> b) -> a -> b
$ Array Int Double -> (Int, Int)
forall i e. Array i e -> (i, i)
bounds Array Int Double
arrivalRates


------ example from wikipedia page on Jackson networks
wikiExample:: Array Int Double
wikiExample :: Array Int Double
wikiExample = let p :: Array (Int, Int) Double
p     = ((Int, Int), (Int, Int)) -> [Double] -> Array (Int, Int) Double
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray ((Int
1,Int
1),(Int
3,Int
3)) ([Double] -> Array (Int, Int) Double)
-> [Double] -> Array (Int, Int) Double
forall a b. (a -> b) -> a -> b
$ [Double
0  ,Double
0.5,Double
0.5,     -- node 1
                                                     Double
0  ,Double
0  ,Double
0  ,     -- node 2
                                                     Double
0  ,Double
0  ,Double
0   ] in -- node 3
              let alpha :: Double
alpha = Double
5 in                                        -- 5 events per second arrive into the system
              let p0i :: Array Int Double
p0i   = (Int, Int) -> [Double] -> Array Int Double
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
1,Int
3) ([Double] -> Array Int Double) -> [Double] -> Array Int Double
forall a b. (a -> b) -> a -> b
$         [Double
0.5,Double
0.5,Double
0   ] in -- the input events are distributed evenly across nodes 1 and 2
                  Array (Int, Int) Double
-> Array Int Double -> Double -> Array Int Double
arrivalRate Array (Int, Int) Double
p Array Int Double
p0i Double
alpha

--- Taxi Q1 example
{--
type Q1Output = ((UTCTime, UTCTime), [(Journey, Int)])
frequentRoutes :: Stream Trip -> Stream Q1Output                                                          -- node 6  Input rate 1.188*0.1 = 0.1188 
frequentRoutes s = streamFilterAcc (\_ h -> (False,h)) (True,undefined) testSndChange s                   -- node 5  Input rate 1.188 Selectivity (est. 0.1)
                 $ streamMap (\w -> (let lj = last w in (pickupTime lj, dropoffTime lj), topk 10 w))      -- node 4  Input rate 1.188
                 $ streamWindow (slidingTime 1800000)                                                     -- node 3  Input rate 1.2*0.99 = 1.188
                 $ streamFilter (\j -> inRangeQ1 (start j) && inRangeQ1 (end j))                          -- node 2  Input rate 1.2/s Selectivity (est.) 0.95
                 $ streamMap    tripToJourney s                                                           -- node 1  Input rate 1.2/s         

Node, InputFrom, Input Rate, Selectivity, Output Rate
0     -          -           -            1.2
1     0 (1)      1.2         1            1.2
2     1 (1)      1.2         0.95         1.188
3     2 (0.95)   1.188       1            1.188
4     3 (1)      1.188       1            1.188
5     4 (1)      1.188       0.1          0.1188
6     5 (0.1)    0.118       -            - 

This is represented as follows:      
-}
       
taxiQ1Array :: Array (Int,Int) Double
taxiQ1Array :: Array (Int, Int) Double
taxiQ1Array  = ((Int, Int), (Int, Int)) -> [Double] -> Array (Int, Int) Double
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray ((Int
1,Int
1),(Int
7,Int
7)) ([Double] -> Array (Int, Int) Double)
-> [Double] -> Array (Int, Int) Double
forall a b. (a -> b) -> a -> b
$
              -- Output Node
              --  0   ,1    2    3    4    5     6
               [  Double
0   ,Double
1   ,Double
0   ,Double
0   ,Double
0   ,Double
0    ,Double
0  ,     -- node 1 Source
                  Double
0   ,Double
0   ,Double
1   ,Double
0   ,Double
0   ,Double
0    ,Double
0  ,     -- node 2 streamMap
                  Double
0   ,Double
0   ,Double
0   ,Double
0.95,Double
0   ,Double
0    ,Double
0  ,     -- node 3 streamFilter
                  Double
0   ,Double
0   ,Double
0   ,Double
0   ,Double
1   ,Double
0    ,Double
0  ,     -- node 4 streamWindow
                  Double
0   ,Double
0   ,Double
0   ,Double
0   ,Double
0   ,Double
1    ,Double
0  ,     -- node 5 streamMap
                  Double
0   ,Double
0   ,Double
0   ,Double
0   ,Double
0   ,Double
0    ,Double
0.1,     -- node 6 streamFilterAcc
                  Double
0   ,Double
0   ,Double
0   ,Double
0   ,Double
0   ,Double
0    ,Double
0  ]     -- node 7 the output of Q1

 
taxiQ1Inputs :: Array Int Double
taxiQ1Inputs = (Int, Int) -> [Double] -> Array Int Double
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
1,Int
7) ([Double] -> Array Int Double) -> [Double] -> Array Int Double
forall a b. (a -> b) -> a -> b
$ [Double
1,Double
0,Double
0,Double
0,Double
0,Double
0,Double
0] -- all events in the input stream are sent to node 1

taxiQ1meanServiceTimes:: Array Int Double
taxiQ1meanServiceTimes :: Array Int Double
taxiQ1meanServiceTimes = (Int, Int) -> [Double] -> Array Int Double
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
1,Int
7) [Double
0,Double
0.0001,Double
0.0001,Double
0.0001,Double
0.01,Double
0.0001,Double
0.0001]
 
taxiQ1arrivalRates:: Array Int Double
taxiQ1arrivalRates :: Array Int Double
taxiQ1arrivalRates = Array (Int, Int) Double
-> Array Int Double -> Double -> Array Int Double
arrivalRate Array (Int, Int) Double
taxiQ1Array Array Int Double
taxiQ1Inputs Double
1.2 -- the 1.2 is the arrival rate (in events per second) into the system

test_taxiQ1arrivalRates :: IO ()
test_taxiQ1arrivalRates = Array Int Double -> Array Int Double -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
assertEqual Array Int Double
taxiQ1arrivalRates (Array Int Double -> IO ()) -> Array Int Double -> IO ()
forall a b. (a -> b) -> a -> b
$
    (Int, Int) -> [(Int, Double)] -> Array Int Double
forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
array (Int
1,Int
7) [(Int
1,Double
1.2),(Int
2,Double
1.2),(Int
3,Double
1.2),(Int
4,Double
1.14),(Int
5,Double
1.14),(Int
6,Double
1.14),(Int
7,Double
0.11399999999999999)]

taxiQ1utilisation :: Array Int Double
taxiQ1utilisation = Array Int Double -> Array Int Double -> Array Int Double
utilisation Array Int Double
taxiQ1arrivalRates Array Int Double
taxiQ1meanServiceTimes 

taxiQ1avgeNumberCustomersInSystem :: Array Int Double
taxiQ1avgeNumberCustomersInSystem = Array Int Double -> Array Int Double
avgeNumberOfCustomersInSystem Array Int Double
taxiQ1utilisation

taxiQ1avgeResponseTime :: Array Int Double
taxiQ1avgeResponseTime = Array Int Double -> Array Int Double -> Array Int Double
avgeResponseTime Array Int Double
taxiQ1arrivalRates Array Int Double
taxiQ1meanServiceTimes

taxiQ1avgeTimeInQueue :: Array Int Double
taxiQ1avgeTimeInQueue = Array Int Double -> Array Int Double -> Array Int Double
avgeTimeInQueue   Array Int Double
taxiQ1arrivalRates Array Int Double
taxiQ1meanServiceTimes

data OperatorInfo = OperatorInfo { OperatorInfo -> Int
opId        :: Int
                                 , OperatorInfo -> Double
arrRate     :: Double
                                 , OperatorInfo -> Double
serviceTime :: Double -- XXX rename, clashes with StreamGraph
                                 , OperatorInfo -> Double
util        :: Double
                                 , OperatorInfo -> Bool
stab        :: Bool
                                 , OperatorInfo -> Double
custInSys   :: Double
                                 , OperatorInfo -> Double
respTime    :: Double
                                 , OperatorInfo -> Double
queueTime   :: Double
                                 }
                                 deriving (Int -> OperatorInfo -> ShowS
[OperatorInfo] -> ShowS
OperatorInfo -> String
(Int -> OperatorInfo -> ShowS)
-> (OperatorInfo -> String)
-> ([OperatorInfo] -> ShowS)
-> Show OperatorInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OperatorInfo] -> ShowS
$cshowList :: [OperatorInfo] -> ShowS
show :: OperatorInfo -> String
$cshow :: OperatorInfo -> String
showsPrec :: Int -> OperatorInfo -> ShowS
$cshowsPrec :: Int -> OperatorInfo -> ShowS
Show,OperatorInfo -> OperatorInfo -> Bool
(OperatorInfo -> OperatorInfo -> Bool)
-> (OperatorInfo -> OperatorInfo -> Bool) -> Eq OperatorInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OperatorInfo -> OperatorInfo -> Bool
$c/= :: OperatorInfo -> OperatorInfo -> Bool
== :: OperatorInfo -> OperatorInfo -> Bool
$c== :: OperatorInfo -> OperatorInfo -> Bool
Eq)
                                 
calcAll:: Array (Int,Int) Double -> Array Int Double -> Array Int Double -> [OperatorInfo]
calcAll :: Array (Int, Int) Double
-> Array Int Double -> Array Int Double -> [OperatorInfo]
calcAll Array (Int, Int) Double
connections Array Int Double
arrivalRates Array Int Double
meanServiceTimes = let
    utilisations :: Array Int Double
utilisations             = Array Int Double -> Array Int Double -> Array Int Double
utilisation Array Int Double
arrivalRates Array Int Double
meanServiceTimes
    stability :: Array Int Bool
stability                = Array Int Double -> Array Int Double -> Array Int Bool
stable Array Int Double
arrivalRates Array Int Double
meanServiceTimes
    avgeNumberOfCustInSystem :: Array Int Double
avgeNumberOfCustInSystem = Array Int Double -> Array Int Double
avgeNumberOfCustomersInSystem Array Int Double
utilisations
    avgeResponseTimes :: Array Int Double
avgeResponseTimes        = Array Int Double -> Array Int Double -> Array Int Double
avgeResponseTime Array Int Double
arrivalRates Array Int Double
meanServiceTimes
    avgeTimesInQueue :: Array Int Double
avgeTimesInQueue         = Array Int Double -> Array Int Double -> Array Int Double
avgeTimeInQueue  Array Int Double
arrivalRates Array Int Double
meanServiceTimes

    in (Int -> OperatorInfo) -> [Int] -> [OperatorInfo]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
id -> Int
-> Double
-> Double
-> Double
-> Bool
-> Double
-> Double
-> Double
-> OperatorInfo
OperatorInfo Int
id (Array Int Double
arrivalRates             Array Int Double -> Int -> Double
forall i e. Ix i => Array i e -> i -> e
! Int
id)
                                   (Array Int Double
meanServiceTimes         Array Int Double -> Int -> Double
forall i e. Ix i => Array i e -> i -> e
! Int
id)
                                   (Array Int Double
utilisations             Array Int Double -> Int -> Double
forall i e. Ix i => Array i e -> i -> e
! Int
id)
                                   (Array Int Bool
stability                Array Int Bool -> Int -> Bool
forall i e. Ix i => Array i e -> i -> e
! Int
id)
                                   (Array Int Double
avgeNumberOfCustInSystem Array Int Double -> Int -> Double
forall i e. Ix i => Array i e -> i -> e
! Int
id)
                                   (Array Int Double
avgeResponseTimes        Array Int Double -> Int -> Double
forall i e. Ix i => Array i e -> i -> e
! Int
id)
                                   (Array Int Double
avgeTimesInQueue         Array Int Double -> Int -> Double
forall i e. Ix i => Array i e -> i -> e
! Int
id))
           [Int
1.. ((Int, Int) -> Int
forall a b. (a, b) -> b
snd ((Int, Int) -> Int) -> (Int, Int) -> Int
forall a b. (a -> b) -> a -> b
$ Array Int Double -> (Int, Int)
forall i e. Array i e -> (i, i)
bounds Array Int Double
arrivalRates)]
                              
taxiQ1Calc:: [OperatorInfo]
taxiQ1Calc :: [OperatorInfo]
taxiQ1Calc = Array (Int, Int) Double
-> Array Int Double -> Array Int Double -> [OperatorInfo]
calcAll Array (Int, Int) Double
taxiQ1Array (Array (Int, Int) Double
-> Array Int Double -> Double -> Array Int Double
arrivalRate Array (Int, Int) Double
taxiQ1Array Array Int Double
taxiQ1Inputs Double
1.2) Array Int Double
taxiQ1meanServiceTimes

-- basic tests
ex1 :: Array (Integer, Integer) Double
ex1   = ((Integer, Integer), (Integer, Integer))
-> [Double] -> Array (Integer, Integer) Double
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray ((Integer
1,Integer
1),(Integer
3,Integer
3)) ([Double] -> Array (Integer, Integer) Double)
-> [Double] -> Array (Integer, Integer) Double
forall a b. (a -> b) -> a -> b
$ [Double
1,Double
0,Double
0,-Double
0.5,Double
1,Double
0,-Double
0.5,Double
0,Double
1]                    
test1 :: Integer
test1 = (((Integer, Integer), (Integer, Integer))
-> [Integer] -> Array (Integer, Integer) Integer
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray ((Integer
1,Integer
1), (Integer
3,Integer
3)) ([Integer] -> Array (Integer, Integer) Integer)
-> [Integer] -> Array (Integer, Integer) Integer
forall a b. (a -> b) -> a -> b
$ [Integer
1,Integer
0,Integer
0,Integer
0,Integer
1,Integer
0,Integer
0,Integer
0,Integer
1]) Array (Integer, Integer) Integer -> (Integer, Integer) -> Integer
forall i e. Ix i => Array i e -> i -> e
Data.Array.! (Integer
1,Integer
1)
test2 :: IO ()
test2 = Array (Int, Int) Double -> IO ()
forall a. Show a => a -> IO ()
print (Array (Int, Int) Double -> IO ())
-> Array (Int, Int) Double -> IO ()
forall a b. (a -> b) -> a -> b
$ Array (Int, Int) Double -> Array (Int, Int) Double
inverse (Array (Int, Int) Double -> Array (Int, Int) Double)
-> Array (Int, Int) Double -> Array (Int, Int) Double
forall a b. (a -> b) -> a -> b
$ ((Int, Int), (Int, Int)) -> [Double] -> Array (Int, Int) Double
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray ((Int
1,Int
1), (Int
3,Int
3)) ([Double] -> Array (Int, Int) Double)
-> [Double] -> Array (Int, Int) Double
forall a b. (a -> b) -> a -> b
$ [Double
1,Double
0,Double
0,Double
0,Double
1,Double
0,Double
0,Double
0,Double
1]
test3 :: IO ()
test3 = Array (Int, Int) Double -> IO ()
forall a. Show a => a -> IO ()
print (Array (Int, Int) Double -> IO ())
-> Array (Int, Int) Double -> IO ()
forall a b. (a -> b) -> a -> b
$ Array (Int, Int) Double -> Array (Int, Int) Double
inverse (Array (Int, Int) Double -> Array (Int, Int) Double)
-> Array (Int, Int) Double -> Array (Int, Int) Double
forall a b. (a -> b) -> a -> b
$ ((Int, Int), (Int, Int)) -> [Double] -> Array (Int, Int) Double
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray ((Int
1,Int
1), (Int
3,Int
3)) ([Double] -> Array (Int, Int) Double)
-> [Double] -> Array (Int, Int) Double
forall a b. (a -> b) -> a -> b
$ [Double
1,Double
0,Double
0,-Double
0.5,Double
1,Double
0,-Double
0.5,Double
0,Double
1]
test4 :: IO ()
test4 = Array Int Double -> IO ()
forall a. Show a => a -> IO ()
print (Array Int Double -> IO ()) -> Array Int Double -> IO ()
forall a b. (a -> b) -> a -> b
$ Array (Int, Int) Double -> Array Int Double -> Array Int Double
forall i j a.
(Ix i, Ix j, Num a) =>
Array (i, j) a -> Array j a -> Array i a
mv_mult (Array (Int, Int) Double -> Array (Int, Int) Double
inverse (Array (Int, Int) Double -> Array (Int, Int) Double)
-> Array (Int, Int) Double -> Array (Int, Int) Double
forall a b. (a -> b) -> a -> b
$ ((Int, Int), (Int, Int)) -> [Double] -> Array (Int, Int) Double
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray ((Int
1,Int
1), (Int
3,Int
3)) ([Double] -> Array (Int, Int) Double)
-> [Double] -> Array (Int, Int) Double
forall a b. (a -> b) -> a -> b
$ [Double
1,Double
0,Double
0,-Double
0.5,Double
1,Double
0,-Double
0.5,Double
0,Double
1]) 
                        ((Int, Int) -> [Double] -> Array Int Double
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
1,Int
3) ([Double] -> Array Int Double) -> [Double] -> Array Int Double
forall a b. (a -> b) -> a -> b
$ [Double
2.5,Double
2.5,Double
0])
test5 :: Array (Integer, Integer) Double
test5 = Array (Integer, Integer) Double -> Array (Integer, Integer) Double
forall a b.
(Ix a, Integral a, Num b) =>
Array (a, a) b -> Array (a, a) b
identity Array (Integer, Integer) Double
ex1
test6 :: Array (Integer, Integer) Double
test6 = Array (Integer, Integer) Double
-> Array (Integer, Integer) Double
-> Array (Integer, Integer) Double
forall a b.
(Ix a, Integral a, Num b) =>
Array (a, a) b -> Array (a, a) b -> Array (a, a) b
mm_subtract Array (Integer, Integer) Double
ex1 Array (Integer, Integer) Double
ex1
test7 :: Array (Integer, Integer) Double
test7 = Array (Integer, Integer) Double -> Array (Integer, Integer) Double
forall i j a.
(Ix i, Ix j, Num a) =>
Array (i, j) a -> Array (j, i) a
m_trans Array (Integer, Integer) Double
ex1
test8 :: Array (Integer, Integer) Double
test8 = Array (Integer, Integer) Double
-> Array (Integer, Integer) Double
-> Array (Integer, Integer) Double
forall a b.
(Ix a, Integral a, Num b) =>
Array (a, a) b -> Array (a, a) b -> Array (a, a) b
mm_subtract (Array (Integer, Integer) Double -> Array (Integer, Integer) Double
forall a b.
(Ix a, Integral a, Num b) =>
Array (a, a) b -> Array (a, a) b
identity Array (Integer, Integer) Double
ex1) (Array (Integer, Integer) Double -> Array (Integer, Integer) Double
forall i j a.
(Ix i, Ix j, Num a) =>
Array (i, j) a -> Array (j, i) a
m_trans Array (Integer, Integer) Double
ex1)

------------------------------------------------------------------------------
-- HTF tests (TODO: convert the above)

prop_identity :: Gen Bool
prop_identity = do
    [Double]
n <- Int -> Gen Double -> Gen [Double]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
9 Gen Double
forall a. Arbitrary a => Gen a
arbitrary :: Gen [Double]
    Bool -> Gen Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Gen Bool) -> Bool -> Gen Bool
forall a b. (a -> b) -> a -> b
$ Array (Integer, Integer) Double -> Array (Integer, Integer) Double
forall a b.
(Ix a, Integral a, Num b) =>
Array (a, a) b -> Array (a, a) b
identity (((Integer, Integer), (Integer, Integer))
-> [Double] -> Array (Integer, Integer) Double
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray ((Integer, Integer), (Integer, Integer))
shape [Double]
n)
        Array (Integer, Integer) Double
-> Array (Integer, Integer) Double -> Bool
forall a. Eq a => a -> a -> Bool
== ((Integer, Integer), (Integer, Integer))
-> [Double] -> Array (Integer, Integer) Double
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray ((Integer, Integer), (Integer, Integer))
shape
           ([Double
1, Double
0, Double
0
            ,Double
0, Double
1, Double
0
            ,Double
0, Double
0, Double
1
            ] :: [Double])
    where shape :: ((Integer, Integer), (Integer, Integer))
shape = ((Integer
1,Integer
1),(Integer
3,Integer
3))

main :: IO ()
main = TestSuite -> IO ()
forall t. TestableHTF t => t -> IO ()
htfMain htf_thisModulesTests

------------------------------------------------------------------------------
-- derive* functions to convert the Jackson parameters embedded in the
-- StreamGraph into a form that Jackson code accepts. These should be
-- temporary, and merged/refactored as part of the Jackson code at a
-- later date.
--
-- | Calculate the P propagation array for a StreamGraph based on its
-- filter selectivities.
derivePropagationArray :: StreamGraph -> Array (Int, Int) Double
derivePropagationArray :: StreamGraph -> Array (Int, Int) Double
derivePropagationArray StreamGraph
g = let
    vl :: [(Int, StreamVertex)]
vl = (StreamVertex -> (Int, StreamVertex))
-> [StreamVertex] -> [(Int, StreamVertex)]
forall a b. (a -> b) -> [a] -> [b]
map (\StreamVertex
v -> (StreamVertex -> Int
vertexId StreamVertex
v, StreamVertex
v)) (StreamGraph -> [StreamVertex]
forall a. Ord a => Graph a -> [a]
vertexList StreamGraph
g)
    el :: [(Int, Int)]
el = ((StreamVertex, StreamVertex) -> (Int, Int))
-> [(StreamVertex, StreamVertex)] -> [(Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (\(StreamVertex
x,StreamVertex
y) -> (StreamVertex -> Int
vertexId StreamVertex
x, StreamVertex -> Int
vertexId StreamVertex
y)) (StreamGraph -> [(StreamVertex, StreamVertex)]
forall a. Ord a => Graph a -> [(a, a)]
edgeList StreamGraph
g)
    m :: Int
m  = (Int, StreamVertex) -> Int
forall a b. (a, b) -> a
fst ([(Int, StreamVertex)] -> (Int, StreamVertex)
forall a. [a] -> a
head [(Int, StreamVertex)]
vl)
    n :: Int
n  = (Int, StreamVertex) -> Int
forall a b. (a, b) -> a
fst ([(Int, StreamVertex)] -> (Int, StreamVertex)
forall a. [a] -> a
last [(Int, StreamVertex)]
vl)
    prop :: Int -> Int -> Double
prop Int
x Int
y = if (Int
x, Int
y) (Int, Int) -> [(Int, Int)] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [(Int, Int)]
el
               then let v :: StreamVertex
v = Maybe StreamVertex -> StreamVertex
forall a. HasCallStack => Maybe a -> a
fromJust (Int -> [(Int, StreamVertex)] -> Maybe StreamVertex
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Int
x [(Int, StreamVertex)]
vl)
                    in case StreamVertex -> StreamOperator
operator StreamVertex
v of
                       (Filter Double
x)    -> Double
x
                       (FilterAcc Double
x) -> Double
x
                       StreamOperator
_             -> Double
1
               else Double
0

    in Int -> Array (Int, Int) Double -> Array (Int, Int) Double
forall {b} {e}.
(Ix b, Num b) =>
b -> Array (b, b) e -> Array (b, b) e
bumpIndex2 (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
m) (Array (Int, Int) Double -> Array (Int, Int) Double)
-> Array (Int, Int) Double -> Array (Int, Int) Double
forall a b. (a -> b) -> a -> b
$ ((Int, Int), (Int, Int)) -> [Double] -> Array (Int, Int) Double
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray ((Int
m,Int
m),(Int
n,Int
n)) ([Double] -> Array (Int, Int) Double)
-> [Double] -> Array (Int, Int) Double
forall a b. (a -> b) -> a -> b
$ [ Int -> Int -> Double
prop Int
x Int
y | Int
x <- [Int
m..Int
n], Int
y <- [Int
m..Int
n]]

-- | calculate an array of external input arrival probabilities
deriveInputsArray :: StreamGraph -> Double -> Array Int Double
deriveInputsArray :: StreamGraph -> Double -> Array Int Double
deriveInputsArray StreamGraph
sg Double
totalArrivalRate = let
    vl :: [(Int, StreamVertex)]
vl = (StreamVertex -> (Int, StreamVertex))
-> [StreamVertex] -> [(Int, StreamVertex)]
forall a b. (a -> b) -> [a] -> [b]
map (\StreamVertex
v -> (StreamVertex -> Int
vertexId StreamVertex
v, StreamVertex
v)) (StreamGraph -> [StreamVertex]
forall a. Ord a => Graph a -> [a]
vertexList StreamGraph
sg)
    m :: Int
m  = (Int, StreamVertex) -> Int
forall a b. (a, b) -> a
fst ([(Int, StreamVertex)] -> (Int, StreamVertex)
forall a. [a] -> a
head [(Int, StreamVertex)]
vl)
    n :: Int
n  = (Int, StreamVertex) -> Int
forall a b. (a, b) -> a
fst ([(Int, StreamVertex)] -> (Int, StreamVertex)
forall a. [a] -> a
last [(Int, StreamVertex)]
vl)

    srcProp :: Int -> Double
srcProp Int
x = case Int -> [(Int, StreamVertex)] -> Maybe StreamVertex
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Int
x [(Int, StreamVertex)]
vl of
        Maybe StreamVertex
Nothing -> Double
0
        Just StreamVertex
v  -> case StreamVertex -> StreamOperator
operator StreamVertex
v of
                Source Double
x -> Double
x Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
totalArrivalRate
                StreamOperator
_        -> Double
0

    in Int -> Array Int Double -> Array Int Double
forall {j} {e}. (Ix j, Num j) => j -> Array j e -> Array j e
bumpIndex (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
m) (Array Int Double -> Array Int Double)
-> Array Int Double -> Array Int Double
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> [Double] -> Array Int Double
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
m,Int
n) ([Double] -> Array Int Double) -> [Double] -> Array Int Double
forall a b. (a -> b) -> a -> b
$ (Int -> Double) -> [Int] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Double
srcProp [Int
m..Int
n]


-- | derive an Array of service times from a StreamGraph
deriveServiceTimes :: StreamGraph -> Array Int Double
deriveServiceTimes :: StreamGraph -> Array Int Double
deriveServiceTimes StreamGraph
sg = let
    vl :: [(Int, StreamVertex)]
vl = (StreamVertex -> (Int, StreamVertex))
-> [StreamVertex] -> [(Int, StreamVertex)]
forall a b. (a -> b) -> [a] -> [b]
map (\StreamVertex
v -> (StreamVertex -> Int
vertexId StreamVertex
v, StreamVertex
v)) (StreamGraph -> [StreamVertex]
forall a. Ord a => Graph a -> [a]
vertexList StreamGraph
sg)
    m :: Int
m  = (Int, StreamVertex) -> Int
forall a b. (a, b) -> a
fst ([(Int, StreamVertex)] -> (Int, StreamVertex)
forall a. [a] -> a
head [(Int, StreamVertex)]
vl)
    n :: Int
n  = (Int, StreamVertex) -> Int
forall a b. (a, b) -> a
fst ([(Int, StreamVertex)] -> (Int, StreamVertex)
forall a. [a] -> a
last [(Int, StreamVertex)]
vl)
    prop :: Int -> Double
prop Int
x = case Int -> [(Int, StreamVertex)] -> Maybe StreamVertex
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Int
x [(Int, StreamVertex)]
vl of
        Maybe StreamVertex
Nothing -> Double
0
        Just StreamVertex
v  -> (StreamVertex -> Double
Striot.StreamGraph.serviceTime) StreamVertex
v

    in Int -> Array Int Double -> Array Int Double
forall {j} {e}. (Ix j, Num j) => j -> Array j e -> Array j e
bumpIndex (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
m) (Array Int Double -> Array Int Double)
-> Array Int Double -> Array Int Double
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> [Double] -> Array Int Double
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
m,Int
n) ([Double] -> Array Int Double) -> [Double] -> Array Int Double
forall a b. (a -> b) -> a -> b
$ (Int -> Double) -> [Int] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Double
prop [Int
m..Int
n]

totalArrivalRate :: StreamGraph -> Double
totalArrivalRate = [Double] -> Double
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Double] -> Double)
-> (StreamGraph -> [Double]) -> StreamGraph -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StreamOperator -> Double) -> [StreamOperator] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (\(Source Double
x) -> Double
x) ([StreamOperator] -> [Double])
-> (StreamGraph -> [StreamOperator]) -> StreamGraph -> [Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StreamOperator -> Bool) -> [StreamOperator] -> [StreamOperator]
forall a. (a -> Bool) -> [a] -> [a]
filter StreamOperator -> Bool
isSource ([StreamOperator] -> [StreamOperator])
-> (StreamGraph -> [StreamOperator])
-> StreamGraph
-> [StreamOperator]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StreamVertex -> StreamOperator)
-> [StreamVertex] -> [StreamOperator]
forall a b. (a -> b) -> [a] -> [b]
map StreamVertex -> StreamOperator
operator ([StreamVertex] -> [StreamOperator])
-> (StreamGraph -> [StreamVertex])
-> StreamGraph
-> [StreamOperator]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StreamGraph -> [StreamVertex]
forall a. Ord a => Graph a -> [a]
vertexList

calcAllSg :: StreamGraph -> [OperatorInfo]
calcAllSg :: StreamGraph -> [OperatorInfo]
calcAllSg StreamGraph
sg = [OperatorInfo] -> [OperatorInfo]
deBump ([OperatorInfo] -> [OperatorInfo])
-> [OperatorInfo] -> [OperatorInfo]
forall a b. (a -> b) -> a -> b
$ Array (Int, Int) Double
-> Array Int Double -> Array Int Double -> [OperatorInfo]
calcAll Array (Int, Int) Double
propagation Array Int Double
arrivals Array Int Double
services
    where
        propagation :: Array (Int, Int) Double
propagation      = StreamGraph -> Array (Int, Int) Double
derivePropagationArray StreamGraph
sg
        totalArrivals :: Double
totalArrivals    = StreamGraph -> Double
totalArrivalRate StreamGraph
sg
        inputs :: Array Int Double
inputs           = StreamGraph -> Double -> Array Int Double
deriveInputsArray StreamGraph
sg Double
totalArrivals
        services :: Array Int Double
services         = StreamGraph -> Array Int Double
deriveServiceTimes StreamGraph
sg
        arrivals :: Array Int Double
arrivals         = Array (Int, Int) Double
-> Array Int Double -> Double -> Array Int Double
arrivalRate Array (Int, Int) Double
propagation Array Int Double
inputs Double
totalArrivals

        -- re-adjust vertexIds down to the original range if it began <1
        -- and filter out any dummy vertices that were added to fill the range
        vIds :: [Int]
vIds             = (StreamVertex -> Int) -> [StreamVertex] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map StreamVertex -> Int
vertexId (StreamGraph -> [StreamVertex]
forall a. Ord a => Graph a -> [a]
vertexList StreamGraph
sg)
        m :: Int
m                = [Int] -> Int
forall a. [a] -> a
head [Int]
vIds
        adj :: Int
adj              = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
m
        deBump :: [OperatorInfo] -> [OperatorInfo]
deBump           = (OperatorInfo -> Bool) -> [OperatorInfo] -> [OperatorInfo]
forall a. (a -> Bool) -> [a] -> [a]
filter (\OperatorInfo
oi -> OperatorInfo -> Int
opId OperatorInfo
oi Int -> [Int] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int]
vIds) ([OperatorInfo] -> [OperatorInfo])
-> ([OperatorInfo] -> [OperatorInfo])
-> [OperatorInfo]
-> [OperatorInfo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OperatorInfo -> OperatorInfo) -> [OperatorInfo] -> [OperatorInfo]
forall a b. (a -> b) -> [a] -> [b]
map (\OperatorInfo
oi -> OperatorInfo
oi { opId :: Int
opId = OperatorInfo -> Int
opId OperatorInfo
oi Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
adj })

-- | Determine whether the supplied list of OperatorInfo describes a
-- StreamGraph which is over-utilised: at least one node receives events faster
-- than it can process them.
isOverUtilised :: [OperatorInfo] -> Bool
isOverUtilised :: [OperatorInfo] -> Bool
isOverUtilised = (Double -> Bool) -> [Double] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>Double
1) ([Double] -> Bool)
-> ([OperatorInfo] -> [Double]) -> [OperatorInfo] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OperatorInfo -> Double) -> [OperatorInfo] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map OperatorInfo -> Double
util

graph :: StreamGraph
graph = [StreamVertex] -> StreamGraph
forall a. [a] -> Graph a
path
    [ Int
-> StreamOperator
-> [ExpQ]
-> String
-> String
-> Double
-> StreamVertex
StreamVertex Int
0 (Double -> StreamOperator
Source Double
8)     [[| return 0   |]] String
"Int" String
"Int" Double
0
    , Int
-> StreamOperator
-> [ExpQ]
-> String
-> String
-> Double
-> StreamVertex
StreamVertex Int
4 StreamOperator
Merge          []                 String
"Int" String
"Int" (Double
1Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
5)
    , Int
-> StreamOperator
-> [ExpQ]
-> String
-> String
-> Double
-> StreamVertex
StreamVertex Int
1 (Double -> StreamOperator
Filter (Double
1Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2)) [[|(>5)        |]] String
"Int" String
"Int" Double
0
    , Int
-> StreamOperator
-> [ExpQ]
-> String
-> String
-> Double
-> StreamVertex
StreamVertex Int
5 StreamOperator
Sink           [[|mapM_ print |]] String
"Int" String
"Int" Double
0
    ]

test_isOverUtilised :: IO ()
test_isOverUtilised = HasCallStack => Bool -> IO ()
Bool -> IO ()
assertBool (Bool -> IO ()) -> Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ [OperatorInfo] -> Bool
isOverUtilised (StreamGraph -> [OperatorInfo]
calcAllSg StreamGraph
graph)

------------------------------------------------------------------------------
-- what is the output rate of an Operator?
outputRate :: StreamGraph -> Int {- operator id -} -> Double
outputRate :: StreamGraph -> Int -> Double
outputRate StreamGraph
sg Int
i = let
    ois :: [(Int, OperatorInfo)]
ois = (OperatorInfo -> (Int, OperatorInfo))
-> [OperatorInfo] -> [(Int, OperatorInfo)]
forall a b. (a -> b) -> [a] -> [b]
map (\OperatorInfo
oi -> (OperatorInfo -> Int
opId OperatorInfo
oi, OperatorInfo
oi)) ([OperatorInfo] -> [(Int, OperatorInfo)])
-> [OperatorInfo] -> [(Int, OperatorInfo)]
forall a b. (a -> b) -> a -> b
$ StreamGraph -> [OperatorInfo]
calcAllSg StreamGraph
sg
    v :: StreamVertex
v   = ([StreamVertex] -> StreamVertex
forall a. [a] -> a
head ([StreamVertex] -> StreamVertex)
-> (StreamGraph -> [StreamVertex]) -> StreamGraph -> StreamVertex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StreamVertex -> Bool) -> [StreamVertex] -> [StreamVertex]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
i) (Int -> Bool) -> (StreamVertex -> Int) -> StreamVertex -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StreamVertex -> Int
vertexId) ([StreamVertex] -> [StreamVertex])
-> (StreamGraph -> [StreamVertex]) -> StreamGraph -> [StreamVertex]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StreamGraph -> [StreamVertex]
forall a. Ord a => Graph a -> [a]
vertexList) StreamGraph
sg
    arr :: Double
arr = (OperatorInfo -> Double
arrRate (OperatorInfo -> Double)
-> ([(Int, OperatorInfo)] -> OperatorInfo)
-> [(Int, OperatorInfo)]
-> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe OperatorInfo -> OperatorInfo
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe OperatorInfo -> OperatorInfo)
-> ([(Int, OperatorInfo)] -> Maybe OperatorInfo)
-> [(Int, OperatorInfo)]
-> OperatorInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [(Int, OperatorInfo)] -> Maybe OperatorInfo
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Int
i) [(Int, OperatorInfo)]
ois

    in case StreamVertex -> StreamOperator
operator StreamVertex
v of
        (Filter Double
sel)    -> Double
arr Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
sel
        (FilterAcc Double
sel) -> Double
arr Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
sel

        -- the output rate of Join is the slowest input rate
        StreamOperator
Join            -> ( [Double] -> Double
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum
                           ([Double] -> Double)
-> (StreamGraph -> [Double]) -> StreamGraph -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((StreamVertex, StreamVertex) -> Double)
-> [(StreamVertex, StreamVertex)] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (StreamGraph -> Int -> Double
outputRate StreamGraph
sg (Int -> Double)
-> ((StreamVertex, StreamVertex) -> Int)
-> (StreamVertex, StreamVertex)
-> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StreamVertex -> Int
vertexId (StreamVertex -> Int)
-> ((StreamVertex, StreamVertex) -> StreamVertex)
-> (StreamVertex, StreamVertex)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StreamVertex, StreamVertex) -> StreamVertex
forall a b. (a, b) -> a
fst)
                           ([(StreamVertex, StreamVertex)] -> [Double])
-> (StreamGraph -> [(StreamVertex, StreamVertex)])
-> StreamGraph
-> [Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((StreamVertex, StreamVertex) -> Bool)
-> [(StreamVertex, StreamVertex)] -> [(StreamVertex, StreamVertex)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
i) (Int -> Bool)
-> ((StreamVertex, StreamVertex) -> Int)
-> (StreamVertex, StreamVertex)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StreamVertex -> Int
vertexId (StreamVertex -> Int)
-> ((StreamVertex, StreamVertex) -> StreamVertex)
-> (StreamVertex, StreamVertex)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StreamVertex, StreamVertex) -> StreamVertex
forall a b. (a, b) -> b
snd)
                           ([(StreamVertex, StreamVertex)] -> [(StreamVertex, StreamVertex)])
-> (StreamGraph -> [(StreamVertex, StreamVertex)])
-> StreamGraph
-> [(StreamVertex, StreamVertex)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StreamGraph -> [(StreamVertex, StreamVertex)]
forall a. Ord a => Graph a -> [(a, a)]
edgeList
                           ) StreamGraph
sg
    {-
        Window          -> 0
    -}
        StreamOperator
_               -> Double
arr

test_outputRate_src :: IO ()
test_outputRate_src    = Double -> Double -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
assertEqual Double
1.0 (Double -> IO ()) -> Double -> IO ()
forall a b. (a -> b) -> a -> b
$ StreamGraph -> Int -> Double
outputRate StreamGraph
g Int
1
test_outputRate_merge :: IO ()
test_outputRate_merge  = Double -> Double -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
assertEqual Double
2.0 (Double -> IO ()) -> Double -> IO ()
forall a b. (a -> b) -> a -> b
$ StreamGraph -> Int -> Double
outputRate StreamGraph
g Int
3
test_outputRate_join :: IO ()
test_outputRate_join   = Double -> Double -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
assertEqual Double
2.0 (Double -> IO ()) -> Double -> IO ()
forall a b. (a -> b) -> a -> b
$ StreamGraph -> Int -> Double
outputRate StreamGraph
g Int
3

v1 :: StreamGraph
v1 = StreamVertex -> StreamGraph
forall a. a -> Graph a
Vertex (StreamVertex -> StreamGraph) -> StreamVertex -> StreamGraph
forall a b. (a -> b) -> a -> b
$ Int
-> StreamOperator
-> [ExpQ]
-> String
-> String
-> Double
-> StreamVertex
StreamVertex Int
1 (Double -> StreamOperator
Source Double
1)   [] String
"Int" String
"Int" Double
0
v2 :: StreamGraph
v2 = StreamVertex -> StreamGraph
forall a. a -> Graph a
Vertex (StreamVertex -> StreamGraph) -> StreamVertex -> StreamGraph
forall a b. (a -> b) -> a -> b
$ Int
-> StreamOperator
-> [ExpQ]
-> String
-> String
-> Double
-> StreamVertex
StreamVertex Int
2 (Double -> StreamOperator
Source Double
1)   [] String
"Int" String
"Int" Double
0
v3 :: StreamGraph
v3 = StreamVertex -> StreamGraph
forall a. a -> Graph a
Vertex (StreamVertex -> StreamGraph) -> StreamVertex -> StreamGraph
forall a b. (a -> b) -> a -> b
$ Int
-> StreamOperator
-> [ExpQ]
-> String
-> String
-> Double
-> StreamVertex
StreamVertex Int
3 StreamOperator
Merge        [] String
"Int" String
"Int" Double
0
v4 :: StreamGraph
v4 = StreamVertex -> StreamGraph
forall a. a -> Graph a
Vertex (StreamVertex -> StreamGraph) -> StreamVertex -> StreamGraph
forall a b. (a -> b) -> a -> b
$ Int
-> StreamOperator
-> [ExpQ]
-> String
-> String
-> Double
-> StreamVertex
StreamVertex Int
4 (Double -> StreamOperator
Source Double
3)   [] String
"Int" String
"Int" Double
0
v5 :: StreamGraph
v5 = StreamVertex -> StreamGraph
forall a. a -> Graph a
Vertex (StreamVertex -> StreamGraph) -> StreamVertex -> StreamGraph
forall a b. (a -> b) -> a -> b
$ Int
-> StreamOperator
-> [ExpQ]
-> String
-> String
-> Double
-> StreamVertex
StreamVertex Int
5 StreamOperator
Join         [] String
"Int" String
"(Int,Int)" Double
0
v6 :: StreamGraph
v6 = StreamVertex -> StreamGraph
forall a. a -> Graph a
Vertex (StreamVertex -> StreamGraph) -> StreamVertex -> StreamGraph
forall a b. (a -> b) -> a -> b
$ Int
-> StreamOperator
-> [ExpQ]
-> String
-> String
-> Double
-> StreamVertex
StreamVertex Int
6 (Double -> StreamOperator
Filter Double
0.5) [] String
"(Int,Int)" String
"(Int,Int)" Double
0
v7 :: StreamGraph
v7 = StreamVertex -> StreamGraph
forall a. a -> Graph a
Vertex (StreamVertex -> StreamGraph) -> StreamVertex -> StreamGraph
forall a b. (a -> b) -> a -> b
$ Int
-> StreamOperator
-> [ExpQ]
-> String
-> String
-> Double
-> StreamVertex
StreamVertex Int
7 StreamOperator
Sink         [] String
"(Int,Int)" String
"IO ()" Double
0

m :: StreamGraph
m  = (StreamGraph
v1 StreamGraph -> StreamGraph -> StreamGraph
forall a. Graph a -> Graph a -> Graph a
`connect` StreamGraph
v3) StreamGraph -> StreamGraph -> StreamGraph
forall a. Graph a -> Graph a -> Graph a
`overlay` (StreamGraph
v2 StreamGraph -> StreamGraph -> StreamGraph
forall a. Graph a -> Graph a -> Graph a
`connect` StreamGraph
v3)
g :: StreamGraph
g  = StreamGraph
m StreamGraph -> StreamGraph -> StreamGraph
forall a. Graph a -> Graph a -> Graph a
`overlay`
     (StreamGraph
v3 StreamGraph -> StreamGraph -> StreamGraph
forall a. Graph a -> Graph a -> Graph a
`connect` StreamGraph
v5) StreamGraph -> StreamGraph -> StreamGraph
forall a. Graph a -> Graph a -> Graph a
`overlay` (StreamGraph
v4 StreamGraph -> StreamGraph -> StreamGraph
forall a. Graph a -> Graph a -> Graph a
`connect` StreamGraph
v5)
     StreamGraph -> StreamGraph -> StreamGraph
forall a. Graph a -> Graph a -> Graph a
`overlay` (StreamGraph
v5 StreamGraph -> StreamGraph -> StreamGraph
forall a. Graph a -> Graph a -> Graph a
`connect` StreamGraph
v6)
     StreamGraph -> StreamGraph -> StreamGraph
forall a. Graph a -> Graph a -> Graph a
`overlay` (StreamGraph
v6 StreamGraph -> StreamGraph -> StreamGraph
forall a. Graph a -> Graph a -> Graph a
`connect` StreamGraph
v7)

------------------------------------------------------------------------------
-- Matrix.LU.inverse fails with 0-indexed arrays. bumpIndex and bumpIndex2 are
-- used to adjust the indexing of matrices so they begin at 1 in all dimensions.

both :: (t -> b) -> (t, t) -> (b, b)
both t -> b
f (t
x,t
y) = (t -> b
f t
x, t -> b
f t
y)

-- 1D bumpIndex
bumpIndex :: j -> Array j e -> Array j e
bumpIndex  j
n Array j e
a = (j, j) -> (j -> j) -> Array j e -> Array j e
forall i j e.
(Ix i, Ix j) =>
(i, i) -> (i -> j) -> Array j e -> Array i e
ixmap ((j -> j) -> (j, j) -> (j, j)
forall {t} {b}. (t -> b) -> (t, t) -> (b, b)
both (j -> j -> j
forall a. Num a => a -> a -> a
+j
n) (Array j e -> (j, j)
forall i e. Array i e -> (i, i)
bounds Array j e
a)) (\j
i -> j
i j -> j -> j
forall a. Num a => a -> a -> a
- j
n) Array j e
a

-- 2D bumpIndex
bumpIndex2 :: b -> Array (b, b) e -> Array (b, b) e
bumpIndex2 b
n Array (b, b) e
a = ((b, b), (b, b))
-> ((b, b) -> (b, b)) -> Array (b, b) e -> Array (b, b) e
forall i j e.
(Ix i, Ix j) =>
(i, i) -> (i -> j) -> Array j e -> Array i e
ixmap (((b, b) -> (b, b)) -> ((b, b), (b, b)) -> ((b, b), (b, b))
forall {t} {b}. (t -> b) -> (t, t) -> (b, b)
both ((b -> b) -> (b, b) -> (b, b)
forall {t} {b}. (t -> b) -> (t, t) -> (b, b)
both (b -> b -> b
forall a. Num a => a -> a -> a
+b
n)) (Array (b, b) e -> ((b, b), (b, b))
forall i e. Array i e -> (i, i)
bounds Array (b, b) e
a)) ((b -> b) -> (b, b) -> (b, b)
forall {t} {b}. (t -> b) -> (t, t) -> (b, b)
both (\b
i -> b
i b -> b -> b
forall a. Num a => a -> a -> a
- b
n)) Array (b, b) e
a

-- fails if NaN creeps in since NaN ≠ NaN
test_bumpInverse :: IO ()
test_bumpInverse = Array (Int, Int) Double -> Array (Int, Int) Double -> IO ()
forall a. (Eq a, Show a, HasCallStack) => a -> a -> IO ()
assertEqual (Array (Int, Int) Double -> Array (Int, Int) Double
inverse Array (Int, Int) Double
b) (Array (Int, Int) Double -> Array (Int, Int) Double
inverse (Int -> Array (Int, Int) Double -> Array (Int, Int) Double
forall {b} {e}.
(Ix b, Num b) =>
b -> Array (b, b) e -> Array (b, b) e
bumpIndex2 Int
1 Array (Int, Int) Double
a))
    where a :: Array (Int, Int) Double
a = ((Int, Int), (Int, Int)) -> [Double] -> Array (Int, Int) Double
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray ((Int
0,Int
0),(Int
1,Int
1)) [Double
4,Double
7,Double
2,Double
6]
          b :: Array (Int, Int) Double
b = ((Int, Int), (Int, Int)) -> [Double] -> Array (Int, Int) Double
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray ((Int
1,Int
1),(Int
2,Int
2)) [Double
4,Double
7,Double
2,Double
6]