-----------------------------------------------------------------------------
-- |
-- Module      :  Graphics.Rendering.Chart.Plot.Candle
-- Copyright   :  (c) Tim Docker 2006, 2014
-- License     :  BSD-style (see chart/COPYRIGHT)
--
-- Candlestick charts for financial plotting
--
{-# LANGUAGE TemplateHaskell #-}

module Graphics.Rendering.Chart.Plot.Candle(
    PlotCandle(..),
    Candle(..),

    plot_candle_title,
    plot_candle_line_style,
    plot_candle_tick_length,
    plot_candle_width,
    plot_candle_centre,
    plot_candle_fill,
    plot_candle_rise_fill_style,
    plot_candle_fall_fill_style,
    plot_candle_values,
) where

import Control.Lens hiding (op)
import Data.Monoid

import Graphics.Rendering.Chart.Geometry hiding (close)
import Graphics.Rendering.Chart.Drawing
import Graphics.Rendering.Chart.Plot.Types
import Control.Monad
import Data.Colour (opaque)
import Data.Colour.Names (white, blue)
import Data.Default.Class

-- | Value defining a financial interval: opening and closing prices, with
--   maxima and minima; and a style in which to render them.
--   By convention, there are different fill styles depending on whether
--   the price rises (open < close) or falls (close < open).
--   (This plot type can also be re-purposed for statistical intervals, e.g.
--    minimum, first quartile, median, third quartile, maximum.)
data PlotCandle x y = PlotCandle {
    PlotCandle x y -> String
_plot_candle_title           :: String,
    PlotCandle x y -> LineStyle
_plot_candle_line_style      :: LineStyle,
    PlotCandle x y -> Bool
_plot_candle_fill            :: Bool,
    PlotCandle x y -> FillStyle
_plot_candle_rise_fill_style :: FillStyle,
    PlotCandle x y -> FillStyle
_plot_candle_fall_fill_style :: FillStyle,
    PlotCandle x y -> Double
_plot_candle_tick_length     :: Double,
    PlotCandle x y -> Double
_plot_candle_width           :: Double,
    PlotCandle x y -> Double
_plot_candle_centre          :: Double,
    PlotCandle x y -> [Candle x y]
_plot_candle_values          :: [Candle x y]
}

-- | A Value holding price intervals for a given x-coord.
--   An alternative view is that these are statistical intervals: the
--   0th, 25th, 50th, 75th, and 100th percentiles.
data Candle x y = Candle { Candle x y -> x
candle_x     :: x
                         , Candle x y -> y
candle_low   :: y
                         , Candle x y -> y
candle_open  :: y
                         , Candle x y -> y
candle_mid   :: y
                         , Candle x y -> y
candle_close :: y
                         , Candle x y -> y
candle_high  :: y
                         } deriving (Int -> Candle x y -> ShowS
[Candle x y] -> ShowS
Candle x y -> String
(Int -> Candle x y -> ShowS)
-> (Candle x y -> String)
-> ([Candle x y] -> ShowS)
-> Show (Candle x y)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall x y. (Show x, Show y) => Int -> Candle x y -> ShowS
forall x y. (Show x, Show y) => [Candle x y] -> ShowS
forall x y. (Show x, Show y) => Candle x y -> String
showList :: [Candle x y] -> ShowS
$cshowList :: forall x y. (Show x, Show y) => [Candle x y] -> ShowS
show :: Candle x y -> String
$cshow :: forall x y. (Show x, Show y) => Candle x y -> String
showsPrec :: Int -> Candle x y -> ShowS
$cshowsPrec :: forall x y. (Show x, Show y) => Int -> Candle x y -> ShowS
Show)

instance ToPlot PlotCandle where
    toPlot :: PlotCandle x y -> Plot x y
toPlot PlotCandle 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     = PlotCandle x y -> PointMapFn x y -> BackendProgram ()
forall x y. PlotCandle x y -> PointMapFn x y -> BackendProgram ()
renderPlotCandle PlotCandle x y
p,
        _plot_legend :: [(String, Rect -> BackendProgram ())]
_plot_legend     = [(PlotCandle x y -> String
forall x y. PlotCandle x y -> String
_plot_candle_title PlotCandle x y
p, PlotCandle x y -> Rect -> BackendProgram ()
forall x y. PlotCandle x y -> Rect -> BackendProgram ()
renderPlotLegendCandle PlotCandle x y
p)],
        _plot_all_points :: ([x], [y])
_plot_all_points = ( (Candle x y -> x) -> [Candle x y] -> [x]
forall a b. (a -> b) -> [a] -> [b]
map Candle x y -> x
forall x y. Candle x y -> x
candle_x [Candle x y]
pts
                           , [[y]] -> [y]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ [Candle x y -> y
forall x y. Candle x y -> y
candle_low Candle x y
c, Candle x y -> y
forall x y. Candle x y -> y
candle_high Candle x y
c]
                                    | Candle x y
c <- [Candle x y]
pts ] )
    }
      where
        pts :: [Candle x y]
pts = PlotCandle x y -> [Candle x y]
forall x y. PlotCandle x y -> [Candle x y]
_plot_candle_values PlotCandle x y
p

renderPlotCandle :: PlotCandle x y -> PointMapFn x y -> BackendProgram ()
renderPlotCandle :: PlotCandle x y -> PointMapFn x y -> BackendProgram ()
renderPlotCandle PlotCandle x y
p PointMapFn x y
pmap = 
    (Candle x y -> BackendProgram ())
-> [Candle x y] -> BackendProgram ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (PlotCandle x y -> Candle Double Double -> BackendProgram ()
forall x y.
PlotCandle x y -> Candle Double Double -> BackendProgram ()
drawCandle PlotCandle x y
p (Candle Double Double -> BackendProgram ())
-> (Candle x y -> Candle Double Double)
-> Candle x y
-> BackendProgram ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Candle x y -> Candle Double Double
candlemap) (PlotCandle x y -> [Candle x y]
forall x y. PlotCandle x y -> [Candle x y]
_plot_candle_values PlotCandle x y
p)
  where
    candlemap :: Candle x y -> Candle Double Double
candlemap (Candle x
x y
lo y
op y
mid y
cl y
hi) =
        Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> Candle Double Double
forall x y. x -> y -> y -> y -> y -> y -> Candle x y
Candle Double
x' Double
lo' Double
op' Double
mid' Double
cl' Double
hi'
        where (Point Double
x' Double
mid')  = (x, y) -> Point
pmap' (x
x,y
mid)
              (Point Double
_  Double
lo')   = (x, y) -> Point
pmap' (x
x,y
lo)
              (Point Double
_  Double
op')   = (x, y) -> Point
pmap' (x
x,y
op)
              (Point Double
_  Double
cl')   = (x, y) -> Point
pmap' (x
x,y
cl)
              (Point Double
_  Double
hi')   = (x, y) -> Point
pmap' (x
x,y
hi)
    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

drawCandle :: PlotCandle x y -> Candle Double Double -> BackendProgram ()
drawCandle :: PlotCandle x y -> Candle Double Double -> BackendProgram ()
drawCandle PlotCandle x y
ps (Candle Double
x Double
lo Double
open Double
mid Double
close Double
hi) = do
        let tl :: Double
tl = PlotCandle x y -> Double
forall x y. PlotCandle x y -> Double
_plot_candle_tick_length PlotCandle x y
ps
        let wd :: Double
wd = PlotCandle x y -> Double
forall x y. PlotCandle x y -> Double
_plot_candle_width PlotCandle x y
ps
        let ct :: Double
ct = PlotCandle x y -> Double
forall x y. PlotCandle x y -> Double
_plot_candle_centre PlotCandle x y
ps
        let f :: Bool
f  = PlotCandle x y -> Bool
forall x y. PlotCandle x y -> Bool
_plot_candle_fill PlotCandle x y
ps
        -- the pixel coordinate system is inverted wrt the value coords.
        Bool -> BackendProgram () -> BackendProgram ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
f (BackendProgram () -> BackendProgram ())
-> BackendProgram () -> BackendProgram ()
forall a b. (a -> b) -> a -> b
$ FillStyle -> BackendProgram () -> BackendProgram ()
forall a. FillStyle -> BackendProgram a -> BackendProgram a
withFillStyle (if Double
open Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
close
                                   then PlotCandle x y -> FillStyle
forall x y. PlotCandle x y -> FillStyle
_plot_candle_rise_fill_style PlotCandle x y
ps
                                   else PlotCandle x y -> FillStyle
forall x y. PlotCandle x y -> FillStyle
_plot_candle_fall_fill_style PlotCandle x y
ps) (BackendProgram () -> BackendProgram ())
-> BackendProgram () -> BackendProgram ()
forall a b. (a -> b) -> a -> b
$ 
                    Path -> BackendProgram ()
fillPath (Path -> BackendProgram ()) -> Path -> BackendProgram ()
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Path
moveTo' (Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
wd) Double
open
                            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
wd) Double
close
                            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
wd) Double
close
                            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
wd) Double
open
                            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
wd) Double
open

        LineStyle -> BackendProgram () -> BackendProgram ()
forall a. LineStyle -> BackendProgram a -> BackendProgram a
withLineStyle (PlotCandle x y -> LineStyle
forall x y. PlotCandle x y -> LineStyle
_plot_candle_line_style PlotCandle x y
ps) (BackendProgram () -> BackendProgram ())
-> BackendProgram () -> BackendProgram ()
forall a b. (a -> b) -> a -> b
$ do
          Path -> BackendProgram ()
strokePath (Path -> BackendProgram ()) -> Path -> BackendProgram ()
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Path
moveTo' (Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
wd) Double
open
                    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
wd) Double
close
                    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
wd) Double
close
                    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
wd) Double
open
                    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
wd) Double
open

          Path -> BackendProgram ()
strokePath (Path -> BackendProgram ()) -> Path -> BackendProgram ()
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Path
moveTo' Double
x (Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
lo Double
hi)
                    Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
lineTo' Double
x (Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
open Double
close)
                    Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
moveTo' Double
x (Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
open Double
close)
                    Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Path
lineTo' Double
x (Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
hi Double
lo)

          Bool -> BackendProgram () -> BackendProgram ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Double
tl Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0) (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
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
tl) Double
lo
                                    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
lo
                                    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
hi
                                    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
hi
          
          Bool -> BackendProgram () -> BackendProgram ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Double
ct Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0) (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
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
-Double
ct) Double
mid
                                    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
ct) Double
mid

renderPlotLegendCandle :: PlotCandle x y -> Rect -> BackendProgram ()
renderPlotLegendCandle :: PlotCandle x y -> Rect -> BackendProgram ()
renderPlotLegendCandle PlotCandle x y
pc (Rect Point
p1 Point
p2) = do
    PlotCandle x y -> Candle Double Double -> BackendProgram ()
forall x y.
PlotCandle x y -> Candle Double Double -> BackendProgram ()
drawCandle PlotCandle x y
pc2 (Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> Candle Double Double
forall x y. x -> y -> y -> y -> y -> y -> Candle x y
Candle (Double
xwidDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
1Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
4) Double
lo Double
open Double
mid Double
close Double
hi)
    PlotCandle x y -> Candle Double Double -> BackendProgram ()
forall x y.
PlotCandle x y -> Candle Double Double -> BackendProgram ()
drawCandle PlotCandle x y
pc2 (Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> Candle Double Double
forall x y. x -> y -> y -> y -> y -> y -> Candle x y
Candle (Double
xwidDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
2Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
3) Double
lo Double
close Double
mid Double
open Double
hi)
  where
    pc2 :: PlotCandle x y
pc2   = PlotCandle x y
pc { _plot_candle_width :: Double
_plot_candle_width = Double
2 }
    xwid :: Double
xwid  = Point -> Double
p_x Point
p1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Point -> Double
p_x Point
p2
    lo :: Double
lo    = Double -> Double -> Double
forall a. Ord a => a -> a -> a
max (Point -> Double
p_y Point
p1) (Point -> Double
p_y Point
p2)
    mid :: Double
mid   = (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
    hi :: Double
hi    = Double -> Double -> Double
forall a. Ord a => a -> a -> a
min (Point -> Double
p_y Point
p1) (Point -> Double
p_y Point
p2)
    open :: Double
open  = (Double
lo Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
mid) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2
    close :: Double
close = (Double
mid Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
hi) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2

instance Default (PlotCandle x y) where
  def :: PlotCandle x y
def = PlotCandle :: forall x y.
String
-> LineStyle
-> Bool
-> FillStyle
-> FillStyle
-> Double
-> Double
-> Double
-> [Candle x y]
-> PlotCandle x y
PlotCandle 
    { _plot_candle_title :: String
_plot_candle_title       = String
""
    , _plot_candle_line_style :: LineStyle
_plot_candle_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_candle_fill :: Bool
_plot_candle_fill        = Bool
False
    , _plot_candle_rise_fill_style :: FillStyle
_plot_candle_rise_fill_style  = AlphaColour Double -> FillStyle
solidFillStyle (AlphaColour Double -> FillStyle)
-> AlphaColour Double -> FillStyle
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
white
    , _plot_candle_fall_fill_style :: FillStyle
_plot_candle_fall_fill_style  = AlphaColour Double -> FillStyle
solidFillStyle (AlphaColour Double -> FillStyle)
-> AlphaColour Double -> FillStyle
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_candle_tick_length :: Double
_plot_candle_tick_length = Double
2
    , _plot_candle_width :: Double
_plot_candle_width       = Double
5
    , _plot_candle_centre :: Double
_plot_candle_centre      = Double
0
    , _plot_candle_values :: [Candle x y]
_plot_candle_values      = []
    }

$( makeLenses ''PlotCandle )