diff --git a/CHANGES b/CHANGES --- a/CHANGES +++ b/CHANGES @@ -101,3 +101,6 @@ 0.1.8: * added `TickFormat` data type + +0.2: + * added `BarSpread` diff --git a/lib/Graphics/Rendering/Plot/Defaults.hs b/lib/Graphics/Rendering/Plot/Defaults.hs --- a/lib/Graphics/Rendering/Plot/Defaults.hs +++ b/lib/Graphics/Rendering/Plot/Defaults.hs @@ -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 [] ----------------------------------------------------------------------------- diff --git a/lib/Graphics/Rendering/Plot/Figure.hs b/lib/Graphics/Rendering/Plot/Figure.hs --- a/lib/Graphics/Rendering/Plot/Figure.hs +++ b/lib/Graphics/Rendering/Plot/Figure.hs @@ -88,6 +88,9 @@ , clearAxis , addAxis , withAxis + -- * BarSetting + , BarSetting(..) + , barSetting -- * Legend , Legend , LegendBorder diff --git a/lib/Graphics/Rendering/Plot/Figure/Plot.hs b/lib/Graphics/Rendering/Plot/Figure/Plot.hs --- a/lib/Graphics/Rendering/Plot/Figure/Plot.hs +++ b/lib/Graphics/Rendering/Plot/Figure/Plot.hs @@ -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 diff --git a/lib/Graphics/Rendering/Plot/Render/Plot.hs b/lib/Graphics/Rendering/Plot/Render/Plot.hs --- a/lib/Graphics/Rendering/Plot/Render/Plot.hs +++ b/lib/Graphics/Rendering/Plot/Render/Plot.hs @@ -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 diff --git a/lib/Graphics/Rendering/Plot/Render/Plot/Data.hs b/lib/Graphics/Rendering/Plot/Render/Plot/Data.hs --- a/lib/Graphics/Rendering/Plot/Render/Plot/Data.hs +++ b/lib/Graphics/Rendering/Plot/Render/Plot/Data.hs @@ -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 gmail 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 () ----------------------------------------------------------------------------- diff --git a/lib/Graphics/Rendering/Plot/Types.hs b/lib/Graphics/Rendering/Plot/Types.hs --- a/lib/Graphics/Rendering/Plot/Types.hs +++ b/lib/Graphics/Rendering/Plot/Types.hs @@ -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 diff --git a/plot.cabal b/plot.cabal --- a/plot.cabal +++ b/plot.cabal @@ -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