{- |

Model:

  one server serving customers from one queue

-}

module Numeric.Probability.Example.Queuing where

import qualified Numeric.Probability.Distribution as Dist
import qualified Numeric.Probability.Random as Rnd

import Numeric.Probability.Percentage
    (Dist, RDist, Trans, )

import Data.List (nub,sort)


{- no Random instance for Rational
type Probability = Rational
type Dist a  = Dist.T  Probability a
type RDist a = Rnd.Distribution Probability a
type Trans a = Transition    Probability a
-}


type Time = Int

-- | (servingTime, nextArrival)
type Profile = (Time, Time)

type Event a = (a,Profile)

-- | customers and their individual serving times
type Queue a = [(a,Time)]

-- | (customers waiting,validity period of that queue)
type State a = (Queue a,Time)

type System a = [([a],Time)]

type Events a = [Event a]


event :: Time -> Events a -> Queue a -> [State a]
event :: forall a. Time -> Events a -> Queue a -> [State a]
event = forall a. Time -> Time -> Events a -> Queue a -> [State a]
mEvent Time
1

--event _ [] []                    = []
--event 0 ((c,(s,a)):es) q         =        event a     es (q++[(c,s)])
--event a es []                    = ([],a):event 0     es []
--event a [] (q@((c,s):q'))        =  (q,s):event a     [] q'
--event a es (q@((c,s):q')) | a<s  =  (q,a):event 0     es ((c,s-a):q')
--                          | True =  (q,s):event (a-s) es q'

system :: Events a -> System a
--system es = map (\(q,t)->(map fst q,t)) $ event 0 es []
system :: forall a. Events a -> System a
system = forall a. Time -> Events a -> System a
mSystem Time
1


-- | multiple servers

mEvent :: Int -> Time -> Events a -> Queue a -> [State a]
mEvent :: forall a. Time -> Time -> Events a -> Queue a -> [State a]
mEvent Time
_ Time
_ [] []             =        []
mEvent Time
n Time
0 ((a
c,(Time
s,Time
a)):[Event a]
es) [(a, Time)]
q  = 	      forall a. Time -> Time -> Events a -> Queue a -> [State a]
mEvent Time
n Time
a     [Event a]
es ([(a, Time)]
qforall a. [a] -> [a] -> [a]
++[(a
c,Time
s)])
mEvent Time
n Time
a [Event a]
es []             = ([],Time
a)forall a. a -> [a] -> [a]
:forall a. Time -> Time -> Events a -> Queue a -> [State a]
mEvent Time
n Time
0     [Event a]
es []
mEvent Time
n Time
_ [] [(a, Time)]
q		     =  ([(a, Time)]
q,Time
s)forall a. a -> [a] -> [a]
:forall a. Time -> Time -> Events a -> Queue a -> [State a]
mEvent Time
n Time
0     [] (forall a. Time -> Time -> Queue a -> Queue a
mServe Time
n Time
s [(a, Time)]
q)
	where s :: Time
s = forall a. Time -> Queue a -> Time
mTimeStep Time
n [(a, Time)]
q
mEvent Time
n Time
a [Event a]
es [(a, Time)]
q =
   if Time
a forall a. Ord a => a -> a -> Bool
< Time
s
     then ([(a, Time)]
q,Time
a) forall a. a -> [a] -> [a]
: forall a. Time -> Time -> Events a -> Queue a -> [State a]
mEvent Time
n Time
0     [Event a]
es (forall a. Time -> Time -> Queue a -> Queue a
mServe Time
n Time
a [(a, Time)]
q)
     else ([(a, Time)]
q,Time
s) forall a. a -> [a] -> [a]
: forall a. Time -> Time -> Events a -> Queue a -> [State a]
mEvent Time
n (Time
aforall a. Num a => a -> a -> a
-Time
s) [Event a]
es (forall a. Time -> Time -> Queue a -> Queue a
mServe Time
n Time
s [(a, Time)]
q)
	where s :: Time
s = forall a. Time -> Queue a -> Time
mTimeStep Time
n [(a, Time)]
q


-- | decrease served customers remaining time by specified amount
mServe :: Int -> Int -> Queue a -> Queue a
mServe :: forall a. Time -> Time -> Queue a -> Queue a
mServe Time
_ Time
_ [] = []
mServe Time
0 Time
_ [(a, Time)]
x = [(a, Time)]
x
mServe Time
n Time
c ((a
a,Time
t):[(a, Time)]
es) =
   if Time
t forall a. Ord a => a -> a -> Bool
> Time
c
     then (a
a,Time
tforall a. Num a => a -> a -> a
-Time
c) forall a. a -> [a] -> [a]
: forall a. Time -> Time -> Queue a -> Queue a
mServe (Time
nforall a. Num a => a -> a -> a
-Time
1) Time
c [(a, Time)]
es
     else forall a. Time -> Time -> Queue a -> Queue a
mServe (Time
nforall a. Num a => a -> a -> a
-Time
1) Time
c [(a, Time)]
es

-- | time until next completion
mTimeStep :: Int -> Queue a -> Int
mTimeStep :: forall a. Time -> Queue a -> Time
mTimeStep Time
_ ((a
_,Time
t):[]) = Time
t
mTimeStep Time
1 ((a
_,Time
t):[(a, Time)]
_)  = Time
t
mTimeStep Time
n ((a
_,Time
t):[(a, Time)]
es) = forall a. Ord a => a -> a -> a
min Time
t (forall a. Time -> Queue a -> Time
mTimeStep (Time
nforall a. Num a => a -> a -> a
-Time
1) [(a, Time)]
es)
mTimeStep Time
_ [(a, Time)]
_ = forall a. HasCallStack => [Char] -> a
error [Char]
"Queuing.mTimeStep: queue must be non-empty"

mSystem :: Int -> Events a -> System a
mSystem :: forall a. Time -> Events a -> System a
mSystem Time
n Events a
es = forall a b. (a -> b) -> [a] -> [b]
map (\([(a, Time)]
q,Time
t)->(forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(a, Time)]
q,Time
t)) forall a b. (a -> b) -> a -> b
$ forall a. Time -> Time -> Events a -> Queue a -> [State a]
mEvent Time
n Time
0 Events a
es []


-- * random

type RProfile = (Dist Time, Trans Time)

type REvent a = (a, RProfile)

type REvents a = [REvent a]

rSystem :: Int -> REvents a -> Rnd.T (System a)
rSystem :: forall a. Time -> REvents a -> T (System a)
rSystem Time
n REvents a
re = do
		Events a
e <- forall a. REvents a -> T (Events a)
rBuildEvents REvents a
re
		forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Time -> Events a -> System a
mSystem Time
n Events a
e)

rBuildEvents :: REvents a -> Rnd.T (Events a)
rBuildEvents :: forall a. REvents a -> T (Events a)
rBuildEvents ((a
a,(Dist Time
dt,Trans Time
tt)):[REvent a]
ex) = do
			Events a
rest <- forall a. REvents a -> T (Events a)
rBuildEvents [REvent a]
ex
			Time
t <- forall prob a. (Num prob, Ord prob, Random prob) => T prob a -> T a
Rnd.pick Dist Time
dt
			Time
nt <- forall prob a. (Num prob, Ord prob, Random prob) => T prob a -> T a
Rnd.pick forall a b. (a -> b) -> a -> b
$ Trans Time
tt Time
t
			forall (m :: * -> *) a. Monad m => a -> m a
return ((a
a,(Time
t,Time
nt))forall a. a -> [a] -> [a]
:Events a
rest)
rBuildEvents [] = forall (m :: * -> *) a. Monad m => a -> m a
return []

rmSystem :: Ord a => Int -> Int -> REvents a -> RDist (System a)
rmSystem :: forall a. Ord a => Time -> Time -> REvents a -> RDist (System a)
rmSystem Time
c Time
n REvents a
re = forall prob a.
(Fractional prob, Ord a) =>
[T a] -> Distribution prob a
Rnd.dist forall a b. (a -> b) -> a -> b
$ forall a. Time -> a -> [a]
replicate Time
c (forall a. Time -> REvents a -> T (System a)
rSystem Time
n REvents a
re)

evalSystem :: (Ord a, Ord b) =>
   Int -> Int -> REvents a -> (System a -> b) -> RDist b
evalSystem :: forall a b.
(Ord a, Ord b) =>
Time -> Time -> REvents a -> (System a -> b) -> RDist b
evalSystem Time
c Time
n REvents a
re System a -> b
ef =
   do
      Dist (System a)
rds <- forall a. Ord a => Time -> Time -> REvents a -> RDist (System a)
rmSystem Time
c Time
n REvents a
re
      forall (m :: * -> *) a. Monad m => a -> m a
return (forall prob b a.
(Num prob, Ord b) =>
(a -> b) -> T prob a -> T prob b
Dist.map System a -> b
ef Dist (System a)
rds)

unit :: b -> ((), b)
unit :: forall b. b -> ((), b)
unit = (\b
p->((),b
p)) -- Dist.map (\p->((),p))


-- * evaluation

maxQueue :: Ord a => System a -> Int
maxQueue :: forall a. Ord a => System a -> Time
maxQueue System a
s = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [forall (t :: * -> *) a. Foldable t => t a -> Time
length [a]
q | ([a]
q,Time
_) <- System a
s]

allWaiting :: Ord a => Int -> System a -> [a]
allWaiting :: forall a. Ord a => Time -> System a -> [a]
allWaiting Time
n System a
s = forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> [a]
sort forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ forall a. Time -> [a] -> [a]
drop Time
n [a]
q | ([a]
q,Time
_) <- System a
s]


countWaiting :: Ord a => Int -> System a -> Int
countWaiting :: forall a. Ord a => Time -> System a -> Time
countWaiting Time
n = forall (t :: * -> *) a. Foldable t => t a -> Time
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => Time -> System a -> [a]
allWaiting Time
n

waiting :: Int -> System a -> Time
waiting :: forall a. Time -> System a -> Time
waiting Time
n System a
s = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [ Time
tforall a. Num a => a -> a -> a
*forall (t :: * -> *) a. Foldable t => t a -> Time
length (forall a. Time -> [a] -> [a]
drop Time
n [a]
q) | ([a]
q,Time
t) <- System a
s]

inSystem :: System a -> Time
inSystem :: forall a. System a -> Time
inSystem System a
s = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [ Time
tforall a. Num a => a -> a -> a
*forall (t :: * -> *) a. Foldable t => t a -> Time
length [a]
q | ([a]
q,Time
t) <- System a
s]

total :: System a -> Time
total :: forall a. System a -> Time
total = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd

server :: Int -> System a -> Time
server :: forall a. Time -> System a -> Time
server Time
n System a
s = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [ Time
tforall a. Num a => a -> a -> a
*forall (t :: * -> *) a. Foldable t => t a -> Time
length (forall a. Time -> [a] -> [a]
take Time
n [a]
q) | ([a]
q,Time
t) <- System a
s]

idle :: Int -> System a -> Time
idle :: forall a. Time -> System a -> Time
idle Time
n System a
s = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [ Time
tforall a. Num a => a -> a -> a
*(Time
n forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Time
length [a]
q) | ([a]
q,Time
t) <- System a
s, forall (t :: * -> *) a. Foldable t => t a -> Time
length [a]
q forall a. Ord a => a -> a -> Bool
<= Time
n]

idleAvgP :: Int -> System a -> Float
idleAvgP :: forall a. Time -> System a -> Float
idleAvgP Time
n System a
s = (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Time -> System a -> Time
idle Time
n System a
s) forall a. Fractional a => a -> a -> a
/ (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Time -> System a -> Time
server Time
n System a
s)