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