{-# LANGUAGE OverloadedStrings #-} -- | -- SPDX-License-Identifier: BSD-3-Clause -- -- Sliding window for activity monitoring. module Swarm.Util.WindowedCounter ( WindowedCounter, Offsettable (..), -- * Construction mkWindow, -- * Querying getOccupancy, -- * Maintenance insert, discardGarbage, ) where import Data.Aeson import Data.Set (Set) import Data.Set qualified as Set import Swarm.Util.UnitInterval import Prelude hiding (length) -- | Values that can be offset by an integral amount class Offsettable a where offsetBy :: Int -> a -> a -- | A "sliding window" of a designated span that supports insertion -- of tick "timestamps" that represent some state of interest during that tick. -- This data structure supports efficient querying of the ratio of -- {ticks for which that state existed} -- to the -- {total number of ticks spanned by the window}. -- -- The primary use case is in displaying the "activity level" of a robot. -- -- == Efficiency considerations -- -- The data retention of the window shall be maintained externally by -- invoking the 'discardGarbage' function. However, we should not -- unconditionally invoke this function upon each game tick. -- -- For efficiency, we do not want to iterate over every robot -- upon every tick; we only want to "visit" a robot if it is actually -- doing work that tick. -- Because of this, there may be some ticks in which the oldest element -- that is still stored falls outside of the nominal retention window -- while a robot is inactive. -- -- One might think we could perform garbage collection whenever we execute queries. -- However, in the context in which the view powered by the query is generated, we -- are not permitted to mutate the "state" of the game -- (the type signature of the rendering function is @AppState -> Widget Name@). -- -- Therefore, when we perform "queries" on the window, we must apply some -- filtering to exclude the "stragglers"; data members that have already fallen outside -- the window but have not yet been "garbage collected". -- We use a 'Set' to allow this filtering to be performed in @O(log n)@ time. -- -- In the worst case, the entire dataset may "age out" without being garbage collected, -- so that an @O(log n)@ filtering operation might be performed upon every "frame refresh" -- of the UI view. -- However, we also store the largest element of the window separately from the 'Set' so that -- we can compare against it for a @O(1)@ short-circuited path once every member ages out. -- -- The maximum number of elements ever stored in the 'Set' will be the width of the nominal -- span, even after some protracted failure to "garbage collect". data WindowedCounter a = WindowedCounter { forall a. WindowedCounter a -> Set a _members :: Set a , forall a. WindowedCounter a -> Maybe a _lastLargest :: Maybe a -- ^ NOTE: It is possible that '_lastLargest' may not exist in the 'Set'. , forall a. WindowedCounter a -> Int _nominalSpan :: Int -- ^ Data retention window. This value is guaranteed positive by the smart constructor. } deriving (WindowedCounter a -> WindowedCounter a -> Bool forall a. Eq a => WindowedCounter a -> WindowedCounter a -> Bool forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: WindowedCounter a -> WindowedCounter a -> Bool $c/= :: forall a. Eq a => WindowedCounter a -> WindowedCounter a -> Bool == :: WindowedCounter a -> WindowedCounter a -> Bool $c== :: forall a. Eq a => WindowedCounter a -> WindowedCounter a -> Bool Eq, Int -> WindowedCounter a -> ShowS forall a. Show a => Int -> WindowedCounter a -> ShowS forall a. Show a => [WindowedCounter a] -> ShowS forall a. Show a => WindowedCounter a -> String forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [WindowedCounter a] -> ShowS $cshowList :: forall a. Show a => [WindowedCounter a] -> ShowS show :: WindowedCounter a -> String $cshow :: forall a. Show a => WindowedCounter a -> String showsPrec :: Int -> WindowedCounter a -> ShowS $cshowsPrec :: forall a. Show a => Int -> WindowedCounter a -> ShowS Show) -- | Automatically deriving 'FromJSON' circumvents the protection offered by "smart constructors", -- and the 'ToJSON' instance may expose internal details. -- Therefore, we write our own custom implementations. -- -- This 'ToJSON' instance is strictly for diagnostic purposes, and we can reveal -- a bit more information than is used for parsing. instance (ToJSON a) => ToJSON (WindowedCounter a) where toJSON :: WindowedCounter a -> Value toJSON (WindowedCounter Set a membersSet Maybe a _lastLargest Int nominalSpan) = [Pair] -> Value object [ Key "members" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv .= forall a. ToJSON a => a -> Value toJSON Set a membersSet , Key "span" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv .= Int nominalSpan ] -- | We discard any "internal state" revealed by the 'ToJSON' instance and -- just use the "span" so that we can rely on any guarantees offered by the -- smart constructor, no matter the origin of the JSON. -- -- Discarding the internal state is OK, because it is not integral to gameplay; -- it is merely informational as a live indicator in the UI. instance FromJSON (WindowedCounter a) where parseJSON :: Value -> Parser (WindowedCounter a) parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a withObject String "WindowedCounter" forall a b. (a -> b) -> a -> b $ \Object v -> do Int s <- Object v forall a. FromJSON a => Object -> Key -> Parser a .: Key "span" forall (m :: * -> *) a. Monad m => a -> m a return forall a b. (a -> b) -> a -> b $ forall a. Int -> WindowedCounter a mkWindow Int s -- | NOTE: We take the absolute value of the "window span" argument -- so that we can make guarantees about the output of 'getOccupancy'. mkWindow :: -- | window span Int -> WindowedCounter a mkWindow :: forall a. Int -> WindowedCounter a mkWindow = forall a. Set a -> Maybe a -> Int -> WindowedCounter a WindowedCounter forall a. Set a Set.empty forall a. Maybe a Nothing forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a. Num a => a -> a abs -- | Return the ratio of {members in the window} to the {integral span -- represented by the window}. -- -- The "current time" should be at least as large as the largest -- element of the window. -- -- A fully-contiguous collection of ticks would have an occupancy ratio of @1@. -- -- == Unit interval guarantee -- The returned ratio is /guaranteed/ to lie on the unit interval, because: -- -- * Both the numerator and denominator of the ratio are guaranteed positive, and -- * 'discardGarbage' guarantees that the set size is less than or equal to -- the nominal span. getOccupancy :: (Ord a, Offsettable a) => -- | current time a -> WindowedCounter a -> UnitInterval Double getOccupancy :: forall a. (Ord a, Offsettable a) => a -> WindowedCounter a -> UnitInterval Double getOccupancy a currentTime wc :: WindowedCounter a wc@(WindowedCounter Set a s Maybe a lastLargest Int nominalSpan) = forall a. (Ord a, Num a) => a -> UnitInterval a mkInterval forall a b. (a -> b) -> a -> b $ if forall a. Set a -> Bool Set.null Set a s Bool -> Bool -> Bool || forall b a. b -> (a -> b) -> Maybe a -> b maybe Bool False (forall a. Ord a => a -> a -> Bool < a referenceTick) Maybe a lastLargest then Double 0 else forall a b. (Integral a, Num b) => a -> b fromIntegral (forall a. Set a -> Int Set.size Set a culledSet) forall a. Fractional a => a -> a -> a / forall a b. (Integral a, Num b) => a -> b fromIntegral Int nominalSpan where referenceTick :: a referenceTick = forall a. Offsettable a => Int -> a -> a offsetBy (forall a. Num a => a -> a negate Int nominalSpan) a currentTime -- Cull the window according to the current time WindowedCounter Set a culledSet Maybe a _ Int _ = forall a. (Ord a, Offsettable a) => a -> WindowedCounter a -> WindowedCounter a discardGarbage a currentTime WindowedCounter a wc -- | Invocations of this function shall be guarded externally -- by the conditions meant to be tracked in the window. -- -- Proper usage dictates that the value inserted should always -- be at least as large as the current largest element of the set. -- -- The 'discardGarbage' function is called from inside this function -- so that maintenance of the data structure is simplified. insert :: (Ord a, Offsettable a) => -- | current time a -> WindowedCounter a -> WindowedCounter a insert :: forall a. (Ord a, Offsettable a) => a -> WindowedCounter a -> WindowedCounter a insert a x (WindowedCounter Set a s Maybe a lastLargest Int nominalSpan) = forall a. (Ord a, Offsettable a) => a -> WindowedCounter a -> WindowedCounter a discardGarbage a x forall a b. (a -> b) -> a -> b $ forall a. Set a -> Maybe a -> Int -> WindowedCounter a WindowedCounter (forall a. Ord a => a -> Set a -> Set a Set.insert a x Set a s) Maybe a newLargest Int nominalSpan where newLargest :: Maybe a newLargest = forall a. a -> Maybe a Just forall a b. (a -> b) -> a -> b $ forall b a. b -> (a -> b) -> Maybe a -> b maybe a x (forall a. Ord a => a -> a -> a max a x) Maybe a lastLargest -- | Drop the leading elements that are not larger than the cutoff. -- -- This function is already called by the 'insert' function, so clients -- do not necessarily ever have to call this directly. -- However, there may -- be opportunity to call this even more often, i.e. in code paths where the -- robot is visited but the condition for insertion is not met. -- -- == Invariant -- If the largest member of the set is the current time, -- then after calling this function, the difference between smallest and largest -- value in the set is strictly less than the "nominal span", and the size of the -- set is less than or equal to the nominal span. -- -- For example, if the nominal span is @3@, the current time is @7@, and the -- set entails a contiguous sequence @{2, 3, 4, 5, 6, 7}@, then the pivot for 'Set.split' will be -- @7 - 3 = 4@. The set becomes @{5, 6, 7}@, with cardinality equal to the nominal span. discardGarbage :: (Ord a, Offsettable a) => -- | current time a -> WindowedCounter a -> WindowedCounter a discardGarbage :: forall a. (Ord a, Offsettable a) => a -> WindowedCounter a -> WindowedCounter a discardGarbage a currentTime (WindowedCounter Set a s Maybe a lastLargest Int nominalSpan) = forall a. Set a -> Maybe a -> Int -> WindowedCounter a WindowedCounter Set a larger Maybe a lastLargest Int nominalSpan where -- NOTE: Neither output set of 'split' includes the "pivot" value. (Set a _smaller, Set a larger) = forall a. Ord a => a -> Set a -> (Set a, Set a) Set.split (forall a. Offsettable a => Int -> a -> a offsetBy (forall a. Num a => a -> a negate Int nominalSpan) a currentTime) Set a s