This commit is contained in:
Reid Draper 2019-04-30 21:31:17 -07:00
Родитель 99b28f3a84
Коммит a3a980538f
2 изменённых файлов: 13 добавлений и 10 удалений

Просмотреть файл

@ -4,11 +4,13 @@ module Main where
import Control.DeepSeq import Control.DeepSeq
import Debug.Trace (traceM) import Debug.Trace (traceM)
import Data.Maybe (fromJust)
import Control.Monad (replicateM, forM_, forever) import Control.Monad (replicateM, forM_, forever)
import Control.Monad.Random.Class (getRandomR) import Control.Monad.Random.Class (getRandomR)
import Data.Coerce (coerce) import Data.Coerce (coerce)
import Data.Random.Source.PureMT (newPureMT) import Data.Random.Source.PureMT (newPureMT)
import qualified Data.PQueue.Prio.Min as PQueue import qualified Data.PQueue.Prio.Min as PQueue
import qualified Data.SortedList as SList
import Deli (Channel, Deli, JobTiming(..)) import Deli (Channel, Deli, JobTiming(..))
import Deli.Printer (printResults) import Deli.Printer (printResults)
import System.Random import System.Random
@ -56,19 +58,19 @@ leastWorkLeft
-> Deli JobTiming () -> Deli JobTiming ()
leastWorkLeft num jobChannel = do leastWorkLeft num jobChannel = do
chans :: [Channel JobTiming] <- replicateM num createWorker chans :: [Channel JobTiming] <- replicateM num createWorker
let workQueue :: PQueue.MinPQueue Deli.Duration (Deli.Channel JobTiming) let workQueue :: SList.SortedList (Deli.Duration, Deli.Channel JobTiming)
workQueue = PQueue.fromList [(0 :: Deli.Duration, c) | c <- chans] --workQueue = PQueue.fromList [(0 :: Deli.Duration, c) | c <- chans]
mFun lastTime nowTime k = max 0 (k - coerce (nowTime - lastTime)) workQueue = SList.toSortedList [(0 :: Deli.Duration, c) | c <- chans]
loop :: PQueue.MinPQueue Deli.Duration (Deli.Channel JobTiming) -> Deli.Time -> Deli JobTiming () mFun lastTime nowTime (k, v) = (max 0 (k - coerce (nowTime - lastTime)), v)
loop :: SList.SortedList (Deli.Duration, Deli.Channel JobTiming) -> Deli.Time -> Deli JobTiming ()
loop prevQueue prevTime = do loop prevQueue prevTime = do
job <- Deli.readChannel jobChannel job <- Deli.readChannel jobChannel
newTime <- Deli.now newTime <- Deli.now
let !adjustedQueue = PQueue.mapKeysMonotonic (mFun prevTime newTime) prevQueue let !adjustedQueue = SList.map (mFun prevTime newTime) prevQueue
(shortestPrevDuration, shortestQueue) = PQueue.findMin adjustedQueue ((shortestPrevDuration, shortestQueue), deletedMin) = fromJust $ SList.uncons adjustedQueue
!deletedMin = PQueue.deleteMin adjustedQueue !addedBack = SList.insert (shortestPrevDuration + _jobDuration job, shortestQueue) deletedMin
!addedBack = PQueue.insert (shortestPrevDuration + _jobDuration job) shortestQueue deletedMin
Deli.writeChannel shortestQueue job Deli.writeChannel shortestQueue job
loop (PQueue.seqSpine addedBack addedBack) newTime loop addedBack newTime
now <- Deli.now now <- Deli.now
loop workQueue now loop workQueue now
@ -76,7 +78,7 @@ loadBalancerExample :: IO ()
loadBalancerExample = do loadBalancerExample = do
simulationGen <- newStdGen simulationGen <- newStdGen
inputGen <- newPureMT inputGen <- newPureMT
-- Generate a poisson process of arrivals, with a mean of 650 arrivals -- Generate a poisson process of arrivals, with a mean of 31,000 arrivals
-- per second -- per second
let arrivals = Deli.Random.arrivalTimePoissonDistribution 31000 let arrivals = Deli.Random.arrivalTimePoissonDistribution 31000
-- Generate a Pareto distribution of service times, with a mean service -- Generate a Pareto distribution of service times, with a mean service

Просмотреть файл

@ -83,6 +83,7 @@ executable load-balancer
, random , random
, random-fu , random-fu
, random-source , random-source
, sorted-list
, tdigest , tdigest
, time , time
default-language: Haskell2010 default-language: Haskell2010