utils/heap-view/Graph.lhs

   1 Started 29/11/93:
   2
   3 > module Main where
   4 > import PreludeGlaST
   5 > import LibSystem
   6
   7 Program to draw a graph of last @n@ pieces of data from standard input
   8 continuously.
   9
  10 > n :: Int
  11 > n = 40
  12
  13 > max_sample :: Int
  14 > max_sample = 100
  15
  16 > screen_size :: Int
  17 > screen_size = 200
  18
  19 Version of grapher that can handle the output of ghc's @+RTS -Sstderr@
  20 option.
  21
  22 Nice variant would be to take a list of numbers from the commandline
  23 and display several graphs at once.
  24
  25 > main :: IO ()
  26 > main =
  27 >       getArgs                         >>= \ r ->
  28 >       case r of
  29 >         [select] ->
  30 >               let selection = read select
  31 >               in
  32 >               xInitialise [] screen_size screen_size  >>
  33 >               hGetContents stdin                      >>= \ input ->
  34 >               graphloop2 (parseGCData selection input) []
  35 >         _ ->
  36 >               error "usage: graph <number in range 0..17>\n"
  37
  38 The format of glhc18's stderr stuff is:
  39
  40 -- start of example (view in 120 column window)
  41 graph +RTS -Sstderr -H500
  42
  43 Collector: APPEL  HeapSize: 500 (bytes)
  44
  45   Alloc  Collect   Live   Resid   GC    GC     TOT     TOT  Page Flts   No of Roots  Caf  Mut-  Old  Collec  Resid
  46   bytes   bytes    bytes   ency  user  elap    user    elap   GC  MUT  Astk Bstk Reg  No  able  Gen   tion   %heap
  47      248     248      60  24.2%  0.00  0.04    0.05    0.23    1    1     1    0   0   1     0    0   Minor
  48 -- end of example
  49      0       1      2       3      4    5      6       7       8    9    10   11  12  13    14   15      16     17
  50
  51 That is: 6 header lines followed by 17-18 columns of integers,
  52 percentages, floats and text.
  53
  54 The scaling in the following is largely based on guesses about likely
  55 values - needs tuned.
  56
  57 @gcParsers@ is a list of functions which parse the corresponding
  58 column and attempts to scale the numbers into the range $0.0 .. 1.0$.
  59 (But may return a number avove $1.0$ which graphing part will scale to
  60 fit screen...)
  61
  62 (Obvious optimisation - replace by list of scaling information!)
  63
  64 (Obvious improvement - return (x,y) pair based on elapsed (or user) time.)
  65
  66 > gcParsers :: [ String -> Float ]
  67 > gcParsers = [ heap, heap, heap, percent, time, time, time, time, flts, flts, stk, stk, reg, caf, caf, heap, text, percent ]
  68 >  where
  69 >   heap = scale 100000.0 . fromInt . check 0 . readDec
  70 >   stk  = scale  25000.0 . fromInt . check 0 . readDec
  71 >   int  = scale   1000.0 . fromInt . check 0 . readDec
  72 >   reg = scale   10.0 . fromInt . check 0 . readDec
  73 >   caf = scale  100.0 . fromInt . check 0 . readDec
  74 >   flts = scale  100.0 . fromInt . check 0 . readDec
  75 >   percent = scale 100.0 . check 0.0 . readFloat
  76 >   time   = scale  20.0 . check 0.0 . readFloat
  77 >   text s = 0.0
  78
  79 > check :: a -> [(a,String)] -> a
  80 > check error_value parses =
  81 >       case parses of
  82 >         []            -> error_value
  83 >         ((a,s):_)     -> a
  84
  85 > scale :: Float -> Float -> Float
  86 > scale max n = n / max
  87
  88 > parseGCData :: Int -> String -> [Float]
  89 > parseGCData column input =
  90 >       map ((gcParsers !! column) . (!! column) . words) (drop 6 (lines input))
  91
  92 Hmmm, how to add logarithmic scaling neatly?  Do I still need to?
  93
  94 Note: unpleasant as it is, the code cannot be simplified to something
  95 like the following.  The problem is that the graph won't start to be
  96 drawn until the first @n@ values are available. (Is there also a
  97 danger of clearing the screen while waiting for the next input value?)
  98 A possible alternative solution is to keep count of how many values
  99 have actually been received.
 100
 101 < graphloop2 :: [Float] -> [Float] -> IO ()
 102 < graphloop2 [] =
 103 <       return ()
 104 < graphloop2 ys =
 105 <       let ys' = take n ys
 106 <           m = maximum ys'
 107 <           y_scale = (floor m) + 1
 108 <           y_scale' = fromInt y_scale
 109 <       in
 110 <       xCls                                            >>
 111 <       drawScales y_scale                              >>
 112 <       draw x_coords [ x / y_scale' | x <- ys' ]       >>
 113 <       xHandleEvent                                    >>
 114 <       graphloop2 (tail ys)
 115
 116
 117 > graphloop2 :: [Float] -> [Float] -> IO ()
 118 > graphloop2 (y:ys) xs =
 119 >       let xs' = take n (y:xs)
 120 >           m = maximum xs'
 121 >           y_scale = (floor m) + 1
 122 >           y_scale' = fromInt y_scale
 123 >       in
 124 >       xCls                                            >>
 125 >       drawScales y_scale                              >>
 126 >       draw x_coords [ x / y_scale' | x <- xs' ]       >>
 127 >       xHandleEvent                                    >>
 128 >       graphloop2 ys xs'
 129 > graphloop2 [] xs =
 130 >       return ()
 131
 132 > x_coords :: [Float]
 133 > x_coords = [ 0.0, 1 / (fromInt n) .. ]
 134
 135 Draw lines specified by coordinates in range (0.0 .. 1.0) onto screen.
 136
 137 > draw :: [Float] -> [Float] -> IO ()
 138 > draw xs ys = drawPoly (zip xs' (reverse ys'))
 139 >  where
 140 >   xs' = [ floor (x * sz) | x <- xs ]
 141 >   ys' = [ floor ((1.0 - y) * sz) | y <- ys ]
 142 >   sz = fromInt screen_size
 143
 144 > drawPoly :: [(Int, Int)] -> IO ()
 145 > drawPoly ((x1,y1):(x2,y2):poly) =
 146 >       xDrawLine x1 y1 x2 y2           >>
 147 >       drawPoly ((x2,y2):poly)
 148 > drawPoly _ = return ()
 149
 150 Draw horizontal line at major points on y-axis.
 151
 152 > drawScales :: Int -> IO ()
 153 > drawScales y_scale =
 154 >       sequence (map drawScale ys)     >>
 155 >       return ()
 156 >  where
 157 >   ys = [ (fromInt i) / (fromInt y_scale) | i <- [1 .. y_scale - 1] ]
 158
 159 > drawScale :: Float -> IO ()
 160 > drawScale y =
 161 >       let y' = floor ((1.0 - y) * (fromInt screen_size))
 162 >       in
 163 >       xDrawLine 0 y' screen_size y'
 164
 165 >#include "common-bits"