    {-# LANGUAGE TemplateHaskell, FlexibleInstances #-}

    module Graphics.Rendering.Chart.Plot.Histogram
      ( -- * Histograms
        PlotHist (..)
      , histToPlot
      , defaultPlotHist
      , defaultFloatPlotHist
      , defaultNormedPlotHist
      , histToBins
        -- * Accessors
      , plot_hist_title
      , plot_hist_bins
      , plot_hist_values
      , plot_hist_no_zeros
      , plot_hist_range
      , plot_hist_drop_lines
      , plot_hist_line_style
      , plot_hist_fill_style
      , plot_hist_norm_func
      ) where

    import Control.Monad (when)
    import Data.Monoid
    import Data.Maybe (fromMaybe)
    import qualified Data.Foldable as F
    import qualified Data.Vector as V

    import Control.Lens
    import Graphics.Rendering.Chart.Plot.Types
    import Graphics.Rendering.Chart.Geometry
    import Graphics.Rendering.Chart.Drawing
    import Data.Default.Class

    import Data.Colour (opaque)
    import Data.Colour.Names (blue)
    import Data.Colour.SRGB (sRGB)

    import Numeric.Histogram

    data PlotHist x y = PlotHist
        { -- | Plot title
          forall x y. PlotHist x y -> String
    _plot_hist_title                :: String

          -- | Number of bins
        , forall x y. PlotHist x y -> Int
    _plot_hist_bins                 :: Int

          -- | Values to histogram
        , forall x y. PlotHist x y -> [x]
    _plot_hist_values               :: [x]

          -- | Don't attempt to plot bins with zero counts. Useful when
          -- the y-axis is logarithmically scaled.
        , forall x y. PlotHist x y -> Bool
    _plot_hist_no_zeros             :: Bool

          -- | Override the range of the histogram. If @Nothing@ the
          -- range of @_plot_hist_values@ is used.
          --
          -- Note that any normalization is always computed over the full
          -- data set, including samples not falling in the histogram range.
        , forall x y. PlotHist x y -> Maybe (x, x)
    _plot_hist_range                :: Maybe (x,x)

          -- | Plot vertical lines between bins
        , forall x y. PlotHist x y -> Bool
    _plot_hist_drop_lines           :: Bool

          -- | Fill style of the bins
        , forall x y. PlotHist x y -> FillStyle
    _plot_hist_fill_style           :: FillStyle

          -- | Line style of the bin outlines
        , forall x y. PlotHist x y -> LineStyle
    _plot_hist_line_style           :: LineStyle

          -- | Normalization function
        , forall x y. PlotHist x y -> Double -> Int -> y
    _plot_hist_norm_func            :: Double -> Int -> y
        }

    instance Default (PlotHist x Int) where
        def :: PlotHist x Int
    def = PlotHist x Int
    forall x. PlotHist x Int
    defaultPlotHist

    -- | The default style is an unnormalized histogram of 20 bins.
    defaultPlotHist :: PlotHist x Int
    defaultPlotHist :: forall x. PlotHist x Int
    defaultPlotHist = PlotHist { _plot_hist_bins :: Int
    _plot_hist_bins        = Int
    20
                               , _plot_hist_title :: String
    _plot_hist_title       = String
    ""
                               , _plot_hist_values :: [x]
    _plot_hist_values      = []
                               , _plot_hist_no_zeros :: Bool
    _plot_hist_no_zeros    = Bool
    False
                               , _plot_hist_range :: Maybe (x, x)
    _plot_hist_range       = Maybe (x, x)
    forall a. Maybe a
    Nothing
                               , _plot_hist_drop_lines :: Bool
    _plot_hist_drop_lines  = Bool
    False
                               , _plot_hist_line_style :: LineStyle
    _plot_hist_line_style  = LineStyle
    defaultLineStyle
                               , _plot_hist_fill_style :: FillStyle
    _plot_hist_fill_style  = FillStyle
    defaultFillStyle
                               , _plot_hist_norm_func :: Double -> Int -> Int
    _plot_hist_norm_func   = (Int -> Int) -> Double -> Int -> Int
    forall a b. a -> b -> a
    const Int -> Int
    forall a. a -> a
    id
                               }

    -- | @defaultPlotHist@ but with real counts
    defaultFloatPlotHist :: PlotHist x Double
    defaultFloatPlotHist :: forall x. PlotHist x Double
    defaultFloatPlotHist = PlotHist x Int
    forall x. PlotHist x Int
    defaultPlotHist { _plot_hist_norm_func :: Double -> Int -> Double
    _plot_hist_norm_func = (Int -> Double) -> Double -> Int -> Double
    forall a b. a -> b -> a
    const Int -> Double
    forall a b. (Real a, Fractional b) => a -> b
    realToFrac }

    -- | @defaultPlotHist@ but normalized such that the integral of the
    -- histogram is one.
    defaultNormedPlotHist :: PlotHist x Double
    defaultNormedPlotHist :: forall x. PlotHist x Double
    defaultNormedPlotHist = PlotHist x Int
    forall x. PlotHist x Int
    defaultPlotHist { _plot_hist_norm_func :: Double -> Int -> Double
    _plot_hist_norm_func = \Double
    n Int
    y->Int -> Double
    forall a b. (Real a, Fractional b) => a -> b
    realToFrac Int
    y Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    / Double
    n }

    defaultFillStyle :: FillStyle
    defaultFillStyle :: FillStyle
    defaultFillStyle = AlphaColour Double -> FillStyle
    solidFillStyle (Colour Double -> AlphaColour Double
    forall a. Num a => Colour a -> AlphaColour a
    opaque (Colour Double -> AlphaColour Double)
    -> Colour Double -> AlphaColour Double
    forall a b. (a -> b) -> a -> b
    $ Double -> Double -> Double -> Colour Double
    forall b. (Ord b, Floating b) => b -> b -> b -> Colour b
    sRGB Double
    0.5 Double
    0.5 Double
    1.0)

    defaultLineStyle :: LineStyle
    defaultLineStyle :: LineStyle
    defaultLineStyle = (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)
         { _line_cap :: LineCap
    _line_cap  = LineCap
    LineCapButt
         , _line_join :: LineJoin
    _line_join = LineJoin
    LineJoinMiter
         }

    -- | Convert a @PlotHist@ to a @Plot@
    --
    -- N.B. In principle this should be Chart's @ToPlot@ class but unfortunately
    -- this does not allow us to set bounds on the x and y axis types, hence
    -- the need for this function.
    histToPlot :: (RealFrac x, Num y, Ord y) => PlotHist x y -> Plot x y
    histToPlot :: forall x y. (RealFrac x, Num y, Ord y) => PlotHist x y -> Plot x y
    histToPlot PlotHist x y
    p = Plot {
            _plot_render :: PointMapFn x y -> BackendProgram ()
    _plot_render      = PlotHist x y -> PointMapFn x y -> BackendProgram ()
    forall x y.
    (RealFrac x, Num y, Ord y) =>
    PlotHist x y -> PointMapFn x y -> BackendProgram ()
    renderPlotHist PlotHist x y
    p,
            _plot_legend :: [(String, Rect -> BackendProgram ())]
    _plot_legend      = [(PlotHist x y -> String
    forall x y. PlotHist x y -> String
    _plot_hist_title PlotHist x y
    p, PlotHist x y -> Rect -> BackendProgram ()
    forall x y. PlotHist x y -> Rect -> BackendProgram ()
    renderPlotLegendHist PlotHist x y
    p)],
            _plot_all_points :: ([x], [y])
    _plot_all_points  = [(x, y)] -> ([x], [y])
    forall a b. [(a, b)] -> ([a], [b])
    unzip
                                ([(x, y)] -> ([x], [y])) -> [(x, y)] -> ([x], [y])
    forall a b. (a -> b) -> a -> b
    $ (((x, x), y) -> [(x, y)]) -> [((x, x), y)] -> [(x, y)]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (\((x
    x1,x
    x2), y
    y)->[ (x
    x1,y
    y)
                                                            , (x
    x2,y
    y)
                                                            , (x
    x1,y
    0)
                                                            , (x
    x2,y
    0)
                                                            ])
                                ([((x, x), y)] -> [(x, y)]) -> [((x, x), y)] -> [(x, y)]
    forall a b. (a -> b) -> a -> b
    $ PlotHist x y -> [((x, x), y)]
    forall x y.
    (RealFrac x, Num y, Ord y) =>
    PlotHist x y -> [((x, x), y)]
    histToBins PlotHist x y
    p
        }

    buildHistPath :: (RealFrac x, Num y)
                  => PointMapFn x y -> [((x,x), y)] -> Path
    buildHistPath :: forall x y.
    (RealFrac x, Num y) =>
    PointMapFn x y -> [((x, x), y)] -> Path
    buildHistPath PointMapFn x y
    _ [] = Path
    End
    buildHistPath PointMapFn x y
    pmap [((x, x), y)]
    bins = Point -> Path -> Path
    MoveTo (x -> y -> Point
    pt x
    xb y
    0) ([((x, x), y)] -> Path
    go [((x, x), y)]
    bins)
        where go :: [((x, x), y)] -> Path
    go [((x
    x1,x
    x2),y
    y)]      = Point -> Path -> Path
    LineTo (x -> y -> Point
    pt x
    x1 y
    y)
                                    (Path -> Path) -> Path -> Path
    forall a b. (a -> b) -> a -> b
    $ Point -> Path -> Path
    LineTo (x -> y -> Point
    pt x
    x2 y
    y)
                                    (Path -> Path) -> Path -> Path
    forall a b. (a -> b) -> a -> b
    $ Point -> Path -> Path
    LineTo (x -> y -> Point
    pt x
    x2 y
    0)
                                    (Path -> Path) -> Path -> Path
    forall a b. (a -> b) -> a -> b
    $ Path
    End
              go (((x
    x1,x
    x2),y
    y):[((x, x), y)]
    rest) = Point -> Path -> Path
    LineTo (x -> y -> Point
    pt x
    x1 y
    y)
                                    (Path -> Path) -> Path -> Path
    forall a b. (a -> b) -> a -> b
    $ Point -> Path -> Path
    LineTo (x -> y -> Point
    pt x
    x2 y
    y)
                                    (Path -> Path) -> Path -> Path
    forall a b. (a -> b) -> a -> b
    $ [((x, x), y)] -> Path
    go [((x, x), y)]
    rest
              go []                 = Path
    End
              ((x
    xb,x
    _),y
    _) = [((x, x), y)] -> ((x, x), y)
    forall a. HasCallStack => [a] -> a
    head [((x, x), y)]
    bins
              pt :: x -> y -> Point
    pt x
    x y
    y = PointMapFn x y
    pmap (x -> Limit x
    forall a. a -> Limit a
    LValue x
    x, y -> Limit y
    forall a. a -> Limit a
    LValue y
    y)

    renderPlotHist :: (RealFrac x, Num y, Ord y)
                   => PlotHist x y -> PointMapFn x y -> BackendProgram ()
    renderPlotHist :: forall x y.
    (RealFrac x, Num y, Ord y) =>
    PlotHist x y -> PointMapFn x y -> BackendProgram ()
    renderPlotHist PlotHist x y
    p PointMapFn x y
    pmap
        | [((x, x), y)] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [((x, x), y)]
    bins = () -> BackendProgram ()
    forall a. a -> ProgramT ChartBackendInstr Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        | Bool
    otherwise = do
            FillStyle -> BackendProgram () -> BackendProgram ()
    forall a. FillStyle -> BackendProgram a -> BackendProgram a
    withFillStyle (PlotHist x y -> FillStyle
    forall x y. PlotHist x y -> FillStyle
    _plot_hist_fill_style PlotHist x y
    p) (BackendProgram () -> BackendProgram ())
    -> BackendProgram () -> BackendProgram ()
    forall a b. (a -> b) -> a -> b
    $
                Path -> BackendProgram Path
    alignFillPath (PointMapFn x y -> [((x, x), y)] -> Path
    forall x y.
    (RealFrac x, Num y) =>
    PointMapFn x y -> [((x, x), y)] -> Path
    buildHistPath PointMapFn x y
    pmap [((x, x), y)]
    bins) BackendProgram Path
    -> (Path -> BackendProgram ()) -> BackendProgram ()
    forall a b.
    ProgramT ChartBackendInstr Identity a
    -> (a -> ProgramT ChartBackendInstr Identity b)
    -> ProgramT ChartBackendInstr Identity b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Path -> BackendProgram ()
    fillPath
            LineStyle -> BackendProgram () -> BackendProgram ()
    forall a. LineStyle -> BackendProgram a -> BackendProgram a
    withLineStyle (PlotHist x y -> LineStyle
    forall x y. PlotHist x y -> LineStyle
    _plot_hist_line_style PlotHist x y
    p) (BackendProgram () -> BackendProgram ())
    -> BackendProgram () -> BackendProgram ()
    forall a b. (a -> b) -> a -> b
    $ do
                Bool -> BackendProgram () -> BackendProgram ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (PlotHist x y -> Bool
    forall x y. PlotHist x y -> Bool
    _plot_hist_drop_lines PlotHist x y
    p) (BackendProgram () -> BackendProgram ())
    -> BackendProgram () -> BackendProgram ()
    forall a b. (a -> b) -> a -> b
    $
                    Path -> BackendProgram Path
    alignStrokePath Path
    dropLinesPath BackendProgram Path
    -> (Path -> BackendProgram ()) -> BackendProgram ()
    forall a b.
    ProgramT ChartBackendInstr Identity a
    -> (a -> ProgramT ChartBackendInstr Identity b)
    -> ProgramT ChartBackendInstr Identity b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Path -> BackendProgram ()
    strokePath
                Path -> BackendProgram Path
    alignStrokePath (PointMapFn x y -> [((x, x), y)] -> Path
    forall x y.
    (RealFrac x, Num y) =>
    PointMapFn x y -> [((x, x), y)] -> Path
    buildHistPath PointMapFn x y
    pmap [((x, x), y)]
    bins) BackendProgram Path
    -> (Path -> BackendProgram ()) -> BackendProgram ()
    forall a b.
    ProgramT ChartBackendInstr Identity a
    -> (a -> ProgramT ChartBackendInstr Identity b)
    -> ProgramT ChartBackendInstr Identity b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Path -> BackendProgram ()
    strokePath
        where bins :: [((x, x), y)]
    bins = PlotHist x y -> [((x, x), y)]
    forall x y.
    (RealFrac x, Num y, Ord y) =>
    PlotHist x y -> [((x, x), y)]
    histToBins PlotHist x y
    p
              pt :: x -> y -> Point
    pt x
    x y
    y = PointMapFn x y
    pmap (x -> Limit x
    forall a. a -> Limit a
    LValue x
    x, y -> Limit y
    forall a. a -> Limit a
    LValue y
    y)
              dropLinesPath :: Path
    dropLinesPath = (((x, x), y) -> Path) -> [((x, x), y)] -> Path
    forall m a. Monoid m => (a -> m) -> [a] -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    F.foldMap (\((x
    x1,x
    _), y
    y)->Point -> Path
    moveTo (x -> y -> Point
    pt x
    x1 y
    0)
                                                    Path -> Path -> Path
    forall a. Semigroup a => a -> a -> a
    <> Point -> Path
    lineTo (x -> y -> Point
    pt x
    x1 y
    y)
                                        ) ([((x, x), y)] -> Path) -> [((x, x), y)] -> Path
    forall a b. (a -> b) -> a -> b
    $ [((x, x), y)] -> [((x, x), y)]
    forall a. HasCallStack => [a] -> [a]
    tail [((x, x), y)]
    bins

    renderPlotLegendHist :: PlotHist x y -> Rect -> BackendProgram ()
    renderPlotLegendHist :: forall x y. PlotHist x y -> Rect -> BackendProgram ()
    renderPlotLegendHist PlotHist x y
    p (Rect Point
    p1 Point
    p2) =
        LineStyle -> BackendProgram () -> BackendProgram ()
    forall a. LineStyle -> BackendProgram a -> BackendProgram a
    withLineStyle (PlotHist x y -> LineStyle
    forall x y. PlotHist x y -> LineStyle
    _plot_hist_line_style PlotHist x y
    p) (BackendProgram () -> BackendProgram ())
    -> BackendProgram () -> BackendProgram ()
    forall a b. (a -> b) -> a -> b
    $
            let 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
            in Path -> BackendProgram ()
    strokePath (Path -> BackendProgram ()) -> Path -> BackendProgram ()
    forall a b. (a -> b) -> a -> b
    $ Double -> Double -> Path
    moveTo' (Point -> Double
    p_x Point
    p1) Double
    y Path -> Path -> Path
    forall a. Semigroup a => a -> a -> a
    <> Double -> Double -> Path
    lineTo' (Point -> Double
    p_x Point
    p2) Double
    y

    -- | Obtain the bin dimensions of a given @PlotHist@.
    histToBins :: (RealFrac x, Num y, Ord y) => PlotHist x y -> [((x,x), y)]
    histToBins :: forall x y.
    (RealFrac x, Num y, Ord y) =>
    PlotHist x y -> [((x, x), y)]
    histToBins PlotHist x y
    hist =
        [((x, x), y)] -> [((x, x), y)]
    forall {a}. [(a, y)] -> [(a, y)]
    filter_zeros ([((x, x), y)] -> [((x, x), y)]) -> [((x, x), y)] -> [((x, x), y)]
    forall a b. (a -> b) -> a -> b
    $ [(x, x)] -> [y] -> [((x, x), y)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [(x, x)]
    bounds ([y] -> [((x, x), y)]) -> [y] -> [((x, x), y)]
    forall a b. (a -> b) -> a -> b
    $ [y]
    counts
        where n :: Int
    n = PlotHist x y -> Int
    forall x y. PlotHist x y -> Int
    _plot_hist_bins PlotHist x y
    hist
              (x
    a,x
    b) = PlotHist x y -> (x, x)
    forall x y. RealFrac x => PlotHist x y -> (x, x)
    realHistRange PlotHist x y
    hist
              dx :: Double
    dx = x -> Double
    forall a b. (Real a, Fractional b) => a -> b
    realToFrac (x
    bx -> x -> x
    forall a. Num a => a -> a -> a
    -x
    a) Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    / Int -> Double
    forall a b. (Real a, Fractional b) => a -> b
    realToFrac Int
    n
              bounds :: [(x, x)]
    bounds = x -> x -> Int -> [(x, x)]
    forall a. RealFrac a => a -> a -> Int -> [Range a]
    binBounds x
    a x
    b Int
    n
              values :: Vector x
    values = [x] -> Vector x
    forall a. [a] -> Vector a
    V.fromList (PlotHist x y -> [x]
    forall x y. PlotHist x y -> [x]
    _plot_hist_values PlotHist x y
    hist)
              filter_zeros :: [(a, y)] -> [(a, y)]
    filter_zeros | PlotHist x y -> Bool
    forall x y. PlotHist x y -> Bool
    _plot_hist_no_zeros PlotHist x y
    hist  = ((a, y) -> Bool) -> [(a, y)] -> [(a, y)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (\(a
    _,y
    c)->y
    c y -> y -> Bool
    forall a. Ord a => a -> a -> Bool
    > y
    0)
                           | Bool
    otherwise                 = [(a, y)] -> [(a, y)]
    forall a. a -> a
    id
              norm :: Double
    norm = Double
    dx Double -> Double -> Double
    forall a. Num a => a -> a -> a
    * Int -> Double
    forall a b. (Real a, Fractional b) => a -> b
    realToFrac (Vector x -> Int
    forall a. Vector a -> Int
    V.length Vector x
    values)
              normalize :: Int -> y
    normalize = PlotHist x y -> Double -> Int -> y
    forall x y. PlotHist x y -> Double -> Int -> y
    _plot_hist_norm_func PlotHist x y
    hist Double
    norm
              counts :: [y]
    counts = Vector y -> [y]
    forall a. Vector a -> [a]
    V.toList (Vector y -> [y]) -> Vector y -> [y]
    forall a b. (a -> b) -> a -> b
    $ (((x, x), Int) -> y) -> Vector ((x, x), Int) -> Vector y
    forall a b. (a -> b) -> Vector a -> Vector b
    V.map (Int -> y
    normalize (Int -> y) -> (((x, x), Int) -> Int) -> ((x, x), Int) -> y
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((x, x), Int) -> Int
    forall a b. (a, b) -> b
    snd)
                       (Vector ((x, x), Int) -> Vector y)
    -> Vector ((x, x), Int) -> Vector y
    forall a b. (a -> b) -> a -> b
    $ Vector (x, x) -> [(Int, x)] -> Vector ((x, x), Int)
    forall w a.
    (Num w, RealFrac a) =>
    Vector (Range a) -> [(w, a)] -> Vector (Range a, w)
    histWithBins ([(x, x)] -> Vector (x, x)
    forall a. [a] -> Vector a
    V.fromList [(x, x)]
    bounds)
                       ([(Int, x)] -> Vector ((x, x), Int))
    -> [(Int, x)] -> Vector ((x, x), Int)
    forall a b. (a -> b) -> a -> b
    $ [Int] -> [x] -> [(Int, x)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip (Int -> [Int]
    forall a. a -> [a]
    repeat Int
    1) (Vector x -> [x]
    forall a. Vector a -> [a]
    V.toList Vector x
    values)

    realHistRange :: (RealFrac x) => PlotHist x y -> (x,x)
    realHistRange :: forall x y. RealFrac x => PlotHist x y -> (x, x)
    realHistRange PlotHist x y
    hist = (x, x) -> Maybe (x, x) -> (x, x)
    forall a. a -> Maybe a -> a
    fromMaybe (x, x)
    range (Maybe (x, x) -> (x, x)) -> Maybe (x, x) -> (x, x)
    forall a b. (a -> b) -> a -> b
    $ PlotHist x y -> Maybe (x, x)
    forall x y. PlotHist x y -> Maybe (x, x)
    _plot_hist_range PlotHist x y
    hist
        where values :: Vector x
    values = [x] -> Vector x
    forall a. [a] -> Vector a
    V.fromList (PlotHist x y -> [x]
    forall x y. PlotHist x y -> [x]
    _plot_hist_values PlotHist x y
    hist)
              range :: (x, x)
    range = if Vector x -> Bool
    forall a. Vector a -> Bool
    V.null Vector x
    values
                        then (x
    0,x
    0)
                        else (Vector x -> x
    forall a. Ord a => Vector a -> a
    V.minimum Vector x
    values, Vector x -> x
    forall a. Ord a => Vector a -> a
    V.maximum Vector x
    values)

    $( makeLenses ''PlotHist )