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)