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