diff --git a/Graphics/Rendering/Chart/Event.hs b/Graphics/Rendering/Chart/Event.hs --- a/Graphics/Rendering/Chart/Event.hs +++ b/Graphics/Rendering/Chart/Event.hs @@ -45,7 +45,7 @@ plot_event_data_ = [], plot_event_pulse_linestyle_ = const $ solidLine 2 (opaque red), plot_event_long_linestyle_ = const $ solidLine 1 (opaque black), - plot_event_long_fillstyle_ = const $ solidFillStyle (opaque white), + plot_event_long_fillstyle_ = const $ solidFillStyle (opaque lightgray), plot_event_track_linestyle_ = solidLine 1 (opaque black) } @@ -66,8 +66,8 @@ framedRect :: CairoLineStyle -> Rect -> CRender () framedRect ls r = setLineStyle ls >> strokePath (rectPath r) -barHeight = 15 -pulseHeight = 15 +barHeight = 7 +pulseHeight = 7 renderPlotEvent :: PlotEvent t e -> PointMapFn t e -> CRender () renderPlotEvent p pmap = do diff --git a/Tools/TimePlot.hs b/Tools/TimePlot.hs --- a/Tools/TimePlot.hs +++ b/Tools/TimePlot.hs @@ -10,6 +10,8 @@ import qualified Data.ByteString.Lazy.Char8 as B import Data.ByteString.Lex.Lazy.Double +import Data.Char + import Text.Regex.PCRE import Text.Regex.PCRE.ByteString @@ -31,11 +33,28 @@ import Data.Colour import Data.Colour.Names -data Edge = Rise | Fall | Pulse deriving (Eq,Show) +newtype Status = Status String deriving (Eq, Show, Ord) +instance PlotValue Status where + toValue = const 0 + fromValue = const (Status "") + autoAxis = const unitStatusAxis + +unitStatusAxis :: AxisData Status +unitStatusAxis = AxisData { + axis_viewport_ = \(x0,x1) _ -> (x0+x1)/2, + axis_tropweiv_ = \_ _ -> Status "", + axis_ticks_ = [(Status "", 0)], + axis_labels_ = [[(Status "", "")]], + axis_grid_ = [] +} + +data Edge = Rise | Fall | Pulse | SetTo Status deriving (Eq,Show) + data InEvent = InEdge Edge | InValue Double | InAtom S.ByteString + deriving (Show) data OutFormat = PNG | PDF | PS | SVG | Window @@ -71,14 +90,15 @@ instance TimeAxis LocalTime data (TimeAxis t) => ChartKind t = KindEvent - | KindDuration { subKind :: ChartKind t } + | KindDuration { mapName :: S.ByteString -> S.ByteString, subKind :: ChartKind t } | KindHistogram { binSize :: Delta t } | KindQuantile { binSize :: Delta t, quantiles :: [Double] } | KindBinFreq { binSize :: Delta t, delims :: [Double] } | KindBinCount { binSize :: Delta t, delims :: [Double] } | KindFreq { binSize :: Delta t, style :: PlotBarsStyle } | KindCount { binSize :: Delta t, style :: PlotBarsStyle } - | KindValue + | KindLines + | KindDots | KindNone @@ -138,10 +158,13 @@ parseKind ["quantile",b,q] = KindQuantile {binSize=read b, quantiles=read ("["++q++"]")} parseKind ["binf", b,q] = KindBinFreq {binSize=read b, delims =read ("["++q++"]")} parseKind ["binc", b,q] = KindBinCount {binSize=read b, delims =read ("["++q++"]")} - parseKind ["value" ] = KindValue - parseKind ("duration":ws) = KindDuration {subKind=parseKind ws} + parseKind ["lines" ] = KindLines + parseKind ["dots" ] = KindDots + parseKind ("duration":ws) = KindDuration {subKind=parseKind ws, mapName=id} + parseKind (('d':'u':'r':'a':'t':'i':'o':'n':'[':sep:"]"):ws) + = KindDuration {subKind=parseKind ws, mapName = fst . S.break (==sep)} parseKind ["none" ] = KindNone - parseKind ws = error ("Unknown diagram kind" ++ unwords ws) + parseKind ws = error ("Unknown diagram kind " ++ unwords ws) defaultKind = parseKind $ words $ single "default kind" "-dk" "event" @@ -168,6 +191,10 @@ '>' -> return (t, strict rest, InEdge Rise ) '<' -> return (t, strict rest, InEdge Fall ) '!' -> return (t, strict rest, InEdge Pulse) + '@' -> do + let (track, val') = B.break (==' ') rest + (_,val) <- B.uncons val' + return (t, strict track, InEdge . SetTo . Status . B.unpack $ val) '=' -> do let (track, val') = B.break (==' ') rest (_,val) <- B.uncons val' @@ -187,11 +214,23 @@ makeChart chartKindF [] = emptyRenderable makeChart chartKindF events@((t0,_,_):_) = renderLayout1sStacked plots where - track2events = reverse `fmap` foldl insert M.empty [(s, (t, e)) | (t, s, e) <- events] + track2events = reverse `fmap` foldl' insert M.empty [(s, (t, e)) | (t, s, e) <- events] where insert m (s, r) = M.alter (Just . maybe [r] (r:)) s m plots = [ plotTrack k es | (k, es) <- M.toList track2events, - case (chartKindF k) of {KindNone -> False ; _ -> True} ] + case (chartKindF k) of {KindNone -> False ; KindDuration _ _ -> False ; _ -> True} ] ++ + durationPlots + durationPlots = [ plotWithKind name k es | (name, (k,es)) <- M.toList durationTracks ] + where + durationTracks = M.fromListWith (\(ka,as) (kb,bs) -> (ka,mergeOn fst as bs)) components + components = [ (mn k, (sk, edges2durations (edges es)))| (k, es) <- M.toList track2events, + Just (sk,mn) <- [case (chartKindF k) of + {KindDuration mn sk -> Just (sk,mn) ; _ -> Nothing}]] + mergeOn f [] ys = ys + mergeOn f xs [] = xs + mergeOn f (x:xs) (y:ys) + | f x <= f y = x : mergeOn f xs (y:ys) + | otherwise = y : mergeOn f (x:xs) ys timeBounds = (head times, last times) times = sort $ [t | tes <- M.elems track2events, (t,_)<- tes] @@ -207,9 +246,10 @@ KindQuantile bs qs -> withAnyOrdinate $ plotTrackQuantile name es qs bs KindBinFreq bs vs -> withAnyOrdinate $ plotTrackBinFreqs name es vs bs KindBinCount bs vs -> withAnyOrdinate $ plotTrackBinCounts name es vs bs - KindValue -> withAnyOrdinate $ plotTrackValue name es - KindDuration sk -> plotWithKind name sk (edges2durations (edges es)) - KindNone -> error "KindNone should not be plotted" + KindLines -> withAnyOrdinate $ plotTrackLines name es + KindDots -> withAnyOrdinate $ plotTrackDots name es + KindDuration _ _ -> error "KindDuration should not be plotted" + KindNone -> error "KindNone should not be plotted" edges es = [(t,e) | (t,InEdge e) <- es] values es = [(t,v) | (t,InValue v) <- es] @@ -242,7 +282,9 @@ vs = M.keys $ M.fromList $ [(a,()) | (_,a) <- as] plotTrackEvent name es = layoutWithTitle (toPlot plot) name - where plot = plot_event_data ^= edges2events (edges es) $ defaultPlotEvent + where plot = plot_event_data ^= edges2events (edges es) $ + plot_event_long_fillstyle ^= toFillStyle $ defaultPlotEvent + toFillStyle (Status s) = solidFillStyle . opaque $ fromMaybe lightgray (readColourName s) plotTrackQuantile name es qs bs = layoutWithTitle (plotBars plot) name where plot = plot_bars_values ^= toBars (byTimeBins (getQuantiles qs) bs t0 (values es)) $ @@ -285,9 +327,14 @@ toBars tvs = [(t,diffs vs) | (t,vs) <- tvs] diffs xs = zipWith (-) xs (0:xs) - plotTrackValue name es = layoutWithTitle (toPlot plot) name + plotTrackLines name es = layoutWithTitle (toPlot plot) name where plot = plot_lines_values ^= [values es] $ defaultPlotLines + plotTrackDots name es = layoutWithTitle (toPlot plot) name + where plot = plot_points_values ^= values es $ + plot_points_style ^= hollowCircles 4 1 (opaque blue) $ + defaultPlotPoints + layoutWithTitle plot name = layout1_title ^= "" $ layout1_plots ^= [Left plot] $ @@ -295,12 +342,13 @@ layout1_top_axis .> laxis_generate ^= (\_ -> commonTimeAxis) $ layout1_left_axis .> laxis_title ^= S.unpack name $ layout1_margin ^= 0 $ + layout1_grid_last ^= True $ defaultLayout1 edges2durations :: forall t. (Ord t, HasDelta t) => [(t,Edge)] -> [(t,InEvent)] -edges2durations tes = [(t1, InValue $ toSeconds (t2 `sub` t1) (undefined::t)) | LongEvent t1 t2 () <- edges2events tes] +edges2durations tes = [(t1, InValue $ toSeconds (t2 `sub` t1) (undefined::t)) | LongEvent t1 t2 _ <- edges2events tes] -edges2events :: (Ord t) => [(t,Edge)] -> [Event t ()] +edges2events :: (Ord t) => [(t,Edge)] -> [Event t Status] edges2events tes = longs `merge` pulses where merge [] ps = ps @@ -308,17 +356,19 @@ merge (l@(LongEvent t1 t2 _):ls) (p@(PulseEvent t _):ps) | t1 Delta t -> t -> [(t,Edge)] -> [((t,t), Int)] edges2bins binSize t0 es = gather 0 0 0 es $ iterate (add binSize) t0 @@ -335,6 +385,8 @@ = gather nmax (nopen-1) npulse tes (t1:t2:ts) gather nmax nopen npulse ((t,Pulse):tes) (t1:t2:ts) = gather (nmax `max` (nopen+npulse+1)) nopen (npulse+1) tes (t1:t2:ts) + gather nmax nopen npulse ((t,SetTo s):tes) (t1:t2:ts) + = gather nmax nopen npulse tes (t1:t2:ts) values2timeBins :: (Ord t) => [t] -> [(t,a)] -> [[a]] values2timeBins (t1:t2:ts) [] = [] @@ -428,6 +480,10 @@ "It is assumed that many events of the same kind may occur at once.", "Diagram kinds:", " 'event' is for event diagrams: during events are drawn like --[===]--- , pulse events like --|--", + " 'duration XXXX' - plot any kind of diagram over the *durations* of events on a track (delimited by > ... <)", + " for example 'duration quantile 300 0.25,0.5,0.75' will plot these quantiles of durations of the events.", + " This is useful where your log looks like 'Started processing' ... 'Finished processing': you can plot", + " processing durations without computing them yourself.", " 'hist N' is for histograms: a histogram is drawn with granularity of N time units, where", " the bin corresponding to [t..t+N) has value 'what was the maximal number of active events", " in that interval'.", @@ -443,7 +499,8 @@ " into bins min..v1, v1..v2, .., v2..max in time bins of size N", " 'binc N v1,v2,..' (example: binf 100 1,2,5,10) - a bar chart of counts of values falling", " into bins min..v1, v1..v2, .., v2..max in time bins of size N", - " 'value' - a simple line plot of numeric values", + " 'lines' - a simple line plot of numeric values", + " 'dots' - a simple dot plot of numeric values", "N is measured in units or in seconds." ] diff --git a/timeplot.cabal b/timeplot.cabal --- a/timeplot.cabal +++ b/timeplot.cabal @@ -1,5 +1,5 @@ Name: timeplot -Version: 0.1.8 +Version: 0.1.9 License: BSD3 License-file: LICENSE Copyright: Eugene Kirpichov, 2009 @@ -27,7 +27,7 @@ else Build-Depends: base < 3 - Build-Depends: Chart >= 0.12, cairo, bytestring, bytestring-lexing, strptime >= 0.1.5, time, + Build-Depends: Chart >= 0.14, cairo, bytestring, bytestring-lexing, strptime >= 0.1.5, time, containers, colour, data-accessor == 0.2.*, data-accessor-template >= 0.2.1.1 && < 0.3, haskell98, regex-pcre Main-Is: Tools/TimePlot.hs