module Numeric.Probability.Example.Barber where

import qualified Numeric.Probability.Distribution as Dist
import Numeric.Probability.Example.Queuing
   (Time, System, unit, evalSystem, idleAvgP, waiting)

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

{- 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
-}


-- * barber shop

custServ :: Dist Time
custServ :: Dist Time
custServ = forall prob a. Floating prob => Spread prob a
Dist.normal [Time
5..Time
10]

nextCust :: Trans Time -- not dependant on serving time
nextCust :: Trans Time
nextCust Time
_ = forall prob a. Floating prob => Spread prob a
Dist.normal [Time
3..Time
6]

barbers :: Int
barbers :: Time
barbers = Time
1

customers :: Int
customers :: Time
customers = Time
20

runs :: Int
runs :: Time
runs = Time
50

barberEvent :: ((), (Dist Time, Time -> Dist Time))
barberEvent :: ((), (Dist Time, Trans Time))
barberEvent =  forall b. b -> ((), b)
unit (Dist Time
custServ, Trans Time
nextCust)

barberEvents :: [((), (Dist Time, Time -> Dist Time))]
barberEvents :: [((), (Dist Time, Trans Time))]
barberEvents = forall a. Time -> a -> [a]
replicate Time
customers ((), (Dist Time, Trans Time))
barberEvent

barberSystem :: (Ord b) => (System () -> b) -> RDist b
barberSystem :: forall b. Ord b => (System () -> b) -> RDist b
barberSystem System () -> b
eval = forall a b.
(Ord a, Ord b) =>
Time -> Time -> REvents a -> (System a -> b) -> RDist b
evalSystem Time
runs Time
barbers [((), (Dist Time, Trans Time))]
barberEvents System () -> b
eval


-- * category

data Category = ThreeOrLess | FourToTen | MoreThanTen
	deriving (Category -> Category -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Category -> Category -> Bool
$c/= :: Category -> Category -> Bool
== :: Category -> Category -> Bool
$c== :: Category -> Category -> Bool
Eq,Eq Category
Category -> Category -> Bool
Category -> Category -> Ordering
Category -> Category -> Category
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Category -> Category -> Category
$cmin :: Category -> Category -> Category
max :: Category -> Category -> Category
$cmax :: Category -> Category -> Category
>= :: Category -> Category -> Bool
$c>= :: Category -> Category -> Bool
> :: Category -> Category -> Bool
$c> :: Category -> Category -> Bool
<= :: Category -> Category -> Bool
$c<= :: Category -> Category -> Bool
< :: Category -> Category -> Bool
$c< :: Category -> Category -> Bool
compare :: Category -> Category -> Ordering
$ccompare :: Category -> Category -> Ordering
Ord,Time -> Category -> ShowS
[Category] -> ShowS
Category -> String
forall a.
(Time -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Category] -> ShowS
$cshowList :: [Category] -> ShowS
show :: Category -> String
$cshow :: Category -> String
showsPrec :: Time -> Category -> ShowS
$cshowsPrec :: Time -> Category -> ShowS
Show)

cat :: Time -> Category
cat :: Time -> Category
cat Time
n | Time
n forall a. Ord a => a -> a -> Bool
<= Time
3 = Category
ThreeOrLess
cat Time
n | Time
n forall a. Ord a => a -> a -> Bool
<= Time
10 = Category
FourToTen
cat Time
_ = Category
MoreThanTen

perc :: Float -> String
perc :: Float -> String
perc Float
n | Float
n forall a. Ord a => a -> a -> Bool
<= Float
0.25 = String
"0% to 25%"
perc Float
n | Float
n forall a. Ord a => a -> a -> Bool
<= Float
0.5 = String
"25% to 50%"
perc Float
n | Float
n forall a. Ord a => a -> a -> Bool
<= Float
0.75 = String
"50% to 75%"
perc Float
_ = String
"75% to 100%"

-- * evaluation

-- | avg barber idle time
barberIdle :: RDist String
barberIdle :: RDist String
barberIdle = forall b. Ord b => (System () -> b) -> RDist b
barberSystem (Float -> String
perc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Time -> System a -> Float
idleAvgP Time
barbers)

-- | avg customer waiting time (unserved customers)
customerWait :: RDist Category
customerWait :: RDist Category
customerWait = forall b. Ord b => (System () -> b) -> RDist b
barberSystem (Time -> Category
cat forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Integral a => a -> a -> a
`div` Time
customers) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Time -> System a -> Time
waiting Time
barbers)