Compute and display activity ratio

data/scenarios/Testing/1341-command-count.yaml

@@ -1,7 +1,9 @@
 version: 1
 name: Count commands
+creative: true
 description: |
-  Count commands
+  Count commands and demonstrate various "duty cycles"
+  with system robots.
 objectives:
   - goal:
     - |
@@ -31,6 +33,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 +93,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

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)
 
@@ -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,7 @@ mkRobot rid pid name descr loc dir disp m devs inv sys heavy ts =
           , _tangibleCommandCount = 0
           , _commandsHistogram = mempty
           , _lifetimeStepCount = 0
+          , _activityWindow = mkWindow 32
           }
     , _runningAtomic = False
     }

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 ::

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)

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)
 

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
 

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

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,20 @@ 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
+          [ "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 +639,7 @@ robotsListWidget s = hCenter table
     , "Actions"
     , "Commands"
     , "Cycles"
+    , "Activity"
     , "Log"
     ]
   headers = withAttr robotAttr . txt <$> applyWhen cheat ("ID" :) headings
@@ -646,10 +656,28 @@ robotsListWidget s = hCenter table
       , str $ show $ robot ^. activityCounts . tangibleCommandCount
       , 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

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

src/Swarm/TUI/Attr.hs → 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
+    $ meterAttributes
+      <> worldAttributes
       <> [(waterAttr, V.white `on` V.blue)]
       <> terrainAttr
       <> [ -- Robot attribute
@@ -134,6 +138,22 @@ worldAttributes =
         , ("blue", V.blue)
         ]
 
+worldAttributeNames :: [AttrName]
+worldAttributeNames = map fst worldAttributes
+
+meterPrefix :: AttrName
+meterPrefix = attrName "meter"
+
+meterAttributes :: [(AttrName, V.Attr)]
+meterAttributes =
+  bimap ((meterPrefix <>) . attrName . show) bgWithAutoForeground
+    <$> zip [0 :: Int ..] brewers
+ where
+  brewers = reverse $ brewerSet RdYlGn 5
+
+meterAttributeNames :: [AttrName]
+meterAttributeNames = map fst meterAttributes
+
 terrainPrefix :: AttrName
 terrainPrefix = attrName "terrain"