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 @@ -57,6 +57,7 @@ , area , bar , hist + , candle, whisker , setDataset -- ** Plot type , setSeriesType 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 @@ -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)) diff --git a/lib/Graphics/Rendering/Plot/Figure/Plot/Data.hs b/lib/Graphics/Rendering/Plot/Figure/Plot/Data.hs --- a/lib/Graphics/Rendering/Plot/Figure/Plot/Data.hs +++ b/lib/Graphics/Rendering/Plot/Figure/Plot/Data.hs @@ -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 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 @@ -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 () ----------------------------------------------------------------------------- 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 @@ -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 diff --git a/plot.cabal b/plot.cabal --- a/plot.cabal +++ b/plot.cabal @@ -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 - + . + Changes in plot 0.1.1 + * added candle and whisker plots Category: Graphics Tested-with: GHC==6.12.1