{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}

-- | Bar charts
module Chart.Bar
  ( BarOptions (..),
    defaultBarOptions,
    BarData (..),
    barRange,
    bars,
    barChart,
    barRects,
    barTextCharts,
  )
where

import Chart.Data
import Chart.Hud
import Chart.Markup
import Chart.Primitive
import Chart.Style
import Data.Bool
import Data.Colour
import Data.Foldable
import Data.FormatN
import Data.List (transpose)
import Data.Maybe
import Data.Text (Text, pack)
import GHC.Generics
import Optics.Core
import Prelude hiding (abs)

-- $setup
--
-- >>> :set -XOverloadedLabels
-- >>> :set -XOverloadedStrings
-- >>> import Chart
-- >>> import Optics.Core
-- >>> import Data.Text (pack)

-- | Typical bar chart options.
--
-- The internal model for a bar chart (across the x-axis for a vertical bar chart) is:
--
-- - half the outerGap at the start and the end.
--
-- - each row collection of bars, including the outerGap and innerGaps has a value of 1.
--
-- - the entire x range of the chart isequal to the number of rows in the bar data.
--
-- - The value of inner and outer gaps are relative to this model.
--
-- >>> let barDataExample = BarData [[1, 2, 3, 5, 8, 0, -2, 11, 2, 1], [1 .. 10]] (("row " <>) . pack . show <$> [1 .. 11]) (("column " <>) . pack . show <$> [1 .. 2])
-- >>> let barExample = barChart defaultBarOptions barDataExample
--
-- > writeChartOptions "other/bar.svg" barExample
--
-- ![bar chart example](other/bar.svg)
data BarOptions = BarOptions
  { BarOptions -> [Style]
barRectStyles :: [Style],
    BarOptions -> [Style]
barTextStyles :: [Style],
    -- | gap between each bar collection row.
    BarOptions -> Double
outerGap :: Double,
    -- | gap between bars within a row collection. Negative numbers represent bar overlaps.
    BarOptions -> Double
innerGap :: Double,
    -- | gap between top of a bar and text representation of the bar value
    -- as a proportion of the highest absolute bar value
    BarOptions -> Double
textGap :: Double,
    -- | gap between top of a bar and text representation of the bar value,
    -- if the value is negative
    -- as a proportion of the highest absolute bar value
    BarOptions -> Double
textGapNegative :: Double,
    -- | A nudge to help text align for horizontal bar charts.
    BarOptions -> Double
textShiftVert :: Double,
    -- | Whether to display text values above bars.
    BarOptions -> Bool
displayValues :: Bool,
    BarOptions -> FormatN
valueFormatN :: FormatN,
    BarOptions -> Orientation
barOrientation :: Orientation,
    BarOptions -> Stacked
barStacked :: Stacked,
    BarOptions -> LegendOptions
barLegendOptions :: LegendOptions
  }
  deriving (Int -> BarOptions -> ShowS
[BarOptions] -> ShowS
BarOptions -> String
(Int -> BarOptions -> ShowS)
-> (BarOptions -> String)
-> ([BarOptions] -> ShowS)
-> Show BarOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BarOptions -> ShowS
showsPrec :: Int -> BarOptions -> ShowS
$cshow :: BarOptions -> String
show :: BarOptions -> String
$cshowList :: [BarOptions] -> ShowS
showList :: [BarOptions] -> ShowS
Show, BarOptions -> BarOptions -> Bool
(BarOptions -> BarOptions -> Bool)
-> (BarOptions -> BarOptions -> Bool) -> Eq BarOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BarOptions -> BarOptions -> Bool
== :: BarOptions -> BarOptions -> Bool
$c/= :: BarOptions -> BarOptions -> Bool
/= :: BarOptions -> BarOptions -> Bool
Eq, (forall x. BarOptions -> Rep BarOptions x)
-> (forall x. Rep BarOptions x -> BarOptions) -> Generic BarOptions
forall x. Rep BarOptions x -> BarOptions
forall x. BarOptions -> Rep BarOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BarOptions -> Rep BarOptions x
from :: forall x. BarOptions -> Rep BarOptions x
$cto :: forall x. Rep BarOptions x -> BarOptions
to :: forall x. Rep BarOptions x -> BarOptions
Generic)

-- | The official bar options.
defaultBarOptions :: BarOptions
defaultBarOptions :: BarOptions
defaultBarOptions =
  [Style]
-> [Style]
-> Double
-> Double
-> Double
-> Double
-> Double
-> Bool
-> FormatN
-> Orientation
-> Stacked
-> LegendOptions
-> BarOptions
BarOptions
    [Style]
gs
    [Style]
ts
    Double
0.1
    Double
0
    Double
0.03
    Double
0.05
    (-Double
0.008)
    Bool
True
    (FStyle -> Maybe Int -> Int -> Bool -> Bool -> FormatN
FormatN FStyle
FSCommaPrec (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
2) Int
4 Bool
True Bool
True)
    Orientation
Vert
    Stacked
NonStacked
    LegendOptions
defaultLegendOptions
  where
    gs :: [Style]
gs = (\Int
x -> Style
defaultRectStyle Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Double Double
-> Double -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Double Double
#borderSize Double
0.005 Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Colour Colour
-> Colour -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Colour Colour
#borderColor (Int -> Colour
palette Int
x) Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Colour Colour
-> Colour -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Colour Colour
#color (Int -> Double -> Colour
paletteO Int
x Double
0.7)) (Int -> Style) -> [Int] -> [Style]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int
1, Int
2, Int
6, Int
7, Int
5, Int
3, Int
4, Int
0]
    ts :: [Style]
ts = (\Int
x -> Style
defaultTextStyle Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Colour Colour
-> Colour -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Colour Colour
#color (Int -> Colour
palette Int
x) Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Double Double
-> Double -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Double Double
#size Double
0.03) (Int -> Style) -> [Int] -> [Style]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int
1, Int
2, Int
6, Int
7, Int
5, Int
3, Int
4, Int
0]

-- | Number of bars per row of data
cols :: Stacked -> [[Double]] -> Int
cols :: Stacked -> [[Double]] -> Int
cols Stacked
Stacked [[Double]]
_ = Int
1
cols Stacked
NonStacked [[Double]]
xs = [[Double]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Double]]
xs

-- | Number of rows
rows :: [[Double]] -> Int
rows :: [[Double]] -> Int
rows [[Double]]
xs = [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
$ (Int
0 :) ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ [Double] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Double] -> Int) -> [[Double]] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Double]]
xs

-- | Width of each bar
barWidth :: BarOptions -> [[Double]] -> Double
barWidth :: BarOptions -> [[Double]] -> Double
barWidth BarOptions
o [[Double]]
xs = ((Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- BarOptions -> Double
outerGap BarOptions
o) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
c) Double -> Double -> Double
forall a. Num a => a -> a -> a
- (BarOptions -> Double
innerGap BarOptions
o Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
c Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
1))
  where
    c :: Double
c = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Double) -> Int -> Double
forall a b. (a -> b) -> a -> b
$ Stacked -> [[Double]] -> Int
cols (BarOptions -> Stacked
barStacked BarOptions
o) [[Double]]
xs

-- | Placement for the ith row jth column bar (x axis for vertical bars)
barX0 :: BarOptions -> [[Double]] -> Int -> Int -> Double
barX0 :: BarOptions -> [[Double]] -> Int -> Int -> Double
barX0 BarOptions
o [[Double]]
xs Int
i Int
j = BarOptions -> Double
outerGap BarOptions
o Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
j Double -> Double -> Double
forall a. Num a => a -> a -> a
* (BarOptions -> [[Double]] -> Double
barWidth BarOptions
o [[Double]]
xs Double -> Double -> Double
forall a. Num a => a -> a -> a
+ BarOptions -> Double
innerGap BarOptions
o)

-- | Make bars from the double list values, normalizing to one :: Rect.
--
-- >>> barRects defaultBarOptions [[1,2],[2,3]]
-- [[Rect (-0.5) (-0.26315789473684215) (-0.5) (-0.16666666666666669),Rect 2.631578947368418e-2 0.26315789473684204 (-0.5) 0.16666666666666663],[Rect (-0.26315789473684215) (-2.6315789473684292e-2) (-0.5) 0.16666666666666663,Rect 0.26315789473684204 0.4999999999999999 (-0.5) 0.5]]
--
-- >>> barRects defaultBarOptions [[]]
-- []
barRects :: BarOptions -> [[Double]] -> [[Rect Double]]
barRects :: BarOptions -> [[Double]] -> [[Rect Double]]
barRects BarOptions
o [[Double]]
xs = [[Rect Double]]
rects'
  where
    rects' :: [[Rect Double]]
rects' = ([Rect Double] -> [Rect Double])
-> [[Rect Double]] -> [[Rect Double]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Rect Double -> Rect Double) -> [Rect Double] -> [Rect Double]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Rect Double -> Rect Double -> Rect Double -> Rect Double
projectOnR Rect Double
forall a. Multiplicative a => a
one Rect Double
sb)) [[Rect Double]]
rects
    rects :: [[Rect Double]]
rects = ([Rect Double] -> [Rect Double])
-> [[Rect Double]] -> [[Rect Double]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Rect Double -> Rect Double) -> [Rect Double] -> [Rect Double]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Orientation -> Rect Double -> Rect Double
flipRect (BarOptions -> Orientation
barOrientation BarOptions
o))) ([[Rect Double]] -> [[Rect Double]])
-> [[Rect Double]] -> [[Rect Double]]
forall a b. (a -> b) -> a -> b
$ [[Rect Double]] -> [[Rect Double]]
accVals ([[Rect Double]] -> [[Rect Double]])
-> [[Rect Double]] -> [[Rect Double]]
forall a b. (a -> b) -> a -> b
$ (Double -> Double -> Rect Double)
-> [[Double]] -> [[Double]] -> [[Rect Double]]
forall a b c. (a -> b -> c) -> [[a]] -> [[b]] -> [[c]]
zip2With (\Double
y Double
x0 -> Rect Double -> Rect Double
forall a. Absolute a => a -> a
abs (Double -> Double -> Double -> Double -> Rect Double
forall a. a -> a -> a -> a -> Rect a
Rect Double
x0 (Double
x0 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ BarOptions -> [[Double]] -> Double
barWidth BarOptions
o [[Double]]
xs') Double
0 Double
y)) [[Double]]
xs' (BarOptions -> [[Double]] -> [[Double]]
barX0s BarOptions
o [[Double]]
xs')
    sb :: Rect Double
sb = Rect Double -> Maybe (Rect Double) -> Rect Double
forall a. a -> Maybe a -> a
fromMaybe Rect Double
forall a. Multiplicative a => a
one (Maybe (Rect Double) -> Rect Double)
-> Maybe (Rect Double) -> Rect Double
forall a b. (a -> b) -> a -> b
$ [Rect Double] -> Maybe (Rect Double)
forall a. Ord a => [Rect a] -> Maybe (Rect a)
foldRect ([[Rect Double]] -> [Rect Double]
forall a. Monoid a => [a] -> a
mconcat [[Rect Double]]
rects)
    xs' :: [[Double]]
xs' = [[Double]] -> [[Double]]
appendZeros [[Double]]
xs
    accVals :: [[Rect Double]] -> [[Rect Double]]
accVals = ([[Rect Double]] -> [[Rect Double]])
-> ([[Rect Double]] -> [[Rect Double]])
-> Bool
-> [[Rect Double]]
-> [[Rect Double]]
forall a. a -> a -> Bool -> a
bool [[Rect Double]] -> [[Rect Double]]
forall a. a -> a
id [[Rect Double]] -> [[Rect Double]]
forall {t :: * -> *} {a}.
(Foldable t, Num a) =>
t [Rect a] -> [[Rect a]]
accRectYs (BarOptions -> Stacked
barStacked BarOptions
o Stacked -> Stacked -> Bool
forall a. Eq a => a -> a -> Bool
== Stacked
Stacked)
    accRectYs :: t [Rect a] -> [[Rect a]]
accRectYs t [Rect a]
xss = ([Rect a] -> [[Rect a]] -> [[Rect a]])
-> [[Rect a]] -> t [Rect a] -> [[Rect a]]
forall a b. (a -> b -> b) -> b -> t a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr [Rect a] -> [[Rect a]] -> [[Rect a]]
forall {a}. Num a => [Rect a] -> [[Rect a]] -> [[Rect a]]
addLast [] t [Rect a]
xss
    addLast :: [Rect a] -> [[Rect a]] -> [[Rect a]]
addLast [Rect a]
rs [] = [[Rect a]
rs]
    addLast [Rect a]
rs res :: [[Rect a]]
res@([Rect a]
l : [[Rect a]]
_) = (Rect a -> Rect a -> Rect a) -> [Rect a] -> [Rect a] -> [Rect a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Rect a -> Rect a -> Rect a
forall {a}. Num a => Rect a -> Rect a -> Rect a
addW [Rect a]
rs [Rect a]
l [Rect a] -> [[Rect a]] -> [[Rect a]]
forall a. a -> [a] -> [a]
: [[Rect a]]
res
    addW :: Rect a -> Rect a -> Rect a
addW (Rect a
x a
z a
y a
w) (Rect a
_ a
_ a
_ a
w') = a -> a -> a -> a -> Rect a
forall a. a -> a -> a -> a -> Rect a
Rect a
x a
z (a
y a -> a -> a
forall a. Num a => a -> a -> a
+ a
w') (a
w a -> a -> a
forall a. Num a => a -> a -> a
+ a
w')

zip2With :: (a -> b -> c) -> [[a]] -> [[b]] -> [[c]]
zip2With :: forall a b c. (a -> b -> c) -> [[a]] -> [[b]] -> [[c]]
zip2With a -> b -> c
f = ([a] -> [b] -> [c]) -> [[a]] -> [[b]] -> [[c]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ((a -> b -> c) -> [a] -> [b] -> [c]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith a -> b -> c
f)

-- outer product on functors
iter2 :: (Functor f, Functor g) => (a -> b -> c) -> f a -> g b -> f (g c)
iter2 :: forall (f :: * -> *) (g :: * -> *) a b c.
(Functor f, Functor g) =>
(a -> b -> c) -> f a -> g b -> f (g c)
iter2 a -> b -> c
f f a
xs g b
ys = a -> b -> c
f (a -> b -> c) -> f a -> f (b -> c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
xs f (b -> c) -> ((b -> c) -> g c) -> f (g c)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ((b -> c) -> g b -> g c) -> g b -> (b -> c) -> g c
forall a b c. (a -> b -> c) -> b -> a -> c
flip (b -> c) -> g b -> g c
forall a b. (a -> b) -> g a -> g b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap g b
ys -- or (\a -> f a <$> ys) <$> xs

-- | Placements for the bars (x axis for vertical bars)
barX0s :: BarOptions -> [[Double]] -> [[Double]]
barX0s :: BarOptions -> [[Double]] -> [[Double]]
barX0s BarOptions
o [[Double]]
xs = [[Double]] -> [[Double]]
forall a. [[a]] -> [[a]]
transpose ([[Double]] -> [[Double]]) -> [[Double]] -> [[Double]]
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Double) -> [Int] -> [Int] -> [[Double]]
forall (f :: * -> *) (g :: * -> *) a b c.
(Functor f, Functor g) =>
(a -> b -> c) -> f a -> g b -> f (g c)
iter2 (BarOptions -> [[Double]] -> Int -> Int -> Double
barX0 BarOptions
o [[Double]]
xs) [Int
0 .. ([[Double]] -> Int
rows [[Double]]
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)] ([Int] -> [Int] -> Bool -> [Int]
forall a. a -> a -> Bool -> a
bool (Int -> Int -> [Int]
forall a. Int -> a -> [a]
replicate ([[Double]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Double]]
xs) Int
0) [Int
0 .. ([[Double]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Double]]
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)] (BarOptions -> Stacked
barStacked BarOptions
o Stacked -> Stacked -> Bool
forall a. Eq a => a -> a -> Bool
== Stacked
NonStacked))

flipRect :: Orientation -> Rect Double -> Rect Double
flipRect :: Orientation -> Rect Double -> Rect Double
flipRect Orientation
Vert Rect Double
r = Rect Double
r
flipRect Orientation
Hori (Rect Double
x Double
z Double
y Double
w) = Double -> Double -> Double -> Double -> Rect Double
forall a. a -> a -> a -> a -> Rect a
Rect Double
y Double
w Double
x Double
z

appendZeros :: [[Double]] -> [[Double]]
appendZeros :: [[Double]] -> [[Double]]
appendZeros [[Double]]
xs =
  ( \[Double]
x ->
      Int -> [Double] -> [Double]
forall a. Int -> [a] -> [a]
take
        ([[Double]] -> Int
rows [[Double]]
xs)
        ([Double]
x [Double] -> [Double] -> [Double]
forall a. Semigroup a => a -> a -> a
<> Double -> [Double]
forall a. a -> [a]
repeat Double
0)
  )
    ([Double] -> [Double]) -> [[Double]] -> [[Double]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Double]]
xs

-- | A bar chart.
--
-- >>> emptyBar = barChart defaultBarOptions (BarData [] [] [])
-- >>> foldOf (#chartTree % charts') emptyBar
-- []
barChart :: BarOptions -> BarData -> ChartOptions
barChart :: BarOptions -> BarData -> ChartOptions
barChart BarOptions
bo BarData
bd =
  ChartOptions
forall a. Monoid a => a
mempty
    ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
-> HudOptions -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
#hudOptions (BarOptions -> BarData -> HudOptions
barHudOptions BarOptions
bo BarData
bd)
    ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
-> ChartTree -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set
      #chartTree
      ( Text -> [Chart] -> ChartTree
named
          Text
"barchart"
          ( BarOptions -> BarData -> [Chart]
bars BarOptions
bo BarData
bd
              [Chart] -> [Chart] -> [Chart]
forall a. Semigroup a => a -> a -> a
<> [Chart] -> [Chart] -> Bool -> [Chart]
forall a. a -> a -> Bool -> a
bool [] (BarOptions -> BarData -> [Chart]
barTextCharts BarOptions
bo BarData
bd) (Optic' A_Lens NoIx BarOptions Bool -> BarOptions -> Bool
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx BarOptions Bool
#displayValues BarOptions
bo)
          )
      )

barHudOptions :: BarOptions -> BarData -> HudOptions
barHudOptions :: BarOptions -> BarData -> HudOptions
barHudOptions BarOptions
bo BarData
bd =
  HudOptions
forall a. Monoid a => a
mempty
    HudOptions -> (HudOptions -> HudOptions) -> HudOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority AxisOptions]
  [Priority AxisOptions]
-> [Priority AxisOptions] -> HudOptions -> HudOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority AxisOptions]
  [Priority AxisOptions]
#axes [Double -> AxisOptions -> Priority AxisOptions
forall a. Double -> a -> Priority a
Priority Double
1 AxisOptions
axis1]
    HudOptions -> (HudOptions -> HudOptions) -> HudOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority LegendOptions]
  [Priority LegendOptions]
-> [Priority LegendOptions] -> HudOptions -> HudOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority LegendOptions]
  [Priority LegendOptions]
#legends [Double -> LegendOptions -> Priority LegendOptions
forall a. Double -> a -> Priority a
Priority Double
10 (LegendOptions
o LegendOptions -> (LegendOptions -> LegendOptions) -> LegendOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens
  NoIx
  LegendOptions
  LegendOptions
  [(Text, [Chart])]
  [(Text, [Chart])]
-> [(Text, [Chart])] -> LegendOptions -> LegendOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic
  A_Lens
  NoIx
  LegendOptions
  LegendOptions
  [(Text, [Chart])]
  [(Text, [Chart])]
#legendCharts (BarOptions -> BarData -> [(Text, [Chart])]
barLegendContent BarOptions
bo BarData
bd))]
  where
    o :: LegendOptions
o = Optic' A_Lens NoIx BarOptions LegendOptions
-> BarOptions -> LegendOptions
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx BarOptions LegendOptions
#barLegendOptions BarOptions
bo
    axis1 :: AxisOptions
axis1 = AxisOptions -> AxisOptions -> Bool -> AxisOptions
forall a. a -> a -> Bool -> a
bool AxisOptions
defaultXAxisOptions AxisOptions
defaultYAxisOptions (BarOptions -> Orientation
barOrientation BarOptions
bo Orientation -> Orientation -> Bool
forall a. Eq a => a -> a -> Bool
== Orientation
Hori) AxisOptions -> (AxisOptions -> AxisOptions) -> AxisOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens
  NoIx
  AxisOptions
  AxisOptions
  (Maybe TickStyle)
  (Maybe TickStyle)
-> Maybe TickStyle -> AxisOptions -> AxisOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
#ticks Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
-> Optic
     A_Lens NoIx Ticks Ticks (Maybe TickStyle) (Maybe TickStyle)
-> Optic
     A_Lens
     NoIx
     AxisOptions
     AxisOptions
     (Maybe TickStyle)
     (Maybe TickStyle)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Ticks Ticks (Maybe TickStyle) (Maybe TickStyle)
#lineTick) Maybe TickStyle
forall a. Maybe a
Nothing AxisOptions -> (AxisOptions -> AxisOptions) -> AxisOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx AxisOptions AxisOptions Tick Tick
-> Tick -> AxisOptions -> AxisOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
#ticks Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
-> Optic A_Lens NoIx Ticks Ticks Tick Tick
-> Optic A_Lens NoIx AxisOptions AxisOptions Tick Tick
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Ticks Ticks Tick Tick
#tick) (BarData -> Tick
barTicks BarData
bd)

-- | Two dimensional data, maybe with row and column labels.
data BarData = BarData
  { BarData -> [[Double]]
barData :: [[Double]],
    BarData -> [Text]
barRowLabels :: [Text],
    BarData -> [Text]
barColumnLabels :: [Text]
  }
  deriving (Int -> BarData -> ShowS
[BarData] -> ShowS
BarData -> String
(Int -> BarData -> ShowS)
-> (BarData -> String) -> ([BarData] -> ShowS) -> Show BarData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BarData -> ShowS
showsPrec :: Int -> BarData -> ShowS
$cshow :: BarData -> String
show :: BarData -> String
$cshowList :: [BarData] -> ShowS
showList :: [BarData] -> ShowS
Show, BarData -> BarData -> Bool
(BarData -> BarData -> Bool)
-> (BarData -> BarData -> Bool) -> Eq BarData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BarData -> BarData -> Bool
== :: BarData -> BarData -> Bool
$c/= :: BarData -> BarData -> Bool
/= :: BarData -> BarData -> Bool
Eq, (forall x. BarData -> Rep BarData x)
-> (forall x. Rep BarData x -> BarData) -> Generic BarData
forall x. Rep BarData x -> BarData
forall x. BarData -> Rep BarData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BarData -> Rep BarData x
from :: forall x. BarData -> Rep BarData x
$cto :: forall x. Rep BarData x -> BarData
to :: forall x. Rep BarData x -> BarData
Generic)

-- | Calculate the Rect range of a bar data set.
--
-- >>> barRange [[1,2],[2,3]]
-- Rect 0.0 2.0 0.0 3.0
--
-- >>> barRange [[]]
-- Rect (-0.5) 0.5 (-0.5) 0.5
barRange ::
  [[Double]] -> Rect Double
barRange :: [[Double]] -> Rect Double
barRange [[Double]]
ys = Rect Double -> Rect Double
padSingletons (Rect Double -> Rect Double) -> Rect Double -> Rect Double
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Double -> Double -> Rect Double
forall a. a -> a -> a -> a -> Rect a
Rect Double
0 (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Double) -> Int -> Double
forall a b. (a -> b) -> a -> b
$ [[Double]] -> Int
rows [[Double]]
ys) (Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
0 Double
l) Double
u
  where
    (Range Double
l Double
u) = Range Double -> Maybe (Range Double) -> Range Double
forall a. a -> Maybe a -> a
fromMaybe Range Double
forall a. Multiplicative a => a
one (Maybe (Range Double) -> Range Double)
-> Maybe (Range Double) -> Range Double
forall a b. (a -> b) -> a -> b
$ [Element (Range Double)] -> Maybe (Range Double)
forall s (f :: * -> *).
(Space s, Traversable f) =>
f (Element s) -> Maybe s
space1 ([Element (Range Double)] -> Maybe (Range Double))
-> [Element (Range Double)] -> Maybe (Range Double)
forall a b. (a -> b) -> a -> b
$ [[Double]] -> [Double]
forall a. Monoid a => [a] -> a
mconcat [[Double]]
ys

-- | A bar chart without hud trimmings.
--
-- >>> bars defaultBarOptions (BarData [[1,2],[2,3]] [] [])
-- [Chart {chartStyle = Style {size = 6.0e-2, borderSize = 5.0e-3, color = Colour 0.02 0.29 0.48 0.70, borderColor = Colour 0.02 0.29 0.48 1.00, scaleP = NoScaleP, textAnchor = AnchorMiddle, rotation = Nothing, translate = Nothing, escapeText = EscapeText, frame = Nothing, lineCap = Nothing, lineJoin = Nothing, dasharray = Nothing, dashoffset = Nothing, hsize = 0.6, vsize = 1.1, vshift = -0.25, glyphShape = SquareGlyph}, chartData = RectData [Rect (-0.5) (-0.26315789473684215) (-0.5) (-0.16666666666666669),Rect 2.631578947368418e-2 0.26315789473684204 (-0.5) 0.16666666666666663]},Chart {chartStyle = Style {size = 6.0e-2, borderSize = 5.0e-3, color = Colour 0.66 0.07 0.55 0.70, borderColor = Colour 0.66 0.07 0.55 1.00, scaleP = NoScaleP, textAnchor = AnchorMiddle, rotation = Nothing, translate = Nothing, escapeText = EscapeText, frame = Nothing, lineCap = Nothing, lineJoin = Nothing, dasharray = Nothing, dashoffset = Nothing, hsize = 0.6, vsize = 1.1, vshift = -0.25, glyphShape = SquareGlyph}, chartData = RectData [Rect (-0.26315789473684215) (-2.6315789473684292e-2) (-0.5) 0.16666666666666663,Rect 0.26315789473684204 0.4999999999999999 (-0.5) 0.5]}]
--
-- >>> bars defaultBarOptions (BarData [[]] [] [])
-- []
bars :: BarOptions -> BarData -> [Chart]
bars :: BarOptions -> BarData -> [Chart]
bars BarOptions
bo BarData
bd = [Chart] -> [Chart] -> Bool -> [Chart]
forall a. a -> a -> Bool -> a
bool [Chart]
cs [] ([Double] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Double] -> Bool) -> [Double] -> Bool
forall a b. (a -> b) -> a -> b
$ [[Double]] -> [Double]
forall a. Monoid a => [a] -> a
mconcat ([[Double]] -> [Double]) -> [[Double]] -> [Double]
forall a b. (a -> b) -> a -> b
$ Optic' A_Lens NoIx BarData [[Double]] -> BarData -> [[Double]]
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx BarData [[Double]]
#barData BarData
bd)
  where
    cs :: [Chart]
cs =
      (Style -> [Rect Double] -> Chart)
-> [Style] -> [[Rect Double]] -> [Chart]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
        (\Style
o [Rect Double]
d -> Style -> [Rect Double] -> Chart
RectChart Style
o [Rect Double]
d)
        (Optic' A_Lens NoIx BarOptions [Style] -> BarOptions -> [Style]
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx BarOptions [Style]
#barRectStyles BarOptions
bo [Style] -> [Style] -> [Style]
forall a. Semigroup a => a -> a -> a
<> Style -> [Style]
forall a. a -> [a]
repeat Style
defaultRectStyle)
        (BarOptions -> [[Double]] -> [[Rect Double]]
barRects BarOptions
bo (Optic' A_Lens NoIx BarData [[Double]] -> BarData -> [[Double]]
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx BarData [[Double]]
#barData BarData
bd))

-- | Sensible ticks for a bar chart.
barTicks :: BarData -> Tick
barTicks :: BarData -> Tick
barTicks BarData
bd
  | [[Double]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Optic' A_Lens NoIx BarData [[Double]] -> BarData -> [[Double]]
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx BarData [[Double]]
#barData BarData
bd) = Tick
TickNone
  | [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Optic' A_Lens NoIx BarData [Text] -> BarData -> [Text]
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx BarData [Text]
#barRowLabels BarData
bd) =
      [Text] -> Tick
TickLabels ([Text] -> Tick) -> [Text] -> Tick
forall a b. (a -> b) -> a -> b
$ String -> Text
pack (String -> Text) -> (Int -> String) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show (Int -> Text) -> [Int] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int
0 .. ([[Double]] -> Int
rows (Optic' A_Lens NoIx BarData [[Double]] -> BarData -> [[Double]]
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx BarData [[Double]]
#barData BarData
bd) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)]
  | Bool
otherwise =
      [Text] -> Tick
TickLabels ([Text] -> Tick) -> [Text] -> Tick
forall a b. (a -> b) -> a -> b
$
        Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
take ([[Double]] -> Int
rows (Optic' A_Lens NoIx BarData [[Double]] -> BarData -> [[Double]]
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx BarData [[Double]]
#barData BarData
bd)) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$
          Optic' A_Lens NoIx BarData [Text] -> BarData -> [Text]
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx BarData [Text]
#barRowLabels BarData
bd [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> Text -> [Text]
forall a. a -> [a]
repeat Text
""

-- | A bar legend
barLegendContent :: BarOptions -> BarData -> [(Text, [Chart])]
barLegendContent :: BarOptions -> BarData -> [(Text, [Chart])]
barLegendContent BarOptions
bo BarData
bd
  | [[Double]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Optic' A_Lens NoIx BarData [[Double]] -> BarData -> [[Double]]
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx BarData [[Double]]
#barData BarData
bd) = []
  | [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Optic' A_Lens NoIx BarData [Text] -> BarData -> [Text]
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx BarData [Text]
#barColumnLabels BarData
bd) = []
  | Bool
otherwise =
      [Text] -> [[Chart]] -> [(Text, [Chart])]
forall a b. [a] -> [b] -> [(a, b)]
zip
        (Optic' A_Lens NoIx BarData [Text] -> BarData -> [Text]
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx BarData [Text]
#barColumnLabels BarData
bd [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> Text -> [Text]
forall a. a -> [a]
repeat Text
"")
        ((\Style
s -> [Style -> ChartData -> Chart
Chart Style
s ([Rect Double] -> ChartData
RectData [Rect Double
forall a. Multiplicative a => a
one])]) (Style -> [Chart]) -> [Style] -> [[Chart]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> [Style] -> [Style]
forall a. Int -> [a] -> [a]
take ([[Double]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Optic' A_Lens NoIx BarData [[Double]] -> BarData -> [[Double]]
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx BarData [[Double]]
#barData BarData
bd)) (Optic' A_Lens NoIx BarOptions [Style] -> BarOptions -> [Style]
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx BarOptions [Style]
#barRectStyles BarOptions
bo))

barTexts :: BarOptions -> [[Double]] -> [[(Text, Point Double)]]
barTexts :: BarOptions -> [[Double]] -> [[(Text, Point Double)]]
barTexts BarOptions
o [[Double]]
xs = (Double -> Rect Double -> (Text, Point Double))
-> [[Double]] -> [[Rect Double]] -> [[(Text, Point Double)]]
forall a b c. (a -> b -> c) -> [[a]] -> [[b]] -> [[c]]
zip2With (\Double
x Rect Double
r -> (FormatN -> Double -> Text
formatN (BarOptions -> FormatN
valueFormatN BarOptions
o) Double
x, Orientation -> Rect Double -> Double -> Point Double
forall {a}.
(Ord a, Num a) =>
Orientation -> Rect Double -> a -> Point Double
gapt (BarOptions -> Orientation
barOrientation BarOptions
o) Rect Double
r Double
x)) [[Double]]
xs (BarOptions -> [[Double]] -> [[Rect Double]]
barRects BarOptions
o [[Double]]
xs)
  where
    gapt :: Orientation -> Rect Double -> a -> Point Double
gapt Orientation
Vert (Rect Double
x Double
z Double
y Double
w) a
x' = Double -> Double -> Point Double
forall a. a -> a -> Point a
Point ((Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
z) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2) (Double -> Double -> Bool -> Double
forall a. a -> a -> Bool -> a
bool (Double
w Double -> Double -> Double
forall a. Num a => a -> a -> a
+ BarOptions -> Double
textGap BarOptions
o) (Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
- BarOptions -> Double
textGapNegative BarOptions
o) (a
x' a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0))
    gapt Orientation
Hori (Rect Double
x Double
z Double
y Double
w) a
x' = Double -> Double -> Point Double
forall a. a -> a -> Point a
Point (Double -> Double -> Bool -> Double
forall a. a -> a -> Bool -> a
bool (Double
z Double -> Double -> Double
forall a. Num a => a -> a -> a
+ BarOptions -> Double
textGap BarOptions
o) (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
- BarOptions -> Double
textGapNegative BarOptions
o) (a
x' a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0)) ((Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
w) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ BarOptions -> Double
textShiftVert BarOptions
o)

-- | Placed text, hold the bars.
barTextCharts :: BarOptions -> BarData -> [Chart]
barTextCharts :: BarOptions -> BarData -> [Chart]
barTextCharts BarOptions
bo BarData
bd =
  (Style -> [(Text, Point Double)] -> Chart)
-> [Style] -> [[(Text, Point Double)]] -> [Chart]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Style -> [(Text, Point Double)] -> Chart
TextChart (Optic' A_Lens NoIx BarOptions [Style] -> BarOptions -> [Style]
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx BarOptions [Style]
#barTextStyles BarOptions
bo [Style] -> [Style] -> [Style]
forall a. Semigroup a => a -> a -> a
<> Style -> [Style]
forall a. a -> [a]
repeat Style
defaultTextStyle [Style] -> ([Style] -> [Style]) -> [Style]
forall a b. a -> (a -> b) -> b
& Optic A_Traversal (WithIx Int) [Style] [Style] ScaleP ScaleP
-> ScaleP -> [Style] -> [Style]
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (IxTraversal Int [Style] [Style] Style Style
forall i s t a b. Each i s t a b => IxTraversal i s t a b
each IxTraversal Int [Style] [Style] Style Style
-> Optic A_Lens NoIx Style Style ScaleP ScaleP
-> Optic A_Traversal (WithIx Int) [Style] [Style] ScaleP ScaleP
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens NoIx Style Style ScaleP ScaleP
#scaleP) ScaleP
ScalePArea) (BarOptions -> [[Double]] -> [[(Text, Point Double)]]
barTexts BarOptions
bo (Optic' A_Lens NoIx BarData [[Double]] -> BarData -> [[Double]]
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx BarData [[Double]]
#barData BarData
bd))