Initial commit

CHANGELOG.md

@@ -0,0 +1,5 @@
+# Revision history for holmusk-challenge
+
+## 0.0.0.1 -- YYYY-mm-dd
+
+* First version. Released on an unsuspecting world.

Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

Thoughts.md

@@ -0,0 +1,26 @@
+# Thoughts
+
+## Approach
+
+1. write down the formulas, play with them a little
+2. figure out how to get average and maximum customer processing (not waiting) time
+3. figure out how to model queue length for average and maximum customer processing time
+4. use 1, 2. and 3. to model waiting times
+
+## Queue length
+
+The key is creating a model for the queue length. The easiest approach is to
+set a probability value x and say "a person appears at the bank when the
+probability is greater or equal to x". Then the probability drops to 0
+and increases over time until it hits x again.
+
+Another possibility would be to generate a random number every second and
+compare it to the current probability of a person appearing.
+
+## Waiting time
+
+The waiting time depends on the queue length. The maximum waiting time
+is the time the person who came last has to wait wrt size of the max queue
+length (times max processing time).
+
+Average is similar.

app/Main.hs

@@ -0,0 +1,96 @@
+{-
+
+Your task is to write a program that can outputs to stdout
+the answers to the following questions:
+
+- Given only yellow customers, what are the average and maximum
+  customer waiting times?
+- Given only red customers, what are the average and maximum queue
+  lengths in-front of the teller?
+- Which type of customer(yellow, red or blue) gives the
+  closest value between the average and maximum customer waiting times?
+
+-}
+
+
+module Main where
+
+import           Holmusk
+
+import           Data.List
+import           Options.Applicative
+import           System.Random
+
+
+data Options = Options {
+    interval :: Double
+  }
+
+
+options :: Parser Options
+options =
+  Options
+    <$> (option
+          auto
+          (  long "interval"
+          <> short 'i'
+          <> help "interval between checks in queueLengthR"
+          <> showDefault
+          <> value 0.1
+          <> metavar "DOUBLE"
+          )
+        )
+
+
+main :: IO ()
+main = do
+  Options {..} <- execParser $ info
+    (options <**> helper)
+    (fullDesc <> progDesc "Run holmusk simulations")
+
+  -- Q1
+  putStrLn
+    "Given only yellow customers, what are the average and maximum customer waiting times?"
+  g1 <- getStdGen
+  g2 <- getStdGen
+  let yAvgPt = avgCustomerProcTime Yellow
+      yMaxPt = maxCustomerProcTime Yellow
+      yAvgQl = queueLengthR yAvgPt interval g1
+      yMaxQl = queueLengthR yMaxPt interval g2
+      yAvgW  = avgWaitingTime yAvgQl yAvgPt
+      yMaxW  = maxWaitingTime yMaxQl yMaxPt
+  putStrLn $ "Avg: " ++ show yAvgW
+  putStrLn $ "Max: " ++ show yMaxW
+  putStrLn ""
+
+  -- Q2
+  putStrLn
+    "Given only red customers, what are the average and maximum queue lengths in-front of the teller?"
+  g1 <- getStdGen
+  g2 <- getStdGen
+  let rAvgPt = avgCustomerProcTime Red
+      rMaxPt = maxCustomerProcTime Red
+      rAvgQl = queueLengthR rAvgPt interval g1
+      rMaxQl = queueLengthR rMaxPt interval g2
+      rAvgW  = avgWaitingTime rAvgQl rAvgPt
+      rMaxW  = maxWaitingTime rMaxQl rMaxPt
+  putStrLn $ "Avg: " ++ show rAvgQl
+  putStrLn $ "Max: " ++ show rMaxQl
+  putStrLn ""
+
+  -- Q3
+  putStrLn
+    "Which type of customer(yellow, red or blue) gives the closest value between the average and maximum customer waiting times?"
+  g1 <- getStdGen
+  g2 <- getStdGen
+  let bAvgPt = avgCustomerProcTime Blue
+      bMaxPt = maxCustomerProcTime Blue
+      bAvgQl = queueLengthR bAvgPt interval g1
+      bMaxQl = queueLengthR bMaxPt interval g2
+      bAvgW  = avgWaitingTime bAvgQl bAvgPt
+      bMaxW  = maxWaitingTime bMaxQl bMaxPt
+
+  let dist =
+        [(Yellow, yMaxW - yAvgW), (Red, rMaxW - rAvgW), (Blue, bMaxW - bAvgW)]
+      min = minimumBy (\(_, x) (_, y) -> compare x y) $ dist
+  putStrLn (show min)

holmusk-challenge.cabal

@@ -0,0 +1,55 @@
+cabal-version:      2.4
+name:               holmusk-challenge
+version:            0.0.0.1
+
+-- synopsis:
+-- description:
+-- bug-reports:
+license:            LicenseRef-LGPL-2
+license-file:       LICENSE
+author:             Julian Ospald
+maintainer:         hasufell@posteo.de
+
+-- copyright:
+category:           Finance
+extra-source-files: CHANGELOG.md
+
+library
+  -- cabal-fmt: expand lib
+  exposed-modules:    Holmusk
+
+  -- other-modules:
+  -- other-extensions:
+  build-depends:
+    , base    ^>=4.13.0.0
+    , random  ^>=1.1
+
+  hs-source-dirs:     lib
+  default-language:   Haskell2010
+  default-extensions:
+    LambdaCase
+    MultiWayIf
+    Strict
+    StrictData
+
+executable holmusk-challenge
+  main-is:            Main.hs
+
+  -- other-modules:
+  -- other-extensions:
+  build-depends:
+    , base                  ^>=4.13.0.0
+    , holmusk-challenge
+    , optparse-applicative  ^>=0.15
+    , random                ^>=1.1
+
+  hs-source-dirs:     app
+  default-language:   Haskell2010
+  default-extensions: RecordWildCards
+
+test-suite holmusk-challenge-test
+  default-language: Haskell2010
+  type:             exitcode-stdio-1.0
+  hs-source-dirs:   test
+  main-is:          MyLibTest.hs
+  build-depends:    base ^>=4.13.0.0

lib/Holmusk.hs

@@ -0,0 +1,180 @@
+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)
+

test/MyLibTest.hs

@@ -0,0 +1,4 @@
+module Main (main) where
+
+main :: IO ()
+main = putStrLn "Test suite not yet implemented."