-----------------------------------------------------------------------------
-- |
-- Module      :  Graphics.Rendering.Chart.Plot.Bars
-- Copyright   :  (c) Tim Docker 2006, 2014
-- License     :  BSD-style (see chart/COPYRIGHT)
--
-- Bar Charts
--
{-# LANGUAGE TemplateHaskell #-}

module Graphics.Rendering.Chart.Plot.Bars(
    PlotBars(..),
    PlotBarsStyle(..),
    PlotBarsSpacing(..),
    PlotBarsAlignment(..),
    BarsPlotValue(..),

    plotBars,
    plot_bars_style,
    plot_bars_item_styles,
    plot_bars_titles,
    plot_bars_spacing,
    plot_bars_alignment,
    plot_bars_reference,
    plot_bars_singleton_width,
    plot_bars_values,

) where

import Control.Lens
import Control.Monad
import Data.List(nub,sort)
import Graphics.Rendering.Chart.Geometry hiding (x0, y0)
import Graphics.Rendering.Chart.Drawing
import Graphics.Rendering.Chart.Plot.Types
import Graphics.Rendering.Chart.Axis
import Data.Colour (opaque)
import Data.Colour.Names (black)
import Data.Default.Class

class PlotValue a => BarsPlotValue a where
    barsReference :: a
    barsAdd       :: a -> a -> a

instance BarsPlotValue Double where
    barsReference :: Double
barsReference = Double
0
    barsAdd :: Double -> Double -> Double
barsAdd       = Double -> Double -> Double
forall a. Num a => a -> a -> a
(+)
instance BarsPlotValue Int where
    barsReference :: Int
barsReference = Int
0
    barsAdd :: Int -> Int -> Int
barsAdd       = Int -> Int -> Int
forall a. Num a => a -> a -> a
(+)

data PlotBarsStyle
    = BarsStacked   -- ^ Bars for a fixed x are stacked vertically
                    --   on top of each other.
    | BarsClustered -- ^ Bars for a fixed x are put horizontally
                    --   beside each other.
     deriving (Int -> PlotBarsStyle -> ShowS
[PlotBarsStyle] -> ShowS
PlotBarsStyle -> String
(Int -> PlotBarsStyle -> ShowS)
-> (PlotBarsStyle -> String)
-> ([PlotBarsStyle] -> ShowS)
-> Show PlotBarsStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PlotBarsStyle] -> ShowS
$cshowList :: [PlotBarsStyle] -> ShowS
show :: PlotBarsStyle -> String
$cshow :: PlotBarsStyle -> String
showsPrec :: Int -> PlotBarsStyle -> ShowS
$cshowsPrec :: Int -> PlotBarsStyle -> ShowS
Show)

data PlotBarsSpacing
    = BarsFixWidth Double       -- ^ All bars have the same width in pixels.
    | BarsFixGap Double Double  -- ^ (BarsFixGap g mw) means make the gaps between
                                --   the bars equal to g, but with a minimum bar width
                                --   of mw
     deriving (Int -> PlotBarsSpacing -> ShowS
[PlotBarsSpacing] -> ShowS
PlotBarsSpacing -> String
(Int -> PlotBarsSpacing -> ShowS)
-> (PlotBarsSpacing -> String)
-> ([PlotBarsSpacing] -> ShowS)
-> Show PlotBarsSpacing
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PlotBarsSpacing] -> ShowS
$cshowList :: [PlotBarsSpacing] -> ShowS
show :: PlotBarsSpacing -> String
$cshow :: PlotBarsSpacing -> String
showsPrec :: Int -> PlotBarsSpacing -> ShowS
$cshowsPrec :: Int -> PlotBarsSpacing -> ShowS
Show)

-- | How bars for a given (x,[y]) are aligned with respect to screen
--   coordinate corresponding to x (deviceX).
data PlotBarsAlignment = BarsLeft      -- ^ The left edge of bars is at deviceX
                       | BarsCentered  -- ^ Bars are centered around deviceX
                       | BarsRight     -- ^ The right edge of bars is at deviceX
     deriving (Int -> PlotBarsAlignment -> ShowS
[PlotBarsAlignment] -> ShowS
PlotBarsAlignment -> String
(Int -> PlotBarsAlignment -> ShowS)
-> (PlotBarsAlignment -> String)
-> ([PlotBarsAlignment] -> ShowS)
-> Show PlotBarsAlignment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PlotBarsAlignment] -> ShowS
$cshowList :: [PlotBarsAlignment] -> ShowS
show :: PlotBarsAlignment -> String
$cshow :: PlotBarsAlignment -> String
showsPrec :: Int -> PlotBarsAlignment -> ShowS
$cshowsPrec :: Int -> PlotBarsAlignment -> ShowS
Show)

-- | Value describing how to plot a set of bars.
--   Note that the input data is typed [(x,[y])], ie for each x value
--   we plot several y values. Typically the size of each [y] list would
--   be the same.
data PlotBars x y = PlotBars {
   -- | This value specifies whether each value from [y] should be
   --   shown beside or above the previous value.
   PlotBars x y -> PlotBarsStyle
_plot_bars_style           :: PlotBarsStyle,

   -- | The style in which to draw each element of [y]. A fill style
   --   is required, and if a linestyle is given, each bar will be
   --   outlined.
   PlotBars x y -> [(FillStyle, Maybe LineStyle)]
_plot_bars_item_styles     :: [ (FillStyle,Maybe LineStyle) ],

   -- | The title of each element of [y]. These will be shown in the legend.
   PlotBars x y -> [String]
_plot_bars_titles          :: [String],

   -- | This value controls how the widths of the bars are
   --   calculated. Either the widths of the bars, or the gaps between
   --   them can be fixed.
   PlotBars x y -> PlotBarsSpacing
_plot_bars_spacing         :: PlotBarsSpacing,

   -- | This value controls how bars for a fixed x are aligned with
   --   respect to the device coordinate corresponding to x.
   PlotBars x y -> PlotBarsAlignment
_plot_bars_alignment       :: PlotBarsAlignment,

   -- | The starting level for the chart (normally 0).
   PlotBars x y -> y
_plot_bars_reference       :: y,

   PlotBars x y -> Double
_plot_bars_singleton_width :: Double,

   -- | The actual points to be plotted.
   PlotBars x y -> [(x, [y])]
_plot_bars_values          :: [ (x,[y]) ]
}

instance BarsPlotValue y => Default (PlotBars x y) where
  def :: PlotBars x y
def = PlotBars :: forall x y.
PlotBarsStyle
-> [(FillStyle, Maybe LineStyle)]
-> [String]
-> PlotBarsSpacing
-> PlotBarsAlignment
-> y
-> Double
-> [(x, [y])]
-> PlotBars x y
PlotBars
    { _plot_bars_style :: PlotBarsStyle
_plot_bars_style           = PlotBarsStyle
BarsClustered
    , _plot_bars_item_styles :: [(FillStyle, Maybe LineStyle)]
_plot_bars_item_styles     = [(FillStyle, Maybe LineStyle)] -> [(FillStyle, Maybe LineStyle)]
forall a. [a] -> [a]
cycle [(FillStyle, Maybe LineStyle)]
istyles
    , _plot_bars_titles :: [String]
_plot_bars_titles          = []
    , _plot_bars_spacing :: PlotBarsSpacing
_plot_bars_spacing         = Double -> Double -> PlotBarsSpacing
BarsFixGap Double
10 Double
2
    , _plot_bars_alignment :: PlotBarsAlignment
_plot_bars_alignment       = PlotBarsAlignment
BarsCentered
    , _plot_bars_values :: [(x, [y])]
_plot_bars_values          = []
    , _plot_bars_singleton_width :: Double
_plot_bars_singleton_width = Double
20
    , _plot_bars_reference :: y
_plot_bars_reference       = y
forall a. BarsPlotValue a => a
barsReference
    }
    where
      istyles :: [(FillStyle, Maybe LineStyle)]
istyles   = (AlphaColour Double -> (FillStyle, Maybe LineStyle))
-> [AlphaColour Double] -> [(FillStyle, Maybe LineStyle)]
forall a b. (a -> b) -> [a] -> [b]
map AlphaColour Double -> (FillStyle, Maybe LineStyle)
mkstyle [AlphaColour Double]
defaultColorSeq
      mkstyle :: AlphaColour Double -> (FillStyle, Maybe LineStyle)
mkstyle AlphaColour Double
c = (AlphaColour Double -> FillStyle
solidFillStyle AlphaColour Double
c, LineStyle -> Maybe LineStyle
forall a. a -> Maybe a
Just (Double -> AlphaColour Double -> LineStyle
solidLine Double
1.0 (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. Num a => Colour a
black))

plotBars :: (BarsPlotValue y) => PlotBars x y -> Plot x y
plotBars :: PlotBars x y -> Plot x y
plotBars PlotBars 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     = PlotBars x y -> PointMapFn x y -> BackendProgram ()
forall y x.
BarsPlotValue y =>
PlotBars x y -> PointMapFn x y -> BackendProgram ()
renderPlotBars PlotBars x y
p,
        _plot_legend :: [(String, Rect -> BackendProgram ())]
_plot_legend     = [String]
-> [Rect -> BackendProgram ()]
-> [(String, Rect -> BackendProgram ())]
forall a b. [a] -> [b] -> [(a, b)]
zip (PlotBars x y -> [String]
forall x y. PlotBars x y -> [String]
_plot_bars_titles PlotBars x y
p)
                               (((FillStyle, Maybe LineStyle) -> Rect -> BackendProgram ())
-> [(FillStyle, Maybe LineStyle)] -> [Rect -> BackendProgram ()]
forall a b. (a -> b) -> [a] -> [b]
map (FillStyle, Maybe LineStyle) -> Rect -> BackendProgram ()
renderPlotLegendBars
                                    (PlotBars x y -> [(FillStyle, Maybe LineStyle)]
forall x y. PlotBars x y -> [(FillStyle, Maybe LineStyle)]
_plot_bars_item_styles PlotBars x y
p)),
        _plot_all_points :: ([x], [y])
_plot_all_points = PlotBars x y -> ([x], [y])
forall y x. BarsPlotValue y => PlotBars x y -> ([x], [y])
allBarPoints PlotBars x y
p
    }

renderPlotBars :: (BarsPlotValue y) => PlotBars x y -> PointMapFn x y -> BackendProgram ()
renderPlotBars :: PlotBars x y -> PointMapFn x y -> BackendProgram ()
renderPlotBars PlotBars x y
p PointMapFn x y
pmap = case PlotBars x y -> PlotBarsStyle
forall x y. PlotBars x y -> PlotBarsStyle
_plot_bars_style PlotBars x y
p of
      PlotBarsStyle
BarsClustered -> [(x, [y])] -> ((x, [y]) -> BackendProgram ()) -> BackendProgram ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(x, [y])]
vals (x, [y]) -> BackendProgram ()
clusteredBars
      PlotBarsStyle
BarsStacked   -> [(x, [y])] -> ((x, [y]) -> BackendProgram ()) -> BackendProgram ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(x, [y])]
vals (x, [y]) -> BackendProgram ()
stackedBars
  where
    clusteredBars :: (x, [y]) -> BackendProgram ()
clusteredBars (x
x,[y]
ys) = do
       [(Int, y, (FillStyle, Maybe LineStyle))]
-> ((Int, y, (FillStyle, Maybe LineStyle)) -> BackendProgram ())
-> BackendProgram ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Int]
-> [y]
-> [(FillStyle, Maybe LineStyle)]
-> [(Int, y, (FillStyle, Maybe LineStyle))]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Int
0,Int
1..] [y]
ys [(FillStyle, Maybe LineStyle)]
styles) (((Int, y, (FillStyle, Maybe LineStyle)) -> BackendProgram ())
 -> BackendProgram ())
-> ((Int, y, (FillStyle, Maybe LineStyle)) -> BackendProgram ())
-> BackendProgram ()
forall a b. (a -> b) -> a -> b
$ \(Int
i, y
y, (FillStyle
fstyle,Maybe LineStyle
_)) -> 
           FillStyle -> BackendProgram () -> BackendProgram ()
forall a. FillStyle -> BackendProgram a -> BackendProgram a
withFillStyle FillStyle
fstyle (BackendProgram () -> BackendProgram ())
-> BackendProgram () -> BackendProgram ()
forall a b. (a -> b) -> a -> b
$ 
             Path -> BackendProgram Path
alignFillPath (Double -> x -> y -> y -> Path
barPath (Int -> Double
offset Int
i) x
x y
yref0 y
y)
             BackendProgram Path
-> (Path -> BackendProgram ()) -> BackendProgram ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Path -> BackendProgram ()
fillPath
       [(Int, y, (FillStyle, Maybe LineStyle))]
-> ((Int, y, (FillStyle, Maybe LineStyle)) -> BackendProgram ())
-> BackendProgram ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Int]
-> [y]
-> [(FillStyle, Maybe LineStyle)]
-> [(Int, y, (FillStyle, Maybe LineStyle))]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Int
0,Int
1..] [y]
ys [(FillStyle, Maybe LineStyle)]
styles) (((Int, y, (FillStyle, Maybe LineStyle)) -> BackendProgram ())
 -> BackendProgram ())
-> ((Int, y, (FillStyle, Maybe LineStyle)) -> BackendProgram ())
-> BackendProgram ()
forall a b. (a -> b) -> a -> b
$ \(Int
i, y
y, (FillStyle
_,Maybe LineStyle
mlstyle)) -> 
           Maybe LineStyle
-> (LineStyle -> BackendProgram ()) -> BackendProgram ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe LineStyle
mlstyle ((LineStyle -> BackendProgram ()) -> BackendProgram ())
-> (LineStyle -> BackendProgram ()) -> BackendProgram ()
forall a b. (a -> b) -> a -> b
$ \LineStyle
lstyle -> 
             LineStyle -> BackendProgram () -> BackendProgram ()
forall a. LineStyle -> BackendProgram a -> BackendProgram a
withLineStyle LineStyle
lstyle (BackendProgram () -> BackendProgram ())
-> BackendProgram () -> BackendProgram ()
forall a b. (a -> b) -> a -> b
$ 
               Path -> BackendProgram Path
alignStrokePath (Double -> x -> y -> y -> Path
barPath (Int -> Double
offset Int
i) x
x y
yref0 y
y)
               BackendProgram Path
-> (Path -> BackendProgram ()) -> BackendProgram ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Path -> BackendProgram ()
strokePath

    offset :: Int -> Double
offset = case PlotBars x y -> PlotBarsAlignment
forall x y. PlotBars x y -> PlotBarsAlignment
_plot_bars_alignment PlotBars x y
p of
      PlotBarsAlignment
BarsLeft     -> \Int
i -> Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
width
      PlotBarsAlignment
BarsRight    -> \Int
i -> Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
nys) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
width
      PlotBarsAlignment
BarsCentered -> \Int
i -> Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
nys) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
widthDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2

    stackedBars :: (x, [y]) -> BackendProgram ()
stackedBars (x
x,[y]
ys) = do
       let y2s :: [(y, y)]
y2s = [y] -> [y] -> [(y, y)]
forall a b. [a] -> [b] -> [(a, b)]
zip (y
yref0y -> [y] -> [y]
forall a. a -> [a] -> [a]
:[y] -> [y]
forall y. BarsPlotValue y => [y] -> [y]
stack [y]
ys) ([y] -> [y]
forall y. BarsPlotValue y => [y] -> [y]
stack [y]
ys)
       let ofs :: Double
ofs = case PlotBars x y -> PlotBarsAlignment
forall x y. PlotBars x y -> PlotBarsAlignment
_plot_bars_alignment PlotBars x y
p of
             PlotBarsAlignment
BarsLeft     -> Double
0
             PlotBarsAlignment
BarsRight    -> -Double
width
             PlotBarsAlignment
BarsCentered -> -(Double
widthDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2)
       [((y, y), (FillStyle, Maybe LineStyle))]
-> (((y, y), (FillStyle, Maybe LineStyle)) -> BackendProgram ())
-> BackendProgram ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([(y, y)]
-> [(FillStyle, Maybe LineStyle)]
-> [((y, y), (FillStyle, Maybe LineStyle))]
forall a b. [a] -> [b] -> [(a, b)]
zip [(y, y)]
y2s [(FillStyle, Maybe LineStyle)]
styles) ((((y, y), (FillStyle, Maybe LineStyle)) -> BackendProgram ())
 -> BackendProgram ())
-> (((y, y), (FillStyle, Maybe LineStyle)) -> BackendProgram ())
-> BackendProgram ()
forall a b. (a -> b) -> a -> b
$ \((y
y0,y
y1), (FillStyle
fstyle,Maybe LineStyle
_)) -> 
           FillStyle -> BackendProgram () -> BackendProgram ()
forall a. FillStyle -> BackendProgram a -> BackendProgram a
withFillStyle FillStyle
fstyle (BackendProgram () -> BackendProgram ())
-> BackendProgram () -> BackendProgram ()
forall a b. (a -> b) -> a -> b
$ 
             Path -> BackendProgram Path
alignFillPath (Double -> x -> y -> y -> Path
barPath Double
ofs x
x y
y0 y
y1)
             BackendProgram Path
-> (Path -> BackendProgram ()) -> BackendProgram ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Path -> BackendProgram ()
fillPath
       [((y, y), (FillStyle, Maybe LineStyle))]
-> (((y, y), (FillStyle, Maybe LineStyle)) -> BackendProgram ())
-> BackendProgram ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([(y, y)]
-> [(FillStyle, Maybe LineStyle)]
-> [((y, y), (FillStyle, Maybe LineStyle))]
forall a b. [a] -> [b] -> [(a, b)]
zip [(y, y)]
y2s [(FillStyle, Maybe LineStyle)]
styles) ((((y, y), (FillStyle, Maybe LineStyle)) -> BackendProgram ())
 -> BackendProgram ())
-> (((y, y), (FillStyle, Maybe LineStyle)) -> BackendProgram ())
-> BackendProgram ()
forall a b. (a -> b) -> a -> b
$ \((y
y0,y
y1), (FillStyle
_,Maybe LineStyle
mlstyle)) -> 
           Maybe LineStyle
-> (LineStyle -> BackendProgram ()) -> BackendProgram ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe LineStyle
mlstyle ((LineStyle -> BackendProgram ()) -> BackendProgram ())
-> (LineStyle -> BackendProgram ()) -> BackendProgram ()
forall a b. (a -> b) -> a -> b
$ \LineStyle
lstyle -> 
              LineStyle -> BackendProgram () -> BackendProgram ()
forall a. LineStyle -> BackendProgram a -> BackendProgram a
withLineStyle LineStyle
lstyle (BackendProgram () -> BackendProgram ())
-> BackendProgram () -> BackendProgram ()
forall a b. (a -> b) -> a -> b
$ 
                Path -> BackendProgram Path
alignStrokePath (Double -> x -> y -> y -> Path
barPath Double
ofs x
x y
y0 y
y1)
                BackendProgram Path
-> (Path -> BackendProgram ()) -> BackendProgram ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Path -> BackendProgram ()
strokePath

    barPath :: Double -> x -> y -> y -> Path
barPath Double
xos x
x y
y0 y
y1 = do
      let (Point Double
x' Double
y') = (x, y) -> Point
pmap' (x
x,y
y1)
      let (Point Double
_ Double
y0') = (x, y) -> Point
pmap' (x
x,y
y0)
      Rect -> Path
rectPath (Point -> Point -> Rect
Rect (Double -> Double -> Point
Point (Double
x'Double -> Double -> Double
forall a. Num a => a -> a -> a
+Double
xos) Double
y0') (Double -> Double -> Point
Point (Double
x'Double -> Double -> Double
forall a. Num a => a -> a -> a
+Double
xosDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
width) Double
y'))

    yref0 :: y
yref0 = PlotBars x y -> y
forall x y. PlotBars x y -> y
_plot_bars_reference PlotBars x y
p
    vals :: [(x, [y])]
vals  = PlotBars x y -> [(x, [y])]
forall x y. PlotBars x y -> [(x, [y])]
_plot_bars_values PlotBars x y
p
    width :: Double
width = case PlotBars x y -> PlotBarsSpacing
forall x y. PlotBars x y -> PlotBarsSpacing
_plot_bars_spacing PlotBars x y
p of
        BarsFixGap Double
gap Double
minw -> let w :: Double
w = Double -> Double -> Double
forall a. Ord a => a -> a -> a
max (Double
minXInterval Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
gap) Double
minw in
            case PlotBars x y -> PlotBarsStyle
forall x y. PlotBars x y -> PlotBarsStyle
_plot_bars_style PlotBars x y
p of
                PlotBarsStyle
BarsClustered -> Double
w Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nys
                PlotBarsStyle
BarsStacked -> Double
w
        BarsFixWidth Double
width' -> Double
width'
    styles :: [(FillStyle, Maybe LineStyle)]
styles = PlotBars x y -> [(FillStyle, Maybe LineStyle)]
forall x y. PlotBars x y -> [(FillStyle, Maybe LineStyle)]
_plot_bars_item_styles PlotBars x y
p

    minXInterval :: Double
minXInterval = let diffs :: [Double]
diffs = (Double -> Double -> Double) -> [Double] -> [Double] -> [Double]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (-) ([Double] -> [Double]
forall a. [a] -> [a]
tail [Double]
mxs) [Double]
mxs
                   in if [Double] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Double]
diffs
                        then PlotBars x y -> Double
forall x y. PlotBars x y -> Double
_plot_bars_singleton_width PlotBars x y
p
                        else [Double] -> Double
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Double]
diffs
      where
        xs :: [x]
xs  = ([x], [y]) -> [x]
forall a b. (a, b) -> a
fst (PlotBars x y -> ([x], [y])
forall y x. BarsPlotValue y => PlotBars x y -> ([x], [y])
allBarPoints PlotBars x y
p)
        mxs :: [Double]
mxs = [Double] -> [Double]
forall a. Eq a => [a] -> [a]
nub ([Double] -> [Double]) -> [Double] -> [Double]
forall a b. (a -> b) -> a -> b
$ [Double] -> [Double]
forall a. Ord a => [a] -> [a]
sort ([Double] -> [Double]) -> [Double] -> [Double]
forall a b. (a -> b) -> a -> b
$ (x -> Double) -> [x] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map x -> Double
mapX [x]
xs

    nys :: Int
nys    = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [ [y] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [y]
ys | (x
_,[y]
ys) <- [(x, [y])]
vals ]

    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
    mapX :: x -> Double
mapX x
x = Point -> Double
p_x ((x, y) -> Point
pmap' (x
x,y
forall a. BarsPlotValue a => a
barsReference))

whenJust :: (Monad m) => Maybe a -> (a -> m ()) -> m ()
whenJust :: Maybe a -> (a -> m ()) -> m ()
whenJust (Just a
a) a -> m ()
f = a -> m ()
f a
a
whenJust Maybe a
_        a -> m ()
_ = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

allBarPoints :: (BarsPlotValue y) => PlotBars x y -> ([x],[y])
allBarPoints :: PlotBars x y -> ([x], [y])
allBarPoints PlotBars x y
p = case PlotBars x y -> PlotBarsStyle
forall x y. PlotBars x y -> PlotBarsStyle
_plot_bars_style PlotBars x y
p of
    PlotBarsStyle
BarsClustered -> ( [x
x| (x
x,[y]
_) <- [(x, [y])]
pts], y
y0y -> [y] -> [y]
forall a. a -> [a] -> [a]
:[[y]] -> [y]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[y]
ys| (x
_,[y]
ys) <- [(x, [y])]
pts] )
    PlotBarsStyle
BarsStacked   -> ( [x
x| (x
x,[y]
_) <- [(x, [y])]
pts], y
y0y -> [y] -> [y]
forall a. a -> [a] -> [a]
:[[y]] -> [y]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[y] -> [y]
forall y. BarsPlotValue y => [y] -> [y]
stack [y]
ys | (x
_,[y]
ys) <- [(x, [y])]
pts] )
  where
    pts :: [(x, [y])]
pts = PlotBars x y -> [(x, [y])]
forall x y. PlotBars x y -> [(x, [y])]
_plot_bars_values PlotBars x y
p
    y0 :: y
y0  = PlotBars x y -> y
forall x y. PlotBars x y -> y
_plot_bars_reference PlotBars x y
p

stack :: (BarsPlotValue y) => [y] -> [y]
stack :: [y] -> [y]
stack = (y -> y -> y) -> [y] -> [y]
forall a. (a -> a -> a) -> [a] -> [a]
scanl1 y -> y -> y
forall a. BarsPlotValue a => a -> a -> a
barsAdd

renderPlotLegendBars :: (FillStyle,Maybe LineStyle) -> Rect -> BackendProgram ()
renderPlotLegendBars :: (FillStyle, Maybe LineStyle) -> Rect -> BackendProgram ()
renderPlotLegendBars (FillStyle
fstyle,Maybe LineStyle
_) Rect
r = 
  FillStyle -> BackendProgram () -> BackendProgram ()
forall a. FillStyle -> BackendProgram a -> BackendProgram a
withFillStyle FillStyle
fstyle (BackendProgram () -> BackendProgram ())
-> BackendProgram () -> BackendProgram ()
forall a b. (a -> b) -> a -> b
$ 
    Path -> BackendProgram ()
fillPath (Rect -> Path
rectPath Rect
r)

$( makeLenses ''PlotBars )