{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
{-# OPTIONS_GHC -Wall #-}

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

import Chart.Data
import Chart.Hud
import Chart.Primitive
import Chart.Style
import Chart.Svg
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.
--
-- >>> 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
--
-- > writeChartSvg "other/bar.svg" barExample
--
-- ![bar chart example](other/bar.svg)
data BarOptions = BarOptions
  { BarOptions -> [RectStyle]
barRectStyles :: [RectStyle],
    BarOptions -> [TextStyle]
barTextStyles :: [TextStyle],
    BarOptions -> Double
outerGap :: Double,
    BarOptions -> Double
innerGap :: Double,
    BarOptions -> Double
textGap :: Double,
    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)

-- | A bar chart.
--
-- >>> emptyBar = barChart defaultBarOptions (BarData [] [] [])
-- >>> foldOf (#charts % charts') emptyBar
-- []
barChart :: BarOptions -> BarData -> ChartSvg
barChart :: BarOptions -> BarData -> ChartSvg
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
.~ [ (Double
1, AxisOptions
axis1),
           (Double
1, AxisOptions
axis2)
         ]
    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
.~ [ (Double
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
Vert) (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)
    axis2 :: AxisOptions
axis2 = 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

-- | 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 -> Bool -> FormatN
FormatN FStyle
FSCommaPrec (forall a. a -> Maybe a
Just Int
2) 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)

-- | Convert BarData to Rects
--
-- >>> 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 [RectStyle]
_ [TextStyle]
_ Double
ogap Double
igap Double
_ Double
_ Bool
_ FormatN
_ Orientation
orient Stacked
stacked LegendOptions
_) [[Double]]
bs = Orientation -> [[Rect Double]]
rects'' Orientation
orient
  where
    bs' :: [[Double]]
bs' = [[Double]] -> [[Double]]
appendZero [[Double]]
bs
    rects'' :: Orientation -> [[Rect Double]]
rects'' Orientation
Vert = [[Rect Double]]
rects'
    rects'' Orientation
Hori = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(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) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Rect Double]]
rects'
    rects' :: [[Rect Double]]
rects' = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Double -> [(Double, Double)] -> [Rect Double]
batSet (forall a. a -> a -> Bool -> a
bool [Double
0 ..] (forall a. a -> [a]
repeat Double
0) (Stacked
stacked forall a. Eq a => a -> a -> Bool
== Stacked
Stacked)) (Stacked -> [[Double]] -> [[(Double, Double)]]
barDataLowerUpper Stacked
stacked [[Double]]
bs')
    batSet :: Double -> [(Double, Double)] -> [Rect Double]
batSet Double
z [(Double, Double)]
ys =
      forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
        ( \Double
x (Double
yl, Double
yh) ->
            forall a. Signed a => a -> a
abs
              ( forall a. a -> a -> a -> a -> Rect a
Rect
                  (Double
x forall a. Num a => a -> a -> a
+ (Double
ogap forall a. Fractional a => a -> a -> a
/ Double
2) forall a. Num a => a -> a -> a
+ Double
z forall a. Num a => a -> a -> a
* Double
bstep)
                  (Double
x forall a. Num a => a -> a -> a
+ (Double
ogap forall a. Fractional a => a -> a -> a
/ Double
2) forall a. Num a => a -> a -> a
+ Double
z forall a. Num a => a -> a -> a
* Double
bstep forall a. Num a => a -> a -> a
+ Double
bstep forall a. Num a => a -> a -> a
- Double
igap')
                  Double
yl
                  Double
yh
              )
        )
        [Double
0 ..]
        [(Double, Double)]
ys
    n :: Double
n = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Double]]
bs')
    bstep :: Double
bstep = case Stacked
stacked of
      Stacked
NonStacked -> (Double
1 forall a. Num a => a -> a -> a
- Double
ogap forall a. Num a => a -> a -> a
+ (Double
n forall a. Num a => a -> a -> a
- Double
1) forall a. Num a => a -> a -> a
* Double
igap') forall a. Fractional a => a -> a -> a
/ Double
n
      Stacked
Stacked -> Double
1 forall a. Num a => a -> a -> a
- Double
ogap
    igap' :: Double
igap' = case Stacked
stacked of
      Stacked
NonStacked -> Double
igap forall a. Num a => a -> a -> a
* (Double
1 forall a. Num a => a -> a -> a
- Double
ogap)
      Stacked
Stacked -> Double
0

-- | Convert data to a range assuming a zero bound (a very common but implicit assumption in a lot of bar charts)
--
-- >>> barDataLowerUpper NonStacked [[1,2],[2,3]]
-- [[(0.0,1.0),(0.0,2.0)],[(0.0,2.0),(0.0,3.0)]]
barDataLowerUpper :: Stacked -> [[Double]] -> [[(Double, Double)]]
barDataLowerUpper :: Stacked -> [[Double]] -> [[(Double, Double)]]
barDataLowerUpper Stacked
stacked [[Double]]
bs =
  case Stacked
stacked of
    Stacked
NonStacked -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Double
0,)) [[Double]]
bs
    Stacked
Stacked -> forall a. Int -> [a] -> [a]
drop Int
1 forall a b. (a -> b) -> a -> b
$ forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl' (\[(Double, Double)]
acc [Double]
xs -> forall a b. [a] -> [b] -> [(a, b)]
zip (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd [(Double, Double)]
acc) [Double]
xs) (forall a. a -> [a]
repeat (Double
0, Double
0)) ([[Double]] -> [[Double]]
accRows [[Double]]
bs)

-- | 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
$ forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (forall (t :: * -> *) a. Foldable t => t a -> Int
length forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[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 -5.0e-2 2.05 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 [forall a. a -> a -> a -> a -> Rect a
Rect (Double
x forall a. Num a => a -> a -> a
- (BarOptions
bo forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "outerGap" a => a
#outerGap)) (Double
z forall a. Num a => a -> a -> a
+ (BarOptions
bo forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. forall a. IsLabel "outerGap" a => a
#outerGap)) Double
y Double
w]]
    (Rect Double
x Double
z Double
y Double
w) = forall a. a -> Maybe a -> a
fromMaybe forall a. Multiplicative a => a
one forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [Rect a] -> Maybe (Rect a)
foldRect forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ 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)

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

appendZero :: [[Double]] -> [[Double]]
appendZero :: [[Double]] -> [[Double]]
appendZero [[Double]]
xs =
  ( \[Double]
x ->
      forall a. Int -> [a] -> [a]
take
        ([[Double]] -> Int
maxRows [[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)

-- | 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
maxRows (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
maxRows (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))

barDataTP :: Stacked -> FormatN -> Double -> Double -> [[Double]] -> [[(Text, Double)]]
barDataTP :: Stacked
-> FormatN -> Double -> Double -> [[Double]] -> [[(Text, Double)]]
barDataTP Stacked
stacked FormatN
fn Double
d Double
negd [[Double]]
bs =
  forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Double
x Double
y' -> (FormatN -> Double -> Text
formatN FormatN
fn Double
x, Double -> Double
drop' Double
y'))) [[Double]]
bs' (forall a. a -> a -> Bool -> a
bool [[Double]]
bs' ([[Double]] -> [[Double]]
accRows [[Double]]
bs') (Stacked
stacked forall a. Eq a => a -> a -> Bool
== Stacked
Stacked))
  where
    drop' :: Double -> Double
drop' Double
x = forall a. a -> a -> Bool -> a
bool (Double
x forall a. Num a => a -> a -> a
- (Double
negd forall a. Num a => a -> a -> a
* (Double
w forall a. Num a => a -> a -> a
- Double
y))) (Double
x forall a. Num a => a -> a -> a
+ (Double
d forall a. Num a => a -> a -> a
* (Double
w forall a. Num a => a -> a -> a
- Double
y))) (Double
x forall a. Ord a => a -> a -> Bool
>= Double
0)
    bs' :: [[Double]]
bs' = [[Double]] -> [[Double]]
appendZero [[Double]]
bs
    (Rect Double
_ Double
_ Double
y Double
w) = [[Double]] -> Rect Double
barRange [[Double]]
bs'

-- | Convert BarData to text placed above (or below) the bars.
barTexts ::
  BarOptions ->
  [[Double]] ->
  [[(Text, Point Double)]]
barTexts :: BarOptions -> [[Double]] -> [[(Text, Point Double)]]
barTexts (BarOptions [RectStyle]
_ [TextStyle]
_ Double
ogap Double
igap Double
tgap Double
tgapneg Bool
_ FormatN
fn Orientation
orient Stacked
stacked LegendOptions
_) [[Double]]
bs =
  forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a b. [a] -> [b] -> [(a, b)]
zip (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Stacked
-> FormatN -> Double -> Double -> [[Double]] -> [[(Text, Double)]]
barDataTP Stacked
stacked FormatN
fn Double
tgap Double
tgapneg [[Double]]
bs') (Orientation -> [[Point Double]]
txs'' Orientation
orient)
  where
    bs' :: [[Double]]
bs' = forall a. a -> a -> Bool -> a
bool [[Double]]
bs ([[Double]] -> [[Double]]
appendZero [[Double]]
bs) (Stacked
stacked forall a. Eq a => a -> a -> Bool
== Stacked
Stacked)
    txs'' :: Orientation -> [[Point Double]]
txs'' Orientation
Vert = [[Point Double]]
txs'
    txs'' Orientation
Hori = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Point Double
x Double
y) -> forall a. a -> a -> Point a
Point Double
y Double
x) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Point Double]]
txs'
    txs' :: [[Point Double]]
txs' = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Double -> [Double] -> [Point Double]
addX [Double
0 ..] (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Stacked
-> FormatN -> Double -> Double -> [[Double]] -> [[(Text, Double)]]
barDataTP Stacked
stacked FormatN
fn Double
tgap Double
tgapneg [[Double]]
bs')
    addX :: Double -> [Double] -> [Point Double]
addX Double
z [Double]
y =
      forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
        ( \Double
x Double
y' ->
            forall a. a -> a -> Point a
Point
              (Double
x forall a. Num a => a -> a -> a
+ (Double
ogap forall a. Fractional a => a -> a -> a
/ Double
2) forall a. Num a => a -> a -> a
+ Double
z forall a. Num a => a -> a -> a
* Double
bstep forall a. Num a => a -> a -> a
+ Double
bstep forall a. Fractional a => a -> a -> a
/ Double
2 forall a. Num a => a -> a -> a
- Double
igap' forall a. Fractional a => a -> a -> a
/ Double
2)
              Double
y'
        )
        [Double
0 ..]
        [Double]
y
    n :: Double
n = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Double]]
bs')
    bstep :: Double
bstep = (Double
1 forall a. Num a => a -> a -> a
- (Double
1 forall a. Num a => a -> a -> a
+ Double
1) forall a. Num a => a -> a -> a
* Double
ogap forall a. Num a => a -> a -> a
+ (Double
n forall a. Num a => a -> a -> a
- Double
1) forall a. Num a => a -> a -> a
* Double
igap') forall a. Fractional a => a -> a -> a
/ Double
n
    igap' :: Double
igap' = Double
igap forall a. Num a => a -> a -> a
* (Double
1 forall a. Num a => a -> a -> a
- (Double
1 forall a. Num a => a -> a -> a
+ Double
1) forall a. Num a => a -> a -> a
* Double
ogap)

-- | 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))