plot 0.1 → 0.1.1
raw patch · 6 files changed
+340/−33 lines, 6 files
Files
- lib/Graphics/Rendering/Plot/Figure.hs +1/−0
- lib/Graphics/Rendering/Plot/Figure/Plot.hs +6/−5
- lib/Graphics/Rendering/Plot/Figure/Plot/Data.hs +186/−4
- lib/Graphics/Rendering/Plot/Render/Plot/Data.hs +124/−21
- lib/Graphics/Rendering/Plot/Types.hs +19/−1
- plot.cabal +4/−2
lib/Graphics/Rendering/Plot/Figure.hs view
@@ -57,6 +57,7 @@ , area , bar , hist+ , candle, whisker , setDataset -- ** Plot type , setSeriesType
lib/Graphics/Rendering/Plot/Figure/Plot.hs view
@@ -29,6 +29,7 @@ , D.area , D.bar , D.hist+ , D.candle, D.whisker , setDataset -- ** Plot type , setSeriesType@@ -68,7 +69,7 @@ import Data.Eq.Unicode import Data.Bool.Unicode-import Data.Ord.Unicode+--import Data.Ord.Unicode --import Data.Packed.Vector --import Data.Packed.Matrix@@ -109,16 +110,16 @@ -- | set the axis range setRange :: AxisType -> AxisSide -> Scale → Double -> Double -> Plot ()-setRange XAxis sd sc min max = modify $ \s -> s { _ranges = setXRanges' sd (_ranges s) }- where setXRanges' sd r+setRange XAxis sd sc min max = modify $ \s -> s { _ranges = setXRanges' (_ranges s) }+ where setXRanges' r | sc ≡ Log ∧ min <= 0 = error "non-positive logarithmic range" | otherwise = setXRanges sd r setXRanges Lower (Ranges (Left _) yr) = Ranges (Left (Range sc min max)) yr setXRanges Lower (Ranges (Right (_,xr)) yr) = Ranges (Right ((Range sc min max,xr))) yr setXRanges Upper (Ranges (Left xr) yr) = Ranges (Right (xr,Range sc min max)) yr setXRanges Upper (Ranges (Right (_,xr)) yr) = Ranges (Right (Range sc min max,xr)) yr-setRange YAxis sd sc min max = modify $ \s -> s { _ranges = setYRanges' sd (_ranges s) }- where setYRanges' sd r+setRange YAxis sd sc min max = modify $ \s -> s { _ranges = setYRanges' (_ranges s) }+ where setYRanges' r | sc ≡ Log ∧ min <= 0 = error "non-positive logarithmic range" | otherwise = setYRanges sd r setYRanges Lower (Ranges xr (Left _)) = Ranges xr (Left (Range sc min max))
lib/Graphics/Rendering/Plot/Figure/Plot/Data.hs view
@@ -25,6 +25,7 @@ , area , bar , hist+ , candle, whisker , setDataSeries -- * Plot type , setSeriesType@@ -85,6 +86,14 @@ let c = getBarColour bt lt <- toLine c return $ DecLine lt+ setSeriesType'' Line (DecCand bt) = do+ let c = getBarColour bt+ lt <- toLine c+ return $ DecLine lt+ setSeriesType'' Line (DecWhisk bt) = do+ let c = getBarColour bt+ lt <- toLine c+ return $ DecLine lt setSeriesType'' Point (DecLine lt) = do let c = fromJust $ getLineColour lt g <- supply@@ -117,6 +126,16 @@ g <- supply pt <- toPoint (g :: Glyph,c) return $ DecPoint pt+ setSeriesType'' Point (DecCand bt) = do+ let c = getBarColour bt+ g <- supply+ pt <- toPoint (g :: Glyph,c)+ return $ DecPoint pt+ setSeriesType'' Point (DecWhisk bt) = do+ let c = getBarColour bt+ g <- supply+ pt <- toPoint (g :: Glyph,c)+ return $ DecPoint pt setSeriesType'' LinePoint (DecLine lt) = do let c = fromJust $ getLineColour lt g <- supply@@ -154,6 +173,18 @@ g <- supply pt <- toPoint (g :: Glyph,c) return $ DecLinPt lt pt+ setSeriesType'' LinePoint (DecCand bt) = do+ let c = getBarColour bt+ lt <- toLine c+ g <- supply+ pt <- toPoint (g :: Glyph,c)+ return $ DecLinPt lt pt+ setSeriesType'' LinePoint (DecWhisk bt) = do+ let c = getBarColour bt+ lt <- toLine c+ g <- supply+ pt <- toPoint (g :: Glyph,c)+ return $ DecLinPt lt pt setSeriesType'' Impulse (DecLine lt) = return $ DecImpulse lt setSeriesType'' Impulse (DecPoint pt) = do let c = getPointColour pt@@ -171,6 +202,14 @@ let c = getBarColour bt lt <- toLine c return $ DecImpulse lt+ setSeriesType'' Impulse (DecCand bt) = do+ let c = getBarColour bt+ lt <- toLine c+ return $ DecImpulse lt+ setSeriesType'' Impulse (DecWhisk bt) = do+ let c = getBarColour bt+ lt <- toLine c+ return $ DecImpulse lt setSeriesType'' Step (DecLine lt) = return $ DecStep lt setSeriesType'' Step (DecPoint pt) = do let c = getPointColour pt@@ -188,6 +227,14 @@ let c = getBarColour bt lt <- toLine c return $ DecStep lt+ setSeriesType'' Step (DecCand bt) = do+ let c = getBarColour bt+ lt <- toLine c+ return $ DecStep lt+ setSeriesType'' Step (DecWhisk bt) = do+ let c = getBarColour bt+ lt <- toLine c+ return $ DecStep lt setSeriesType'' Area (DecLine lt) = return $ DecArea lt setSeriesType'' Area (DecPoint pt) = do let c = getPointColour pt@@ -205,6 +252,14 @@ let c = getBarColour bt lt <- toLine c return $ DecArea lt+ setSeriesType'' Area (DecCand bt) = do+ let c = getBarColour bt+ lt <- toLine c+ return $ DecArea lt+ setSeriesType'' Area (DecWhisk bt) = do+ let c = getBarColour bt+ lt <- toLine c+ return $ DecArea lt setSeriesType'' Bar (DecLine lt) = do let c = fromJust $ getLineColour lt bt <- toBar c@@ -231,6 +286,8 @@ return $ DecBar bt setSeriesType'' Bar d@(DecBar _) = return d setSeriesType'' Bar (DecHist bt) = return $ DecBar bt+ setSeriesType'' Bar (DecCand bt) = return $ DecBar bt+ setSeriesType'' Bar (DecWhisk bt) = return $ DecBar bt setSeriesType'' Hist (DecLine lt) = do let c = fromJust $ getLineColour lt bt <- toBar c@@ -257,6 +314,64 @@ return $ DecHist bt setSeriesType'' Hist (DecBar bt) = return $ DecHist bt setSeriesType'' Hist d@(DecHist _) = return d+ setSeriesType'' Hist (DecCand bt) = return $ DecHist bt+ setSeriesType'' Hist (DecWhisk bt) = return $ DecHist bt+ setSeriesType'' Candle (DecLine lt) = do+ let c = fromJust $ getLineColour lt+ bt <- toBar c+ return $ DecCand bt+ setSeriesType'' Candle (DecPoint pt) = do+ let c = getPointColour pt+ bt <- toBar c+ return $ DecCand bt+ setSeriesType'' Candle (DecLinPt lt _) = do+ let c = fromJust $ getLineColour lt+ bt <- toBar c+ return $ DecCand bt+ setSeriesType'' Candle (DecImpulse lt) = do+ let c = fromJust $ getLineColour lt+ bt <- toBar c+ return $ DecCand bt+ setSeriesType'' Candle (DecStep lt) = do+ let c = fromJust $ getLineColour lt+ bt <- toBar c+ return $ DecCand bt+ setSeriesType'' Candle (DecArea lt) = do+ let c = fromJust $ getLineColour lt+ bt <- toBar c+ return $ DecCand bt+ setSeriesType'' Candle (DecBar bt) = return $ DecCand bt+ setSeriesType'' Candle (DecHist bt) = return $ DecCand bt+ setSeriesType'' Candle d@(DecCand _) = return d+ setSeriesType'' Candle (DecWhisk bt) = return $ DecCand bt+ setSeriesType'' Whisker (DecLine lt) = do+ let c = fromJust $ getLineColour lt+ bt <- toBar c+ return $ DecWhisk bt+ setSeriesType'' Whisker (DecPoint pt) = do+ let c = getPointColour pt+ bt <- toBar c+ return $ DecWhisk bt+ setSeriesType'' Whisker (DecLinPt lt _) = do+ let c = fromJust $ getLineColour lt+ bt <- toBar c+ return $ DecWhisk bt+ setSeriesType'' Whisker (DecImpulse lt) = do+ let c = fromJust $ getLineColour lt+ bt <- toBar c+ return $ DecWhisk bt+ setSeriesType'' Whisker (DecStep lt) = do+ let c = fromJust $ getLineColour lt+ bt <- toBar c+ return $ DecWhisk bt+ setSeriesType'' Whisker (DecArea lt) = do+ let c = fromJust $ getLineColour lt+ bt <- toBar c+ return $ DecWhisk bt+ setSeriesType'' Whisker (DecBar bt) = return $ DecWhisk bt+ setSeriesType'' Whisker (DecHist bt) = return $ DecWhisk bt+ setSeriesType'' Whisker (DecCand bt) = return $ DecWhisk bt+ setSeriesType'' Whisker d@(DecWhisk _) = return d instance SeriesTypes DecoratedSeries where setSeriesType'' t (DecSeries o d) = do@@ -319,14 +434,14 @@ return $ DecSeries o (DecArea lt') modifyFormat _ d@(DecSeries _ (DecBar _)) = return d modifyFormat _ d@(DecSeries _ (DecHist _)) = return d+ modifyFormat _ d@(DecSeries _ (DecCand _)) = return d+ modifyFormat _ d@(DecSeries _ (DecWhisk _)) = return d instance PlotFormats Point where modifyFormat _ d@(DecSeries _ (DecLine _)) = return d modifyFormat _ d@(DecSeries _ (DecImpulse _)) = return d modifyFormat _ d@(DecSeries _ (DecStep _)) = return d modifyFormat _ d@(DecSeries _ (DecArea _)) = return d- modifyFormat _ d@(DecSeries _ (DecBar _)) = return d- modifyFormat _ d@(DecSeries _ (DecHist _)) = return d modifyFormat p (DecSeries o (DecPoint pt)) = do po <- asks _pointoptions let pt' = execPoint p po pt@@ -335,6 +450,10 @@ po <- asks _pointoptions let pt' = execPoint p po pt return $ DecSeries o (DecLinPt lt pt')+ modifyFormat _ d@(DecSeries _ (DecBar _)) = return d+ modifyFormat _ d@(DecSeries _ (DecHist _)) = return d+ modifyFormat _ d@(DecSeries _ (DecCand _)) = return d+ modifyFormat _ d@(DecSeries _ (DecWhisk _)) = return d instance PlotFormats Bar where modifyFormat _ d@(DecSeries _ (DecLine _)) = return d@@ -351,6 +470,14 @@ bo <- asks _baroptions let bt' = execBar b bo bt return $ DecSeries o (DecHist bt')+ modifyFormat b (DecSeries o (DecCand bt)) = do + bo <- asks _baroptions+ let bt' = execBar b bo bt+ return $ DecSeries o (DecCand bt')+ modifyFormat b (DecSeries o (DecWhisk bt)) = do + bo <- asks _baroptions+ let bt' = execBar b bo bt+ return $ DecSeries o (DecWhisk bt') -- | format the plot elements of a given series withSeriesFormat :: PlotFormats m => Int -> m () -> Data ()@@ -403,12 +530,12 @@ instance Ordinate Series where toOrdinate s = OrdPoints Lower (Plain s) Nothing instance Ordinate (Series,ErrorSeries) where toOrdinate (s,e) = OrdPoints Lower (Error s (e,e)) Nothing instance Ordinate (Series,(ErrorSeries,ErrorSeries)) where toOrdinate (s,(l,u)) = OrdPoints Lower (Error s (l,u)) Nothing-+instance Ordinate (MinMaxSeries,(ErrorSeries,ErrorSeries)) where toOrdinate (s,(l,u)) = OrdPoints Lower (MinMax s (Just (l,u))) Nothing instance Ordinate (Function,AxisSide) where toOrdinate (f,ax) = OrdFunction ax f Nothing instance Ordinate (Series,AxisSide) where toOrdinate (s,ax) = OrdPoints ax (Plain s) Nothing instance Ordinate (Series,ErrorSeries,AxisSide) where toOrdinate (s,e,ax) = OrdPoints ax (Error s (e,e)) Nothing instance Ordinate (Series,(ErrorSeries,ErrorSeries),AxisSide) where toOrdinate (s,(l,u),ax) = OrdPoints ax (Error s (l,u)) Nothing-+instance Ordinate (MinMaxSeries,(ErrorSeries,ErrorSeries),AxisSide) where toOrdinate (s,(l,u),ax) = OrdPoints ax (MinMax s (Just (l,u))) Nothing instance Ordinate (Function,SeriesLabel) where toOrdinate (f,la) = OrdFunction Lower f (Just la) instance Ordinate (Series,SeriesLabel) where toOrdinate (s,la) = OrdPoints Lower (Plain s) (Just la) instance Ordinate (Series,ErrorSeries,SeriesLabel) where toOrdinate (s,e,la) = OrdPoints Lower (Error s (e,e)) (Just la)@@ -418,6 +545,7 @@ instance Ordinate (Series,AxisSide,SeriesLabel) where toOrdinate (s,ax,la) = OrdPoints ax (Plain s) (Just la) instance Ordinate (Series,ErrorSeries,AxisSide,SeriesLabel) where toOrdinate (s,e,ax,la) = OrdPoints ax (Error s (e,e)) (Just la) instance Ordinate (Series,(ErrorSeries,ErrorSeries),AxisSide,SeriesLabel) where toOrdinate (s,(l,u),ax,la) = OrdPoints ax (Error s (l,u)) (Just la)+instance Ordinate (MinMaxSeries,(ErrorSeries,ErrorSeries),AxisSide,SeriesLabel) where toOrdinate (s,(l,u),ax,la) = OrdPoints ax (MinMax s (Just (l,u))) (Just la) class Decorations a where toDecoration :: a -> Decoration@@ -476,6 +604,16 @@ f' <- toBar f setSeriesType'' Hist (format o f') +candle :: (Ordinate a, BarFormat b) => a -> b -> FormattedSeries+candle o f = do+ f' <- toBar f+ setSeriesType'' Candle (format o f')++whisker :: (Ordinate a, BarFormat b) => a -> b -> FormattedSeries+whisker o f = do+ f' <- toBar f+ setSeriesType'' Whisker (format o f')+ ----------------------------------------------------------------------------- getType :: SeriesType -> Data Decoration@@ -513,6 +651,14 @@ c <- supply bt <- toBar (c :: Color) setSeriesType'' Hist $ toDecoration bt+getType Candle = do+ c <- supply+ bt <- toBar (c :: Color)+ setSeriesType'' Candle $ toDecoration bt+getType Whisker = do+ c <- supply+ bt <- toBar (c :: Color)+ setSeriesType'' Whisker $ toDecoration bt getNTypes :: Int -> SeriesType -> Data [Decoration] getNTypes n st = mapM getType (replicate n st)@@ -575,6 +721,18 @@ bs <- mapM toBar (cs :: [Color]) ds <- mapM (setSeriesType'' Hist) $ toDecorations bs return $ DS_Y $ A.listArray (1,ln) $ zipWith format os ds+ toDataSeries (Candle,os) = do+ let ln = length os+ cs <- supplyN ln+ bs <- mapM toBar (cs :: [Color])+ ds <- mapM (setSeriesType'' Candle) $ toDecorations bs+ return $ DS_Y $ A.listArray (1,ln) $ zipWith format os ds+ toDataSeries (Whisker,os) = do+ let ln = length os+ cs <- supplyN ln+ bs <- mapM toBar (cs :: [Color])+ ds <- mapM (setSeriesType'' Whisker) $ toDecorations bs+ return $ DS_Y $ A.listArray (1,ln) $ zipWith format os ds instance (Abscissa a, Ordinate b) => Dataset (SeriesType,a,[b]) where toDataSeries (Line,t,os) = do@@ -633,6 +791,20 @@ ds <- mapM (setSeriesType'' Hist) $ toDecorations bs return $ DS_1toN (toAbscissa t) $ A.listArray (1,ln) $ zipWith format os ds+ toDataSeries (Candle,t,os) = do+ let ln = length os+ cs <- supplyN ln+ bs <- mapM toBar (cs :: [Color])+ ds <- mapM (setSeriesType'' Candle) $ toDecorations bs+ return $ DS_1toN (toAbscissa t) $ A.listArray (1,ln) + $ zipWith format os ds+ toDataSeries (Whisker,t,os) = do+ let ln = length os+ cs <- supplyN ln+ bs <- mapM toBar (cs :: [Color])+ ds <- mapM (setSeriesType'' Whisker) $ toDecorations bs+ return $ DS_1toN (toAbscissa t) $ A.listArray (1,ln) + $ zipWith format os ds instance (Abscissa a, Ordinate b) => Dataset [(SeriesType,a,b)] where toDataSeries prs = do@@ -682,6 +854,16 @@ c <- supply b <- toBar (c :: Color) d <- setSeriesType'' Hist $ toDecoration b+ return $ format o d+toDataSeries' (Candle,o) = do+ c <- supply + b <- toBar (c :: Color)+ d <- setSeriesType'' Candle $ toDecoration b+ return $ format o d+toDataSeries' (Whisker,o) = do+ c <- supply + b <- toBar (c :: Color)+ d <- setSeriesType'' Whisker $ toDecoration b return $ format o d instance Dataset [FormattedSeries] where
lib/Graphics/Rendering/Plot/Render/Plot/Data.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE UnicodeSyntax #-}+{-# LANGUAGE FlexibleInstances #-} ----------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.Plot.Render.Plot.Data@@ -21,19 +22,20 @@ ----------------------------------------------------------------------------- import Data.List(partition)-import Data.List.Unicode+import Prelude.Unicode +import Foreign.Storable +import Foreign.Ptr+ --import Data.Packed.Vector --import Data.Packed.Matrix --import Data.Packed() import Numeric.LinearAlgebra import qualified Data.Array.IArray as A-import qualified Data.Array.MArray as M+--import qualified Data.Array.MArray as M import qualified Data.Array.Base as B -import Data.Eq.Unicode- import Data.Word import qualified Graphics.Rendering.Cairo as C@@ -165,72 +167,99 @@ (OrdFunction _ f _) -> do (BoundingBox _ _ w _) <- get let t = linspace (round w) (xmin,xmax)- return $ [(t,mapVector f t)]+ return $ Left [(t,mapVector f t)] (OrdPoints _ (Plain o') _) -> do let t = case abs of AbsFunction -> if isHist d then fromList [0.0..(fromIntegral $ dim o')] else fromList [1.0..(fromIntegral $ dim o')] AbsPoints t' -> t'- return $ [(t,o')]+ return $ Left [(t,o')] (OrdPoints _ (Error o' (l,h)) _) -> do let t = case abs of AbsFunction -> if isHist d then fromList [0.0..(fromIntegral $ dim o')] else fromList [1.0..(fromIntegral $ dim o')] AbsPoints t' -> t'- return $ [(t,o'),(t,o'-l),(t,o'+h)]- let dat = map (\(a,b) → (if xsc ≡ Log then (logBase 10 a) else a- ,if ysc == Log then (logBase 10 b) else b)) dat' + return $ Left [(t,o'),(t,o'-l),(t,o'+h)]+ (OrdPoints _ (MinMax o' (Just (l,h))) _) -> do+ let t = case abs of+ AbsFunction -> fromList [1.0..(fromIntegral $ dim l)]+ AbsPoints t' -> t'+ return $ Right [((t,o'),(t,(l,h)))]+ let dat = case dat' of+ Left dat'' → map (\(a,b) → Left (if xsc ≡ Log then (logBase 10 a) else a+ ,if ysc == Log then (logBase 10 b) else b)) dat''+ Right dat''' → map (\((a,(bl,bu)),(c,(dl,du))) → let (a',c') = if xsc ≡ Log then (logBase 10 a,logBase 10 c) else (a,c)+ (bl',bu',dl',du') = if ysc ≡ Log then (logBase 10 bl,logBase 10 bu,logBase 10 dl,logBase 10 du) else (bl,bu,dl,du) + in Right ((a',(bl',bu')),(c',(dl',du')))) dat''' case d of (DecLine lt) -> do formatLineSeries lt xscale yscale mapM_ (\(t',y') -> renderSamples xmin xmax Nothing - renderLineSample endLineSample t' y') dat+ renderLineSample endLineSample t' y') (map (either id (error "MinMax data")) dat) (DecPoint pt) -> do (pz,g) <- formatPointSeries pt xscale yscale let gs = g : Bot : Top : [] mapM_ (\(g',(t',y')) -> renderSamples xmin xmax Nothing - (renderPointSample xscale yscale pz g') endPointSample t' y') (zip gs dat)+ (renderPointSample xscale yscale pz g') endPointSample t' y') + (zip gs (map (either id (error "MinMax data")) dat)) (DecLinPt lt pt) -> do formatLineSeries lt xscale yscale mapM_ (\(t',y') -> renderSamples xmin xmax Nothing - renderLineSample endLineSample t' y') dat+ renderLineSample endLineSample t' y') (map (either id (error "MinMax data")) dat) (pz,g) <- formatPointSeries pt xscale yscale let gs = g : Bot : Top : [] mapM_ (\(g',(t',y')) -> renderSamples xmin xmax Nothing - (renderPointSample xscale yscale pz g') endPointSample t' y') (zip gs dat)+ (renderPointSample xscale yscale pz g') endPointSample t' y')+ (zip gs (map (either id (error "MinMax data")) dat)) (DecImpulse lt) -> do formatLineSeries lt xscale yscale mapM_ (\(t',y') -> renderSamples xmin xmax Nothing - renderImpulseSample endImpulseSample t' y') dat+ renderImpulseSample endImpulseSample t' y') (map (either id (error "MinMax data")) dat) (DecStep lt) -> do formatLineSeries lt xscale yscale mapM_ (\(t',y') -> renderSamples xmin xmax Nothing - renderStepSample endStepSample t' y') dat+ renderStepSample endStepSample t' y') (map (either id (error "MinMax data")) dat) (DecArea lt) -> do formatLineSeries lt xscale yscale- let hd = head dat+ let Left hd = head dat ln = dim $ fst hd xmin_ix = findMinIdx (fst hd) xmin 0 (ln-1) x0 = (fst hd) @> xmin_ix y0 = (snd hd) @> xmin_ix mapM_ (\(t',y') -> renderSamples xmin xmax Nothing - renderAreaSample (endAreaSample x0 y0) t' y') dat+ renderAreaSample (endAreaSample x0 y0) t' y') (map (either id (error "MinMax data")) dat) (DecBar bt) -> do (bw,bc,c) <- formatBarSeries bt xscale yscale mapM_ (\(t',y') -> renderSamples xmin xmax Nothing - (renderBarSample bw bc c) endBarSample t' y') dat+ (renderBarSample bw bc c) endBarSample t' y') (map (either id (error "MinMax data")) dat) (DecHist bt) -> do (bw,bc,c) <- formatBarSeries bt xscale yscale- let hd = head dat+ let Left hd = head dat ln = dim $ fst hd xmin_ix = findMinIdx (fst hd) xmin 0 (ln-1) rest v = subVector 1 (dim v - 1) v x0 = (fst hd) @> xmin_ix y0 = 0 mapM_ (\(t',y') -> renderSamples xmin xmax (Just $ C.moveTo x0 y0) - (renderHistSample bw bc c) endHistSample (rest t') y') dat+ (renderHistSample bw bc c) endHistSample (rest t') y') (map (either id (error "MinMax data")) dat)+ (DecCand bt) → do+ (bw,bc,c) ← formatBarSeries bt xscale yscale+ mapM_ (\((t',y'),(_,e')) → do+ renderMinMaxSamples xmin xmax Nothing+ (renderWhiskerSample bw bc c False) endWhiskerSample t' e'+ renderMinMaxSamples xmin xmax Nothing+ (renderCandleSample bw bc c) endCandleSample t' y'+ ) (map (either (error "Single data") id) dat)+ (DecWhisk bt) → do+ (bw,bc,c) ← formatBarSeries bt xscale yscale+ mapM_ (\((t',y'),(_,e')) → do+ renderMinMaxSamples xmin xmax Nothing+ (renderWhiskerSample bw bc c True) endWhiskerSample t' e'+ renderMinMaxSamples xmin xmax Nothing+ (renderCandleSample bw bc c) endCandleSample t' y'+ ) (map (either (error "Single data") id) dat) return () -----------------------------------------------------------------------------@@ -301,6 +330,35 @@ ----------------------------------------------------------------------------- +renderMinMaxSamples :: Double -> Double + -> Maybe (C.Render ())+ -> (Double -> (Double,Double) -> C.Render ()) -> C.Render ()+ -> Vector Double -> (Vector Double,Vector Double) -> Render ()+renderMinMaxSamples xmin xmax s f e t y = do+ (BoundingBox _ _ w _) <- get+ let ln = dim t+ m = isMonotoneIncreasing t+ (xmin_ix,xmax_ix,num_pts) = if m+ then (findMinIdx t xmin 0 (ln-1)+ ,findMaxIdx t xmax (ln-1) 0+ ,xmax_ix - xmin_ix + 1)+ else (0,ln-1,1)+ diff'' = (fromIntegral num_pts)/w+ diff' = round $ if diff'' <= 1 then 1 else diff''+ diff = if m then diff' else 1+ cairo $ do+ case s of+ Nothing -> C.moveTo (t @> xmin_ix) ((fst $ y) @> xmin_ix)+ Just s' -> s'+ _ <- runMaybeT $ mapVectorWithIndexM_ (\i t -> do+ when (i >= xmin_ix && i `mod` diff == 0)+ (do+ renderMinMaxSample i xmax_ix t f e y)+ return ()) t+ return ()++-----------------------------------------------------------------------------+ renderSample :: Int -> Int -> Vector Double -> (Double -> Double -> C.Render ()) -> C.Render () -> Double -> MaybeT C.Render ()@@ -313,6 +371,18 @@ | otherwise = do lift $ f (t @> ix) y +renderMinMaxSample :: Int -> Int -> Double + -> (Double -> (Double,Double) -> C.Render ()) -> C.Render () + -> (Vector Double,Vector Double) -> MaybeT C.Render ()+renderMinMaxSample ix xmax_ix t f e (yl,yu)+ | ix >= xmax_ix = do+ lift $ do+ f t (yl @> ix,yu @> ix)+ e+ fail "end of bounded area"+ | otherwise = do+ lift $ f t (yl @> ix,yu @> ix)+ ----------------------------------------------------------------------------- renderLineSample :: Double -> Double -> C.Render ()@@ -373,7 +443,7 @@ endBarSample = return () renderHistSample :: Width -> Color -> Color -> Double -> Double -> C.Render ()-renderHistSample bw c bc x y = do+renderHistSample _ c bc x y = do (x',_) <- C.getCurrentPoint C.stroke setColour bc@@ -385,6 +455,39 @@ endHistSample :: C.Render () endHistSample = return ()++renderCandleSample :: Width -> Color -> Color -> Double -> (Double,Double) -> C.Render ()+renderCandleSample bw c bc x (yl,yu) = do+ setColour bc+ C.rectangle (x-bw/2) yl bw (yu-yl)+ C.strokePreserve+ liftIO $ putStrLn $ (show yl) ++ " " ++ (show yu)+ if (yl < yu)+ then do+ setColour c+ else do+ C.setSourceRGBA 1 1 1 1+ C.fill++endCandleSample :: C.Render ()+endCandleSample = return ()++renderWhiskerSample :: Width -> Color -> Color → Bool -> Double -> (Double,Double) -> C.Render ()+renderWhiskerSample bw _ bc whiskers x (yl,yu) = do+ setColour bc+ C.moveTo x yl+ C.lineTo x yu+ if whiskers+ then do+ C.moveTo (x-bw÷2) yu+ C.lineTo (x+bw÷2) yu+ C.moveTo (x-bw÷2) yl+ C.lineTo (x+bw÷2) yl+ else return ()+ C.stroke++endWhiskerSample :: C.Render ()+endWhiskerSample = return () -----------------------------------------------------------------------------
lib/Graphics/Rendering/Plot/Types.hs view
@@ -240,13 +240,15 @@ ----------------------------------------------------------------------------- -data SeriesType = Line | Point | LinePoint | Impulse | Step | Area | Bar | Hist+data SeriesType = Line | Point | LinePoint | Impulse | Step | Area + | Bar | Hist | Candle | Whisker ----------------------------------------------------------------------------- type Series = Vector Double type Surface = Matrix Double type ErrorSeries = Series+type MinMaxSeries = (Series,Series) type Function = (Double -> Double) type SeriesLabel = String@@ -255,11 +257,17 @@ data OrdSeries = Plain Series | Error Series (ErrorSeries,ErrorSeries)+ | MinMax MinMaxSeries (Maybe (ErrorSeries,ErrorSeries)) getOrdData :: OrdSeries -> Series getOrdData (Plain o) = o getOrdData (Error o _) = o+getOrdData (MinMax (o,_) _) = o +getMinMaxData ∷ OrdSeries → Either MinMaxSeries (MinMaxSeries,(ErrorSeries,ErrorSeries))+getMinMaxData (MinMax o Nothing) = Left o+getMinMaxData (MinMax o (Just e)) = Right (o,e)+ data Abscissae = AbsFunction | AbsPoints Series @@ -286,6 +294,8 @@ | DecArea LineType | DecBar BarType | DecHist BarType+ | DecCand BarType+ | DecWhisk BarType isHist :: Decoration -> Bool isHist (DecLine _) = False@@ -296,6 +306,8 @@ isHist (DecArea _) = False isHist (DecBar _) = False isHist (DecHist _) = True+isHist (DecCand _) = False+isHist (DecWhisk _) = False decorationGetLineType :: Decoration -> Maybe LineType decorationGetLineType (DecLine lt) = Just lt@@ -306,6 +318,8 @@ decorationGetLineType (DecArea lt) = Just lt decorationGetLineType (DecBar _) = Nothing decorationGetLineType (DecHist _) = Nothing+decorationGetLineType (DecCand _) = Nothing+decorationGetLineType (DecWhisk _) = Nothing decorationGetPointType :: Decoration -> Maybe PointType decorationGetPointType (DecLine _) = Nothing@@ -316,6 +330,8 @@ decorationGetPointType (DecArea _) = Nothing decorationGetPointType (DecBar _) = Nothing decorationGetPointType (DecHist _) = Nothing+decorationGetPointType (DecCand _) = Nothing+decorationGetPointType (DecWhisk _) = Nothing decorationGetBarType :: Decoration -> Maybe BarType decorationGetBarType (DecLine _) = Nothing@@ -326,6 +342,8 @@ decorationGetBarType (DecArea _) = Nothing decorationGetBarType (DecBar bt) = Just bt decorationGetBarType (DecHist bt) = Just bt+decorationGetBarType (DecCand bt) = Just bt+decorationGetBarType (DecWhisk bt) = Just bt data DecoratedSeries = DecSeries Ordinates Decoration -- BarSeries Abscissae Ordinates BarType
plot.cabal view
@@ -1,5 +1,5 @@ Name: plot-Version: 0.1+Version: 0.1.1 License: BSD3 License-file: LICENSE Copyright: (c) A.V.H. McPhail 2010@@ -31,7 +31,9 @@ . The example in Graphics.Rendering.Plot can be viewed at <http://code.haskell.org/plot/examples/perturbed-sine.png>-+ .+ Changes in plot 0.1.1+ * added candle and whisker plots Category: Graphics Tested-with: GHC==6.12.1