schedulers - first approach
nihonium
1 year ago
parent
7eb6d580b4
commit
96401e7fc3
@ -0,0 +1,11 @@
|
||||
module Algo.Common where
|
||||
|
||||
import Types
|
||||
import Heap
|
||||
|
||||
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
|
||||
let inc_rem x = x {rem_p = rem_p x + 1}
|
||||
restore x h = insert (x {rem_p = 1}) h in
|
||||
(foldr restore (fmap inc_rem h) nh, emptyHeap) -- "bring back" clients without available packets every 20ms
|
||||
else (h, nh)
|
||||
@ -0,0 +1,20 @@
|
||||
module Algo.MaxMinRate where
|
||||
|
||||
import Types
|
||||
import Heap
|
||||
import Algo.Common
|
||||
|
||||
createHeap :: [Time] -> Heap Unit
|
||||
createHeap [] = Nil
|
||||
createHeap (t:ts) = insert (Unit (fromIntegral t) t 1 0) $ createHeap ts -- we use 1/speed as metric
|
||||
|
||||
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)
|
||||
@ -0,0 +1,20 @@
|
||||
module Algo.MaxRate where
|
||||
|
||||
import Types
|
||||
import Heap
|
||||
import Algo.Common
|
||||
|
||||
createHeap :: [Time] -> Heap Unit
|
||||
createHeap [] = Nil
|
||||
createHeap (t:ts) = insert (Unit (1 / (fromIntegral t)) t 1 0) $ createHeap ts -- we use speed as metric
|
||||
|
||||
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)
|
||||
@ -0,0 +1,31 @@
|
||||
module Algo.PF where
|
||||
|
||||
import Types
|
||||
import Heap
|
||||
import qualified Algo.Common
|
||||
|
||||
createHeap :: [Time] -> Heap Unit
|
||||
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
|
||||
|
||||
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
|
||||
let inc_rem x = x {rem_p = rem_p x + 1}
|
||||
restore x h = insert (x {rem_p = 1}) h in
|
||||
(updateMetrics $ foldr restore (fmap inc_rem h) nh, emptyHeap) -- "bring back" clients without available packets every 20ms
|
||||
else fmap updateMetrics (h, nh)
|
||||
|
||||
-- Rebuild tree to update metrics
|
||||
updateMetrics :: Heap Unit -> Heap Unit
|
||||
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)
|
||||
@ -0,0 +1,58 @@
|
||||
module Heap where
|
||||
|
||||
data Heap a = Nil | Node Int a (Heap a) (Heap a) deriving Show
|
||||
|
||||
emptyHeap :: Heap a
|
||||
emptyHeap = Nil
|
||||
|
||||
isEmpty :: Heap a -> Bool
|
||||
isEmpty Nil = True
|
||||
isEmpty _ = False
|
||||
|
||||
size Nil = 0
|
||||
size (Node s _ _ _) = s
|
||||
|
||||
root (Node _ x _ _) = x
|
||||
|
||||
isHeap (Node s x hl hr) = s == 1 + sl + sr && sl >= sr &&
|
||||
(isEmpty hl || x >= root hl) &&
|
||||
(isEmpty hr || x >= root hr) &&
|
||||
isHeap hl && isHeap hr
|
||||
where (sl, sr) = (size hl, size hr)
|
||||
|
||||
realign :: Heap a -> Heap a
|
||||
realign Nil = Nil
|
||||
realign h@(Node s x hl hr)
|
||||
| size hl >= size hr = h
|
||||
| otherwise = Node s x hr hl
|
||||
|
||||
union :: Ord a => Heap a -> Heap a -> Heap a
|
||||
union h Nil = h
|
||||
union Nil h = h
|
||||
union h1@(Node s1 x h1l h1r) h2@(Node s2 y h2l h2r)
|
||||
| x >= y = realign
|
||||
(Node (s1+s2) x h1l (union h1r h2))
|
||||
| otherwise = realign
|
||||
(Node (s1+s2) y h2l (union h1 h2r))
|
||||
|
||||
insert :: Ord a => a -> Heap a -> Heap a
|
||||
insert x h = union (Node 1 x Nil Nil) h
|
||||
|
||||
findMax :: Heap a -> Maybe a
|
||||
findMax h = if isEmpty h then Nothing
|
||||
else Just (root h)
|
||||
|
||||
deleteMax :: Ord a => Heap a -> (Maybe a, Heap a)
|
||||
deleteMax Nil = (Nothing, Nil)
|
||||
deleteMax (Node _ x hl hr) = (Just x, union hl hr)
|
||||
|
||||
instance Functor Heap where
|
||||
fmap f Nil = Nil
|
||||
fmap f (Node n x left right) = Node n (f x) left' right' where
|
||||
left' = fmap f left
|
||||
right' = fmap f right
|
||||
|
||||
instance Foldable Heap where
|
||||
foldr _ acc Nil = acc
|
||||
foldr f base (Node _ x left right) = f x $ foldr f acc right where
|
||||
acc = foldr f base left
|
||||
@ -0,0 +1,40 @@
|
||||
module Main where
|
||||
|
||||
import Algo.MaxRate as MaxRate
|
||||
import Algo.MaxMinRate as MaxMinRate
|
||||
import Algo.PF as PF
|
||||
import Types
|
||||
import Heap
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
s <- getLine
|
||||
let speeds = map read $ words s :: [Double]
|
||||
let ts = map (ceiling . (* 1000) . (Types.packet_size/)) speeds -- ms
|
||||
|
||||
putStr "======\nMaxRate\n"
|
||||
let max_rate_h = MaxRate.runUntilCycle packet_t ts
|
||||
print $ getAverageSpeed max_rate_h
|
||||
print $ getShare max_rate_h
|
||||
|
||||
putStr "======\nMaxMinRate\n"
|
||||
let max_min_rate_h = MaxMinRate.runUntilCycle packet_t ts
|
||||
print $ getAverageSpeed max_min_rate_h
|
||||
print $ getShare max_min_rate_h
|
||||
|
||||
putStr "======\nPF\n"
|
||||
let pf_h = PF.runUntilCycle packet_t ts
|
||||
print pf_h
|
||||
print $ getAverageSpeed pf_h
|
||||
print $ getShare pf_h
|
||||
|
||||
getAverageSpeed :: Heap Unit -> Double
|
||||
getAverageSpeed h = summary_bytes / ((fromIntegral . getSummaryTime) h) where
|
||||
summary_bytes = (foldr (\x result -> fromIntegral (1000 * (sent_p x)) + result) 0 h)
|
||||
|
||||
getSummaryTime :: Heap Unit -> Time
|
||||
getSummaryTime = foldr (\x result-> result + (sent_p x) * (period x)) 0
|
||||
|
||||
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
|
||||
sum_t = fromIntegral $ getSummaryTime h
|
||||
@ -0,0 +1,18 @@
|
||||
module Types where
|
||||
|
||||
type Time = Int -- ms
|
||||
|
||||
packet_size = 1 :: Double -- kb
|
||||
cbr = 50 :: Double
|
||||
packet_t = (ceiling . (1000*) . (1/)) cbr :: Time
|
||||
|
||||
data Unit = Unit {metric :: Double,
|
||||
period :: Time,
|
||||
rem_p :: Int,
|
||||
sent_p :: Int} deriving Show
|
||||
|
||||
instance Eq Unit where
|
||||
(==) a b = (metric a) == (metric b)
|
||||
|
||||
instance Ord Unit where
|
||||
(<=) a b = (metric a) <= (metric b)
|
||||
Reference in New Issue