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

-- | Bar charts
module Chart.Bar
  ( BarOptions (..),
    defaultBarOptions,
    BarData (..),
    barRange,
    bars,
    barChart,
    barRects,
  )
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 (scanl', 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 -> [RectStyle]
barRectStyles :: [RectStyle],
    BarOptions -> [TextStyle]
barTextStyles :: [TextStyle],
    -- | gap between each bar collection row.
    BarOptions -> Double
outerGap :: Double,
    -- | gap between bars within a row collection, negative 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,
    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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BarOptions] -> ShowS
$cshowList :: [BarOptions] -> ShowS
show :: BarOptions -> String
$cshow :: BarOptions -> String
showsPrec :: Int -> BarOptions -> ShowS
$cshowsPrec :: Int -> BarOptions -> ShowS
Show, BarOptions -> BarOptions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BarOptions -> BarOptions -> Bool
$c/= :: BarOptions -> BarOptions -> Bool
== :: BarOptions -> BarOptions -> Bool
$c== :: BarOptions -> BarOptions -> Bool
Eq, 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
$cto :: forall x. Rep BarOptions x -> BarOptions
$cfrom :: forall x. BarOptions -> Rep BarOptions x
Generic)

-- | 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 = forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Double]]
xs

-- | Number of rows
rows :: [[Double]] -> Int
rows :: [[Double]] -> Int
rows [[Double]]
xs = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall a b. (a -> b) -> a -> b
$ (Int
0 :) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length 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 forall a. Num a => a -> a -> a
- BarOptions -> Double
outerGap BarOptions
o) forall a. Fractional a => a -> a -> a
/ Double
c) forall a. Num a => a -> a -> a
- (BarOptions -> Double
innerGap BarOptions
o forall a. Num a => a -> a -> a
* (Double
c forall a. Num a => a -> a -> a
- Double
1))
  where
    c :: Double
c = forall a b. (Integral a, Num b) => a -> b
fromIntegral 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 forall a. Fractional a => a -> a -> a
/ Double
2 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
j forall a. Num a => a -> a -> a
* (BarOptions -> [[Double]] -> Double
barWidth BarOptions
o [[Double]]
xs forall a. Num a => a -> a -> a
+ BarOptions -> Double
innerGap BarOptions
o)

-- | Make bars from the double list values.
--
-- >>> barRects defaultBarOptions [[1,2],[2,3]]
-- [[Rect 5.0e-2 0.5 0.0 1.0,Rect 1.05 1.5 0.0 2.0],[Rect 0.5 0.95 0.0 2.0,Rect 1.5 1.95 0.0 3.0]]
--
-- >>> barRects defaultBarOptions [[]]
-- []
barRects :: BarOptions -> [[Double]] -> [[Rect Double]]
barRects :: BarOptions -> [[Double]] -> [[Rect Double]]
barRects BarOptions
o [[Double]]
xs = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Orientation -> Rect Double -> Rect Double
flipRect (BarOptions -> Orientation
barOrientation BarOptions
o)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b c. (a -> b -> c) -> [[a]] -> [[b]] -> [[c]]
zip2With (\Double
y Double
x0 -> forall a. Absolute a => a -> a
abs (forall a. a -> a -> a -> a -> Rect a
Rect Double
x0 (Double
x0 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')
  where
    xs' :: [[Double]]
xs' = forall a. a -> a -> Bool -> a
bool forall a. a -> a
id [[Double]] -> [[Double]]
accRows (BarOptions -> Stacked
barStacked BarOptions
o forall a. Eq a => a -> a -> Bool
== Stacked
Stacked) ([[Double]] -> [[Double]]
appendZeros [[Double]]
xs)

zip2With :: (a -> b -> c) -> [[a]] -> [[b]] -> [[c]]
zip2With :: forall a b c. (a -> b -> c) -> [[a]] -> [[b]] -> [[c]]
zip2With a -> b -> c
f = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
xs forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> forall a b c. (a -> b -> c) -> b -> a -> c
flip 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 = forall a. [[a]] -> [[a]]
transpose forall a b. (a -> b) -> a -> b
$ 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 forall a. Num a => a -> a -> a
- Int
1)] [Int
0 .. Stacked -> [[Double]] -> Int
cols (BarOptions -> Stacked
barStacked BarOptions
o) [[Double]]
xs forall a. Num a => a -> a -> a
- Int
1]

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) = 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 ->
      forall a. Int -> [a] -> [a]
take
        ([[Double]] -> Int
rows [[Double]]
xs)
        ([Double]
x forall a. Semigroup a => a -> a -> a
<> forall a. a -> [a]
repeat Double
0)
  )
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Double]]
xs

accRows :: [[Double]] -> [[Double]]
accRows :: [[Double]] -> [[Double]]
accRows [[Double]]
xs = forall a. [[a]] -> [[a]]
transpose forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
drop Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl' forall a. Num a => a -> a -> a
(+) Double
0 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. [[a]] -> [[a]]
transpose (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
toList [[Double]]
xs)

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

barHudOptions :: BarOptions -> BarData -> HudOptions
barHudOptions :: BarOptions -> BarData -> HudOptions
barHudOptions BarOptions
bo BarData
bd =
  forall a. Monoid a => a
mempty
    forall a b. a -> (a -> b) -> b
& forall a. IsLabel "axes" a => a
#axes
      forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ [ (Priority
1, AxisOptions
axis1)
         ]
    forall a b. a -> (a -> b) -> b
& forall a. IsLabel "legends" a => a
#legends
      forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ [ (Priority
10, LegendOptions
o forall a b. a -> (a -> b) -> b
& forall a. IsLabel "content" a => a
#content forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ BarOptions -> BarData -> [(Text, [Chart])]
barLegendContent BarOptions
bo BarData
bd)
         ]
  where
    o :: LegendOptions
o = forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "barLegendOptions" a => a
#barLegendOptions BarOptions
bo
    axis1 :: AxisOptions
axis1 = forall a. a -> a -> Bool -> a
bool forall a. a -> a
id AxisOptions -> AxisOptions
flipAxis (BarOptions -> Orientation
barOrientation BarOptions
bo forall a. Eq a => a -> a -> Bool
== Orientation
Hori) (AxisOptions
defaultAxisOptions forall a b. a -> (a -> b) -> b
& forall a. IsLabel "ticks" a => a
#ticks 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
% forall a. IsLabel "ltick" a => a
#ltick forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ forall a. Maybe a
Nothing forall a b. a -> (a -> b) -> b
& forall a. IsLabel "ticks" a => a
#ticks 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
% forall a. IsLabel "style" a => a
#style forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ BarData -> TickStyle
barTicks BarData
bd)

-- | The official bar options.
defaultBarOptions :: BarOptions
defaultBarOptions :: BarOptions
defaultBarOptions =
  [RectStyle]
-> [TextStyle]
-> Double
-> Double
-> Double
-> Double
-> Bool
-> FormatN
-> Orientation
-> Stacked
-> LegendOptions
-> BarOptions
BarOptions
    [RectStyle]
gs
    [TextStyle]
ts
    Double
0.1
    Double
0
    Double
0.04
    Double
0.1
    Bool
True
    (FStyle -> Maybe Int -> Int -> Bool -> Bool -> FormatN
FormatN FStyle
FSCommaPrec (forall a. a -> Maybe a
Just Int
2) Int
4 Bool
True Bool
True)
    Orientation
Vert
    Stacked
NonStacked
    LegendOptions
defaultLegendOptions
  where
    gs :: [RectStyle]
gs = (\Int
x -> Double -> Colour -> Colour -> RectStyle
RectStyle Double
0.005 (Int -> Colour
palette1 Int
x) (Int -> Double -> Colour
palette1a Int
x Double
0.7)) 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 :: [TextStyle]
ts = (\Int
x -> TextStyle
defaultTextStyle forall a b. a -> (a -> b) -> b
& forall a. IsLabel "color" a => a
#color forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Int -> Colour
palette1 Int
x forall a b. a -> (a -> b) -> b
& forall a. IsLabel "size" a => a
#size forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Double
0.24) 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]

-- | 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BarData] -> ShowS
$cshowList :: [BarData] -> ShowS
show :: BarData -> String
$cshow :: BarData -> String
showsPrec :: Int -> BarData -> ShowS
$cshowsPrec :: Int -> BarData -> ShowS
Show, BarData -> BarData -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BarData -> BarData -> Bool
$c/= :: BarData -> BarData -> Bool
== :: BarData -> BarData -> Bool
$c== :: BarData -> BarData -> Bool
Eq, 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
$cto :: forall x. Rep BarData x -> BarData
$cfrom :: forall x. BarData -> Rep BarData x
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 = Maybe (Rect Double) -> Rect Double
singletonGuard forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> a -> a -> a -> Rect a
Rect Double
0 (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ [[Double]] -> Int
rows [[Double]]
ys) (forall a. Ord a => a -> a -> a
min Double
0 Double
l) Double
u
  where
    (Range Double
l Double
u) = forall a. a -> Maybe a -> a
fromMaybe forall a. Multiplicative a => a
one forall a b. (a -> b) -> a -> b
$ forall s (f :: * -> *).
(Space s, Traversable f) =>
f (Element s) -> Maybe s
space1 forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [[Double]]
ys

-- | A bar chart without hud trimmings.
--
-- >>> bars defaultBarOptions (BarData [[1,2],[2,3]] [] [])
-- [RectChart (RectStyle {borderSize = 5.0e-3, borderColor = Colour 0.02 0.29 0.48 1.00, color = Colour 0.02 0.29 0.48 0.70}) [Rect 5.0e-2 0.5 0.0 1.0,Rect 1.05 1.5 0.0 2.0],RectChart (RectStyle {borderSize = 5.0e-3, borderColor = Colour 0.66 0.07 0.55 1.00, color = Colour 0.66 0.07 0.55 0.70}) [Rect 0.5 0.95 0.0 2.0,Rect 1.5 1.95 0.0 3.0],BlankChart [Rect 0.0 2.0 0.0 3.0]]
--
-- >>> bars defaultBarOptions (BarData [[]] [] [])
-- []
bars :: BarOptions -> BarData -> [Chart]
bars :: BarOptions -> BarData -> [Chart]
bars BarOptions
bo BarData
bd = forall a. a -> a -> Bool -> a
bool [Chart]
cs [] (forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view forall a. IsLabel "barData" a => a
#barData BarData
bd)
  where
    cs :: [Chart]
cs =
      forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
        (\RectStyle
o [Rect Double]
d -> RectStyle -> [Rect Double] -> Chart
RectChart RectStyle
o [Rect Double]
d)
        (BarOptions
bo forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "barRectStyles" a => a
#barRectStyles forall a. Semigroup a => a -> a -> a
<> forall a. a -> [a]
repeat RectStyle
defaultRectStyle)
        (BarOptions -> [[Double]] -> [[Rect Double]]
barRects BarOptions
bo (BarData
bd forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "barData" a => a
#barData))
        forall a. Semigroup a => a -> a -> a
<> [[Rect Double] -> Chart
BlankChart [[[Double]] -> Rect Double
barRange (BarData
bd forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "barData" a => a
#barData)]]

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

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

flipPoint :: Orientation -> Point a -> Point a
flipPoint :: forall a. Orientation -> Point a -> Point a
flipPoint Orientation
Vert Point a
p = Point a
p
flipPoint Orientation
Hori (Point a
x a
y) = forall a. a -> a -> Point a
Point a
y a
x

maxAbsValue :: [[Double]] -> Double
maxAbsValue :: [[Double]] -> Double
maxAbsValue [[Double]]
xs = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Absolute a => a -> a
abs (Double
0 forall a. a -> [a] -> [a]
: forall a. Monoid a => [a] -> a
mconcat [[Double]]
xs)

barTexts :: BarOptions -> [[Double]] -> [[(Text, Point Double)]]
barTexts :: BarOptions -> [[Double]] -> [[(Text, Point Double)]]
barTexts BarOptions
o [[Double]]
xs = forall a b c. (a -> b -> c) -> [[a]] -> [[b]] -> [[c]]
zip2With (\Text
t (Rect Double
x Double
z Double
y Double
w) -> (Text
t, forall a. Orientation -> Point a -> Point a
flipPoint (BarOptions -> Orientation
barOrientation BarOptions
o) (forall a. a -> a -> Point a
Point ((Double
x forall a. Num a => a -> a -> a
+ Double
z) forall a. Fractional a => a -> a -> a
/ Double
2) (forall a. a -> a -> Bool -> a
bool (Double
w forall a. Num a => a -> a -> a
+ Double
gap) (Double
y forall a. Num a => a -> a -> a
- Double
gapn) (Double
y forall a. Ord a => a -> a -> Bool
< Double
0))))) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FormatN -> Double -> Text
formatN (BarOptions -> FormatN
valueFormatN BarOptions
o)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Double]]
xs) (BarOptions -> [[Double]] -> [[Rect Double]]
barRects BarOptions
o [[Double]]
xs)
  where
    gap :: Double
gap = BarOptions -> Double
textGap BarOptions
o forall a. Num a => a -> a -> a
* [[Double]] -> Double
maxAbsValue [[Double]]
xs
    gapn :: Double
gapn = BarOptions -> Double
textGapNegative BarOptions
o forall a. Num a => a -> a -> a
* [[Double]] -> Double
maxAbsValue [[Double]]
xs

-- | Placed text, hold the bars.
barTextCharts :: BarOptions -> BarData -> [Chart]
barTextCharts :: BarOptions -> BarData -> [Chart]
barTextCharts BarOptions
bo BarData
bd =
  forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith TextStyle -> [(Text, Point Double)] -> Chart
TextChart (BarOptions
bo forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "barTextStyles" a => a
#barTextStyles forall a. Semigroup a => a -> a -> a
<> forall a. a -> [a]
repeat TextStyle
defaultTextStyle) (BarOptions -> [[Double]] -> [[(Text, Point Double)]]
barTexts BarOptions
bo (BarData
bd forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "barData" a => a
#barData))