From 7d246ec71a235adbaff9c504c6641f6ec8f9b73b Mon Sep 17 00:00:00 2001 From: Karl Ostmo Date: Sat, 2 Sep 2023 22:30:41 -0700 Subject: [PATCH] Compute and display activity ratio --- .../scenarios/Testing/1341-command-count.yaml | 69 ++++++++- src/Swarm/Game/Robot.hs | 11 +- src/Swarm/Game/Step.hs | 3 + src/Swarm/TUI/Editor/View.hs | 2 +- src/Swarm/TUI/Launch/View.hs | 2 +- src/Swarm/TUI/Model/StateUpdate.hs | 4 +- src/Swarm/TUI/Model/UI.hs | 2 +- src/Swarm/TUI/View.hs | 41 +++++- src/Swarm/TUI/View/Achievement.hs | 2 +- src/Swarm/TUI/{ => View/Attribute}/Attr.hs | 28 +++- .../TUI/View/{ => Attribute}/CustomStyling.hs | 17 +-- src/Swarm/TUI/View/Attribute/Util.hs | 26 ++++ src/Swarm/TUI/View/CellDisplay.hs | 2 +- src/Swarm/TUI/View/Objective.hs | 2 +- src/Swarm/TUI/View/Util.hs | 2 +- src/Swarm/Util/WindowedCounter.hs | 135 ++++++++++++++++++ swarm.cabal | 7 +- 17 files changed, 320 insertions(+), 35 deletions(-) rename src/Swarm/TUI/{ => View/Attribute}/Attr.hs (87%) rename src/Swarm/TUI/View/{ => Attribute}/CustomStyling.hs (63%) create mode 100644 src/Swarm/TUI/View/Attribute/Util.hs create mode 100644 src/Swarm/Util/WindowedCounter.hs diff --git a/data/scenarios/Testing/1341-command-count.yaml b/data/scenarios/Testing/1341-command-count.yaml index 2647586c98..495c42c9e4 100644 --- a/data/scenarios/Testing/1341-command-count.yaml +++ b/data/scenarios/Testing/1341-command-count.yaml @@ -1,7 +1,11 @@ version: 1 name: Count commands +creative: true description: | - Count commands + Count commands and demonstrate various "duty cycles" + with system robots. The four robots should have duty + cycles of 100%, 50%, 33%, and 25% based on the number + of ticks that they `wait`. objectives: - goal: - | @@ -31,6 +35,58 @@ robots: - comparator - hourglass - branch predictor + - name: idler1 + dir: [1, 0] + system: true + devices: + - dictionary + - strange loop + - hourglass + program: | + def go = + wait 1; + go; + end; + go; + - name: idler2 + dir: [1, 0] + system: true + devices: + - dictionary + - strange loop + - hourglass + program: | + def go = + wait 2; + go; + end; + go; + - name: idler3 + dir: [1, 0] + system: true + devices: + - dictionary + - strange loop + - hourglass + program: | + def go = + wait 3; + go; + end; + go; + - name: idler4 + dir: [1, 0] + system: true + devices: + - dictionary + - strange loop + - hourglass + program: | + def go = + wait 4; + go; + end; + go; known: [flower, tree] world: default: [blank] @@ -39,8 +95,13 @@ world: 'f': [grass, flower] 'T': [grass, tree] 'B': [grass, null, base] + '1': [grass, null, idler1] + '2': [grass, null, idler2] + '3': [grass, null, idler3] + '4': [grass, null, idler4] upperleft: [-1, 1] map: | - ....... - .B.fff. - ...T... + ........1 + .B.fff..2 + ...T....3 + ........4 diff --git a/src/Swarm/Game/Robot.hs b/src/Swarm/Game/Robot.hs index fa692c3b83..4957b48aea 100644 --- a/src/Swarm/Game/Robot.hs +++ b/src/Swarm/Game/Robot.hs @@ -64,6 +64,7 @@ module Swarm.Game.Robot ( tangibleCommandCount, commandsHistogram, lifetimeStepCount, + activityWindow, -- ** Creation & instantiation mkRobot, @@ -110,6 +111,7 @@ import Swarm.Language.Typed (Typed (..)) import Swarm.Language.Types (TCtx) import Swarm.Language.Value as V import Swarm.Util.Lens (makeLensesExcluding, makeLensesNoSigs) +import Swarm.Util.WindowedCounter import Swarm.Util.Yaml import System.Clock (TimeSpec) @@ -177,6 +179,7 @@ data ActivityCounts = ActivityCounts , _tangibleCommandCount :: Int , _commandsHistogram :: Map Const Int , _lifetimeStepCount :: Int + , _activityWindow :: WindowedCounter Integer } deriving (Eq, Show, Generic, FromJSON, ToJSON) @@ -226,7 +229,7 @@ tickStepBudget :: Lens' ActivityCounts Int -- | Total number of tangible commands executed over robot's lifetime tangibleCommandCount :: Lens' ActivityCounts Int --- | Total number of commands executed over robot's lifetime +-- | Histogram of commands executed over robot's lifetime commandsHistogram :: Lens' ActivityCounts (Map Const Int) -- | Total number of CESK steps executed over robot's lifetime. @@ -234,6 +237,9 @@ commandsHistogram :: Lens' ActivityCounts (Map Const Int) -- as "cycles" in the F2 dialog in the UI. lifetimeStepCount :: Lens' ActivityCounts Int +-- | Sliding window over a span of ticks indicating ratio of activity +activityWindow :: Lens' ActivityCounts (WindowedCounter Integer) + -- | With a robot template, we may or may not have a location. With a -- concrete robot we must have a location. type family RobotLocation (phase :: RobotPhase) :: Data.Kind.Type where @@ -523,6 +529,9 @@ mkRobot rid pid name descr loc dir disp m devs inv sys heavy ts = , _tangibleCommandCount = 0 , _commandsHistogram = mempty , _lifetimeStepCount = 0 + , -- NOTE: This value was chosen experimentally. + -- TODO(#1341): Make this dynamic based on game speed. + _activityWindow = mkWindow 64 } , _runningAtomic = False } diff --git a/src/Swarm/Game/Step.hs b/src/Swarm/Game/Step.hs index 62e115869d..c69e4e3b61 100644 --- a/src/Swarm/Game/Step.hs +++ b/src/Swarm/Game/Step.hs @@ -94,6 +94,7 @@ import Swarm.Language.Typed (Typed (..)) import Swarm.Language.Value import Swarm.Util hiding (both) import Swarm.Util.Effect (throwToMaybe) +import Swarm.Util.WindowedCounter qualified as WC import System.Clock (TimeSpec) import Witch (From (from), into) import Prelude hiding (Applicative (..), lookup) @@ -523,10 +524,12 @@ stepRobot :: (Has (State GameState) sig m, Has (Lift IO) sig m) => Robot -> m Ro stepRobot r = do (r', cesk') <- runState (r & activityCounts . tickStepBudget -~ 1) (stepCESK (r ^. machine)) -- sendIO $ appendFile "out.txt" (prettyString cesk' ++ "\n") + TickNumber t <- use ticks return $ r' & machine .~ cesk' & activityCounts . lifetimeStepCount +~ 1 + & (activityCounts . activityWindow %~ WC.insert t) -- | replace some entity in the world with another entity updateWorld :: diff --git a/src/Swarm/TUI/Editor/View.hs b/src/Swarm/TUI/Editor/View.hs index 13ffa2836d..c99d3d0eed 100644 --- a/src/Swarm/TUI/Editor/View.hs +++ b/src/Swarm/TUI/Editor/View.hs @@ -13,13 +13,13 @@ import Swarm.Game.Scenario.Topography.EntityFacade import Swarm.Game.Terrain (TerrainType) import Swarm.Game.Universe import Swarm.Game.World qualified as W -import Swarm.TUI.Attr import Swarm.TUI.Border import Swarm.TUI.Editor.Model import Swarm.TUI.Model import Swarm.TUI.Model.Name import Swarm.TUI.Model.UI import Swarm.TUI.Panel +import Swarm.TUI.View.Attribute.Attr import Swarm.TUI.View.CellDisplay (renderDisplay) import Swarm.TUI.View.Util qualified as VU import Swarm.Util (listEnums) diff --git a/src/Swarm/TUI/Launch/View.hs b/src/Swarm/TUI/Launch/View.hs index 3a46b59180..fad8081f98 100644 --- a/src/Swarm/TUI/Launch/View.hs +++ b/src/Swarm/TUI/Launch/View.hs @@ -22,10 +22,10 @@ import Data.Text qualified as T import Swarm.Game.Scenario (scenarioSeed) import Swarm.Game.Scenario.Status (ParameterizableLaunchParams (..)) import Swarm.Game.State (getRunCodePath) -import Swarm.TUI.Attr import Swarm.TUI.Launch.Model import Swarm.TUI.Launch.Prep import Swarm.TUI.Model.Name +import Swarm.TUI.View.Attribute.Attr import Swarm.TUI.View.Util (EllipsisSide (Beginning), withEllipsis) import Swarm.Util (brackets, parens) diff --git a/src/Swarm/TUI/Model/StateUpdate.hs b/src/Swarm/TUI/Model/StateUpdate.hs index 6caa9eedbb..2af597a39b 100644 --- a/src/Swarm/TUI/Model/StateUpdate.hs +++ b/src/Swarm/TUI/Model/StateUpdate.hs @@ -58,7 +58,6 @@ import Swarm.Game.ScenarioInfo ( ) import Swarm.Game.State import Swarm.Language.Pretty (prettyText) -import Swarm.TUI.Attr (swarmAttrMap) import Swarm.TUI.Editor.Model qualified as EM import Swarm.TUI.Editor.Util qualified as EU import Swarm.TUI.Inventory.Sorting @@ -67,7 +66,8 @@ import Swarm.TUI.Model import Swarm.TUI.Model.Goal (emptyGoalDisplay) import Swarm.TUI.Model.Repl import Swarm.TUI.Model.UI -import Swarm.TUI.View.CustomStyling (toAttrPair) +import Swarm.TUI.View.Attribute.Attr (swarmAttrMap) +import Swarm.TUI.View.Attribute.CustomStyling (toAttrPair) import Swarm.Util.Effect (asExceptT, withThrow) import System.Clock diff --git a/src/Swarm/TUI/Model/UI.hs b/src/Swarm/TUI/Model/UI.hs index cfe3f4bdc8..c24c3f1013 100644 --- a/src/Swarm/TUI/Model/UI.hs +++ b/src/Swarm/TUI/Model/UI.hs @@ -76,7 +76,6 @@ import Swarm.Game.ScenarioInfo ( ) import Swarm.Game.Universe import Swarm.Game.World qualified as W -import Swarm.TUI.Attr (swarmAttrMap) import Swarm.TUI.Editor.Model import Swarm.TUI.Inventory.Sorting import Swarm.TUI.Launch.Model @@ -85,6 +84,7 @@ import Swarm.TUI.Model.Goal import Swarm.TUI.Model.Menu import Swarm.TUI.Model.Name import Swarm.TUI.Model.Repl +import Swarm.TUI.View.Attribute.Attr (swarmAttrMap) import Swarm.Util import Swarm.Util.Lens (makeLensesExcluding) import System.Clock diff --git a/src/Swarm/TUI/View.hs b/src/Swarm/TUI/View.hs index 2aab228861..86a3d02cf2 100644 --- a/src/Swarm/TUI/View.hs +++ b/src/Swarm/TUI/View.hs @@ -69,6 +69,7 @@ import Data.Text qualified as T import Data.Time (NominalDiffTime, defaultTimeLocale, formatTime) import Linear import Network.Wai.Handler.Warp (Port) +import Numeric (fromRat, showFFloat) import Swarm.Constant import Swarm.Game.CESK (CESK (..), TickNumber (..)) import Swarm.Game.Display @@ -93,7 +94,6 @@ import Swarm.Language.Capability (Capability (..), constCaps) import Swarm.Language.Pretty (prettyText) import Swarm.Language.Syntax import Swarm.Language.Typecheck (inferConst) -import Swarm.TUI.Attr import Swarm.TUI.Border import Swarm.TUI.Controller (ticksPerFrameCap) import Swarm.TUI.Editor.Model @@ -107,10 +107,12 @@ import Swarm.TUI.Model.Repl (lastEntry) import Swarm.TUI.Model.UI import Swarm.TUI.Panel import Swarm.TUI.View.Achievement +import Swarm.TUI.View.Attribute.Attr import Swarm.TUI.View.CellDisplay import Swarm.TUI.View.Objective qualified as GR import Swarm.TUI.View.Util as VU import Swarm.Util +import Swarm.Util.WindowedCounter qualified as WC import Swarm.Version (NewReleaseFailure (..)) import System.Clock (TimeSpec (..)) import Text.Printf @@ -606,13 +608,18 @@ drawModal s = \case DescriptionModal e -> descriptionWidget s e QuitModal -> padBottom (Pad 1) $ hCenter $ txt (quitMsg (s ^. uiState . uiMenu)) GoalModal -> GR.renderGoalsDisplay (s ^. uiState . uiGoal) - KeepPlayingModal -> padLeftRight 1 (displayParagraphs ["Have fun! Hit Ctrl-Q whenever you're ready to proceed to the next challenge or return to the menu."]) + KeepPlayingModal -> + padLeftRight 1 $ + displayParagraphs $ + pure + "Have fun! Hit Ctrl-Q whenever you're ready to proceed to the next challenge or return to the menu." TerrainPaletteModal -> EV.drawTerrainSelector s EntityPaletteModal -> EV.drawEntityPaintSelector s robotsListWidget :: AppState -> Widget Name robotsListWidget s = hCenter table where + TickNumber curTicks = s ^. gameState . ticks table = BT.renderTable . BT.columnBorders False @@ -630,6 +637,7 @@ robotsListWidget s = hCenter table , "Actions" , "Commands" , "Cycles" + , "Activity" , "Log" ] headers = withAttr robotAttr . txt <$> applyWhen cheat ("ID" :) headings @@ -644,12 +652,32 @@ robotsListWidget s = hCenter table , padRight (Pad 1) (str $ show rInvCount) , statusWidget , str $ show $ robot ^. activityCounts . tangibleCommandCount - , str . show . sum . M.elems $ robot ^. activityCounts . commandsHistogram + , -- TODO(#1341): May want to expose the details of this histogram in + -- a per-robot pop-up + str . show . sum . M.elems $ robot ^. activityCounts . commandsHistogram , str $ show $ robot ^. activityCounts . lifetimeStepCount + , dutyCycleDisplay , txt rLog ] + + dutyCycleAttrIdx = floor $ dutyCycleRatio * fromIntegral (length meterAttributeNames - 1) + dutyCycleAttr = meterAttributeNames !! dutyCycleAttrIdx + dutyCycleDisplay = withAttr dutyCycleAttr . str . flip (showFFloat (Just 1)) "%" $ dutyCyclePercentage + + dutyCycleRatio = + WC.getOccupancy curTicks $ + robot ^. activityCounts . activityWindow + + dutyCyclePercentage :: Double + dutyCyclePercentage = fromRat . (100 *) $ dutyCycleRatio + idWidget = str $ show $ robot ^. robotID - nameWidget = hBox [renderDisplay (robot ^. robotDisplay), highlightSystem . txt $ " " <> robot ^. robotName] + nameWidget = + hBox + [ renderDisplay (robot ^. robotDisplay) + , highlightSystem . txt $ " " <> robot ^. robotName + ] + highlightSystem = if robot ^. systemRobot then withAttr highlightAttr else id ageStr @@ -856,9 +884,8 @@ colorLogs e = case e ^. leSource of Critical -> redAttr where -- color each robot message with different color of the world - robotColor rid = fgCols !! (rid `mod` fgColLen) - fgCols = map fst worldAttributes - fgColLen = length fgCols + robotColor rid = worldAttributeNames !! (rid `mod` fgColLen) + fgColLen = length worldAttributeNames -- | Draw the F-key modal menu. This is displayed in the top left world corner. drawModalMenu :: AppState -> Widget Name diff --git a/src/Swarm/TUI/View/Achievement.hs b/src/Swarm/TUI/View/Achievement.hs index 369ef87e29..fdf8d79106 100644 --- a/src/Swarm/TUI/View/Achievement.hs +++ b/src/Swarm/TUI/View/Achievement.hs @@ -15,9 +15,9 @@ import Data.Time.Format (defaultTimeLocale, formatTime) import Swarm.Game.Achievement.Attainment import Swarm.Game.Achievement.Definitions import Swarm.Game.Achievement.Description -import Swarm.TUI.Attr import Swarm.TUI.Model import Swarm.TUI.Model.UI +import Swarm.TUI.View.Attribute.Attr import Text.Wrap padAllEvenly :: Int -> Widget Name -> Widget Name diff --git a/src/Swarm/TUI/Attr.hs b/src/Swarm/TUI/View/Attribute/Attr.hs similarity index 87% rename from src/Swarm/TUI/Attr.hs rename to src/Swarm/TUI/View/Attribute/Attr.hs index bbc3537fe2..4d41d8270c 100644 --- a/src/Swarm/TUI/Attr.hs +++ b/src/Swarm/TUI/View/Attribute/Attr.hs @@ -11,10 +11,11 @@ -- For example using the robot attribute to highlight some text. -- -- The few attributes that we use for drawing the logo are an exception. -module Swarm.TUI.Attr ( +module Swarm.TUI.View.Attribute.Attr ( swarmAttrMap, - worldAttributes, + worldAttributeNames, worldPrefix, + meterAttributeNames, toAttrName, -- ** Terrain attributes @@ -52,11 +53,13 @@ import Brick import Brick.Forms import Brick.Widgets.Dialog import Brick.Widgets.Edit qualified as E -import Brick.Widgets.List +import Brick.Widgets.List hiding (reverse) import Data.Bifunctor (bimap) +import Data.Colour.Palette.BrewerSet import Data.Text (unpack) import Graphics.Vty qualified as V import Swarm.Game.Display (Attribute (..)) +import Swarm.TUI.View.Attribute.Util toAttrName :: Attribute -> AttrName toAttrName = \case @@ -71,7 +74,8 @@ swarmAttrMap :: AttrMap swarmAttrMap = attrMap V.defAttr - $ worldAttributes + $ activityMeterAttributes + <> worldAttributes <> [(waterAttr, V.white `on` V.blue)] <> terrainAttr <> [ -- Robot attribute @@ -134,6 +138,22 @@ worldAttributes = , ("blue", V.blue) ] +worldAttributeNames :: [AttrName] +worldAttributeNames = map fst worldAttributes + +activityMeterPrefix :: AttrName +activityMeterPrefix = attrName "activityMeter" + +activityMeterAttributes :: [(AttrName, V.Attr)] +activityMeterAttributes = + bimap ((activityMeterPrefix <>) . attrName . show) bgWithAutoForeground + <$> zip [0 :: Int ..] brewers + where + brewers = reverse $ brewerSet RdYlGn 5 + +meterAttributeNames :: [AttrName] +meterAttributeNames = map fst activityMeterAttributes + terrainPrefix :: AttrName terrainPrefix = attrName "terrain" diff --git a/src/Swarm/TUI/View/CustomStyling.hs b/src/Swarm/TUI/View/Attribute/CustomStyling.hs similarity index 63% rename from src/Swarm/TUI/View/CustomStyling.hs rename to src/Swarm/TUI/View/Attribute/CustomStyling.hs index 1d49609da6..bd82490ba4 100644 --- a/src/Swarm/TUI/View/CustomStyling.hs +++ b/src/Swarm/TUI/View/Attribute/CustomStyling.hs @@ -1,14 +1,15 @@ -- | -- SPDX-License-Identifier: BSD-3-Clause -module Swarm.TUI.View.CustomStyling where +module Swarm.TUI.View.Attribute.CustomStyling where import Brick (AttrName, attrName) -import Data.Colour.SRGB (Colour, RGB (..), sRGB24read, toSRGB24) +import Data.Colour.Palette.BrewerSet (Kolor) +import Data.Colour.SRGB (RGB (..), sRGB24read, toSRGB24) import Data.Set (toList) import Data.Text qualified as T import Graphics.Vty.Attributes import Swarm.Game.Scenario.Style -import Swarm.TUI.Attr (worldPrefix) +import Swarm.TUI.View.Attribute.Attr (worldPrefix) toStyle :: StyleFlag -> Style toStyle = \case @@ -21,18 +22,18 @@ toStyle = \case Dim -> dim Bold -> bold -toAttrColor :: HexColor -> Color -toAttrColor (HexColor colorText) = +hexToAttrColor :: HexColor -> Color +hexToAttrColor (HexColor colorText) = RGBColor r g b where RGB r g b = toSRGB24 c - c :: Colour Double + c :: Kolor c = sRGB24read $ T.unpack colorText toAttrPair :: CustomAttr -> (AttrName, Attr) toAttrPair ca = (worldPrefix <> attrName (name ca), addStyle $ addFg $ addBg defAttr) where - addFg = maybe id (flip withForeColor . toAttrColor) $ fg ca - addBg = maybe id (flip withBackColor . toAttrColor) $ bg ca + addFg = maybe id (flip withForeColor . hexToAttrColor) $ fg ca + addBg = maybe id (flip withBackColor . hexToAttrColor) $ bg ca addStyle = maybe id (flip withStyle . sum . map toStyle . toList) $ style ca diff --git a/src/Swarm/TUI/View/Attribute/Util.hs b/src/Swarm/TUI/View/Attribute/Util.hs new file mode 100644 index 0000000000..eb2cb53b44 --- /dev/null +++ b/src/Swarm/TUI/View/Attribute/Util.hs @@ -0,0 +1,26 @@ +-- | +-- SPDX-License-Identifier: BSD-3-Clause +module Swarm.TUI.View.Attribute.Util where + +import Brick.Util (on) +import Data.Colour.CIE (luminance) +import Data.Colour.Palette.BrewerSet (Kolor) +import Data.Colour.SRGB (RGB (..), toSRGB24) +import Graphics.Vty qualified as V +import Graphics.Vty.Attributes + +kolorToAttrColor :: Kolor -> Color +kolorToAttrColor c = + RGBColor r g b + where + RGB r g b = toSRGB24 c + +-- | Automatically selects black or white for the foreground +-- based on the darkness of the supplied background. +bgWithAutoForeground :: Kolor -> Attr +bgWithAutoForeground c = fgColor `on` kolorToAttrColor c + where + fgColor = + if luminance c > 0.5 + then V.black + else V.white diff --git a/src/Swarm/TUI/View/CellDisplay.hs b/src/Swarm/TUI/View/CellDisplay.hs index 5eb4f80dd5..4d73f6853e 100644 --- a/src/Swarm/TUI/View/CellDisplay.hs +++ b/src/Swarm/TUI/View/CellDisplay.hs @@ -26,12 +26,12 @@ import Swarm.Game.State import Swarm.Game.Terrain import Swarm.Game.Universe import Swarm.Game.World qualified as W -import Swarm.TUI.Attr import Swarm.TUI.Editor.Masking import Swarm.TUI.Editor.Model import Swarm.TUI.Editor.Util qualified as EU import Swarm.TUI.Model.Name import Swarm.TUI.Model.UI +import Swarm.TUI.View.Attribute.Attr import Witch (from) import Witch.Encoding qualified as Encoding diff --git a/src/Swarm/TUI/View/Objective.hs b/src/Swarm/TUI/View/Objective.hs index 03d5dd7636..7b1ead093c 100644 --- a/src/Swarm/TUI/View/Objective.hs +++ b/src/Swarm/TUI/View/Objective.hs @@ -18,9 +18,9 @@ import Data.Map.Strict qualified as M import Data.Vector qualified as V import Swarm.Game.Scenario.Objective import Swarm.Language.Text.Markdown qualified as Markdown -import Swarm.TUI.Attr import Swarm.TUI.Model.Goal import Swarm.TUI.Model.Name +import Swarm.TUI.View.Attribute.Attr import Swarm.TUI.View.Util makeListWidget :: GoalTracking -> BL.List Name GoalEntry diff --git a/src/Swarm/TUI/View/Util.hs b/src/Swarm/TUI/View/Util.hs index 97f247aa9e..3bf207f137 100644 --- a/src/Swarm/TUI/View/Util.hs +++ b/src/Swarm/TUI/View/Util.hs @@ -25,9 +25,9 @@ import Swarm.Language.Pretty (prettyText) import Swarm.Language.Syntax (Syntax) import Swarm.Language.Text.Markdown qualified as Markdown import Swarm.Language.Types (Polytype) -import Swarm.TUI.Attr import Swarm.TUI.Model import Swarm.TUI.Model.UI +import Swarm.TUI.View.Attribute.Attr import Swarm.TUI.View.CellDisplay import Swarm.Util (listEnums) import Witch (from, into) diff --git a/src/Swarm/Util/WindowedCounter.hs b/src/Swarm/Util/WindowedCounter.hs new file mode 100644 index 0000000000..75d83b21a3 --- /dev/null +++ b/src/Swarm/Util/WindowedCounter.hs @@ -0,0 +1,135 @@ +-- | +-- SPDX-License-Identifier: BSD-3-Clause +-- +-- Sliding window for activity monitoring. +module Swarm.Util.WindowedCounter ( + WindowedCounter, + + -- * Construction + mkWindow, + + -- * Querying + getOccupancy, + + -- * Maintenance + insert, + discardGarbage, +) where + +import Data.Aeson (FromJSON, ToJSON) +import Data.Ratio +import Data.Set (Set) +import Data.Set qualified as Set +import GHC.Generics (Generic) +import Prelude hiding (length) + +-- | 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. +-- +-- 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. +data WindowedCounter a = WindowedCounter + { _members :: Set a + , _lastLargest :: Maybe a + -- ^ NOTE: It is possible that '_lastLargest' may not exist in the 'Set'. + , _nominalSpan :: a + -- ^ Data retention window + } + -- NOTE: deriving 'FromJSON' circumvents the protection offered by "smart constructors", + -- and the 'ToJSON' instance may expose internal details. + deriving (Eq, Show, Generic, FromJSON, ToJSON) + +mkWindow :: + -- | Window span + a -> + WindowedCounter a +mkWindow = WindowedCounter Set.empty Nothing + +-- | Return the ratio of {members in the window} to the {integral span +-- represented by the window} (actually, the beginning of the window up to +-- some reference tick). +-- +-- The "reference tick" must 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@. +getOccupancy :: + Integral a => + -- | reference tick + a -> + WindowedCounter a -> + Ratio a +getOccupancy referenceTick (WindowedCounter s lastLargest nominalSpan) = + if Set.null s || maybe False (< referenceTick - nominalSpan) lastLargest + then 0 + else case Set.lookupMin s of + Nothing -> 0 + Just minElement -> fromIntegral (Set.size s) % (referenceTick - minElement) + +-- | Invocations of this function shall be guarded externally +-- by the conditions meant to be tracked in the window. +-- +-- The value inserted must always be at least as large as the +-- current largest element of the set! +-- If it is equal, it is ignored. +-- +-- The 'discardGarbage' function is called from inside this function +-- so that maintenance of the data structure is simplified. +insert :: (Show a, Integral a) => a -> WindowedCounter a -> WindowedCounter a +insert x statusQuo@(WindowedCounter s lastLargest nominalSpan) + | maybe False (x <) lastLargest = + error $ + unwords + [ show x + , "is less than the current maximum of" + , show lastLargest <> "." + , "Insertions into the sliding window must monotonically increase!" + ] + | Just x == lastLargest = statusQuo + | otherwise = + discardGarbage x $ + WindowedCounter (Set.insert x s) (Just x) nominalSpan + +-- | Drop the leading elements that are not larger than the cutoff. +-- +-- This function is already called by the 'insert' function, so clients +-- no not necessarily every 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. +discardGarbage :: Integral a => a -> WindowedCounter a -> WindowedCounter a +discardGarbage currentTime (WindowedCounter s lastLargest nominalSpan) = + WindowedCounter larger lastLargest nominalSpan + where + (_smaller, larger) = Set.split (currentTime - nominalSpan) s diff --git a/swarm.cabal b/swarm.cabal index 0aec8d667a..087bb8235a 100644 --- a/swarm.cabal +++ b/swarm.cabal @@ -168,7 +168,9 @@ library Swarm.Language.Types Swarm.Language.Value Swarm.ReadableIORef - Swarm.TUI.Attr + Swarm.TUI.View.Attribute.CustomStyling + Swarm.TUI.View.Attribute.Attr + Swarm.TUI.View.Attribute.Util Swarm.TUI.Border Swarm.Game.Scenario.Topography.Area Swarm.TUI.Editor.Controller @@ -193,7 +195,6 @@ library Swarm.TUI.View Swarm.TUI.View.Achievement Swarm.TUI.View.CellDisplay - Swarm.TUI.View.CustomStyling Swarm.TUI.View.Objective Swarm.TUI.View.Util Swarm.Util @@ -201,6 +202,7 @@ library Swarm.Util.Erasable Swarm.Util.Lens Swarm.Util.Parse + Swarm.Util.WindowedCounter Swarm.Util.Yaml Swarm.Version Swarm.Web @@ -243,6 +245,7 @@ library mtl >= 2.2.2 && < 2.4, murmur3 >= 1.0.4 && < 1.1, natural-sort >= 0.1.2 && < 0.2, + palette >= 0.3 && < 0.4, parser-combinators >= 1.2 && < 1.4, prettyprinter >= 1.7.0 && < 1.8, random >= 1.2.0 && < 1.3,