-----------------------------------------------------------------------------
-- |
-- Module      :  Graphics.Rendering.Chart.Plot.ErrBars
-- Copyright   :  (c) Tim Docker 2006, 2014
-- License     :  BSD-style (see chart/COPYRIGHT)
--
-- Plot series of points with associated error bars.
--
{-# LANGUAGE TemplateHaskell #-}

module Graphics.Rendering.Chart.Plot.ErrBars(
    PlotErrBars(..),
    ErrPoint(..),
    ErrValue(..),
    symErrPoint,

    -- * Accessors
    -- | These accessors are generated by template haskell

    plot_errbars_title,
    plot_errbars_line_style,
    plot_errbars_tick_length,
    plot_errbars_overhang,
    plot_errbars_values,
) where

import Control.Lens

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

-- | Value for holding a point with associated error bounds for each axis.

data ErrValue x = ErrValue {
      forall x. ErrValue x -> x
ev_low  :: x,
      forall x. ErrValue x -> x
ev_best :: x,
      forall x. ErrValue x -> x
ev_high :: x
} deriving Int -> ErrValue x -> ShowS
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 {
      forall x y. ErrPoint x y -> ErrValue x
ep_x :: ErrValue x,
      forall x y. ErrPoint x y -> ErrValue y
ep_y :: ErrValue y
} deriving Int -> ErrPoint x y -> ShowS
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

-- | When the error is symmetric, we can simply pass in dx for the error.
symErrPoint :: (Num a, Num b) => a -> b -> a -> b -> ErrPoint a b
symErrPoint :: forall a b. (Num a, Num b) => a -> b -> a -> b -> ErrPoint a b
symErrPoint a
x b
y a
dx b
dy = forall x y. ErrValue x -> ErrValue y -> ErrPoint x y
ErrPoint (forall x. x -> x -> x -> ErrValue x
ErrValue (a
xforall a. Num a => a -> a -> a
-a
dx) a
x (a
xforall a. Num a => a -> a -> a
+a
dx))
                                 (forall x. x -> x -> x -> ErrValue x
ErrValue (b
yforall a. Num a => a -> a -> a
-b
dy) b
y (b
yforall a. Num a => a -> a -> a
+b
dy))

-- | Value defining a series of error intervals, and a style in
--   which to render them.
data PlotErrBars x y = PlotErrBars {
    forall x y. PlotErrBars x y -> String
_plot_errbars_title       :: String,
    forall x y. PlotErrBars x y -> LineStyle
_plot_errbars_line_style  :: LineStyle,
    forall x y. PlotErrBars x y -> Double
_plot_errbars_tick_length :: Double,
    forall x y. PlotErrBars x y -> Double
_plot_errbars_overhang    :: Double,
    forall x y. PlotErrBars x y -> [ErrPoint x y]
_plot_errbars_values      :: [ErrPoint x y]
}


instance ToPlot PlotErrBars where
    toPlot :: forall x y. PlotErrBars x y -> Plot x y
toPlot PlotErrBars x y
p = Plot {
        _plot_render :: PointMapFn x y -> BackendProgram ()
_plot_render     = forall x y. PlotErrBars x y -> PointMapFn x y -> BackendProgram ()
renderPlotErrBars PlotErrBars x y
p,
        _plot_legend :: [(String, Rect -> BackendProgram ())]
_plot_legend     = [(forall x y. PlotErrBars x y -> String
_plot_errbars_title PlotErrBars x y
p, forall x y. PlotErrBars x y -> Rect -> BackendProgram ()
renderPlotLegendErrBars PlotErrBars x y
p)],
        _plot_all_points :: ([x], [y])
_plot_all_points = ( forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ [forall x. ErrValue x -> x
ev_low ErrValue x
x,forall x. ErrValue x -> x
ev_high ErrValue x
x]
                                    | ErrPoint ErrValue x
x ErrValue y
_ <- [ErrPoint x y]
pts ]
                           , forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ [forall x. ErrValue x -> x
ev_low 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 = 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 :: forall x y. PlotErrBars x y -> PointMapFn x y -> BackendProgram ()
renderPlotErrBars PlotErrBars x y
p PointMapFn x y
pmap =
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (ErrPoint Double Double -> BackendProgram ()
drawErrBarforall b c a. (b -> c) -> (a -> b) -> a -> c
.ErrPoint x y -> ErrPoint Double Double
epmap) (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)) =
        forall x y. ErrValue x -> ErrValue y -> ErrPoint x y
ErrPoint (forall x. x -> x -> x -> ErrValue x
ErrValue Double
xl' Double
x' Double
xh') (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 = forall x y.
PlotErrBars x y -> ErrPoint Double Double -> BackendProgram ()
drawErrBar0 PlotErrBars x y
p
    pmap' :: (x, y) -> Point
pmap'      = forall x y. PointMapFn x y -> (x, y) -> Point
mapXY PointMapFn x y
pmap

drawErrBar0 :: PlotErrBars x y -> ErrPoint Double Double -> BackendProgram ()
drawErrBar0 :: forall x y.
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 = forall x y. PlotErrBars x y -> Double
_plot_errbars_tick_length PlotErrBars x y
ps
        let oh :: Double
oh = forall x y. PlotErrBars x y -> Double
_plot_errbars_overhang PlotErrBars x y
ps
        forall a. LineStyle -> BackendProgram a -> BackendProgram a
withLineStyle (forall x y. PlotErrBars x y -> LineStyle
_plot_errbars_line_style PlotErrBars x y
ps) forall a b. (a -> b) -> a -> b
$
          Path -> BackendProgram ()
strokePath forall a b. (a -> b) -> a -> b
$ Double -> Double -> Path
moveTo' (Double
xlforall a. Num a => a -> a -> a
-Double
oh) Double
y
                    forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
lineTo' (Double
xhforall a. Num a => a -> a -> a
+Double
oh) Double
y
                    forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
moveTo' Double
x (Double
ylforall a. Num a => a -> a -> a
-Double
oh)
                    forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
lineTo' Double
x (Double
yhforall a. Num a => a -> a -> a
+Double
oh)
                    forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
moveTo' Double
xl (Double
yforall a. Num a => a -> a -> a
-Double
tl)
                    forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
lineTo' Double
xl (Double
yforall a. Num a => a -> a -> a
+Double
tl)
                    forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
moveTo' (Double
xforall a. Num a => a -> a -> a
-Double
tl) Double
yl
                    forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
lineTo' (Double
xforall a. Num a => a -> a -> a
+Double
tl) Double
yl
                    forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
moveTo' Double
xh (Double
yforall a. Num a => a -> a -> a
-Double
tl)
                    forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
lineTo' Double
xh (Double
yforall a. Num a => a -> a -> a
+Double
tl)
                    forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
moveTo' (Double
xforall a. Num a => a -> a -> a
-Double
tl) Double
yh
                    forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
lineTo' (Double
xforall a. Num a => a -> a -> a
+Double
tl) Double
yh

renderPlotLegendErrBars :: PlotErrBars x y -> Rect -> BackendProgram ()
renderPlotLegendErrBars :: forall x y. PlotErrBars x y -> Rect -> BackendProgram ()
renderPlotLegendErrBars PlotErrBars x y
p (Rect Point
p1 Point
p2) = do
    ErrPoint Double Double -> BackendProgram ()
drawErrBar (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 (forall a b. (Num a, Num b) => a -> b -> a -> b -> ErrPoint a b
symErrPoint ((Point -> Double
p_x Point
p1 forall a. Num a => a -> a -> a
+ Point -> Double
p_x Point
p2)forall a. Fractional a => a -> a -> a
/Double
2) Double
y Double
dx Double
dx)
    ErrPoint Double Double -> BackendProgram ()
drawErrBar (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 = forall x y.
PlotErrBars x y -> ErrPoint Double Double -> BackendProgram ()
drawErrBar0 PlotErrBars x y
p
    dx :: Double
dx         = forall a. Ord a => a -> a -> a
min ((Point -> Double
p_x Point
p2 forall a. Num a => a -> a -> a
- Point -> Double
p_x Point
p1)forall a. Fractional a => a -> a -> a
/Double
6) ((Point -> Double
p_y Point
p2 forall a. Num a => a -> a -> a
- Point -> Double
p_y Point
p1)forall a. Fractional a => a -> a -> a
/Double
2)
    y :: Double
y          = (Point -> Double
p_y Point
p1 forall a. Num a => a -> a -> a
+ Point -> Double
p_y Point
p2)forall a. Fractional a => a -> a -> a
/Double
2

instance Default (PlotErrBars x y) where
  def :: PlotErrBars x y
def = 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 forall a b. (a -> b) -> a -> b
$ forall a. Num a => Colour a -> AlphaColour a
opaque 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 )