timeplot 0.1.8 → 0.1.9
raw patch · 3 files changed
+87/−30 lines, 3 filesdep ~Chart
Dependency ranges changed: Chart
Files
- Graphics/Rendering/Chart/Event.hs +3/−3
- Tools/TimePlot.hs +82/−25
- timeplot.cabal +2/−2
Graphics/Rendering/Chart/Event.hs view
@@ -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
Tools/TimePlot.hs view
@@ -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<t = l:merge ls (p:ps) | True = p:merge (l:ls) ps- pulses = [PulseEvent t () | (t,Pulse) <- tes]+ pulses = [PulseEvent t (Status "") | (t,Pulse) <- tes] edges = [(t,e) | (t,e) <- tes, e /= Pulse]- longs = longs' Nothing 0 (error "Unreachable") edges+ longs = longs' (Status "") Nothing 0 (error "Unreachable") edges where- longs' _ 0 _ [] = []- longs' (Just t0) _ t [] = [LongEvent t0 t ()]- longs' Nothing n _ ((t,Rise):tes) = longs' (Just t) (n+1) t tes- longs' Nothing n _ ((t,Fall):tes) = longs' Nothing 0 t tes- longs' (Just t0) n _ ((t,Rise):tes) = longs' (Just t0) (n+1) t tes- longs' (Just t0) 1 _ ((t,Fall):tes) = LongEvent t0 t () : longs' Nothing 0 t tes- longs' (Just t0) n _ ((t,Fall):tes) = longs' (Just t0) (n-1) t tes+ longs' s _ 0 _ [] = []+ longs' s (Just t0) _ t [] = [LongEvent t0 t s]+ longs' s Nothing 0 _ ((t,Rise):tes) = longs' s (Just t) 1 t tes+ longs' s Nothing 0 _ ((t,Fall):tes) = longs' s Nothing 0 t tes+ longs' s (Just t0) n _ ((t,Rise):tes) = longs' s (Just t0) 1 t tes+ longs' s (Just t0) 1 _ ((t,Fall):tes) = LongEvent t0 t s : longs' s Nothing 0 t tes+ longs' s (Just t0) n _ ((t,Fall):tes) = longs' s (Just t0) (n-1) t tes+ longs' s Nothing 0 _ ((t,SetTo s'):tes) = longs' s' (Just t) 1 t tes+ longs' s (Just t0) n _ ((t,SetTo s'):tes) = LongEvent t0 t s : longs' s' (Just t) n t tes edges2bins :: (Ord t,HasDelta t) => 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." ]
timeplot.cabal view
@@ -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