Additional data extraction from simulation traces (#399)

* Implemented extraction of CPU info from traces
* Implemented resource extraction from traces
* Implemented receipts analysis for simulation tracing
* Updated logbook
* Tidied haskell code formatting.
* Added trace processor to CI

Author: bwbush

.github/workflows/simulation.yaml

@@ -7,6 +7,7 @@ on:
       - "data/**"
       - "simulation/**"
       - "leios-trace-hs/**"
+      - "analysis/sims/trace-processor/**"
   push:
     branches:
       - main
@@ -15,6 +16,7 @@ on:
       - "data/**"
       - "simulation/**"
       - "leios-trace-hs/**"
+      - "analysis/sims/trace-processor/**"
 
 jobs:
   simulation-test:

Logbook.md

@@ -1,5 +1,31 @@
 # Leios logbook
 
+## 2025-06-11
+
+### Additional data analyses in Leios trace processor
+
+The [`leios-trace-processor`](analysis/sims/trace-processor/) now extracts CPU, resource, and message-receipt data from simulation trace files. This eliminates the need for using the old, lower performance, scripts for analyzing simulation results.
+
+```console
+$ cabal run exe:leios-trace-processor -- --help
+
+Process Leios trace logs into CSV file abstracts
+
+Usage: leios-trace-processor [--trace-file FILE] --lifecycle-file FILE
+                             --cpu-file FILE --resource-file FILE
+                             --receipt-file FILE
+
+  Leios trace processor
+
+Available options:
+  --trace-file FILE        Input Leios simulation trace log file
+  --lifecycle-file FILE    Output CSV file for transaction lifecycle data
+  --cpu-file FILE          Output CSV file for CPU data
+  --resource-file FILE     Output CSV file for resource data
+  --receipt-file FILE      Output CSV file for receipt data
+  -h,--help                Show this help text
+```
+
 ## 2025-06-09
 
 ### Fixes to CI

analysis/sims/trace-processor/app/Main.hs

@@ -13,11 +13,14 @@ main :: IO ()
 main =
   do
     Command{..} <- O.execParser commandParser
-    process logFile lifecycleFile
+    process logFile lifecycleFile cpuFile resourceFile receiptFile
 
 data Command = Command
   { logFile :: FilePath
   , lifecycleFile :: FilePath
+  , cpuFile :: FilePath
+  , resourceFile :: FilePath
+  , receiptFile :: FilePath
   }
   deriving (Eq, Ord, Read, Show)
 
@@ -32,3 +35,6 @@ commandParser =
     Command
       <$> O.strOption (O.long "trace-file" <> O.metavar "FILE" <> O.value "/dev/stdin" <> O.help "Input Leios simulation trace log file")
       <*> O.strOption (O.long "lifecycle-file" <> O.metavar "FILE" <> O.help "Output CSV file for transaction lifecycle data")
+      <*> O.strOption (O.long "cpu-file" <> O.metavar "FILE" <> O.help "Output CSV file for CPU data")
+      <*> O.strOption (O.long "resource-file" <> O.metavar "FILE" <> O.help "Output CSV file for resource data")
+      <*> O.strOption (O.long "receipt-file" <> O.metavar "FILE" <> O.help "Output CSV file for receipt data")

analysis/sims/trace-processor/src/Leios/Tracing/Cpu.hs

@@ -0,0 +1,114 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE StrictData #-}
+{-# LANGUAGE TupleSections #-}
+
+module Leios.Tracing.Cpu (
+  cpu,
+) where
+
+import Control.Concurrent.Chan (Chan, readChan)
+import Control.Monad.IO.Class (liftIO)
+import Control.Monad.State.Strict (StateT, execStateT, modify')
+import Data.Aeson (Value (Object), withObject, (.:))
+import Data.Aeson.Types (Parser, parseMaybe)
+import Data.Function (on)
+import Data.List (intercalate)
+import Data.Map.Strict (Map)
+import Data.Monoid (Sum (..))
+import Data.Text (Text)
+
+import qualified Data.Map.Strict as M (insertWith, toList)
+import qualified Data.Text as T (unpack)
+
+data ItemKey
+  = ItemKey
+  { slot :: Int
+  , node :: Text
+  , task :: Text
+  }
+  deriving (Eq, Ord, Show)
+
+newtype ItemInfo = ItemInfo {duration :: Sum Double}
+  deriving (Show)
+
+instance Semigroup ItemInfo where
+  x <> y =
+    ItemInfo
+      { duration = on (<>) duration x y
+      }
+
+instance Monoid ItemInfo where
+  mempty = ItemInfo{duration = mempty}
+
+toCSV :: ItemKey -> ItemInfo -> String
+toCSV ItemKey{..} ItemInfo{..} =
+  intercalate
+    sep
+    [ show slot
+    , T.unpack node
+    , T.unpack task
+    , show $ getSum duration
+    ]
+
+itemHeader :: String
+itemHeader =
+  intercalate
+    sep
+    [ "Slot"
+    , "Node"
+    , "Task"
+    , "Duration [s]"
+    ]
+
+sep :: String
+sep = ","
+
+parseEvent :: Value -> Parser (ItemKey, ItemInfo)
+parseEvent =
+  withObject "TraceEvent" $ \event ->
+    do
+      time <- event .: "time_s"
+      message <- event .: "message"
+      typ <- message .: "type"
+      parseMessage typ time $ Object message
+
+parseMessage :: Text -> Double -> Value -> Parser (ItemKey, ItemInfo)
+parseMessage "Cpu" created =
+  withObject "Cpu" $ \message ->
+    do
+      let slot = floor created
+      node <- message .: "node"
+      task <- message .: "task_type"
+      duration <- message .: "cpu_time_s"
+      pure (ItemKey{..}, mempty{duration})
+parseMessage _ _ =
+  const $ fail "Ignore"
+
+type Index = Map ItemKey ItemInfo
+
+tally :: Monad m => Value -> StateT Index m ()
+tally event =
+  case parseMaybe parseEvent event of
+    Just (itemKey, itemInfo) ->
+      do
+        -- Insert the generated items.
+        modify' $ M.insertWith (<>) itemKey itemInfo
+    Nothing -> pure ()
+
+cpu :: FilePath -> Chan (Maybe Value) -> IO ()
+cpu cpuFile events =
+  do
+    let
+      go =
+        do
+          liftIO (readChan events)
+            >>= \case
+              Nothing -> pure ()
+              Just event -> tally event >> go
+    index <- go `execStateT` mempty
+    writeFile cpuFile . unlines . (itemHeader :) $
+      uncurry toCSV <$> M.toList index

analysis/sims/trace-processor/src/Leios/Tracing/Lifecycle.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
@@ -9,44 +10,24 @@ module Leios.Tracing.Lifecycle (
   lifecycle,
 ) where
 
+import Control.Concurrent.Chan (Chan, readChan)
 import Control.Monad ((<=<))
-import Control.Monad.State.Strict (State, execState, gets, modify')
-import Data.Aeson (FromJSON (..), Value (Object), withObject, (.:))
+import Control.Monad.IO.Class (liftIO)
+import Control.Monad.State.Strict (StateT, execStateT, gets, modify')
+import Data.Aeson (Value (Object), withObject, (.:))
 import Data.Aeson.Types (Parser, parseMaybe)
 import Data.Function (on)
 import Data.List (intercalate)
 import Data.Map.Strict (Map)
 import Data.Monoid (Sum (..))
 import Data.Set (Set)
 import Data.Text (Text)
+import Leios.Tracing.Util (Minimum (..))
 
 import qualified Data.Map.Strict as M (elems, fromList, insertWith, restrictKeys, toList, unionWith)
 import qualified Data.Set as S (map, singleton)
 import qualified Data.Text as T (unpack)
 
-newtype Earliest a = Earliest {getEarliest :: Maybe a}
-  deriving (Show)
-
-instance Eq a => Eq (Earliest a) where
-  Earliest (Just x) == Earliest (Just y) = x == y
-  Earliest Nothing == Earliest Nothing = True
-  _ == _ = False
-
-instance Ord a => Ord (Earliest a) where
-  Earliest (Just x) `compare` Earliest (Just y) = x `compare` y
-  Earliest (Just _) `compare` Earliest Nothing = LT
-  Earliest Nothing `compare` Earliest (Just _) = GT
-  Earliest Nothing `compare` Earliest Nothing = EQ
-
-instance Ord a => Semigroup (Earliest a) where
-  x <> y = if x < y then x else y
-
-instance Ord a => Monoid (Earliest a) where
-  mempty = Earliest Nothing
-
-instance FromJSON a => FromJSON (Earliest a) where
-  parseJSON = fmap Earliest . parseJSON
-
 data ItemKey
   = ItemKey
   { kind :: Text
@@ -56,13 +37,13 @@ data ItemKey
 
 data ItemInfo
   = ItemInfo
-  { size :: Earliest Int
+  { size :: Minimum Int
   , references :: Sum Int
-  , created :: Earliest Double
-  , toIB :: Earliest Double
-  , toEB :: Earliest Double
-  , toRB :: Earliest Double
-  , inRB :: Earliest Double
+  , created :: Minimum Double
+  , toIB :: Minimum Double
+  , toEB :: Minimum Double
+  , toRB :: Minimum Double
+  , inRB :: Minimum Double
   , inIBs :: Set Text
   , inEBs :: Set Text
   }
@@ -102,13 +83,13 @@ toCSV ItemKey{..} ItemInfo{..} =
     sep
     [ T.unpack kind
     , T.unpack item
-    , maybe "NA" show $ getEarliest size
+    , show size
     , show $ getSum references
-    , maybe "NA" show $ getEarliest created
-    , maybe "NA" show $ getEarliest toIB
-    , maybe "NA" show $ getEarliest toEB
-    , maybe "NA" show $ getEarliest toRB
-    , maybe "NA" show $ getEarliest inRB
+    , show created
+    , show toIB
+    , show toEB
+    , show toRB
+    , show inRB
     ]
 
 itemHeader :: String
@@ -133,13 +114,13 @@ parseEvent :: Value -> Parser (ItemKey, ItemInfo, Index)
 parseEvent =
   withObject "TraceEvent" $ \event ->
     do
-      time <- Earliest <$> event .: "time_s"
+      time <- Minimum <$> event .: "time_s"
       message <- event .: "message"
       typ <- message .: "type"
       ident <- message .: "id"
       parseMessage typ ident time $ Object message
 
-parseMessage :: Text -> Text -> Earliest Double -> Value -> Parser (ItemKey, ItemInfo, Index)
+parseMessage :: Text -> Text -> Minimum Double -> Value -> Parser (ItemKey, ItemInfo, Index)
 parseMessage "TXGenerated" item created =
   withObject "TXGenerated" $ \message ->
     do
@@ -174,7 +155,7 @@ parseMessage _ _ _ =
 
 type Index = Map ItemKey ItemInfo
 
-tally :: Value -> State Index ()
+tally :: Monad m => Value -> StateT Index m ()
 tally event =
   case parseMaybe parseEvent event of
     Just (itemKey, itemInfo, updates) ->
@@ -185,7 +166,7 @@ tally event =
         modify' $ M.unionWith (<>) updates
     Nothing -> pure ()
 
-updateInclusions :: Text -> ItemKey -> Set Text -> State Index ()
+updateInclusions :: Monad m => Text -> ItemKey -> Set Text -> StateT Index m ()
 updateInclusions kind itemKey includers =
   do
     includers' <- gets $ M.elems . (`M.restrictKeys` S.map (ItemKey kind) includers)
@@ -198,24 +179,30 @@ updateInclusions kind itemKey includers =
           , toRB = mconcat $ toRB <$> includers'
           }
 
-updateEBs :: ItemKey -> ItemInfo -> State Index ()
+updateEBs :: Monad m => ItemKey -> ItemInfo -> StateT Index m ()
 updateEBs itemKey = updateInclusions "EB" itemKey . inEBs
 
-updateIBs :: ItemKey -> ItemInfo -> State Index ()
+updateIBs :: Monad m => ItemKey -> ItemInfo -> StateT Index m ()
 updateIBs itemKey = updateInclusions "IB" itemKey . inIBs
 
-lifecycle :: FilePath -> [Value] -> IO ()
+lifecycle :: FilePath -> Chan (Maybe Value) -> IO ()
 lifecycle lifecycleFile events =
-  let
-    index =
-      (`execState` mempty) $
+  do
+    let
+      go =
+        do
+          liftIO (readChan events)
+            >>= \case
+              Nothing -> pure ()
+              Just event -> tally event >> go
+    index <-
+      (`execStateT` mempty) $
         do
           -- Compute the direct metrics from the traces.
-          mapM_ tally events
+          go
           -- Update arrival in EBs and RBs for IBs.
           mapM_ (uncurry updateEBs) =<< gets M.toList
           -- Update arrival in EBs and RBs for TXs.
           mapM_ (uncurry updateIBs) =<< gets M.toList
-   in
     writeFile lifecycleFile . unlines . (itemHeader :) $
       uncurry toCSV <$> M.toList index