зеркало из https://github.com/github/deli.git
Try with sorted list
This commit is contained in:
Родитель
99b28f3a84
Коммит
a3a980538f
|
@ -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
|
||||||
|
|
Загрузка…
Ссылка в новой задаче