From e6072a651b36793a43f99afad9d8ce45cb976efd Mon Sep 17 00:00:00 2001 From: Kosyrev Serge Date: Thu, 23 Mar 2023 20:43:25 +0800 Subject: [PATCH] locli & workbench: allow variance summaries to be processed --- bench/locli/locli.cabal | 1 + .../locli/src/Cardano/Analysis/API/Context.hs | 29 ++- .../locli/src/Cardano/Analysis/API/Ground.hs | 11 +- .../locli/src/Cardano/Analysis/API/Metrics.hs | 68 +++---- bench/locli/src/Cardano/Analysis/API/Run.hs | 25 +++ bench/locli/src/Cardano/Analysis/API/Types.hs | 85 ++++++--- bench/locli/src/Cardano/Analysis/BlockProp.hs | 81 +++++---- bench/locli/src/Cardano/Analysis/MachPerf.hs | 36 ++-- bench/locli/src/Cardano/Analysis/Summary.hs | 168 ++++++++++++++---- bench/locli/src/Cardano/Command.hs | 115 ++++++++---- bench/locli/src/Cardano/Render.hs | 17 +- bench/locli/src/Cardano/Report.hs | 12 +- bench/locli/src/Cardano/Unlog/LogObject.hs | 2 - bench/locli/src/Cardano/Util.hs | 34 +++- bench/locli/src/Data/Accum.hs | 1 - bench/locli/src/Data/CDF.hs | 68 ++++--- bench/locli/src/Data/DataDomain.hs | 87 ++++++--- bench/locli/test/Test/Analysis/CDF.hs | 16 ++ nix/workbench/analyse/analyse.sh | 164 +++++++++-------- nix/workbench/ede/chart.ede | 2 +- nix/workbench/ede/report.ede | 4 +- nix/workbench/ede/tablevars-delta-pct.ede | 2 +- nix/workbench/ede/tablevars-delta.ede | 2 +- nix/workbench/profile/prof3-derived.jq | 2 +- 24 files changed, 710 insertions(+), 322 deletions(-) diff --git a/bench/locli/locli.cabal b/bench/locli/locli.cabal index 7c998aae5bd..3c8a31611b1 100644 --- a/bench/locli/locli.cabal +++ b/bench/locli/locli.cabal @@ -138,6 +138,7 @@ library , unordered-containers , utf8-string , vector + , witherable , cardano-strict-containers ^>= 0.1 executable locli diff --git a/bench/locli/src/Cardano/Analysis/API/Context.hs b/bench/locli/src/Cardano/Analysis/API/Context.hs index 24b79f7b60c..a065cc1b566 100644 --- a/bench/locli/src/Cardano/Analysis/API/Context.hs +++ b/bench/locli/src/Cardano/Analysis/API/Context.hs @@ -19,7 +19,7 @@ data GenesisSpec { delegators :: Word64 , utxo :: Word64 } - deriving (Generic, Show, ToJSON, FromJSON) + deriving (Eq, Generic, Show, ToJSON, FromJSON, NFData) -- | Partial 'Cardano.Ledger.Shelley.Genesis.ShelleyGenesis' data Genesis @@ -34,7 +34,18 @@ data Genesis , maxKESEvolutions :: Word64 , securityParam :: Word64 } - deriving (Generic, Show, FromJSON, ToJSON) + deriving (Generic, Show, FromJSON, ToJSON, NFData) + +genesesSameButTimeP :: Genesis -> Genesis -> Bool +genesesSameButTimeP l r = + ((==) `on` activeSlotsCoeff) l r && + ((==) `on` protocolParams) l r && + ((==) `on` networkMagic) l r && + ((==) `on` epochLength) l r && + ((==) `on` slotsPerKESPeriod) l r && + ((==) `on` slotLength) l r && + ((==) `on` maxKESEvolutions) l r && + ((==) `on` securityParam) l r -- | Partial 'Cardano.Ledger.Shelley.PParams.PParams' data PParams @@ -42,7 +53,7 @@ data PParams { maxTxSize :: Word64 , maxBlockBodySize :: Word64 } - deriving (Generic, Show, FromJSON, ToJSON) + deriving (Eq, Generic, Show, FromJSON, ToJSON, NFData) data GeneratorProfile = GeneratorProfile @@ -54,11 +65,11 @@ data GeneratorProfile , plutusMode :: Maybe Bool , plutusLoopScript :: Maybe FilePath } - deriving (Generic, Show, FromJSON, ToJSON) + deriving (Eq, Generic, Show, FromJSON, ToJSON, NFData) -newtype Commit = Commit { unCommit :: Text } deriving newtype (Show, FromJSON, ToJSON) -newtype Branch = Branch { unBranch :: Text } deriving newtype (Show, FromJSON, ToJSON) -newtype Version = Version { unVersion :: Text } deriving newtype (Show, FromJSON, ToJSON) +newtype Commit = Commit { unCommit :: Text } deriving newtype (Eq, Show, FromJSON, ToJSON, NFData) +newtype Branch = Branch { unBranch :: Text } deriving newtype (Eq, Show, FromJSON, ToJSON, NFData) +newtype Version = Version { unVersion :: Text } deriving newtype (Eq, Show, FromJSON, ToJSON, NFData) unsafeShortenCommit :: Int -> Commit -> Commit unsafeShortenCommit n (Commit c) = Commit (T.take n c) @@ -76,7 +87,7 @@ data Manifest , mBase :: !Commit , mPrelude :: !Commit } - deriving (Generic, Show) + deriving (Eq, Generic, NFData, Show) unsafeShortenManifest :: Int -> Manifest -> Manifest unsafeShortenManifest n m@Manifest{..} = @@ -126,4 +137,4 @@ data Metadata , era :: Text , manifest :: Manifest } - deriving (Generic, Show, FromJSON, ToJSON) + deriving (Generic, NFData, Show, FromJSON, ToJSON) diff --git a/bench/locli/src/Cardano/Analysis/API/Ground.hs b/bench/locli/src/Cardano/Analysis/API/Ground.hs index 5f808b0a1b7..3120333051f 100644 --- a/bench/locli/src/Cardano/Analysis/API/Ground.hs +++ b/bench/locli/src/Cardano/Analysis/API/Ground.hs @@ -31,6 +31,7 @@ import System.FilePath qualified as F import Cardano.Slotting.Slot (EpochNo(..), SlotNo(..)) import Ouroboros.Network.Block (BlockNo(..)) +import Data.CDF import Data.DataDomain import Cardano.Util @@ -68,7 +69,7 @@ instance FromJSONKey Hash where newtype Count a = Count { unCount :: Int } deriving (Eq, Generic, Ord, Show) - deriving newtype (FromJSON, Num, ToJSON) + deriving newtype (Divisible, FromJSON, Num, Real, ToJSON) deriving anyclass NFData countMap :: Map.Map a b -> Count a @@ -164,6 +165,14 @@ newtype OutputFile = OutputFile { unOutputFile :: FilePath } deriving (Show, Eq) +--- +--- Orphans +--- +deriving newtype instance Real BlockNo +deriving newtype instance Divisible BlockNo +deriving newtype instance Real SlotNo +deriving newtype instance Divisible SlotNo + --- --- Readers --- diff --git a/bench/locli/src/Cardano/Analysis/API/Metrics.hs b/bench/locli/src/Cardano/Analysis/API/Metrics.hs index f6163e37468..63dac94c011 100644 --- a/bench/locli/src/Cardano/Analysis/API/Metrics.hs +++ b/bench/locli/src/Cardano/Analysis/API/Metrics.hs @@ -52,8 +52,8 @@ sumFieldsReport = , "ddFiltered.sumStartSpread", "ddFiltered.sumStopSpread" , "sumDomainSlots", "sumDomainBlocks", "sumBlocksRejected" ] -instance TimelineFields SummaryOne where - data TimelineComments SummaryOne +instance (KnownCDF f) => TimelineFields (Summary f) where + data TimelineComments (Summary f) deriving Show timelineFields = @@ -66,8 +66,8 @@ instance TimelineFields SummaryOne where "Date of cluster genesis systemStart" <> fScalar "time.systemStart" W8 Tim (ITime $ systemStart.sumGenesis) - "Cluster system start date" - "Date of cluster genesis systemStart" + "Cluster system start time" + "Time-of-day portion of cluster genesis systemStart" <> fScalar "batch" Wno Id (IText $ batch.sumMeta) "Run batch" @@ -109,31 +109,33 @@ instance TimelineFields SummaryOne where "Starting UTxO set size" "Extra UTxO set size at the beginning of the benchmark" - <> fScalar "add_tx_size" W6 B (IWord64 $ add_tx_size.sumGenerator) + <> fScalar "add_tx_size" W6 B (IWord64 $ add_tx_size.sumWorkload + ) "Extra tx payload" "" - <> fScalar "inputs_per_tx" W3 Cnt (IWord64 $ inputs_per_tx.sumGenerator) + <> fScalar "inputs_per_tx" W3 Cnt (IWord64 $ inputs_per_tx.sumWorkload) "Tx inputs" "" - <> fScalar "outputs_per_tx" W3 Cnt (IWord64 $ outputs_per_tx.sumGenerator) + <> fScalar "outputs_per_tx" W3 Cnt (IWord64 $ outputs_per_tx.sumWorkload) "Tx Outputs" "" - <> fScalar "tps" W7 Hz (IFloat $ tps.sumGenerator) + <> fScalar "tps" W7 Hz (IFloat $ tps.sumWorkload) "TPS" "Offered load, transactions per second" - <> fScalar "tx_count" W12 Cnt (IWord64 $ tx_count.sumGenerator) + <> fScalar "tx_count" W12 Cnt (IWord64 $ tx_count.sumWorkload) "Transaction count" "Number of transactions prepared for submission, but not necessarily submitted" - <> fScalar "plutusScript" Wno Id (IText $ T.pack.fromMaybe "---".plutusLoopScript.sumGenerator) + <> fScalar "plutusScript" Wno Id (IText $ T.pack.fromMaybe "---".plutusLoopScript.sumWorkload) "Plutus script" "Name of th Plutus script used for smart contract workload generation, if any" - <> fScalar "sumHosts" W4 Cnt (IInt $ unCount.sumHosts) + <> fScalar "sumHosts" W4 Cnt + (IInt $ unCount.arityProj cdfMedian.sumHosts) "Machines" "Number of machines under analysis" @@ -161,47 +163,47 @@ instance TimelineFields SummaryOne where "Host log line rate, Hz" "" - <> fScalar "sumLogObjectsTotal" W12 Cnt (IInt $ unCount.sumLogObjectsTotal) + <> fScalar "sumLogObjectsTotal" W12 Cnt (IInt $ unCount.arityProj cdfMedian.sumLogObjectsTotal) "Total log objects analysed" "" - <> fScalar "ddRawCount.sumDomainTime" W12 Sec (IInt $ ddRawCount.sumDomainTime) + <> fScalar "ddRawCount.sumDomainTime" W12 Sec (IInt $ arityProj cdfMedian.ddRawCount.sumDomainTime) "Run time, s" "" - <> fScalar "ddFilteredCount.sumDomainTime" W12 Sec (IInt $ ddFilteredCount.sumDomainTime) + <> fScalar "ddFilteredCount.sumDomainTime" W12 Sec (IInt $ arityProj cdfMedian.ddFilteredCount.sumDomainTime) "Analysed run duration, s" "" - <> fScalar "dataDomainFilterRatio.sumDomainTime" W4 Rto (IFloat $ dataDomainFilterRatio.sumDomainTime) + <> fScalar "dataDomainFilterRatio.sumDomainTime" W4 Rto (IFloat $ dataDomainFilterRatio (arityProj cdfMedian).sumDomainTime) "Run time efficiency" "" - <> fScalar "ddRaw.sumStartSpread" W9 Sec (IDeltaT$ intvDurationSec.ddRaw.sumStartSpread) + <> fScalar "ddRaw.sumStartSpread" W9 Sec (IDeltaT$ intvDurationSec.fmap (fromRUTCTime . arityProj cdfMedian).ddRaw.sumStartSpread) "Node start spread, s" "" - <> fScalar "ddRaw.sumStopSpread" W9 Sec (IDeltaT$ intvDurationSec.ddRaw.sumStopSpread) + <> fScalar "ddRaw.sumStopSpread" W9 Sec (IDeltaT$ intvDurationSec.fmap (fromRUTCTime . arityProj cdfMedian).ddRaw.sumStopSpread) "Node stop spread, s" "" - <> fScalar "ddFiltered.sumStartSpread" W9 Sec (IDeltaT$ maybe 0 intvDurationSec.ddFiltered.sumStartSpread) + <> fScalar "ddFiltered.sumStartSpread" W9 Sec (IDeltaT$ maybe 0 (intvDurationSec.fmap (fromRUTCTime . arityProj cdfMedian)).ddFiltered.sumStartSpread) "Perf analysis start spread, s" "" - <> fScalar "ddFiltered.sumStopSpread" W9 Sec (IDeltaT$ maybe 0 intvDurationSec.ddFiltered.sumStopSpread) + <> fScalar "ddFiltered.sumStopSpread" W9 Sec (IDeltaT$ maybe 0 (intvDurationSec.fmap (fromRUTCTime . arityProj cdfMedian)).ddFiltered.sumStopSpread) "Perf analysis stop spread, s" "" - <> fScalar "sumDomainSlots" W12 Slo (IInt $ ddFilteredCount.sumDomainSlots) + <> fScalar "sumDomainSlots" W12 Slo (IInt $ floor.arityProj cdfMedian.cdfAverage.ddFilteredCount.sumDomainSlots) "Slots analysed" "" - <> fScalar "sumDomainBlocks" W10 Blk (IInt $ ddFilteredCount.sumDomainBlocks) + <> fScalar "sumDomainBlocks" W10 Blk (IInt $ arityProj cdfMedian.ddFilteredCount.sumDomainBlocks) "Blocks analysed" "" - <> fScalar "sumBlocksRejected" W10 Cnt (IInt $ unCount . sumBlocksRejected) + <> fScalar "sumBlocksRejected" W10 Cnt (IInt $ unCount.arityProj cdfMedian.sumBlocksRejected) "Blocks rejected" "" -- fieldJSONOverlay f = (:[]) . tryOverlayFieldDescription f @@ -632,17 +634,17 @@ instance TimelineFields (SlotStats NominalDiffTime) where -- * Instances, depending on the metrics' instances: -- -instance (ToJSON (f NominalDiffTime), ToJSON (f Int), ToJSON (f Double), ToJSON (f (Count BlockEvents)), ToJSON (f (DataDomain SlotNo)), ToJSON (f (DataDomain BlockNo))) => ToJSON (BlockProp f) where - toJSON x = AE.genericToJSON AE.defaultOptions x - & \case - Object o -> Object $ processFieldOverlays x o - _ -> error "Heh, serialised BlockProp to a non-Object." - -instance (ToJSON (a Double), ToJSON (a Int), ToJSON (a NominalDiffTime), ToJSON (a (DataDomain UTCTime)), ToJSON (a Word64), ToJSON (a (DataDomain SlotNo)), ToJSON (a (DataDomain BlockNo))) => ToJSON (MachPerf a) where - toJSON x = AE.genericToJSON AE.defaultOptions x - & \case - Object o -> Object $ processFieldOverlays x o - _ -> error "Heh, serialised BlockProp to a non-Object." +-- instance (ToJSON (f NominalDiffTime), ToJSON (f Int), ToJSON (f Double), ToJSON (f (Count BlockEvents)), ToJSON (f (DataDomain f SlotNo)), ToJSON (f (DataDomain BlockNo))) => ToJSON (BlockProp f) where +-- toJSON x = AE.genericToJSON AE.defaultOptions x +-- & \case +-- Object o -> Object $ processFieldOverlays x o +-- _ -> error "Heh, serialised BlockProp to a non-Object." + +-- instance (ToJSON (a Double), ToJSON (a Int), ToJSON (a NominalDiffTime), ToJSON (a (DataDomain UTCTime)), ToJSON (a Word64), ToJSON (a (DataDomain SlotNo)), ToJSON (a (DataDomain BlockNo))) => ToJSON (MachPerf a) where +-- toJSON x = AE.genericToJSON AE.defaultOptions x +-- & \case +-- Object o -> Object $ processFieldOverlays x o +-- _ -> error "Heh, serialised BlockProp to a non-Object." deriving newtype instance ToJSON MultiClusterPerf diff --git a/bench/locli/src/Cardano/Analysis/API/Run.hs b/bench/locli/src/Cardano/Analysis/API/Run.hs index 32080e9ff03..129104ae4b9 100644 --- a/bench/locli/src/Cardano/Analysis/API/Run.hs +++ b/bench/locli/src/Cardano/Analysis/API/Run.hs @@ -7,11 +7,13 @@ import Cardano.Prelude import Control.Monad (fail) import Data.Aeson qualified as Aeson +import Data.Aeson ((.=)) import Cardano.Util import Cardano.Analysis.API.ChainFilter import Cardano.Analysis.API.Context import Cardano.Analysis.API.Ground +import Cardano.Analysis.API.Types data AnalysisCmdError = AnalysisCmdError !Text @@ -58,6 +60,29 @@ instance FromJSON RunPartial where genesis = () pure Run{..} +-- | Given a Summary object, +-- produce a JSON file readable by the above RunPartial FromJSON instance. +-- Keep in sync. Better still, automate it so it's not necessary. +summaryMetaJson :: Summary f -> Value +summaryMetaJson Summary{sumMeta=Metadata{..}, ..} = + object [ "meta" .= meta ] + where meta = + object $ + -- keep in sync with 'data Metadata' + [ "tag" .= tag + , "batch" .= batch + , "profile" .= profile + , "era" .= era + , "manifest" .= manifest + ] <> + -- keep in sync with the above instance + [ "profile_content" .= + object + [ "generator" .= toJSON sumWorkload + , "genesis" .= toJSON sumGenesisSpec + ] + ] + readRun :: JsonInputFile Genesis -> JsonInputFile RunPartial -> ExceptT AnalysisCmdError IO Run readRun shelleyGenesis runmeta = do runPartial <- readJsonData runmeta (RunMetaParseError runmeta) diff --git a/bench/locli/src/Cardano/Analysis/API/Types.hs b/bench/locli/src/Cardano/Analysis/API/Types.hs index 5050e35691b..cd79a3e6245 100644 --- a/bench/locli/src/Cardano/Analysis/API/Types.hs +++ b/bench/locli/src/Cardano/Analysis/API/Types.hs @@ -1,6 +1,9 @@ {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE GeneralisedNewtypeDeriving #-} +{-# LANGUAGE QuantifiedConstraints #-} {-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE TypeInType #-} +{-# LANGUAGE TypeSynonymInstances #-} {-# OPTIONS_GHC -Wno-name-shadowing -Wno-orphans #-} module Cardano.Analysis.API.Types (module Cardano.Analysis.API.Types) where @@ -26,24 +29,24 @@ import Cardano.Analysis.API.LocliVersion -- * API types -- --- | Overall summary of all analyses. +-- | Overall analysis summary of a run. data Summary f where Summary :: { sumAnalysisTime :: !UTCTime , sumMeta :: !Metadata , sumGenesis :: !Genesis , sumGenesisSpec :: !GenesisSpec - , sumGenerator :: !GeneratorProfile - , sumHosts :: !(Count Host) - , sumLogObjectsTotal :: !(Count LogObject) + , sumWorkload :: !GeneratorProfile + , sumHosts :: !(f (Count Host)) + , sumLogObjectsTotal :: !(f (Count LogObject)) , sumFilters :: !([FilterName], [ChainFilter]) , sumChainRejectionStats :: ![(ChainFilter, Int)] - , sumBlocksRejected :: !(Count BlockEvents) - , sumDomainTime :: !(DataDomain UTCTime) - , sumStartSpread :: !(DataDomain UTCTime) - , sumStopSpread :: !(DataDomain UTCTime) - , sumDomainSlots :: !(DataDomain SlotNo) - , sumDomainBlocks :: !(DataDomain BlockNo) + , sumBlocksRejected :: !(f (Count BlockEvents)) + , sumDomainTime :: !(DataDomain f RUTCTime) + , sumStartSpread :: !(DataDomain f RUTCTime) + , sumStopSpread :: !(DataDomain f RUTCTime) + , sumDomainSlots :: !(DataDomain (CDF I) SlotNo) + , sumDomainBlocks :: !(DataDomain f BlockNo) , cdfLogLinesEmitted :: !(CDF f Int) , cdfLogObjectsEmitted :: !(CDF f Int) , cdfLogObjects :: !(CDF f Int) @@ -54,10 +57,23 @@ data Summary f where type SummaryOne = Summary I type MultiSummary = Summary (CDF I) - -deriving instance (FromJSON (f NominalDiffTime), FromJSON (f Int), FromJSON (f Double)) => FromJSON (Summary f) -deriving instance ( ToJSON (f NominalDiffTime), ToJSON (f Int), ToJSON (f Double)) => ToJSON (Summary f) -deriving instance ( Show (f NominalDiffTime), Show (f Int), Show (f Double)) => Show (Summary f) +data SomeSummary = forall f. KnownCDF f => SomeSummary (Summary f) + +deriving instance (forall a. FromJSON a => FromJSON (f a)) => FromJSON (Summary f) +deriving instance (forall a. ToJSON a => ToJSON (f a)) => ToJSON (Summary f) +deriving instance (forall a. NFData a => NFData (f a)) => NFData (Summary f) +deriving instance (forall a. Show a => Show (f a)) => Show (Summary f) + +instance FromJSON SomeSummary where + parseJSON x = + (SomeSummary <$> parseJSON @SummaryOne x) + <|> + (SomeSummary <$> parseJSON @MultiSummary x) +instance FromJSON SomeBlockProp where + parseJSON x = + (SomeBlockProp <$> parseJSON @BlockPropOne x) + <|> + (SomeBlockProp <$> parseJSON @MultiBlockProp x) data HostBlockStats = HostBlockStats @@ -75,8 +91,10 @@ hbsChained HostBlockStats{..} = hbsFiltered + hbsRejected data BlockProp f = BlockProp { bpVersion :: !Cardano.Analysis.API.LocliVersion.LocliVersion - , bpDomainSlots :: ![DataDomain SlotNo] - , bpDomainBlocks :: ![DataDomain BlockNo] + , bpDomainSlots :: !(CDFList f (DataDomain I SlotNo)) + , bpDomainBlocks :: !(CDFList f (DataDomain I BlockNo)) + , bpDomainCDFSlots :: !(DataDomain f SlotNo) + , bpDomainCDFBlocks :: !(DataDomain f BlockNo) , cdfForgerStart :: !(CDF f NominalDiffTime) , cdfForgerBlkCtx :: !(CDF f NominalDiffTime) , cdfForgerLgrState :: !(CDF f NominalDiffTime) @@ -104,17 +122,35 @@ data BlockProp f , bpPropagation :: !(Map Text (CDF f NominalDiffTime)) } deriving (Generic) -deriving instance (Show (f NominalDiffTime), Show (f Int), Show (f Double), Show (f (Count BlockEvents)), Show (f (DataDomain SlotNo)), Show (f (DataDomain BlockNo))) => Show (BlockProp f) -deriving instance (FromJSON (f NominalDiffTime), FromJSON (f Int), FromJSON (f Double), FromJSON (f (Count BlockEvents)), FromJSON (f (DataDomain SlotNo)), FromJSON (f (DataDomain BlockNo))) => FromJSON (BlockProp f) +deriving instance + ( forall a. FromJSON a => FromJSON (f a) + , FromJSON (CDFList f (DataDomain I SlotNo)) + , FromJSON (CDFList f (DataDomain I BlockNo)) + ) => + FromJSON (BlockProp f) +deriving instance + ( forall a. ToJSON a => ToJSON (f a) + , ToJSON (CDFList f (DataDomain I SlotNo)) + , ToJSON (CDFList f (DataDomain I BlockNo)) + ) => + ToJSON (BlockProp f) +deriving instance + ( forall a. Show a => Show (f a) + , Show (CDFList f (DataDomain I SlotNo)) + , Show (CDFList f (DataDomain I BlockNo)) + ) => + Show (BlockProp f) type BlockPropOne = BlockProp I type MultiBlockProp = BlockProp (CDF I) +data SomeBlockProp = forall f. KnownCDF f => SomeBlockProp (BlockProp f) -- | The top-level representation of the machine timeline analysis results. data MachPerf f = MachPerf { mpVersion :: !Cardano.Analysis.API.LocliVersion.LocliVersion - , mpDomainSlots :: ![DataDomain SlotNo] + , mpDomainSlots :: !(CDFList f (DataDomain I SlotNo)) + , mpDomainCDFSlots :: !(DataDomain f SlotNo) , cdfHostSlots :: !(CDF f Word64) -- distributions , cdfStarts :: !(CDF f Word64) @@ -150,8 +186,8 @@ newtype MultiClusterPerf -- data Chain = Chain - { cDomSlots :: !(DataDomain SlotNo) - , cDomBlocks :: !(DataDomain BlockNo) + { cDomSlots :: !(DataDomain I SlotNo) + , cDomBlocks :: !(DataDomain I BlockNo) , cRejecta :: ![BlockEvents] , cMainChain :: ![BlockEvents] , cHostBlockStats :: !(Map Host HostBlockStats) @@ -318,9 +354,10 @@ data RunScalars -- deriving newtype instance FromJSON a => FromJSON (I a) deriving newtype instance ToJSON a => ToJSON (I a) -deriving instance (FromJSON (a Double), FromJSON (a Int), FromJSON (a NominalDiffTime), FromJSON (a Word64), FromJSON (a (DataDomain SlotNo)), FromJSON (a (DataDomain UTCTime))) => FromJSON (MachPerf a) -deriving instance (NFData (a Double), NFData (a Int), NFData (a NominalDiffTime), NFData (a Word64), NFData (a (DataDomain SlotNo)), NFData (a (DataDomain UTCTime))) => NFData (MachPerf a) -deriving instance (Show (a Double), Show (a Int), Show (a NominalDiffTime), Show (a Word64), Show (a (DataDomain SlotNo)), Show (a (DataDomain UTCTime))) => Show (MachPerf a) +deriving instance (forall a. FromJSON a => FromJSON (f a), FromJSON (CDFList f (DataDomain I SlotNo))) => FromJSON (MachPerf f) +deriving instance (forall a. ToJSON a => ToJSON (f a), ToJSON (CDFList f (DataDomain I SlotNo))) => ToJSON (MachPerf f) +deriving instance (forall a. NFData a => NFData (f a), NFData (CDFList f (DataDomain I SlotNo))) => NFData (MachPerf f) +deriving instance (forall a. Show a => Show (f a), Show (CDFList f (DataDomain I SlotNo))) => Show (MachPerf f) data SlotStats a = SlotStats diff --git a/bench/locli/src/Cardano/Analysis/BlockProp.hs b/bench/locli/src/Cardano/Analysis/BlockProp.hs index b79684b9980..b2c8333d39b 100644 --- a/bench/locli/src/Cardano/Analysis/BlockProp.hs +++ b/bench/locli/src/Cardano/Analysis/BlockProp.hs @@ -89,8 +89,12 @@ summariseMultiBlockProp centiles bs@(headline:_) = do (d,) <$> cdf2OfCDFs comb (snd <$> xs) pure $ BlockProp { bpVersion = bpVersion headline - , bpDomainSlots = concat $ bs <&> bpDomainSlots - , bpDomainBlocks = concat $ bs <&> bpDomainBlocks + , bpDomainSlots = slotDomains + , bpDomainBlocks = blockDomains + , bpDomainCDFSlots = slotDomains & + traverseDataDomain (cdf stdCentiles . fmap unI) + , bpDomainCDFBlocks = blockDomains & + traverseDataDomain (cdf stdCentiles . fmap unI) , bpPropagation = Map.fromList bpPropagation , .. } @@ -98,6 +102,11 @@ summariseMultiBlockProp centiles bs@(headline:_) = do comb :: forall a. Divisible a => Combine I a comb = stdCombine1 centiles + slotDomains :: [DataDomain I SlotNo] + slotDomains = bs <&> bpDomainSlots + blockDomains :: [DataDomain I BlockNo] + blockDomains = bs <&> bpDomainBlocks + bfePrevBlock :: ForgerEvents a -> Maybe Hash bfePrevBlock x = case bfeBlockNo x of 0 -> Nothing @@ -284,15 +293,15 @@ rebuildChain :: Run -> [ChainFilter] -> [FilterName] -> [(JsonLogfile, MachView) rebuildChain run@Run{genesis} flts fltNames xs@(fmap snd -> machViews) = Chain { cDomSlots = DataDomain - (Interval (blk0 & beSlotNo) (blkL & beSlotNo)) - (mFltDoms <&> fst3) - (beSlotNo blkL - beSlotNo blk0 & fromIntegral . unSlotNo) - (mFltDoms <&> thd3 & fromMaybe 0) + (Interval (blk0 & beSlotNo) (blkL & beSlotNo) <&> I) + (mFltDoms <&> fmap I . fst3) + (beSlotNo blkL - beSlotNo blk0 & I . fromIntegral . unSlotNo) + (mFltDoms <&> thd3 & maybe (I 0) I) , cDomBlocks = DataDomain - (Interval (blk0 & beBlockNo) (blkL & beBlockNo)) - (mFltDoms <&> snd3) - (length cMainChain) - (length accepta) + (Interval (blk0 & beBlockNo) (blkL & beBlockNo) <&> I) + (mFltDoms <&> fmap I . snd3) + (length cMainChain & I) + (length accepta & I) , cHostBlockStats = Map.fromList $ machViews <&> (mvHost &&& mvBlockStats) , .. } @@ -497,8 +506,10 @@ rebuildChain run@Run{genesis} flts fltNames xs@(fmap snd -> machViews) = blockProp :: Run -> Chain -> IO BlockPropOne blockProp run@Run{genesis} Chain{..} = do pure $ BlockProp - { bpDomainSlots = [cDomSlots] - , bpDomainBlocks = [cDomBlocks] + { bpDomainSlots = cDomSlots + , bpDomainBlocks = cDomBlocks + , bpDomainCDFSlots = cDomSlots -- At unit-arity.. + , bpDomainCDFBlocks = cDomBlocks -- .. it's just a replica. , cdfForgerStart = forgerCDF (SJust . bfStarted . beForge) , cdfForgerBlkCtx = forgerCDF (bfBlkCtx . beForge) , cdfForgerLgrState = forgerCDF (bfLgrState . beForge) @@ -525,30 +536,42 @@ blockProp run@Run{genesis} Chain{..} = do , cdfBlockBattle = forgerCDF (SJust . unCount . beForks) , cdfBlockSize = forgerCDF (SJust . bfBlockSize . beForge) , bpVersion = getLocliVersion - , cdfBlocksPerHost = cdf stdCentiles (hostBlockStats <&> unCount - . hbsTotal) - , cdfBlocksFilteredRatio = cdf stdCentiles (hostBlockStats <&> - uncurry ((/) `on` - fromIntegral . unCount) - . (hbsFiltered &&& hbsChained) + , cdfBlocksPerHost = cdf stdCentiles (hostBlockStats + <&> unCount . hbsTotal) + , cdfBlocksFilteredRatio = cdf stdCentiles (hostBlockStats + <&> uncurry ((/) `on` + fromIntegral . unCount) + . (hbsFiltered &&& hbsChained) & filter (not . isNaN)) - , cdfBlocksChainedRatio = cdf stdCentiles (hostBlockStats <&> - uncurry ((/) `on` - fromIntegral . unCount) - . (hbsChained &&& hbsTotal) + , cdfBlocksChainedRatio = cdf stdCentiles (hostBlockStats + <&> uncurry ((/) `on` + fromIntegral . unCount) + . (hbsChained &&& hbsTotal) & filter (not . isNaN)) } where + ne :: String -> [a] -> [a] + ne desc = \case + [] -> error desc + xs -> xs + hostBlockStats = Map.elems cHostBlockStats boFetchedCum :: BlockObservation -> NominalDiffTime boFetchedCum BlockObservation{..} = boNoticed + boRequested + boFetched analysisChain :: [BlockEvents] - analysisChain = filter (all snd . beAcceptance) cMainChain + analysisChain = + case filter (all snd . beAcceptance) cMainChain of + [] -> error $ mconcat + [ "analysisChain: all blocks filtered out of originally " + , show (length cMainChain) + ] + xs -> xs forgerCDF :: Divisible a => (BlockEvents -> SMaybe a) -> CDF I a - forgerCDF = flip (witherToDistrib (cdf stdCentiles)) analysisChain + forgerCDF proj = + cdfZ stdCentiles $ mapSMaybe proj analysisChain each, earliest :: [NominalDiffTime] -> [NominalDiffTime] each = identity @@ -571,15 +594,7 @@ blockProp run@Run{genesis} Chain{..} = do -> (BlockEvents -> [a]) -> CDF I a mapChainBlockEventsCDF percs cbes f = - cdf percs (concatMap f cbes) - -witherToDistrib :: - ([b] -> CDF p b) - -> (a -> SMaybe b) - -> [a] - -> CDF p b -witherToDistrib distrify proj xs = - distrify $ mapSMaybe proj xs + cdfZ percs $ concatMap f cbes -- | Given a single machine's log object stream, recover its block map. blockEventMapsFromLogObjects :: Run -> (JsonLogfile, [LogObject]) -> MachView diff --git a/bench/locli/src/Cardano/Analysis/MachPerf.hs b/bench/locli/src/Cardano/Analysis/MachPerf.hs index 328a2fee78a..e8fe877e9ad 100644 --- a/bench/locli/src/Cardano/Analysis/MachPerf.hs +++ b/bench/locli/src/Cardano/Analysis/MachPerf.hs @@ -462,13 +462,13 @@ runSlotFilters :: Run -> [ChainFilter] -> [(JsonLogfile, [SlotStats a])] - -> IO (DataDomain SlotNo, [(JsonLogfile, [SlotStats a])]) + -> IO (DataDomain I SlotNo, [(JsonLogfile, [SlotStats a])]) runSlotFilters Run{genesis} flts slots = mapConcurrentlyPure (fmap $ filterSlotStats flts) slots <&> \filtered -> (,) (domain filtered) filtered where - domain :: [(JsonLogfile, [SlotStats a])] -> DataDomain SlotNo + domain :: [(JsonLogfile, [SlotStats a])] -> DataDomain I SlotNo domain filtered = mkDataDomain ((CP.head samplePre <&> slSlot) & fromMaybe 0) ((lastMay samplePre <&> slSlot) & fromMaybe 0) @@ -567,8 +567,9 @@ slotStatsMachPerf _ (JsonLogfile f, []) = slotStatsMachPerf run (f, slots) = Right . (f,) $ MachPerf { mpVersion = getLocliVersion - , mpDomainSlots = [domSlots] - , cdfHostSlots = dist [fromIntegral $ ddFilteredCount domSlots] + , mpDomainSlots = domSlots + , mpDomainCDFSlots = domSlots -- At unit-arity it's just a replica. + , cdfHostSlots = dist [fromIntegral . unI $ ddFilteredCount domSlots] -- , cdfStarts = dist (slCountStarts <$> slots) , cdfLeads = dist (slCountLeads <$> slots) @@ -587,12 +588,12 @@ slotStatsMachPerf run (f, slots) = , .. } where - domSlots = mkDataDomainInj sFirst sLast (fromIntegral . unSlotNo) + domSlots = mkDataDomainInj sFirst sLast (fromIntegral . unSlotNo) (,) sFirst sLast = (slSlot . head &&& slSlot . last) slots dist :: Divisible a => [a] -> CDF I a - dist = cdf stdCentiles + dist = cdfZ stdCentiles SlotStatsSummary{..} = slotStatsSummary run slots @@ -621,16 +622,18 @@ summariseClusterPerf centiles mps@(headline:_) = do (xs :: [CDF I Word64]) -> cdf2OfCDFs comb xs :: Either CDFError (CDF (CDF I) Word64) pure MachPerf - { mpVersion = mpVersion headline - , mpDomainSlots = domSlots + { mpVersion = mpVersion headline + , mpDomainSlots = slotDomains + , mpDomainCDFSlots = slotDomains & traverseDataDomain (cdf stdCentiles . fmap unI) , .. } where - domSlots = concat $ mps <&> mpDomainSlots - comb :: forall a. Divisible a => Combine I a comb = stdCombine1 centiles + slotDomains :: [DataDomain I SlotNo] + slotDomains = mps <&> mpDomainSlots + summariseMultiClusterPerf :: [Centile] -> [ClusterPerf] -> Either CDFError MultiClusterPerf summariseMultiClusterPerf _ [] = error "Asked to summarise empty list of MachPerfOne" summariseMultiClusterPerf centiles mps@(headline:_) = do @@ -654,10 +657,19 @@ summariseMultiClusterPerf centiles mps@(headline:_) = do (xs :: [CDF (CDF I) Word64]) -> cdf2OfCDFs comb xs :: Either CDFError (CDF (CDF I) Word64) pure . MultiClusterPerf $ MachPerf - { mpVersion = mpVersion headline - , mpDomainSlots = concat $ mps <&> mpDomainSlots + { mpVersion = mpVersion headline + , mpDomainSlots = slotDomains + , mpDomainCDFSlots = + -- The simpler option, smashing the data from multiple runs into a single CDF: + slotDomains & traverseDataDomain (cdf stdCentiles . fmap unI) + -- Arguably, the proper option: + -- mps <&> mpDomainCDFSlots + -- & traverseDataDomain (cdf2OfCDFs comb) , .. } where + slotDomains :: [DataDomain I SlotNo] + slotDomains = concat $ mps <&> mpDomainSlots + comb :: forall a. Divisible a => Combine (CDF I) a comb = stdCombine2 centiles diff --git a/bench/locli/src/Cardano/Analysis/Summary.hs b/bench/locli/src/Cardano/Analysis/Summary.hs index 833feb974d0..3c75d52b5b5 100644 --- a/bench/locli/src/Cardano/Analysis/Summary.hs +++ b/bench/locli/src/Cardano/Analysis/Summary.hs @@ -1,5 +1,5 @@ +{-# LANGUAGE GeneralisedNewtypeDeriving #-} {-# LANGUAGE UndecidableInstances #-} - {-# OPTIONS_GHC -Wno-name-shadowing -Wno-orphans #-} {- HLINT ignore "Use mapMaybe" -} @@ -9,13 +9,100 @@ module Cardano.Analysis.Summary (module Cardano.Analysis.Summary) where import Prelude (head, last) import Cardano.Prelude +import Data.Either.Extra (mapLeft) import Data.Map.Strict qualified as Map +import Data.Text qualified as Text import Cardano.Analysis.API -import Cardano.Unlog.LogObject +import Cardano.Unlog.LogObject hiding (Text) import Cardano.Util +data SummaryError + = SEEmptyDataset + | SEIncoherentRunGeneses [Genesis] + | SEIncoherentRunGenesisSpecs [GenesisSpec] + | SEIncoherentRunWorkloads [GeneratorProfile] + | SEIncoherentRunProfiles [Text] + | SEIncoherentRunEras [Text] + | SEIncoherentRunVersions [Manifest] + | SEIncoherentRunFilters [([FilterName], [ChainFilter])] + | SECDFError CDFError + deriving Show + +summariseMultiSummary :: + UTCTime + -> [Centile] + -> [SummaryOne] + -> Either SummaryError MultiSummary +summariseMultiSummary _ _ [] = error "Asked to summarise empty list of Summary" +summariseMultiSummary sumAnalysisTime centiles xs@(headline:xss) = do + sumHosts <- pure $ cdf centiles $ xs <&> unI . sumHosts + sumLogObjectsTotal <- pure $ cdf centiles $ xs <&> unI . sumLogObjectsTotal + sumChainRejectionStats <- pure $ xs <&> sumChainRejectionStats + & concat + sumBlocksRejected <- pure $ cdf centiles $ xs <&> unI . sumBlocksRejected + sumDomainTime <- pure $ xs <&> sumDomainTime + & traverseDataDomain (cdf centiles . fmap unI) + sumStartSpread <- pure $ xs <&> sumStartSpread + & traverseDataDomain (cdf centiles . fmap unI) + sumStopSpread <- pure $ xs <&> sumStopSpread + & traverseDataDomain (cdf centiles . fmap unI) + sumDomainSlots <- traverseDataDomain' + (mapLeft SECDFError + . collapseCDFs (stdCombine1 centiles)) + (xs <&> sumDomainSlots) + sumDomainBlocks <- pure $ xs <&> sumDomainBlocks + & traverseDataDomain (cdf centiles . fmap unI) + + sumMeta <- summariseMetadata $ xs <&> sumMeta + sumFilters <- allEqOrElse (xs <&> sumFilters) SEIncoherentRunFilters + + cdfLogLinesEmitted <- sumCDF2 $ xs <&> cdfLogLinesEmitted + cdfLogObjectsEmitted <- sumCDF2 $ xs <&> cdfLogObjectsEmitted + cdfLogObjects <- sumCDF2 $ xs <&> cdfLogObjects + cdfRuntime <- sumCDF2 $ xs <&> cdfRuntime + cdfLogLineRate <- sumCDF2 $ xs <&> cdfLogLineRate + sumGenesis <- find (not .genesesSameButTimeP (sumGenesis headline)) + (sumGenesis <$> xss) + & maybe (Right $ sumGenesis headline) + (Left .SEIncoherentRunGeneses .(sumGenesis headline:).(:[])) + sumGenesisSpec <- find (not .(== (sumGenesisSpec headline))) + (sumGenesisSpec <$> xss) + & maybe (Right $ sumGenesisSpec headline) + (Left .SEIncoherentRunGenesisSpecs .(sumGenesisSpec headline:).(:[])) + sumWorkload <- find (not .(== (sumWorkload headline))) + (sumWorkload <$> xss) + & maybe (Right $ sumWorkload headline) + (Left .SEIncoherentRunWorkloads .(sumWorkload headline:).(:[])) + pure $ Summary + { .. + } + where + summariseMetadata :: [Metadata] -> Either SummaryError Metadata + summariseMetadata [] = Left SEEmptyDataset + summariseMetadata xs@(headline:_) = do + profile <- allEqOrElse (xs <&> profile) SEIncoherentRunProfiles + era <- allEqOrElse (xs <&> era) SEIncoherentRunEras + manifest <- allEqOrElse (xs <&> manifest) SEIncoherentRunVersions + -- XXX: magic transformation that happens to match + -- the logic in 'analyse.sh multi-call' on line with "local run=" + pure Metadata { tag = xs <&> tag & sort & last & Text.take 16 & (<> "_variance") + , batch = batch headline + , .. } + + allEqOrElse :: Eq a => [a] -> ([a] -> SummaryError) -> Either SummaryError a + allEqOrElse [] _ = Left SEEmptyDataset + allEqOrElse xss@(headline:xs) err = + all (== headline) xs + & bool (Left $ err xss) (Right headline) + + sumCDF2 :: Divisible a => [CDF I a] -> Either SummaryError (CDF (CDF I) a) + sumCDF2 xs = cdf2OfCDFs (stdCombine1 centiles) xs & bimap SECDFError identity + + -- comb :: forall a. Divisible a => Combine I a + -- comb = stdCombine1 centiles + computeSummary :: UTCTime -> Metadata @@ -32,7 +119,7 @@ computeSummary sumAnalysisTime sumMeta sumGenesis sumGenesisSpec - sumGenerator + sumWorkload rl@RunLogs{..} sumFilters MachPerf{..} @@ -40,23 +127,11 @@ computeSummary sumAnalysisTime Chain{..} = Summary - { sumHosts = countMap rlHostLogs - , sumLogObjectsTotal = countListsAll objLists - , sumBlocksRejected = countListAll cRejecta - , sumDomainTime = - DataDomain (Interval minStartRaw maxStopRaw) (Just $ Interval minStartFlt maxStopFlt) - (maxStopRaw `utcTimeDeltaSec` minStartRaw) - (maxStopFlt `utcTimeDeltaSec` minStartFlt) - , sumStartSpread = - DataDomain (Interval minStartRaw maxStartRaw) (Just $ Interval minStartFlt maxStartFlt) - (maxStartRaw `utcTimeDeltaSec` minStartRaw) - (maxStartFlt `utcTimeDeltaSec` minStartFlt) - , sumStopSpread = - DataDomain (Interval minStopRaw maxStopRaw) (Just $ Interval minStopFlt maxStopFlt) - (maxStopRaw `utcTimeDeltaSec` minStopRaw) - (maxStopFlt `utcTimeDeltaSec` minStopFlt) - , sumDomainSlots = Prelude.head mpDomainSlots - , sumDomainBlocks = Prelude.head bpDomainBlocks + { sumHosts = I $ countMap rlHostLogs + , sumLogObjectsTotal = I $ countListsAll objLists + , sumBlocksRejected = I $ countListAll cRejecta + , sumDomainSlots = mpDomainCDFSlots + , sumDomainBlocks = bpDomainCDFBlocks -- , cdfLogObjects = cdf stdCentiles (objLists <&> length) , cdfLogObjectsEmitted = cdf stdCentiles logObjectsEmitted @@ -74,8 +149,7 @@ computeSummary sumAnalysisTime & unzip objLists = rlLogs rl <&> snd - (,) minStartRaw maxStartRaw = (minimum &&& maximum) losFirsts - (,) minStopRaw maxStopRaw = (minimum &&& maximum) losLasts + losFirsts, losLasts :: [UTCTime] losFirsts = objLists <&> loAt . Prelude.head losLasts = objLists <&> loAt . Prelude.last runtimes :: [NominalDiffTime] @@ -83,18 +157,52 @@ computeSummary sumAnalysisTime lineRates = zipWith (/) (textLinesEmitted <&> fromIntegral) (runtimes <&> fromIntegral @Int . truncate) - (,) minStartFlt maxStartFlt = (timeOf *** timeOf) startMinMaxS - (,) minStopFlt maxStopFlt = (timeOf *** timeOf) stopMinMaxS - startMinMaxS = (minimum &&& maximum) slotFirsts - stopMinMaxS = (minimum &&& maximum) slotLasts - slotFirsts = slotDomains <&> low - slotLasts = slotDomains <&> high - slotDomains = catMaybes (ddFiltered <$> mpDomainSlots) - timeOf = unSlotStart . slotStart sumGenesis + (,,) sumDomainTime sumStartSpread sumStopSpread = + slotDomains sumGenesis (losFirsts, losLasts) mpDomainSlots + sumChainRejectionStats :: [(ChainFilter, Int)] sumChainRejectionStats = cRejecta <&> fmap fst . filter (not . snd) . beAcceptance & concat & foldr' (\k m -> Map.insertWith (+) k 1 m) Map.empty & Map.toList + +deriving newtype instance (Num (I Int)) + +slotDomains :: Genesis + -> ([UTCTime], [UTCTime]) + -> [DataDomain I SlotNo] + -> ( DataDomain I RUTCTime + , DataDomain I RUTCTime + , DataDomain I RUTCTime) +slotDomains gsis (firstLOs, lastLOs) (catMaybes . fmap ddFiltered -> xs) = + ( DataDomain (I <$> Interval minStartRaw maxStopRaw) + (Just $ I <$> Interval minStartFlt maxStopFlt) + (I $ maxStopRaw `utcTimeDeltaSec` minStartRaw) + (I $ maxStopFlt `utcTimeDeltaSec` minStartFlt) + <&> toRUTCTime + , DataDomain (I <$> Interval minStartRaw maxStartRaw) + (Just $ I <$> Interval minStartFlt maxStartFlt) + (I $ maxStartRaw `utcTimeDeltaSec` minStartRaw) + (I $ maxStartFlt `utcTimeDeltaSec` minStartFlt) + <&> toRUTCTime + , DataDomain (I <$> Interval minStopRaw maxStopRaw) + (Just $ I <$> Interval minStopFlt maxStopFlt) + (I $ maxStopRaw `utcTimeDeltaSec` minStopRaw) + (I $ maxStopFlt `utcTimeDeltaSec` minStopFlt) + <&> toRUTCTime + ) + where + minStartRaw, maxStartRaw, minStopRaw, maxStopRaw :: UTCTime + (,) minStartRaw maxStartRaw = (minimum &&& maximum) firstLOs + (,) minStopRaw maxStopRaw = (minimum &&& maximum) lastLOs + + (,) minStartFlt maxStartFlt = (timeOf *** timeOf) startMinMaxS + (,) minStopFlt maxStopFlt = (timeOf *** timeOf) stopMinMaxS + startMinMaxS = (minimum &&& maximum) slotFirsts + stopMinMaxS = (minimum &&& maximum) slotLasts + slotFirsts = xs <&> unI . low + slotLasts = xs <&> unI . high + + timeOf = unSlotStart . slotStart gsis diff --git a/bench/locli/src/Cardano/Command.hs b/bench/locli/src/Cardano/Command.hs index 826b72a3fa4..533f734517f 100644 --- a/bench/locli/src/Cardano/Command.hs +++ b/bench/locli/src/Cardano/Command.hs @@ -5,11 +5,13 @@ module Cardano.Command (module Cardano.Command) where import Cardano.Prelude hiding (State) import Data.Aeson qualified as Aeson +import Data.Aeson.Text qualified as Aeson import Data.ByteString qualified as BS import Data.ByteString.Lazy.Char8 qualified as LBS import Data.Map qualified as Map import Data.Text (pack) import Data.Text qualified as T +import Data.Text.Lazy qualified as LT import Data.Text.Short (toText) import Data.Time.Clock import Options.Applicative @@ -45,7 +47,8 @@ data ChainCommand = ListLogobjectKeys TextOutputFile | ListLogobjectKeysLegacy TextOutputFile - | MetaGenesis (JsonInputFile RunPartial) (JsonInputFile Genesis) + | ReadMetaGenesis (JsonInputFile RunPartial) (JsonInputFile Genesis) + | WriteMetaGenesis TextOutputFile TextOutputFile | Unlog (JsonInputFile (RunLogs ())) Bool [LOAnyType] | DumpLogObjects @@ -83,11 +86,13 @@ data ChainCommand | ComputeSummary | RenderSummary RenderConfig TextOutputFile | ReadSummaries [JsonInputFile SummaryOne] + | ComputeMultiSummary + | RenderMultiSummary RenderConfig TextOutputFile | Compare InputDir (Maybe TextInputFile) TextOutputFile - [( JsonInputFile SummaryOne + [( JsonInputFile SomeSummary , JsonInputFile ClusterPerf - , JsonInputFile BlockPropOne)] + , JsonInputFile SomeBlockProp)] deriving Show @@ -100,10 +105,15 @@ parseChainCommand = , op "list-logobject-keys-legacy" "List legacy logobject keys that analyses care about" (ListLogobjectKeysLegacy <$> optTextOutputFile "keys-legacy" "Text file to write logobject keys to") - , op "meta-genesis" "Machine performance timeline" - (MetaGenesis + , op "read-meta-genesis" "Read the run metadata: meta.json and Shelley genesis" + (ReadMetaGenesis <$> optJsonInputFile "run-metafile" "The meta.json file from the benchmark run" <*> optJsonInputFile "shelley-genesis" "Genesis file of the run") + + , op "write-meta-genesis" "Write the run metadata: meta.json and Shelley genesis" + (WriteMetaGenesis + <$> optTextOutputFile "run-metafile" "The meta.json file from the benchmark run" + <*> optTextOutputFile "shelley-genesis" "Genesis file of the run") ]) <|> subparser (mconcat [ commandGroup "Basic log objects" @@ -222,6 +232,11 @@ parseChainCommand = (ReadSummaries <$> some (optJsonInputFile "summary" "JSON block propagation input file")) + + , op "compute-multi-summary" "Compute a multi-run summary" + (ComputeMultiSummary & pure) + , op "render-multi-summary" "Write out multi-run summary results" + (writerOpts RenderMultiSummary "Render") ]) <|> subparser (mconcat [ commandGroup "Run comparison" @@ -311,7 +326,7 @@ data State , sTags :: [Text] , sRun :: Maybe Run , sRunLogs :: Maybe (RunLogs [LogObject]) - , sDomSlots :: Maybe (DataDomain SlotNo) + , sDomSlots :: Maybe (DataDomain I SlotNo) -- propagation , sMachViews :: Maybe [(JsonLogfile, MachView)] , sChain :: Maybe Chain @@ -326,6 +341,7 @@ data State , sMultiClusterPerf :: Maybe MultiClusterPerf -- , sSummaries :: Maybe [SummaryOne] + , sMultiSummary :: Maybe MultiSummary } callComputeSummary :: State -> Either Text SummaryOne @@ -349,20 +365,21 @@ callComputeSummary = where err = Left . ("Summary of a run requires " <>) -sRunAnchor :: State -> Anchor -sRunAnchor State{sRun = Just run, sFilters, sWhen, sClusterPerf, sChain} - = runAnchor run sWhen sFilters - ((sClusterPerf <&> fmap (head . mpDomainSlots) . head & join.join) <|> - (sChain <&> cDomSlots)) - (sChain <&> cDomBlocks) -sRunAnchor _ = error "sRunAnchor with no run." - -sTagsAnchor :: State -> Anchor -sTagsAnchor State{sFilters, sTags, sWhen, sClusterPerf, sChain} - = tagsAnchor sTags sWhen sFilters - ((sClusterPerf <&> fmap (head . mpDomainSlots) . head & join.join) <|> - (sChain <&> cDomSlots)) - (sChain <&> cDomBlocks) +stateAnchor :: [Text] -> State -> Anchor +stateAnchor tags State{sFilters, sWhen, sClusterPerf, sChain} = + tagsAnchor tags sWhen sFilters + ((sClusterPerf <&> fmap (head . mpDomainSlots) . head & join.join) <|> + (sChain <&> cDomSlots)) + (sChain <&> cDomBlocks) + +sAnchor :: HasCallStack => State -> Anchor +sAnchor s@State{sMultiSummary=Just summary} + = stateAnchor [tag . sumMeta $ summary] s +sAnchor s@State{sRun = Just run} + = stateAnchor [tag . metadata $ run] s +sAnchor State{sTags=[]} = error "sAnchor with no run or multi-summary." +sAnchor s@State{sTags} + = stateAnchor sTags s runChainCommand :: State -> ChainCommand -> ExceptT CommandError IO State @@ -378,12 +395,22 @@ runChainCommand s pure s runChainCommand s - c@(MetaGenesis runMeta shelleyGenesis) = do + c@(ReadMetaGenesis runMeta shelleyGenesis) = do progress "run" (Q $ printf "reading run metadata & Shelley genesis") run <- readRun shelleyGenesis runMeta & firstExceptT (fromAnalysisError c) pure s { sRun = Just run } +runChainCommand s@State{sMultiSummary=Just summ@Summary{..}} + c@(WriteMetaGenesis runMeta shelleyGenesis) = do + dumpText "meta" [LT.toStrict $ Aeson.encodeToLazyText (summaryMetaJson summ)] runMeta + & firstExceptT (CommandError c) + dumpText "genesis" [LT.toStrict $ Aeson.encodeToLazyText sumGenesis] shelleyGenesis + & firstExceptT (CommandError c) + pure s +runChainCommand _ c@WriteMetaGenesis{} = missingCommandData c + ["multi objects"] + runChainCommand s c@(Unlog rlf okDErr okAny) = do progress "logs" (Q $ printf "reading run log manifest %s" $ unJsonInputFile rlf) @@ -473,7 +500,7 @@ runChainCommand _ c@DumpChain{} = missingCommandData c runChainCommand s@State{sRun=Just _run, sChain=Just Chain{..}} c@(TimelineChain rc f comments) = do progress "chain" (Q $ printf "dumping prettyprinted chain: %s" (show rc :: String)) - dumpText "chain" (renderTimeline rc (sRunAnchor s) (const True) comments cMainChain) f + dumpText "chain" (renderTimeline rc (sAnchor s) (const True) comments cMainChain) f & firstExceptT (CommandError c) pure s runChainCommand _ c@TimelineChain{} = missingCommandData c @@ -537,7 +564,7 @@ runChainCommand s@State{sRun=Just _run, sSlots=Just slots} c@(TimelineSlots rc comments) = do progress "mach" (Q $ printf "dumping %d slot timelines: %s" (length slots) (show rc :: String)) dumpAssociatedTextStreams "mach" - (fmap (fmap $ renderTimeline rc (sRunAnchor s) (const True) comments) slots) + (fmap (fmap $ renderTimeline rc (sAnchor s) (const True) comments) slots) & firstExceptT (CommandError c) pure s runChainCommand _ c@TimelineSlots{} = missingCommandData c @@ -554,7 +581,8 @@ runChainCommand _ c@ComputePropagation = missingCommandData c runChainCommand s@State{sBlockProp=Just [prop]} c@(RenderPropagation rc@RenderConfig{..} f subset) = do progress "block-propagation" $ Q "rendering block propagation CDFs" - forM_ (renderAnalysisCDFs (sRunAnchor s) (propSubsetFn subset) OfOverallDataset Nothing rc prop) $ + forM_ (renderAnalysisCDFs + (sAnchor s) (propSubsetFn subset) OfOverallDataset Nothing rc prop) $ \(name, body) -> dumpText (T.unpack name) body (modeFilename f name rcFormat) & firstExceptT (CommandError c) @@ -565,7 +593,7 @@ runChainCommand _ c@RenderPropagation{} = missingCommandData c runChainCommand s@State{} c@(ReadPropagations fs) = do progress "block-propagations" (Q $ printf "reading %d block propagations" $ length fs) - xs <- mapConcurrently readJsonDataIO fs + xs :: [BlockProp I] <- mapConcurrently readJsonDataIO fs & fmap sequence & newExceptT & firstExceptT (CommandError c . show) @@ -585,7 +613,8 @@ runChainCommand _ c@ComputeMultiPropagation{} = missingCommandData c runChainCommand s@State{sMultiBlockProp=Just prop} c@(RenderMultiPropagation rc@RenderConfig{..} f subset aspect) = do progress "block-propagations" (Q "rendering multi-run block propagation") - forM_ (renderAnalysisCDFs (sTagsAnchor s) (propSubsetFn subset) aspect Nothing rc prop) $ + forM_ (renderAnalysisCDFs + (sAnchor s) (propSubsetFn subset) aspect Nothing rc prop) $ \(name, body) -> dumpText (T.unpack name) body (modeFilename f name rcFormat) & firstExceptT (CommandError c) @@ -626,7 +655,7 @@ runChainCommand _ c@ComputeClusterPerf{} = missingCommandData c runChainCommand s@State{sClusterPerf=Just [perf]} c@(RenderClusterPerf rc@RenderConfig{..} f subset) = do progress "clusterperf" (Q $ printf "rendering cluster performance") - forM_ (renderAnalysisCDFs (sRunAnchor s) (perfSubsetFn subset) OfOverallDataset Nothing rc perf) $ + forM_ (renderAnalysisCDFs (sAnchor s) (perfSubsetFn subset) OfOverallDataset Nothing rc perf) $ \(name, body) -> dumpText (T.unpack name) body (modeFilename f name rcFormat) & firstExceptT (CommandError c) @@ -657,7 +686,7 @@ runChainCommand _ c@ComputeMultiClusterPerf{} = missingCommandData c runChainCommand s@State{sMultiClusterPerf=Just (MultiClusterPerf perf)} c@(RenderMultiClusterPerf rc@RenderConfig{..} f subset aspect) = do progress "clusterperfs" (Q $ printf "rendering multi-run cluster performance") - forM_ (renderAnalysisCDFs (sTagsAnchor s) (perfSubsetFn subset) aspect Nothing rc perf) $ + forM_ (renderAnalysisCDFs (sAnchor s) (perfSubsetFn subset) aspect Nothing rc perf) $ \(name, body) -> dumpText (T.unpack name) body (modeFilename f name rcFormat) & firstExceptT (CommandError c) @@ -673,26 +702,46 @@ runChainCommand s c@ComputeSummary = do pure s { sSummaries = Just [summary] } runChainCommand s@State{sSummaries = Just (summary:_)} c@(RenderSummary rc@RenderConfig{..} f) = do - progress "summary" (Q $ printf "rendering summary") + progress "summary" (Q "rendering summary") dumpText "summary" body (modeFilename f "" rcFormat) & firstExceptT (CommandError c) pure s - where body = renderSummary rc (sRunAnchor s) (iFields sumFieldsReport) summary + where body = renderSummary rc (sAnchor s) (iFields sumFieldsReport) summary runChainCommand _ c@RenderSummary{} = missingCommandData c ["run summary"] runChainCommand s@State{} c@(ReadSummaries fs) = do progress "summaries" (Q $ printf "reading %d run summaries" $ length fs) - xs <- mapConcurrently (fmap (Aeson.eitherDecode @SummaryOne) . LBS.readFile . unJsonInputFile) fs + xs <- mapConcurrently (fmap Aeson.eitherDecode . LBS.readFile . unJsonInputFile) fs & fmap sequence & newExceptT & firstExceptT (CommandError c . show) pure s { sSummaries = Just xs } +runChainCommand s@State{sWhen, sSummaries=Just xs} + c@ComputeMultiSummary = do + progress "multi-summary" (Q $ printf "computing multi-summary of %d summaries" $ length xs) + r <- pure (summariseMultiSummary sWhen (nEquicentiles $ max 7 (length xs)) xs) + & newExceptT + & firstExceptT (CommandError c . show) + pure s { sMultiSummary = Just r } +runChainCommand _ c@ComputeMultiSummary{} = missingCommandData c + ["multi-run summary"] + +runChainCommand s@State{sMultiSummary=Just summary} + c@(RenderMultiSummary rc@RenderConfig{..} f) = do + progress "multi-summary" (Q "rendering multi-run summary") + dumpText "multi-summary" body (modeFilename f "" rcFormat) + & firstExceptT (CommandError c) + pure s + where body = renderSummary rc (sAnchor s) (iFields sumFieldsReport) summary +runChainCommand _ c@RenderMultiSummary{} = missingCommandData c + ["multi-run summary"] + runChainCommand s c@(Compare ede mTmpl outf@(TextOutputFile outfp) runs) = do progress "report" (Q $ printf "rendering report for %d runs" $ length runs) - xs :: [(SummaryOne, ClusterPerf, BlockPropOne)] <- forM runs $ + xs :: [(SomeSummary, ClusterPerf, SomeBlockProp)] <- forM runs $ \(sumf,cpf,bpf)-> (,,) <$> readJsonData sumf (CommandError c) @@ -748,7 +797,7 @@ runCommand (ChainCommand cs) = do Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing - Nothing Nothing + Nothing Nothing Nothing opts :: ParserInfo Command opts = diff --git a/bench/locli/src/Cardano/Render.hs b/bench/locli/src/Cardano/Render.hs index 082b614a499..b8b9b6ab9dd 100644 --- a/bench/locli/src/Cardano/Render.hs +++ b/bench/locli/src/Cardano/Render.hs @@ -51,16 +51,13 @@ data Anchor = Anchor { aRuns :: [Text] , aFilters :: ([FilterName], [ChainFilter]) - , aSlots :: Maybe (DataDomain SlotNo) - , aBlocks :: Maybe (DataDomain BlockNo) + , aSlots :: Maybe (DataDomain I SlotNo) + , aBlocks :: Maybe (DataDomain I BlockNo) , aVersion :: LocliVersion , aWhen :: UTCTime } -runAnchor :: Run -> UTCTime -> ([FilterName], [ChainFilter]) -> Maybe (DataDomain SlotNo) -> Maybe (DataDomain BlockNo) -> Anchor -runAnchor Run{..} = tagsAnchor [tag metadata] - -tagsAnchor :: [Text] -> UTCTime -> ([FilterName], [ChainFilter]) -> Maybe (DataDomain SlotNo) -> Maybe (DataDomain BlockNo) -> Anchor +tagsAnchor :: [Text] -> UTCTime -> ([FilterName], [ChainFilter]) -> Maybe (DataDomain I SlotNo) -> Maybe (DataDomain I BlockNo) -> Anchor tagsAnchor aRuns aWhen aFilters aSlots aBlocks = Anchor { aVersion = getLocliVersion, .. } @@ -88,15 +85,15 @@ renderAnchorDomains Anchor{..} = mconcat $ maybe [] ((:[]) . renderDomain "slot" (showText . unSlotNo)) aSlots <> maybe [] ((:[]) . renderDomain "block" (showText . unBlockNo)) aBlocks - where renderDomain :: Text -> (a -> Text) -> DataDomain a -> Text + where renderDomain :: Text -> (a -> Text) -> DataDomain I a -> Text renderDomain ty r DataDomain{..} = mconcat [ ", ", ty - , " range: raw(", renderIntv r ddRaw, ", " + , " range: raw(", renderIntv r (fmap unI ddRaw), ", " , showText ddRawCount, " total)" , " filtered(", maybe "none" - (renderIntv r) ddFiltered, ", " + (renderIntv r . fmap unI) ddFiltered, ", " , showText ddFilteredCount, " total), " - , "filtered ", T.take 4 . showText $ ((/) @Double `on` fromIntegral) + , "filtered ", T.take 4 . showText $ ((/) @Double `on` (fromIntegral.unI)) ddFilteredCount ddRawCount ] diff --git a/bench/locli/src/Cardano/Report.hs b/bench/locli/src/Cardano/Report.hs index ef74b951192..d5ffec8f855 100644 --- a/bench/locli/src/Cardano/Report.hs +++ b/bench/locli/src/Cardano/Report.hs @@ -92,12 +92,12 @@ data Section where , sTitle :: !Text } -> Section -summaryReportSection :: SummaryOne -> Section +summaryReportSection :: Summary f -> Section summaryReportSection summ = STable summ (ISel @SummaryOne $ iFields sumFieldsReport) "Parameter" "Value" "summary" "summary.org" "Overall run parameters" -analysesReportSections :: MachPerf (CDF I) -> BlockProp I -> [Section] +analysesReportSections :: MachPerf (CDF I) -> BlockProp f -> [Section] analysesReportSections mp bp = [ STable mp (DSel @MachPerf $ dFields mtFieldsReport) "metric" "average" "perf" "clusterperf.report.org" "Resource Usage" @@ -120,7 +120,7 @@ analysesReportSections mp bp = -- liftTmplRun :: Summary a -> TmplRun -liftTmplRun Summary{sumGenerator=GeneratorProfile{..} +liftTmplRun Summary{sumWorkload=GeneratorProfile{..} ,sumMeta=meta@Metadata{..}} = TmplRun { trMeta = meta @@ -207,9 +207,9 @@ instance ToJSON TmplSection where ] generate :: InputDir -> Maybe TextInputFile - -> (SummaryOne, ClusterPerf, BlockPropOne) -> [(SummaryOne, ClusterPerf, BlockPropOne)] + -> (SomeSummary, ClusterPerf, SomeBlockProp) -> [(SomeSummary, ClusterPerf, SomeBlockProp)] -> IO (ByteString, Text) -generate (InputDir ede) mReport (summ, cp, bp) rest = do +generate (InputDir ede) mReport (SomeSummary summ, cp, SomeBlockProp bp) rest = do ctx <- getReport (last restTmpls & trManifest & mNodeApproxVer) Nothing tmplRaw <- BS.readFile (maybe defaultReportPath unTextInputFile mReport) tmpl <- parseWith defaultSyntax (includeFile ede) "report" tmplRaw @@ -218,7 +218,7 @@ generate (InputDir ede) mReport (summ, cp, bp) rest = do renderWith fenv x (env ctx baseTmpl restTmpls) where baseTmpl = liftTmplRun summ - restTmpls = fmap (liftTmplRun. fst3) rest + restTmpls = fmap ((\(SomeSummary ss) -> liftTmplRun ss). fst3) rest defaultReportPath = ede <> "/report.ede" fenv = HM.fromList diff --git a/bench/locli/src/Cardano/Unlog/LogObject.hs b/bench/locli/src/Cardano/Unlog/LogObject.hs index 7460e302f5e..2677ca5583f 100644 --- a/bench/locli/src/Cardano/Unlog/LogObject.hs +++ b/bench/locli/src/Cardano/Unlog/LogObject.hs @@ -35,8 +35,6 @@ import Cardano.Logging.Resources.Types import Cardano.Analysis.API.Ground import Cardano.Util -import Data.Accum (zeroUTCTime) - type Text = ShortText diff --git a/bench/locli/src/Cardano/Util.hs b/bench/locli/src/Cardano/Util.hs index f1ed86fefd7..495c2b9b97e 100644 --- a/bench/locli/src/Cardano/Util.hs +++ b/bench/locli/src/Cardano/Util.hs @@ -1,6 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE GeneralisedNewtypeDeriving #-} {-# OPTIONS_GHC -Wno-orphans #-} {-# OPTIONS_GHC -Wno-incomplete-patterns #-} {- HLINT ignore "Use list literal pattern" -} @@ -26,6 +27,7 @@ module Cardano.Util where import Prelude (String, error, head, last) +import Text.Show qualified as Show (Show(..)) import Cardano.Prelude #if __GLASGOW_HASKELL__ < 902 @@ -51,7 +53,7 @@ import Data.List (span) import Data.List.Split (chunksOf) import Data.Text qualified as T import Data.SOP.Strict -import Data.Time.Clock (NominalDiffTime, UTCTime (..), diffUTCTime) +import Data.Time.Clock (NominalDiffTime, UTCTime (..), diffUTCTime, addUTCTime) import Data.Time.Clock.POSIX import Data.Vector (Vector) import Data.Vector qualified as Vec @@ -214,3 +216,33 @@ utcTimeDeltaSec x y = diffUTCTime x y & round foldEmpty :: r -> ([a] -> r) -> [a] -> r foldEmpty r _ [] = r foldEmpty _ f l = f l + +-- | A tweaked version of UTCTime that is able to have more instances. +-- Structurally equivalent to difftime from zeroUTCTime +zeroUTCTime :: UTCTime +zeroUTCTime = posixSecondsToUTCTime $ realToFrac (0 :: Int) + +newtype RUTCTime = + RUTCTime { unRUTCTime :: NominalDiffTime } + deriving newtype (Eq, NFData, Num, Ord, Real) + +instance Show.Show RUTCTime where + show = show . unsafeNominalToUTC . unRUTCTime + +instance ToJSON RUTCTime where + toJSON = toJSON . unsafeNominalToUTC . unRUTCTime + +instance FromJSON RUTCTime where + parseJSON v = RUTCTime . unsafeUTCToNominal <$> parseJSON v + +unsafeUTCToNominal :: UTCTime -> NominalDiffTime +unsafeUTCToNominal = (`diffUTCTime` zeroUTCTime) + +unsafeNominalToUTC :: NominalDiffTime -> UTCTime +unsafeNominalToUTC = flip addUTCTime zeroUTCTime + +toRUTCTime :: UTCTime -> RUTCTime +toRUTCTime = RUTCTime . unsafeUTCToNominal + +fromRUTCTime :: RUTCTime -> UTCTime +fromRUTCTime = unsafeNominalToUTC . unRUTCTime diff --git a/bench/locli/src/Data/Accum.hs b/bench/locli/src/Data/Accum.hs index f6c126be0b1..b4e87ba29f6 100644 --- a/bench/locli/src/Data/Accum.hs +++ b/bench/locli/src/Data/Accum.hs @@ -10,7 +10,6 @@ module Data.Accum , divAccum , mulAccum , updateAccum - , zeroUTCTime -- Various accumulators , mkAccumNew , mkAccumDelta diff --git a/bench/locli/src/Data/CDF.hs b/bench/locli/src/Data/CDF.hs index d66e25e7f97..9df590df9db 100644 --- a/bench/locli/src/Data/CDF.hs +++ b/bench/locli/src/Data/CDF.hs @@ -27,7 +27,7 @@ module Data.CDF , CDFError (..) , CDF(..) , cdf - , cdfRatioCDF + , cdfZ , cdfAverageVal , centilesCDF , filterCDF @@ -38,11 +38,14 @@ module Data.CDF , indexCDF , CDFIx (..) , KnownCDF (..) + , CDFList , liftCDFVal , unliftCDFVal , unliftCDFValExtra + , arity , cdfArity , cdfArity' + , arityProj , mapCDFCentiles , Combine (..) , stdCombine1 @@ -147,6 +150,8 @@ instance Divisible NominalDiffTime where divide x by = x / secondsToNominalDiffTime by fromDouble = secondsToNominalDiffTime +deriving newtype instance Divisible RUTCTime + weightedAverage :: forall b. (Divisible b) => [(Int, b)] -> b weightedAverage xs = (`divide` (fromIntegral . sum $ fst <$> xs)) . sum $ @@ -162,26 +167,13 @@ data CDF p a = CDF { cdfSize :: Int , cdfAverage :: p Double + , cdfMedian :: a , cdfStddev :: Double , cdfRange :: Interval a , cdfSamples :: [(Centile, p a)] } deriving (Functor, Generic) -cdfRatioCDF :: forall a. Fractional a => CDF I a -> CDF I a -> CDF I a -cdfRatioCDF x y = - CDF - { cdfSize = cdfSize x - , cdfAverage = I $ ((/) `on` unI . cdfAverage) x y - , cdfStddev = cdfStddev x * cdfStddev y - , cdfRange = Interval (((/) `on` low . cdfRange) x y) (((/) `on` high . cdfRange) x y) - , cdfSamples = (zipWith divCentile `on` cdfSamples) x y - } - where divCentile :: (Centile, I a) -> (Centile, I a) -> (Centile, I a) - divCentile (cx, I x') (cy, I y') = - if cx == cy then (cx, I $ x' / y') - else error "Centile incoherency: %s vs %s" (show cx) (show cy) - deriving instance (Eq a, Eq (p a), Eq (p Double)) => Eq (CDF p a) deriving instance (Show a, Show (p a), Show (p Double)) => Show (CDF p a) deriving instance (NFData a, NFData (p a), NFData (p Double)) => NFData (CDF p a) @@ -225,6 +217,7 @@ zeroCDF = CDF { cdfSize = 0 , cdfAverage = liftCDFVal 0 cdfIx + , cdfMedian = 0 , cdfStddev = 0 , cdfRange = Interval 0 0 , cdfSamples = mempty @@ -236,6 +229,7 @@ cdf centiles (sort -> sorted) = CDF { cdfSize = size , cdfAverage = I . fromDouble $ Stat.mean doubleVec + , cdfMedian = vecCentile vec size (Centile 0.5) , cdfStddev = Stat.stdDev doubleVec , cdfRange = Interval mini maxi , cdfSamples = @@ -253,8 +247,20 @@ cdf centiles (sort -> sorted) = then (0, 0) else (vec Vec.! 0, Vec.last vec) --- * Singletons +cdfZ :: forall a. Divisible a => [Centile] -> [a] -> CDF I a +cdfZ cs [] = zeroCDF { cdfSamples = fmap (,I 0) cs } +cdfZ cs xs = cdf cs xs + +-- * Arity dispatch +-- +-- Dealing with polymorphism over: +-- - I +-- - CDF I +-- - CDF (CDF I) -- +-- This toolkit isn't exhaustive, only covering what's actually used. +type CDF2 a = CDF (CDF I) a + data CDFIx p where CDFI :: CDFIx I CDF2 :: CDFIx (CDF I) @@ -265,11 +271,16 @@ class KnownCDF a where instance KnownCDF I where cdfIx = CDFI instance KnownCDF (CDF I) where cdfIx = CDF2 +type family CDFList (f :: Type -> Type) (t :: Type) :: Type where + CDFList I t = t + CDFList (CDF I) t = [t] + liftCDFVal :: forall a p. Real a => a -> CDFIx p -> p a liftCDFVal x = \case CDFI -> I x CDF2 -> CDF { cdfSize = 1 , cdfAverage = I $ toDouble x + , cdfMedian = x , cdfStddev = 0 , cdfRange = point x , cdfSamples = [] @@ -277,7 +288,7 @@ liftCDFVal x = \case unliftCDFVal :: forall a p. Divisible a => CDFIx p -> p a -> a unliftCDFVal CDFI (I x) = x -unliftCDFVal CDF2 CDF{cdfAverage=I cdfAverage} = (1 :: a) `divide` (1 / toDouble cdfAverage) +unliftCDFVal CDF2 CDF{cdfMedian} = (1 :: a) `divide` (1 / toDouble cdfMedian) unliftCDFValExtra :: forall a p. Divisible a => CDFIx p -> p a -> [a] unliftCDFValExtra CDFI (I x) = [x] @@ -290,12 +301,18 @@ unliftCDFValExtra i@CDF2 c@CDF{cdfRange=Interval mi ma, ..} = [ mean where mean = unliftCDFVal i c stddev = (1 :: a) `divide` (1 / cdfStddev) -cdfArity :: forall p a b. KnownCDF p => (CDF I a -> b) -> (CDF (CDF I) a -> b) -> CDF p a -> b -cdfArity fi fcdf x = +arity :: forall p a b. KnownCDF p => (I a -> b) -> (CDF I a -> b) -> p a -> b +arity fi fcdf x = case cdfIx @p of CDFI -> fi x CDF2 -> fcdf x +cdfArity :: forall p a b. KnownCDF p => (CDF I a -> b) -> (CDF (CDF I) a -> b) -> CDF p a -> b +cdfArity fcdf fcdf2 x = + case cdfIx @p of + CDFI -> fcdf x + CDF2 -> fcdf2 x + cdfArity' :: forall p a. KnownCDF p => (CDF I a -> I a) -> (CDF (CDF I) a -> CDF I a) -> CDF p a -> p a cdfArity' fi fcdf x = case cdfIx @p of @@ -305,7 +322,8 @@ cdfArity' fi fcdf x = mapCDFCentiles :: (Centile -> p a -> b) -> CDF p a -> [b] mapCDFCentiles f CDF{..} = fmap (uncurry f) cdfSamples -type CDF2 a = CDF (CDF I) a +arityProj :: forall p a. KnownCDF p => (CDF I a -> a) -> p a -> a +arityProj f = arity unI f data CDFError = CDFIncoherentSamplingLengths [Int] @@ -346,6 +364,7 @@ collapseCDF avg c = CDF { cdfSize = cdfSize c , cdfAverage = I $ cdfAverageVal c + , cdfMedian = avg [cdfMedian c] , cdfRange = cdfRange c & low &&& high & both (avg . (:[])) @@ -359,8 +378,11 @@ collapseCDF avg c = . cdfSamples . snd) -- :: [(Centile a)] } +listMedian :: Ord a => [a] -> a +listMedian ms = sort ms !! div (length ms) 2 + -- | Collapse basic CDFs. -collapseCDFs :: forall a. Combine I a -> [CDF I a] -> Either CDFError (CDF I a) +collapseCDFs :: forall a. Ord a => Combine I a -> [CDF I a] -> Either CDFError (CDF I a) collapseCDFs _ [] = Left CDFEmptyDataset collapseCDFs Combine{..} xs = do unless (all (head lengths ==) lengths) $ @@ -370,6 +392,7 @@ collapseCDFs Combine{..} xs = do pure CDF { cdfSize = sum sizes , cdfAverage = I . fromDouble . cWeightedAverages $ zip sizes avgs + , cdfMedian = listMedian $ xs <&> cdfMedian , cdfRange = xs <&> cdfRange & cRanges , cdfStddev = xs <&> cdfStddev & cStddevs , cdfSamples = coherent <&> @@ -395,7 +418,7 @@ collapseCDFs Combine{..} xs = do -- | Polymorphic, but practically speaking, intended for either: -- 1. given a ([I] -> CDF I) function, and a list of (CDF I), produce a CDF (CDF I), or -- 2. given a ([CDF I] -> CDF I) function, and a list of (CDF (CDF I)), produce a CDF (CDF I) -cdf2OfCDFs :: forall a p. (KnownCDF p) +cdf2OfCDFs :: forall a p. (KnownCDF p, Ord a) => Combine p a -> [CDF p a] -> Either CDFError (CDF (CDF I) a) cdf2OfCDFs _ [] = Left CDFEmptyDataset cdf2OfCDFs Combine{..} xs = do @@ -412,6 +435,7 @@ cdf2OfCDFs Combine{..} xs = do , cdfRange = xs <&> cdfRange & cRanges , cdfStddev = xs <&> cdfStddev & cStddevs , cdfAverage = cdf (nEquicentiles nCDFs) averages -- XXX: unweighted + , cdfMedian = listMedian $ xs <&> cdfMedian , .. } where diff --git a/bench/locli/src/Data/DataDomain.hs b/bench/locli/src/Data/DataDomain.hs index de623be288c..c20aae85b29 100644 --- a/bench/locli/src/Data/DataDomain.hs +++ b/bench/locli/src/Data/DataDomain.hs @@ -1,5 +1,7 @@ {-# LANGUAGE DeriveAnyClass #-} -{-# OPTIONS_GHC -Wno-orphans #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE QuantifiedConstraints #-} +{-# OPTIONS_GHC -Wno-orphans -Wno-partial-fields #-} module Data.DataDomain ( module Data.DataDomain ) @@ -7,50 +9,91 @@ where import Cardano.Prelude +import Witherable qualified as Wither +import Data.List.NonEmpty qualified as NE + import Cardano.Util +import Data.CDF -- * DataDomain -- -data DataDomain a +data DataDomain f a = DataDomain - { ddRaw :: !(Interval a) - , ddFiltered :: !(Maybe (Interval a)) - , ddRawCount :: !Int - , ddFilteredCount :: !Int + { ddRaw :: !(Interval (f a)) + , ddFiltered :: !(Maybe (Interval (f a))) + , ddRawCount :: !(f Int) + , ddFilteredCount :: !(f Int) } - deriving (Generic, Show, ToJSON, FromJSON) - deriving anyclass NFData + deriving (Generic, Functor) -- Perhaps: Plutus.V1.Ledger.Slot.SlotRange = Interval Slot +deriving instance (forall b. FromJSON b => FromJSON (f b), FromJSON a) => FromJSON (DataDomain f a) +deriving instance (forall b. ToJSON b => ToJSON (f b), ToJSON a) => ToJSON (DataDomain f a) +deriving instance (forall b. NFData b => NFData (f b), NFData a) => NFData (DataDomain f a) +deriving instance (forall b. Show b => Show (f b), Show a) => Show (DataDomain f a) + +-- | Key decision of DataDomain merging policy. +data DataDomainComb + = DataDomainComb + { ddcMergeIntervals :: !(forall a. Ord a => + [Interval (I a)] -> Interval (I a)) + , ddcMergeCounts :: !([I Int] -> I Int) + , ddcProjInterval :: !(forall a. + Interval (CDF I a) -> Interval (I a)) + , ddcProjCount :: !(CDF I Int -> I Int) + } + +summariseDataDomains :: Divisible a => [DataDomain I a] -> DataDomain (CDF I) a +summariseDataDomains = traverseDataDomain (cdf briefCentiles . fmap unI) + +traverseDataDomain :: + (Divisible a, Wither.Witherable h) => + (forall b. Divisible b => h (f b) -> g b) + -> h (DataDomain f a) + -> DataDomain g a +traverseDataDomain f = unI . traverseDataDomain' (I . f) + +traverseDataDomain' :: + (Divisible a, Wither.Witherable h, Applicative i) => + (forall b. Divisible b => h (f b) -> i (g b)) + -> h (DataDomain f a) + -> i (DataDomain g a) +traverseDataDomain' f xs = + DataDomain + <$> (Interval <$> f (xs <&> low . ddRaw) <*> f (xs <&> high . ddRaw)) + <*> (let lohis = NE.unzip $ (fmap (low &&& high) . ddFiltered) `Wither.mapMaybe` xs + in Just <$> (Interval <$> f (fst lohis) <*> f (snd lohis))) + <*> f (xs <&> ddRawCount) + <*> f (xs <&> ddFilteredCount) -dataDomainFilterRatio :: DataDomain a -> Double -dataDomainFilterRatio DataDomain{..} = - fromIntegral ddFilteredCount / fromIntegral ddRawCount +dataDomainFilterRatio :: (f Int -> Int) -> DataDomain f a -> Double +dataDomainFilterRatio proj DataDomain{..} = + fromIntegral (proj ddFilteredCount) / fromIntegral (proj ddRawCount) -mkDataDomainInj :: a -> a -> (a -> Int) -> DataDomain a +mkDataDomainInj :: a -> a -> (a -> Int) -> DataDomain I a mkDataDomainInj f l measure = - DataDomain (Interval f l) (Just (Interval f l)) delta delta + DataDomain (Interval (I f) (I l)) (Just (Interval (I f) (I l))) (I delta) (I delta) where delta = measure l - measure f -mkDataDomain :: a -> a -> a -> a -> (a -> Int) -> DataDomain a +mkDataDomain :: a -> a -> a -> a -> (a -> Int) -> DataDomain I a mkDataDomain f l f' l' measure = - DataDomain (Interval f l) (Just (Interval f' l')) - (measure l - measure f) (measure l' - measure f') + DataDomain (Interval (I f) (I l)) (Just (Interval (I f') (I l'))) + (I $ measure l - measure f) (I $ measure l' - measure f') -unionDataDomains :: Ord a => [DataDomain a] -> DataDomain a +unionDataDomains :: Ord a => [DataDomain I a] -> DataDomain I a unionDataDomains xs = DataDomain { ddRaw = unionIntv $ xs <&> ddRaw , ddFiltered = foldEmpty Nothing (Just . unionIntv) $ ddFiltered `mapMaybe` xs - , ddRawCount = sum $ xs <&> ddRawCount - , ddFilteredCount = sum $ xs <&> ddFilteredCount + , ddRawCount = I $ sum $ xs <&> unI . ddRawCount + , ddFilteredCount = I $ sum $ xs <&> unI . ddFilteredCount } -intersectDataDomains :: Ord a => [DataDomain a] -> DataDomain a +intersectDataDomains :: Ord a => [DataDomain I a] -> DataDomain I a intersectDataDomains xs = DataDomain { ddRaw = intersectIntv $ xs <&> ddRaw , ddFiltered = foldEmpty Nothing (Just . intersectIntv) $ ddFiltered `mapMaybe` xs - , ddRawCount = sum $ xs <&> ddRawCount - , ddFilteredCount = sum $ xs <&> ddFilteredCount + , ddRawCount = I $ sum $ xs <&> unI . ddRawCount + , ddFilteredCount = I $ sum $ xs <&> unI . ddFilteredCount } diff --git a/bench/locli/test/Test/Analysis/CDF.hs b/bench/locli/test/Test/Analysis/CDF.hs index f265a1fa0b8..9cd08787aa6 100644 --- a/bench/locli/test/Test/Analysis/CDF.hs +++ b/bench/locli/test/Test/Analysis/CDF.hs @@ -65,6 +65,7 @@ cdf2_3x3x3sh = prop_CDF_I_2x2 = property $ cdfI_2x2 === CDF { cdfSize = 2 + , cdfMedian = 1 , cdfAverage = I 0.5 , cdfStddev = 0.7071067811865476 , cdfRange = Interval 0.0 1.0 @@ -75,9 +76,11 @@ prop_CDF_I_2x2 = property $ cdfI_2x2 === prop_CDF_CDF_I_3x3 = property $ cdf2_3x3 === CDF { cdfSize = 9 + , cdfMedian = 1 , cdfAverage = CDF { cdfSize = 3 + , cdfMedian = 1 , cdfAverage = I 1.0 , cdfStddev = 0.0 , cdfRange = Interval 1.0 1.0 @@ -91,6 +94,7 @@ prop_CDF_CDF_I_3x3 = property $ cdf2_3x3 === [(Centile 0.16666666666666666 ,CDF { cdfSize = 3 + , cdfMedian = 0 , cdfAverage = I 0.0 , cdfStddev = 0.0 , cdfRange = Interval 0.0 0.0 @@ -101,6 +105,7 @@ prop_CDF_CDF_I_3x3 = property $ cdf2_3x3 === ,(Centile 0.5 ,CDF { cdfSize = 3 + , cdfMedian = 1 , cdfAverage = I 1.0 , cdfStddev = 0.0 , cdfRange = Interval 1.0 1.0 @@ -111,6 +116,7 @@ prop_CDF_CDF_I_3x3 = property $ cdf2_3x3 === ,(Centile 0.8333333333333333 ,CDF { cdfSize = 3 + , cdfMedian = 2 , cdfAverage = I 2.0 , cdfStddev = 0.0 , cdfRange = Interval 2.0 2.0 @@ -122,9 +128,11 @@ prop_CDF_CDF_I_3x3 = property $ cdf2_3x3 === prop_CDF_CDF_I_3x3_shifted = property $ cdf2_3x3sh === CDF { cdfSize = 9 + , cdfMedian = 1 , cdfAverage = CDF { cdfSize = 3 + , cdfMedian = 1 , cdfAverage = I 1.0 , cdfStddev = 1.0 , cdfRange = Interval 0.0 2.0 @@ -138,6 +146,7 @@ prop_CDF_CDF_I_3x3_shifted = property $ cdf2_3x3sh === [(Centile 0.16666666666666666 ,CDF { cdfSize = 3 + , cdfMedian = 0 , cdfAverage = I 0.0 , cdfStddev = 1.0 , cdfRange = Interval (-1.0) 1.0 @@ -148,6 +157,7 @@ prop_CDF_CDF_I_3x3_shifted = property $ cdf2_3x3sh === ,(Centile 0.5 ,CDF { cdfSize = 3 + , cdfMedian = 1 , cdfAverage = I 1.0 , cdfStddev = 1.0 , cdfRange = Interval 0.0 2.0 @@ -158,6 +168,7 @@ prop_CDF_CDF_I_3x3_shifted = property $ cdf2_3x3sh === ,(Centile 0.8333333333333333 ,CDF { cdfSize = 3 + , cdfMedian = 2 , cdfAverage = I 2.0 , cdfStddev = 1.0 , cdfRange = Interval 1.0 3.0 @@ -169,9 +180,11 @@ prop_CDF_CDF_I_3x3_shifted = property $ cdf2_3x3sh === prop_CDF_CDF_I_3x3x3_collapsed_shifted = property $ cdf2_3x3x3sh === CDF { cdfSize = 27 + , cdfMedian = 1 , cdfAverage = CDF { cdfSize = 3 + , cdfMedian = 1 , cdfAverage = I 1.0 , cdfStddev = 2.0 , cdfRange = Interval (-1.0) 3.0 @@ -185,6 +198,7 @@ prop_CDF_CDF_I_3x3x3_collapsed_shifted = property $ cdf2_3x3x3sh === [(Centile 0.16666666666666666 ,CDF { cdfSize = 9 + , cdfMedian = 0 , cdfAverage = I 0.0 , cdfStddev = 1.0 , cdfRange = Interval (-3.0) 3.0 @@ -195,6 +209,7 @@ prop_CDF_CDF_I_3x3x3_collapsed_shifted = property $ cdf2_3x3x3sh === ,(Centile 0.5 ,CDF { cdfSize = 9 + , cdfMedian = 1 , cdfAverage = I 1.0 , cdfStddev = 1.0 , cdfRange = Interval (-2.0) 4.0 @@ -205,6 +220,7 @@ prop_CDF_CDF_I_3x3x3_collapsed_shifted = property $ cdf2_3x3x3sh === ,(Centile 0.8333333333333333 ,CDF { cdfSize = 9 + , cdfMedian = 2 , cdfAverage = I 2.0 , cdfStddev = 1.0 , cdfRange = Interval (-1.0) 5.0 diff --git a/nix/workbench/analyse/analyse.sh b/nix/workbench/analyse/analyse.sh index 52a005a8149..622200373e3 100644 --- a/nix/workbench/analyse/analyse.sh +++ b/nix/workbench/analyse/analyse.sh @@ -85,8 +85,9 @@ analysis_allowed_loanys=( analyse_default_op='standard' analyse() { -local sargs=() filters=() -local dump_logobjects= dump_machviews= dump_chain= dump_slots_raw= dump_slots= unfiltered= without_datever_meta= +local sargs=() +local arg_filters=() filter_exprs=() unfiltered= +local dump_logobjects= dump_machviews= dump_chain= dump_slots_raw= dump_slots= without_datever_meta= local multi_aspect='--inter-cdf' rtsmode= force_prepare= local locli_render=() locli_timeline=() locli_args=() @@ -94,12 +95,12 @@ locli_args=() progress "analyse" "args: $(yellow $*)" while test $# -gt 0 do case "$1" in - --filters | -f ) sargs+=($1 "$2"); analysis_add_filters "--filters" "unitary,$2"; shift;; + --filters | -f ) sargs+=($1 "$2"); analysis_add_filters "--filters" 'arg_filters' "unitary,$2"; shift;; --filter-expr | -fex ) sargs+=($1 "$2"); filter_exprs+=($2); shift;; --filter-block-expr | -fbex ) sargs+=($1 "$2"); filter_exprs+=('{ "tag":"CBlock" , "contents": '"$2"'}'); shift;; --filter-slot-expr | -fsex ) sargs+=($1 "$2"); filter_exprs+=('{ "tag":"CSlot" , "contents": '"$2"'}'); shift;; --no-filters | --unfiltered | -u ) - sargs+=($1); analysis_set_filters "--unfiltered" ""; unfiltered='true';; + sargs+=($1); arg_filters=(); unfiltered='true';; --loany-ok ) sargs+=($1); locli_args+=(--loany-ok);; --lodecodeerror-ok ) sargs+=($1); locli_args+=(--lodecodeerror-ok);; --dump-logobjects | -lo ) sargs+=($1); dump_logobjects='true';; @@ -160,14 +161,23 @@ case "$op" in multi-propagation-{control,forger,peers,endtoend} multi-propagation-gnuplot multi-propagation-full + + read-summaries + compute-multi-summary + multi-summary-json + multi-summary-report + write-context ) verbose "analyse" "$(white variance), calling script: $(colorise ${script[*]})" analyse "${sargs[@]}" multi-call 'variance' "$*" ${script[*]} + + ## Ugly patching for compat reasons. + jq '.meta.profile_content' "$(run get-rundir)"/current/meta.json > "$(run get-rundir)"/current/profile.json ;; rerender | render ) local script=( - context + read-context read-propagations propagation-json @@ -182,6 +192,10 @@ case "$op" in clusterperf-org clusterperf-report clusterperf-full + + read-summaries + summary-json + summary-report ) verbose "analyse" "$(white full), calling script: $(colorise ${script[*]})" analyse "${sargs[@]}" map "call ${script[*]}" "$@" @@ -190,7 +204,7 @@ case "$op" in standard | full | std ) local script=( logs $(test -n "$dump_logobjects" && echo 'dump-logobjects') - context + read-context build-mach-views $(test -n "$dump_machviews" && echo 'dump-mach-views') rebuild-chain @@ -229,7 +243,7 @@ case "$op" in block-propagation | blockprop | bp ) local script=( logs $(test -n "$dump_logobjects" && echo 'dump-logobjects') - context + read-context build-mach-views $(test -n "$dump_machviews" && echo 'dump-mach-views') rebuild-chain @@ -267,7 +281,7 @@ case "$op" in performance | perf ) local script=( logs $(test -n "$dump_logobjects" && echo 'dump-logobjects') - context + read-context collect-slots $(test -n "$dump_slots_raw" && echo 'dump-slots-raw') filter-slots $(test -n "$dump_slots" && echo 'dump-slots') @@ -293,7 +307,7 @@ case "$op" in local script=( logs 'dump-logobjects' - context + read-context collect-slots $(test -n "$dump_slots_raw" && echo 'dump-slots-raw') filter-slots $(test -n "$dump_slots" && echo 'dump-slots') @@ -365,11 +379,12 @@ case "$op" in $(for host in ${perf_omit_hosts[*]} do ls "$adir"/logs-$host.flt.json; done)) + local filters=("${arg_filters[@]}") if test -z "$unfiltered" then local filter_names=$(jq '(.analysis.filters // []) | join(",") ' "$dir"/profile.json --raw-output) - analysis_add_filters "profile" "$filter_names" + analysis_add_filters "profile" 'filters' "$filter_names" filter_exprs+=($(jq '(.analysis.filter_exprs // []) | map(tojson) | join(",") @@ -382,34 +397,35 @@ case "$op" in local v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 va vb vc vd ve vf vg vh vi vj vk vl vm vn vo v0=( $* ) v1=("${v0[@]/#logs/ 'unlog' --run-logs \"$adir\"/log-manifest.json ${analysis_allowed_loanys[*]/#/--ok-loany } }") - v2=("${v1[@]/#context/ 'meta-genesis' --run-metafile \"$dir\"/meta.json - --shelley-genesis \"$dir\"/genesis-shelley.json }") - v3=("${v2[@]/#read-chain/ 'read-chain' --chain \"$adir\"/chain.json}") - v4=("${v3[@]/#rebuild-chain/ 'rebuild-chain' ${filters[@]}}") - v5=("${v4[@]/#dump-chain/ 'dump-chain' --chain \"$adir\"/chain.json --chain-rejecta \"$adir\"/chain-rejecta.json }") - v6=("${v5[@]/#chain-timeline/ 'timeline-chain' --timeline \"$adir\"/chain.txt ${locli_render[*]} ${locli_timeline[*]} }") - v7=("${v6[@]/#collect-slots/ 'collect-slots' ${minus_logfiles[*]/#/--ignore-log }}") - v8=("${v7[@]/#filter-slots/ 'filter-slots' ${filters[@]}}") - v9=("${v8[@]/#timeline-slots/ 'timeline-slots' ${locli_render[*]} ${locli_timeline[*]} }") - va=("${v9[@]/#propagation-json/ 'render-propagation' --json \"$adir\"/blockprop.json --full }") - vb=("${va[@]/#propagation-org/ 'render-propagation' --org \"$adir\"/blockprop.org ${locli_render[*]} --full }") - vc=("${vb[@]/#propagation-control/ 'render-propagation' --org-report \"$adir\"/blockprop.control.org ${locli_render[*]} --control }") - vd=("${vc[@]/#propagation-forger/ 'render-propagation' --org-report \"$adir\"/blockprop.forger.org ${locli_render[*]} --forger }") - ve=("${vd[@]/#propagation-peers/ 'render-propagation' --org-report \"$adir\"/blockprop.peers.org ${locli_render[*]} --peers }") - vf=("${ve[@]/#propagation-endtoend/ 'render-propagation' --org-report \"$adir\"/blockprop.endtoend.org ${locli_render[*]} --end-to-end }") - vg=("${vf[@]/#propagation-gnuplot/ 'render-propagation' --gnuplot \"$adir\"/cdf/%s.cdf ${locli_render[*]} --full }") - vh=("${vg[@]/#propagation-full/ 'render-propagation' --pretty \"$adir\"/blockprop-full.txt ${locli_render[*]} --full }") - vi=("${vh[@]/#clusterperf-json/ 'render-clusterperf' --json \"$adir\"/clusterperf.json --full }") - vj=("${vi[@]/#clusterperf-org/ 'render-clusterperf' --org \"$adir\"/clusterperf.org ${locli_render[*]} --full }") - vk=("${vj[@]/#clusterperf-report/ 'render-clusterperf' --org-report \"$adir\"/clusterperf.report.org ${locli_render[*]} --report }") - vl=("${vk[@]/#clusterperf-gnuplot/ 'render-clusterperf' --gnuplot \"$adir\"/cdf/%s.cdf ${locli_render[*]} --full }") - vm=("${vl[@]/#clusterperf-full/ 'render-clusterperf' --pretty \"$adir\"/clusterperf-full.txt ${locli_render[*]} --full }") - vn=("${vm[@]/#read-clusterperfs/ 'read-clusterperfs' --clusterperf \"$adir\"/clusterperf.json }") - vo=("${vn[@]/#read-propagations/ 'read-propagations' --prop \"$adir\"/blockprop.json }") - vp=("${vo[@]/#summary-json/ 'render-summary' --json \"$adir\"/summary.json }") - vq=("${vp[@]/#summary-report/ 'render-summary' --org-report \"$adir\"/summary.org ${locli_render[*]}}") + v2=("${v1[@]/#read-context/ 'read-meta-genesis' --run-metafile \"$dir\"/meta.json --shelley-genesis \"$dir\"/genesis-shelley.json }") + v3=("${v2[@]/#write-context/ 'write-meta-genesis' --run-metafile \"$dir\"/meta.json --shelley-genesis \"$dir\"/genesis-shelley.json }") + v4=("${v3[@]/#read-chain/ 'read-chain' --chain \"$adir\"/chain.json}") + v5=("${v4[@]/#rebuild-chain/ 'rebuild-chain' ${filters[@]}}") + v6=("${v5[@]/#dump-chain/ 'dump-chain' --chain \"$adir\"/chain.json --chain-rejecta \"$adir\"/chain-rejecta.json }") + v7=("${v6[@]/#chain-timeline/ 'timeline-chain' --timeline \"$adir\"/chain.txt ${locli_render[*]} ${locli_timeline[*]} }") + v8=("${v7[@]/#collect-slots/ 'collect-slots' ${minus_logfiles[*]/#/--ignore-log }}") + v9=("${v8[@]/#filter-slots/ 'filter-slots' ${filters[@]}}") + va=("${v9[@]/#timeline-slots/ 'timeline-slots' ${locli_render[*]} ${locli_timeline[*]} }") + vb=("${va[@]/#propagation-json/ 'render-propagation' --json \"$adir\"/blockprop.json --full }") + vc=("${vb[@]/#propagation-org/ 'render-propagation' --org \"$adir\"/blockprop.org ${locli_render[*]} --full }") + vd=("${vc[@]/#propagation-control/ 'render-propagation' --org-report \"$adir\"/blockprop.control.org ${locli_render[*]} --control }") + ve=("${vd[@]/#propagation-forger/ 'render-propagation' --org-report \"$adir\"/blockprop.forger.org ${locli_render[*]} --forger }") + vf=("${ve[@]/#propagation-peers/ 'render-propagation' --org-report \"$adir\"/blockprop.peers.org ${locli_render[*]} --peers }") + vg=("${vf[@]/#propagation-endtoend/ 'render-propagation' --org-report \"$adir\"/blockprop.endtoend.org ${locli_render[*]} --end-to-end }") + vh=("${vg[@]/#propagation-gnuplot/ 'render-propagation' --gnuplot \"$adir\"/cdf/%s.cdf ${locli_render[*]} --full }") + vi=("${vh[@]/#propagation-full/ 'render-propagation' --pretty \"$adir\"/blockprop-full.txt ${locli_render[*]} --full }") + vj=("${vi[@]/#clusterperf-json/ 'render-clusterperf' --json \"$adir\"/clusterperf.json --full }") + vk=("${vj[@]/#clusterperf-org/ 'render-clusterperf' --org \"$adir\"/clusterperf.org ${locli_render[*]} --full }") + vl=("${vk[@]/#clusterperf-report/ 'render-clusterperf' --org-report \"$adir\"/clusterperf.report.org ${locli_render[*]} --report }") + vm=("${vl[@]/#clusterperf-gnuplot/ 'render-clusterperf' --gnuplot \"$adir\"/cdf/%s.cdf ${locli_render[*]} --full }") + vn=("${vm[@]/#clusterperf-full/ 'render-clusterperf' --pretty \"$adir\"/clusterperf-full.txt ${locli_render[*]} --full }") + vo=("${vn[@]/#read-clusterperfs/ 'read-clusterperfs' --clusterperf \"$adir\"/clusterperf.json }") + vp=("${vo[@]/#read-propagations/ 'read-propagations' --prop \"$adir\"/blockprop.json }") + vq=("${vp[@]/#read-summaries/ 'read-summaries' --summary \"$adir\"/summary.json }") + vr=("${vq[@]/#summary-json/ 'render-summary' --json \"$adir\"/summary.json }") + vs=("${vr[@]/#summary-report/ 'render-summary' --org-report \"$adir\"/summary.org ${locli_render[*]}}") local ops_final=() - for v in "${vq[@]}" + for v in "${vs[@]}" do eval ops_final+=($v); done call_locli "$rtsmode" "${ops_final[@]}" @@ -435,37 +451,46 @@ case "$op" in local adirs=( $(for dir in ${dirs[*]}; do echo $dir/analysis; done)) local props=( $(for adir in ${adirs[*]}; do echo --prop ${adir}/blockprop.json; done)) local cperfs=($(for adir in ${adirs[*]}; do echo --clusterperf ${adir}/clusterperf.json; done)) + local summaries=($(for adir in ${adirs[*]}; do echo --summary ${adir}/summary.json; done)) local compares=($(for adir in ${adirs[*]} do echo --summary ${adir}/summary.json \ --perf ${adir}/clusterperf.json \ --prop ${adir}/blockprop.json done)) local run=$(for dir in ${dirs[*]}; do basename $dir; done | sort -r | head -n1 | cut -d. -f1-2)_$suffix - local adir=$(run get-rundir)/$run + local rundir=$(run get-rundir) + local dir=$rundir/$run + local adir=$dir/analysis - mkdir -p "$adir/cdf" + mkdir -p "$adir"/{cdf,png} + rm -f "$rundir/current" + ln -sf "$run" "$rundir/current" progress "analysis | multi-call" "output $(yellow $run), inputs: $(white ${runs[*]})" local v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 va vb vc vd ve vf vg vh vi vj vk vl vm vn vo v0=("$@") - v1=(${v0[*]/#read-clusterperfs/ 'read-clusterperfs' ${cperfs[*]} }) - v2=(${v1[*]/#read-propagations/ 'read-propagations' ${props[*]} }) - v3=(${v2[*]/#multi-clusterperf-json/ 'render-multi-clusterperf' --json $adir/'clusterperf.json' --full $multi_aspect }) - v4=(${v3[*]/#multi-clusterperf-org/ 'render-multi-clusterperf' --org $adir/'clusterperf.org' --full $multi_aspect }) - v5=(${v4[*]/#multi-clusterperf-report/ 'render-multi-clusterperf' --org-report $adir/'clusterperf.report.org' --report $multi_aspect }) - v6=(${v5[*]/#multi-clusterperf-gnuplot/ 'render-multi-clusterperf' --gnuplot $adir/cdf/'%s.cdf' --full $multi_aspect }) - v7=(${v6[*]/#multi-clusterperf-full/ 'render-multi-clusterperf' --pretty $adir/'clusterperf-full.txt' --full $multi_aspect }) - v8=(${v7[*]/#multi-propagation-json/ 'render-multi-propagation' --json $adir/'blockprop.json' --full $multi_aspect }) - v9=(${v8[*]/#multi-propagation-org/ 'render-multi-propagation' --org $adir/'blockprop.org' --full $multi_aspect }) - va=(${v9[*]/#multi-propagation-control/ 'render-multi-propagation' --org-report $adir/'blockprop.control.org' --control $multi_aspect }) - vb=(${va[*]/#multi-propagation-forger/ 'render-multi-propagation' --org-report $adir/'blockprop.forger.org' --forger $multi_aspect }) - vc=(${vb[*]/#multi-propagation-peers/ 'render-multi-propagation' --org-report $adir/'blockprop.peers.org' --peers $multi_aspect }) - vd=(${vc[*]/#multi-propagation-endtoend/ 'render-multi-propagation' --org-report $adir/'blockprop.endtoend.org' --end-to-end $multi_aspect }) - ve=(${vd[*]/#multi-propagation-gnuplot/ 'render-multi-propagation' --gnuplot $adir/cdf/'%s.cdf' --full $multi_aspect }) - vf=(${ve[*]/#multi-propagation-full/ 'render-multi-propagation' --pretty $adir/'blockprop-full.txt' --full $multi_aspect }) - vg=(${vf[*]/#compare/ 'compare' --ede nix/workbench/ede --report $adir/report-$run.org ${compares[*]} }) - vh=(${vg[*]/#update/ 'compare' --ede nix/workbench/ede --report $adir/report-$run.org ${compares[*]} --template $adir/report-$run.ede }) - local ops_final=(${vh[*]}) + v1=(${v0[*]/#read-clusterperfs/ 'read-clusterperfs' ${cperfs[*]} }) + v2=(${v1[*]/#read-propagations/ 'read-propagations' ${props[*]} }) + v3=(${v2[@]/#read-summaries/ 'read-summaries' ${summaries[*]} }) + v4=(${v3[*]/#multi-clusterperf-json/ 'render-multi-clusterperf' --json $adir/'clusterperf.json' --full $multi_aspect }) + v5=(${v4[*]/#multi-clusterperf-org/ 'render-multi-clusterperf' --org $adir/'clusterperf.org' --full $multi_aspect }) + v6=(${v5[*]/#multi-clusterperf-report/ 'render-multi-clusterperf' --org-report $adir/'clusterperf.report.org' --report $multi_aspect }) + v7=(${v6[*]/#multi-clusterperf-gnuplot/ 'render-multi-clusterperf' --gnuplot $adir/cdf/'%s.cdf' --full $multi_aspect }) + v8=(${v7[*]/#multi-clusterperf-full/ 'render-multi-clusterperf' --pretty $adir/'clusterperf-full.txt' --full $multi_aspect }) + v9=(${v8[*]/#multi-propagation-json/ 'render-multi-propagation' --json $adir/'blockprop.json' --full $multi_aspect }) + va=(${v9[*]/#multi-propagation-org/ 'render-multi-propagation' --org $adir/'blockprop.org' --full $multi_aspect }) + vb=(${va[*]/#multi-propagation-control/ 'render-multi-propagation' --org-report $adir/'blockprop.control.org' --control $multi_aspect }) + vc=(${vb[*]/#multi-propagation-forger/ 'render-multi-propagation' --org-report $adir/'blockprop.forger.org' --forger $multi_aspect }) + vd=(${vc[*]/#multi-propagation-peers/ 'render-multi-propagation' --org-report $adir/'blockprop.peers.org' --peers $multi_aspect }) + ve=(${vd[*]/#multi-propagation-endtoend/ 'render-multi-propagation' --org-report $adir/'blockprop.endtoend.org' --end-to-end $multi_aspect }) + vf=(${ve[*]/#multi-propagation-gnuplot/ 'render-multi-propagation' --gnuplot $adir/cdf/'%s.cdf' --full $multi_aspect }) + vg=(${vf[*]/#multi-propagation-full/ 'render-multi-propagation' --pretty $adir/'blockprop-full.txt' --full $multi_aspect }) + vh=(${vg[*]/#compare/ 'compare' --ede nix/workbench/ede --report $adir/report-$run.org ${compares[*]} }) + vi=(${vh[*]/#update/ 'compare' --ede nix/workbench/ede --report $adir/report-$run.org ${compares[*]} --template $adir/report-$run.ede }) + vj=(${vi[*]/#multi-summary-json/ 'render-multi-summary' --json $adir/'summary.json' }) + vk=(${vj[*]/#multi-summary-report/ 'render-multi-summary' --org-report $adir/'summary.org' }) + vl=(${vk[@]/#write-context/ 'write-meta-genesis' --run-metafile $dir/meta.json --shelley-genesis $dir/genesis-shelley.json }) + local ops_final=(${vl[*]}) call_locli "$rtsmode" "${ops_final[@]}" @@ -483,7 +508,7 @@ case "$op" in progress "analyse" "preparing run for analysis: $(with_color white $name)" local adir=$dir/analysis - mkdir -p "$adir/cdf" + mkdir -p "$adir"/{cdf,png} ## 0. ask locli what it cares about local keyfile="$adir"/substring-keys @@ -619,7 +644,7 @@ call_locli() { * ) fail "unknown rtsmode: $rtsmode";; esac - verbose "analysis | locli" "$(with_color reset ${locli_args[@]}) $(colorise "${args[*]}")" + verbose "analysis | locli" "$(with_color reset ${locli_args[@]}) $(colorise ${args[*]})" time locli "${locli_args[@]}" "${args[@]}" } @@ -638,7 +663,7 @@ filter_path() { } analysis_add_filters() { - local context=$1 flts=$2 + local context=$1 var=$2 flts=$3 local filter_names=($(echo $flts | sed 's_,_ _g')) local filter_paths=(${filter_names[*]/#/"$(filter_path)/"}) local filter_files=(${filter_paths[*]/%/.json}) @@ -648,23 +673,8 @@ analysis_add_filters() { fail "no such filter: $f"; done progress "analyse" "adding filters from $context: $(yellow ${filter_files[*]})" - filters+=(${filter_files[*]/#/--filter }) - verbose "analyse" "filters args: $(yellow ${filters[*]})" -} - -analysis_set_filters() { - local context=$1 flts=$2 - local filter_names=($(echo $flts | sed 's_,_ _g')) - local filter_paths=(${filter_names[*]/#/"$global_basedir/analyse/chain-filters/"}) - local filter_files=(${filter_paths[*]/%/.json}) - - for f in ${filter_files[*]} - do test -f "$f" || - fail "no such filter: $f"; done - - progress "analyse" "setting filters from $context: $(yellow ${filter_files[*]})" - filters=(${filter_files[*]/#/--filter }) - verbose "analyse" "filters args: $(yellow ${filters[*]})" + eval "$var+=(\${filter_files[*]/#/--filter })" + eval 'verbose "analyse" "$var: $(yellow ${'$var'[*]})"' } trace_frequencies_json() { diff --git a/nix/workbench/ede/chart.ede b/nix/workbench/ede/chart.ede index 3dd51264134..5b4f885915b 100644 --- a/nix/workbench/ede/chart.ede +++ b/nix/workbench/ede/chart.ede @@ -1,4 +1,4 @@ -#+begin_src gnuplot :file {{ args.deField }}.png +#+begin_src gnuplot :file png/{{ args.deField }}.png load "../../bench/workbench.gnuplot" {% if args.deLogScale == "true" %} set logscale y diff --git a/nix/workbench/ede/report.ede b/nix/workbench/ede/report.ede index b7014e4125b..e3e779c9363 100644 --- a/nix/workbench/ede/report.ede +++ b/nix/workbench/ede/report.ede @@ -1,7 +1,7 @@ #+CONSTANTS: {{ summary.dataRef }}={{ summary.orgFile }}{% for sec in analyses %} {{ sec.value.dataRef }}={{ sec.value.orgFile }} {% endfor %} -#+CONSTANTS: base=../{{ base.meta.tag }}/analysis +#+CONSTANTS: base=../../{{ base.meta.tag }}/analysis {% for run in runs %} -#+CONSTANTS: run{{ run.index }}=../{{ run.value.meta.tag }}/analysis +#+CONSTANTS: run{{ run.index }}=../../{{ run.value.meta.tag }}/analysis {% endfor %} #+LATEX_CLASS: report #+LATEX_CLASS_OPTIONS: [a4paper,7pt] diff --git a/nix/workbench/ede/tablevars-delta-pct.ede b/nix/workbench/ede/tablevars-delta-pct.ede index 8b2f57f7065..d87f6712874 100644 --- a/nix/workbench/ede/tablevars-delta-pct.ede +++ b/nix/workbench/ede/tablevars-delta-pct.ede @@ -7,4 +7,4 @@ {% for var in table.vars %} | | {% for run in runs %} | | | {% endfor %} | {% endfor %} -#+TBLFM: $2='(identity remote(file:$base/${{ table.dataRef }},@@#${{ table.valueCol }})); N f-3::$1='(identity remote(file:$base/${{ table.dataRef }},@@#${{ table.nameCol }})){% for var in table.vars %}::@{{ var.value.angles }}$1=string("{{ var.value.name }}")::@{{ var.value.angles }}$2='(identity remote(file:$base/${{ table.dataRef }},${{var.key}})){% endfor %}{% for run in runs %}::${{ run.index * 3 }}='(identity remote(file:$run{{ run.index }}/${{ table.dataRef }},@@#${{ table.valueCol }})); N f-3::${{ run.index * 3 + 1 }}=${{ run.index * 3 }}-$2; N f-3::${{ run.index * 3 + 2 }}=if($2 == 0, string("nan"), round(100*${{ run.index * 3 + 1 }}/$2)){% for var in table.vars %}::@{{ var.value.angles }}${{ run.index * 3 }}='(identity remote(file:$base/${{ table.dataRef }},${{var.key}}))::@{{ var.value.angles }}${{ run.index * 3 + 1 }}=string("")::@{{ var.value.angles }}${{ run.index * 3 + 2 }}=string(""){% endfor %}{% endfor %} +#+TBLFM: $2='(identity remote(file:$base/${{ table.dataRef }},@@#${{ table.valueCol }})); N f-3::$1='(identity remote(file:$base/${{ table.dataRef }},@@#${{ table.nameCol }})){% for var in table.vars %}::@{{ var.value.angles }}$1=string("{{ var.value.name }}")::@{{ var.value.angles }}$2='(identity remote(file:$base/${{ table.dataRef }},${{var.key}})){% endfor %}{% for run in runs %}::${{ run.index * 3 }}='(identity remote(file:$run{{ run.index }}/${{ table.dataRef }},@@#${{ table.valueCol }})); N f-3::${{ run.index * 3 + 1 }}=${{ run.index * 3 }}-$2; N f-3::${{ run.index * 3 + 2 }}=if($2 == 0, string("nan"), round(100*${{ run.index * 3 + 1 }}/$2)){% for var in table.vars %}::@{{ var.value.angles }}${{ run.index * 3 }}='(identity remote(file:$run{{ run.index }}/${{ table.dataRef }},${{var.key}}))::@{{ var.value.angles }}${{ run.index * 3 + 1 }}=string("")::@{{ var.value.angles }}${{ run.index * 3 + 2 }}=string(""){% endfor %}{% endfor %} diff --git a/nix/workbench/ede/tablevars-delta.ede b/nix/workbench/ede/tablevars-delta.ede index 560780529d3..d6945c102ff 100644 --- a/nix/workbench/ede/tablevars-delta.ede +++ b/nix/workbench/ede/tablevars-delta.ede @@ -7,4 +7,4 @@ {% for var in table.vars %} | | {% for run in runs %} | | {% endfor %} | {% endfor %} -#+TBLFM: $2='(identity remote(file:$base/${{ table.dataRef }},@@#${{ table.valueCol }})); N f-3::$1='(identity remote(file:$base/${{ table.dataRef }},@@#${{ table.nameCol }})){% for var in table.vars %}::@{{ var.value.angles }}$1=string("{{ var.value.name }}")::@{{ var.value.angles }}$2='(identity remote(file:$base/${{ table.dataRef }},${{var.key}})){% endfor %}{% for run in runs %}::${{ run.index * 2 }}='(identity remote(file:$run{{ run.index }}/${{ table.dataRef }},@@#${{ table.valueCol }})); N f-3::${{ run.index * 2 + 1 }}=${{ run.index * 2 }}-$2; N f-3::@{{ var.value.angles }}${{ run.index * 2 }}='(identity remote(file:$base/${{ table.dataRef }},${{var.key}}))::@{{ var.value.angles }}${{ run.index * 2 + 1 }}=string(""){% endfor %}{% endfor %} +#+TBLFM: $2='(identity remote(file:$base/${{ table.dataRef }},@@#${{ table.valueCol }})); N f-3::$1='(identity remote(file:$base/${{ table.dataRef }},@@#${{ table.nameCol }})){% for var in table.vars %}::@{{ var.value.angles }}$1=string("{{ var.value.name }}")::@{{ var.value.angles }}$2='(identity remote(file:$base/${{ table.dataRef }},${{var.key}})){% endfor %}{% for run in runs %}::${{ run.index * 2 }}='(identity remote(file:$run{{ run.index }}/${{ table.dataRef }},@@#${{ table.valueCol }})); N f-3::${{ run.index * 2 + 1 }}=${{ run.index * 2 }}-$2; N f-3::@{{ var.value.angles }}${{ run.index * 2 }}='(identity remote(file:$run{{ run.index }}/${{ table.dataRef }},${{var.key}}))::@{{ var.value.angles }}${{ run.index * 2 + 1 }}=string(""){% endfor %}{% endfor %} diff --git a/nix/workbench/profile/prof3-derived.jq b/nix/workbench/profile/prof3-derived.jq index e642bc3ab6b..3d4d32e4363 100644 --- a/nix/workbench/profile/prof3-derived.jq +++ b/nix/workbench/profile/prof3-derived.jq @@ -201,7 +201,7 @@ def add_derived_params: (if $n_pools == 0 then [] else [ { tag: "CBlock", contents: { tag: "BMinimumAdoptions" - , contents: ($n_pools - 1) } } + , contents: ($n_pools - 1) } } ] end)) } })