plot 0.1.8 → 0.2
raw patch · 8 files changed
+319/−213 lines, 8 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
+ Graphics.Rendering.Plot.Figure: BarNone :: BarSetting
+ Graphics.Rendering.Plot.Figure: BarSpread :: BarSetting
+ Graphics.Rendering.Plot.Figure: BarStack :: BarSetting
+ Graphics.Rendering.Plot.Figure: barSetting :: BarSetting -> Plot ()
+ Graphics.Rendering.Plot.Figure: data BarSetting
Files
- CHANGES +3/−0
- lib/Graphics/Rendering/Plot/Defaults.hs +1/−1
- lib/Graphics/Rendering/Plot/Figure.hs +3/−0
- lib/Graphics/Rendering/Plot/Figure/Plot.hs +11/−4
- lib/Graphics/Rendering/Plot/Render/Plot.hs +2/−2
- lib/Graphics/Rendering/Plot/Render/Plot/Data.hs +289/−203
- lib/Graphics/Rendering/Plot/Types.hs +8/−1
- plot.cabal +2/−2
CHANGES view
@@ -101,3 +101,6 @@ 0.1.8: * added `TickFormat` data type++0.2:+ * added `BarSpread`
lib/Graphics/Rendering/Plot/Defaults.hs view
@@ -198,7 +198,7 @@ emptyPlot :: PlotData emptyPlot = Plot False defaultPlotPadding NoText (Ranges (Left (Range Linear (-1) 1)) (Left (Range Linear (-1) 1)))- [] undefined Nothing []+ [] BarSpread undefined Nothing [] -----------------------------------------------------------------------------
lib/Graphics/Rendering/Plot/Figure.hs view
@@ -88,6 +88,9 @@ , clearAxis , addAxis , withAxis+ -- * BarSetting+ , BarSetting(..)+ , barSetting -- * Legend , Legend , LegendBorder
lib/Graphics/Rendering/Plot/Figure/Plot.hs view
@@ -57,6 +57,8 @@ , clearAxis , addAxis , withAxis+ -- * BarSetting+ , barSetting -- * Legend , L.Legend , LegendBorder@@ -187,6 +189,11 @@ ----------------------------------------------------------------------------- +barSetting :: BarSetting -> Plot ()+barSetting bc = modify $ \s -> s { _barconfig = bc }++-----------------------------------------------------------------------------+ -- | clear the legend clearLegend :: Plot () clearLegend = withLegend $ L.clearLegend@@ -265,8 +272,8 @@ ----------------------------------------------------------------------------- findMinMax :: Abscissae -> Ordinates -> (Double,Double)-findMinMax AbsFunction (OrdFunction _ f _) = let v = mapVector f (linspace 100 (-1,1))- in (minElement v,maxElement v)+findMinMax (AbsFunction _) (OrdFunction _ f _) = let v = mapVector f (linspace 100 (-1,1))+ in (minElement v,maxElement v) findMinMax (AbsPoints _ x) (OrdFunction _ f _) = let v = mapVector f x in (minElement v,maxElement v) -- what if errors go beyond plot?@@ -276,7 +283,7 @@ ,Prelude.max (maxElement o) (maxElement p)) abscMinMax :: Abscissae -> (Double,Double)-abscMinMax AbsFunction = defaultXAxisSideLowerRange+abscMinMax (AbsFunction _) = defaultXAxisSideLowerRange abscMinMax (AbsPoints _ x) = (minElement x,maxElement x) @@ -287,7 +294,7 @@ calculateRanges :: DataSeries -> ((Double,Double),(Double,Double)) calculateRanges (DS_Y ys) = let xmax = maximum $ map (\(DecSeries o _) -> fromIntegral $ ordDim o) $ A.elems ys- ym = unzip $ map (\(DecSeries o _) -> findMinMax AbsFunction o) $ A.elems ys+ ym = unzip $ map (\(DecSeries o _) -> findMinMax (AbsFunction id) o) $ A.elems ys ymm = (minimum $ fst ym,maximum $ snd ym) in ((0,xmax),ymm) calculateRanges (DS_1toN x ys) = let ym = unzip $ map (\(DecSeries o _) -> findMinMax x o) $ A.elems ys
lib/Graphics/Rendering/Plot/Render/Plot.hs view
@@ -84,7 +84,7 @@ put bb) (A.assocs d) renderPlot :: PlotData -> Render ()-renderPlot (Plot b p hd r a d l an) = do+renderPlot (Plot b p hd r a bc d l an) = do tx <- bbCentreWidth ty <- bbTopHeight (_,th) <- renderText hd Centre TTop tx ty@@ -107,7 +107,7 @@ renderBorder b cairo C.save clipBoundary- renderData r d+ renderData r bc d renderAnnotations r an cairo C.restore legend padding
lib/Graphics/Rendering/Plot/Render/Plot/Data.hs view
@@ -5,7 +5,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.Plot.Render.Plot.Data--- Copyright : (c) A. V. H. McPhail 2010+-- Copyright : (c) A. V. H. McPhail 2010, 2013 -- License : BSD3 -- -- Maintainer : haskell.vivian.mcphail <at> gmail <dot> com@@ -40,6 +40,7 @@ import Data.Word +import Data.Maybe import qualified Graphics.Rendering.Cairo as C import qualified Graphics.Rendering.Cairo.Matrix as CM @@ -81,11 +82,10 @@ mx = maxElement m mn = minElement m mapM_ (\ri -> mapM_ (\(rj,ci) -> do- let mi = ((rj `div` r')*c) + (ci `div` c')- let e = round . (* 255) . (/ (mx-mn)) . (\x -> x - mn) $ (fm @> mi)- let si = (rj*stride) + ci- B.unsafeWrite s si e) $ zip (repeat ri) [0..((c*c')-1)]) [0..((r*r')-1)]-+ let mi = ((rj `div` r')*c) + (ci `div` c')+ let e = round . (* 255) . (/ (mx-mn)) . (\x -> x - mn) $ (fm @> mi)+ let si = (rj*stride) + ci+ B.unsafeWrite s si e) $ zip (repeat ri) [0..((c*c')-1)]) [0..((r*r')-1)] ---------------------------------------------------------------------------- @@ -94,8 +94,8 @@ | x == 0.0 = 1.0 | otherwise = x -renderData :: Ranges -> DataSeries -> Render ()-renderData _ (DS_Surf m) = do +renderData :: Ranges -> BarSetting -> DataSeries -> Render ()+renderData _ _ (DS_Surf m) = do (BoundingBox x y w h) <- get let r = rows m c = cols m@@ -124,10 +124,10 @@ C.restore return () -renderData r ds = do+renderData r bc ds = do let aos = case ds of- (DS_Y os') -> zip (repeat AbsFunction) (A.elems os')- (DS_1toN abs' os') -> zip (repeat abs') (A.elems os') + (DS_Y os') -> zip (repeat (AbsFunction id)) (A.elems os')+ (DS_1toN abs' os') -> zip (repeat abs') (A.elems os') (DS_1to1 aos') -> A.elems aos' _ -> error "renderData: DataSeries not handled" let (los,ups) = partition (\(_,DecSeries o _) -> isLower o) aos@@ -145,7 +145,8 @@ --C.scale xscale yscalel C.translate (-xmin*xscale) (yminl*yscalel) flipVertical- mapM_ (renderSeries xsc yscl xmin xmax xscale yscalel) los+ los' <- configureBars xsc yscl xmin xmax xscale yscalel bc los + mapM_ (renderSeries xsc yscl xmin xmax xscale yscalel) los' cairo $ C.restore when (not $ null ups) (do@@ -159,7 +160,8 @@ --C.scale xscale yscaleu C.translate (-xmin*xscale) (yminu*yscaleu) flipVertical- mapM_ (renderSeries xsc yscu xmin xmax xscale yscaleu) ups+ ups' <- configureBars xsc yscu xmin xmax xscale yscaleu bc ups + mapM_ (renderSeries xsc yscu xmin xmax xscale yscaleu) ups' cairo $ C.restore) -- could filter annotations as well return ()@@ -178,173 +180,258 @@ logSeriesMinMax Log (v,w) = (logSeries Log v,logSeries Log w) logSeriesMinMax Linear x = x +getBar :: (Integer,(Abscissae,DecoratedSeries)) + -> Maybe (Integer,(Abscissae,DecoratedSeries,BarType)) +getBar (ix,(as,DecSeries os ds)) = let d = decorationGetBarType ds+ in case d of+ Just d' -> Just (ix,(as,DecSeries os ds,d'))+ Nothing -> Nothing++getBarWidth :: (Integer,(Abscissae,DecoratedSeries,BarType)) -> Render Double+getBarWidth (_,(_,_,(ColourBar _))) = do+ (BarOptions w _ _) <- asks (_baroptions . _renderoptions)+ return w+getBarWidth (_,(_,_,(TypeBar (BarOptions w _ _) _))) = return w++replace :: Integer -> a -> [a] -> [a]+replace n x xs = let (pre,post) = splitAt (fromIntegral n) xs+ in pre ++ x:(tail post)++shiftAbscissa :: (Integer,(Abscissae,DecoratedSeries,BarType)) -> Double+ -> (Integer,(Abscissae,DecoratedSeries))+shiftAbscissa (i,(AbsFunction f,ds,_)) s = (i,(AbsFunction ((+) s . f),ds))+shiftAbscissa (i,(AbsPoints mi t,ds,_)) s = (i,(AbsPoints mi (addConstant s t),ds))++replaceBars :: [(Integer,(Abscissae,DecoratedSeries))] + -> [(Abscissae,DecoratedSeries)] + -> [(Abscissae,DecoratedSeries)] +replaceBars [] as = as+replaceBars ((i,ds):dss) as = replaceBars dss $ replace i ds as++scanStacked :: Vector Double+ -> (Integer,(Abscissae,DecoratedSeries,BarType))+ -> Vector Double+scanStacked v (i,(_,DecSeries (OrdPoints _ o _) _,_)) = v + (getOrdData o)++convertBarToCandle :: (Vector Double,Vector Double)+ -> OrdSeries+ -> OrdSeries+convertBarToCandle (v,w) os =+ case os of+ Plain _ -> MinMax (v,w) Nothing+ Error _ (Right (el,eh)) -> MinMax (v,w) (Just (el,eh))+ _ -> error "convertBarToCandle: unreachable code"++mkCandlesFromBars :: (Vector Double,Vector Double)+ -> (Integer,(Abscissae,DecoratedSeries,BarType))+ -> (Integer,(Abscissae,DecoratedSeries))+mkCandlesFromBars (v,w) (i,(a,DecSeries (OrdPoints ax o mb_l) _,bt)) = + (i,(a,DecSeries (OrdPoints ax ordSeries mb_l) (DecCand bt)))+ where+ ordSeries = convertBarToCandle (v,w) o++getOrdData' :: DecoratedSeries -> Series+getOrdData' (DecSeries (OrdPoints _ os _) _) = getOrdData os++configureBars :: Scale -> Scale+ -> Double -> Double -> Double -> Double+ -> BarSetting+ -> [(Abscissae,DecoratedSeries)] + -> Render [(Abscissae,DecoratedSeries)] +configureBars xsc ysc xmin xmax xscale yscale bs aos = do+ let bars = mapMaybe getBar $ zip [0..] aos+ case bs of+ BarNone -> return aos+ BarSpread -> do+ widths <- mapM getBarWidth bars+ let half_total = (sum widths) / 2+ let shifts' = init $ scanl (+) 0 widths+ shifts = map ((/ xscale) . flip (-) half_total) shifts'+ let shifted = zipWith shiftAbscissa bars shifts+ let aos' = replaceBars shifted aos+ return aos'+ BarStack -> do+ let od = (getOrdData' . (\(_,b,_) -> b) . snd . head) bars+ let ln = dim $ od+ let zero = constant 0 ln+ let pairs = pair $ scanl scanStacked zero bars + let candles = zipWith mkCandlesFromBars pairs bars+ let aos' = replaceBars candles aos+ return aos'+ where pair [] = []+ pair [x,y] = [(x,y)]+ pair (x:y:xs) = (x,y) : pair (y:xs)+ renderSeries :: Scale -> Scale -> Double -> Double -> Double -> Double -> (Abscissae,DecoratedSeries) -> Render () renderSeries xsc ysc xmin xmax xscale yscale (abs,(DecSeries o d)) = do dat <- case o of- (OrdFunction _ f _) -> do- (BoundingBox _ _ w _) <- get- let t = logSeries xsc $ linspace (round w) (xmin,xmax)- return $ Left $ Left ((True,t),logSeries ysc $ mapVector f t)- (OrdPoints _ (Plain o') _) -> do- let t = case abs of- AbsFunction -> if isHist d- then (True,fromList [0.0..(fromIntegral $ dim o')])- else (True,fromList [1.0..(fromIntegral $ dim o')])- AbsPoints mi t' -> (mi,t')- return $ Left $ Left ((fst t,logSeries xsc $ snd t),logSeries ysc $ o')- (OrdPoints _ (Error o' (Left e)) _) -> do- let t = case abs of- AbsFunction -> if isHist d- then (True,fromList [0.0..(fromIntegral $ dim o')])- else (True,fromList [1.0..(fromIntegral $ dim o')])- AbsPoints mi t' -> (mi,t')- let t' = (fst t,logSeries xsc $ snd t)- return $ Left $ Right $ Left ((t',logSeries ysc $ o'),(t',logSeries ysc $ e))- (OrdPoints _ (Error o' (Right (l,h))) _) -> do- let t = case abs of- AbsFunction -> if isHist d- then (True,fromList [0.0..(fromIntegral $ dim o')])- else (True,fromList [1.0..(fromIntegral $ dim o')])- AbsPoints mi t' -> (mi,t') - let t' = (fst t,logSeries xsc $ snd t)- return $ Left $ Right $ Right ((t',logSeries ysc $ o'),(t',logSeries ysc $ l),(t',logSeries ysc $ h))- (OrdPoints _ (MinMax o' Nothing) _) -> do- let t = case abs of- AbsFunction -> (True,fromList [1.0..(fromIntegral $ dim $ fst o')])- AbsPoints mi t' -> (mi,t')- let t' = (fst t,logSeries xsc $ snd t)- return $ Right $ Left (t',logSeriesMinMax ysc $ o')- (OrdPoints _ (MinMax o' (Just (l,h))) _) -> do- let t = case abs of- AbsFunction -> (True,fromList [1.0..(fromIntegral $ dim l)])- AbsPoints mi t' -> (mi,t')- let t' = (fst t,logSeries xsc $ snd t)- return $ Right $ Right ((t',logSeriesMinMax ysc o'),(t',(logSeries ysc l,logSeries ysc h)))+ (OrdFunction _ f _) -> do+ (BoundingBox _ _ w _) <- get+ let t = logSeries xsc $ linspace (round w) (xmin,xmax)+ return $ Left $ Left ((True,t),logSeries ysc $ mapVector f t)+ (OrdPoints _ (Plain o') _) -> do+ let t = case abs of+ AbsFunction f -> + if isHist d+ then (True,mapVector f $ fromList [0.0..(fromIntegral $ dim o')])+ else (True,mapVector f $ fromList [1.0..(fromIntegral $ dim o')])+ AbsPoints mi t' -> (mi,t')+ return $ Left $ Left ((fst t,logSeries xsc $ snd t),logSeries ysc $ o')+ (OrdPoints _ (Error o' (Left e)) _) -> do+ let t = case abs of+ AbsFunction f -> + if isHist d+ then (True,mapVector f $ fromList [0.0..(fromIntegral $ dim o')])+ else (True,mapVector f $ fromList [1.0..(fromIntegral $ dim o')])+ AbsPoints mi t' -> (mi,t')+ let t' = (fst t,logSeries xsc $ snd t)+ return $ Left $ Right $ Left ((t',logSeries ysc $ o'),(t',logSeries ysc $ e))+ (OrdPoints _ (Error o' (Right (l,h))) _) -> do+ let t = case abs of+ AbsFunction f -> + if isHist d+ then (True,mapVector f $ fromList [0.0..(fromIntegral $ dim o')])+ else (True,mapVector f $ fromList [1.0..(fromIntegral $ dim o')])+ AbsPoints mi t' -> (mi,t') + let t' = (fst t,logSeries xsc $ snd t)+ return $ Left $ Right $ Right ((t',logSeries ysc $ o'),(t',logSeries ysc $ l),(t',logSeries ysc $ h))+ (OrdPoints _ (MinMax o' Nothing) _) -> do+ let t = case abs of+ AbsFunction f -> (True,mapVector f $ fromList [1.0..(fromIntegral $ dim $ fst o')])+ AbsPoints mi t' -> (mi,t')+ let t' = (fst t,logSeries xsc $ snd t)+ return $ Right $ Left (t',logSeriesMinMax ysc $ o')+ (OrdPoints _ (MinMax o' (Just (l,h))) _) -> do+ let t = case abs of+ AbsFunction f -> (True,mapVector f $ fromList [1.0..(fromIntegral $ dim l)])+ AbsPoints mi t' -> (mi,t')+ let t' = (fst t,logSeries xsc $ snd t)+ return $ Right $ Right ((t',logSeriesMinMax ysc o'),(t',(logSeries ysc l,logSeries ysc h))) case d of (DecLine lt) -> do- formatLineSeries lt- case dat of- Left (Left (t',y')) -> do- renderSamples xscale yscale xmin xmax Nothing renderLineSample endLineSample t' y'- _ -> error "Data.hs renderSeries: cannot have error bars with line type"+ formatLineSeries lt+ case dat of+ Left (Left (t',y')) -> do+ renderSamples xscale yscale xmin xmax Nothing renderLineSample endLineSample t' y'+ _ -> error "Data.hs renderSeries: cannot have error bars with line type" (DecPoint pt) -> do- (pz,g) <- formatPointSeries pt- case dat of- Left (Left (t',y')) -> do- renderSamples xscale yscale xmin xmax Nothing (renderPointSample pz g) endPointSample t' y'- Left (Right (Left ((t',y'),(_,e')))) -> do- renderSamples xscale yscale xmin xmax Nothing (renderPointSample pz g) endPointSample t' y'- renderSamples xscale yscale xmin xmax Nothing (renderPointSample pz Bot) endPointSample t' (y'-e')- renderSamples xscale yscale xmin xmax Nothing (renderPointSample pz Top) endPointSample t' (y'+e')- Left (Right (Right ((t',y'),(_,l),(_,h)))) -> do- renderSamples xscale yscale xmin xmax Nothing (renderPointSample pz g) endPointSample t' y'- renderSamples xscale yscale xmin xmax Nothing (renderPointSample pz Bot) endPointSample t' l - renderSamples xscale yscale xmin xmax Nothing (renderPointSample pz Top) endPointSample t' h - _ -> error "Data.hs renderSeries: cannot have MinMax data series with point type"+ (pz,g) <- formatPointSeries pt+ case dat of+ Left (Left (t',y')) -> do+ renderSamples xscale yscale xmin xmax Nothing (renderPointSample pz g) endPointSample t' y'+ Left (Right (Left ((t',y'),(_,e')))) -> do+ renderSamples xscale yscale xmin xmax Nothing (renderPointSample pz g) endPointSample t' y'+ renderSamples xscale yscale xmin xmax Nothing (renderPointSample pz Bot) endPointSample t' (y'-e')+ renderSamples xscale yscale xmin xmax Nothing (renderPointSample pz Top) endPointSample t' (y'+e')+ Left (Right (Right ((t',y'),(_,l),(_,h)))) -> do+ renderSamples xscale yscale xmin xmax Nothing (renderPointSample pz g) endPointSample t' y'+ renderSamples xscale yscale xmin xmax Nothing (renderPointSample pz Bot) endPointSample t' l + renderSamples xscale yscale xmin xmax Nothing (renderPointSample pz Top) endPointSample t' h + _ -> error "Data.hs renderSeries: cannot have MinMax data series with point type" (DecLinPt lt pt) -> do- formatLineSeries lt- (pz,g) <- formatPointSeries pt- case dat of- Left (Left (t',y')) -> do- renderSamples xscale yscale xmin xmax Nothing renderLineSample endLineSample t' y'- renderSamples xscale yscale xmin xmax Nothing (renderPointSample pz g) endPointSample t' y'- Left (Right (Left ((t',y'),(_,e')))) -> do- renderSamples xscale yscale xmin xmax Nothing renderLineSample endLineSample t' y'- renderSamples xscale yscale xmin xmax Nothing (renderPointSample pz g) endPointSample t' y'- renderSamples xscale yscale xmin xmax Nothing (renderPointSample pz Bot) endPointSample t' (y'-e')- renderSamples xscale yscale xmin xmax Nothing (renderPointSample pz Top) endPointSample t' (y'+e')- error "Data.hs renderSeries: cannot have single error value with line-points type" - Left (Right (Right ((t',y'),(_,l),(_,h)))) -> do- renderSamples xscale yscale xmin xmax Nothing renderLineSample endLineSample t' y'- renderSamples xscale yscale xmin xmax Nothing (renderPointSample pz g) endPointSample t' y'- renderSamples xscale yscale xmin xmax Nothing (renderPointSample pz Bot) endPointSample t' l - renderSamples xscale yscale xmin xmax Nothing (renderPointSample pz Top) endPointSample t' h - _ -> error "Data.hs renderSeries: cannot have MinMax data series with line-point type"+ formatLineSeries lt+ (pz,g) <- formatPointSeries pt+ case dat of+ Left (Left (t',y')) -> do+ renderSamples xscale yscale xmin xmax Nothing renderLineSample endLineSample t' y'+ renderSamples xscale yscale xmin xmax Nothing (renderPointSample pz g) endPointSample t' y'+ Left (Right (Left ((t',y'),(_,e')))) -> do+ renderSamples xscale yscale xmin xmax Nothing renderLineSample endLineSample t' y'+ renderSamples xscale yscale xmin xmax Nothing (renderPointSample pz g) endPointSample t' y'+ renderSamples xscale yscale xmin xmax Nothing (renderPointSample pz Bot) endPointSample t' (y'-e')+ renderSamples xscale yscale xmin xmax Nothing (renderPointSample pz Top) endPointSample t' (y'+e')+-- error "Data.hs renderSeries: cannot have single error value with line-points type" + Left (Right (Right ((t',y'),(_,l),(_,h)))) -> do+ renderSamples xscale yscale xmin xmax Nothing renderLineSample endLineSample t' y'+ renderSamples xscale yscale xmin xmax Nothing (renderPointSample pz g) endPointSample t' y'+ renderSamples xscale yscale xmin xmax Nothing (renderPointSample pz Bot) endPointSample t' l + renderSamples xscale yscale xmin xmax Nothing (renderPointSample pz Top) endPointSample t' h + _ -> error "Data.hs renderSeries: cannot have MinMax data series with line-point type" (DecImpulse lt) -> do- formatLineSeries lt- case dat of- Left (Left (t',y')) -> do- renderSamples xscale yscale xmin xmax Nothing renderImpulseSample endImpulseSample t' y'- _ -> error "Data.hs renderSeries: cannot have error bars with impulse type"+ formatLineSeries lt+ case dat of+ Left (Left (t',y')) -> do+ renderSamples xscale yscale xmin xmax Nothing renderImpulseSample endImpulseSample t' y'+ _ -> error "Data.hs renderSeries: cannot have error bars with impulse type" (DecStep lt) -> do- formatLineSeries lt- case dat of- Left (Left (t',y')) -> do- renderSamples xscale yscale xmin xmax Nothing renderStepSample endStepSample t' y'- _ -> error "Data.hs renderSeries: cannot have error bars with step type"+ formatLineSeries lt+ case dat of+ Left (Left (t',y')) -> do+ renderSamples xscale yscale xmin xmax Nothing renderStepSample endStepSample t' y'+ _ -> error "Data.hs renderSeries: cannot have error bars with step type" (DecArea lt) -> do- formatLineSeries lt- case dat of- Left (Left (t',y')) -> do- let ln = dim $ snd t'- xmin_ix = findMinIdx (snd t') xmin 0 (ln-1)- x0 = (snd t') @> xmin_ix- y0 = y' @> xmin_ix- renderSamples xscale yscale xmin xmax Nothing renderAreaSample (endAreaSample x0 y0) t' y'- _ -> error "Data.hs renderSeries: cannot have error bars with area type"+ formatLineSeries lt+ case dat of+ Left (Left (t',y')) -> do+ let ln = dim $ snd t'+ xmin_ix = findMinIdx (snd t') xmin 0 (ln-1)+ x0 = (snd t') @> xmin_ix+ y0 = y' @> xmin_ix+ renderSamples xscale yscale xmin xmax Nothing renderAreaSample (endAreaSample x0 y0) t' y'+ _ -> error "Data.hs renderSeries: cannot have error bars with area type" (DecBar bt) -> do- (bw,bc,c) <- formatBarSeries bt- (gw,_) <- formatPointSeries defaultPointType - case dat of- Left (Left (t',y')) -> do- renderSamples xscale yscale xmin xmax Nothing (renderBarSample bw bc c) endBarSample t' y' - Left (Right (Left ((t',y'),(_,e')))) -> do- renderSamples xscale yscale xmin xmax Nothing (renderBarSample bw bc c) endBarSample t' y' - renderSamples xscale yscale xmin xmax Nothing (renderPointSampleUpDown gw) endPointSample t' e'- Left (Right (Right ((t',y'),(_,l'),(_,h')))) -> do- renderSamples xscale yscale xmin xmax Nothing (renderBarSample bw bc c) endBarSample t' y' - renderSamples xscale yscale xmin xmax Nothing (renderPointSample gw Bot) endPointSample t' l'- renderSamples xscale yscale xmin xmax Nothing (renderPointSample gw Top) endPointSample t' h'- _ -> error "Data.hs renderSeries: cannot have MinMax data series with bar type"+ (bw,bc,c) <- formatBarSeries bt+ (gw,_) <- formatPointSeries defaultPointType + case dat of+ Left (Left (t',y')) -> do+ renderSamples xscale yscale xmin xmax Nothing (renderBarSample bw bc c) endBarSample t' y' + Left (Right (Left ((t',y'),(_,e')))) -> do+ renderSamples xscale yscale xmin xmax Nothing (renderBarSample bw bc c) endBarSample t' y' + renderSamples xscale yscale xmin xmax Nothing (renderPointSampleUpDown gw) endPointSample t' e'+ Left (Right (Right ((t',y'),(_,l'),(_,h')))) -> do+ renderSamples xscale yscale xmin xmax Nothing (renderBarSample bw bc c) endBarSample t' y' + renderSamples xscale yscale xmin xmax Nothing (renderPointSample gw Bot) endPointSample t' l'+ renderSamples xscale yscale xmin xmax Nothing (renderPointSample gw Top) endPointSample t' h'+ _ -> error "Data.hs renderSeries: cannot have MinMax data series with bar type" (DecHist bt) -> do- (bw,bc,c) <- formatBarSeries bt- (gw,_) <- formatPointSeries defaultPointType - case dat of- Left (Left (t',y')) -> do- let ln = dim $ snd $ t'- xmin_ix = findMinIdx (snd t') xmin 0 (ln-1)- rest (m,v) = (m,subVector 1 (dim v - 1) v)- x0 = (snd t') @> xmin_ix- y0 = 0- renderSamples xscale yscale xmin xmax (Just $ C.moveTo x0 y0) (renderHistSample bw bc c) endHistSample (rest t') y'- Left (Right (Left ((t',y'),(_,e')))) -> do- let ln = dim $ snd $ t'- xmin_ix = findMinIdx (snd t') xmin 0 (ln-1)- rest (m,v) = (m,subVector 1 (dim v - 1) v)- x0 = (snd t') @> xmin_ix- y0 = 0- renderSamples xscale yscale xmin xmax (Just $ C.moveTo x0 y0) (renderHistSample bw bc c) endHistSample (rest t') y'- renderSamples xscale yscale xmin xmax Nothing (renderPointSampleUpDown gw) endPointSample (midpoints t') e'- Left (Right (Right ((t',y'),(_,l'),(_,h')))) -> do- let ln = dim $ snd $ t'- xmin_ix = findMinIdx (snd t') xmin 0 (ln-1)- rest (m,v) = (m,subVector 1 (dim v - 1) v)- x0 = (snd t') @> xmin_ix- y0 = 0- renderSamples xscale yscale xmin xmax (Just $ C.moveTo x0 y0) (renderHistSample bw bc c) endHistSample (rest t') y'- renderSamples xscale yscale xmin xmax Nothing (renderPointSample gw Bot) endPointSample (midpoints t') l'- renderSamples xscale yscale xmin xmax Nothing (renderPointSample gw Top) endPointSample (midpoints t') h'- _ -> error "Data.hs renderSeries: cannot have MinMax data series with histogram type"+ (bw,bc,c) <- formatBarSeries bt+ (gw,_) <- formatPointSeries defaultPointType + case dat of+ Left (Left (t',y')) -> do+ let ln = dim $ snd $ t'+ xmin_ix = findMinIdx (snd t') xmin 0 (ln-1)+ rest (m,v) = (m,subVector 1 (dim v - 1) v)+ x0 = (snd t') @> xmin_ix+ y0 = 0+ renderSamples xscale yscale xmin xmax (Just $ C.moveTo x0 y0) (renderHistSample bw bc c) endHistSample (rest t') y'+ Left (Right (Left ((t',y'),(_,e')))) -> do+ let ln = dim $ snd $ t'+ xmin_ix = findMinIdx (snd t') xmin 0 (ln-1)+ rest (m,v) = (m,subVector 1 (dim v - 1) v)+ x0 = (snd t') @> xmin_ix+ y0 = 0+ renderSamples xscale yscale xmin xmax (Just $ C.moveTo x0 y0) (renderHistSample bw bc c) endHistSample (rest t') y'+ renderSamples xscale yscale xmin xmax Nothing (renderPointSampleUpDown gw) endPointSample (midpoints t') e'+ Left (Right (Right ((t',y'),(_,l'),(_,h')))) -> do+ let ln = dim $ snd $ t'+ xmin_ix = findMinIdx (snd t') xmin 0 (ln-1)+ rest (m,v) = (m,subVector 1 (dim v - 1) v)+ x0 = (snd t') @> xmin_ix+ y0 = 0+ renderSamples xscale yscale xmin xmax (Just $ C.moveTo x0 y0) (renderHistSample bw bc c) endHistSample (rest t') y'+ renderSamples xscale yscale xmin xmax Nothing (renderPointSample gw Bot) endPointSample (midpoints t') l'+ renderSamples xscale yscale xmin xmax Nothing (renderPointSample gw Top) endPointSample (midpoints t') h'+ _ -> error "Data.hs renderSeries: cannot have MinMax data series with histogram type" (DecCand bt) → do- (bw,bc,c) ← formatBarSeries bt- case dat of - Left _ -> error "Candles series requires two data series (MinMax series)"- Right (Left (t',y')) -> do- renderMinMaxSamples xscale yscale xmin xmax Nothing (renderCandleSample bw bc c) endCandleSample t' y'- Right (Right ((t',y'),(_,e'))) → do- renderMinMaxSamples xscale yscale xmin xmax Nothing (renderWhiskerSample bw bc c False) endWhiskerSample t' e'- renderMinMaxSamples xscale yscale xmin xmax Nothing (renderCandleSample bw bc c) endCandleSample t' y'+ (bw,bc,c) <- formatBarSeries bt+ case dat of + Left _ -> error "Candles series requires two data series (MinMax series)"+ Right (Left (t',y')) -> do+ renderMinMaxSamples xscale yscale xmin xmax Nothing (renderCandleSample bw bc c) endCandleSample t' y'+ Right (Right ((t',y'),(_,e'))) -> do+ renderMinMaxSamples xscale yscale xmin xmax Nothing (renderWhiskerSample bw bc c False) endWhiskerSample t' e'+ renderMinMaxSamples xscale yscale xmin xmax Nothing (renderCandleSample bw bc c) endCandleSample t' y' (DecWhisk bt) → do- (bw,bc,c) ← formatBarSeries bt+ (bw,bc,c) <- formatBarSeries bt case dat of - Left _ -> error "Candles series requires two data series (MinMax series)"- Right (Left (t',y')) -> do- renderMinMaxSamples xscale yscale xmin xmax Nothing (renderCandleSample bw bc c) endCandleSample t' y'- Right (Right ((t',y'),(_,e'))) → do- renderMinMaxSamples xscale yscale xmin xmax Nothing (renderWhiskerSample bw bc c True) endWhiskerSample t' e'- renderMinMaxSamples xscale yscale xmin xmax Nothing (renderCandleSample bw bc c) endCandleSample t' y'+ Left _ -> error "Candles series requires two data series (MinMax series)"+ Right (Left (t',y')) -> do+ renderMinMaxSamples xscale yscale xmin xmax Nothing (renderCandleSample bw bc c) endCandleSample t' y'+ Right (Right ((t',y'),(_,e'))) -> do+ renderMinMaxSamples xscale yscale xmin xmax Nothing (renderWhiskerSample bw bc c True) endWhiskerSample t' e'+ renderMinMaxSamples xscale yscale xmin xmax Nothing (renderCandleSample bw bc c) endCandleSample t' y' return () -----------------------------------------------------------------------------@@ -355,26 +442,26 @@ -> (Double -> Double -> Double -> Double -> C.Render ()) -> (Double -> Double -> C.Render ()) -> (Bool,Vector Double) -> Vector Double -> Render () renderSamples xscale yscale xmin xmax s f e (mono,t) y = do- (BoundingBox _ _ w _) <- get- let ln = dim t- (xmin_ix,xmax_ix,num_pts) = if mono- then (findMinIdx t xmin 0 (ln-1)- ,findMaxIdx t xmax (ln-1) 0- ,xmax_ix - xmin_ix + 1)- else (0,ln-1,ln)- diff'' = floor $ (fromIntegral num_pts)/w- diff' = if diff'' <= 1 then 1 else diff''- diff = if mono then diff' else 1- cairo $ do- case s of- Nothing -> C.moveTo ((t @> xmin_ix)*xscale) ((y @> xmin_ix)*yscale)- Just s' -> s'- _ <- runMaybeT $ do- mapVectorWithIndexM_ (\j y' -> do- when (j >= xmin_ix && j `mod` diff == 0)- (renderSample j xmax_ix t (f xscale yscale) y')- return ()) y- (e xscale yscale)+ (BoundingBox _ _ w _) <- get+ let ln = dim t+ (xmin_ix,xmax_ix,num_pts) = if mono+ then (findMinIdx t xmin 0 (ln-1)+ ,findMaxIdx t xmax (ln-1) 0+ ,xmax_ix - xmin_ix + 1)+ else (0,ln-1,ln)+ diff'' = floor $ (fromIntegral num_pts)/w+ diff' = if diff'' <= 1 then 1 else diff''+ diff = if mono then diff' else 1+ cairo $ do+ case s of+ Nothing -> C.moveTo ((t @> xmin_ix)*xscale) ((y @> xmin_ix)*yscale)+ Just s' -> s'+ _ <- runMaybeT $ do+ mapVectorWithIndexM_ (\j y' -> do+ when (j >= xmin_ix && j `mod` diff == 0)+ (renderSample j xmax_ix t (f xscale yscale) y')+ return ()) y+ (e xscale yscale) ----------------------------------------------------------------------------- @@ -384,26 +471,25 @@ -> (Double -> Double -> Double -> (Double,Double) -> C.Render ()) -> (Double -> Double -> C.Render ()) -> (Bool,Vector Double) -> (Vector Double,Vector Double) -> Render () renderMinMaxSamples xscale yscale xmin xmax s f e (mono,t) y = do- (BoundingBox _ _ w _) <- get- let ln = dim t- (xmin_ix,xmax_ix,num_pts) = if mono- then (findMinIdx t xmin 0 (ln-1)- ,findMaxIdx t xmax (ln-1) 0- ,xmax_ix - xmin_ix + 1)- else (0,ln-1,ln)- diff'' = floor $ (fromIntegral num_pts)/w- diff' = if diff'' <= 1 then 1 else diff''- diff = if mono then diff' else 1- cairo $ do- case s of- Nothing -> C.moveTo ((t @> xmin_ix)*xscale) (((fst $ y) @> xmin_ix)*yscale)- Just s' -> s'-- _ <- runMaybeT $ mapVectorWithIndexM_ (\j t' -> do- when (j >= xmin_ix && j `mod` diff == 0)- (renderMinMaxSample j xmax_ix t' (f xscale yscale) (e xscale yscale) y)- return ()) t- return ()+ (BoundingBox _ _ w _) <- get+ let ln = dim t+ (xmin_ix,xmax_ix,num_pts) = if mono+ then (findMinIdx t xmin 0 (ln-1)+ ,findMaxIdx t xmax (ln-1) 0+ ,xmax_ix - xmin_ix + 1)+ else (0,ln-1,ln)+ diff'' = floor $ (fromIntegral num_pts)/w+ diff' = if diff'' <= 1 then 1 else diff''+ diff = if mono then diff' else 1+ cairo $ do+ case s of+ Nothing -> C.moveTo ((t @> xmin_ix)*xscale) (((fst $ y) @> xmin_ix)*yscale)+ Just s' -> s'+ _ <- runMaybeT $ mapVectorWithIndexM_ (\j t' -> do+ when (j >= xmin_ix && j `mod` diff == 0)+ (renderMinMaxSample j xmax_ix t' (f xscale yscale) (e xscale yscale) y)+ return ()) t+ return () -----------------------------------------------------------------------------
lib/Graphics/Rendering/Plot/Types.hs view
@@ -295,7 +295,9 @@ type MonotoneIncreasing = Bool -data Abscissae = AbsFunction +type AbsFunctionModifier = (Double -> Double) ++data Abscissae = AbsFunction AbsFunctionModifier | AbsPoints MonotoneIncreasing Series data Ordinates = OrdFunction AxisSide Function (Maybe SeriesLabel)@@ -410,6 +412,10 @@ ----------------------------------------------------------------------------- +data BarSetting = BarNone | BarSpread | BarStack ++-----------------------------------------------------------------------------+ -- | a plot data PlotData = Plot { _border :: Border@@ -417,6 +423,7 @@ , _heading :: TextEntry , _ranges :: Ranges , _axes :: [AxisData]+ , _barconfig :: BarSetting , _data :: DataSeries , _legend :: Maybe LegendData , _annote :: Annotations
plot.cabal view
@@ -1,5 +1,5 @@ Name: plot-Version: 0.1.8+Version: 0.2 License: BSD3 License-file: LICENSE Copyright: (c) A.V.H. McPhail 2010, 2012@@ -35,7 +35,7 @@ . Category: Graphics -Tested-with: GHC==7.0.1+Tested-with: GHC==7.6.3 Cabal-version: >= 1.8 Build-type: Simple