holmusk-challenge/lib/Holmusk.hs

module Holmusk where

import           Data.Maybe
import           System.Random


data Customer = Yellow
              | Red
              | Blue
              deriving (Show, Eq)


e :: Double
e = exp 1




    --------------------
    --[ Given models ]--
    --------------------


defAlpha :: Double
defAlpha = 200


-- | Probability that a customer arrives at any given time `t`.
-- Converges to `1` over time.
customerArrival :: Double        -- ^ t
                -> Maybe Double  -- ^ 𝛼 (default: 200)
                -> Double        -- ^ F(t) = 1 - e^ -(t / 𝛼)
customerArrival t 𝛼 = 1.0 - (e ** (negate (t / (fromMaybe defAlpha 𝛼))))


defP :: Double
defP = 200

-- | Models the time for a customer to be processed by the teller.
customerProcTime :: Double        -- ^ x
                 -> Maybe Double  -- ^ p (default: 200)
                 -> Double        -- ^ 𝛼
                 -> Double        -- ^ β
                 -> Double        -- ^ F(x) = p * x^(𝛼 - 1) * (1 - x)^(β - 1)
customerProcTime x p 𝛼 β =
  (fromMaybe defP p) * (x ** (𝛼 - 1)) * ((1 - x) ** (β - 1))




    --------------------------------------
    --[ Average/max customer proc time ]--
    --------------------------------------


-- | Get the distribution of customer processing time for x in 0.0001 to 1.0000.
customerProcTimeDist :: Customer -> [Double]
customerProcTimeDist = \case
  Yellow -> fmap yellowCustomerProcTime xDist
  Red    -> fmap redCustomerProcTime xDist
  Blue   -> fmap blueCustomerProcTime xDist
 where
  yellowCustomerProcTime :: Double -> Double
  yellowCustomerProcTime x = customerProcTime x Nothing 2.0 5

  redCustomerProcTime :: Double -> Double
  redCustomerProcTime x = customerProcTime x Nothing 2.0 2.0

  blueCustomerProcTime :: Double -> Double
  blueCustomerProcTime x = customerProcTime x Nothing 5.0 1.0

  xDist :: [Double]
  xDist = takeWhile (\x -> x <= 1.0) . iterate (\x -> (x + precision)) $ 0
    where precision = 0.0001


-- | Average customer processing time.
avgCustomerProcTime :: Customer -> Double
avgCustomerProcTime customer =
  let f = customerProcTimeDist customer
  in if | length f == 0 -> 0
        | otherwise -> sum f / (fromIntegral $ length f)


-- | Maximum customer processing time.
maxCustomerProcTime :: Customer -> Double
maxCustomerProcTime customer =
  let f = customerProcTimeDist customer in maximum f



    --------------------
    --[ Queue length ]--
    --------------------


-- | This correlates to `customerArrival`. Given a minimum probability x,
-- returns the time when the next customer "appears".
timeToNextCustomer :: Double -> Maybe Double -> Double
timeToNextCustomer prob 𝛼 = negate (log (1 - prob) * fromMaybe defAlpha 𝛼)


-- | The first model of a queue length. The queue length is the number
-- of people who enter the bank while the current customer is being served.
--
-- The key is the second argument `prob`. It describes the probability
-- a person appears at the bank.
queueLength :: Double -- ^ processing time of the current customer
            -> Double -- ^ probability threshold when a new customer "appears"
            -> Int
queueLength t' prob = go t' 0
 where
  go t c | t >= 0    = go (t - timeToNextCustomer prob Nothing) (c + 1)
         | otherwise = c


-- | Model based on random numbers every x seconds to determine
-- whether a person appeared.
queueLengthR :: RandomGen g
             => Double  -- ^ processing time of the current customer
             -> Double  -- ^ Interval
             -> g
             -> Int
queueLengthR t' int genS = go t' 0 0 (customerArrival 0 Nothing) genS
 where
  go :: RandomGen g
     => Double -- ^ time left til processing done
     -> Double -- ^ time since last customer
     -> Int    -- ^ number of customers
     -> Double -- ^ current probability of a customer appearing
     -> g
     -> Int
  go tP tC c prob gen =
    let (r, gen')     = randomR (0.0, 1.0) gen
        spawnCustomer = r < prob
    in  if
          | tP >= 0 && spawnCustomer -> go (tP - int)
                                           0.0
                                           (c + 1)
                                           (customerArrival 0.0 Nothing)
                                           gen'
          | tP >= 0 -> go (tP - int)
                          (tC + int)
                          c
                          (customerArrival tC Nothing)
                          gen'
          | otherwise -> c




    ---------------------
    --[ Waiting times ]--
    ---------------------


-- | The waiting times for all customers in the queue.
--
-- Whether queue length or processing time is based on the average or
-- maximum processing time is up to the caller. These could be considered
-- distinct models.
waitingTimes :: Int     -- ^ queue length
             -> Double  -- ^ processing time
             -> [Double]
waitingTimes l t =
  fmap (\x -> sum (fmap (\y -> fromIntegral y * t) [x .. l])) [1 .. l]


maxWaitingTime :: Int    -- ^ queue length
               -> Double -- ^ processing time
               -> Double
maxWaitingTime l t = maximum $ waitingTimes l t


avgWaitingTime :: Int    -- ^ queue length
               -> Double -- ^ processing time
               -> Double
avgWaitingTime 0 t = 0
avgWaitingTime l t = (sum $ waitingTimes l t) / (fromIntegral l)