locli & wb: table properties, field precisions, better rendering, Sum…

…mary computation & rendering

bench/locli/locli.cabal

@@ -77,6 +77,7 @@ library
 
                        Cardano.Analysis.BlockProp
                        Cardano.Analysis.MachPerf
+                       Cardano.Analysis.Summary
 
                        Cardano.JSON
                        Cardano.Org

bench/locli/src/Cardano/Analysis/API/Field.hs

@@ -85,6 +85,13 @@ data Width
   | W12
   deriving (Eq, Enum, Ord, Show)
 
+data Precision
+  = P0
+  | P1
+  | P2
+  | P3
+  deriving (Eq, Enum, Ord, Show)
+
 {-# INLINE width #-}
 width :: Width -> Int
 width = fromEnum
@@ -101,6 +108,7 @@ data Field (s :: (Type -> Type) -> k -> Type) (p :: Type -> Type) (a :: k)
   , fHead2       :: Text
   , fWidth       :: Width
   , fUnit        :: Unit
+  , fPrecision   :: Precision
   , fScale       :: Scale
   , fRange       :: Range
   , fSelect      :: s p a
@@ -145,6 +153,14 @@ mapField x cdfProj Field{..} =
     DFloat  (cdfProj . ($x) ->r) -> r
     DDeltaT (cdfProj . ($x) ->r) -> r
 
+mapFieldWithKey :: a p -> (forall v. Divisible v => Field DSelect p a -> CDF p v -> b) -> Field DSelect p a -> b
+mapFieldWithKey x cdfProj f@Field{..} =
+  case fSelect of
+    DInt    (cdfProj f . ($x) ->r) -> r
+    DWord64 (cdfProj f . ($x) ->r) -> r
+    DFloat  (cdfProj f . ($x) ->r) -> r
+    DDeltaT (cdfProj f . ($x) ->r) -> r
+
 tryOverlayFieldDescription :: Field DSelect p a -> Object -> Maybe Object
 tryOverlayFieldDescription Field{..} =
   alterSubObject (Just . overlayJSON [ ("description", String fDescription)

bench/locli/src/Cardano/Analysis/Summary.hs

@@ -0,0 +1,40 @@
+{-# LANGUAGE UndecidableInstances #-}
+{-# OPTIONS_GHC -Wno-name-shadowing -Wno-orphans #-}
+module Cardano.Analysis.Summary (module Cardano.Analysis.Summary) where
+
+import Cardano.Prelude          hiding (head)
+
+import Data.Map.Strict                  qualified as Map
+
+import Cardano.Analysis.API
+import Cardano.Unlog.LogObject
+
+
+computeSummary ::
+     UTCTime
+  -> [[LogObject]]
+  -> ([FilterName], [ChainFilter])
+  -> DataDomain SlotNo
+  -> DataDomain BlockNo
+  -> [BlockEvents]
+  -> Summary
+computeSummary sumWhen
+               objLists
+               sumFilters
+               sumDomainSlots
+               sumDomainBlocks
+               chainRejecta
+  =
+  Summary
+  { sumLogStreams          = countOfList  objLists
+  , sumLogObjects          = countOfLists objLists
+  , sumBlocksRejected      = countOfList chainRejecta
+  , ..
+  }
+ where
+   sumChainRejectionStats =
+     chainRejecta
+     <&> fmap fst . filter (not . snd) . beAcceptance
+      &  concat
+      &  foldr' (\k m -> Map.insertWith (+) k 1 m) Map.empty
+      &  Map.toList

bench/locli/src/Cardano/Command.hs

@@ -6,7 +6,6 @@ import Cardano.Prelude                  hiding (State, head)
 import Data.Aeson                       qualified as Aeson
 import Data.ByteString                  qualified as BS
 import Data.ByteString.Lazy.Char8       qualified as LBS
-import Data.Map.Strict                  qualified as Map
 import Data.Text                        (pack)
 import Data.Text                        qualified as T
 import Data.Text.Short                  (toText)
@@ -20,6 +19,7 @@ import System.Posix.Files               qualified as IO
 import Cardano.Analysis.API
 import Cardano.Analysis.BlockProp
 import Cardano.Analysis.MachPerf
+import Cardano.Analysis.Summary
 import Cardano.Render
 import Cardano.Report
 import Cardano.Unlog.LogObject          hiding (Text)
@@ -325,8 +325,8 @@ data State
   , sSummaries        :: Maybe [Summary]
   }
 
-computeSummary :: State -> Summary
-computeSummary =
+callComputeSummary :: State -> Either Text Summary
+callComputeSummary =
   \case
     State{sRun           = Nothing} -> err "a run"
     State{sObjLists      = Nothing} -> err "logobjects"
@@ -342,24 +342,11 @@ computeSummary =
          , sChainRejecta = Just chainRejecta
          , sDomSlots     = Just sumDomainSlots
          , sDomBlocks    = Just sumDomainBlocks
-         , ..} ->
-      Summary
-      { sumWhen                = sWhen
-      , sumFilters             = sFilters
-      , sumLogStreams          = countOfList  objLists
-      , sumLogObjects          = countOfLists objLists
-      , sumBlocksRejected      = countOfList chainRejecta
-      , ..
-      }
-     where
-       sumChainRejectionStats =
-         chainRejecta
-         <&> fmap fst . filter (not . snd) . beAcceptance
-          &  concat
-          &  foldr' (\k m -> Map.insertWith (+) k 1 m) Map.empty
-          &  Map.toList
+         , ..} -> Right $
+      computeSummary sWhen objLists sFilters
+                     sumDomainSlots sumDomainBlocks chainRejecta
  where
-   err = error . ("Summary of a run requires " <>)
+   err = Left . ("Summary of a run requires " <>)
 
 sRunAnchor :: State -> Anchor
 sRunAnchor State{sRun = Just run, sFilters, sWhen, sDomSlots, sDomBlocks}
@@ -664,16 +651,19 @@ runChainCommand s@State{sMultiClusterPerf=Just (MultiClusterPerf perf)}
 runChainCommand _ c@RenderMultiClusterPerf{} = missingCommandData c
   ["multi-run cluster preformance stats"]
 
-runChainCommand s ComputeSummary = do
+runChainCommand s c@ComputeSummary = do
   progress "summary" (Q "summarising a run")
-  pure s { sSummaries = Just [computeSummary s] }
+  summary <- pure (callComputeSummary s)
+    & newExceptT
+    & firstExceptT (CommandError c . show)
+  pure s { sSummaries = Just [summary] }
 
-runChainCommand s@State{sSummaries = Just (_summary:_)} c@(RenderSummary fmt f) = do
+runChainCommand s@State{sSummaries = Just (summary:_)} c@(RenderSummary fmt f) = do
   progress "summary" (Q $ printf "rendering summary")
   dumpText "summary" body (modeFilename f "" fmt)
     & firstExceptT (CommandError c)
   pure s
- where body = [""] -- renderSummary summary
+ where body = renderSummary fmt (sRunAnchor s) summary
 runChainCommand _ c@RenderSummary{} = missingCommandData c
   ["run summary"]
 

bench/locli/src/Cardano/Org.hs

@@ -5,6 +5,8 @@ module Cardano.Org (module Cardano.Org) where
 import Cardano.Prelude
 import Data.Text                qualified as T
 
+import Cardano.Util
+
 
 data Org
   = Props
@@ -21,6 +23,7 @@ data Org
     , tSummaryHeaders :: [Text]
     , tSummaryValues  :: [[Text]]
     , tFormula        :: [Text]
+    , tConstants      :: [(Text, Text)]
     }
   deriving (Show)
 
@@ -33,13 +36,18 @@ render Props{..} =
   <>
   (oBody <&> render & mconcat)
 
+render Table{tConstants = _:_, tExtended = False} =
+  error "Asked to render a non-extended Org table with an extended table feature:  named constants"
+
 render Table{..} =
-    tableHLine
-  : tableRow jusAllHeaders
-  : tableHLine
-  : fmap tableRow (transpose jusAllColumns)
+    renderTableHLine
+  : renderTableRow jusAllHeaders
+  : renderTableHLine
+  : fmap renderTableRow (transpose jusAllColumns)
   & flip (<>)
     jusAllSummaryLines
+  & flip (<>)
+    jusAllConstantLines
   & flip (<>)
     (bool [ "#+TBLFM:" <> (tFormula & T.intercalate "::") ] [] (null tFormula))
  where
@@ -57,37 +65,55 @@ render Table{..} =
    jusAllSummaryLines :: [Text]
    jusAllSummaryLines =
      if null tSummaryHeaders then [] else
-       tableHLine :
-       fmap tableRow (zipWith (:)
-                      (tSummaryHeaders <&> T.justifyRight rowHdrWidth ' ')
-                      (transpose (justifySourceColumns tSummaryValues))
-                       <&> consIfSpecial " ")
+       renderTableHLine :
+       fmap renderTableRow (zipWith (:)
+                            (tSummaryHeaders <&> T.justifyRight rowHdrWidth ' ')
+                            (transpose (justifySourceColumns tSummaryValues))
+                             <&> consIfSpecial (bool " " "#" tExtended))
+
+   justifySourceColumns :: [[Text]] -> [[Text]]
+   justifySourceColumns = zipWith (\w-> fmap (T.justifyRight w ' ')) colWidths
+
+   jusAllConstantLines :: [Text]
+   jusAllConstantLines =
+     if null tConstants then [] else
+       renderTableHLine :
+       fmap renderTableRow (zipWith (:)
+                             (cycle ["_", "#"])
+                             constRows)
+    where
+      constRows = (chunksOf nTotalColumns tConstants                                          -- we can fit so many definitions per row
+                   & mapLast (\row -> row <> replicate (nTotalColumns - length row) ("", "")) -- last row needs completion
+                   & fmap (`zip` allColWidths))                                               -- and we supply column widths for justification
+                  <&> transpose . fmap (\((name, value), w) ->                                -- each row -> row pair of justified [Name, Definition]
+                                          [ T.justifyRight w ' ' name
+                                          , T.justifyRight w ' ' value])
+                   & concat                                                                   -- merge into a single list of rows
 
-   rowHdrWidth :: Int
+   rowHdrWidth, nTotalColumns :: Int
    rowHdrWidth = maximum $ length <$> (maybeToList tApexHeader
                                        <> tRowHeaders
                                        <> tSummaryHeaders)
+   nTotalColumns = length allColWidths
 
-   justifySourceColumns :: [[Text]] -> [[Text]]
-   justifySourceColumns = zipWith (\w-> fmap (T.justifyRight w ' ')) colWidths
-
-   colWidths :: [Int]
+   colWidths, allColWidths :: [Int]
+   allColWidths = rowHdrWidth : colWidths
    colWidths = maximum . fmap length <$>
                (tColumns
                 & zipWith (:)  tColHeaders
                 & if null tSummaryValues then identity
                   else zipWith (<>) tSummaryValues)
 
    specialCol :: [Text]
-   specialCol = replicate (length tRowHeaders) "#"
+   specialCol = length tRowHeaders `replicate` "#"
 
    consIfSpecial :: a -> [a] -> [a]
    consIfSpecial x = bool  identity        (x:)  tExtended
 
-   tableRow :: [Text] -> Text
-   tableRow xs = "| " <> T.intercalate " | " xs <> " |"
-   tableHLine :: Text
-   tableHLine = ("|-" <>) . (<> "-|") . T.intercalate "-+-" . (flip T.replicate "-" <$>) $
-                rowHdrWidth
-                : colWidths
-                & consIfSpecial 1
+   renderTableRow :: [Text] -> Text
+   renderTableRow xs = "| " <> T.intercalate " | " xs <> " |"
+   renderTableHLine :: Text
+   renderTableHLine = ("|-" <>) . (<> "-|") . T.intercalate "-+-" . (flip T.replicate "-" <$>) $
+                      rowHdrWidth
+                      : colWidths
+                      & consIfSpecial 1

bench/locli/src/Cardano/Render.hs

@@ -53,6 +53,42 @@ renderFloatStr w = justifyData w'. T.take w' . T.pack . stripLeadingZero
      '0':xs@('.':_) -> xs
      xs -> xs
 
+renderSummary :: RenderFormat -> Anchor -> Summary -> [Text]
+renderSummary AsJSON _ x = (:[]) . LT.toStrict $ encodeToLazyText x
+renderSummary AsGnuplot _ _ = error "renderSummary:  output not supported:  gnuplot"
+renderSummary AsPretty  _ _ = error "renderSummary:  output not supported:  pretty"
+renderSummary _ a Summary{..} =
+  render $
+  Props
+  { oProps = [ ("TITLE",    renderAnchorRuns a )
+             , ("SUBTITLE", renderAnchorFiltersAndDomains a)
+             , ("DATE",     renderAnchorDate a)
+             , ("VERSION",  renderProgramAndVersion (aVersion a))
+             ]
+  , oConstants = []
+  , oBody = (:[]) $
+    Table
+    { tColHeaders     = ["Value"]
+    , tExtended       = False
+    , tApexHeader     = Just "Property"
+    , tColumns        = [kvs <&> snd]
+    , tRowHeaders     =  kvs <&> fst
+    , tSummaryHeaders = []
+    , tSummaryValues  = []
+    , tFormula = []
+    , tConstants = []
+    }
+  }
+ where
+   kvs = [ ("Date",              showText $ sumWhen)
+         , ("Machines",          showText $ sumLogStreams)
+         , ("Log objects",       showText $ sumLogObjects)
+         , ("Slots considered",  showText $ ddFilteredCount sumDomainSlots)
+         , ("Blocks considered", showText $ ddFilteredCount sumDomainBlocks)
+         , ("Blocks dropped",    showText $ sumBlocksRejected)
+         ]
+
+
 renderTimeline :: forall (a :: Type). TimelineFields a => Run -> (Field ISelect I a -> Bool) -> [TimelineComments a] -> [a] -> [Text]
 renderTimeline run flt comments xs =
   concatMap (uncurry fLine) $ zip xs [(0 :: Int)..]
@@ -136,7 +172,7 @@ data RenderFormat
   | AsOrg
   | AsReport
   | AsPretty
-  deriving (Show, Bounded, Enum)
+  deriving (Eq, Show, Bounded, Enum)
 
 -- | When rendering a CDF-of-CDFs _and_ subsetting the data, how to subset:
 data CDF2Aspect
@@ -196,6 +232,7 @@ renderAnalysisCDFs a@Anchor{..} fieldSelr _c2a centileSelr AsOrg x =
                           \f@Field{}   -> mapField x (T.pack . printf "%d" . cdfSize) f
                         ] & transpose
     , tFormula = []
+    , tConstants = []
     }
   }
  where
@@ -230,40 +267,44 @@ renderAnalysisCDFs a@Anchor{..} fieldSelr aspect _centileSelr AsReport x =
     , tColumns        = transpose $
                         fields <&>
                         fmap (T.take 6 . T.pack . printf "%f")
-                        . mapField x (snd hdrsProjs)
+                        . mapFieldWithKey x (snd hdrsProjs)
     , tRowHeaders     = fields <&> fShortDesc
     , tSummaryHeaders = []
     , tSummaryValues  = []
     , tFormula = []
+    , tConstants = [("nSamples",
+                     fields <&> mapField x (T.pack . show . cdfSize) & head)]
     }
   }
  where
    fields :: [Field DSelect p a]
    fields = filter fieldSelr cdfFields
 
-   hdrsProjs :: forall v. (Divisible v) => ([Text], CDF p v -> [Double])
+   hdrsProjs :: forall v. (Divisible v) => ([Text], Field DSelect p a -> CDF p v -> [Double])
    hdrsProjs = aspectColHeadersAndProjections aspect
 
    aspectColHeadersAndProjections :: forall v. (Divisible v)
-                                  => CDF2Aspect -> ([Text], CDF p v -> [Double])
+                                  => CDF2Aspect -> ([Text], Field DSelect p a -> CDF p v -> [Double])
    aspectColHeadersAndProjections = \case
      OfOverallDataset ->
        (,)
-       ["average", "CoV", "min", "max", "stddev", "range", "size"]
-       \c@CDF{cdfRange=(cdfMin, cdfMax), ..} ->
+       ["average", "CoV", "min", "max", "stddev", "range", "precision", "size"]
+       \Field{..} c@CDF{cdfRange=(cdfMin, cdfMax), ..} ->
          let avg = cdfAverageVal c & toDouble in
          [ avg
          , cdfStddev / avg
          , fromRational . toRational $ cdfMin
          , fromRational . toRational $ cdfMax
          , cdfStddev
          , fromRational . toRational $ cdfMax - cdfMin
+         , fromIntegral $ fromEnum fPrecision
          , fromIntegral cdfSize
          ]
      OfInterCDF ->
        (,)
-       ["average", "CoV", "min", "max", "stddev", "range", "size"]
-       (cdfArity
+       ["average", "CoV", "min", "max", "stddev", "range", "precision", "size"]
+       (\Field{..} ->
+        cdfArity
          (error "Cannot do inter-CDF statistics on plain CDFs")
          (\CDF{cdfAverage=cdfAvg@CDF{cdfRange=(minAvg, maxAvg),..}} ->
              let avg = cdfAverageVal cdfAvg & toDouble in
@@ -273,6 +314,7 @@ renderAnalysisCDFs a@Anchor{..} fieldSelr aspect _centileSelr AsReport x =
              , toDouble maxAvg
              , cdfStddev
              , toDouble $ maxAvg - minAvg
+             , fromIntegral $ fromEnum fPrecision
              , fromIntegral cdfSize
              ]))