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

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

    plotBars,
    plotHBars,

    plot_bars_style,
    plot_bars_item_styles,
    plot_bars_titles,
    plot_bars_spacing,
    plot_bars_alignment,
    plot_bars_singleton_width,
    plot_bars_label_bar_hanchor,
    plot_bars_label_bar_vanchor,
    plot_bars_label_text_hanchor,
    plot_bars_label_text_vanchor,
    plot_bars_label_angle,
    plot_bars_label_style,
    plot_bars_label_offset,

    plot_bars_values,

    plot_bars_settings,
    plot_bars_values_with_labels,

    addLabels
) where

import Control.Arrow
import Control.Lens
import Control.Monad
import Data.Colour (opaque)
import Data.Colour.Names (black)
import Data.Default.Class
import Data.Tuple(swap)
import Data.List(nub,sort)
import Graphics.Rendering.Chart.Axis
import Graphics.Rendering.Chart.Drawing
import Graphics.Rendering.Chart.Geometry hiding (x0, y0)
import Graphics.Rendering.Chart.Plot.Types
import Graphics.Rendering.Chart.Utils
class PlotValue a => BarsPlotValue a where
    barsIsNull    :: a -> Bool
    -- | The starting level for the chart, a function of some statistic
    --   (normally the lowest value or just const 0).
    barsReference :: [a] -> a
    barsAdd       :: a -> a -> a

instance BarsPlotValue Double where
    barsIsNull :: Double -> Bool
barsIsNull Double
a  = Double
a forall a. Eq a => a -> a -> Bool
== Double
0.0
    barsReference :: [Double] -> Double
barsReference = forall a b. a -> b -> a
const Double
0
    barsAdd :: Double -> Double -> Double
barsAdd       = forall a. Num a => a -> a -> a
(+)

instance BarsPlotValue Int where
    barsIsNull :: Int -> Bool
barsIsNull Int
a  = Int
a forall a. Eq a => a -> a -> Bool
== Int
0
    barsReference :: [Int] -> Int
barsReference = forall a b. a -> b -> a
const Int
0
    barsAdd :: Int -> Int -> Int
barsAdd       = forall a. Num a => a -> a -> a
(+)

instance BarsPlotValue LogValue where
    barsIsNull :: LogValue -> Bool
barsIsNull (LogValue Double
a) = Double
a forall a. Eq a => a -> a -> Bool
== Double
0.0
    barsReference :: [LogValue] -> LogValue
barsReference [LogValue]
as        =
      LogValue
10.0 forall a b. (Fractional a, Integral b) => a -> b -> a
^^ (forall a b. (RealFrac a, Integral b) => a -> b
floor (forall a. Floating a => a -> a
log10 forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= LogValue
0.0) [LogValue]
as) :: Integer)
    barsAdd :: LogValue -> LogValue -> LogValue
barsAdd                 = 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
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
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
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)

data BarHorizAnchor
    = BHA_Left
    | BHA_Centre
    | BHA_Right
     deriving (Int -> BarHorizAnchor -> ShowS
[BarHorizAnchor] -> ShowS
BarHorizAnchor -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BarHorizAnchor] -> ShowS
$cshowList :: [BarHorizAnchor] -> ShowS
show :: BarHorizAnchor -> String
$cshow :: BarHorizAnchor -> String
showsPrec :: Int -> BarHorizAnchor -> ShowS
$cshowsPrec :: Int -> BarHorizAnchor -> ShowS
Show)

data BarVertAnchor
    = BVA_Bottom
    | BVA_Centre
    | BVA_Top
     deriving (Int -> BarVertAnchor -> ShowS
[BarVertAnchor] -> ShowS
BarVertAnchor -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BarVertAnchor] -> ShowS
$cshowList :: [BarVertAnchor] -> ShowS
show :: BarVertAnchor -> String
$cshow :: BarVertAnchor -> String
showsPrec :: Int -> BarVertAnchor -> ShowS
$cshowsPrec :: Int -> BarVertAnchor -> 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 BarsSettings = BarsSettings {
   -- | This value specifies whether each value from [y] should be
   --   shown beside or above the previous value.
   BarsSettings -> PlotBarsStyle
_bars_settings_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.
   BarsSettings -> [(FillStyle, Maybe LineStyle)]
_bars_settings_item_styles     :: [ (FillStyle,Maybe LineStyle) ],

   -- | 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.
   BarsSettings -> PlotBarsSpacing
_bars_settings_spacing         :: PlotBarsSpacing,

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

   BarsSettings -> Double
_bars_settings_singleton_width :: Double,

   -- | The point on the bar to horizontally anchor the label to
   BarsSettings -> BarHorizAnchor
_bars_settings_label_bar_hanchor :: BarHorizAnchor,

   -- | The point on the bar to vertically anchor the label to
   BarsSettings -> BarVertAnchor
_bars_settings_label_bar_vanchor  :: BarVertAnchor,

    -- | The anchor point on the label.
   BarsSettings -> HTextAnchor
_bars_settings_label_text_hanchor :: HTextAnchor,

    -- | The anchor point on the label.
   BarsSettings -> VTextAnchor
_bars_settings_label_text_vanchor :: VTextAnchor,

   -- | Angle, in degrees, to rotate the label about the anchor point.
   BarsSettings -> Double
_bars_settings_label_angle   :: Double,

   -- | The style to use for the label.
   BarsSettings -> FontStyle
_bars_settings_label_style   :: FontStyle,

   -- | The offset from the anchor point to display the label at.
   BarsSettings -> Vector
_bars_settings_label_offset  :: Vector
}
instance Default BarsSettings where
  def :: BarsSettings
def = BarsSettings
    { _bars_settings_style :: PlotBarsStyle
_bars_settings_style              = PlotBarsStyle
BarsClustered
    , _bars_settings_item_styles :: [(FillStyle, Maybe LineStyle)]
_bars_settings_item_styles        = forall a. [a] -> [a]
cycle [(FillStyle, Maybe LineStyle)]
istyles
    , _bars_settings_spacing :: PlotBarsSpacing
_bars_settings_spacing            = Double -> Double -> PlotBarsSpacing
BarsFixGap Double
10 Double
2
    , _bars_settings_alignment :: PlotBarsAlignment
_bars_settings_alignment          = PlotBarsAlignment
BarsCentered
    , _bars_settings_singleton_width :: Double
_bars_settings_singleton_width    = Double
20
    , _bars_settings_label_bar_hanchor :: BarHorizAnchor
_bars_settings_label_bar_hanchor  = BarHorizAnchor
BHA_Centre
    , _bars_settings_label_bar_vanchor :: BarVertAnchor
_bars_settings_label_bar_vanchor  = BarVertAnchor
BVA_Top
    , _bars_settings_label_text_hanchor :: HTextAnchor
_bars_settings_label_text_hanchor = HTextAnchor
HTA_Centre
    , _bars_settings_label_text_vanchor :: VTextAnchor
_bars_settings_label_text_vanchor = VTextAnchor
VTA_Bottom
    , _bars_settings_label_angle :: Double
_bars_settings_label_angle        = Double
0
    , _bars_settings_label_style :: FontStyle
_bars_settings_label_style        = forall a. Default a => a
def
    , _bars_settings_label_offset :: Vector
_bars_settings_label_offset       = Double -> Double -> Vector
Vector Double
0 Double
0
    }
    where
      istyles :: [(FillStyle, Maybe LineStyle)]
istyles   = 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, forall a. a -> Maybe a
Just (Double -> AlphaColour Double -> LineStyle
solidLine Double
1.0 forall a b. (a -> b) -> a -> b
$ forall a. Num a => Colour a -> AlphaColour a
opaque forall a. Num a => Colour a
black))
data PlotBars x y = PlotBars {
   forall x y. PlotBars x y -> BarsSettings
_plot_bars_settings :: BarsSettings,
   -- | The title of each element of [y]. These will be shown in the legend.
   forall x y. PlotBars x y -> [String]
_plot_bars_titles :: [String],
   -- | The actual points to be plotted, and their labels
   forall x y. PlotBars x y -> [(x, [(y, String)])]
_plot_bars_values_with_labels :: [(x, [(y, String)])]
}
instance Default (PlotBars x y) where
  def :: PlotBars x y
def = PlotBars
    { _plot_bars_settings :: BarsSettings
_plot_bars_settings = forall a. Default a => a
def
    , _plot_bars_titles :: [String]
_plot_bars_titles = []
    , _plot_bars_values_with_labels :: [(x, [(y, String)])]
_plot_bars_values_with_labels = []
    }

plotBars :: (BarsPlotValue y) => PlotBars x y -> Plot x y
plotBars :: forall y x. BarsPlotValue y => PlotBars x y -> Plot x y
plotBars PlotBars x y
p = Plot {
        _plot_render :: PointMapFn x y -> BackendProgram ()
_plot_render     = \PointMapFn x y
pmap -> forall v k.
BarsPlotValue v =>
BarsSettings
-> [(k, [(v, String)])]
-> v
-> (Double -> Double -> k -> v -> v -> Rect)
-> (k -> Double)
-> BackendProgram ()
renderBars BarsSettings
s [(x, [(y, String)])]
vals y
yref0
                                      (forall {x} {y}.
PointMapFn x y -> Double -> Double -> x -> y -> y -> Rect
barRect PointMapFn x y
pmap) (forall {x}. PointMapFn x y -> x -> Double
mapX PointMapFn x y
pmap),
        _plot_legend :: [(String, Rect -> BackendProgram ())]
_plot_legend     = forall a b. [a] -> [b] -> [(a, b)]
zip (forall x y. PlotBars x y -> [String]
_plot_bars_titles PlotBars x y
p)
                               (forall a b. (a -> b) -> [a] -> [b]
map (FillStyle, Maybe LineStyle) -> Rect -> BackendProgram ()
renderPlotLegendBars
                                    (BarsSettings -> [(FillStyle, Maybe LineStyle)]
_bars_settings_item_styles BarsSettings
s)),
        _plot_all_points :: ([x], [y])
_plot_all_points = forall y x.
BarsPlotValue y =>
BarsSettings -> [(x, [(y, String)])] -> ([x], [y])
allBarPoints BarsSettings
s [(x, [(y, String)])]
vals
    }
  where
    s :: BarsSettings
s = forall x y. PlotBars x y -> BarsSettings
_plot_bars_settings PlotBars x y
p
    vals :: [(x, [(y, String)])]
vals = forall x y. PlotBars x y -> [(x, [(y, String)])]
_plot_bars_values_with_labels PlotBars x y
p
    yref0 :: y
yref0 = forall y x.
BarsPlotValue y =>
BarsSettings -> [(x, [(y, String)])] -> y
refVal BarsSettings
s [(x, [(y, String)])]
vals

    barRect :: PointMapFn x y -> Double -> Double -> x -> y -> y -> Rect
barRect PointMapFn x y
pmap Double
xos Double
width x
x y
y0 y
y1 = Point -> Point -> Rect
Rect (Double -> Double -> Point
Point (Double
x'forall a. Num a => a -> a -> a
+Double
xos) Double
y0') (Double -> Double -> Point
Point (Double
x'forall a. Num a => a -> a -> a
+Double
xosforall a. Num a => a -> a -> a
+Double
width) Double
y') where
      Point Double
x' Double
y' = forall x y. PointMapFn x y -> (x, y) -> Point
mapXY PointMapFn x y
pmap (x
x,y
y1)
      Point Double
_ Double
y0' = forall x y. PointMapFn x y -> (x, y) -> Point
mapXY PointMapFn x y
pmap (x
x,y
y0)

    mapX :: PointMapFn x y -> x -> Double
mapX PointMapFn x y
pmap x
x = Point -> Double
p_x (forall x y. PointMapFn x y -> (x, y) -> Point
mapXY PointMapFn x y
pmap (x
x, y
yref0))

plotHBars :: (BarsPlotValue x) => PlotBars y x -> Plot x y
plotHBars :: forall x y. BarsPlotValue x => PlotBars y x -> Plot x y
plotHBars PlotBars y x
p = Plot {
        _plot_render :: PointMapFn x y -> BackendProgram ()
_plot_render     = \PointMapFn x y
pmap -> forall v k.
BarsPlotValue v =>
BarsSettings
-> [(k, [(v, String)])]
-> v
-> (Double -> Double -> k -> v -> v -> Rect)
-> (k -> Double)
-> BackendProgram ()
renderBars BarsSettings
s [(y, [(x, String)])]
vals x
xref0
                                      (forall {x} {y}.
PointMapFn x y -> Double -> Double -> y -> x -> x -> Rect
barRect PointMapFn x y
pmap) (forall {y}. PointMapFn x y -> y -> Double
mapY PointMapFn x y
pmap),
        _plot_legend :: [(String, Rect -> BackendProgram ())]
_plot_legend     = forall a b. [a] -> [b] -> [(a, b)]
zip (forall x y. PlotBars x y -> [String]
_plot_bars_titles PlotBars y x
p)
                               (forall a b. (a -> b) -> [a] -> [b]
map (FillStyle, Maybe LineStyle) -> Rect -> BackendProgram ()
renderPlotLegendBars
                                    (BarsSettings -> [(FillStyle, Maybe LineStyle)]
_bars_settings_item_styles BarsSettings
s)),
        _plot_all_points :: ([x], [y])
_plot_all_points = forall a b. (a, b) -> (b, a)
swap forall a b. (a -> b) -> a -> b
$ forall y x.
BarsPlotValue y =>
BarsSettings -> [(x, [(y, String)])] -> ([x], [y])
allBarPoints BarsSettings
s [(y, [(x, String)])]
vals
    }
  where
    s :: BarsSettings
s = forall x y. PlotBars x y -> BarsSettings
_plot_bars_settings PlotBars y x
p
    vals :: [(y, [(x, String)])]
vals = forall x y. PlotBars x y -> [(x, [(y, String)])]
_plot_bars_values_with_labels PlotBars y x
p
    xref0 :: x
xref0 = forall y x.
BarsPlotValue y =>
BarsSettings -> [(x, [(y, String)])] -> y
refVal BarsSettings
s [(y, [(x, String)])]
vals

    barRect :: PointMapFn x y -> Double -> Double -> y -> x -> x -> Rect
barRect PointMapFn x y
pmap Double
yos Double
height y
y x
x0 x
x1 = Point -> Point -> Rect
Rect (Double -> Double -> Point
Point Double
x0' (Double
y'forall a. Num a => a -> a -> a
+Double
yos)) (Double -> Double -> Point
Point Double
x' (Double
y'forall a. Num a => a -> a -> a
+Double
yosforall a. Num a => a -> a -> a
+Double
height)) where
      Point Double
x' Double
y' = forall x y. PointMapFn x y -> (x, y) -> Point
mapXY PointMapFn x y
pmap (x
x1,y
y)
      Point Double
x0' Double
_ = forall x y. PointMapFn x y -> (x, y) -> Point
mapXY PointMapFn x y
pmap (x
x0,y
y)

    mapY :: PointMapFn x y -> y -> Double
mapY PointMapFn x y
pmap y
y = Point -> Double
p_y (forall x y. PointMapFn x y -> (x, y) -> Point
mapXY PointMapFn x y
pmap (x
xref0, y
y))

renderBars :: (BarsPlotValue v) =>
              BarsSettings
           -> [(k, [(v, String)])]
           -> v
           -> (Double -> Double -> k -> v -> v -> Rect)
           -> (k -> Double)
           -> BackendProgram ()
renderBars :: forall v k.
BarsPlotValue v =>
BarsSettings
-> [(k, [(v, String)])]
-> v
-> (Double -> Double -> k -> v -> v -> Rect)
-> (k -> Double)
-> BackendProgram ()
renderBars BarsSettings
p [(k, [(v, String)])]
vals v
vref0 Double -> Double -> k -> v -> v -> Rect
r k -> Double
mapk = case BarsSettings -> PlotBarsStyle
_bars_settings_style BarsSettings
p of
      PlotBarsStyle
BarsClustered -> forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(k, [(v, String)])]
vals (k, [(v, String)]) -> BackendProgram ()
clusteredBars
      PlotBarsStyle
BarsStacked   -> forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(k, [(v, String)])]
vals (k, [(v, String)]) -> BackendProgram ()
stackedBars
  where
    clusteredBars :: (k, [(v, String)]) -> BackendProgram ()
clusteredBars (k
k,[(v, String)]
vs) = do
       let offset :: Int -> Double
offset Int
i = case BarsSettings -> PlotBarsAlignment
_bars_settings_alignment BarsSettings
p of
             PlotBarsAlignment
BarsLeft     -> forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i forall a. Num a => a -> a -> a
* Double
bsize
             PlotBarsAlignment
BarsRight    -> forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
iforall a. Num a => a -> a -> a
-Int
nvs) forall a. Num a => a -> a -> a
* Double
bsize
             PlotBarsAlignment
BarsCentered -> forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
2forall a. Num a => a -> a -> a
*Int
iforall a. Num a => a -> a -> a
-Int
nvs) forall a. Num a => a -> a -> a
* Double
bsizeforall a. Fractional a => a -> a -> a
/Double
2
       forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Int
0,Int
1..] [(v, String)]
vs [(FillStyle, Maybe LineStyle)]
styles) forall a b. (a -> b) -> a -> b
$ \(Int
i, (v
v, String
_), (FillStyle
fstyle,Maybe LineStyle
_)) ->
           forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall a. BarsPlotValue a => a -> Bool
barsIsNull v
v) forall a b. (a -> b) -> a -> b
$
           forall a. FillStyle -> BackendProgram a -> BackendProgram a
withFillStyle FillStyle
fstyle forall a b. (a -> b) -> a -> b
$
             Path -> BackendProgram Path
alignFillPath (Double -> k -> v -> v -> Path
barPath (Int -> Double
offset Int
i) k
k v
vref0 v
v)
             forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Path -> BackendProgram ()
fillPath
       forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Int
0,Int
1..] [(v, String)]
vs [(FillStyle, Maybe LineStyle)]
styles) forall a b. (a -> b) -> a -> b
$ \(Int
i, (v
v, String
_), (FillStyle
_,Maybe LineStyle
mlstyle)) ->
           forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall a. BarsPlotValue a => a -> Bool
barsIsNull v
v) forall a b. (a -> b) -> a -> b
$
           forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe LineStyle
mlstyle forall a b. (a -> b) -> a -> b
$ \LineStyle
lstyle ->
             forall a. LineStyle -> BackendProgram a -> BackendProgram a
withLineStyle LineStyle
lstyle forall a b. (a -> b) -> a -> b
$
               Path -> BackendProgram Path
alignStrokePath (Double -> k -> v -> v -> Path
barPath (Int -> Double
offset Int
i) k
k v
vref0 v
v)
               forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Path -> BackendProgram ()
strokePath
       forall a. FontStyle -> BackendProgram a -> BackendProgram a
withFontStyle (BarsSettings -> FontStyle
_bars_settings_label_style BarsSettings
p) forall a b. (a -> b) -> a -> b
$
           forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0,Int
1..] [(v, String)]
vs) forall a b. (a -> b) -> a -> b
$ \(Int
i, (v
v, String
txt)) ->
             forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
txt) forall a b. (a -> b) -> a -> b
$ do
               let ha :: BarHorizAnchor
ha = BarsSettings -> BarHorizAnchor
_bars_settings_label_bar_hanchor BarsSettings
p
               let va :: BarVertAnchor
va = BarsSettings -> BarVertAnchor
_bars_settings_label_bar_vanchor BarsSettings
p
               let pt :: Point
pt = BarHorizAnchor -> BarVertAnchor -> Rect -> Point
rectCorner BarHorizAnchor
ha BarVertAnchor
va (Double -> Double -> k -> v -> v -> Rect
r (Int -> Double
offset Int
i) Double
bsize k
k v
vref0 v
v)
               HTextAnchor
-> VTextAnchor -> Double -> Point -> String -> BackendProgram ()
drawTextR
                  (BarsSettings -> HTextAnchor
_bars_settings_label_text_hanchor BarsSettings
p)
                  (BarsSettings -> VTextAnchor
_bars_settings_label_text_vanchor BarsSettings
p)
                  (BarsSettings -> Double
_bars_settings_label_angle BarsSettings
p)
                  (Point -> Vector -> Point
pvadd Point
pt forall a b. (a -> b) -> a -> b
$ BarsSettings -> Vector
_bars_settings_label_offset BarsSettings
p)
                  String
txt

    stackedBars :: (k, [(v, String)]) -> BackendProgram ()
stackedBars (k
k,[(v, String)]
vs) = do
       let ([v]
vs', [String]
lbls) = forall a b. [(a, b)] -> ([a], [b])
unzip [(v, String)]
vs
       let vs'' :: [v]
vs'' = forall a b. (a -> b) -> [a] -> [b]
map (\v
v -> if forall a. BarsPlotValue a => a -> Bool
barsIsNull v
v then v
vref0 else v
v) (forall y. BarsPlotValue y => [y] -> [y]
stack [v]
vs')
       let v2s :: [(v, v)]
v2s = forall a b. [a] -> [b] -> [(a, b)]
zip (v
vref0forall a. a -> [a] -> [a]
:[v]
vs'') [v]
vs''
       let ofs :: Double
ofs = case BarsSettings -> PlotBarsAlignment
_bars_settings_alignment BarsSettings
p of
             PlotBarsAlignment
BarsLeft     -> Double
0
             PlotBarsAlignment
BarsRight    -> -Double
bsize
             PlotBarsAlignment
BarsCentered -> -(Double
bsizeforall a. Fractional a => a -> a -> a
/Double
2)
       forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a b. [a] -> [b] -> [(a, b)]
zip [(v, v)]
v2s [(FillStyle, Maybe LineStyle)]
styles) forall a b. (a -> b) -> a -> b
$ \((v
v0,v
v1), (FillStyle
fstyle,Maybe LineStyle
_)) ->
           forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (v
v0 forall a. Ord a => a -> a -> Bool
>= v
v1) forall a b. (a -> b) -> a -> b
$
           forall a. FillStyle -> BackendProgram a -> BackendProgram a
withFillStyle FillStyle
fstyle forall a b. (a -> b) -> a -> b
$
             Path -> BackendProgram Path
alignFillPath (Double -> k -> v -> v -> Path
barPath Double
ofs k
k v
v0 v
v1)
             forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Path -> BackendProgram ()
fillPath
       forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a b. [a] -> [b] -> [(a, b)]
zip [(v, v)]
v2s [(FillStyle, Maybe LineStyle)]
styles) forall a b. (a -> b) -> a -> b
$ \((v
v0,v
v1), (FillStyle
_,Maybe LineStyle
mlstyle)) ->
           forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (v
v0 forall a. Ord a => a -> a -> Bool
>= v
v1) forall a b. (a -> b) -> a -> b
$
           forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe LineStyle
mlstyle forall a b. (a -> b) -> a -> b
$ \LineStyle
lstyle ->
              forall a. LineStyle -> BackendProgram a -> BackendProgram a
withLineStyle LineStyle
lstyle forall a b. (a -> b) -> a -> b
$
                Path -> BackendProgram Path
alignStrokePath (Double -> k -> v -> v -> Path
barPath Double
ofs k
k v
v0 v
v1)
                forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Path -> BackendProgram ()
strokePath
       forall a. FontStyle -> BackendProgram a -> BackendProgram a
withFontStyle (BarsSettings -> FontStyle
_bars_settings_label_style BarsSettings
p) forall a b. (a -> b) -> a -> b
$
           forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a b. [a] -> [b] -> [(a, b)]
zip [(v, v)]
v2s [String]
lbls) forall a b. (a -> b) -> a -> b
$ \((v
v0, v
v1), String
txt) ->
             forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
txt) forall a b. (a -> b) -> a -> b
$ do
               let ha :: BarHorizAnchor
ha = BarsSettings -> BarHorizAnchor
_bars_settings_label_bar_hanchor BarsSettings
p
               let va :: BarVertAnchor
va = BarsSettings -> BarVertAnchor
_bars_settings_label_bar_vanchor BarsSettings
p
               let pt :: Point
pt = BarHorizAnchor -> BarVertAnchor -> Rect -> Point
rectCorner BarHorizAnchor
ha BarVertAnchor
va (Double -> Double -> k -> v -> v -> Rect
r Double
ofs Double
bsize k
k v
v0 v
v1)
               HTextAnchor
-> VTextAnchor -> Double -> Point -> String -> BackendProgram ()
drawTextR
                  (BarsSettings -> HTextAnchor
_bars_settings_label_text_hanchor BarsSettings
p)
                  (BarsSettings -> VTextAnchor
_bars_settings_label_text_vanchor BarsSettings
p)
                  (BarsSettings -> Double
_bars_settings_label_angle BarsSettings
p)
                  (Point -> Vector -> Point
pvadd Point
pt forall a b. (a -> b) -> a -> b
$ BarsSettings -> Vector
_bars_settings_label_offset BarsSettings
p)
                  String
txt

    styles :: [(FillStyle, Maybe LineStyle)]
styles = BarsSettings -> [(FillStyle, Maybe LineStyle)]
_bars_settings_item_styles BarsSettings
p

    barPath :: Double -> k -> v -> v -> Path
barPath Double
os k
k v
v0 v
v1 = Rect -> Path
rectPath forall a b. (a -> b) -> a -> b
$ Double -> Double -> k -> v -> v -> Rect
r Double
os Double
bsize k
k v
v0 v
v1

    bsize :: Double
bsize = case BarsSettings -> PlotBarsSpacing
_bars_settings_spacing BarsSettings
p of
        BarsFixGap Double
gap Double
minw -> let w :: Double
w = forall a. Ord a => a -> a -> a
max (Double
minKInterval forall a. Num a => a -> a -> a
- Double
gap) Double
minw in
            case BarsSettings -> PlotBarsStyle
_bars_settings_style BarsSettings
p of
                PlotBarsStyle
BarsClustered -> Double
w forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nvs
                PlotBarsStyle
BarsStacked -> Double
w
        BarsFixWidth Double
width' -> Double
width'

    minKInterval :: Double
minKInterval = let diffs :: [Double]
diffs = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (-) (forall a. [a] -> [a]
tail [Double]
mks) [Double]
mks
                   in if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Double]
diffs
                        then BarsSettings -> Double
_bars_settings_singleton_width BarsSettings
p
                        else forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Double]
diffs
      where
        mks :: [Double]
mks = forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> [a]
sort forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (k -> Double
mapk forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(k, [(v, String)])]
vals

    nvs :: Int
nvs = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(k, [(v, String)])]
vals

rectCorner :: BarHorizAnchor -> BarVertAnchor -> Rect -> Point
rectCorner :: BarHorizAnchor -> BarVertAnchor -> Rect -> Point
rectCorner BarHorizAnchor
h BarVertAnchor
v (Rect (Point Double
x0 Double
y0) (Point Double
x1 Double
y1)) = Double -> Double -> Point
Point Double
x' Double
y' where
    x' :: Double
x' = case BarHorizAnchor
h of
              BarHorizAnchor
BHA_Left   -> Double
x0
              BarHorizAnchor
BHA_Right  -> Double
x1
              BarHorizAnchor
BHA_Centre -> (Double
x0 forall a. Num a => a -> a -> a
+ Double
x1) forall a. Fractional a => a -> a -> a
/ Double
2
    y' :: Double
y' = case BarVertAnchor
v of
              BarVertAnchor
BVA_Bottom -> Double
y0
              BarVertAnchor
BVA_Top    -> Double
y1
              BarVertAnchor
BVA_Centre -> (Double
y0 forall a. Num a => a -> a -> a
+ Double
y1) forall a. Fractional a => a -> a -> a
/ Double
2

-- Helper function for printing bar values as labels
addLabels :: Show y => [(x, [y])] -> [(x, [(y, String)])]
addLabels :: forall y x. Show y => [(x, [y])] -> [(x, [(y, String)])]
addLabels = forall a b. (a -> b) -> [a] -> [b]
map forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\y
y -> (y
y, forall a. Show a => a -> String
show y
y))

refVal :: (BarsPlotValue y) => BarsSettings -> [(x, [(y, String)])] -> y
refVal :: forall y x.
BarsPlotValue y =>
BarsSettings -> [(x, [(y, String)])] -> y
refVal BarsSettings
p [(x, [(y, String)])]
vals = forall a. BarsPlotValue a => [a] -> a
barsReference forall a b. (a -> b) -> a -> b
$ case BarsSettings -> PlotBarsStyle
_bars_settings_style BarsSettings
p of
    PlotBarsStyle
BarsClustered -> forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(x, [(y, String)])]
vals
    PlotBarsStyle
BarsStacked   -> forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a. Int -> [a] -> [a]
take Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile forall a. BarsPlotValue a => a -> Bool
barsIsNull forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall y. BarsPlotValue y => [y] -> [y]
stack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(x, [(y, String)])]
vals

allBarPoints :: (BarsPlotValue y) => BarsSettings -> [(x, [(y, String)])] -> ([x],[y])
allBarPoints :: forall y x.
BarsPlotValue y =>
BarsSettings -> [(x, [(y, String)])] -> ([x], [y])
allBarPoints BarsSettings
p [(x, [(y, String)])]
vals = case BarsSettings -> PlotBarsStyle
_bars_settings_style BarsSettings
p of
    PlotBarsStyle
BarsClustered ->
      let ys :: [y]
ys = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst) [[(y, String)]]
yls in
      ( [x]
xs, forall a. BarsPlotValue a => [a] -> a
barsReference [y]
ysforall a. a -> [a] -> [a]
:[y]
ys )
    PlotBarsStyle
BarsStacked   ->
      let ys :: [[y]]
ys = forall a b. (a -> b) -> [a] -> [b]
map (forall y. BarsPlotValue y => [y] -> [y]
stack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst) [[(y, String)]]
yls in
      ( [x]
xs, forall a. BarsPlotValue a => [a] -> a
barsReference (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a. Int -> [a] -> [a]
take Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile forall a. BarsPlotValue a => a -> Bool
barsIsNull) [[y]]
ys)forall a. a -> [a] -> [a]
:forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[y]]
ys)
  where ([x]
xs, [[(y, String)]]
yls) = forall a b. [(a, b)] -> ([a], [b])
unzip [(x, [(y, String)])]
vals

stack :: (BarsPlotValue y) => [y] -> [y]
stack :: forall y. BarsPlotValue y => [y] -> [y]
stack = forall a. (a -> a -> a) -> [a] -> [a]
scanl1 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 =
  forall a. FillStyle -> BackendProgram a -> BackendProgram a
withFillStyle FillStyle
fstyle forall a b. (a -> b) -> a -> b
$
    Path -> BackendProgram ()
fillPath (Rect -> Path
rectPath Rect
r)

$( makeLenses ''BarsSettings )
$( makeLenses ''PlotBars )

-- Lens provided for backward compat.

-- Note that this one does not satisfy the lens laws, as it discards/overwrites the labels.
plot_bars_values :: Lens' (PlotBars x y) [(x, [y])]
plot_bars_values :: forall x y. Lens' (PlotBars x y) [(x, [y])]
plot_bars_values = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall {c} {b}. PlotBars c b -> [(c, [b])]
getter forall {x} {y} {x} {y}. PlotBars x y -> [(x, [y])] -> PlotBars x y
setter
  where
    getter :: PlotBars c b -> [(c, [b])]
getter = forall a b c. (a -> b) -> [(c, [a])] -> [(c, [b])]
mapYs forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x y. PlotBars x y -> [(x, [(y, String)])]
_plot_bars_values_with_labels
    setter :: PlotBars x y -> [(x, [y])] -> PlotBars x y
setter PlotBars x y
pb [(x, [y])]
vals' = PlotBars x y
pb { _plot_bars_values_with_labels :: [(x, [(y, String)])]
_plot_bars_values_with_labels = forall a b c. (a -> b) -> [(c, [a])] -> [(c, [b])]
mapYs (, String
"") [(x, [y])]
vals' }
    mapYs :: (a -> b) -> [(c, [a])] -> [(c, [b])]
    mapYs :: forall a b c. (a -> b) -> [(c, [a])] -> [(c, [b])]
mapYs a -> b
f = forall a b. (a -> b) -> [a] -> [b]
map (forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall s t a b. Field2 s t a b => Lens s t a b
_2 forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map a -> b
f)

plot_bars_style :: Lens' (PlotBars x y) PlotBarsStyle
plot_bars_style :: forall x y. Lens' (PlotBars x y) PlotBarsStyle
plot_bars_style = forall x y. Lens' (PlotBars x y) BarsSettings
plot_bars_settings forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' BarsSettings PlotBarsStyle
bars_settings_style

plot_bars_item_styles :: Lens' (PlotBars x y) [(FillStyle, Maybe LineStyle)]
plot_bars_item_styles :: forall x y. Lens' (PlotBars x y) [(FillStyle, Maybe LineStyle)]
plot_bars_item_styles = forall x y. Lens' (PlotBars x y) BarsSettings
plot_bars_settings forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' BarsSettings [(FillStyle, Maybe LineStyle)]
bars_settings_item_styles

plot_bars_spacing :: Lens' (PlotBars x y) PlotBarsSpacing
plot_bars_spacing :: forall x y. Lens' (PlotBars x y) PlotBarsSpacing
plot_bars_spacing = forall x y. Lens' (PlotBars x y) BarsSettings
plot_bars_settings forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' BarsSettings PlotBarsSpacing
bars_settings_spacing

plot_bars_alignment :: Lens' (PlotBars x y) PlotBarsAlignment
plot_bars_alignment :: forall x y. Lens' (PlotBars x y) PlotBarsAlignment
plot_bars_alignment =  forall x y. Lens' (PlotBars x y) BarsSettings
plot_bars_settings forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' BarsSettings PlotBarsAlignment
bars_settings_alignment

plot_bars_singleton_width :: Lens' (PlotBars x y) Double
plot_bars_singleton_width :: forall x y. Lens' (PlotBars x y) Double
plot_bars_singleton_width = forall x y. Lens' (PlotBars x y) BarsSettings
plot_bars_settings forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' BarsSettings Double
bars_settings_singleton_width

plot_bars_label_bar_hanchor :: Lens' (PlotBars x y) BarHorizAnchor
plot_bars_label_bar_hanchor :: forall x y. Lens' (PlotBars x y) BarHorizAnchor
plot_bars_label_bar_hanchor = forall x y. Lens' (PlotBars x y) BarsSettings
plot_bars_settings forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' BarsSettings BarHorizAnchor
bars_settings_label_bar_hanchor

plot_bars_label_bar_vanchor :: Lens' (PlotBars x y) BarVertAnchor
plot_bars_label_bar_vanchor :: forall x y. Lens' (PlotBars x y) BarVertAnchor
plot_bars_label_bar_vanchor = forall x y. Lens' (PlotBars x y) BarsSettings
plot_bars_settings forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' BarsSettings BarVertAnchor
bars_settings_label_bar_vanchor

plot_bars_label_text_hanchor :: Lens' (PlotBars x y) HTextAnchor
plot_bars_label_text_hanchor :: forall x y. Lens' (PlotBars x y) HTextAnchor
plot_bars_label_text_hanchor = forall x y. Lens' (PlotBars x y) BarsSettings
plot_bars_settings forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' BarsSettings HTextAnchor
bars_settings_label_text_hanchor

plot_bars_label_text_vanchor :: Lens' (PlotBars x y) VTextAnchor
plot_bars_label_text_vanchor :: forall x y. Lens' (PlotBars x y) VTextAnchor
plot_bars_label_text_vanchor = forall x y. Lens' (PlotBars x y) BarsSettings
plot_bars_settings forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' BarsSettings VTextAnchor
bars_settings_label_text_vanchor

plot_bars_label_angle :: Lens' (PlotBars x y) Double
plot_bars_label_angle :: forall x y. Lens' (PlotBars x y) Double
plot_bars_label_angle = forall x y. Lens' (PlotBars x y) BarsSettings
plot_bars_settings forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' BarsSettings Double
bars_settings_label_angle

plot_bars_label_style :: Lens' (PlotBars x y) FontStyle
plot_bars_label_style :: forall x y. Lens' (PlotBars x y) FontStyle
plot_bars_label_style = forall x y. Lens' (PlotBars x y) BarsSettings
plot_bars_settings forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' BarsSettings FontStyle
bars_settings_label_style

plot_bars_label_offset :: Lens' (PlotBars x y) Vector
plot_bars_label_offset :: forall x y. Lens' (PlotBars x y) Vector
plot_bars_label_offset = forall x y. Lens' (PlotBars x y) BarsSettings
plot_bars_settings forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' BarsSettings Vector
bars_settings_label_offset