From 96401e7fc3776a172dfe8beb2f7554ee1e476597 Mon Sep 17 00:00:00 2001 From: nihonium Date: Sun, 9 Apr 2023 14:48:30 +0300 Subject: [PATCH] schedulers - first approach --- 14_schedulers/Algo/Common.hs | 11 ++++++ 14_schedulers/Algo/MaxMinRate.hs | 20 +++++++++++ 14_schedulers/Algo/MaxRate.hs | 20 +++++++++++ 14_schedulers/Algo/PF.hs | 31 +++++++++++++++++ 14_schedulers/Heap.hs | 58 ++++++++++++++++++++++++++++++++ 14_schedulers/Main.hs | 40 ++++++++++++++++++++++ 14_schedulers/Types.hs | 18 ++++++++++ 7 files changed, 198 insertions(+) create mode 100644 14_schedulers/Algo/Common.hs create mode 100644 14_schedulers/Algo/MaxMinRate.hs create mode 100644 14_schedulers/Algo/MaxRate.hs create mode 100644 14_schedulers/Algo/PF.hs create mode 100644 14_schedulers/Heap.hs create mode 100644 14_schedulers/Main.hs create mode 100644 14_schedulers/Types.hs diff --git a/14_schedulers/Algo/Common.hs b/14_schedulers/Algo/Common.hs new file mode 100644 index 0000000..98f74a8 --- /dev/null +++ b/14_schedulers/Algo/Common.hs @@ -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) diff --git a/14_schedulers/Algo/MaxMinRate.hs b/14_schedulers/Algo/MaxMinRate.hs new file mode 100644 index 0000000..9d30657 --- /dev/null +++ b/14_schedulers/Algo/MaxMinRate.hs @@ -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) diff --git a/14_schedulers/Algo/MaxRate.hs b/14_schedulers/Algo/MaxRate.hs new file mode 100644 index 0000000..c8a0415 --- /dev/null +++ b/14_schedulers/Algo/MaxRate.hs @@ -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) diff --git a/14_schedulers/Algo/PF.hs b/14_schedulers/Algo/PF.hs new file mode 100644 index 0000000..44cdac5 --- /dev/null +++ b/14_schedulers/Algo/PF.hs @@ -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) diff --git a/14_schedulers/Heap.hs b/14_schedulers/Heap.hs new file mode 100644 index 0000000..cc8009e --- /dev/null +++ b/14_schedulers/Heap.hs @@ -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 diff --git a/14_schedulers/Main.hs b/14_schedulers/Main.hs new file mode 100644 index 0000000..b4c4917 --- /dev/null +++ b/14_schedulers/Main.hs @@ -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 diff --git a/14_schedulers/Types.hs b/14_schedulers/Types.hs new file mode 100644 index 0000000..c0204c0 --- /dev/null +++ b/14_schedulers/Types.hs @@ -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)