schedulers

master
nihonium 1 year ago
parent 96401e7fc3
commit b78cc5fd7d
No known key found for this signature in database
GPG Key ID: 0251623741027CFC

@ -3,9 +3,13 @@ module Algo.Common where
import Types import Types
import Heap import Heap
updateHeap :: Time -> Time -> (Heap Unit, Heap Unit) -> (Heap Unit, Heap Unit) runUntilCycle :: CreateHeapFunc -> HeapUpdateFunc -> Time -> [Time] -> Heap Unit
updateHeap start_t fin_t (h, nh) = if (div start_t Types.packet_t /= div fin_t Types.packet_t) then runUntilCycle createHeap updateHeap p ts = fst $ run 0 (h, emptyHeap) -- maintain two heaps - one for clients with remaining packets, one for clients without available packets
let inc_rem x = x {rem_p = rem_p x + 1} where h = createHeap ts
restore x h = insert (x {rem_p = 1}) h in run :: Time -> (Heap Unit, Heap Unit) -> (Heap Unit, Heap Unit)
(foldr restore (fmap inc_rem h) nh, emptyHeap) -- "bring back" clients without available packets every 20ms run curr_t (h, exh_h) | (mod curr_t p == 0) && (curr_t /= 0) = (h, exh_h) -- cycle found
else (h, nh) | otherwise = let (Just m,h') = deleteMax h in
run (curr_t + period m) $ updateHeap curr_t (curr_t + period m) $ insertDecreased m h' exh_h where
insertDecreased el h exh_h = if (rem_p el == 1) then
(h, insert el {sent_p = sent_p el + 1, rem_p = 0} exh_h) -- move best client to the "exhausted" heap if his rem_p is equal to zero
else (insert el {sent_p = sent_p el + 1, rem_p = rem_p el - 1} h, exh_h)

@ -8,13 +8,9 @@ createHeap :: [Time] -> Heap Unit
createHeap [] = Nil createHeap [] = Nil
createHeap (t:ts) = insert (Unit (fromIntegral t) t 1 0) $ createHeap ts -- we use 1/speed as metric createHeap (t:ts) = insert (Unit (fromIntegral t) t 1 0) $ createHeap ts -- we use 1/speed as metric
runUntilCycle :: Int -> [Int] -> Heap Unit updateHeap :: HeapUpdateFunc
runUntilCycle p ts = fst $ run 0 (h, emptyHeap) -- maintain two heaps - one for clients with remaining packets, one for clients without available packets updateHeap start_t fin_t (h, nh) = if (div start_t Types.packet_t /= div fin_t Types.packet_t) then
where h = createHeap ts let inc_rem x = x {rem_p = rem_p x + 1}
run :: Time -> (Heap Unit, Heap Unit) -> (Heap Unit, Heap Unit) restore x h = insert (x {rem_p = 1}) h in
run curr_t (h, exh_h) | (mod curr_t p == 0) && (curr_t /= 0) = (h, exh_h) -- cycle found (foldr restore (fmap inc_rem h) nh, emptyHeap) -- "bring back" clients without available packets every 20ms
| otherwise = let (Just m,h') = deleteMax h in else (h, nh)
run (curr_t + period m) $ updateHeap curr_t (curr_t + period m) $ insertDecreased m h' exh_h where
insertDecreased el h exh_h = if (rem_p el == 1) then
(h, insert el {sent_p = sent_p el + 1, rem_p = 0} exh_h) -- move best client to the "exhausted" heap if his rem_p is equal to zero
else (insert el {sent_p = sent_p el + 1, rem_p = rem_p el - 1} h, exh_h)

@ -8,13 +8,9 @@ createHeap :: [Time] -> Heap Unit
createHeap [] = Nil createHeap [] = Nil
createHeap (t:ts) = insert (Unit (1 / (fromIntegral t)) t 1 0) $ createHeap ts -- we use speed as metric createHeap (t:ts) = insert (Unit (1 / (fromIntegral t)) t 1 0) $ createHeap ts -- we use speed as metric
runUntilCycle :: Int -> [Int] -> Heap Unit updateHeap :: HeapUpdateFunc
runUntilCycle p ts = fst $ run 0 (h, emptyHeap) -- maintain two heaps - one for clients with remaining packets, one for clients without available packets updateHeap start_t fin_t (h, nh) = if (div start_t Types.packet_t /= div fin_t Types.packet_t) then
where h = createHeap ts let inc_rem x = x {rem_p = rem_p x + 1}
run :: Time -> (Heap Unit, Heap Unit) -> (Heap Unit, Heap Unit) restore x h = insert (x {rem_p = 1}) h in
run curr_t (h, exh_h) | (mod curr_t p == 0) && (curr_t /= 0) = (h, exh_h) -- cycle found (foldr restore (fmap inc_rem h) nh, emptyHeap) -- "bring back" clients without available packets every 20ms
| otherwise = let (Just m,h') = deleteMax h in else (h, nh)
run (curr_t + period m) $ updateHeap curr_t (curr_t + period m) $ insertDecreased m h' exh_h where
insertDecreased el h exh_h = if (rem_p el == 1) then
(h, insert el {sent_p = sent_p el + 1, rem_p = 0} exh_h) -- move best client to the "exhausted" heap if his rem_p is equal to zero
else (insert el {sent_p = sent_p el + 1, rem_p = rem_p el - 1} h, exh_h)

@ -6,7 +6,7 @@ import qualified Algo.Common
createHeap :: [Time] -> Heap Unit createHeap :: [Time] -> Heap Unit
createHeap [] = Nil createHeap [] = Nil
createHeap (t:ts) = insert (Unit (1 / (fromIntegral t) / 0.01) t 1 0) $ createHeap ts -- we use r/R as metric, where t is speeed, R - transmitted size createHeap (t:ts) = insert (Unit (1 / (fromIntegral t) / 0.01) t 1 0) $ createHeap ts -- we use r/R as metric, where r is speed, R - transmitted size
updateHeap :: Time -> Time -> (Heap Unit, Heap Unit) -> (Heap Unit, Heap Unit) updateHeap :: Time -> Time -> (Heap Unit, Heap Unit) -> (Heap Unit, Heap Unit)
updateHeap start_t fin_t (h, nh) = if (div start_t Types.packet_t /= div fin_t Types.packet_t) then updateHeap start_t fin_t (h, nh) = if (div start_t Types.packet_t /= div fin_t Types.packet_t) then
@ -18,14 +18,3 @@ updateHeap start_t fin_t (h, nh) = if (div start_t Types.packet_t /= div fin_t T
-- Rebuild tree to update metrics -- Rebuild tree to update metrics
updateMetrics :: Heap Unit -> Heap Unit updateMetrics :: Heap Unit -> Heap Unit
updateMetrics = foldr (\x h -> insert (x {metric = 1 / (fromIntegral $ (period x) * (sent_p x))}) h) emptyHeap updateMetrics = foldr (\x h -> insert (x {metric = 1 / (fromIntegral $ (period x) * (sent_p x))}) h) emptyHeap
runUntilCycle :: Int -> [Int] -> Heap Unit
runUntilCycle p ts = fst $ run 0 (h, emptyHeap) -- maintain two heaps - one for clients with remaining packets, one for clients without available packets
where h = createHeap ts
run :: Time -> (Heap Unit, Heap Unit) -> (Heap Unit, Heap Unit)
run curr_t (h, exh_h) | (mod curr_t p == 0) && (curr_t /= 0) = (h, exh_h) -- cycle found
| otherwise = let (Just m,h') = deleteMax h in
run (curr_t + period m) $ updateHeap curr_t (curr_t + period m) $ insertDecreased m h' exh_h where
insertDecreased el h exh_h = if (rem_p el == 1) then
(h, insert el {sent_p = sent_p el + 1, rem_p = 0} exh_h) -- move best client to the "exhausted" heap if his rem_p is equal to zero
else (insert el {sent_p = sent_p el + 1, rem_p = rem_p el - 1} h, exh_h)

@ -3,30 +3,31 @@ module Main where
import Algo.MaxRate as MaxRate import Algo.MaxRate as MaxRate
import Algo.MaxMinRate as MaxMinRate import Algo.MaxMinRate as MaxMinRate
import Algo.PF as PF import Algo.PF as PF
import Algo.Common
import Types import Types
import Heap import Heap
main :: IO () main :: IO ()
main = do main = do
s <- getLine --s <- getLine
let speeds = map read $ words s :: [Double] --let speeds = map read $ words s :: [Double]
let speeds = [72, 54 ,36]
let ts = map (ceiling . (* 1000) . (Types.packet_size/)) speeds -- ms let ts = map (ceiling . (* 1000) . (Types.packet_size/)) speeds -- ms
putStr "======\nMaxRate\n" putStr "======\nMaxRate\n"
let max_rate_h = MaxRate.runUntilCycle packet_t ts let h = runUntilCycle MaxRate.createHeap MaxRate.updateHeap packet_t ts
print $ getAverageSpeed max_rate_h print $ getAverageSpeed h
print $ getShare max_rate_h print $ getShare h
putStr "======\nMaxMinRate\n" putStr "======\nMaxMinRate\n"
let max_min_rate_h = MaxMinRate.runUntilCycle packet_t ts let h = runUntilCycle MaxMinRate.createHeap MaxMinRate.updateHeap packet_t ts
print $ getAverageSpeed max_min_rate_h print $ getAverageSpeed h
print $ getShare max_min_rate_h print $ getShare h
putStr "======\nPF\n" putStr "======\nPF\n"
let pf_h = PF.runUntilCycle packet_t ts let h = runUntilCycle PF.createHeap PF.updateHeap packet_t ts
print pf_h print $ getAverageSpeed h
print $ getAverageSpeed pf_h print $ getShare h
print $ getShare pf_h
getAverageSpeed :: Heap Unit -> Double getAverageSpeed :: Heap Unit -> Double
getAverageSpeed h = summary_bytes / ((fromIntegral . getSummaryTime) h) where getAverageSpeed h = summary_bytes / ((fromIntegral . getSummaryTime) h) where
@ -38,3 +39,4 @@ getSummaryTime = foldr (\x result-> result + (sent_p x) * (period x)) 0
getShare :: Heap Unit -> [(Double, Double)] getShare :: Heap Unit -> [(Double, Double)]
getShare h = foldr (\x lst -> (1000 / (fromIntegral $ period x), (fromIntegral $ (sent_p x) * (period x)) / sum_t) : lst) [] h where getShare h = foldr (\x lst -> (1000 / (fromIntegral $ period x), (fromIntegral $ (sent_p x) * (period x)) / sum_t) : lst) [] h where
sum_t = fromIntegral $ getSummaryTime h sum_t = fromIntegral $ getSummaryTime h

@ -1,6 +1,10 @@
module Types where module Types where
import Heap
type Time = Int -- ms type Time = Int -- ms
type HeapUpdateFunc = Time -> Time -> (Heap Unit, Heap Unit) -> (Heap Unit, Heap Unit)
type CreateHeapFunc = [Time] -> Heap Unit
packet_size = 1 :: Double -- kb packet_size = 1 :: Double -- kb
cbr = 50 :: Double cbr = 50 :: Double