module Graphics.Rendering.Chart.Plot.ErrBars(
PlotErrBars(..),
defaultPlotErrBars,
ErrPoint(..),
ErrValue(..),
symErrPoint,
plot_errbars_title,
plot_errbars_line_style,
plot_errbars_tick_length,
plot_errbars_overhang,
plot_errbars_values,
) where
import Data.Accessor.Template
import qualified Graphics.Rendering.Cairo as C
import Graphics.Rendering.Chart.Types
import Graphics.Rendering.Chart.Renderable
import Graphics.Rendering.Chart.Plot.Types
import Data.Colour (opaque)
import Data.Colour.Names (black, blue)
import Data.Colour.SRGB (sRGB)
data ErrValue x = ErrValue {
ev_low :: x,
ev_best :: x,
ev_high :: x
} deriving Show
data ErrPoint x y = ErrPoint {
ep_x :: ErrValue x,
ep_y :: ErrValue y
} deriving Show
symErrPoint :: (Num a, Num b) => a -> b -> a -> b -> ErrPoint a b
symErrPoint x y dx dy = ErrPoint (ErrValue (xdx) x (x+dx))
(ErrValue (ydy) y (y+dy))
data PlotErrBars x y = PlotErrBars {
plot_errbars_title_ :: String,
plot_errbars_line_style_ :: CairoLineStyle,
plot_errbars_tick_length_ :: Double,
plot_errbars_overhang_ :: Double,
plot_errbars_values_ :: [ErrPoint x y]
}
instance ToPlot PlotErrBars where
toPlot p = Plot {
plot_render_ = renderPlotErrBars p,
plot_legend_ = [(plot_errbars_title_ p, renderPlotLegendErrBars p)],
plot_all_points_ = ( concat [ [ev_low x,ev_high x]
| ErrPoint x _ <- pts ]
, concat [ [ev_low y,ev_high y]
| ErrPoint _ y <- pts ] )
}
where
pts = plot_errbars_values_ p
renderPlotErrBars :: PlotErrBars x y -> PointMapFn x y -> CRender ()
renderPlotErrBars p pmap = preserveCState $ do
mapM_ (drawErrBar.epmap) (plot_errbars_values_ p)
where
epmap (ErrPoint (ErrValue xl x xh) (ErrValue yl y yh)) =
ErrPoint (ErrValue xl' x' xh') (ErrValue yl' y' yh')
where (Point x' y') = pmap' (x,y)
(Point xl' yl') = pmap' (xl,yl)
(Point xh' yh') = pmap' (xh,yh)
drawErrBar = drawErrBar0 p
pmap' = mapXY pmap
drawErrBar0 ps (ErrPoint (ErrValue xl x xh) (ErrValue yl y yh)) = do
let tl = plot_errbars_tick_length_ ps
let oh = plot_errbars_overhang_ ps
setLineStyle (plot_errbars_line_style_ ps)
c $ C.newPath
c $ C.moveTo (xloh) y
c $ C.lineTo (xh+oh) y
c $ C.moveTo x (yloh)
c $ C.lineTo x (yh+oh)
c $ C.moveTo xl (ytl)
c $ C.lineTo xl (y+tl)
c $ C.moveTo (xtl) yl
c $ C.lineTo (x+tl) yl
c $ C.moveTo xh (ytl)
c $ C.lineTo xh (y+tl)
c $ C.moveTo (xtl) yh
c $ C.lineTo (x+tl) yh
c $ C.stroke
renderPlotLegendErrBars :: PlotErrBars x y -> Rect -> CRender ()
renderPlotLegendErrBars p r@(Rect p1 p2) = preserveCState $ do
drawErrBar (symErrPoint (p_x p1) ((p_y p1 + p_y p2)/2) dx dx)
drawErrBar (symErrPoint ((p_x p1 + p_x p2)/2) ((p_y p1 + p_y p2)/2) dx dx)
drawErrBar (symErrPoint (p_x p2) ((p_y p1 + p_y p2)/2) dx dx)
where
drawErrBar = drawErrBar0 p
dx = min ((p_x p2 p_x p1)/6) ((p_y p2 p_y p1)/2)
defaultPlotErrBars :: PlotErrBars x y
defaultPlotErrBars = PlotErrBars {
plot_errbars_title_ = "",
plot_errbars_line_style_ = solidLine 1 $ opaque blue,
plot_errbars_tick_length_ = 3,
plot_errbars_overhang_ = 0,
plot_errbars_values_ = []
}
$( deriveAccessors ''PlotErrBars )