utils/nofib-analyse/Main.hs

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