[project @ 2000-03-01 18:38:45 by keithw]

Display (overall) averages for per-module statistics as well as for
per-program statistics.

Also, with `-d' (default; `-n' to turn off) compute geometric standard
deviations and display +/- 1 s.d. points as well as average.  Note that
since these are *geometric*, the lower point will appear closer to the
average than the upper.  This is correct behaviour.

2 files changed, 122 insertions, 50 deletions

diff --git a/glafp-utils/nofib-analyse/CmdLine.hs b/glafp-utils/nofib-analyse/CmdLine.hs
index 4dfc9f9e21..b32d8e5cb8 100644
--- a/glafp-utils/nofib-analyse/CmdLine.hs
+++ b/glafp-utils/nofib-analyse/CmdLine.hs
@@ -22,10 +22,15 @@ tooquick_threshold
 	[] -> default_tooquick_threshold
 	(i:_) -> i
 
+devs   = OptDeviations   `elem` flags
+nodevs = OptNoDeviations `elem` flags
+
 data CLIFlags
   = OptASCIIOutput
   | OptHTMLOutput
   | OptIgnoreSmallTimes Float
+  | OptDeviations
+  | OptNoDeviations
   | OptHelp
   deriving Eq
 
@@ -39,5 +44,9 @@ argInfo =
 	"Produce HTML output"
   , Option ['i'] ["ignore"]  (ReqArg (OptIgnoreSmallTimes . read) "secs")
 	"Ignore runtimes smaller than <secs>"
+  , Option ['d'] ["deviations"] (NoArg OptDeviations)
+	"Display deviations (default)"
+  , Option ['n'] ["nodeviations"] (NoArg OptNoDeviations)
+	"Hide deviations"
   ]
 
diff --git a/glafp-utils/nofib-analyse/Main.hs b/glafp-utils/nofib-analyse/Main.hs
index ad1a7ab88a..c5f4b3c713 100644
--- a/glafp-utils/nofib-analyse/Main.hs
+++ b/glafp-utils/nofib-analyse/Main.hs
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $Id: Main.hs,v 1.1 1999/11/12 11:54:17 simonmar Exp $
+-- $Id: Main.hs,v 1.2 2000/03/01 18:38:45 keithw Exp $
 
 -- (c) Simon Marlow 1997-1999
 -----------------------------------------------------------------------------
@@ -44,6 +44,10 @@ main = do
 	then die "Can't produce both ASCII and HTML"
 	else do
 
+ if devs && nodevs
+	then die "Can't both display and hide deviations"
+	else do
+
  results <- parse_logs other_args
 
  let column_headings = map (reverse . takeWhile (/= '/') . reverse) other_args
@@ -154,13 +158,16 @@ htmlShowResults
 htmlShowResults (r:rs) ss f stat result_ok
   =   tabHeader ss
   +/+ foldr1 (+/+) (zipWith tableRow [1..] results_per_prog)
-  +/+ tableRow (-1) ("Average", geometric_means)
+  +/+ foldr1 (+/+) (tableRow (-1) ("Average", gms)
+                    : if nodevs then []
+                                else [tableRow (-1) ("-1 s.d.", lows),
+                                      tableRow (-1) ("+1 s.d.", highs)])
  where
 	-- results_per_prog :: [ (String,[BoxValue a]) ]
 	results_per_prog = map (calc_result rs f stat result_ok) (fmToList r)
 	
-	results_per_run = transpose (map snd results_per_prog)
-	geometric_means = map calc_gm results_per_run
+	results_per_run  = transpose (map snd results_per_prog)
+	(lows,gms,highs) = unzip3 (map calc_gmsd results_per_run)
 
 htmlShowMultiResults
     :: Result a
@@ -172,31 +179,42 @@ htmlShowMultiResults
 
 htmlShowMultiResults (r:rs) ss f result_ok =
 	multiTabHeader ss 
-	 +/+ foldr1 (+/+) (map show_results_for_prog base_results)
-
+	 +/+ foldr1 (+/+) (map show_results_for_prog results_per_prog_mod_run)
+         +/+ foldr1 (+/+) ((cellHtml [] (bold [] (htmlStr "Average"))
+                            +-+ tableRow (-1) ("", gms))
+                           : if nodevs then []
+                                       else [(cellHtml [] (bold [] (htmlStr "-1 s.d.")))
+                                             +-+ tableRow (-1) ("", lows),
+                                             (cellHtml [] (bold [] (htmlStr "+1 s.d.")))
+                                             +-+ tableRow (-1) ("", highs)])
   where
 	base_results = fmToList r :: [(String,Results)]
 
-	show_results_for_prog (prog,r) =
+        -- results_per_prog_mod_run :: [(String,[(String,[BoxValue a])])]
+        results_per_prog_mod_run = map get_results_for_prog base_results
+
+        -- get_results_for_prog :: (String,Results) -> (String,[BoxValue a])
+        get_results_for_prog (prog,r) = (prog, map get_results_for_mod (fmToList (f r)))
+
+           where fms = map get_run_results rs
+
+                 get_run_results fm = case lookupFM fm prog of
+                                        Nothing  -> emptyFM
+                                        Just res -> f res
+
+                 get_results_for_mod (id,attr) = calc_result fms Just (const Success)
+                                                             result_ok (id,attr)
+
+        show_results_for_prog (prog,mrs) =
 	    cellHtml [valign "top"] (bold [] (htmlStr prog))
-	    +-+ (if null base then
+	    +-+ (if null mrs then
 		   cellHtml [] (htmlStr "(no modules compiled)")
 	         else
-		   foldr1 (+/+) (map (show_one_result fms) base))
-
-         where
-	    base = fmToList (f r)
-	    fms = map (get_results_for prog) rs
-
-	get_results_for prog m = case lookupFM m prog of
-				   Nothing -> emptyFM
-				   Just r -> f r
+		   foldr1 (+/+) (map (tableRow 0) mrs))
 
-	show_one_result other_results (id,attribute) = 
-		tableRow 0 (
-		   	calc_result other_results Just (const Success) 
-				result_ok (id,attribute) 
-		)
+        results_per_run  = transpose [xs | (_,mods) <- results_per_prog_mod_run,
+                                           (_,xs) <- mods]
+        (lows,gms,highs) = unzip3 (map calc_gmsd results_per_run)
 
 tableRow :: Result a => Int -> (String, [BoxValue a]) -> HtmlTable
 tableRow row_no (prog, results)
@@ -295,13 +313,18 @@ ascii_show_results (r:rs) ss f stat result_ok
 	= ascii_header ss
 	. interleave "\n" (map show_per_prog_results results_per_prog)
 	. str "\n"
-	. show_per_prog_results ("Average",geometric_means)
+	. show_per_prog_results ("Average",gms)
+        . if nodevs then id
+                    else   str "\n"
+	                 . show_per_prog_results ("-1 s.d.",lows)
+	                 . str "\n"
+	                 . show_per_prog_results ("+1 s.d.",highs)
  where
 	-- results_per_prog :: [ (String,[BoxValue a]) ]
 	results_per_prog = map (calc_result rs f stat result_ok) (fmToList r)
 	
-	results_per_run = transpose (map snd results_per_prog)
-	geometric_means = map calc_gm results_per_run
+	results_per_run  = transpose (map snd results_per_prog)
+        (lows,gms,highs) = unzip3 (map calc_gmsd results_per_run)
 
 ascii_show_multi_results
    :: Result a
@@ -313,30 +336,43 @@ ascii_show_multi_results
 
 ascii_show_multi_results (r:rs) ss f result_ok
 	= ascii_header ss 
-	. interleave "\n" (map show_results_for_prog base_results)
+	. interleave "\n" (map show_results_for_prog results_per_prog_mod_run)
+	. str "\n"
+	. str "\n"
+	. show_per_prog_results ("Average",gms)
+        . if nodevs then id
+                    else   str "\n"
+	                 . show_per_prog_results ("-1 s.d.",lows)
+	                 . str "\n"
+	                 . show_per_prog_results ("+1 s.d.",highs)
   where
 	base_results = fmToList r :: [(String,Results)]
 
-	show_results_for_prog (prog,r) =
-	      str ("\n"++prog++"\n")
-	    . (if null base then
-		 str "(no modules compiled)\n"
-	       else
-		 interleave "\n" (map (show_one_result fms) base))
+        -- results_per_prog_mod_run :: [(String,[(String,[BoxValue a])])]
+        results_per_prog_mod_run = map get_results_for_prog base_results
 
-         where
-	    base = fmToList (f r)
-	    fms = map (get_results_for prog) rs
+        -- get_results_for_prog :: (String,Results) -> (String,[BoxValue a])
+        get_results_for_prog (prog,r) = (prog, map get_results_for_mod (fmToList (f r)))
 
-	get_results_for prog m = case lookupFM m prog of
-				   Nothing -> emptyFM
-				   Just r -> f r
+           where fms = map get_run_results rs
 
-	show_one_result other_results (id,attribute) = 
-	 	show_per_prog_results (
-			calc_result other_results Just (const Success) 
-				result_ok (id,attribute) 
-		)
+                 get_run_results fm = case lookupFM fm prog of
+                                        Nothing  -> emptyFM
+                                        Just res -> f res
+
+                 get_results_for_mod (id,attr) = calc_result fms Just (const Success)
+                                                             result_ok (id,attr)
+
+        show_results_for_prog (prog,mrs) =
+	      str ("\n"++prog++"\n")
+	    . (if null mrs then
+		   str "(no modules compiled)\n"
+	         else
+		   interleave "\n" (map show_per_prog_results mrs))
+
+        results_per_run  = transpose [xs | (_,mods) <- results_per_prog_mod_run,
+                                           (_,xs) <- mods]
+        (lows,gms,highs) = unzip3 (map calc_gmsd results_per_run)
 
 show_per_prog_results :: Result a => (String, [BoxValue a]) -> ShowS
 show_per_prog_results (prog,results)
@@ -414,7 +450,7 @@ show_box (Percentage p) = show_pcntage p
 show_box (Result a)     = result_to_string a
 
 -----------------------------------------------------------------------------
--- Calculating geometric means
+-- Calculating geometric means and standard deviations
 
 {-
 This is done using the log method, to avoid needing really large
@@ -427,16 +463,43 @@ which is equivalent to
 	e ^ ( (log a1 + ... + log an) / n )
 
 where log is the natural logarithm function.
+
+Similarly, to compute the geometric standard deviation we compute the
+deviation of each log, take the root-mean-square, and take the
+exponential again:
+
+        e ^ sqrt( ( sqr(log a1 - lbar) + ... + sqr(log an - lbar) ) / n )
+
+where lbar is the mean log,
+
+        (log a1 + ... + log an) / n
+
+This is a *factor*: i.e., the 1 s.d. points are (gm/sdf,gm*sdf); do
+not subtract 100 from gm before performing this calculation.
+
+We therefore return a (low, mean, high) triple.
+
 -}
 
-calc_gm :: [BoxValue a] -> BoxValue Float
-calc_gm xs 
-  | null percentages = RunFailed NotDone
-  | otherwise        = Percentage (exp (sum (map log percentages) / 
-				          fromInt (length percentages)))
+calc_gmsd :: [BoxValue a] -> (BoxValue Float, BoxValue Float, BoxValue Float)
+calc_gmsd xs 
+  | null percentages = (RunFailed NotDone, RunFailed NotDone, RunFailed NotDone)
+  | otherwise        = let sqr x = x * x
+                           len   = fromInt (length percentages)
+                           logs  = map log percentages
+                           lbar  = sum logs / len
+                           devs  = map (sqr . (lbar-)) logs
+                           dbar  = sum devs / len
+                           gm    = exp lbar
+                           sdf   = exp (sqrt dbar)
+                       in
+                       (Percentage (gm/sdf),
+                        Percentage gm,
+                        Percentage (gm*sdf))
  where
-  percentages = [ f | Percentage f <- xs, f /= 0.0 ]
+  percentages = [ if f < 5 then 5 else f | Percentage f <- xs ]
 	-- can't do log(0.0), so exclude zeros
+        -- small values have inordinate effects so cap at -95%.
 
 -----------------------------------------------------------------------------
 -- Generic stuff for results generation