{-# LANGUAGE TemplateHaskell #-}
module Graphics.Rendering.Chart.Plot.ErrBars(
PlotErrBars(..),
ErrPoint(..),
ErrValue(..),
symErrPoint,
plot_errbars_title,
plot_errbars_line_style,
plot_errbars_tick_length,
plot_errbars_overhang,
plot_errbars_values,
) where
import Control.Lens
import Data.Monoid
import Graphics.Rendering.Chart.Geometry
import Graphics.Rendering.Chart.Drawing
import Graphics.Rendering.Chart.Plot.Types
import Data.Colour (opaque)
import Data.Colour.Names (blue)
import Data.Default.Class
data ErrValue x = ErrValue {
ErrValue x -> x
ev_low :: x,
ErrValue x -> x
ev_best :: x,
ErrValue x -> x
ev_high :: x
} deriving Int -> ErrValue x -> ShowS
[ErrValue x] -> ShowS
ErrValue x -> String
(Int -> ErrValue x -> ShowS)
-> (ErrValue x -> String)
-> ([ErrValue x] -> ShowS)
-> Show (ErrValue x)
forall x. Show x => Int -> ErrValue x -> ShowS
forall x. Show x => [ErrValue x] -> ShowS
forall x. Show x => ErrValue x -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ErrValue x] -> ShowS
$cshowList :: forall x. Show x => [ErrValue x] -> ShowS
show :: ErrValue x -> String
$cshow :: forall x. Show x => ErrValue x -> String
showsPrec :: Int -> ErrValue x -> ShowS
$cshowsPrec :: forall x. Show x => Int -> ErrValue x -> ShowS
Show
data ErrPoint x y = ErrPoint {
ErrPoint x y -> ErrValue x
ep_x :: ErrValue x,
ErrPoint x y -> ErrValue y
ep_y :: ErrValue y
} deriving Int -> ErrPoint x y -> ShowS
[ErrPoint x y] -> ShowS
ErrPoint x y -> String
(Int -> ErrPoint x y -> ShowS)
-> (ErrPoint x y -> String)
-> ([ErrPoint x y] -> ShowS)
-> Show (ErrPoint x y)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall x y. (Show x, Show y) => Int -> ErrPoint x y -> ShowS
forall x y. (Show x, Show y) => [ErrPoint x y] -> ShowS
forall x y. (Show x, Show y) => ErrPoint x y -> String
showList :: [ErrPoint x y] -> ShowS
$cshowList :: forall x y. (Show x, Show y) => [ErrPoint x y] -> ShowS
show :: ErrPoint x y -> String
$cshow :: forall x y. (Show x, Show y) => ErrPoint x y -> String
showsPrec :: Int -> ErrPoint x y -> ShowS
$cshowsPrec :: forall x y. (Show x, Show y) => Int -> ErrPoint x y -> ShowS
Show
symErrPoint :: (Num a, Num b) => a -> b -> a -> b -> ErrPoint a b
symErrPoint :: a -> b -> a -> b -> ErrPoint a b
symErrPoint a
x b
y a
dx b
dy = ErrValue a -> ErrValue b -> ErrPoint a b
forall x y. ErrValue x -> ErrValue y -> ErrPoint x y
ErrPoint (a -> a -> a -> ErrValue a
forall x. x -> x -> x -> ErrValue x
ErrValue (a
xa -> a -> a
forall a. Num a => a -> a -> a
-a
dx) a
x (a
xa -> a -> a
forall a. Num a => a -> a -> a
+a
dx))
(b -> b -> b -> ErrValue b
forall x. x -> x -> x -> ErrValue x
ErrValue (b
yb -> b -> b
forall a. Num a => a -> a -> a
-b
dy) b
y (b
yb -> b -> b
forall a. Num a => a -> a -> a
+b
dy))
data PlotErrBars x y = PlotErrBars {
PlotErrBars x y -> String
_plot_errbars_title :: String,
PlotErrBars x y -> LineStyle
_plot_errbars_line_style :: LineStyle,
PlotErrBars x y -> Double
_plot_errbars_tick_length :: Double,
PlotErrBars x y -> Double
_plot_errbars_overhang :: Double,
PlotErrBars x y -> [ErrPoint x y]
_plot_errbars_values :: [ErrPoint x y]
}
instance ToPlot PlotErrBars where
toPlot :: PlotErrBars x y -> Plot x y
toPlot PlotErrBars x y
p = Plot :: forall x y.
(PointMapFn x y -> BackendProgram ())
-> [(String, Rect -> BackendProgram ())] -> ([x], [y]) -> Plot x y
Plot {
_plot_render :: PointMapFn x y -> BackendProgram ()
_plot_render = PlotErrBars x y -> PointMapFn x y -> BackendProgram ()
forall x y. PlotErrBars x y -> PointMapFn x y -> BackendProgram ()
renderPlotErrBars PlotErrBars x y
p,
_plot_legend :: [(String, Rect -> BackendProgram ())]
_plot_legend = [(PlotErrBars x y -> String
forall x y. PlotErrBars x y -> String
_plot_errbars_title PlotErrBars x y
p, PlotErrBars x y -> Rect -> BackendProgram ()
forall x y. PlotErrBars x y -> Rect -> BackendProgram ()
renderPlotLegendErrBars PlotErrBars x y
p)],
_plot_all_points :: ([x], [y])
_plot_all_points = ( [[x]] -> [x]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ [ErrValue x -> x
forall x. ErrValue x -> x
ev_low ErrValue x
x,ErrValue x -> x
forall x. ErrValue x -> x
ev_high ErrValue x
x]
| ErrPoint ErrValue x
x ErrValue y
_ <- [ErrPoint x y]
pts ]
, [[y]] -> [y]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ [ErrValue y -> y
forall x. ErrValue x -> x
ev_low ErrValue y
y,ErrValue y -> y
forall x. ErrValue x -> x
ev_high ErrValue y
y]
| ErrPoint ErrValue x
_ ErrValue y
y <- [ErrPoint x y]
pts ] )
}
where
pts :: [ErrPoint x y]
pts = PlotErrBars x y -> [ErrPoint x y]
forall x y. PlotErrBars x y -> [ErrPoint x y]
_plot_errbars_values PlotErrBars x y
p
renderPlotErrBars :: PlotErrBars x y -> PointMapFn x y -> BackendProgram ()
renderPlotErrBars :: PlotErrBars x y -> PointMapFn x y -> BackendProgram ()
renderPlotErrBars PlotErrBars x y
p PointMapFn x y
pmap =
(ErrPoint x y -> BackendProgram ())
-> [ErrPoint x y] -> BackendProgram ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (ErrPoint Double Double -> BackendProgram ()
drawErrBar(ErrPoint Double Double -> BackendProgram ())
-> (ErrPoint x y -> ErrPoint Double Double)
-> ErrPoint x y
-> BackendProgram ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ErrPoint x y -> ErrPoint Double Double
epmap) (PlotErrBars x y -> [ErrPoint x y]
forall x y. PlotErrBars x y -> [ErrPoint x y]
_plot_errbars_values PlotErrBars x y
p)
where
epmap :: ErrPoint x y -> ErrPoint Double Double
epmap (ErrPoint (ErrValue x
xl x
x x
xh) (ErrValue y
yl y
y y
yh)) =
ErrValue Double -> ErrValue Double -> ErrPoint Double Double
forall x y. ErrValue x -> ErrValue y -> ErrPoint x y
ErrPoint (Double -> Double -> Double -> ErrValue Double
forall x. x -> x -> x -> ErrValue x
ErrValue Double
xl' Double
x' Double
xh') (Double -> Double -> Double -> ErrValue Double
forall x. x -> x -> x -> ErrValue x
ErrValue Double
yl' Double
y' Double
yh')
where (Point Double
x' Double
y') = (x, y) -> Point
pmap' (x
x,y
y)
(Point Double
xl' Double
yl') = (x, y) -> Point
pmap' (x
xl,y
yl)
(Point Double
xh' Double
yh') = (x, y) -> Point
pmap' (x
xh,y
yh)
drawErrBar :: ErrPoint Double Double -> BackendProgram ()
drawErrBar = PlotErrBars x y -> ErrPoint Double Double -> BackendProgram ()
forall x y.
PlotErrBars x y -> ErrPoint Double Double -> BackendProgram ()
drawErrBar0 PlotErrBars x y
p
pmap' :: (x, y) -> Point
pmap' = PointMapFn x y -> (x, y) -> Point
forall x y. PointMapFn x y -> (x, y) -> Point
mapXY PointMapFn x y
pmap
drawErrBar0 :: PlotErrBars x y -> ErrPoint Double Double -> BackendProgram ()
drawErrBar0 :: PlotErrBars x y -> ErrPoint Double Double -> BackendProgram ()
drawErrBar0 PlotErrBars x y
ps (ErrPoint (ErrValue Double
xl Double
x Double
xh) (ErrValue Double
yl Double
y Double
yh)) = do
let tl :: Double
tl = PlotErrBars x y -> Double
forall x y. PlotErrBars x y -> Double
_plot_errbars_tick_length PlotErrBars x y
ps
let oh :: Double
oh = PlotErrBars x y -> Double
forall x y. PlotErrBars x y -> Double
_plot_errbars_overhang PlotErrBars x y
ps
LineStyle -> BackendProgram () -> BackendProgram ()
forall a. LineStyle -> BackendProgram a -> BackendProgram a
withLineStyle (PlotErrBars x y -> LineStyle
forall x y. PlotErrBars x y -> LineStyle
_plot_errbars_line_style PlotErrBars x y
ps) (BackendProgram () -> BackendProgram ())
-> BackendProgram () -> BackendProgram ()
forall a b. (a -> b) -> a -> b
$
Path -> BackendProgram ()
strokePath (Path -> BackendProgram ()) -> Path -> BackendProgram ()
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Path
moveTo' (Double
xlDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
oh) Double
y
Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
lineTo' (Double
xhDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
oh) Double
y
Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
moveTo' Double
x (Double
ylDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
oh)
Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
lineTo' Double
x (Double
yhDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
oh)
Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
moveTo' Double
xl (Double
yDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
tl)
Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
lineTo' Double
xl (Double
yDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
tl)
Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
moveTo' (Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
tl) Double
yl
Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
lineTo' (Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
tl) Double
yl
Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
moveTo' Double
xh (Double
yDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
tl)
Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
lineTo' Double
xh (Double
yDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
tl)
Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
moveTo' (Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
tl) Double
yh
Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
lineTo' (Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
tl) Double
yh
renderPlotLegendErrBars :: PlotErrBars x y -> Rect -> BackendProgram ()
renderPlotLegendErrBars :: PlotErrBars x y -> Rect -> BackendProgram ()
renderPlotLegendErrBars PlotErrBars x y
p (Rect Point
p1 Point
p2) = do
ErrPoint Double Double -> BackendProgram ()
drawErrBar (Double -> Double -> Double -> Double -> ErrPoint Double Double
forall a b. (Num a, Num b) => a -> b -> a -> b -> ErrPoint a b
symErrPoint (Point -> Double
p_x Point
p1) Double
y Double
dx Double
dx)
ErrPoint Double Double -> BackendProgram ()
drawErrBar (Double -> Double -> Double -> Double -> ErrPoint Double Double
forall a b. (Num a, Num b) => a -> b -> a -> b -> ErrPoint a b
symErrPoint ((Point -> Double
p_x Point
p1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Point -> Double
p_x Point
p2)Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2) Double
y Double
dx Double
dx)
ErrPoint Double Double -> BackendProgram ()
drawErrBar (Double -> Double -> Double -> Double -> ErrPoint Double Double
forall a b. (Num a, Num b) => a -> b -> a -> b -> ErrPoint a b
symErrPoint (Point -> Double
p_x Point
p2) Double
y Double
dx Double
dx)
where
drawErrBar :: ErrPoint Double Double -> BackendProgram ()
drawErrBar = PlotErrBars x y -> ErrPoint Double Double -> BackendProgram ()
forall x y.
PlotErrBars x y -> ErrPoint Double Double -> BackendProgram ()
drawErrBar0 PlotErrBars x y
p
dx :: Double
dx = Double -> Double -> Double
forall a. Ord a => a -> a -> a
min ((Point -> Double
p_x Point
p2 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Point -> Double
p_x Point
p1)Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
6) ((Point -> Double
p_y Point
p2 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Point -> Double
p_y Point
p1)Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2)
y :: Double
y = (Point -> Double
p_y Point
p1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Point -> Double
p_y Point
p2)Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2
instance Default (PlotErrBars x y) where
def :: PlotErrBars x y
def = PlotErrBars :: forall x y.
String
-> LineStyle
-> Double
-> Double
-> [ErrPoint x y]
-> PlotErrBars x y
PlotErrBars
{ _plot_errbars_title :: String
_plot_errbars_title = String
""
, _plot_errbars_line_style :: LineStyle
_plot_errbars_line_style = Double -> AlphaColour Double -> LineStyle
solidLine Double
1 (AlphaColour Double -> LineStyle)
-> AlphaColour Double -> LineStyle
forall a b. (a -> b) -> a -> b
$ Colour Double -> AlphaColour Double
forall a. Num a => Colour a -> AlphaColour a
opaque Colour Double
forall a. (Ord a, Floating a) => Colour a
blue
, _plot_errbars_tick_length :: Double
_plot_errbars_tick_length = Double
3
, _plot_errbars_overhang :: Double
_plot_errbars_overhang = Double
0
, _plot_errbars_values :: [ErrPoint x y]
_plot_errbars_values = []
}
$( makeLenses ''PlotErrBars )