So this is a fun bundle of patches..â After the "get it done" but "try
not to touch/break anything important" first attempt at Graphing, this
bundle of patches factors out the common parts of tabulateRepo/graphRepo.
Hopefully the end result is a lot more readable than Report.hs used to
be.
The key here is a new data type RepoTableâ Instead of tabulateRepo/
graphRepo using [(Test a, Maybe MemTimeOutput)], they now both work
with the new RepoTable dataâ RepoTable provides: repo name, row names,
column names, and a "square" table that should line up with the row
and column names.
This is a huge refactor, so I'm somewhat skeptical that it works as
advertised, but at least it seems to in the report that I've been using.
I expect this to be thoroughly reviewed, because it is such a deep
refactor.
Also, is there a purpose for the vestigial benchMany in Run.hs? I
refactored it while I was at it, but grep certainly doesn't turn up
any actual uses of it.
Thu May 6 21:00:16 EDT 2010 Max Battcher <m...@worldmaker.net>
* Data format and converter for "square" repo tables
This data object is meant to be the format accepted by
graphRepo/tabulateRepo.
Thu May 6 22:13:31 EDT 2010 Max Battcher <m...@worldmaker.net>
* Move graphRepo to RepoTable
Fri May 7 03:04:53 EDT 2010 Max Battcher <m...@worldmaker.net>
* Refactor tabulateRepo to use RepoTable
Fri May 7 03:06:02 EDT 2010 Max Battcher <m...@worldmaker.net>
* repoTables should use trCoreName; force sort
It seems better to actually sort the input results than to assume they
are sorted.
Fri May 7 03:24:35 EDT 2010 Max Battcher <m...@worldmaker.net>
* Refactor Run.hs to use updated tabulateRepo
New patches:
[Data format and converter for "square" repo tables
Max Battcher <m...@worldmaker.net>**20100507010016
Ignore-this: 8cc0eba57714245524a200a9f2627ee
This data object is meant to be the format accepted by
graphRepo/tabulateRepo.
] hunk ./Definitions.hs 209
time_v = toU [ t | MemTime _ t <- xs ]
mem_v = toU [ fromRational m | MemTime m _ <- xs ]
+data RepoTable = RepoTable { rtRepo :: String
+ , rtColumns :: [String]
+ , rtRows :: [String]
+ , rtTable :: [(TimeUnit, [Maybe MemTimeOutput])]
+ }
+
+-- Reformat (test, output) array as a square table
+repoTables :: [Benchmark ()] -> [(Test a, Maybe MemTimeOutput)] -> [RepoTable]
+repoTables benchmarks results = [RepoTable { rtRepo = reponame (head repo)
+ , rtColumns = columns
+ , rtRows = rows
+ , rtTable = table repo
+ } | repo <- reposResults]
+ where
+ reposResults = groupBy sameRepo results -- ASSUME: ordered by repository
+ sameRepo (Test _ tr1 _, _) (Test _ tr2 _, _) = trName tr1 == trName tr2
+ reponame (Test _ tr _, _) = trName tr
+ --
+ rows = map description . filter hasBenchmark $ benchmarks
+ hasBenchmark b = any (\ (Test tb _ _, _) -> description tb == description b) results
+ --
+ columns = map mkColName columnInfos
+ columnInfos = nub [ (b, trName tr) | (Test _ tr b, _) <- results ]
+ mkColName (TestBinary b, tname) =
+ let v = nameToVariant tname
+ prefix = case vId v of
+ DefaultVariant -> ""
+ _-> vSuffix v ++ " "
+ in prefix ++ cutdown b
+ cutdown d | "darcs-" `isPrefixOf` d = cutdown (drop 6 d)
+ | takeExtension d == ".exe" = dropExtension d
+ | otherwise = d
+ --
+ table repo = [(tu (tableRow row), map justMemTimeOutput $ tableRow row)
+ | row <- rows]
+ where
+ tableRow row = [find (match row col) repo | col <- columnInfos]
+ getTime (Just (_, Just mt)) = Just (mtTimeMean mt)
+ getTime _ = Nothing
+ tu row = case mapMaybe getTime row of
+ [] -> Milliseconds
+ xs -> appropriateUnit (minimum xs)
+ match bench (binary, name) (Test bench' tr binary', _) =
+ bench == description bench' && binary == binary' && trName tr == name
+ justMemTimeOutput (Just (_, mt)) = mt
+ justMemTimeOutput Nothing = Nothing
+
data TimeUnit = MinutesAndSeconds | Milliseconds
formatTimeElapsed :: TimeUnit -> Double -> String
[Move graphRepo to RepoTable
Max Battcher <m...@worldmaker.net>**20100507021331
Ignore-this: 9e5924852acd29368fd6f9201a33b502
] hunk ./Graph.hs 1
-module Graph ( graph ) where
+module Graph where
import Data.List
import Data.Maybe
hunk ./Graph.hs 11
import Definitions
import Standard
--- A Formatter with Double output instead of String
-type Selector = TimeUnit -> Maybe MemTimeOutput -> Double
-
-selectMemory :: Selector
-selectMemory _ (Just mt) = fromRational (mtMemMean mt) / (1024 * 1024)
-selectMemory _ _ = 0.0
-
-selectTime :: Selector
-selectTime Milliseconds (Just mt) = mtTimeMean mt * 1000
-selectTime MinutesAndSeconds (Just mt) = mtTimeMean mt
-selectTime _ _ = 0.0
-
-graph :: Bool -- ^ Select for Time, else Memory
- -> [(Test a, Maybe MemTimeOutput)] -> [(String, String)]
-graph timeresults results = map graphs coreNames
+graphRepoMemory :: RepoTable -> [String]
+graphRepoMemory repo = map graphUrl rows
where
hunk ./Graph.hs 14
- graphs cname = (cname, mkGraphs cname)
- coreNames = nub [ trCoreName r | (Test _ r _, _) <- results ]
- mkGraphs cname = graphRepo timeresults cname results
+ rows = [(title rowname, rtColumns repo, graphdata rowdata)
+ | (rowname, (tu, rowdata)) <- zip (rtRows repo) (rtTable repo)]
+ title rowname = rowname ++ " (MiB)"
+ graphdata rowdata = map selectMemory rowdata
+ selectMemory (Just mt) = fromRational (mtMemMean mt) / (1024 * 1024)
+ selectMemory _ = 0.0
hunk ./Graph.hs 21
-graphRepo :: Bool -- ^ Select for Time, else Memory
- -> String -- ^ Repo name
- -> [(Test a, Maybe MemTimeOutput)] -> String
-graphRepo timeresults repo results = unlines $ map (graphDirective . graphUrl) rs
+graphRepoTime :: RepoTable -> [String]
+graphRepoTime repo = map graphUrl rows
where
hunk ./Graph.hs 24
- -- the results which correspond to the repo in question (or a variant thereof)
- interesting = [ test | test@(Test _ r _, _) <- results, trCoreName r == repo ]
- columns = nub [ (b, trName tr) | (Test _ tr b, _) <- interesting ]
- rownames = map description . filter hasBenchmark $ benchmarks
- hasBenchmark b = any (\ (Test tb _ _, _) -> description tb == description b) interesting
- rows = [catMaybes [find (match row col) interesting | col <- columns]
- | row <- rownames]
- match bench (binary,name) (Test bench' tr binary', _) =
- bench == description bench' && binary == binary' && trName tr == name
- rs = [(title (head row) row, map mkColName columns, rowdata row)
- | row <- rows]
- mkColName (TestBinary b, tname) =
- let v = nameToVariant tname
- prefix = case vId v of
- DefaultVariant -> ""
- _-> vSuffix v ++ " "
- in prefix ++ cutdown b
- cutdown d | "darcs-" `isPrefixOf` d = cutdown (drop 6 d)
- | takeExtension d == ".exe" = dropExtension d
- | otherwise = d
- rowdata row = [select (tu row) mt | (_, mt) <- row]
- title (Test b _ _, _) row = description b ++ " (" ++ unitName (tu row) ++ ")"
- select = if timeresults then selectTime else selectMemory
- unitName tu = case (timeresults, tu) of
- (True, Milliseconds) -> "ms"
- (True, MinutesAndSeconds) -> "s"
- (False, _) -> "MiB"
- tu row = case timeresults of
- True -> case mapMaybe getTime row of
- [] -> Milliseconds
- xs -> appropriateUnit (minimum xs)
- False -> Milliseconds
- getTime (_, Just mt) = Just $ mtTimeMean mt
- getTime _ = Nothing
-
-graphDirective :: String -> String
-graphDirective = (++) ".. image:: "
+ rows = [(title tu rowname, rtColumns repo, graphdata tu rowdata)
+ | (rowname, (tu, rowdata)) <- zip (rtRows repo) (rtTable repo)]
+ title Milliseconds rowname = rowname ++ " (ms)"
+ title MinutesAndSeconds rowname = rowname ++ " (s)"
+ graphdata tu rowdata = map (selectTime tu) rowdata
+ selectTime Milliseconds (Just mt) = mtTimeMean mt * 1000
+ selectTime MinutesAndSeconds (Just mt) = mtTimeMean mt
+ selectTime _ _ = 0.0
graphUrl :: (String, [String], [Double]) -> String
graphUrl (title, labels, results) = getChartUrl $ do
hunk ./Report.hs 171
, intercalate "\n" (map showG m_graphs)
]
where
+ tables = repoTables benchmarks results
+ --
machine_details = intercalate "\n" $
map detail [ "GHC version"
, "Machine description", "Year", "CPU", "Memory", "Hard disk"
hunk ./Report.hs 191
, ""
, TR.render id id id t ]
--
- t_graphs = graph True results
- m_graphs = graph False results
- showG (r,g) = intercalate "\n" [ r
- , replicate (length r) '-'
- , ""
- , g]
+ t_graphs = map (repoTuple graphRepoTime) tables
+ m_graphs = map (repoTuple graphRepoMemory) tables
+ showG (r,gs) = intercalate "\n" $ [ r
+ , replicate (length r) '-'
+ , ""
+ ] ++ (map imgDirective gs) ++ [""]
+ imgDirective = (".. image:: " ++)
printCumulativeReport :: Command ()
printCumulativeReport = do
[Refactor tabulateRepo to use RepoTable
Max Battcher <m...@worldmaker.net>**20100507070453
Ignore-this: a814543a9b70b6b448df2ee789d7cd26
] hunk ./Report.hs 29
type BenchmarkTable = Tab.Table String String String
-tabulateRepo :: Formatter
- -> String -> [(Test a, Maybe MemTimeOutput)] -> Tab.Table String String String
-tabulateRepo format repo results = Tab.Table rowhdrs colhdrs rows
+tabulateRepo :: Formatter -> RepoTable -> Tab.Table String String String
+tabulateRepo format repo = Tab.Table rowhdrs colhdrs rows
where
hunk ./Report.hs 32
- -- the results which correspond to the repo in question (or a variant thereof)
- interesting = [ test | test@(Test _ r _, _) <- results, trCoreName r == repo ]
- -- keep in mind that not all variants for all binaries may be available
- columns = nub [ (b, trName tr) | (Test _ tr b, _) <- interesting ]
- rownames = map description . filter hasBenchmark $ benchmarks
- hasBenchmark b = any (\ (Test tb _ _, _) -> description tb == description b) interesting
- -- headers
- rowhdrs = Tab.Group Tab.NoLine $ map Tab.Header rownames
+ rowhdrs = Tab.Group Tab.NoLine $ map Tab.Header (rtRows repo)
colhdrs = Tab.Group Tab.SingleLine $ map Tab.Header $
hunk ./Report.hs 34
- concatMap (format myundefined . ColHeader . mkColName) $ columns
- myundefined = error "column headers have no time units"
- mkColName (TestBinary b, tname) =
- let v = nameToVariant tname
- prefix = case vId v of
- DefaultVariant -> ""
- _-> vSuffix v ++ " "
- in prefix ++ cutdown b
- cutdown d | "darcs-" `isPrefixOf` d = cutdown (drop 6 d)
- | takeExtension d == ".exe" = dropExtension d
- | otherwise = d
- -- the cells themselves
- mkRow row = concatMap (fmt tu) rawColumns
- where
- rawColumns = [ find (match row col) interesting | col <- columns ]
- getTime (Just (_, Just mt)) = Just (mtTimeMean mt)
- getTime _ = Nothing
- -- time unit corresponding to the smallest time value in the row
- tu = case mapMaybe getTime rawColumns of
- [] -> Milliseconds
- xs -> appropriateUnit (minimum xs)
- rows = map mkRow rownames
- match bench (binary,name) (Test bench' tr binary', _) =
- bench == description bench' && binary == binary' && trName tr == name
- fmt tu (Just (_, Just x)) = format tu (Cell x)
- fmt tu _ = format tu MissingCell
-
-tabulate :: Formatter -> [(Test a, Maybe MemTimeOutput)] -> [(String, BenchmarkTable)]
-tabulate format results =
- map tables coreNames
- where
- tables cname = (cname, mkTable cname)
- coreNames = nub [ trCoreName r | (Test _ r _, _) <- results ]
- mkTable r = tabulateRepo format r results
+ concatMap (format myundefined . ColHeader) $ rtColumns repo
+ myundefined = error "Formatting is undefined for column headers"
+ rows = map formatRow $ rtTable repo
+ formatRow (tu, rs) = concatMap (fmt tu) rs
+ fmt tu (Just mt) = format tu (Cell mt)
+ fmt tu Nothing = format tu MissingCell
-- ----------------------------------------------------------------------
-- timings files
hunk ./Report.hs 148
describe v = def (vSuffix v) (vDescription v ++ " variant")
def k v = "* " ++ k ++ " = " ++ v
--
- t_tables = tabulate formatTimeResult results
- m_tables = tabulate formatMemoryResult results
+ repoTuple tabulate repo = (rtRepo repo, tabulate repo)
+ t_tables = map (repoTuple $ tabulateRepo formatTimeResult) tables
+ m_tables = map (repoTuple $ tabulateRepo formatMemoryResult) tables
showT (r,t) = intercalate "\n" [ r
, replicate (length r) '-'
, ""
[repoTables should use trCoreName; force sort
Max Battcher <m...@worldmaker.net>**20100507070602
Ignore-this: d7cc860269be56bcdd24e056afea2400
It seems better to actually sort the input results than to assume they
are sorted.
] hunk ./Definitions.hs 215
, rtTable :: [(TimeUnit, [Maybe MemTimeOutput])]
}
--- Reformat (test, output) array as a square table
+-- Reformat (test, output) array as a square table by (core) Repository
repoTables :: [Benchmark ()] -> [(Test a, Maybe MemTimeOutput)] -> [RepoTable]
repoTables benchmarks results = [RepoTable { rtRepo = reponame (head repo)
, rtColumns = columns
hunk ./Definitions.hs 223
, rtTable = table repo
} | repo <- reposResults]
where
- reposResults = groupBy sameRepo results -- ASSUME: ordered by repository
- sameRepo (Test _ tr1 _, _) (Test _ tr2 _, _) = trName tr1 == trName tr2
- reponame (Test _ tr _, _) = trName tr
+ reposResults = groupBy sameRepo $ sortBy repoOrder results
+ sameRepo (Test _ tr1 _, _) (Test _ tr2 _, _) = trCoreName tr1 == trCoreName tr2
+ reponame (Test _ tr _, _) = trCoreName tr
+ repoOrder a b = compare (reponame a) (reponame b)
--
rows = map description . filter hasBenchmark $ benchmarks
hasBenchmark b = any (\ (Test tb _ _, _) -> description tb == description b) results
[Refactor Run.hs to use updated tabulateRepo
Max Battcher <m...@worldmaker.net>**20100507072435
Ignore-this: e2e7172bbce88833a2196a62bb2091c6
] hunk ./Run.hs 12
import Definitions
import Report
import Shellish hiding ( run )
+import Standard
import qualified TabularRST as TR
benchMany :: [TestRepo] -> [TestBinary] -> [Benchmark a] -> Command [(Test a, Maybe MemTimeOutput)]
hunk ./Run.hs 23
memtime <- run test
return (test, memtime)
| repo <- rs, bin <- bins, bench <- benches ]
- case tabulate formatTimeResult res of
- [] -> return ()
- [(_,t)] -> echo_n $ TR.render id id id t
- _ -> error "Not expecting more than one table for a repo and its variants"
+ let tables = repoTables benchmarks res
+ if length tables == 1 then
+ echo_n $ TR.render id id id $ tabulateRepo formatTimeResult (head tables)
+ else error "Not expecting more than one table for a repo and its variants"
return res
where
repoAndVariants r = map (r `tweakVia`) (trVariants r)
Context:
[Add GChart graphs to reports
Max Battcher <m...@worldmaker.net>**20100504085035
Ignore-this: eaff40f00675aa16443221ed2192c1da
]
[Open #9bf: GoogleCharts integration.
'Eric Kow <ko...@darcs.net>'**20100321111031
Ignore-this: a95ee214b37a2ed9acf034d1592a9139
]
[Include the hostname in the parameters stamp.
Eric Kow <ko...@darcs.net>**20100228225819
Ignore-this: d6747bed303faceb7ac6174cf3c4112a
]
[Drop .exe from darcs binary name under Windows.
Eric Kow <ko...@darcs.net>**20100228224552
Ignore-this: aed052b5198c2e63fb1b5f55dc030d95
]
[Restore variant-then-version order of row headers.
Eric Kow <ko...@darcs.net>**20100228224437
Ignore-this: a1652b71035fe611e2b4bf8e80f7d447
]
[Pick time unit for whole row based on smallest value in that row.
Eric Kow <ko...@darcs.net>**20100228224217
Ignore-this: 6491a506dc1af8ef84aeae5ff616238a
]
[Refactor time-printing code.
Eric Kow <ko...@darcs.net>**20100228204812
Ignore-this: e04c3ac9065fff437650964b541e04e
]
[Clean up unused imports.
Eric Kow <ko...@darcs.net>**20100228185054
Ignore-this: 9db5027c3ab521ee10dc527cb2d92839
]
[Separate timing and memory tables.
Eric Kow <ko...@darcs.net>**20100228185052
Ignore-this: 8ff235c5cb1e7d8281d08cf69e92cf07
]
[First stab at pstamps and timestamps.
Eric Kow <ko...@darcs.net>**20100225224835
Ignore-this: aa263b2ff030e36193fcf453dcc66ae5
]
[Constraint a type to fix a warning.
Eric Kow <ko...@darcs.net>**20100225223723
Ignore-this: 9953809b43547e7d470ae9a706f1ff8
]
[Fill in type signatures for Report.
Eric Kow <ko...@darcs.net>**20100225223557
Ignore-this: 9f8e6689b4113637673e15beeb05bfb7
]
[Print tables in a standard order.
Eric Kow <e.y....@brighton.ac.uk>**20100225110908
Ignore-this: e477aa66246da2bd615affef360cfa23
]
[Shuffle lots of code around.
Eric Kow <e.y....@brighton.ac.uk>**20100225110557
Ignore-this: e30f9a5c3d2287ebb384b614116d6f77
New modules:
- Definitions (shared code - perhaps badly named)
- Run (for the darcs-benchmark run command)
This will be necessary if we want to avoid a future import cycle.
]
[Characterise benchmarks so that we can moosh them into a single list.
Eric Kow <e.y....@brighton.ac.uk>**20100225102841
Ignore-this: 2177ac19c81e160bb557ae3db546f7ca
]
[Minor cleanups.
Eric Kow <e.y....@brighton.ac.uk>**20100225102828
Ignore-this: 5d8a6ce39c6b150de0b94ebdd6b3737f
]
[Make stddev column a little more visually distinct.
Eric Kow <ko...@darcs.net>**20100225085511
Ignore-this: 76420ade616491cfb061bb72ec3ebc08
]
[Enable reporting with variants noted.
Eric Kow <ko...@darcs.net>**20100224224516
Ignore-this: 3ef25ae7cede22de661129d8f50285e6
]
[Safer and simpler variant-sensitive tabulation.
Eric Kow <ko...@darcs.net>**20100224224250
Ignore-this: d4c8922cf914e3bb958a31649232532d
]
[Make timings files a bit more manageable.
Eric Kow <ko...@darcs.net>**20100224215744
Ignore-this: 5d034aa10dfcf242c55b537327b4fcec
Store timings as in files
~/.darcs-benchmark/<pstamp>.timings/<tstamp>
The pstamp is some kind of representation of the unique paramaters that would
make benchmarks with different pstamps hard to compare. Examples of things we
may want to encode in the pstamp:
- machine info
- parameters like --cold
The hope is to have a human readable ~/.darcs-benchmark/<pstamp>.info
that provides details on the stamp.
The tstamp is meant to be an ISO date/time. You can actually concatenate all
the <tstamp> files if you want. They're just broken up for easy management
(for example, if you wanted do delete all timings from 2009)
Entries in each tstamp file are tab-separated lines
<repo> <darcs> <benchmark> <mem> <time>
]
[Drop the redundant "darcs-" prefix from column names.
Petr Rockai <m...@mornfall.net>**20100224133722
Ignore-this: 3024b578cee99e9ec15def7801ec09b3
]
[Adaptively choose display units.
Petr Rockai <m...@mornfall.net>**20100224133611
Ignore-this: 10b71be8e4ddf9775c9f8bed9fcecffb
]
[Helper code to guess variant core names.
Eric Kow <e.y....@brighton.ac.uk>**20100224132846
Ignore-this: f119a6bab0cc0f24c5a61ab40f1f174a
]
[Wibble.
Eric Kow <e.y....@brighton.ac.uk>**20100224132841
Ignore-this: c434de0d39706eafd9098cdb6997d4a6
]
[Minor code wibble.
Eric Kow <e.y....@brighton.ac.uk>**20100224130836
Ignore-this: 3f4d4f391b415a3c65cdc3147f5ed22f
]
[Don't append variants to sdev columns.
Eric Kow <e.y....@brighton.ac.uk>**20100224125830
Ignore-this: 6f325c38b6a3bea66526d7f6d786ba2c
]
[Oops, fix bug in column name handling.
Eric Kow <e.y....@brighton.ac.uk>**20100224121642
Ignore-this: 3e4339ea2530b3b67c5172b3b113b1ea
]
[Cut some superfluous characters.
Eric Kow <e.y....@brighton.ac.uk>**20100224121304
Ignore-this: c17e8d6fabf41ce69ed23db4cbbed38e
]
[Implement Petr's idea of display sample size indicators.
Eric Kow <e.y....@brighton.ac.uk>**20100224121202
Ignore-this: d20a6d7e9fbdbddca686b77aec3504d1
]
[Split stddev off into its own cell.
Eric Kow <e.y....@brighton.ac.uk>**20100224121201
Ignore-this: 7cd3871a3fab5892170b48b36806ef86
]
[Tweak formatting functions to return lists of cells.
Eric Kow <e.y....@brighton.ac.uk>**20100224121109
Ignore-this: b6931d8761c596256461ac61de86820f
]
[Add a very incomplete report command.
Eric Kow <ko...@darcs.net>**20100223223835
Ignore-this: fcc82bfcea92123bf3c2b64edc1ce06d
- does not recognise variants
- thinks all benchmarks are in milliseconds
]
[Improve timings file.
Eric Kow <ko...@darcs.net>**20100223223714
Ignore-this: 822f9cec2c0e4522b78f2fa89a926d58
]
[Dump result from each timing into a log file.
Eric Kow <ko...@darcs.net>**20100223210259
Ignore-this: d438d115ec705fe27a0bdf545a894a9e
]
[Fix shadowing warning.
Eric Kow <ko...@darcs.net>**20100223200556
Ignore-this: 7a20535d1d7149d8da90d62b293f7f0d
]
[Rearrange and break into sections.
Eric Kow <ko...@darcs.net>**20100223200254
Ignore-this: ab65929f82425157824a04a62f333b38
]
[More suggestions for things to report.
Eric Kow <e.y....@brighton.ac.uk>**20100223144139
Ignore-this: 65fe7b5225669b2dbdc697815ea6330f
]
[Open #3e0: darcs version threshold for variants.
Eric Kow <e.y....@brighton.ac.uk>**20100223143655
Ignore-this: 1168cce71d86f76653da05f3a5b4cabe
]
[TAG 0.1.7
Eric Kow <e.y....@brighton.ac.uk>**20100222172325
Ignore-this: b7aa43ef661226e5be1d955315b4bb2e
]
Patch bundle hash:
f5ac9561ede5f8d6b4c214dfef9d95d72363b735
_______________________________________________
darcs-users mailing list
darcs-users@darcs.net
http://lists.osuosl.org/mailman/listinfo/darcs-users
