{-# 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
barsReference :: [a] -> a
barsAdd :: a -> a -> a
instance BarsPlotValue Double where
barsIsNull :: Double -> Bool
barsIsNull Double
a = Double
a Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0.0
barsReference :: [Double] -> Double
barsReference = Double -> [Double] -> Double
forall a b. a -> b -> a
const Double
0
barsAdd :: Double -> Double -> Double
barsAdd = Double -> Double -> Double
forall a. Num a => a -> a -> a
(+)
instance BarsPlotValue Int where
barsIsNull :: Int -> Bool
barsIsNull Int
a = Int
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
barsReference :: [Int] -> Int
barsReference = Int -> [Int] -> Int
forall a b. a -> b -> a
const Int
0
barsAdd :: Int -> Int -> Int
barsAdd = Int -> Int -> Int
forall a. Num a => a -> a -> a
(+)
instance BarsPlotValue LogValue where
barsIsNull :: LogValue -> Bool
barsIsNull (LogValue Double
a) = Double
a Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0.0
barsReference :: [LogValue] -> LogValue
barsReference [LogValue]
as =
LogValue
10.0 LogValue -> Integer -> LogValue
forall a b. (Fractional a, Integral b) => a -> b -> a
^^ (LogValue -> Integer
forall b. Integral b => LogValue -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (LogValue -> LogValue
forall a. Floating a => a -> a
log10 (LogValue -> LogValue) -> LogValue -> LogValue
forall a b. (a -> b) -> a -> b
$ [LogValue] -> LogValue
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum ([LogValue] -> LogValue) -> [LogValue] -> LogValue
forall a b. (a -> b) -> a -> b
$ (LogValue -> Bool) -> [LogValue] -> [LogValue]
forall a. (a -> Bool) -> [a] -> [a]
filter (LogValue -> LogValue -> Bool
forall a. Eq a => a -> a -> Bool
/= LogValue
0.0) [LogValue]
as) :: Integer)
barsAdd :: LogValue -> LogValue -> LogValue
barsAdd = LogValue -> LogValue -> LogValue
forall a. Num a => a -> a -> a
(+)
data
=
| BarsClustered
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
$cshowsPrec :: Int -> PlotBarsStyle -> ShowS
showsPrec :: Int -> PlotBarsStyle -> ShowS
$cshow :: PlotBarsStyle -> String
show :: PlotBarsStyle -> String
$cshowList :: [PlotBarsStyle] -> ShowS
showList :: [PlotBarsStyle] -> ShowS
Show)
data
= BarsFixWidth Double
| BarsFixGap Double Double
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
$cshowsPrec :: Int -> PlotBarsSpacing -> ShowS
showsPrec :: Int -> PlotBarsSpacing -> ShowS
$cshow :: PlotBarsSpacing -> String
show :: PlotBarsSpacing -> String
$cshowList :: [PlotBarsSpacing] -> ShowS
showList :: [PlotBarsSpacing] -> ShowS
Show)
data PlotBarsAlignment = BarsLeft
| BarsCentered
| BarsRight
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
$cshowsPrec :: Int -> PlotBarsAlignment -> ShowS
showsPrec :: Int -> PlotBarsAlignment -> ShowS
$cshow :: PlotBarsAlignment -> String
show :: PlotBarsAlignment -> String
$cshowList :: [PlotBarsAlignment] -> ShowS
showList :: [PlotBarsAlignment] -> ShowS
Show)
data BarHorizAnchor
= BHA_Left
| BHA_Centre
| BHA_Right
deriving (Int -> BarHorizAnchor -> ShowS
[BarHorizAnchor] -> ShowS
BarHorizAnchor -> String
(Int -> BarHorizAnchor -> ShowS)
-> (BarHorizAnchor -> String)
-> ([BarHorizAnchor] -> ShowS)
-> Show BarHorizAnchor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BarHorizAnchor -> ShowS
showsPrec :: Int -> BarHorizAnchor -> ShowS
$cshow :: BarHorizAnchor -> String
show :: BarHorizAnchor -> String
$cshowList :: [BarHorizAnchor] -> ShowS
showList :: [BarHorizAnchor] -> ShowS
Show)
data BarVertAnchor
= BVA_Bottom
| BVA_Centre
| BVA_Top
deriving (Int -> BarVertAnchor -> ShowS
[BarVertAnchor] -> ShowS
BarVertAnchor -> String
(Int -> BarVertAnchor -> ShowS)
-> (BarVertAnchor -> String)
-> ([BarVertAnchor] -> ShowS)
-> Show BarVertAnchor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BarVertAnchor -> ShowS
showsPrec :: Int -> BarVertAnchor -> ShowS
$cshow :: BarVertAnchor -> String
show :: BarVertAnchor -> String
$cshowList :: [BarVertAnchor] -> ShowS
showList :: [BarVertAnchor] -> ShowS
Show)
data = {
BarsSettings -> PlotBarsStyle
_bars_settings_style :: PlotBarsStyle,
BarsSettings -> [(FillStyle, Maybe LineStyle)]
_bars_settings_item_styles :: [ (FillStyle,Maybe LineStyle) ],
BarsSettings -> PlotBarsSpacing
_bars_settings_spacing :: PlotBarsSpacing,
BarsSettings -> PlotBarsAlignment
_bars_settings_alignment :: PlotBarsAlignment,
BarsSettings -> Double
_bars_settings_singleton_width :: Double,
BarsSettings -> BarHorizAnchor
_bars_settings_label_bar_hanchor :: BarHorizAnchor,
BarsSettings -> BarVertAnchor
_bars_settings_label_bar_vanchor :: BarVertAnchor,
BarsSettings -> HTextAnchor
_bars_settings_label_text_hanchor :: HTextAnchor,
BarsSettings -> VTextAnchor
_bars_settings_label_text_vanchor :: VTextAnchor,
BarsSettings -> Double
_bars_settings_label_angle :: Double,
BarsSettings -> FontStyle
_bars_settings_label_style :: FontStyle,
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 = [(FillStyle, Maybe LineStyle)] -> [(FillStyle, Maybe LineStyle)]
forall a. HasCallStack => [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 = FontStyle
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 = (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))
data PlotBars x y = PlotBars {
forall x y. PlotBars x y -> BarsSettings
_plot_bars_settings :: BarsSettings,
forall x y. PlotBars x y -> [String]
_plot_bars_titles :: [String],
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 = BarsSettings
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 -> BarsSettings
-> [(x, [(y, String)])]
-> y
-> (Double -> Double -> x -> y -> y -> Rect)
-> (x -> Double)
-> BackendProgram ()
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
(PointMapFn x y -> Double -> Double -> x -> y -> y -> Rect
forall {x} {y}.
((Limit x, Limit y) -> Point)
-> Double -> Double -> x -> y -> y -> Rect
barRect PointMapFn x y
pmap) (PointMapFn x y -> x -> Double
forall {x}. PointMapFn x y -> x -> Double
mapX PointMapFn x y
pmap),
_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
(BarsSettings -> [(FillStyle, Maybe LineStyle)]
_bars_settings_item_styles BarsSettings
s)),
_plot_all_points :: ([x], [y])
_plot_all_points = BarsSettings -> [(x, [(y, String)])] -> ([x], [y])
forall y x.
BarsPlotValue y =>
BarsSettings -> [(x, [(y, String)])] -> ([x], [y])
allBarPoints BarsSettings
s [(x, [(y, String)])]
vals
}
where
s :: BarsSettings
s = PlotBars x y -> BarsSettings
forall x y. PlotBars x y -> BarsSettings
_plot_bars_settings PlotBars x y
p
vals :: [(x, [(y, String)])]
vals = PlotBars x y -> [(x, [(y, String)])]
forall x y. PlotBars x y -> [(x, [(y, String)])]
_plot_bars_values_with_labels PlotBars x y
p
yref0 :: y
yref0 = BarsSettings -> [(x, [(y, String)])] -> y
forall y x.
BarsPlotValue y =>
BarsSettings -> [(x, [(y, String)])] -> y
refVal BarsSettings
s [(x, [(y, String)])]
vals
barRect :: ((Limit x, Limit y) -> Point)
-> Double -> Double -> x -> y -> y -> Rect
barRect (Limit x, Limit y) -> Point
pmap Double
xos Double
width x
x y
y0 y
y1 = 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') where
Point Double
x' Double
y' = ((Limit x, Limit y) -> Point) -> (x, y) -> Point
forall x y. PointMapFn x y -> (x, y) -> Point
mapXY (Limit x, Limit y) -> Point
pmap (x
x,y
y1)
Point Double
_ Double
y0' = ((Limit x, Limit y) -> Point) -> (x, y) -> Point
forall x y. PointMapFn x y -> (x, y) -> Point
mapXY (Limit x, Limit y) -> Point
pmap (x
x,y
y0)
mapX :: PointMapFn x y -> x -> Double
mapX PointMapFn x y
pmap x
x = Point -> Double
p_x (PointMapFn x y -> (x, y) -> Point
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 -> BarsSettings
-> [(y, [(x, String)])]
-> x
-> (Double -> Double -> y -> x -> x -> Rect)
-> (y -> Double)
-> BackendProgram ()
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
(PointMapFn x y -> Double -> Double -> y -> x -> x -> Rect
forall {x} {y}.
((Limit x, Limit y) -> Point)
-> Double -> Double -> y -> x -> x -> Rect
barRect PointMapFn x y
pmap) (PointMapFn x y -> y -> Double
forall {y}. PointMapFn x y -> y -> Double
mapY PointMapFn x y
pmap),
_plot_legend :: [(String, Rect -> BackendProgram ())]
_plot_legend = [String]
-> [Rect -> BackendProgram ()]
-> [(String, Rect -> BackendProgram ())]
forall a b. [a] -> [b] -> [(a, b)]
zip (PlotBars y x -> [String]
forall x y. PlotBars x y -> [String]
_plot_bars_titles PlotBars y x
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
(BarsSettings -> [(FillStyle, Maybe LineStyle)]
_bars_settings_item_styles BarsSettings
s)),
_plot_all_points :: ([x], [y])
_plot_all_points = ([y], [x]) -> ([x], [y])
forall a b. (a, b) -> (b, a)
swap (([y], [x]) -> ([x], [y])) -> ([y], [x]) -> ([x], [y])
forall a b. (a -> b) -> a -> b
$ BarsSettings -> [(y, [(x, String)])] -> ([y], [x])
forall y x.
BarsPlotValue y =>
BarsSettings -> [(x, [(y, String)])] -> ([x], [y])
allBarPoints BarsSettings
s [(y, [(x, String)])]
vals
}
where
s :: BarsSettings
s = PlotBars y x -> BarsSettings
forall x y. PlotBars x y -> BarsSettings
_plot_bars_settings PlotBars y x
p
vals :: [(y, [(x, String)])]
vals = PlotBars y x -> [(y, [(x, String)])]
forall x y. PlotBars x y -> [(x, [(y, String)])]
_plot_bars_values_with_labels PlotBars y x
p
xref0 :: x
xref0 = BarsSettings -> [(y, [(x, String)])] -> x
forall y x.
BarsPlotValue y =>
BarsSettings -> [(x, [(y, String)])] -> y
refVal BarsSettings
s [(y, [(x, String)])]
vals
barRect :: ((Limit x, Limit y) -> Point)
-> Double -> Double -> y -> x -> x -> Rect
barRect (Limit x, Limit y) -> Point
pmap Double
yos Double
height y
y x
x0 x
x1 = Point -> Point -> Rect
Rect (Double -> Double -> Point
Point Double
x0' (Double
y'Double -> Double -> Double
forall a. Num a => a -> a -> a
+Double
yos)) (Double -> Double -> Point
Point Double
x' (Double
y'Double -> Double -> Double
forall a. Num a => a -> a -> a
+Double
yosDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
height)) where
Point Double
x' Double
y' = ((Limit x, Limit y) -> Point) -> (x, y) -> Point
forall x y. PointMapFn x y -> (x, y) -> Point
mapXY (Limit x, Limit y) -> Point
pmap (x
x1,y
y)
Point Double
x0' Double
_ = ((Limit x, Limit y) -> Point) -> (x, y) -> Point
forall x y. PointMapFn x y -> (x, y) -> Point
mapXY (Limit x, Limit y) -> Point
pmap (x
x0,y
y)
mapY :: PointMapFn x y -> y -> Double
mapY PointMapFn x y
pmap y
y = Point -> Double
p_y (PointMapFn x y -> (x, y) -> Point
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 -> [(k, [(v, String)])]
-> ((k, [(v, String)]) -> BackendProgram ()) -> BackendProgram ()
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 -> [(k, [(v, String)])]
-> ((k, [(v, String)]) -> BackendProgram ()) -> BackendProgram ()
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 -> 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
bsize
PlotBarsAlignment
BarsRight -> Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
nvs) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
bsize
PlotBarsAlignment
BarsCentered -> 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
nvs) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
bsizeDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2
[(Int, (v, String), (FillStyle, Maybe LineStyle))]
-> ((Int, (v, String), (FillStyle, Maybe LineStyle))
-> BackendProgram ())
-> BackendProgram ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Int]
-> [(v, String)]
-> [(FillStyle, Maybe LineStyle)]
-> [(Int, (v, String), (FillStyle, Maybe LineStyle))]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Int
0,Int
1..] [(v, String)]
vs [(FillStyle, Maybe LineStyle)]
styles) (((Int, (v, String), (FillStyle, Maybe LineStyle))
-> BackendProgram ())
-> BackendProgram ())
-> ((Int, (v, String), (FillStyle, Maybe LineStyle))
-> BackendProgram ())
-> BackendProgram ()
forall a b. (a -> b) -> a -> b
$ \(Int
i, (v
v, String
_), (FillStyle
fstyle,Maybe LineStyle
_)) ->
Bool -> BackendProgram () -> BackendProgram ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (v -> Bool
forall a. BarsPlotValue a => a -> Bool
barsIsNull v
v) (BackendProgram () -> BackendProgram ())
-> BackendProgram () -> BackendProgram ()
forall a b. (a -> b) -> a -> b
$
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 -> k -> v -> v -> Path
barPath (Int -> Double
offset Int
i) k
k v
vref0 v
v)
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
[(Int, (v, String), (FillStyle, Maybe LineStyle))]
-> ((Int, (v, String), (FillStyle, Maybe LineStyle))
-> BackendProgram ())
-> BackendProgram ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Int]
-> [(v, String)]
-> [(FillStyle, Maybe LineStyle)]
-> [(Int, (v, String), (FillStyle, Maybe LineStyle))]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Int
0,Int
1..] [(v, String)]
vs [(FillStyle, Maybe LineStyle)]
styles) (((Int, (v, String), (FillStyle, Maybe LineStyle))
-> BackendProgram ())
-> BackendProgram ())
-> ((Int, (v, String), (FillStyle, Maybe LineStyle))
-> BackendProgram ())
-> BackendProgram ()
forall a b. (a -> b) -> a -> b
$ \(Int
i, (v
v, String
_), (FillStyle
_,Maybe LineStyle
mlstyle)) ->
Bool -> BackendProgram () -> BackendProgram ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (v -> Bool
forall a. BarsPlotValue a => a -> Bool
barsIsNull v
v) (BackendProgram () -> BackendProgram ())
-> BackendProgram () -> BackendProgram ()
forall a b. (a -> b) -> a -> b
$
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 -> k -> v -> v -> Path
barPath (Int -> Double
offset Int
i) k
k v
vref0 v
v)
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
FontStyle -> BackendProgram () -> BackendProgram ()
forall a. FontStyle -> BackendProgram a -> BackendProgram a
withFontStyle (BarsSettings -> FontStyle
_bars_settings_label_style BarsSettings
p) (BackendProgram () -> BackendProgram ())
-> BackendProgram () -> BackendProgram ()
forall a b. (a -> b) -> a -> b
$
[(Int, (v, String))]
-> ((Int, (v, String)) -> BackendProgram ()) -> BackendProgram ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Int] -> [(v, String)] -> [(Int, (v, String))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0,Int
1..] [(v, String)]
vs) (((Int, (v, String)) -> BackendProgram ()) -> BackendProgram ())
-> ((Int, (v, String)) -> BackendProgram ()) -> BackendProgram ()
forall a b. (a -> b) -> a -> b
$ \(Int
i, (v
v, String
txt)) ->
Bool -> BackendProgram () -> BackendProgram ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
txt) (BackendProgram () -> BackendProgram ())
-> BackendProgram () -> BackendProgram ()
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 (Vector -> Point) -> Vector -> Point
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) = [(v, String)] -> ([v], [String])
forall a b. [(a, b)] -> ([a], [b])
unzip [(v, String)]
vs
let vs'' :: [v]
vs'' = (v -> v) -> [v] -> [v]
forall a b. (a -> b) -> [a] -> [b]
map (\v
v -> if v -> Bool
forall a. BarsPlotValue a => a -> Bool
barsIsNull v
v then v
vref0 else v
v) ([v] -> [v]
forall y. BarsPlotValue y => [y] -> [y]
stack [v]
vs')
let v2s :: [(v, v)]
v2s = [v] -> [v] -> [(v, v)]
forall a b. [a] -> [b] -> [(a, b)]
zip (v
vref0v -> [v] -> [v]
forall 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
bsizeDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2)
[((v, v), (FillStyle, Maybe LineStyle))]
-> (((v, v), (FillStyle, Maybe LineStyle)) -> BackendProgram ())
-> BackendProgram ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([(v, v)]
-> [(FillStyle, Maybe LineStyle)]
-> [((v, v), (FillStyle, Maybe LineStyle))]
forall a b. [a] -> [b] -> [(a, b)]
zip [(v, v)]
v2s [(FillStyle, Maybe LineStyle)]
styles) ((((v, v), (FillStyle, Maybe LineStyle)) -> BackendProgram ())
-> BackendProgram ())
-> (((v, v), (FillStyle, Maybe LineStyle)) -> BackendProgram ())
-> BackendProgram ()
forall a b. (a -> b) -> a -> b
$ \((v
v0,v
v1), (FillStyle
fstyle,Maybe LineStyle
_)) ->
Bool -> BackendProgram () -> BackendProgram ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (v
v0 v -> v -> Bool
forall a. Ord a => a -> a -> Bool
>= v
v1) (BackendProgram () -> BackendProgram ())
-> BackendProgram () -> BackendProgram ()
forall a b. (a -> b) -> a -> b
$
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 -> k -> v -> v -> Path
barPath Double
ofs k
k v
v0 v
v1)
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
[((v, v), (FillStyle, Maybe LineStyle))]
-> (((v, v), (FillStyle, Maybe LineStyle)) -> BackendProgram ())
-> BackendProgram ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([(v, v)]
-> [(FillStyle, Maybe LineStyle)]
-> [((v, v), (FillStyle, Maybe LineStyle))]
forall a b. [a] -> [b] -> [(a, b)]
zip [(v, v)]
v2s [(FillStyle, Maybe LineStyle)]
styles) ((((v, v), (FillStyle, Maybe LineStyle)) -> BackendProgram ())
-> BackendProgram ())
-> (((v, v), (FillStyle, Maybe LineStyle)) -> BackendProgram ())
-> BackendProgram ()
forall a b. (a -> b) -> a -> b
$ \((v
v0,v
v1), (FillStyle
_,Maybe LineStyle
mlstyle)) ->
Bool -> BackendProgram () -> BackendProgram ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (v
v0 v -> v -> Bool
forall a. Ord a => a -> a -> Bool
>= v
v1) (BackendProgram () -> BackendProgram ())
-> BackendProgram () -> BackendProgram ()
forall a b. (a -> b) -> a -> b
$
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 -> k -> v -> v -> Path
barPath Double
ofs k
k v
v0 v
v1)
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
FontStyle -> BackendProgram () -> BackendProgram ()
forall a. FontStyle -> BackendProgram a -> BackendProgram a
withFontStyle (BarsSettings -> FontStyle
_bars_settings_label_style BarsSettings
p) (BackendProgram () -> BackendProgram ())
-> BackendProgram () -> BackendProgram ()
forall a b. (a -> b) -> a -> b
$
[((v, v), String)]
-> (((v, v), String) -> BackendProgram ()) -> BackendProgram ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([(v, v)] -> [String] -> [((v, v), String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [(v, v)]
v2s [String]
lbls) ((((v, v), String) -> BackendProgram ()) -> BackendProgram ())
-> (((v, v), String) -> BackendProgram ()) -> BackendProgram ()
forall a b. (a -> b) -> a -> b
$ \((v
v0, v
v1), String
txt) ->
Bool -> BackendProgram () -> BackendProgram ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
txt) (BackendProgram () -> BackendProgram ())
-> BackendProgram () -> BackendProgram ()
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 (Vector -> Point) -> Vector -> Point
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 (Rect -> Path) -> Rect -> Path
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 = Double -> Double -> Double
forall a. Ord a => a -> a -> a
max (Double
minKInterval Double -> Double -> Double
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 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
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 = (Double -> Double -> Double) -> [Double] -> [Double] -> [Double]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (-) ([Double] -> [Double]
forall a. HasCallStack => [a] -> [a]
tail [Double]
mks) [Double]
mks
in if [Double] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Double]
diffs
then BarsSettings -> Double
_bars_settings_singleton_width BarsSettings
p
else [Double] -> Double
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Double]
diffs
where
mks :: [Double]
mks = [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
$ ((k, [(v, String)]) -> Double) -> [(k, [(v, String)])] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (k -> Double
mapk (k -> Double)
-> ((k, [(v, String)]) -> k) -> (k, [(v, String)]) -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k, [(v, String)]) -> k
forall a b. (a, b) -> a
fst) [(k, [(v, String)])]
vals
nvs :: Int
nvs = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ ((k, [(v, String)]) -> Int) -> [(k, [(v, String)])] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ([(v, String)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([(v, String)] -> Int)
-> ((k, [(v, String)]) -> [(v, String)])
-> (k, [(v, String)])
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k, [(v, String)]) -> [(v, String)]
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 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
x1) Double -> Double -> Double
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 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
y1) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2
addLabels :: Show y => [(x, [y])] -> [(x, [(y, String)])]
addLabels :: forall y x. Show y => [(x, [y])] -> [(x, [(y, String)])]
addLabels = ((x, [y]) -> (x, [(y, String)]))
-> [(x, [y])] -> [(x, [(y, String)])]
forall a b. (a -> b) -> [a] -> [b]
map (((x, [y]) -> (x, [(y, String)]))
-> [(x, [y])] -> [(x, [(y, String)])])
-> (([y] -> [(y, String)]) -> (x, [y]) -> (x, [(y, String)]))
-> ([y] -> [(y, String)])
-> [(x, [y])]
-> [(x, [(y, String)])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([y] -> [(y, String)]) -> (x, [y]) -> (x, [(y, String)])
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (([y] -> [(y, String)]) -> [(x, [y])] -> [(x, [(y, String)])])
-> ([y] -> [(y, String)]) -> [(x, [y])] -> [(x, [(y, String)])]
forall a b. (a -> b) -> a -> b
$ (y -> (y, String)) -> [y] -> [(y, String)]
forall a b. (a -> b) -> [a] -> [b]
map (\y
y -> (y
y, y -> String
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 = [y] -> y
forall a. BarsPlotValue a => [a] -> a
barsReference ([y] -> y) -> [y] -> y
forall a b. (a -> b) -> a -> b
$ case BarsSettings -> PlotBarsStyle
_bars_settings_style BarsSettings
p of
PlotBarsStyle
BarsClustered -> ((x, [(y, String)]) -> [y]) -> [(x, [(y, String)])] -> [y]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (((y, String) -> y) -> [(y, String)] -> [y]
forall a b. (a -> b) -> [a] -> [b]
map (y, String) -> y
forall a b. (a, b) -> a
fst ([(y, String)] -> [y])
-> ((x, [(y, String)]) -> [(y, String)])
-> (x, [(y, String)])
-> [y]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (x, [(y, String)]) -> [(y, String)]
forall a b. (a, b) -> b
snd) [(x, [(y, String)])]
vals
PlotBarsStyle
BarsStacked -> ((x, [(y, String)]) -> [y]) -> [(x, [(y, String)])] -> [y]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int -> [y] -> [y]
forall a. Int -> [a] -> [a]
take Int
1 ([y] -> [y])
-> ((x, [(y, String)]) -> [y]) -> (x, [(y, String)]) -> [y]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (y -> Bool) -> [y] -> [y]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile y -> Bool
forall a. BarsPlotValue a => a -> Bool
barsIsNull ([y] -> [y])
-> ((x, [(y, String)]) -> [y]) -> (x, [(y, String)]) -> [y]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [y] -> [y]
forall y. BarsPlotValue y => [y] -> [y]
stack ([y] -> [y])
-> ((x, [(y, String)]) -> [y]) -> (x, [(y, String)]) -> [y]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((y, String) -> y) -> [(y, String)] -> [y]
forall a b. (a -> b) -> [a] -> [b]
map (y, String) -> y
forall a b. (a, b) -> a
fst ([(y, String)] -> [y])
-> ((x, [(y, String)]) -> [(y, String)])
-> (x, [(y, String)])
-> [y]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (x, [(y, String)]) -> [(y, String)]
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 = ([(y, String)] -> [y]) -> [[(y, String)]] -> [y]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (((y, String) -> y) -> [(y, String)] -> [y]
forall a b. (a -> b) -> [a] -> [b]
map (y, String) -> y
forall a b. (a, b) -> a
fst) [[(y, String)]]
yls in
( [x]
xs, [y] -> y
forall a. BarsPlotValue a => [a] -> a
barsReference [y]
ysy -> [y] -> [y]
forall a. a -> [a] -> [a]
:[y]
ys )
PlotBarsStyle
BarsStacked ->
let ys :: [[y]]
ys = ([(y, String)] -> [y]) -> [[(y, String)]] -> [[y]]
forall a b. (a -> b) -> [a] -> [b]
map ([y] -> [y]
forall y. BarsPlotValue y => [y] -> [y]
stack ([y] -> [y]) -> ([(y, String)] -> [y]) -> [(y, String)] -> [y]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((y, String) -> y) -> [(y, String)] -> [y]
forall a b. (a -> b) -> [a] -> [b]
map (y, String) -> y
forall a b. (a, b) -> a
fst) [[(y, String)]]
yls in
( [x]
xs, [y] -> y
forall a. BarsPlotValue a => [a] -> a
barsReference (([y] -> [y]) -> [[y]] -> [y]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int -> [y] -> [y]
forall a. Int -> [a] -> [a]
take Int
1 ([y] -> [y]) -> ([y] -> [y]) -> [y] -> [y]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (y -> Bool) -> [y] -> [y]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile y -> Bool
forall a. BarsPlotValue a => a -> Bool
barsIsNull) [[y]]
ys)y -> [y] -> [y]
forall a. a -> [a] -> [a]
:[[y]] -> [y]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[y]]
ys)
where ([x]
xs, [[(y, String)]]
yls) = [(x, [(y, String)])] -> ([x], [[(y, String)]])
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 = (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 ''BarsSettings )
$( makeLenses ''PlotBars )
plot_bars_values :: Lens' (PlotBars x y) [(x, [y])]
plot_bars_values :: forall x y (f :: * -> *).
Functor f =>
([(x, [y])] -> f [(x, [y])]) -> PlotBars x y -> f (PlotBars x y)
plot_bars_values = (PlotBars x y -> [(x, [y])])
-> (PlotBars x y -> [(x, [y])] -> PlotBars x y)
-> Lens (PlotBars x y) (PlotBars x y) [(x, [y])] [(x, [y])]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens PlotBars x y -> [(x, [y])]
forall {c} {b}. PlotBars c b -> [(c, [b])]
getter PlotBars x y -> [(x, [y])] -> PlotBars x y
forall {x} {y} {x} {y}. PlotBars x y -> [(x, [y])] -> PlotBars x y
setter
where
getter :: PlotBars c b -> [(c, [b])]
getter = ((b, String) -> b) -> [(c, [(b, String)])] -> [(c, [b])]
forall a b c. (a -> b) -> [(c, [a])] -> [(c, [b])]
mapYs (b, String) -> b
forall a b. (a, b) -> a
fst ([(c, [(b, String)])] -> [(c, [b])])
-> (PlotBars c b -> [(c, [(b, String)])])
-> PlotBars c b
-> [(c, [b])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlotBars c b -> [(c, [(b, String)])]
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 = mapYs (, "") vals' }
mapYs :: (a -> b) -> [(c, [a])] -> [(c, [b])]
mapYs :: forall a b c. (a -> b) -> [(c, [a])] -> [(c, [b])]
mapYs a -> b
f = ((c, [a]) -> (c, [b])) -> [(c, [a])] -> [(c, [b])]
forall a b. (a -> b) -> [a] -> [b]
map (ASetter (c, [a]) (c, [b]) [a] [b]
-> ([a] -> [b]) -> (c, [a]) -> (c, [b])
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter (c, [a]) (c, [b]) [a] [b]
forall s t a b. Field2 s t a b => Lens s t a b
Lens (c, [a]) (c, [b]) [a] [b]
_2 (([a] -> [b]) -> (c, [a]) -> (c, [b]))
-> ([a] -> [b]) -> (c, [a]) -> (c, [b])
forall a b. (a -> b) -> 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 (f :: * -> *).
Functor f =>
(PlotBarsStyle -> f PlotBarsStyle)
-> PlotBars x y -> f (PlotBars x y)
plot_bars_style = (BarsSettings -> f BarsSettings)
-> PlotBars x y -> f (PlotBars x y)
forall x y (f :: * -> *).
Functor f =>
(BarsSettings -> f BarsSettings)
-> PlotBars x y -> f (PlotBars x y)
plot_bars_settings ((BarsSettings -> f BarsSettings)
-> PlotBars x y -> f (PlotBars x y))
-> ((PlotBarsStyle -> f PlotBarsStyle)
-> BarsSettings -> f BarsSettings)
-> (PlotBarsStyle -> f PlotBarsStyle)
-> PlotBars x y
-> f (PlotBars x y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PlotBarsStyle -> f PlotBarsStyle)
-> BarsSettings -> f BarsSettings
Lens' BarsSettings PlotBarsStyle
bars_settings_style
plot_bars_item_styles :: Lens' (PlotBars x y) [(FillStyle, Maybe LineStyle)]
plot_bars_item_styles :: forall x y (f :: * -> *).
Functor f =>
([(FillStyle, Maybe LineStyle)]
-> f [(FillStyle, Maybe LineStyle)])
-> PlotBars x y -> f (PlotBars x y)
plot_bars_item_styles = (BarsSettings -> f BarsSettings)
-> PlotBars x y -> f (PlotBars x y)
forall x y (f :: * -> *).
Functor f =>
(BarsSettings -> f BarsSettings)
-> PlotBars x y -> f (PlotBars x y)
plot_bars_settings ((BarsSettings -> f BarsSettings)
-> PlotBars x y -> f (PlotBars x y))
-> (([(FillStyle, Maybe LineStyle)]
-> f [(FillStyle, Maybe LineStyle)])
-> BarsSettings -> f BarsSettings)
-> ([(FillStyle, Maybe LineStyle)]
-> f [(FillStyle, Maybe LineStyle)])
-> PlotBars x y
-> f (PlotBars x y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(FillStyle, Maybe LineStyle)]
-> f [(FillStyle, Maybe LineStyle)])
-> BarsSettings -> f BarsSettings
Lens' BarsSettings [(FillStyle, Maybe LineStyle)]
bars_settings_item_styles
plot_bars_spacing :: Lens' (PlotBars x y) PlotBarsSpacing
plot_bars_spacing :: forall x y (f :: * -> *).
Functor f =>
(PlotBarsSpacing -> f PlotBarsSpacing)
-> PlotBars x y -> f (PlotBars x y)
plot_bars_spacing = (BarsSettings -> f BarsSettings)
-> PlotBars x y -> f (PlotBars x y)
forall x y (f :: * -> *).
Functor f =>
(BarsSettings -> f BarsSettings)
-> PlotBars x y -> f (PlotBars x y)
plot_bars_settings ((BarsSettings -> f BarsSettings)
-> PlotBars x y -> f (PlotBars x y))
-> ((PlotBarsSpacing -> f PlotBarsSpacing)
-> BarsSettings -> f BarsSettings)
-> (PlotBarsSpacing -> f PlotBarsSpacing)
-> PlotBars x y
-> f (PlotBars x y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PlotBarsSpacing -> f PlotBarsSpacing)
-> BarsSettings -> f BarsSettings
Lens' BarsSettings PlotBarsSpacing
bars_settings_spacing
plot_bars_alignment :: Lens' (PlotBars x y) PlotBarsAlignment
plot_bars_alignment :: forall x y (f :: * -> *).
Functor f =>
(PlotBarsAlignment -> f PlotBarsAlignment)
-> PlotBars x y -> f (PlotBars x y)
plot_bars_alignment = (BarsSettings -> f BarsSettings)
-> PlotBars x y -> f (PlotBars x y)
forall x y (f :: * -> *).
Functor f =>
(BarsSettings -> f BarsSettings)
-> PlotBars x y -> f (PlotBars x y)
plot_bars_settings ((BarsSettings -> f BarsSettings)
-> PlotBars x y -> f (PlotBars x y))
-> ((PlotBarsAlignment -> f PlotBarsAlignment)
-> BarsSettings -> f BarsSettings)
-> (PlotBarsAlignment -> f PlotBarsAlignment)
-> PlotBars x y
-> f (PlotBars x y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PlotBarsAlignment -> f PlotBarsAlignment)
-> BarsSettings -> f BarsSettings
Lens' BarsSettings PlotBarsAlignment
bars_settings_alignment
plot_bars_singleton_width :: Lens' (PlotBars x y) Double
plot_bars_singleton_width :: forall x y (f :: * -> *).
Functor f =>
(Double -> f Double) -> PlotBars x y -> f (PlotBars x y)
plot_bars_singleton_width = (BarsSettings -> f BarsSettings)
-> PlotBars x y -> f (PlotBars x y)
forall x y (f :: * -> *).
Functor f =>
(BarsSettings -> f BarsSettings)
-> PlotBars x y -> f (PlotBars x y)
plot_bars_settings ((BarsSettings -> f BarsSettings)
-> PlotBars x y -> f (PlotBars x y))
-> ((Double -> f Double) -> BarsSettings -> f BarsSettings)
-> (Double -> f Double)
-> PlotBars x y
-> f (PlotBars x y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> f Double) -> BarsSettings -> f BarsSettings
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 (f :: * -> *).
Functor f =>
(BarHorizAnchor -> f BarHorizAnchor)
-> PlotBars x y -> f (PlotBars x y)
plot_bars_label_bar_hanchor = (BarsSettings -> f BarsSettings)
-> PlotBars x y -> f (PlotBars x y)
forall x y (f :: * -> *).
Functor f =>
(BarsSettings -> f BarsSettings)
-> PlotBars x y -> f (PlotBars x y)
plot_bars_settings ((BarsSettings -> f BarsSettings)
-> PlotBars x y -> f (PlotBars x y))
-> ((BarHorizAnchor -> f BarHorizAnchor)
-> BarsSettings -> f BarsSettings)
-> (BarHorizAnchor -> f BarHorizAnchor)
-> PlotBars x y
-> f (PlotBars x y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BarHorizAnchor -> f BarHorizAnchor)
-> BarsSettings -> f BarsSettings
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 (f :: * -> *).
Functor f =>
(BarVertAnchor -> f BarVertAnchor)
-> PlotBars x y -> f (PlotBars x y)
plot_bars_label_bar_vanchor = (BarsSettings -> f BarsSettings)
-> PlotBars x y -> f (PlotBars x y)
forall x y (f :: * -> *).
Functor f =>
(BarsSettings -> f BarsSettings)
-> PlotBars x y -> f (PlotBars x y)
plot_bars_settings ((BarsSettings -> f BarsSettings)
-> PlotBars x y -> f (PlotBars x y))
-> ((BarVertAnchor -> f BarVertAnchor)
-> BarsSettings -> f BarsSettings)
-> (BarVertAnchor -> f BarVertAnchor)
-> PlotBars x y
-> f (PlotBars x y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BarVertAnchor -> f BarVertAnchor)
-> BarsSettings -> f BarsSettings
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 (f :: * -> *).
Functor f =>
(HTextAnchor -> f HTextAnchor) -> PlotBars x y -> f (PlotBars x y)
plot_bars_label_text_hanchor = (BarsSettings -> f BarsSettings)
-> PlotBars x y -> f (PlotBars x y)
forall x y (f :: * -> *).
Functor f =>
(BarsSettings -> f BarsSettings)
-> PlotBars x y -> f (PlotBars x y)
plot_bars_settings ((BarsSettings -> f BarsSettings)
-> PlotBars x y -> f (PlotBars x y))
-> ((HTextAnchor -> f HTextAnchor)
-> BarsSettings -> f BarsSettings)
-> (HTextAnchor -> f HTextAnchor)
-> PlotBars x y
-> f (PlotBars x y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HTextAnchor -> f HTextAnchor) -> BarsSettings -> f BarsSettings
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 (f :: * -> *).
Functor f =>
(VTextAnchor -> f VTextAnchor) -> PlotBars x y -> f (PlotBars x y)
plot_bars_label_text_vanchor = (BarsSettings -> f BarsSettings)
-> PlotBars x y -> f (PlotBars x y)
forall x y (f :: * -> *).
Functor f =>
(BarsSettings -> f BarsSettings)
-> PlotBars x y -> f (PlotBars x y)
plot_bars_settings ((BarsSettings -> f BarsSettings)
-> PlotBars x y -> f (PlotBars x y))
-> ((VTextAnchor -> f VTextAnchor)
-> BarsSettings -> f BarsSettings)
-> (VTextAnchor -> f VTextAnchor)
-> PlotBars x y
-> f (PlotBars x y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VTextAnchor -> f VTextAnchor) -> BarsSettings -> f BarsSettings
Lens' BarsSettings VTextAnchor
bars_settings_label_text_vanchor
plot_bars_label_angle :: Lens' (PlotBars x y) Double
plot_bars_label_angle :: forall x y (f :: * -> *).
Functor f =>
(Double -> f Double) -> PlotBars x y -> f (PlotBars x y)
plot_bars_label_angle = (BarsSettings -> f BarsSettings)
-> PlotBars x y -> f (PlotBars x y)
forall x y (f :: * -> *).
Functor f =>
(BarsSettings -> f BarsSettings)
-> PlotBars x y -> f (PlotBars x y)
plot_bars_settings ((BarsSettings -> f BarsSettings)
-> PlotBars x y -> f (PlotBars x y))
-> ((Double -> f Double) -> BarsSettings -> f BarsSettings)
-> (Double -> f Double)
-> PlotBars x y
-> f (PlotBars x y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> f Double) -> BarsSettings -> f BarsSettings
Lens' BarsSettings Double
bars_settings_label_angle
plot_bars_label_style :: Lens' (PlotBars x y) FontStyle
plot_bars_label_style :: forall x y (f :: * -> *).
Functor f =>
(FontStyle -> f FontStyle) -> PlotBars x y -> f (PlotBars x y)
plot_bars_label_style = (BarsSettings -> f BarsSettings)
-> PlotBars x y -> f (PlotBars x y)
forall x y (f :: * -> *).
Functor f =>
(BarsSettings -> f BarsSettings)
-> PlotBars x y -> f (PlotBars x y)
plot_bars_settings ((BarsSettings -> f BarsSettings)
-> PlotBars x y -> f (PlotBars x y))
-> ((FontStyle -> f FontStyle) -> BarsSettings -> f BarsSettings)
-> (FontStyle -> f FontStyle)
-> PlotBars x y
-> f (PlotBars x y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FontStyle -> f FontStyle) -> BarsSettings -> f BarsSettings
Lens' BarsSettings FontStyle
bars_settings_label_style
plot_bars_label_offset :: Lens' (PlotBars x y) Vector
plot_bars_label_offset :: forall x y (f :: * -> *).
Functor f =>
(Vector -> f Vector) -> PlotBars x y -> f (PlotBars x y)
plot_bars_label_offset = (BarsSettings -> f BarsSettings)
-> PlotBars x y -> f (PlotBars x y)
forall x y (f :: * -> *).
Functor f =>
(BarsSettings -> f BarsSettings)
-> PlotBars x y -> f (PlotBars x y)
plot_bars_settings ((BarsSettings -> f BarsSettings)
-> PlotBars x y -> f (PlotBars x y))
-> ((Vector -> f Vector) -> BarsSettings -> f BarsSettings)
-> (Vector -> f Vector)
-> PlotBars x y
-> f (PlotBars x y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector -> f Vector) -> BarsSettings -> f BarsSettings
Lens' BarsSettings Vector
bars_settings_label_offset