--csv: Support per-module tables as well
[nofib.git] / nofib-analyse / Main.hs
1 {-# LANGUAGE RankNTypes, ExistentialQuantification, FlexibleInstances #-}
2 -----------------------------------------------------------------------------
3 -- (c) Simon Marlow 1997-2005
4 -----------------------------------------------------------------------------
5
6 module Main where
7
8 import GenUtils
9 import Slurp
10 import CmdLine
11
12 import Text.Printf
13 import qualified Data.Map as Map
14 import Data.Map (Map)
15 import System.Exit ( exitWith, ExitCode(..) )
16
17 import Control.Monad
18 import Data.Maybe ( isNothing )
19 import System.IO
20 import Data.List
21
22 -----------------------------------------------------------------------------
23 -- Top level stuff
24
25 die :: String -> IO a
26 die s = hPutStr stderr s >> exitWith (ExitFailure 1)
27
28 data Normalise = NormalisePercent | NormaliseRatio | NormaliseNone
29
30 main :: IO ()
31 main = do
32
33 when (not (null cmdline_errors) || OptHelp `elem` flags) $
34 die (concat cmdline_errors ++ usage)
35
36 norm <- case [ n | OptNormalise n <- flags ] of
37 [] -> return NormalisePercent
38 ["percent"] -> return NormalisePercent
39 ["ratio"] -> return NormaliseRatio
40 ["none"] -> return NormaliseNone
41 _ -> die ("unrecognised value for --normalise\n" ++ usage)
42
43 let { latex = [ t | OptLaTeXOutput t <- flags ];
44 ascii = OptASCIIOutput `elem` flags;
45 csv = [ t | OptCSV t <- flags ];
46 stddev = OptStdDev `elem` flags;
47 inc_baseline = OptShowBaseline `elem` flags
48 }
49
50 when (devs && nodevs) $ die "Can't both display and hide deviations"
51
52 results <- parse_logs other_args
53
54 summary_spec <- case [ cols | OptColumns cols <- flags ] of
55 [] -> return (pickSummary results)
56 (cols:_) -> namedColumns (split ',' cols)
57
58 let summary_rows = case [ rows | OptRows rows <- flags ] of
59 [] -> Nothing
60 rows -> Just (split ',' (last rows))
61
62 let column_headings = map (reverse . takeWhile (/= '/') . reverse) other_args
63
64 -- sanity check
65 sequence_ [ checkTimes prog res | result_table <- results,
66 (prog,res) <- Map.toList result_table ]
67
68 case () of
69 _ | not (null csv) ->
70 putStr (csvTable results (head csv) norm stddev)
71 _ | not (null latex) ->
72 putStr (latexOutput results (head latex) column_headings summary_spec summary_rows norm inc_baseline)
73 _ | otherwise ->
74 putStr (asciiPage results column_headings summary_spec summary_rows norm)
75
76
77 parse_logs :: [String] -> IO [ResultTable]
78 parse_logs [] = do
79 f <- hGetContents stdin
80 return [parse_log f]
81 parse_logs log_files =
82 mapM (\f -> do h <- openFile f ReadMode
83 c <- hGetContents h
84 return (parse_log c)) log_files
85
86 -----------------------------------------------------------------------------
87 -- List of tables we're going to generate
88
89 data PerProgTableSpec =
90 forall a . Result a =>
91 SpecP
92 String -- Name of the table
93 String -- Short name (for column heading)
94 String -- HTML tag for the table (currently unused)
95 (Results -> Maybe a) -- How to get the result
96 (Results -> Status) -- How to get the status of this result
97 (a -> Bool) -- Result within reasonable limits?
98
99 data PerModuleTableSpec =
100 forall a . Result a =>
101 SpecM
102 String -- Name of the table
103 String -- HTML tag for the table (currently unused)
104 (Results -> Map String a) -- get the module map
105 (a -> Bool) -- Result within reasonable limits?
106
107 -- The various per-program aspects of execution that we can generate results for.
108 size_spec, alloc_spec, runtime_spec, elapsedtime_spec, muttime_spec, mutetime_spec,
109 gctime_spec, gcelap_spec,
110 gcwork_spec, instrs_spec, mreads_spec, mwrite_spec, cmiss_spec,
111 gc0time_spec, gc0elap_spec, gc1time_spec, gc1elap_spec, balance_spec, totmem_spec
112 :: PerProgTableSpec
113 size_spec = SpecP "Binary Sizes" "Size" "binary-sizes" binary_size compile_status always_ok
114 alloc_spec = SpecP "Allocations" "Allocs" "allocations" (meanInt allocs) run_status always_ok
115 runtime_spec = SpecP "Run Time" "Runtime" "run-times" (mean run_time) run_status mean_time_ok
116 elapsedtime_spec = SpecP "Elapsed Time" "Elapsed" "elapsed-times" (mean elapsed_time) run_status mean_time_ok
117 muttime_spec = SpecP "Mutator Time" "MutTime" "mutator-time" (mean mut_time) run_status mean_time_ok
118 mutetime_spec = SpecP "Mutator Elapsed Time" "MutETime" "mutator-elapsed-time" (mean mut_elapsed_time) run_status mean_time_ok
119 gctime_spec = SpecP "GC Time" "GCTime" "gc-time" (mean gc_time) run_status mean_time_ok
120 gcelap_spec = SpecP "GC Elapsed Time" "GCETime" "gc-elapsed-time" (mean gc_elapsed_time) run_status mean_time_ok
121 gc0count_spec = SpecP "GC(0) Count" "GC0Count" "gc0-count" (meanInt gc0_count) run_status always_ok
122 gc0time_spec = SpecP "GC(0) Time" "GC0Time" "gc0-time" (mean gc0_time) run_status mean_time_ok
123 gc0elap_spec = SpecP "GC(0) Elapsed Time" "GC0ETime" "gc0-elapsed-time" (mean gc0_elapsed_time) run_status mean_time_ok
124 gc1count_spec = SpecP "GC(1) Count" "GC1Count" "gc1-count" (meanInt gc1_count) run_status always_ok
125 gc1time_spec = SpecP "GC(1) Time" "GC1Time" "gc1-time" (mean gc1_time) run_status mean_time_ok
126 gc1elap_spec = SpecP "GC(1) Elapsed Time" "GC1ETime" "gc1-elapsed-time" (mean gc1_elapsed_time) run_status mean_time_ok
127 balance_spec = SpecP "GC work balance" "Balance" "balance" (mean balance) run_status mean_time_ok
128 gcwork_spec = SpecP "GC Work" "GCWork" "gc-work" (meanInt gc_work) run_status always_ok
129 instrs_spec = SpecP "Instructions" "Instrs" "instrs" instrs run_status always_ok
130 mreads_spec = SpecP "Memory Reads" "Reads" "mem-reads" mem_reads run_status always_ok
131 mwrite_spec = SpecP "Memory Writes" "Writes" "mem-writes" mem_writes run_status always_ok
132 cmiss_spec = SpecP "Cache Misses" "Misses" "cache-misses" cache_misses run_status always_ok
133 totmem_spec = SpecP "Total Memory in use" "TotalMem" "total-mem" (meanInt total_memory) run_status always_ok
134
135 all_specs :: [PerProgTableSpec]
136 all_specs = [
137 size_spec,
138 alloc_spec,
139 runtime_spec,
140 elapsedtime_spec,
141 muttime_spec,
142 mutetime_spec,
143 gctime_spec,
144 gcelap_spec,
145 gc0count_spec,
146 gc0time_spec,
147 gc0elap_spec,
148 gc1count_spec,
149 gc1time_spec,
150 gc1elap_spec,
151 balance_spec,
152 gcwork_spec,
153 instrs_spec,
154 mreads_spec,
155 mwrite_spec,
156 cmiss_spec,
157 totmem_spec
158 ]
159
160 namedColumns :: [String] -> IO [PerProgTableSpec]
161 namedColumns ss = mapM findSpec ss
162 where findSpec s =
163 case [ spec | spec@(SpecP _ short_name _ _ _ _) <- all_specs,
164 short_name == s ] of
165 [] -> die ("unknown column: " ++ s)
166 (spec:_) -> return spec
167
168 mean :: (Results -> [Float]) -> Results -> Maybe (MeanStdDev Float)
169 mean f results = go (f results)
170 where go [] = Nothing
171 go fs = Just (MeanStdDev mn stddev)
172 where mn = sn / n
173 stddev = (sqrt (n * sum (map (^2) fs) - sn^2)) / n
174 sn = foldl' (+) 0 fs
175 n = fromIntegral (length fs)
176
177 meanInt :: Integral a => (Results -> [a]) -> Results -> Maybe (MeanStdDev a)
178 meanInt f results = go (f results)
179 where go [] = Nothing
180 go fs = Just (MeanStdDev mn 0)
181 where mn = foldl' (+) 0 fs `quot` fromIntegral (length fs)
182
183 -- Look for bogus-looking times: On Linux we occasionally get timing results
184 -- that are bizarrely low, and skew the average.
185 checkTimes :: String -> Results -> IO ()
186 checkTimes prog results = do
187 check "run time" (run_time results)
188 check "mut time" (mut_time results)
189 check "GC time" (gc_time results)
190 where
191 check kind ts
192 | any strange ts =
193 hPutStrLn stderr ("warning: dubious " ++ kind
194 ++ " results for " ++ prog
195 ++ ": " ++ show ts)
196 | otherwise = return ()
197 where strange t = any (\r -> time_ok r && r / t > 1.4) ts
198 -- looks for times that are >40% smaller than
199 -- any other.
200
201
202 -- These are the per-prog tables we want to generate
203 per_prog_result_tab :: [PerProgTableSpec]
204 per_prog_result_tab =
205 [ size_spec, alloc_spec, runtime_spec, elapsedtime_spec, muttime_spec, mutetime_spec, gctime_spec,
206 gcelap_spec, gc0count_spec, gc0time_spec, gc0elap_spec, gc1count_spec, gc1time_spec, gc1elap_spec,
207 gcwork_spec, balance_spec, instrs_spec, mreads_spec, mwrite_spec, cmiss_spec, totmem_spec]
208
209 -- A single summary table, giving comparison figures for a number of
210 -- aspects, each in its own column. Only works when comparing at least two runs.
211 normal_summary_specs :: [PerProgTableSpec]
212 normal_summary_specs =
213 [ size_spec, alloc_spec, runtime_spec, elapsedtime_spec, totmem_spec ]
214
215 cachegrind_summary_specs :: [PerProgTableSpec]
216 cachegrind_summary_specs =
217 [ size_spec, alloc_spec, instrs_spec, mreads_spec, mwrite_spec ]
218
219 -- Pick an appropriate summary table: if we're cachegrinding, then
220 -- we're probably not interested in the runtime, but we are interested
221 -- in instructions, mem reads and mem writes (and vice-versa).
222 pickSummary :: [ResultTable] -> [PerProgTableSpec]
223 pickSummary rs
224 | isNothing (instrs (head (Map.elems (head rs)))) = normal_summary_specs
225 | otherwise = cachegrind_summary_specs
226
227 per_module_result_tab :: [PerModuleTableSpec]
228 per_module_result_tab =
229 [ SpecM "Module Sizes" "mod-sizes" module_size always_ok
230 , SpecM "Compile Times" "compile-time" compile_time time_ok
231 , SpecM "Compile Allocations" "compile-allocations" compile_allocs always_ok
232 ]
233
234 always_ok :: a -> Bool
235 always_ok = const True
236
237 mean_time_ok :: (MeanStdDev Float) -> Bool
238 mean_time_ok = time_ok . float
239
240 time_ok :: Float -> Bool
241 time_ok t = t > tooquick_threshold
242
243 -----------------------------------------------------------------------------
244 -- LaTeX table generation (just the summary for now)
245
246 latexOutput :: [ResultTable] -> Maybe String -> [String] -> [PerProgTableSpec]
247 -> Maybe [String] -> Normalise -> Bool -> String
248
249 latexOutput results (Just table_name) _ _ _ norm inc_baseline
250 = let
251 table_spec = [ spec | spec@(SpecP _ n _ _ _ _) <- per_prog_result_tab,
252 n == table_name ]
253 in
254 case table_spec of
255 [] -> error ("can't find table named: " ++ table_name)
256 (spec:_) -> latexProgTable results spec norm inc_baseline "\n"
257
258 latexOutput results Nothing column_headings summary_spec summary_rows _ _ =
259 (if (length results >= 2)
260 then ascii_summary_table True results column_headings summary_spec summary_rows
261 . str "\n\n"
262 else id) ""
263
264
265 latexProgTable :: [ResultTable] -> PerProgTableSpec -> Normalise -> Bool -> ShowS
266 latexProgTable results (SpecP _long_name _ _ get_result get_status result_ok) norm inc_baseline
267 = latex_show_results results get_result get_status result_ok norm inc_baseline
268
269 latex_show_results
270 :: Result a
271 => [ResultTable]
272 -> (Results -> Maybe a)
273 -> (Results -> Status)
274 -> (a -> Bool)
275 -> Normalise
276 -> Bool
277 -> ShowS
278
279 latex_show_results [] _ _ _ _ _
280 = error "latex_show_results: Can't happen?"
281 latex_show_results (r:rs) f stat _result_ok norm inc_baseline
282 = makeLatexTable $
283 [ TableRow (BoxString prog : boxes) |
284 (prog,boxes) <- results_per_prog ] ++
285 if nodevs then [] else
286 [ TableLine,
287 TableRow (BoxString "Min" : mins),
288 TableRow (BoxString "Max" : maxs),
289 TableRow (BoxString "Geometric Mean" : gms) ]
290 where
291 -- results_per_prog :: [ (String,[BoxValue a]) ]
292 results_per_prog = [ (prog, if inc_baseline then xs else tail xs)
293 | (prog,xs) <- map calc (Map.toList r) ]
294 calc = calc_result rs f stat (const True) (normalise norm)
295
296 results_per_run = transpose (map snd results_per_prog)
297 (_lows,gms,_highs) = unzip3 (map calc_gmsd results_per_run)
298 (mins, maxs) = unzip (map calc_minmax results_per_run)
299
300 normalise :: Result a => Normalise -> a -> a -> BoxValue
301 normalise norm = case norm of
302 NormalisePercent -> convert_to_percentage
303 NormaliseRatio -> normalise_to_base
304 NormaliseNone -> \_base res -> toBox res
305
306 -----------------------------------------------------------------------------
307 -- ASCII page generation
308
309 asciiPage :: [ResultTable] -> [String] -> [PerProgTableSpec] -> Maybe [String]
310 -> Normalise
311 -> String
312 asciiPage results args summary_spec summary_rows norm =
313 ( str reportTitle
314 . str "\n\n"
315 -- only show the summary table if we're comparing at least two runs
316 . (if (length results >= 2)
317 then ascii_summary_table False results args summary_spec summary_rows . str "\n\n"
318 else id)
319 . interleave "\n\n" (map (asciiGenProgTable results args norm) per_prog_result_tab)
320 . str "\n"
321 . interleave "\n\n" (map (asciiGenModTable results args) per_module_result_tab)
322 ) "\n"
323
324 asciiGenProgTable :: [ResultTable] -> [String] -> Normalise -> PerProgTableSpec -> ShowS
325 asciiGenProgTable results args norm (SpecP long_name _ _ get_result get_status result_ok)
326 = str long_name
327 . str "\n"
328 . ascii_show_results results args get_result get_status result_ok norm
329
330 asciiGenModTable :: [ResultTable] -> [String] -> PerModuleTableSpec -> ShowS
331 asciiGenModTable results args (SpecM long_name _ get_result result_ok)
332 = str long_name
333 . str "\n"
334 . ascii_show_multi_results results args get_result result_ok
335
336 ascii_header :: Int -> [String] -> ShowS
337 ascii_header w ss
338 = str "\n-------------------------------------------------------------------------------\n"
339 . str (rjustify 15 "Program")
340 . str (space 5)
341 . foldr (.) id (intersperse (str (space 1)) (map (str . rjustify w) ss))
342 . str "\n-------------------------------------------------------------------------------\n"
343
344 ascii_show_results
345 :: Result a
346 => [ResultTable]
347 -> [String]
348 -> (Results -> Maybe a)
349 -> (Results -> Status)
350 -> (a -> Bool)
351 -> Normalise
352 -> ShowS
353
354 ascii_show_results [] _ _ _ _ _
355 = error "ascii_show_results: Can't happen?"
356 ascii_show_results (r:rs) ss f stat result_ok norm
357 = ascii_header fIELD_WIDTH ss
358 . interleave "\n" (map show_per_prog_results results_per_prog)
359 . if nodevs then id
360 else str "\n"
361 . show_per_prog_results ("-1 s.d.",lows)
362 . str "\n"
363 . show_per_prog_results ("+1 s.d.",highs)
364 . str "\n"
365 . show_per_prog_results ("Average",gms)
366 where
367 -- results_per_prog :: [ (String,[BoxValue a]) ]
368 results_per_prog = map (calc_result rs f stat result_ok (normalise norm)) (Map.toList r)
369
370 results_per_run = transpose (map snd results_per_prog)
371 (lows,gms,highs) = unzip3 (map calc_gmsd results_per_run)
372
373 -- A summary table, useful only when we are comparing two runs. This table
374 -- shows a number of different result categories, one per column.
375 ascii_summary_table
376 :: Bool -- generate a LaTeX table?
377 -> [ResultTable]
378 -> [String]
379 -> [PerProgTableSpec]
380 -> Maybe [String]
381 -> ShowS
382 ascii_summary_table _ [] _ _ _
383 = error "ascii_summary_table: Can't happen?"
384 ascii_summary_table _ [_] _ _ _
385 = error "ascii_summary_table: Can't happen?"
386 ascii_summary_table latex (rbase:rs) (_:names) specs mb_restrict
387 | latex = makeLatexTable (rows ++ TableLine : av_rows)
388 | otherwise =
389 makeTable (table_layout (length specs * length rs) w) $
390 [ TableLine
391 , TableRow header_row ] ++
392 [ TableRow header_row2 | length rs > 1] ++
393 [ TableLine ] ++
394 rows ++
395 [ TableLine ] ++
396 av_rows
397 where
398 header_row = BoxString "Program" : map BoxString headings
399 header_row2 = BoxString "" : map BoxString headings2
400
401 (headings, headings2, columns, av_cols) = unzip4 (concatMap calc_col_group specs)
402 av_heads = [BoxString "Min", BoxString "Max", BoxString "Geometric Mean"]
403 baseline = Map.toList rbase
404 progs = map BoxString (Map.keys rbase)
405 rows0 = map TableRow (zipWith (:) progs (transpose columns))
406
407 rows = restrictRows mb_restrict rows0
408
409 av_rows = map TableRow (zipWith (:) av_heads (transpose av_cols))
410 w = sUMMARY_FIELD_WIDTH
411
412 calc_col_group :: PerProgTableSpec -> [(String, String, [BoxValue], [BoxValue])]
413 calc_col_group spec = [calc_col spec r n | (r,n) <- zip rs names]
414
415 calc_col :: PerProgTableSpec -> ResultTable -> String -> (String, String, [BoxValue], [BoxValue])
416 calc_col (SpecP _ heading _ getr gets ok) r n
417 -- throw away the baseline result
418 = (heading, n, column, [column_min, column_max, column_mean])
419 where (_, boxes) = unzip (map calc_one_result baseline)
420 calc_one_result = calc_result [r] getr gets ok convert_to_percentage
421 column = map (\(_:b:_) -> b) boxes
422 (_, column_mean, _) = calc_gmsd column
423 (column_min, column_max) = calc_minmax column
424
425 restrictRows :: Maybe [String] -> [TableRow] -> [TableRow]
426 restrictRows Nothing rows = rows
427 restrictRows (Just these) rows = filter keep_it rows
428 where keep_it (TableRow (BoxString s: _)) = s `elem` these
429 keep_it TableLine = True
430 keep_it _ = False
431
432 table_layout :: Int -> Int -> Layout
433 table_layout n w boxes = foldr (.) id $ intersperse (str (space 1)) $ zipWith ($) fns boxes
434 where fns = (str . rjustify 15 . show ) :
435 (\s -> str (space 5) . str (rjustify w (show s))) :
436 replicate (n-1) (str . rjustify w . show)
437
438 ascii_show_multi_results
439 :: Result a
440 => [ResultTable]
441 -> [String]
442 -> (Results -> Map String a)
443 -> (a -> Bool)
444 -> ShowS
445
446 ascii_show_multi_results [] _ _ _
447 = error "ascii_show_multi_results: Can't happen?"
448 ascii_show_multi_results (r:rs) ss f result_ok
449 = ascii_header fIELD_WIDTH ss
450 . interleave "\n" (map show_results_for_prog results_per_prog_mod_run)
451 . str "\n"
452 . if nodevs then id
453 else str "\n"
454 . show_per_prog_results ("-1 s.d.",lows)
455 . str "\n"
456 . show_per_prog_results ("+1 s.d.",highs)
457 . str "\n"
458 . show_per_prog_results ("Average",gms)
459 where
460 base_results = Map.toList r :: [(String,Results)]
461
462 -- results_per_prog_mod_run :: [(String,[(String,[BoxValue a])])]
463 results_per_prog_mod_run = map get_results_for_prog base_results
464
465 -- get_results_for_prog :: (String,Results) -> (String,[BoxValue a])
466 get_results_for_prog (prog, results)
467 = (prog, map get_results_for_mod (Map.toList (f results)))
468
469 where fms = map get_run_results rs
470
471 get_run_results fm = case Map.lookup prog fm of
472 Nothing -> Map.empty
473 Just res -> f res
474
475 get_results_for_mod id_attr
476 = calc_result fms Just (const Success) result_ok convert_to_percentage id_attr
477
478 show_results_for_prog (prog,mrs) =
479 str ("\n"++prog++"\n")
480 . (if null mrs then
481 str "(no modules compiled)\n"
482 else
483 interleave "\n" (map show_per_prog_results mrs))
484
485 results_per_run = transpose [xs | (_,mods) <- results_per_prog_mod_run,
486 (_,xs) <- mods]
487 (lows,gms,highs) = unzip3 (map calc_gmsd results_per_run)
488
489
490 show_per_prog_results :: (String, [BoxValue]) -> ShowS
491 show_per_prog_results = show_per_prog_results_width fIELD_WIDTH
492
493 show_per_prog_results_width :: Int -> (String, [BoxValue]) -> ShowS
494 show_per_prog_results_width w (prog,results)
495 = str (rjustify 15 prog)
496 . str (space 5)
497 . foldr (.) id (intersperse (str (space 1)) (map (str . rjustify w . showBox) results))
498
499 -- -----------------------------------------------------------------------------
500 -- CSV output
501
502 csvTable :: [ResultTable] -> String -> Normalise -> Bool -> String
503 csvTable results table_name norm stddev
504 = case
505 [ csvProgTable results spec norm stddev "\n"
506 | spec@(SpecP _ n _ _ _ _) <- per_prog_result_tab, n == table_name ]
507 ++
508 [ csvModTable results spec norm stddev "\n"
509 | spec@(SpecM n _ _ _) <- per_module_result_tab, n == table_name ]
510 of
511 [] -> error ("can't find table named: " ++ table_name)
512 (r:_) -> r
513
514 csvProgTable :: [ResultTable] -> PerProgTableSpec -> Normalise -> Bool -> ShowS
515 csvProgTable results (SpecP _long_name _ _ get_result get_status result_ok)
516 norm stddev
517 = csv_show_results results get_result get_status result_ok norm stddev
518
519 csv_show_results
520 :: Result a
521 => [ResultTable]
522 -> (Results -> Maybe a)
523 -> (Results -> Status)
524 -> (a -> Bool)
525 -> Normalise
526 -> Bool
527 -> ShowS
528
529 csv_show_results [] _ _ _ _ _
530 = error "csv_show_results: Can't happen?"
531 csv_show_results (r:rs) f stat _result_ok norm stddev
532 = interleave "\n" results_per_prog
533 where
534 -- results_per_prog :: [ (String,[BoxValue a]) ]
535 results_per_prog = map (result_line . calc) (Map.toList r)
536 calc = calc_result rs f stat (const True) (normalise norm)
537
538 result_line (prog,boxes)
539 | stddev = interleave "," (str prog : concat (map stddevbox boxes))
540 | otherwise = interleave "," (str prog : map (str.showBox) boxes)
541
542 stddevbox (BoxStdDev b s) = [str (showBox b), str (printf "%.3f" s)]
543 stddevbox b = [str (showBox b), str "0"]
544
545 csvModTable :: [ResultTable] -> PerModuleTableSpec -> Normalise -> Bool -> ShowS
546 csvModTable results (SpecM _ _ get_result result_ok)
547 norm stddev
548 = csv_show_multi_results results get_result result_ok norm stddev
549
550 csv_show_multi_results
551 :: Result a
552 => [ResultTable]
553 -> (Results -> Map String a)
554 -> (a -> Bool)
555 -> Normalise
556 -> Bool
557 -> ShowS
558
559 csv_show_multi_results [] _ _ _ _
560 = error "csv_show_multi_results: Can't happen?"
561 csv_show_multi_results (r:rs) f _result_ok norm stddev
562 = interleave "\n"
563 [ result_line prog mod boxes
564 | (prog, results) <- Map.toList r
565 , (mod, result) <- Map.toList (f results)
566 , let fms = map (maybe Map.empty f . Map.lookup prog) rs
567 , let (_, boxes) = calc_result fms Just (const Success) (const True) (normalise norm) (mod, result)
568 ]
569 where
570 result_line prog mod boxes
571 | stddev = interleave "," $ str prog : str mod : concat (map stddevbox boxes)
572 | otherwise = interleave "," $ str prog : str mod : map (str.showBox) boxes
573
574 stddevbox (BoxStdDev b s) = [str (showBox b), str (printf "%.3f" s)]
575 stddevbox b = [str (showBox b), str "0"]
576
577 -- ---------------------------------------------------------------------------
578 -- Generic stuff for results generation
579
580 -- calc_result is a nice exercise in higher-order programming...
581 calc_result
582 :: Result a
583 => [Map String b] -- accumulated results
584 -> (b -> Maybe a) -- get a result from the b
585 -> (b -> Status) -- get a status from the b
586 -> (a -> Bool) -- normalise against the baseline?
587 -> (a -> a -> BoxValue) -- how to normalise
588 -> (String,b) -- the baseline result
589 -> (String,[BoxValue])
590
591 calc_result rts get_maybe_a get_stat base_ok norm_fn (prog,base_r) =
592 (prog, (just_result m_baseline base_stat :
593
594 let
595 rts' = map (\rt -> get_stuff (Map.lookup prog rt)) rts
596
597 get_stuff Nothing = (Nothing, NotDone)
598 get_stuff (Just r) = (get_maybe_a r, get_stat r)
599 in
600 (
601 case m_baseline of
602 Just baseline | base_ok baseline
603 -> map (\(r,s) -> do_norm r s baseline) rts'
604 _other
605 -> map (\(r,s) -> just_result r s) rts'
606 )))
607 where
608 m_baseline = get_maybe_a base_r
609 base_stat = get_stat base_r
610
611 just_result Nothing s = RunFailed s
612 just_result (Just a) _ = toBox a
613
614 do_norm Nothing s _ = RunFailed s
615 do_norm (Just a) _ baseline = norm_fn baseline a
616
617 -----------------------------------------------------------------------------
618 -- Calculating geometric means and standard deviations
619
620 {-
621 This is done using the log method, to avoid needing really large
622 intermediate results. The formula for a geometric mean is
623
624 (a1 * .... * an) ^ 1/n
625
626 which is equivalent to
627
628 e ^ ( (log a1 + ... + log an) / n )
629
630 where log is the natural logarithm function.
631
632 Similarly, to compute the geometric standard deviation we compute the
633 deviation of each log, take the root-mean-square, and take the
634 exponential again:
635
636 e ^ sqrt( ( sqr(log a1 - lbar) + ... + sqr(log an - lbar) ) / n )
637
638 where lbar is the mean log,
639
640 (log a1 + ... + log an) / n
641
642 This is a *factor*: i.e., the 1 s.d. points are (gm/sdf,gm*sdf); do
643 not subtract 100 from gm before performing this calculation.
644
645 We therefore return a (low, mean, high) triple.
646
647 -}
648
649 calc_gmsd :: [BoxValue] -> (BoxValue, BoxValue, BoxValue)
650 calc_gmsd xs
651 | null percentages = (RunFailed NotDone, RunFailed NotDone, RunFailed NotDone)
652 | otherwise = let sqr x = x * x
653 len = fromIntegral (length percentages)
654 logs = map log percentages
655 lbar = sum logs / len
656 st_devs = map (sqr . (lbar-)) logs
657 dbar = sum st_devs / len
658 gm = exp lbar
659 sdf = exp (sqrt dbar)
660 in
661 (Percentage (gm/sdf),
662 Percentage gm,
663 Percentage (gm*sdf))
664 where
665 percentages = [ if f < 5 then 5 else f | Percentage f <- xs ]
666 -- can't do log(0.0), so exclude zeros
667 -- small values have inordinate effects so cap at -95%.
668
669 calc_minmax :: [BoxValue] -> (BoxValue, BoxValue)
670 calc_minmax xs
671 | null percentages = (RunFailed NotDone, RunFailed NotDone)
672 | otherwise = (Percentage (minimum percentages),
673 Percentage (maximum percentages))
674 where
675 percentages = [ if f < 5 then 5 else f | Percentage f <- xs ]
676
677
678 -----------------------------------------------------------------------------
679 -- Show the Results
680
681 convert_to_percentage :: Result a => a -> a -> BoxValue
682 convert_to_percentage n _val | float n < 0.0001 = Percentage 100
683 convert_to_percentage baseline val = Percentage ((float val / float baseline) * 100)
684
685 normalise_to_base :: Result a => a -> a -> BoxValue
686 normalise_to_base n _val | float n < 0.0001 = BoxFloat 1
687 normalise_to_base baseline val =
688 BoxStdDev (BoxFloat point)
689 (point - (float baseline / (float val + variance val)))
690 where
691 point = (float baseline / float val)
692
693 class Result a where
694 toBox :: a -> BoxValue
695 float :: a -> Float
696 variance :: a -> Float
697
698 -- We assume an Int is a size, and print it in kilobytes.
699
700 instance Result Int where
701 toBox = BoxInt
702 float a = fromIntegral a
703 variance a = 0
704
705 data MeanStdDev a = MeanStdDev a Float
706
707 instance Result a => Result (MeanStdDev a) where
708 toBox (MeanStdDev a b) = BoxStdDev (toBox a) b
709 float (MeanStdDev a _) = float a
710 variance (MeanStdDev _ b) = b
711
712 instance Result Integer where
713 toBox = BoxInteger
714 float a = fromIntegral a
715 variance a = 0
716
717 instance Result Float where
718 toBox = BoxFloat
719 float a = realToFrac a
720 variance a = 0
721
722 -- -----------------------------------------------------------------------------
723 -- BoxValues
724
725 -- The contents of a box in a table
726 data BoxValue
727 = RunFailed Status
728 | Percentage Float
729 | BoxFloat Float
730 | BoxInt Int
731 | BoxInteger Integer
732 | BoxString String
733 | BoxStdDev BoxValue Float
734
735 showBox :: BoxValue -> String
736 showBox (RunFailed stat) = show_stat stat
737 showBox (Percentage 100) = " 0.0%" -- pattern matching on Float is bad style, but this is not crucial
738 showBox (Percentage f) = case printf "%.1f%%" (f-100) of
739 xs@('-':_) -> xs
740 xs -> '+':xs
741 showBox (BoxFloat f) = printf "%.3f" f
742 showBox (BoxInt n) = show n
743 showBox (BoxInteger n) = show n
744 --showBox (BoxInt n) = show (n `div` (1024*1024))
745 --showBox (BoxInteger n) = show (n `div` (1024*1024))
746 --showBox (BoxInt n) = show (n `div` 1024) ++ "k"
747 --showBox (BoxInteger n) = show (n `div` 1024) ++ "k"
748 showBox (BoxString s) = s
749 showBox (BoxStdDev b f) = showBox b
750
751 instance Show BoxValue where
752 show = showBox
753
754 show_stat :: Status -> String
755 show_stat Success = "(no result)"
756 show_stat WrongStdout = "(stdout)"
757 show_stat WrongStderr = "(stderr)"
758 show_stat (Exit x) = "exit(" ++ show x ++")"
759 show_stat OutOfHeap = "(heap)"
760 show_stat OutOfStack = "(stack)"
761 show_stat NotDone = "-----"
762
763 -- -----------------------------------------------------------------------------
764 -- Table layout
765
766 data TableRow
767 = TableRow [BoxValue]
768 | TableLine
769
770 type Layout = [BoxValue] -> ShowS
771
772 makeTable :: Layout -> [TableRow] -> ShowS
773 makeTable layout = interleave "\n" . map do_row
774 where do_row (TableRow boxes) = layout boxes
775 do_row TableLine = str (take 80 (repeat '-'))
776
777 makeLatexTable :: [TableRow] -> ShowS
778 makeLatexTable = foldr (.) id . map do_row
779 where do_row (TableRow boxes)
780 = latexTableLayout boxes . str "\\\\\n"
781 do_row TableLine
782 = str "\\hline\n"
783
784 latexTableLayout :: Layout
785 latexTableLayout boxes =
786 foldr (.) id . intersperse (str " & ") . map abox $ boxes
787 where
788 abox (RunFailed NotDone) = id
789 abox s = str (mungeForLaTeX (show s))
790
791 mungeForLaTeX :: String -> String
792 mungeForLaTeX = foldr transchar ""
793 where
794 transchar '_' s = '\\':'_':s
795 transchar '%' s = '\\':'%':s
796 transchar c s = c:s
797
798 -- -----------------------------------------------------------------------------
799 -- General Utils
800
801 split :: Char -> String -> [String]
802 split c s = case break (==c) s of
803 (chunk, rest) ->
804 case rest of
805 [] -> [chunk]
806 _:rest' -> chunk : split c rest'
807
808 str :: String -> ShowS
809 str = showString
810
811 interleave :: String -> [ShowS] -> ShowS
812 interleave s = foldr1 (\a b -> a . str s . b)
813
814 fIELD_WIDTH :: Int
815 fIELD_WIDTH = 16
816
817 sUMMARY_FIELD_WIDTH :: Int
818 sUMMARY_FIELD_WIDTH = 9
819
820 -----------------------------------------------------------------------------