plot 0.1.1.4 → 0.1.2
raw patch · 14 files changed
+514/−149 lines, 14 files
Files
- CHANGES +3/−0
- lib/Graphics/Rendering/Plot/Figure.hs +9/−0
- lib/Graphics/Rendering/Plot/Figure/Plot.hs +17/−2
- lib/Graphics/Rendering/Plot/Figure/Plot/Annotation.hs +105/−0
- lib/Graphics/Rendering/Plot/Figure/Plot/Data.hs +15/−2
- lib/Graphics/Rendering/Plot/Render/Plot.hs +1/−4
- lib/Graphics/Rendering/Plot/Render/Plot/Annotation.hs +136/−0
- lib/Graphics/Rendering/Plot/Render/Plot/Axis.hs +71/−42
- lib/Graphics/Rendering/Plot/Render/Plot/Data.hs +35/−89
- lib/Graphics/Rendering/Plot/Render/Plot/Format.hs +71/−0
- lib/Graphics/Rendering/Plot/Render/Plot/Glyph.hs +1/−1
- lib/Graphics/Rendering/Plot/Render/Types.hs +10/−0
- lib/Graphics/Rendering/Plot/Types.hs +32/−7
- plot.cabal +8/−2
CHANGES view
@@ -15,3 +15,6 @@ 0.1.1.4: * remove Unicode dependency++0.1.2:+ * improve axis line joins
lib/Graphics/Rendering/Plot/Figure.hs view
@@ -59,6 +59,15 @@ , hist , candle, whisker , setDataset+ -- * Annotations+ , Location, Head, Fill+ , arrow+ , oval+ , rect+ , glyph+ , text+ , cairo+ , withAnnotations -- ** Plot type , setSeriesType , setAllSeriesTypes
lib/Graphics/Rendering/Plot/Figure/Plot.hs view
@@ -30,6 +30,15 @@ , D.hist , D.candle, D.whisker , setDataset+ -- * Annotations+ , Location, Head, Fill+ , AN.arrow+ , AN.oval+ , AN.rect+ , AN.glyph+ , AN.text+ , AN.cairo+ , withAnnotations -- ** Plot type , setSeriesType , setAllSeriesTypes@@ -88,6 +97,7 @@ import qualified Graphics.Rendering.Plot.Figure.Plot.Data as D import qualified Graphics.Rendering.Plot.Figure.Plot.Axis as AX import qualified Graphics.Rendering.Plot.Figure.Plot.Legend as L+import qualified Graphics.Rendering.Plot.Figure.Plot.Annotation as AN ----------------------------------------------------------------------------- @@ -137,6 +147,11 @@ ----------------------------------------------------------------------------- +withAnnotations :: Annote () -> Plot ()+withAnnotations = annoteInPlot++-----------------------------------------------------------------------------+ -- | clear the axes of a subplot clearAxes :: Plot () clearAxes = modify $ \s -> s { _axes = [] }@@ -222,7 +237,7 @@ findMinMax :: Abscissae -> Ordinates -> (Double,Double) 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+findMinMax (AbsPoints _ x) (OrdFunction _ f _) = let v = mapVector f x in (minElement v,maxElement v) -- what if errors go beyond plot? findMinMax _ (OrdPoints _ y _) = let o = getOrdData y@@ -230,7 +245,7 @@ abscMinMax :: Abscissae -> (Double,Double) abscMinMax AbsFunction = defaultXAxisSideLowerRange-abscMinMax (AbsPoints x) = (minElement x,maxElement x)+abscMinMax (AbsPoints _ x) = (minElement x,maxElement x) ordDim :: Ordinates -> Int
+ lib/Graphics/Rendering/Plot/Figure/Plot/Annotation.hs view
@@ -0,0 +1,105 @@+-----------------------------------------------------------------------------+-- |+-- Module : Graphics.Rendering.Plot.Figure.Plot.Annotation+-- Copyright : (c) A. V. H. McPhail 2010+-- License : BSD3+--+-- Maintainer : haskell.vivian.mcphail <at> gmail <dot> com+-- Stability : provisional+-- Portability : portable+--+-- 'Annotation' operations+--+-----------------------------------------------------------------------------++module Graphics.Rendering.Plot.Figure.Plot.Annotation (+ clearAnnotations+ , arrow+ , oval+ , rect+ , glyph+ , text+ , cairo+ ) where++-----------------------------------------------------------------------------++--import Data.Packed.Vector++import Control.Monad.State+import Control.Monad.Reader++import qualified Graphics.Rendering.Cairo as C++import Graphics.Rendering.Plot.Types+import Graphics.Rendering.Plot.Defaults++-----------------------------------------------------------------------------++lineInAnnote :: Line () -> Annote LineType+lineInAnnote m = do+ lo <- asks _lineoptions+ let l = execLine m lo defaultLineType+ return l++pointInAnnote :: Point () -> Annote PointType+pointInAnnote m = do+ po <- asks _pointoptions+ let p = execPoint m po defaultPointType+ return p++barInAnnote :: Bar () -> Annote BarType+barInAnnote m = do+ bo <- asks _baroptions+ let b = execBar m bo defaultBarType+ return b++textInAnnote :: Text () -> Annote TextEntry+textInAnnote m = do+ to <- asks _textoptions+ let t = execText m to NoText+ return t++-----------------------------------------------------------------------------++-- | clear annotations+clearAnnotations :: Annote ()+clearAnnotations = put []++-- | add an arrow+arrow :: Head -> Location -> Location -> Line () -> Annote ()+arrow h vs vf m = do+ l <- lineInAnnote m+ modify $ \s -> (AnnArrow h l vs vf) : s++-- | add an oval+oval :: Fill -> Location -> Location -> Bar () -> Annote ()+oval p c e m = do+ b <- barInAnnote m+ modify $ \s -> (AnnOval p b c e) : s++-- | add a rectangle+rect :: Fill -> Location -> Location -> Bar () -> Annote ()+rect p rs rf m = do+ b <- barInAnnote m+ modify $ \s -> (AnnRect p b rs rf) : s++-- | add a rectangle+glyph :: Location -> Point () -> Annote ()+glyph l m = do+ p <- pointInAnnote m+ modify $ \s -> (AnnGlyph p l) : s++-- | add text+text :: Location -> Text () -> Annote ()+text l m = do+ t <- textInAnnote m+ modify $ \s -> (AnnText t l) : s++-- | add a cairo render that takes the bounding box (in user coordinates)+-- as an argument+cairo :: (Double -> Double -> Double -> Double -> C.Render ()) -> Annote ()+cairo r = modify $ \s -> (AnnCairo r) : s++-----------------------------------------------------------------------------+
lib/Graphics/Rendering/Plot/Figure/Plot/Data.hs view
@@ -40,7 +40,7 @@ ----------------------------------------------------------------------------- ---import Data.Packed.Vector+import Data.Packed.Vector import Data.Maybe @@ -49,6 +49,7 @@ import Control.Monad.State import Control.Monad.Reader import Control.Monad.Supply+import Control.Monad.Maybe import Graphics.Rendering.Plot.Types import Graphics.Rendering.Plot.Figure.Line@@ -518,7 +519,7 @@ toAbscissae :: Abscissa a => [a] -> [Abscissae] toAbscissae = map toAbscissa -instance Abscissa Series where toAbscissa s = AbsPoints s+instance Abscissa Series where toAbscissa s = AbsPoints (isMonotoneIncreasing s) s class Ordinate a where toOrdinate :: a -> Ordinates@@ -891,6 +892,18 @@ setDataSeries d = do ds <- toDataSeries d put ds++-----------------------------------------------------------------------------++monoStep :: Double -> MaybeT (State Double) ()+monoStep d = do+ dp <- get+ when (d < dp) (fail "negative difference")+ put d+{-# INLINE monoStep #-}++isMonotoneIncreasing :: Vector Double -> Bool+isMonotoneIncreasing v = maybe False (\_ -> True) $ evalState (runMaybeT $ (mapVectorM_ monoStep (subVector 1 (dim v -1) v))) (v @> 0) -----------------------------------------------------------------------------
lib/Graphics/Rendering/Plot/Render/Plot.hs view
@@ -51,6 +51,7 @@ import Graphics.Rendering.Plot.Render.Plot.Axis import Graphics.Rendering.Plot.Render.Plot.Data import Graphics.Rendering.Plot.Render.Plot.Legend+import Graphics.Rendering.Plot.Render.Plot.Annotation --import qualified Text.Printf as Printf @@ -122,8 +123,4 @@ ----------------------------------------------------------------------------- -renderAnnotations :: Ranges -> [Annotation] -> Render ()-renderAnnotations _ _ = return ()-------------------------------------------------------------------------------
+ lib/Graphics/Rendering/Plot/Render/Plot/Annotation.hs view
@@ -0,0 +1,136 @@+-----------------------------------------------------------------------------+-- |+-- Module : Graphics.Rendering.Plot.Render.Plot.Annotation+-- Copyright : (c) A. V. H. McPhail 2010+-- License : BSD3+--+-- Maintainer : haskell.vivian.mcphail <at> gmail <dot> com+-- Stability : provisional+-- Portability : portable+--+-- Rendering 'Figure's+--+-----------------------------------------------------------------------------++module Graphics.Rendering.Plot.Render.Plot.Annotation (+ -- * Rendering+ renderAnnotations+ ) where++-----------------------------------------------------------------------------++import qualified Graphics.Rendering.Cairo as C++import Control.Monad.Reader+import Control.Monad.State++import Graphics.Rendering.Plot.Types+import Graphics.Rendering.Plot.Defaults++import Graphics.Rendering.Plot.Figure.Text++import Graphics.Rendering.Plot.Render.Types+import Graphics.Rendering.Plot.Render.Text+import Graphics.Rendering.Plot.Render.Plot.Glyph+import Graphics.Rendering.Plot.Render.Plot.Format++import Prelude hiding(min,max)+import qualified Prelude(max)++-----------------------------------------------------------------------------++renderAnnotations :: Ranges -> Annotations -> Render ()+renderAnnotations r an = do+ (BoundingBox x y w h) <- get+ let (xsc,xmin',xmax') = getRanges XAxis Lower r+ let (xmin,xmax) = if xsc == Log then (logBase 10 xmin',logBase 10 xmax') else (xmin',xmax')+ let xscale = w/(xmax-xmin) + cairo $ C.save+ let (yscl,yminl',ymaxl') = getRanges YAxis Lower r+ let (yminl,ymaxl) = if yscl == Log then (logBase 10 yminl',logBase 10 ymaxl') else (yminl',ymaxl')+ let yscalel = h/(ymaxl-yminl) + -- transform to data coordinates+ cairo $ do + C.translate x (y+h)+ C.scale xscale yscalel+ C.translate (-xmin) yminl+ flipVertical+ put (BoundingBox (-xmin) (yminl) (xmax-xmin) (ymaxl-yminl))+ mapM_ (renderAnnotation xscale yscalel) an+ put (BoundingBox x y w h)+ cairo $ C.restore++-----------------------------------------------------------------------------++renderAnnotation :: Double -> Double -> Annotation -> Render ()+renderAnnotation xsc ysc (AnnArrow h lt (x1,y1) (x2,y2)) = do+ formatLineSeries lt xsc ysc+ cairo $ do+ C.moveTo x1 y1+ C.lineTo x2 y2+ C.stroke+ when h (do+ C.moveTo x2 y2+ let theta = atan2 (y2-y1) (x2-x1)+ lw <- C.getLineWidth+ let ln = lw*10+ cx = x2 - ln * cos theta+ cy = y2 - ln * sin theta+ xl = cx + (ln/2) * sin (theta + pi/2)+ yl = cy + (ln/2) * cos (theta + pi/2)+ xu = cx + (ln/2) * sin (theta - pi/2)+ yu = cy + (ln/2) * cos (theta - pi/2)+ C.lineTo xl yl+ C.lineTo xu yu+ C.closePath+ C.fill+ )+ C.stroke+renderAnnotation xsc ysc (AnnOval f b (x1,y1) (x2,y2)) = do+ (_,bc,c) <- formatBarSeries b xsc ysc+ let width = x2 - x1+ height = y2 - y1+ x = x1 + width/2+ y = y1 + height/2+ cairo $ do+ C.save+ setColour c+ C.translate (x + width / 2) (y + height / 2)+ C.scale (1 / (height / 2)) (1 / (width / 2))+ C.arc 0 0 1 0 (2 * pi)+ C.restore+ C.strokePreserve+ when f (do+ setColour bc+ C.fill)+ C.newPath+renderAnnotation xsc ysc (AnnRect f b (x1,y1) (x2,y2)) = do+ (_,bc,c) <- formatBarSeries b xsc ysc+ cairo $ do+ C.save+ setColour c+ C.rectangle x1 y1 x2 y2+ C.restore+ C.strokePreserve+ when f (do+ setColour bc+ C.fill)+ C.newPath+renderAnnotation xsc ysc (AnnGlyph pt (x1,y1)) = do+ (pw,g) <- formatPointSeries pt xsc ysc+ cairo $ do+ C.moveTo x1 y1+ renderGlyph xsc ysc pw g+renderAnnotation xsc ysc (AnnText te (x1,y1)) = do+-- (x,y) <- cairo $ C.userToDevice x1 y1+ cairo $ do+ C.save+ C.scale (recip xsc) (recip (-ysc))+ _ <- renderText te TRight TTop (x1*xsc) (y1*ysc)+ cairo $ C.restore+ return ()+renderAnnotation _ _ (AnnCairo r) = do+ (BoundingBox x y w h) <- get+ cairo $ r x y w h++-----------------------------------------------------------------------------
lib/Graphics/Rendering/Plot/Render/Plot/Axis.hs view
@@ -46,6 +46,24 @@ ----------------------------------------------------------------------------- +moveTo :: Double -> Double -> C.Render ()+moveTo x y = do+ lw <- C.getLineWidth+ let (x',y') = if lw >= 1 && (round lw `mod` 2 == (0 :: Int))+ then (fromIntegral $ (round x :: Int),fromIntegral $ (round y :: Int))+ else ((((fromIntegral $ (round x :: Int))*2)+1)/2,(((fromIntegral $ (round y :: Int))*2)+1)/2)+ C.moveTo x' y'++lineTo :: Double -> Double -> C.Render ()+lineTo x y = do+ lw <- C.getLineWidth+ let (x',y') = if lw >= 1 && (round lw `mod` 2 == (0 :: Int))+ then (fromIntegral $ (round x :: Int),fromIntegral $ (round y :: Int))+ else ((((fromIntegral $ (round x :: Int))*2)+1)/2,(((fromIntegral $ (round y :: Int))*2)+1)/2)+ C.lineTo x' y'++-----------------------------------------------------------------------------+ addPadding :: Padding -> Padding -> Padding addPadding (Padding l0 r0 b0 t0) (Padding l1 r1 b1 t1) = Padding (l0+l1) (r0+r1) (b0+b1) (t0+t1) @@ -230,11 +248,8 @@ renderAxis r (Axis ax sd lt min maj tf _) = do cairo $ setLineStyle lt+ renderAxisTicks r ax sd min maj tf renderAxisLine r ax sd- cairo $ do- lw' <- C.getLineWidth- C.setLineWidth (lw'/2)- renderAxisTicks r ax sd min maj tf return () lowerRange :: Either Range (Range,Range) -> Range@@ -246,40 +261,52 @@ let (Range _ min max) = lowerRange yr (BoundingBox x y w h) <- get cairo $ do- C.moveTo x (y+h*((v-min)/(max-min))+0.5)- C.lineTo (x+w) (y+h*((v-min)/(max-min))+0.5)- C.stroke+ lw' <- C.getLineWidth+ let lw = lw'/2+ moveTo (x-lw) (y+h*((v-min)/(max-min)))+ lineTo (x+w+lw) (y+h*((v-min)/(max-min)))+ C.stroke renderAxisLine (Ranges xr _) YAxis (Value v) = do let (Range _ min max) = lowerRange xr (BoundingBox x y w h) <- get cairo $ do- C.moveTo (x+w*((v-min)/(max-min))+0.5) y- C.lineTo (x+w*((v-min)/(max-min))+0.5) (y+h)- C.stroke+ lw' <- C.getLineWidth+ let lw = lw'/2+ moveTo (x+w*((v-min)/(max-min))) (y-lw)+ lineTo (x+w*((v-min)/(max-min))) (y+h+lw)+ C.stroke renderAxisLine _ XAxis (Side Lower) = do (BoundingBox x y w h) <- get cairo $ do- C.moveTo x (y+h+0.5)- C.lineTo (x+w) (y+h+0.5)- C.stroke+ lw' <- C.getLineWidth+ let lw = lw'/2+ moveTo (x-lw) (y+h)+ lineTo (x+w+lw) (y+h)+ C.stroke renderAxisLine _ XAxis (Side Upper) = do (BoundingBox x y w _) <- get cairo $ do- C.moveTo x (y+0.5)- C.lineTo (x+w) (y+0.5)- C.stroke+ lw' <- C.getLineWidth+ let lw = lw'/2+ moveTo (x-lw) (y)+ lineTo (x+w+lw) (y)+ C.stroke renderAxisLine _ YAxis (Side Lower) = do (BoundingBox x y _ h) <- get cairo $ do- C.moveTo (x+0.5) y- C.lineTo (x+0.5) (y+h)- C.stroke+ lw' <- C.getLineWidth+ let lw = lw'/2+ moveTo (x) (y-lw)+ lineTo (x) (y+h+lw)+ C.stroke renderAxisLine _ YAxis (Side Upper) = do (BoundingBox x y w h) <- get cairo $ do- C.moveTo (x+w+0.5) (y)- C.lineTo (x+w+0.5) (y+h)- C.stroke+ lw' <- C.getLineWidth+ let lw = lw'/2+ moveTo (x+w) (y-lw)+ lineTo (x+w) (y+h+lw)+ C.stroke tickPosition :: Scale -> Double -> Double -> Int -> [(Double,Double)] tickPosition sc min max n = let pos = map (\x -> min + (max-min)*(x)/(fromIntegral (n-1))) (take n [(0 :: Double)..])@@ -364,42 +391,44 @@ (x1,y1,x2,y2) = case xa of XAxis -> case sd of (Side Lower) -> let xt x' = x + (x'-min)*w/(max-min)- in (xt p+0.5,y+h,xt p+0.5,y+h-tl)+ in (xt p,y+h,xt p,y+h-tl) (Side Upper) -> let xt x' = x + (x'-min)*w/(max-min)- in (xt p+0.5,y,xt p+0.5,y+tl)- (Value v) -> let xt x' = x + (x'-min)*w/(max-min)- in (xt p+0.5,v-tl,xt p+0.5,v+tl)+ in (xt p,y,xt p,y+tl)+ (Value v') -> let xt x' = x + (x'-min)*w/(max-min)+ in (xt p,v'-tl,xt p,v'+tl) YAxis -> case sd of (Side Lower) -> let yt y' = (y+h) - (y'-min)*h/(max-min)- in (x,yt p+0.5,x+tl,yt p+0.5)+ in (x,yt p,x+tl,yt p) (Side Upper) -> let yt y' = (y+h) - (y'-min)*h/(max-min)- in (x+w,yt p+0.5,x+w-tl,yt p+0.5)- (Value v) -> let yt y' = (y + h) - (y'-min)*h/(max-min)- in (v-tl,yt p+0.5,v+tl,yt p+0.5)- C.moveTo x1 y1- C.lineTo x2 y2+ in (x+w,yt p,x+w-tl,yt p)+ (Value v') -> let yt y' = (y + h) - (y'-min)*h/(max-min)+ in (v'-tl,yt p,v'+tl,yt p)+ moveTo x1 y1+ lineTo x2 y2 C.stroke when gl (do let (x3,y3,x4,y4) = case xa of XAxis -> case sd of (Side Lower) -> let xt x' = x + (x'-min)*w/(max-min)- in (xt p+0.5,y,xt p+0.5,y+h)+ in (xt p,y,xt p,y+h) (Side Upper) -> let xt x' = x + (x'-min)*w/(max-min)- in (xt p+0.5,y,xt p+0.5,y+h)+ in (xt p,y,xt p,y+h) (Value _) -> let xt x' = x + (x'-min)*w/(max-min)- in (xt p+0.5,y,xt p+0.5,y+h)+ in (xt p,y,xt p,y+h) YAxis -> case sd of (Side Lower) -> let yt y' = (y+h) - (y'-min)*h/(max-min)- in (x,yt p+0.5,x+w,yt p+0.5)+ in (x,yt p,x+w,yt p) (Side Upper) -> let yt y' = (y+h) - (y'-min)*h/(max-min)- in (x,yt p+0.5,x+w,yt p+0.5)+ in (x,yt p,x+w,yt p) (Value _) -> let yt y' = (y + h) - (y'-min)*h/(max-min)- in (x,yt p+0.5,x+w,yt p+0.5)+ in (x,yt p,x+w,yt p) C.save- C.setDash [2,2] 0- C.setSourceRGBA 0 0 0 0.6- C.moveTo x3 y3- C.lineTo x4 y4+ lw <- C.getLineWidth+ C.setLineWidth (lw/2)+ C.setDash [4,4] 0+ C.setSourceRGBA 0 0 0 0.5+ moveTo x3 y3+ lineTo x4 y4 C.stroke C.restore) let majlab = case sd of
lib/Graphics/Rendering/Plot/Render/Plot/Data.hs view
@@ -49,7 +49,9 @@ import Graphics.Rendering.Plot.Types import Graphics.Rendering.Plot.Render.Types+import Graphics.Rendering.Plot.Render.Plot.Format import Graphics.Rendering.Plot.Render.Plot.Glyph+import Graphics.Rendering.Plot.Render.Plot.Annotation import Prelude hiding(min,max,abs) import qualified Prelude@@ -67,12 +69,6 @@ | v @> n <= x = n | otherwise = findMaxIdx v x (n-1) min -flipVerticalMatrix :: CM.Matrix-flipVerticalMatrix = CM.Matrix 1 0 0 (-1) 0 0--flipVertical :: C.Render ()-flipVertical = C.transform flipVerticalMatrix- ----------------------------------------------------------------------------- greySurfaceFromMatrix :: C.SurfaceData Int Word8 -> Surface -> Int -> Int -> Int -> IO ()@@ -89,10 +85,10 @@ B.unsafeWrite s si e) $ zip (repeat ri) [0..((c*c')-1)]) [0..((r*r')-1)] ------------------------------------------------------------------------------+---------------------------------------------------------------------------- renderData :: Ranges -> DataSeries -> Render ()-renderData _ (DS_Surf m) = do+renderData _ (DS_Surf m) = do (BoundingBox x y w h) <- get let r = rows m c = cols m@@ -156,7 +152,8 @@ C.scale xscale yscaleu C.translate xmin yminu flipVertical- mapM_ (renderSeries xsc yscu xmin xmax xscale yscaleu) ups)+ mapM_ (renderSeries xsc yscu xmin xmax xscale yscaleu) ups+ cairo $ C.restore) -- could filter annotations as well return () @@ -168,32 +165,32 @@ (OrdFunction _ f _) -> do (BoundingBox _ _ w _) <- get let t = linspace (round w) (xmin,xmax)- return $ Left [(t,mapVector f t)]+ return $ Left [((True,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'+ then (True,fromList [0.0..(fromIntegral $ dim o')])+ else (True,fromList [1.0..(fromIntegral $ dim o')])+ AbsPoints mi t' -> (mi,t') 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'+ then (True,fromList [0.0..(fromIntegral $ dim o')])+ else (True,fromList [1.0..(fromIntegral $ dim o')])+ AbsPoints mi t' -> (mi,t') 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'+ AbsFunction -> (True,fromList [1.0..(fromIntegral $ dim l)])+ AbsPoints mi t' -> (mi,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'''+ Left dat'' → map (\((m,a),b) -> Left (if xsc == Log then (m,logBase 10 a) else (m,a)+ ,if ysc == Log then (logBase 10 b) else b)) dat''+ Right dat''' -> map (\(((m1,a),(bl,bu)),((m2,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 (((m1,a'),(bl',bu')),((m2,c'),(dl',du')))) dat''' case d of (DecLine lt) -> do formatLineSeries lt xscale yscale@@ -225,9 +222,9 @@ (DecArea lt) -> do formatLineSeries lt xscale yscale let Left hd = head dat- ln = dim $ fst hd- xmin_ix = findMinIdx (fst hd) xmin 0 (ln-1)- x0 = (fst hd) @> xmin_ix+ ln = dim $ snd $ fst hd+ xmin_ix = findMinIdx (snd $ fst hd) xmin 0 (ln-1)+ x0 = (snd $ fst hd) @> xmin_ix y0 = (snd hd) @> xmin_ix mapM_ (\(t',y') -> renderSamples xmin xmax Nothing renderAreaSample (endAreaSample x0 y0) t' y') (map (either id (error "MinMax data")) dat)@@ -238,10 +235,10 @@ (DecHist bt) -> do (bw,bc,c) <- formatBarSeries bt xscale yscale 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+ ln = dim $ snd $ fst hd+ xmin_ix = findMinIdx (snd $ fst hd) xmin 0 (ln-1)+ rest (m,v) = (m,subVector 1 (dim v - 1) v)+ x0 = (snd $ 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') (map (either id (error "MinMax data")) dat)@@ -265,59 +262,21 @@ ----------------------------------------------------------------------------- -formatLineSeries' :: [Dash] -> LineWidth -> Color -> C.Render ()-formatLineSeries' ds lw c = do- setDashes ds- C.setLineWidth lw - setColour c--formatLineSeries :: LineType -> Double -> Double -> Render ()-formatLineSeries NoLine _ _ = error "line format of NoLine in a line series"-formatLineSeries (ColourLine c) xscale yscale = do- (LineOptions ds lw) <- asks (_lineoptions . _renderoptions)- cairo $ formatLineSeries' ds ((lw)/(xscale+yscale)) c-formatLineSeries (TypeLine (LineOptions ds lw) c) xscale yscale = cairo $ formatLineSeries' ds ((lw)/(xscale+yscale)) c--formatPointSeries' :: Color -> C.Render ()-formatPointSeries' = setColour--formatPointSeries :: PointType -> Double -> Double -> Render (LineWidth,Glyph)-formatPointSeries (FullPoint (PointOptions pz c) g) _ _ = do- cairo $ formatPointSeries' c- return (pz,g)--formatBarSeries' :: LineWidth -> C.Render ()-formatBarSeries' lw = C.setLineWidth lw--formatBarSeries :: BarType -> Double -> Double -> Render (Width,Color,Color)-formatBarSeries (ColourBar c) xscale yscale = do- let sc = (xscale+yscale)/2- (BarOptions bw lw bc) <- asks (_baroptions . _renderoptions)- cairo $ formatBarSeries' (lw/sc)- return (bw/sc,c,bc)-formatBarSeries (TypeBar (BarOptions bw lw bc) c) xscale yscale = do- let sc = (xscale+yscale)/2- cairo $ formatBarSeries' (lw/sc)- return (bw/sc,c,bc)-------------------------------------------------------------------------------- renderSamples :: Double -> Double -> Maybe (C.Render ()) -> (Double -> Double -> C.Render ()) -> C.Render ()- -> Vector Double -> Vector Double -> Render ()-renderSamples xmin xmax s f e t y = do+ -> (Bool,Vector Double) -> Vector Double -> Render ()+renderSamples xmin xmax s f e (mono,t) y = do (BoundingBox _ _ w _) <- get let ln = dim t- m = isMonotoneIncreasing t- (xmin_ix,xmax_ix,num_pts) = if m+ (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 m then diff' else 1+ diff = if mono then diff' else 1 cairo $ do case s of Nothing -> C.moveTo (t @> xmin_ix) (y @> xmin_ix)@@ -334,19 +293,18 @@ 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+ -> (Bool,Vector Double) -> (Vector Double,Vector Double) -> Render ()+renderMinMaxSamples xmin xmax s f e (mono,t) y = do (BoundingBox _ _ w _) <- get let ln = dim t- m = isMonotoneIncreasing t- (xmin_ix,xmax_ix,num_pts) = if m+ (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 m then diff' else 1+ diff = if mono then diff' else 1 cairo $ do case s of Nothing -> C.moveTo (t @> xmin_ix) ((fst $ y) @> xmin_ix)@@ -486,18 +444,6 @@ endWhiskerSample :: C.Render () endWhiskerSample = return ()---------------------------------------------------------------------------------monoStep :: Double -> MaybeT (State Double) ()-monoStep d = do- dp <- get- when (d < dp) (fail "negative difference")- put d-{-# INLINE monoStep #-}--isMonotoneIncreasing :: Vector Double -> Bool-isMonotoneIncreasing v = maybe False (\_ -> True) $ evalState (runMaybeT $ (mapVectorM_ monoStep (subVector 1 (dim v -1) v))) (v @> 0) -----------------------------------------------------------------------------
+ lib/Graphics/Rendering/Plot/Render/Plot/Format.hs view
@@ -0,0 +1,71 @@++-----------------------------------------------------------------------------+-- |+-- Module : Graphics.Rendering.Plot.Render.Plot.Data+-- Copyright : (c) A. V. H. McPhail 2010+-- License : BSD3+--+-- Maintainer : haskell.vivian.mcphail <at> gmail <dot> com+-- Stability : provisional+-- Portability : portable+--+-- Rendering 'Figure's+--+-----------------------------------------------------------------------------++module Graphics.Rendering.Plot.Render.Plot.Format (+ formatLineSeries+ , formatPointSeries+ , formatBarSeries+ ) where++-----------------------------------------------------------------------------++import qualified Graphics.Rendering.Cairo as C++import Graphics.Rendering.Plot.Types++import Graphics.Rendering.Plot.Render.Types++import Control.Monad.Reader++-----------------------------------------------------------------------------++formatLineSeries' :: [Dash] -> LineWidth -> Color -> C.Render ()+formatLineSeries' ds lw c = do+ setDashes ds+ C.setLineWidth lw + setColour c++formatLineSeries :: LineType -> Double -> Double -> Render ()+formatLineSeries NoLine _ _ = error "line format of NoLine in a line series"+formatLineSeries (ColourLine c) xscale yscale = do+ (LineOptions ds lw) <- asks (_lineoptions . _renderoptions)+ cairo $ formatLineSeries' ds ((lw)/(xscale+yscale)) c+formatLineSeries (TypeLine (LineOptions ds lw) c) xscale yscale = cairo $ formatLineSeries' ds ((lw)/(xscale+yscale)) c++formatPointSeries' :: Color -> C.Render ()+formatPointSeries' = setColour++formatPointSeries :: PointType -> Double -> Double -> Render (LineWidth,Glyph)+formatPointSeries (FullPoint (PointOptions pz c) g) _ _ = do+ cairo $ formatPointSeries' c+ return (pz,g)++formatBarSeries' :: LineWidth -> C.Render ()+formatBarSeries' lw = C.setLineWidth lw++formatBarSeries :: BarType -> Double -> Double -> Render (Width,Color,Color)+formatBarSeries (ColourBar c) xscale yscale = do+ let sc = (xscale+yscale)/2+ (BarOptions bw lw bc) <- asks (_baroptions . _renderoptions)+ cairo $ formatBarSeries' (lw/sc)+ return (bw/sc,c,bc)+formatBarSeries (TypeBar (BarOptions bw lw bc) c) xscale yscale = do+ let sc = (xscale+yscale)/2+ cairo $ formatBarSeries' (lw/sc)+ return (bw/sc,c,bc)++-----------------------------------------------------------------------------++
lib/Graphics/Rendering/Plot/Render/Plot/Glyph.hs view
@@ -32,7 +32,7 @@ renderGlyph xscale yscale pz g = do C.save C.scale (pz / xscale) (pz / yscale)- C.setLineWidth 1+ C.setLineWidth pz renderGlyph' g C.restore where renderGlyph' Box = renderGlyphBox
lib/Graphics/Rendering/Plot/Render/Types.hs view
@@ -32,6 +32,7 @@ --import qualified Data.Array.IArray as A import qualified Graphics.Rendering.Cairo as C+import qualified Graphics.Rendering.Cairo.Matrix as CM import qualified Graphics.Rendering.Pango as P import Control.Monad.Reader@@ -208,6 +209,15 @@ return g -----------------------------------------------------------------------------++flipVerticalMatrix :: CM.Matrix+flipVerticalMatrix = CM.Matrix 1 0 0 (-1) 0 0++flipVertical :: C.Render ()+flipVertical = C.transform flipVerticalMatrix++-----------------------------------------------------------------------------+
lib/Graphics/Rendering/Plot/Types.hs view
@@ -29,6 +29,7 @@ import qualified Data.Array.IArray as A +import qualified Graphics.Rendering.Cairo as C import qualified Graphics.Rendering.Pango as P import Control.Monad.State@@ -125,21 +126,33 @@ ----------------------------------------------------------------------------- -type Length = Double type Location = (Double,Double) type Orientation = Double -- angle-type Arrow = Bool+type Head = Bool+type Fill = Bool +data AnnoteType = Arrow | Glyph | Text | Oval | Rectangle | Cairo+ -- extra glyphs and so on that can be put in a chart-data AnnoteType = AT_Text TextEntry- | AT_Glyph Glyph- | AT_Arrow Arrow LineOptions Length+data Annotation = AnnArrow Head LineType Location Location + | AnnOval Fill BarType Location Location+ | AnnRect Fill BarType Location Location+ | AnnGlyph PointType Location+ | AnnText TextEntry Location --Orientation+ | AnnCairo (Double -> Double -> Double -> Double -> C.Render ()) -data Annotation = Annotation AnnoteType Location Orientation Color type Annotations = [Annotation] ----------------------------------------------------------------------------- +newtype Annote a = FN { runAnnote :: ReaderT Options (State Annotations) a}+ deriving(Monad, MonadReader Options, MonadState Annotations)++execAnnote :: Annote a -> Options -> Annotations -> Annotations+execAnnote m r = execState (runReaderT (runAnnote m) r) ++-----------------------------------------------------------------------------+ data Scale = Linear | Log deriving(Eq) data Range = Range { _range_scale :: Scale, _range_min :: Double, _range_max :: Double }@@ -267,8 +280,10 @@ getMinMaxData (MinMax o Nothing) = Left o getMinMaxData (MinMax o (Just e)) = Right (o,e) +type MonotoneIncreasing = Bool+ data Abscissae = AbsFunction - | AbsPoints Series+ | AbsPoints MonotoneIncreasing Series data Ordinates = OrdFunction AxisSide Function (Maybe SeriesLabel) | OrdPoints AxisSide OrdSeries (Maybe SeriesLabel)@@ -424,6 +439,16 @@ legendInPlot :: Legend a -> Plot a legendInPlot m = FP $ lift $ (withReaderT _textoptions . mapReaderT legendInPlot') (runLegend m)++-----------------------------------------------------------------------------++annoteInPlot' :: State Annotations a -> State PlotData a+annoteInPlot' m = State $ \s -> let l = _annote s+ (a,annote) = runState m l+ in (a,s { _annote = annote})++annoteInPlot :: Annote a -> Plot a+annoteInPlot m = FP $ lift $ (mapReaderT annoteInPlot') (runAnnote m) -----------------------------------------------------------------------------
plot.cabal view
@@ -1,5 +1,5 @@ Name: plot-Version: 0.1.1.4+Version: 0.1.2 License: BSD3 License-file: LICENSE Copyright: (c) A.V.H. McPhail 2010@@ -36,8 +36,11 @@ . * added candle and whisker plots .- Changes in plot 0.2+ Changes in plot 0.1.2 .+ * axis join rendering improvement+ * added annotations+ . Category: Graphics Tested-with: GHC==6.12.1@@ -80,13 +83,16 @@ Graphics.Rendering.Plot.Figure.Plot.Axis Graphics.Rendering.Plot.Figure.Plot.Data Graphics.Rendering.Plot.Figure.Plot.Legend+ Graphics.Rendering.Plot.Figure.Plot.Annotation Graphics.Rendering.Plot.Render.Types Graphics.Rendering.Plot.Render.Text Graphics.Rendering.Plot.Render.Plot Graphics.Rendering.Plot.Render.Plot.Axis Graphics.Rendering.Plot.Render.Plot.Data Graphics.Rendering.Plot.Render.Plot.Legend+ Graphics.Rendering.Plot.Render.Plot.Annotation Graphics.Rendering.Plot.Render.Plot.Glyph+ Graphics.Rendering.Plot.Render.Plot.Format Control.Monad.Supply ghc-options: -Wall -fno-warn-unused-binds