commit 2517e88d62f99a289bcf3afaa034ab0b666d729c Author: Julian Ospald Date: Tue May 26 22:38:58 2020 +0200 Initial commit diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 index 0000000..9c5a4ce --- /dev/null +++ b/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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/Thoughts.md b/Thoughts.md new file mode 100644 index 0000000..407ff7a --- /dev/null +++ b/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. diff --git a/app/Main.hs b/app/Main.hs new file mode 100644 index 0000000..c6f28f1 --- /dev/null +++ b/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) diff --git a/holmusk-challenge.cabal b/holmusk-challenge.cabal new file mode 100644 index 0000000..2bffa9b --- /dev/null +++ b/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 diff --git a/lib/Holmusk.hs b/lib/Holmusk.hs new file mode 100644 index 0000000..58154d5 --- /dev/null +++ b/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) + diff --git a/test/MyLibTest.hs b/test/MyLibTest.hs new file mode 100644 index 0000000..3e2059e --- /dev/null +++ b/test/MyLibTest.hs @@ -0,0 +1,4 @@ +module Main (main) where + +main :: IO () +main = putStrLn "Test suite not yet implemented."