Skip to content

Commit 5245077

Browse files
deepfiredeepfire
committed
locli & wb: table properties, field precisions, better rendering, Summary computation & rendering
1 parent 2a30453 commit 5245077

File tree

13 files changed

+328
-159
lines changed

13 files changed

+328
-159
lines changed

‎bench/locli/locli.cabal

+1
Original file line numberDiff line numberDiff line change
@@ -77,6 +77,7 @@ library
7777

7878
Cardano.Analysis.BlockProp
7979
Cardano.Analysis.MachPerf
80+
Cardano.Analysis.Summary
8081

8182
Cardano.JSON
8283
Cardano.Org

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

+16
Original file line numberDiff line numberDiff line change
@@ -85,6 +85,13 @@ data Width
8585
| W12
8686
deriving (Eq, Enum, Ord, Show)
8787

88+
data Precision
89+
= P0
90+
| P1
91+
| P2
92+
| P3
93+
deriving (Eq, Enum, Ord, Show)
94+
8895
{-# INLINE width #-}
8996
width :: Width -> Int
9097
width = fromEnum
@@ -101,6 +108,7 @@ data Field (s :: (Type -> Type) -> k -> Type) (p :: Type -> Type) (a :: k)
101108
, fHead2 :: Text
102109
, fWidth :: Width
103110
, fUnit :: Unit
111+
, fPrecision :: Precision
104112
, fScale :: Scale
105113
, fRange :: Range
106114
, fSelect :: s p a
@@ -145,6 +153,14 @@ mapField x cdfProj Field{..} =
145153
DFloat (cdfProj . ($x) ->r) -> r
146154
DDeltaT (cdfProj . ($x) ->r) -> r
147155

156+
mapFieldWithKey :: a p -> (forall v. Divisible v => Field DSelect p a -> CDF p v -> b) -> Field DSelect p a -> b
157+
mapFieldWithKey x cdfProj f@Field{..} =
158+
case fSelect of
159+
DInt (cdfProj f . ($x) ->r) -> r
160+
DWord64 (cdfProj f . ($x) ->r) -> r
161+
DFloat (cdfProj f . ($x) ->r) -> r
162+
DDeltaT (cdfProj f . ($x) ->r) -> r
163+
148164
tryOverlayFieldDescription :: Field DSelect p a -> Object -> Maybe Object
149165
tryOverlayFieldDescription Field{..} =
150166
alterSubObject (Just . overlayJSON [ ("description", String fDescription)

‎bench/locli/src/Cardano/Analysis/API/Metrics.hs

+65-66
Large diffs are not rendered by default.

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

+40
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,40 @@
1+
{-# LANGUAGE UndecidableInstances #-}
2+
{-# OPTIONS_GHC -Wno-name-shadowing -Wno-orphans #-}
3+
module Cardano.Analysis.Summary (module Cardano.Analysis.Summary) where
4+
5+
import Cardano.Prelude hiding (head)
6+
7+
import Data.Map.Strict qualified as Map
8+
9+
import Cardano.Analysis.API
10+
import Cardano.Unlog.LogObject
11+
12+
13+
computeSummary ::
14+
UTCTime
15+
-> [[LogObject]]
16+
-> ([FilterName], [ChainFilter])
17+
-> DataDomain SlotNo
18+
-> DataDomain BlockNo
19+
-> [BlockEvents]
20+
-> Summary
21+
computeSummary sumWhen
22+
objLists
23+
sumFilters
24+
sumDomainSlots
25+
sumDomainBlocks
26+
chainRejecta
27+
=
28+
Summary
29+
{ sumLogStreams = countOfList objLists
30+
, sumLogObjects = countOfLists objLists
31+
, sumBlocksRejected = countOfList chainRejecta
32+
, ..
33+
}
34+
where
35+
sumChainRejectionStats =
36+
chainRejecta
37+
<&> fmap fst . filter (not . snd) . beAcceptance
38+
& concat
39+
& foldr' (\k m -> Map.insertWith (+) k 1 m) Map.empty
40+
& Map.toList

‎bench/locli/src/Cardano/Command.hs

+14-24
Original file line numberDiff line numberDiff line change
@@ -6,7 +6,6 @@ import Cardano.Prelude hiding (State, head)
66
import Data.Aeson qualified as Aeson
77
import Data.ByteString qualified as BS
88
import Data.ByteString.Lazy.Char8 qualified as LBS
9-
import Data.Map.Strict qualified as Map
109
import Data.Text (pack)
1110
import Data.Text qualified as T
1211
import Data.Text.Short (toText)
@@ -20,6 +19,7 @@ import System.Posix.Files qualified as IO
2019
import Cardano.Analysis.API
2120
import Cardano.Analysis.BlockProp
2221
import Cardano.Analysis.MachPerf
22+
import Cardano.Analysis.Summary
2323
import Cardano.Render
2424
import Cardano.Report
2525
import Cardano.Unlog.LogObject hiding (Text)
@@ -325,8 +325,8 @@ data State
325325
, sSummaries :: Maybe [Summary]
326326
}
327327

328-
computeSummary :: State -> Summary
329-
computeSummary =
328+
callComputeSummary :: State -> Either Text Summary
329+
callComputeSummary =
330330
\case
331331
State{sRun = Nothing} -> err "a run"
332332
State{sObjLists = Nothing} -> err "logobjects"
@@ -342,24 +342,11 @@ computeSummary =
342342
, sChainRejecta = Just chainRejecta
343343
, sDomSlots = Just sumDomainSlots
344344
, sDomBlocks = Just sumDomainBlocks
345-
, ..} ->
346-
Summary
347-
{ sumWhen = sWhen
348-
, sumFilters = sFilters
349-
, sumLogStreams = countOfList objLists
350-
, sumLogObjects = countOfLists objLists
351-
, sumBlocksRejected = countOfList chainRejecta
352-
, ..
353-
}
354-
where
355-
sumChainRejectionStats =
356-
chainRejecta
357-
<&> fmap fst . filter (not . snd) . beAcceptance
358-
& concat
359-
& foldr' (\k m -> Map.insertWith (+) k 1 m) Map.empty
360-
& Map.toList
345+
, ..} -> Right $
346+
computeSummary sWhen objLists sFilters
347+
sumDomainSlots sumDomainBlocks chainRejecta
361348
where
362-
err = error . ("Summary of a run requires " <>)
349+
err = Left . ("Summary of a run requires " <>)
363350

364351
sRunAnchor :: State -> Anchor
365352
sRunAnchor State{sRun = Just run, sFilters, sWhen, sDomSlots, sDomBlocks}
@@ -664,16 +651,19 @@ runChainCommand s@State{sMultiClusterPerf=Just (MultiClusterPerf perf)}
664651
runChainCommand _ c@RenderMultiClusterPerf{} = missingCommandData c
665652
["multi-run cluster preformance stats"]
666653

667-
runChainCommand s ComputeSummary = do
654+
runChainCommand s c@ComputeSummary = do
668655
progress "summary" (Q "summarising a run")
669-
pure s { sSummaries = Just [computeSummary s] }
656+
summary <- pure (callComputeSummary s)
657+
& newExceptT
658+
& firstExceptT (CommandError c . show)
659+
pure s { sSummaries = Just [summary] }
670660

671-
runChainCommand s@State{sSummaries = Just (_summary:_)} c@(RenderSummary fmt f) = do
661+
runChainCommand s@State{sSummaries = Just (summary:_)} c@(RenderSummary fmt f) = do
672662
progress "summary" (Q $ printf "rendering summary")
673663
dumpText "summary" body (modeFilename f "" fmt)
674664
& firstExceptT (CommandError c)
675665
pure s
676-
where body = [""] -- renderSummary summary
666+
where body = renderSummary fmt (sRunAnchor s) summary
677667
runChainCommand _ c@RenderSummary{} = missingCommandData c
678668
["run summary"]
679669

‎bench/locli/src/Cardano/Org.hs

+48-22
Original file line numberDiff line numberDiff line change
@@ -5,6 +5,8 @@ module Cardano.Org (module Cardano.Org) where
55
import Cardano.Prelude
66
import Data.Text qualified as T
77

8+
import Cardano.Util
9+
810

911
data Org
1012
= Props
@@ -21,6 +23,7 @@ data Org
2123
, tSummaryHeaders :: [Text]
2224
, tSummaryValues :: [[Text]]
2325
, tFormula :: [Text]
26+
, tConstants :: [(Text, Text)]
2427
}
2528
deriving (Show)
2629

@@ -33,13 +36,18 @@ render Props{..} =
3336
<>
3437
(oBody <&> render & mconcat)
3538

39+
render Table{tConstants = _:_, tExtended = False} =
40+
error "Asked to render a non-extended Org table with an extended table feature: named constants"
41+
3642
render Table{..} =
37-
tableHLine
38-
: tableRow jusAllHeaders
39-
: tableHLine
40-
: fmap tableRow (transpose jusAllColumns)
43+
renderTableHLine
44+
: renderTableRow jusAllHeaders
45+
: renderTableHLine
46+
: fmap renderTableRow (transpose jusAllColumns)
4147
& flip (<>)
4248
jusAllSummaryLines
49+
& flip (<>)
50+
jusAllConstantLines
4351
& flip (<>)
4452
(bool [ "#+TBLFM:" <> (tFormula & T.intercalate "::") ] [] (null tFormula))
4553
where
@@ -57,37 +65,55 @@ render Table{..} =
5765
jusAllSummaryLines :: [Text]
5866
jusAllSummaryLines =
5967
if null tSummaryHeaders then [] else
60-
tableHLine :
61-
fmap tableRow (zipWith (:)
62-
(tSummaryHeaders <&> T.justifyRight rowHdrWidth ' ')
63-
(transpose (justifySourceColumns tSummaryValues))
64-
<&> consIfSpecial " ")
68+
renderTableHLine :
69+
fmap renderTableRow (zipWith (:)
70+
(tSummaryHeaders <&> T.justifyRight rowHdrWidth ' ')
71+
(transpose (justifySourceColumns tSummaryValues))
72+
<&> consIfSpecial (bool " " "#" tExtended))
73+
74+
justifySourceColumns :: [[Text]] -> [[Text]]
75+
justifySourceColumns = zipWith (\w-> fmap (T.justifyRight w ' ')) colWidths
76+
77+
jusAllConstantLines :: [Text]
78+
jusAllConstantLines =
79+
if null tConstants then [] else
80+
renderTableHLine :
81+
fmap renderTableRow (zipWith (:)
82+
(cycle ["_", "#"])
83+
constRows)
84+
where
85+
constRows = (chunksOf nTotalColumns tConstants -- we can fit so many definitions per row
86+
& mapLast (\row -> row <> replicate (nTotalColumns - length row) ("", "")) -- last row needs completion
87+
& fmap (`zip` allColWidths)) -- and we supply column widths for justification
88+
<&> transpose . fmap (\((name, value), w) -> -- each row -> row pair of justified [Name, Definition]
89+
[ T.justifyRight w ' ' name
90+
, T.justifyRight w ' ' value])
91+
& concat -- merge into a single list of rows
6592

66-
rowHdrWidth :: Int
93+
rowHdrWidth, nTotalColumns :: Int
6794
rowHdrWidth = maximum $ length <$> (maybeToList tApexHeader
6895
<> tRowHeaders
6996
<> tSummaryHeaders)
97+
nTotalColumns = length allColWidths
7098

71-
justifySourceColumns :: [[Text]] -> [[Text]]
72-
justifySourceColumns = zipWith (\w-> fmap (T.justifyRight w ' ')) colWidths
73-
74-
colWidths :: [Int]
99+
colWidths, allColWidths :: [Int]
100+
allColWidths = rowHdrWidth : colWidths
75101
colWidths = maximum . fmap length <$>
76102
(tColumns
77103
& zipWith (:) tColHeaders
78104
& if null tSummaryValues then identity
79105
else zipWith (<>) tSummaryValues)
80106

81107
specialCol :: [Text]
82-
specialCol = replicate (length tRowHeaders) "#"
108+
specialCol = length tRowHeaders `replicate` "#"
83109

84110
consIfSpecial :: a -> [a] -> [a]
85111
consIfSpecial x = bool identity (x:) tExtended
86112

87-
tableRow :: [Text] -> Text
88-
tableRow xs = "| " <> T.intercalate " | " xs <> " |"
89-
tableHLine :: Text
90-
tableHLine = ("|-" <>) . (<> "-|") . T.intercalate "-+-" . (flip T.replicate "-" <$>) $
91-
rowHdrWidth
92-
: colWidths
93-
& consIfSpecial 1
113+
renderTableRow :: [Text] -> Text
114+
renderTableRow xs = "| " <> T.intercalate " | " xs <> " |"
115+
renderTableHLine :: Text
116+
renderTableHLine = ("|-" <>) . (<> "-|") . T.intercalate "-+-" . (flip T.replicate "-" <$>) $
117+
rowHdrWidth
118+
: colWidths
119+
& consIfSpecial 1

‎bench/locli/src/Cardano/Render.hs

+50-8
Original file line numberDiff line numberDiff line change
@@ -53,6 +53,42 @@ renderFloatStr w = justifyData w'. T.take w' . T.pack . stripLeadingZero
5353
'0':xs@('.':_) -> xs
5454
xs -> xs
5555

56+
renderSummary :: RenderFormat -> Anchor -> Summary -> [Text]
57+
renderSummary AsJSON _ x = (:[]) . LT.toStrict $ encodeToLazyText x
58+
renderSummary AsGnuplot _ _ = error "renderSummary: output not supported: gnuplot"
59+
renderSummary AsPretty _ _ = error "renderSummary: output not supported: pretty"
60+
renderSummary _ a Summary{..} =
61+
render $
62+
Props
63+
{ oProps = [ ("TITLE", renderAnchorRuns a )
64+
, ("SUBTITLE", renderAnchorFiltersAndDomains a)
65+
, ("DATE", renderAnchorDate a)
66+
, ("VERSION", renderProgramAndVersion (aVersion a))
67+
]
68+
, oConstants = []
69+
, oBody = (:[]) $
70+
Table
71+
{ tColHeaders = ["Value"]
72+
, tExtended = False
73+
, tApexHeader = Just "Property"
74+
, tColumns = [kvs <&> snd]
75+
, tRowHeaders = kvs <&> fst
76+
, tSummaryHeaders = []
77+
, tSummaryValues = []
78+
, tFormula = []
79+
, tConstants = []
80+
}
81+
}
82+
where
83+
kvs = [ ("Date", showText $ sumWhen)
84+
, ("Machines", showText $ sumLogStreams)
85+
, ("Log objects", showText $ sumLogObjects)
86+
, ("Slots considered", showText $ ddFilteredCount sumDomainSlots)
87+
, ("Blocks considered", showText $ ddFilteredCount sumDomainBlocks)
88+
, ("Blocks dropped", showText $ sumBlocksRejected)
89+
]
90+
91+
5692
renderTimeline :: forall (a :: Type). TimelineFields a => Run -> (Field ISelect I a -> Bool) -> [TimelineComments a] -> [a] -> [Text]
5793
renderTimeline run flt comments xs =
5894
concatMap (uncurry fLine) $ zip xs [(0 :: Int)..]
@@ -136,7 +172,7 @@ data RenderFormat
136172
| AsOrg
137173
| AsReport
138174
| AsPretty
139-
deriving (Show, Bounded, Enum)
175+
deriving (Eq, Show, Bounded, Enum)
140176

141177
-- | When rendering a CDF-of-CDFs _and_ subsetting the data, how to subset:
142178
data CDF2Aspect
@@ -196,6 +232,7 @@ renderAnalysisCDFs a@Anchor{..} fieldSelr _c2a centileSelr AsOrg x =
196232
\f@Field{} -> mapField x (T.pack . printf "%d" . cdfSize) f
197233
] & transpose
198234
, tFormula = []
235+
, tConstants = []
199236
}
200237
}
201238
where
@@ -230,40 +267,44 @@ renderAnalysisCDFs a@Anchor{..} fieldSelr aspect _centileSelr AsReport x =
230267
, tColumns = transpose $
231268
fields <&>
232269
fmap (T.take 6 . T.pack . printf "%f")
233-
. mapField x (snd hdrsProjs)
270+
. mapFieldWithKey x (snd hdrsProjs)
234271
, tRowHeaders = fields <&> fShortDesc
235272
, tSummaryHeaders = []
236273
, tSummaryValues = []
237274
, tFormula = []
275+
, tConstants = [("nSamples",
276+
fields <&> mapField x (T.pack . show . cdfSize) & head)]
238277
}
239278
}
240279
where
241280
fields :: [Field DSelect p a]
242281
fields = filter fieldSelr cdfFields
243282

244-
hdrsProjs :: forall v. (Divisible v) => ([Text], CDF p v -> [Double])
283+
hdrsProjs :: forall v. (Divisible v) => ([Text], Field DSelect p a -> CDF p v -> [Double])
245284
hdrsProjs = aspectColHeadersAndProjections aspect
246285

247286
aspectColHeadersAndProjections :: forall v. (Divisible v)
248-
=> CDF2Aspect -> ([Text], CDF p v -> [Double])
287+
=> CDF2Aspect -> ([Text], Field DSelect p a -> CDF p v -> [Double])
249288
aspectColHeadersAndProjections = \case
250289
OfOverallDataset ->
251290
(,)
252-
["average", "CoV", "min", "max", "stddev", "range", "size"]
253-
\c@CDF{cdfRange=(cdfMin, cdfMax), ..} ->
291+
["average", "CoV", "min", "max", "stddev", "range", "precision", "size"]
292+
\Field{..} c@CDF{cdfRange=(cdfMin, cdfMax), ..} ->
254293
let avg = cdfAverageVal c & toDouble in
255294
[ avg
256295
, cdfStddev / avg
257296
, fromRational . toRational $ cdfMin
258297
, fromRational . toRational $ cdfMax
259298
, cdfStddev
260299
, fromRational . toRational $ cdfMax - cdfMin
300+
, fromIntegral $ fromEnum fPrecision
261301
, fromIntegral cdfSize
262302
]
263303
OfInterCDF ->
264304
(,)
265-
["average", "CoV", "min", "max", "stddev", "range", "size"]
266-
(cdfArity
305+
["average", "CoV", "min", "max", "stddev", "range", "precision", "size"]
306+
(\Field{..} ->
307+
cdfArity
267308
(error "Cannot do inter-CDF statistics on plain CDFs")
268309
(\CDF{cdfAverage=cdfAvg@CDF{cdfRange=(minAvg, maxAvg),..}} ->
269310
let avg = cdfAverageVal cdfAvg & toDouble in
@@ -273,6 +314,7 @@ renderAnalysisCDFs a@Anchor{..} fieldSelr aspect _centileSelr AsReport x =
273314
, toDouble maxAvg
274315
, cdfStddev
275316
, toDouble $ maxAvg - minAvg
317+
, fromIntegral $ fromEnum fPrecision
276318
, fromIntegral cdfSize
277319
]))
278320

0 commit comments

Comments
 (0)