{-# 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
(WindowedCounter a -> WindowedCounter a -> Bool)
-> (WindowedCounter a -> WindowedCounter a -> Bool)
-> Eq (WindowedCounter a)
forall a. Eq a => WindowedCounter a -> WindowedCounter a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$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
/= :: WindowedCounter a -> WindowedCounter a -> Bool
Eq, Int -> WindowedCounter a -> ShowS
[WindowedCounter a] -> ShowS
WindowedCounter a -> String
(Int -> WindowedCounter a -> ShowS)
-> (WindowedCounter a -> String)
-> ([WindowedCounter a] -> ShowS)
-> Show (WindowedCounter a)
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
$cshowsPrec :: forall a. Show a => Int -> WindowedCounter a -> ShowS
showsPrec :: Int -> WindowedCounter a -> ShowS
$cshow :: forall a. Show a => WindowedCounter a -> String
show :: WindowedCounter a -> String
$cshowList :: forall a. Show a => [WindowedCounter a] -> ShowS
showList :: [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" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Set a -> Value
forall a. ToJSON a => a -> Value
toJSON Set a
membersSet
      , Key
"span" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e 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 = String
-> (Object -> Parser (WindowedCounter a))
-> Value
-> Parser (WindowedCounter a)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"WindowedCounter" ((Object -> Parser (WindowedCounter a))
 -> Value -> Parser (WindowedCounter a))
-> (Object -> Parser (WindowedCounter a))
-> Value
-> Parser (WindowedCounter a)
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
    Int
s <- Object
v Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"span"
    WindowedCounter a -> Parser (WindowedCounter a)
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (WindowedCounter a -> Parser (WindowedCounter a))
-> WindowedCounter a -> Parser (WindowedCounter a)
forall a b. (a -> b) -> a -> b
$ Int -> WindowedCounter a
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 = Set a -> Maybe a -> Int -> WindowedCounter a
forall a. Set a -> Maybe a -> Int -> WindowedCounter a
WindowedCounter Set a
forall a. Set a
Set.empty Maybe a
forall a. Maybe a
Nothing (Int -> WindowedCounter a)
-> (Int -> Int) -> Int -> WindowedCounter a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
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) =
  Double -> UnitInterval Double
forall a. (Ord a, Num a) => a -> UnitInterval a
mkInterval (Double -> UnitInterval Double) -> Double -> UnitInterval Double
forall a b. (a -> b) -> a -> b
$
    if Set a -> Bool
forall a. Set a -> Bool
Set.null Set a
s Bool -> Bool -> Bool
|| Bool -> (a -> Bool) -> Maybe a -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
referenceTick) Maybe a
lastLargest
      then Double
0
      else Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Set a -> Int
forall a. Set a -> Int
Set.size Set a
culledSet) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nominalSpan
 where
  referenceTick :: a
referenceTick = Int -> a -> a
forall a. Offsettable a => Int -> a -> a
offsetBy (Int -> Int
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
_ = a -> WindowedCounter a -> WindowedCounter a
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) =
  a -> WindowedCounter a -> WindowedCounter a
forall a.
(Ord a, Offsettable a) =>
a -> WindowedCounter a -> WindowedCounter a
discardGarbage a
x (WindowedCounter a -> WindowedCounter a)
-> WindowedCounter a -> WindowedCounter a
forall a b. (a -> b) -> a -> b
$ Set a -> Maybe a -> Int -> WindowedCounter a
forall a. Set a -> Maybe a -> Int -> WindowedCounter a
WindowedCounter (a -> Set a -> Set a
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 = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ a -> (a -> a) -> Maybe a -> a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe a
x (a -> a -> a
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) =
  Set a -> Maybe a -> Int -> WindowedCounter a
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) = a -> Set a -> (Set a, Set a)
forall a. Ord a => a -> Set a -> (Set a, Set a)
Set.split (Int -> a -> a
forall a. Offsettable a => Int -> a -> a
offsetBy (Int -> Int
forall a. Num a => a -> a
negate Int
nominalSpan) a
currentTime) Set a
s