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

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

import Chart.Render
import Chart.Types
import Control.Lens
import Data.Bifunctor
import Data.Bool
import Data.Colour
import Data.FormatN
import Data.Generics.Labels ()
import Data.List (scanl', transpose)
import qualified Data.List.NonEmpty as NonEmpty
import Data.Maybe
import Data.Text (Text, pack)
import GHC.Generics
import GHC.OverloadedLabels
import NumHask.Prelude
import NumHask.Space

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

-- | Typical bar chart options.
--
-- >>> let barDataExample = BarData [[1, 2, 3, 5, 8, 0, -2, 11, 2, 1], [1 .. 10]] (Just (("row " <>) . pack . show <$> [1 .. 11])) (Just (("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 -> Bool
accumulateValues :: Bool,
    BarOptions -> Orientation
barOrientation :: Orientation,
    BarOptions -> HudOptions
barHudOptions :: HudOptions
  }
  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
showList :: [BarOptions] -> ShowS
$cshowList :: [BarOptions] -> ShowS
show :: BarOptions -> String
$cshow :: BarOptions -> String
showsPrec :: Int -> BarOptions -> ShowS
$cshowsPrec :: Int -> BarOptions -> ShowS
Show, BarOptions -> BarOptions -> Bool
(BarOptions -> BarOptions -> Bool)
-> (BarOptions -> BarOptions -> Bool) -> Eq BarOptions
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. 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
$cto :: forall x. Rep BarOptions x -> BarOptions
$cfrom :: forall x. BarOptions -> Rep BarOptions x
Generic)

-- | The official bar options.
defaultBarOptions :: BarOptions
defaultBarOptions :: BarOptions
defaultBarOptions =
  [RectStyle]
-> [TextStyle]
-> Double
-> Double
-> Double
-> Double
-> Bool
-> FormatN
-> Bool
-> Orientation
-> HudOptions
-> BarOptions
BarOptions
    [RectStyle]
gs
    [TextStyle]
ts
    Double
0.1
    Double
0
    Double
0.04
    Double
0.1
    Bool
True
    (Maybe Int -> FormatN
FormatComma (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
2))
    Bool
False
    Orientation
Hori
    ( HudOptions
defaultHudOptions
        HudOptions -> (HudOptions -> HudOptions) -> HudOptions
forall a b. a -> (a -> b) -> b
& ([AxisOptions] -> Identity [AxisOptions])
-> HudOptions -> Identity HudOptions
forall a. IsLabel "hudAxes" a => a
forall (x :: Symbol) a. IsLabel x a => a
#hudAxes
          (([AxisOptions] -> Identity [AxisOptions])
 -> HudOptions -> Identity HudOptions)
-> [AxisOptions] -> HudOptions -> HudOptions
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [ AxisOptions
defaultAxisOptions
                 AxisOptions -> (AxisOptions -> AxisOptions) -> AxisOptions
forall a b. a -> (a -> b) -> b
& (Tick -> Identity Tick) -> AxisOptions -> Identity AxisOptions
forall a. IsLabel "axisTick" a => a
forall (x :: Symbol) a. IsLabel x a => a
#axisTick ((Tick -> Identity Tick) -> AxisOptions -> Identity AxisOptions)
-> ((Maybe (LineStyle, Double)
     -> Identity (Maybe (LineStyle, Double)))
    -> Tick -> Identity Tick)
-> (Maybe (LineStyle, Double)
    -> Identity (Maybe (LineStyle, Double)))
-> AxisOptions
-> Identity AxisOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (LineStyle, Double) -> Identity (Maybe (LineStyle, Double)))
-> Tick -> Identity Tick
forall a. IsLabel "ltick" a => a
forall (x :: Symbol) a. IsLabel x a => a
#ltick ((Maybe (LineStyle, Double)
  -> Identity (Maybe (LineStyle, Double)))
 -> AxisOptions -> Identity AxisOptions)
-> Maybe (LineStyle, Double) -> AxisOptions -> AxisOptions
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe (LineStyle, Double)
forall a. Maybe a
Nothing,
               AxisOptions
defaultAxisOptions AxisOptions -> (AxisOptions -> AxisOptions) -> AxisOptions
forall a b. a -> (a -> b) -> b
& (Place -> Identity Place) -> AxisOptions -> Identity AxisOptions
forall a. IsLabel "place" a => a
forall (x :: Symbol) a. IsLabel x a => a
#place ((Place -> Identity Place) -> AxisOptions -> Identity AxisOptions)
-> Place -> AxisOptions -> AxisOptions
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Place
PlaceLeft
             ]
        HudOptions -> (HudOptions -> HudOptions) -> HudOptions
forall a b. a -> (a -> b) -> b
& ([Title] -> Identity [Title]) -> HudOptions -> Identity HudOptions
forall a. IsLabel "hudTitles" a => a
forall (x :: Symbol) a. IsLabel x a => a
#hudTitles (([Title] -> Identity [Title])
 -> HudOptions -> Identity HudOptions)
-> [Title] -> HudOptions -> HudOptions
forall s t a b. ASetter s t a b -> b -> s -> t
.~ []
        HudOptions -> (HudOptions -> HudOptions) -> HudOptions
forall a b. a -> (a -> b) -> b
& (Maybe (LegendOptions, [(Annotation, Text)])
 -> Identity (Maybe (LegendOptions, [(Annotation, Text)])))
-> HudOptions -> Identity HudOptions
forall a. IsLabel "hudLegend" a => a
forall (x :: Symbol) a. IsLabel x a => a
#hudLegend
          ((Maybe (LegendOptions, [(Annotation, Text)])
  -> Identity (Maybe (LegendOptions, [(Annotation, Text)])))
 -> HudOptions -> Identity HudOptions)
-> (LegendOptions, [(Annotation, Text)])
-> HudOptions
-> HudOptions
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ ( LegendOptions
defaultLegendOptions
                 LegendOptions -> (LegendOptions -> LegendOptions) -> LegendOptions
forall a b. a -> (a -> b) -> b
& (Place -> Identity Place)
-> LegendOptions -> Identity LegendOptions
forall a. IsLabel "lplace" a => a
forall (x :: Symbol) a. IsLabel x a => a
#lplace ((Place -> Identity Place)
 -> LegendOptions -> Identity LegendOptions)
-> Place -> LegendOptions -> LegendOptions
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Place
PlaceRight
                 LegendOptions -> (LegendOptions -> LegendOptions) -> LegendOptions
forall a b. a -> (a -> b) -> b
& (Double -> Identity Double)
-> LegendOptions -> Identity LegendOptions
forall a. IsLabel "lsize" a => a
forall (x :: Symbol) a. IsLabel x a => a
#lsize ((Double -> Identity Double)
 -> LegendOptions -> Identity LegendOptions)
-> Double -> LegendOptions -> LegendOptions
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Double
0.12
                 LegendOptions -> (LegendOptions -> LegendOptions) -> LegendOptions
forall a b. a -> (a -> b) -> b
& (Double -> Identity Double)
-> LegendOptions -> Identity LegendOptions
forall a. IsLabel "vgap" a => a
forall (x :: Symbol) a. IsLabel x a => a
#vgap ((Double -> Identity Double)
 -> LegendOptions -> Identity LegendOptions)
-> Double -> LegendOptions -> LegendOptions
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Double
0.4
                 LegendOptions -> (LegendOptions -> LegendOptions) -> LegendOptions
forall a b. a -> (a -> b) -> b
& (Double -> Identity Double)
-> LegendOptions -> Identity LegendOptions
forall a. IsLabel "hgap" a => a
forall (x :: Symbol) a. IsLabel x a => a
#hgap ((Double -> Identity Double)
 -> LegendOptions -> Identity LegendOptions)
-> Double -> LegendOptions -> LegendOptions
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Double
0.14
                 LegendOptions -> (LegendOptions -> LegendOptions) -> LegendOptions
forall a b. a -> (a -> b) -> b
& (TextStyle -> Identity TextStyle)
-> LegendOptions -> Identity LegendOptions
forall a. IsLabel "ltext" a => a
forall (x :: Symbol) a. IsLabel x a => a
#ltext ((TextStyle -> Identity TextStyle)
 -> LegendOptions -> Identity LegendOptions)
-> ((Double -> Identity Double) -> TextStyle -> Identity TextStyle)
-> (Double -> Identity Double)
-> LegendOptions
-> Identity LegendOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Identity Double) -> TextStyle -> Identity TextStyle
forall a. IsLabel "size" a => a
forall (x :: Symbol) a. IsLabel x a => a
#size ((Double -> Identity Double)
 -> LegendOptions -> Identity LegendOptions)
-> Double -> LegendOptions -> LegendOptions
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Double
0.12
                 LegendOptions -> (LegendOptions -> LegendOptions) -> LegendOptions
forall a b. a -> (a -> b) -> b
& (Double -> Identity Double)
-> LegendOptions -> Identity LegendOptions
forall a. IsLabel "lscale" a => a
forall (x :: Symbol) a. IsLabel x a => a
#lscale ((Double -> Identity Double)
 -> LegendOptions -> Identity LegendOptions)
-> Double -> LegendOptions -> LegendOptions
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Double
0.4,
               []
             )
    )
  where
    gs :: [RectStyle]
gs = (\Colour
x -> Double -> Colour -> Colour -> RectStyle
RectStyle Double
0.002 Colour
x Colour
x) (Colour -> RectStyle) -> [Colour] -> [RectStyle]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Colour]
palette1_
    ts :: [TextStyle]
ts = (\Colour
x -> TextStyle
defaultTextStyle TextStyle -> (TextStyle -> TextStyle) -> TextStyle
forall a b. a -> (a -> b) -> b
& (Colour -> Identity Colour) -> TextStyle -> Identity TextStyle
forall a. IsLabel "color" a => a
forall (x :: Symbol) a. IsLabel x a => a
#color ((Colour -> Identity Colour) -> TextStyle -> Identity TextStyle)
-> Colour -> TextStyle -> TextStyle
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Colour
x TextStyle -> (TextStyle -> TextStyle) -> TextStyle
forall a b. a -> (a -> b) -> b
& (Double -> Identity Double) -> TextStyle -> Identity TextStyle
forall a. IsLabel "size" a => a
forall (x :: Symbol) a. IsLabel x a => a
#size ((Double -> Identity Double) -> TextStyle -> Identity TextStyle)
-> Double -> TextStyle -> TextStyle
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Double
0.04) (Colour -> TextStyle) -> [Colour] -> [TextStyle]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Colour]
palette1_

-- | imagine a dataframe you get in other languages:
--
-- - definitely some [[Double]]
--
-- - maybe some row names
--
-- - maybe some column names
data BarData = BarData
  { BarData -> [[Double]]
barData :: [[Double]],
    BarData -> Maybe [Text]
barRowLabels :: Maybe [Text],
    BarData -> Maybe [Text]
barColumnLabels :: Maybe [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
showList :: [BarData] -> ShowS
$cshowList :: [BarData] -> ShowS
show :: BarData -> String
$cshow :: BarData -> String
showsPrec :: Int -> BarData -> ShowS
$cshowsPrec :: Int -> BarData -> ShowS
Show, BarData -> BarData -> Bool
(BarData -> BarData -> Bool)
-> (BarData -> BarData -> Bool) -> Eq BarData
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. 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
$cto :: forall x. Rep BarData x -> BarData
$cfrom :: forall x. BarData -> Rep BarData x
Generic)

-- | Convert BarData to rectangles
--
-- >>> barRects defaultBarOptions [[1,2],[2,3]]
-- [[Rect 5.0e-2 0.45 0.0 1.0,Rect 1.05 1.4500000000000002 0.0 2.0],[Rect 0.45 0.8500000000000001 0.0 2.0,Rect 1.4500000000000002 1.85 0.0 3.0]]
barRects ::
  BarOptions ->
  [[Double]] ->
  [[Rect Double]]
barRects :: BarOptions -> [[Double]] -> [[Rect Double]]
barRects (BarOptions [RectStyle]
_ [TextStyle]
_ Double
ogap Double
igap Double
_ Double
_ Bool
_ FormatN
_ Bool
add Orientation
orient HudOptions
_) [[Double]]
bs = Orientation -> [[Rect Double]]
rects'' Orientation
orient
  where
    bs' :: [[Double]]
bs' = [[Double]] -> [[Double]] -> Bool -> [[Double]]
forall a. a -> a -> Bool -> a
bool [[Double]]
bs ([[Double]] -> [[Double]]
appendZero [[Double]]
bs) Bool
add
    rects'' :: Orientation -> [[Rect Double]]
rects'' Orientation
Hori = [[Rect Double]]
rects'
    rects'' Orientation
Vert = (Rect Double -> Rect Double) -> [Rect Double] -> [Rect Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(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) ([Rect Double] -> [Rect Double])
-> [[Rect Double]] -> [[Rect Double]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Rect Double]]
rects'
    rects' :: [[Rect Double]]
rects' = (Double -> [(Double, Double)] -> [Rect Double])
-> [Double] -> [[(Double, Double)]] -> [[Rect Double]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Double -> [(Double, Double)] -> [Rect Double]
batSet [Double
0 ..] (Bool -> [[Double]] -> [[(Double, Double)]]
barDataLowerUpper Bool
add [[Double]]
bs')
    batSet :: Double -> [(Double, Double)] -> [Rect Double]
batSet Double
z [(Double, Double)]
ys =
      (Double -> (Double, Double) -> Rect Double)
-> [Double] -> [(Double, Double)] -> [Rect Double]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
        ( \Double
x (Double
yl, Double
yh) ->
            Rect Double -> Rect Double
forall a. Signed a => a -> a
abs
              ( Double -> Double -> Double -> Double -> Rect Double
forall a. a -> a -> a -> a -> Rect a
Rect
                  (Double
x Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ (Double
ogap Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Double
2) Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ Double
z Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Double
bstep)
                  (Double
x Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ (Double
ogap Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Double
2) Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ Double
z Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Double
bstep Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ Double
bstep Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Double
igap')
                  Double
yl
                  Double
yh
              )
        )
        [Double
0 ..]
        [(Double, Double)]
ys
    n :: Double
n = Int -> Double
forall a b. FromIntegral a b => b -> a
fromIntegral ([[Double]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Double]]
bs')
    bstep :: Double
bstep = (Double
1 Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- (Double
1 Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ Double
1) Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Double
ogap Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ (Double
n Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Double
1) Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Double
igap') Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Double
n
    igap' :: Double
igap' = Double
igap Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* (Double
1 Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- (Double
1 Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ Double
1) Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Double
ogap)

-- | convert data to a range assuming a zero bound
-- a very common but implicit assumption in a lot of bar charts
--
-- >>> barDataLowerUpper False [[1,2],[2,3]]
-- [[(0.0,1.0),(0.0,2.0)],[(0.0,2.0),(0.0,3.0)]]
barDataLowerUpper :: Bool -> [[Double]] -> [[(Double, Double)]]
barDataLowerUpper :: Bool -> [[Double]] -> [[(Double, Double)]]
barDataLowerUpper Bool
add [[Double]]
bs =
  case Bool
add of
    Bool
False -> (Double -> (Double, Double)) -> [Double] -> [(Double, Double)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Double
0,) ([Double] -> [(Double, Double)])
-> [[Double]] -> [[(Double, Double)]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Double]]
bs
    Bool
True -> (Double -> (Double, Double)) -> [Double] -> [(Double, Double)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Double
0,) ([Double] -> [(Double, Double)])
-> [[Double]] -> [[(Double, Double)]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[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 ::
  [[Double]] -> Rect Double
barRange :: [[Double]] -> Rect Double
barRange [] = Double -> Double -> Double -> Double -> Rect Double
forall a. a -> a -> a -> a -> Rect a
Rect Double
0 Double
0 Double
0 Double
0
barRange ys' :: [[Double]]
ys'@([Double]
y : [[Double]]
ys) = Double -> Double -> Double -> Double -> Rect Double
forall a. a -> a -> a -> a -> Rect a
Rect Double
0 (Int -> Double
forall a b. FromIntegral a b => b -> a
fromIntegral (Int -> Double) -> Int -> Double
forall a b. (a -> b) -> a -> b
$ [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Double] -> 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]]
ys')) (Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
0 Double
l) Double
u
  where
    (Range Double
l Double
u) = NonEmpty (Range Double) -> Range Double
forall a. Semigroup a => NonEmpty a -> a
sconcat (NonEmpty (Range Double) -> Range Double)
-> NonEmpty (Range Double) -> Range Double
forall a b. (a -> b) -> a -> b
$ [Double] -> Range Double
forall s (f :: * -> *).
(Space s, Traversable f) =>
f (Element s) -> s
space1 ([Double] -> Range Double)
-> NonEmpty [Double] -> NonEmpty (Range Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Double]
y [Double] -> [[Double]] -> NonEmpty [Double]
forall a. a -> [a] -> NonEmpty a
NonEmpty.:| [[Double]]
ys)

-- | A bar chart without hud trimmings.
--
-- >>> bars defaultBarOptions (BarData [[1,2],[2,3]] Nothing Nothing)
-- [Chart {annotation = RectA (RectStyle {borderSize = 2.0e-3, borderColor = Colour 0.69 0.35 0.16 1.00, color = Colour 0.69 0.35 0.16 1.00}), xys = [R 5.0e-2 0.45 0.0 1.0,R 1.05 1.4500000000000002 0.0 2.0]},Chart {annotation = RectA (RectStyle {borderSize = 2.0e-3, borderColor = Colour 0.65 0.81 0.89 1.00, color = Colour 0.65 0.81 0.89 1.00}), xys = [R 0.45 0.8500000000000001 0.0 2.0,R 1.4500000000000002 1.85 0.0 3.0]},Chart {annotation = BlankA, xys = [R -5.0e-2 1.9500000000000002 0.0 3.0]}]
bars :: BarOptions -> BarData -> [Chart Double]
bars :: BarOptions -> BarData -> [Chart Double]
bars BarOptions
bo BarData
bd =
  (RectStyle -> [XY Double] -> Chart Double)
-> [RectStyle] -> [[XY Double]] -> [Chart Double]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\RectStyle
o [XY Double]
d -> Annotation -> [XY Double] -> Chart Double
forall a. Annotation -> [XY a] -> Chart a
Chart (RectStyle -> Annotation
RectA RectStyle
o) [XY Double]
d) (BarOptions
bo BarOptions
-> Getting [RectStyle] BarOptions [RectStyle] -> [RectStyle]
forall s a. s -> Getting a s a -> a
^. Getting [RectStyle] BarOptions [RectStyle]
forall a. IsLabel "barRectStyles" a => a
forall (x :: Symbol) a. IsLabel x a => a
#barRectStyles) ((Rect Double -> XY Double) -> [Rect Double] -> [XY Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Rect Double -> XY Double
forall a. Rect a -> XY a
RectXY ([Rect Double] -> [XY Double]) -> [[Rect Double]] -> [[XY Double]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BarOptions -> [[Double]] -> [[Rect Double]]
barRects BarOptions
bo (BarData
bd BarData -> Getting [[Double]] BarData [[Double]] -> [[Double]]
forall s a. s -> Getting a s a -> a
^. Getting [[Double]] BarData [[Double]]
forall a. IsLabel "barData" a => a
forall (x :: Symbol) a. IsLabel x a => a
#barData)) [Chart Double] -> [Chart Double] -> [Chart Double]
forall a. Semigroup a => a -> a -> a
<> [Annotation -> [XY Double] -> Chart Double
forall a. Annotation -> [XY a] -> Chart a
Chart Annotation
BlankA [Rect Double -> XY Double
forall a. Rect a -> XY a
RectXY (Double -> Double -> Double -> Double -> Rect Double
forall a. a -> a -> a -> a -> Rect a
Rect (Double
x Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- (BarOptions
bo BarOptions -> Getting Double BarOptions Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double BarOptions Double
forall a. IsLabel "outerGap" a => a
forall (x :: Symbol) a. IsLabel x a => a
#outerGap)) (Double
z Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ (BarOptions
bo BarOptions -> Getting Double BarOptions Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double BarOptions Double
forall a. IsLabel "outerGap" a => a
forall (x :: Symbol) a. IsLabel x a => a
#outerGap)) Double
y Double
w)]]
  where
    (Rect Double
x Double
z Double
y Double
w) = 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] -> Maybe (Rect Double))
-> [Rect Double] -> Maybe (Rect Double)
forall a b. (a -> b) -> a -> b
$ [Maybe (Rect Double)] -> [Rect Double]
forall a. [Maybe a] -> [a]
catMaybes ([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] -> Maybe (Rect Double))
-> [[Rect Double]] -> [Maybe (Rect Double)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BarOptions -> [[Double]] -> [[Rect Double]]
barRects BarOptions
bo (BarData
bd BarData -> Getting [[Double]] BarData [[Double]] -> [[Double]]
forall s a. s -> Getting a s a -> a
^. Getting [[Double]] BarData [[Double]]
forall a. IsLabel "barData" a => a
forall (x :: Symbol) a. IsLabel x a => a
#barData)

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

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

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

-- | sensible ticks
barTicks :: BarData -> TickStyle
barTicks :: BarData -> TickStyle
barTicks BarData
bd
  | [[Double]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (BarData
bd BarData -> Getting [[Double]] BarData [[Double]] -> [[Double]]
forall s a. s -> Getting a s a -> a
^. Getting [[Double]] BarData [[Double]]
forall a. IsLabel "barData" a => a
forall (x :: Symbol) a. IsLabel x a => a
#barData) = TickStyle
TickNone
  | Maybe [Text] -> Bool
forall a. Maybe a -> Bool
isNothing (BarData
bd BarData
-> Getting (Maybe [Text]) BarData (Maybe [Text]) -> Maybe [Text]
forall s a. s -> Getting a s a -> a
^. Getting (Maybe [Text]) BarData (Maybe [Text])
forall a. IsLabel "barRowLabels" a => a
forall (x :: Symbol) a. IsLabel x a => a
#barRowLabels) =
    [Text] -> TickStyle
TickLabels ([Text] -> TickStyle) -> [Text] -> TickStyle
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
maxRows (BarData
bd BarData -> Getting [[Double]] BarData [[Double]] -> [[Double]]
forall s a. s -> Getting a s a -> a
^. Getting [[Double]] BarData [[Double]]
forall a. IsLabel "barData" a => a
forall (x :: Symbol) a. IsLabel x a => a
#barData) Int -> Int -> Int
forall a. Subtractive a => a -> a -> a
- Int
1)]
  | Bool
otherwise =
    [Text] -> TickStyle
TickLabels ([Text] -> TickStyle) -> [Text] -> TickStyle
forall a b. (a -> b) -> a -> b
$
      Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
take ([[Double]] -> Int
maxRows (BarData
bd BarData -> Getting [[Double]] BarData [[Double]] -> [[Double]]
forall s a. s -> Getting a s a -> a
^. Getting [[Double]] BarData [[Double]]
forall a. IsLabel "barData" a => a
forall (x :: Symbol) a. IsLabel x a => a
#barData)) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$
        [Text] -> Maybe [Text] -> [Text]
forall a. a -> Maybe a -> a
fromMaybe [] (BarData
bd BarData
-> Getting (Maybe [Text]) BarData (Maybe [Text]) -> Maybe [Text]
forall s a. s -> Getting a s a -> a
^. Getting (Maybe [Text]) BarData (Maybe [Text])
forall a. IsLabel "barRowLabels" a => a
forall (x :: Symbol) a. IsLabel x a => a
#barRowLabels) [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> Text -> [Text]
forall a. a -> [a]
repeat Text
""

tickFirstAxis :: BarData -> [AxisOptions] -> [AxisOptions]
tickFirstAxis :: BarData -> [AxisOptions] -> [AxisOptions]
tickFirstAxis BarData
_ [] = []
tickFirstAxis BarData
bd (AxisOptions
x : [AxisOptions]
xs) = (AxisOptions
x AxisOptions -> (AxisOptions -> AxisOptions) -> AxisOptions
forall a b. a -> (a -> b) -> b
& (Tick -> Identity Tick) -> AxisOptions -> Identity AxisOptions
forall a. IsLabel "axisTick" a => a
forall (x :: Symbol) a. IsLabel x a => a
#axisTick ((Tick -> Identity Tick) -> AxisOptions -> Identity AxisOptions)
-> ((TickStyle -> Identity TickStyle) -> Tick -> Identity Tick)
-> (TickStyle -> Identity TickStyle)
-> AxisOptions
-> Identity AxisOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TickStyle -> Identity TickStyle) -> Tick -> Identity Tick
forall a. IsLabel "tstyle" a => a
forall (x :: Symbol) a. IsLabel x a => a
#tstyle ((TickStyle -> Identity TickStyle)
 -> AxisOptions -> Identity AxisOptions)
-> TickStyle -> AxisOptions -> AxisOptions
forall s t a b. ASetter s t a b -> b -> s -> t
.~ BarData -> TickStyle
barTicks BarData
bd) AxisOptions -> [AxisOptions] -> [AxisOptions]
forall a. a -> [a] -> [a]
: [AxisOptions]
xs

-- | bar legend
barLegend :: BarData -> BarOptions -> [(Annotation, Text)]
barLegend :: BarData -> BarOptions -> [(Annotation, Text)]
barLegend BarData
bd BarOptions
bo
  | [[Double]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (BarData
bd BarData -> Getting [[Double]] BarData [[Double]] -> [[Double]]
forall s a. s -> Getting a s a -> a
^. Getting [[Double]] BarData [[Double]]
forall a. IsLabel "barData" a => a
forall (x :: Symbol) a. IsLabel x a => a
#barData) = []
  | Maybe [Text] -> Bool
forall a. Maybe a -> Bool
isNothing (BarData
bd BarData
-> Getting (Maybe [Text]) BarData (Maybe [Text]) -> Maybe [Text]
forall s a. s -> Getting a s a -> a
^. Getting (Maybe [Text]) BarData (Maybe [Text])
forall a. IsLabel "barColumnLabels" a => a
forall (x :: Symbol) a. IsLabel x a => a
#barColumnLabels) = []
  | Bool
otherwise = [Annotation] -> [Text] -> [(Annotation, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip (RectStyle -> Annotation
RectA (RectStyle -> Annotation) -> [RectStyle] -> [Annotation]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BarOptions
bo BarOptions
-> Getting [RectStyle] BarOptions [RectStyle] -> [RectStyle]
forall s a. s -> Getting a s a -> a
^. Getting [RectStyle] BarOptions [RectStyle]
forall a. IsLabel "barRectStyles" a => a
forall (x :: Symbol) a. IsLabel x a => a
#barRectStyles) ([Text] -> [(Annotation, Text)]) -> [Text] -> [(Annotation, Text)]
forall a b. (a -> b) -> a -> b
$ Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
take ([[Double]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (BarData
bd BarData -> Getting [[Double]] BarData [[Double]] -> [[Double]]
forall s a. s -> Getting a s a -> a
^. Getting [[Double]] BarData [[Double]]
forall a. IsLabel "barData" a => a
forall (x :: Symbol) a. IsLabel x a => a
#barData)) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ [Text] -> Maybe [Text] -> [Text]
forall a. a -> Maybe a -> a
fromMaybe [] (BarData
bd BarData
-> Getting (Maybe [Text]) BarData (Maybe [Text]) -> Maybe [Text]
forall s a. s -> Getting a s a -> a
^. Getting (Maybe [Text]) BarData (Maybe [Text])
forall a. IsLabel "barColumnLabels" a => a
forall (x :: Symbol) a. IsLabel x a => a
#barColumnLabels) [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> Text -> [Text]
forall a. a -> [a]
repeat Text
""

-- | A bar chart.
--
-- By convention only, the first axis (if any) is the bar axis.
barChart :: BarOptions -> BarData -> ChartSvg
barChart :: BarOptions -> BarData -> ChartSvg
barChart BarOptions
bo BarData
bd =
  ChartSvg
forall a. Monoid a => a
mempty
    ChartSvg -> (ChartSvg -> ChartSvg) -> ChartSvg
forall a b. a -> (a -> b) -> b
& (HudOptions -> Identity HudOptions)
-> ChartSvg -> Identity ChartSvg
forall a. IsLabel "hudOptions" a => a
forall (x :: Symbol) a. IsLabel x a => a
#hudOptions ((HudOptions -> Identity HudOptions)
 -> ChartSvg -> Identity ChartSvg)
-> HudOptions -> ChartSvg -> ChartSvg
forall s t a b. ASetter s t a b -> b -> s -> t
.~ BarOptions
bo BarOptions
-> Getting HudOptions BarOptions HudOptions -> HudOptions
forall s a. s -> Getting a s a -> a
^. Getting HudOptions BarOptions HudOptions
forall a. IsLabel "barHudOptions" a => a
forall (x :: Symbol) a. IsLabel x a => a
#barHudOptions
    ChartSvg -> (ChartSvg -> ChartSvg) -> ChartSvg
forall a b. a -> (a -> b) -> b
& (HudOptions -> Identity HudOptions)
-> ChartSvg -> Identity ChartSvg
forall a. IsLabel "hudOptions" a => a
forall (x :: Symbol) a. IsLabel x a => a
#hudOptions ((HudOptions -> Identity HudOptions)
 -> ChartSvg -> Identity ChartSvg)
-> ((Maybe (LegendOptions, [(Annotation, Text)])
     -> Identity (Maybe (LegendOptions, [(Annotation, Text)])))
    -> HudOptions -> Identity HudOptions)
-> (Maybe (LegendOptions, [(Annotation, Text)])
    -> Identity (Maybe (LegendOptions, [(Annotation, Text)])))
-> ChartSvg
-> Identity ChartSvg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (LegendOptions, [(Annotation, Text)])
 -> Identity (Maybe (LegendOptions, [(Annotation, Text)])))
-> HudOptions -> Identity HudOptions
forall a. IsLabel "hudLegend" a => a
forall (x :: Symbol) a. IsLabel x a => a
#hudLegend ((Maybe (LegendOptions, [(Annotation, Text)])
  -> Identity (Maybe (LegendOptions, [(Annotation, Text)])))
 -> ChartSvg -> Identity ChartSvg)
-> (Maybe (LegendOptions, [(Annotation, Text)])
    -> Maybe (LegendOptions, [(Annotation, Text)]))
-> ChartSvg
-> ChartSvg
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ((LegendOptions, [(Annotation, Text)])
 -> (LegendOptions, [(Annotation, Text)]))
-> Maybe (LegendOptions, [(Annotation, Text)])
-> Maybe (LegendOptions, [(Annotation, Text)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([(Annotation, Text)] -> [(Annotation, Text)])
-> (LegendOptions, [(Annotation, Text)])
-> (LegendOptions, [(Annotation, Text)])
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ([(Annotation, Text)]
-> [(Annotation, Text)] -> [(Annotation, Text)]
forall a b. a -> b -> a
const (BarData -> BarOptions -> [(Annotation, Text)]
barLegend BarData
bd BarOptions
bo)))
    ChartSvg -> (ChartSvg -> ChartSvg) -> ChartSvg
forall a b. a -> (a -> b) -> b
& (HudOptions -> Identity HudOptions)
-> ChartSvg -> Identity ChartSvg
forall a. IsLabel "hudOptions" a => a
forall (x :: Symbol) a. IsLabel x a => a
#hudOptions ((HudOptions -> Identity HudOptions)
 -> ChartSvg -> Identity ChartSvg)
-> (([AxisOptions] -> Identity [AxisOptions])
    -> HudOptions -> Identity HudOptions)
-> ([AxisOptions] -> Identity [AxisOptions])
-> ChartSvg
-> Identity ChartSvg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([AxisOptions] -> Identity [AxisOptions])
-> HudOptions -> Identity HudOptions
forall a. IsLabel "hudAxes" a => a
forall (x :: Symbol) a. IsLabel x a => a
#hudAxes (([AxisOptions] -> Identity [AxisOptions])
 -> ChartSvg -> Identity ChartSvg)
-> ([AxisOptions] -> [AxisOptions]) -> ChartSvg -> ChartSvg
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ BarData -> [AxisOptions] -> [AxisOptions]
tickFirstAxis BarData
bd ([AxisOptions] -> [AxisOptions])
-> ([AxisOptions] -> [AxisOptions])
-> [AxisOptions]
-> [AxisOptions]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Orientation -> [AxisOptions] -> [AxisOptions]
flipAllAxes (BarOptions -> Orientation
barOrientation BarOptions
bo)
    ChartSvg -> (ChartSvg -> ChartSvg) -> ChartSvg
forall a b. a -> (a -> b) -> b
& ([Chart Double] -> Identity [Chart Double])
-> ChartSvg -> Identity ChartSvg
forall a. IsLabel "chartList" a => a
forall (x :: Symbol) a. IsLabel x a => a
#chartList (([Chart Double] -> Identity [Chart Double])
 -> ChartSvg -> Identity ChartSvg)
-> [Chart Double] -> ChartSvg -> ChartSvg
forall s t a b. ASetter s t a b -> b -> s -> t
.~ BarOptions -> BarData -> [Chart Double]
bars BarOptions
bo BarData
bd [Chart Double] -> [Chart Double] -> [Chart Double]
forall a. Semigroup a => a -> a -> a
<> [Chart Double] -> [Chart Double] -> Bool -> [Chart Double]
forall a. a -> a -> Bool -> a
bool [] (BarOptions -> BarData -> [Chart Double]
barTextCharts BarOptions
bo BarData
bd) (BarOptions
bo BarOptions -> Getting Bool BarOptions Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool BarOptions Bool
forall a. IsLabel "displayValues" a => a
forall (x :: Symbol) a. IsLabel x a => a
#displayValues)

flipAllAxes :: Orientation -> [AxisOptions] -> [AxisOptions]
flipAllAxes :: Orientation -> [AxisOptions] -> [AxisOptions]
flipAllAxes Orientation
o = (AxisOptions -> AxisOptions) -> [AxisOptions] -> [AxisOptions]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((AxisOptions -> AxisOptions)
-> (AxisOptions -> AxisOptions)
-> Bool
-> AxisOptions
-> AxisOptions
forall a. a -> a -> Bool -> a
bool AxisOptions -> AxisOptions
forall a. a -> a
id AxisOptions -> AxisOptions
flipAxis (Orientation
o Orientation -> Orientation -> Bool
forall a. Eq a => a -> a -> Bool
== Orientation
Vert))

barDataTP :: Bool -> FormatN -> Double -> Double -> [[Double]] -> [[(Text, Double)]]
barDataTP :: Bool
-> FormatN -> Double -> Double -> [[Double]] -> [[(Text, Double)]]
barDataTP Bool
add FormatN
fn Double
d Double
negd [[Double]]
bs =
  ([Double] -> [Double] -> [(Text, Double)])
-> [[Double]] -> [[Double]] -> [[(Text, Double)]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ((Double -> Double -> (Text, Double))
-> [Double] -> [Double] -> [(Text, Double)]
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' ([[Double]] -> [[Double]] -> Bool -> [[Double]]
forall a. a -> a -> Bool -> a
bool [[Double]]
bs' ([[Double]] -> [[Double]]
accRows [[Double]]
bs') Bool
add)
  where
    drop' :: Double -> Double
drop' Double
x = Double -> Double -> Bool -> Double
forall a. a -> a -> Bool -> a
bool (Double
x Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- (Double
negd Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* (Double
w Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Double
y))) (Double
x Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ (Double
d Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* (Double
w Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Double
y))) (Double
x Double -> Double -> Bool
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
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 Bool
add Orientation
orient HudOptions
_) [[Double]]
bs = ([Text] -> [Point Double] -> [(Text, Point Double)])
-> [[Text]] -> [[Point Double]] -> [[(Text, Point Double)]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith [Text] -> [Point Double] -> [(Text, Point Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip (((Text, Double) -> Text) -> [(Text, Double)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text, Double) -> Text
forall a b. (a, b) -> a
fst ([(Text, Double)] -> [Text]) -> [[(Text, Double)]] -> [[Text]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool
-> FormatN -> Double -> Double -> [[Double]] -> [[(Text, Double)]]
barDataTP Bool
add FormatN
fn Double
tgap Double
tgapneg [[Double]]
bs') (Orientation -> [[Point Double]]
txs'' Orientation
orient)
  where
    bs' :: [[Double]]
bs' = [[Double]] -> [[Double]] -> Bool -> [[Double]]
forall a. a -> a -> Bool -> a
bool [[Double]]
bs ([[Double]] -> [[Double]]
appendZero [[Double]]
bs) Bool
add
    txs'' :: Orientation -> [[Point Double]]
txs'' Orientation
Hori = [[Point Double]]
txs'
    txs'' Orientation
Vert = (Point Double -> Point Double) -> [Point Double] -> [Point Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Point Double
x Double
y) -> Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
y Double
x) ([Point Double] -> [Point Double])
-> [[Point Double]] -> [[Point Double]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Point Double]]
txs'
    txs' :: [[Point Double]]
txs' = (Double -> [Double] -> [Point Double])
-> [Double] -> [[Double]] -> [[Point Double]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Double -> [Double] -> [Point Double]
addX [Double
0 ..] (((Text, Double) -> Double) -> [(Text, Double)] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text, Double) -> Double
forall a b. (a, b) -> b
snd ([(Text, Double)] -> [Double]) -> [[(Text, Double)]] -> [[Double]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool
-> FormatN -> Double -> Double -> [[Double]] -> [[(Text, Double)]]
barDataTP Bool
add FormatN
fn Double
tgap Double
tgapneg [[Double]]
bs')
    addX :: Double -> [Double] -> [Point Double]
addX Double
z [Double]
y =
      (Double -> Double -> Point Double)
-> [Double] -> [Double] -> [Point Double]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
        ( \Double
x Double
y' ->
            Double -> Double -> Point Double
forall a. a -> a -> Point a
Point
              (Double
x Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ (Double
ogap Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Double
2) Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ Double
z Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Double
bstep Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ Double
bstep Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Double
2 Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Double
igap' Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Double
2)
              Double
y'
        )
        [Double
0 ..]
        [Double]
y
    n :: Double
n = Int -> Double
forall a b. FromIntegral a b => b -> a
fromIntegral ([[Double]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Double]]
bs')
    bstep :: Double
bstep = (Double
1 Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- (Double
1 Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ Double
1) Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Double
ogap Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ (Double
n Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- Double
1) Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Double
igap') Double -> Double -> Double
forall a. Divisive a => a -> a -> a
/ Double
n
    igap' :: Double
igap' = Double
igap Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* (Double
1 Double -> Double -> Double
forall a. Subtractive a => a -> a -> a
- (Double
1 Double -> Double -> Double
forall a. Additive a => a -> a -> a
+ Double
1) Double -> Double -> Double
forall a. Multiplicative a => a -> a -> a
* Double
ogap)

-- | text, hold the bars
barTextCharts :: BarOptions -> BarData -> [Chart Double]
barTextCharts :: BarOptions -> BarData -> [Chart Double]
barTextCharts BarOptions
bo BarData
bd =
  (TextStyle -> [(Text, Point Double)] -> Chart Double)
-> [TextStyle] -> [[(Text, Point Double)]] -> [Chart Double]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\TextStyle
o [(Text, Point Double)]
d -> Annotation -> [XY Double] -> Chart Double
forall a. Annotation -> [XY a] -> Chart a
Chart (TextStyle -> [Text] -> Annotation
TextA TextStyle
o ((Text, Point Double) -> Text
forall a b. (a, b) -> a
fst ((Text, Point Double) -> Text) -> [(Text, Point Double)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Point Double)]
d)) (Point Double -> XY Double
forall a. Point a -> XY a
PointXY (Point Double -> XY Double)
-> ((Text, Point Double) -> Point Double)
-> (Text, Point Double)
-> XY Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Point Double) -> Point Double
forall a b. (a, b) -> b
snd ((Text, Point Double) -> XY Double)
-> [(Text, Point Double)] -> [XY Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Point Double)]
d)) (BarOptions
bo BarOptions
-> Getting [TextStyle] BarOptions [TextStyle] -> [TextStyle]
forall s a. s -> Getting a s a -> a
^. Getting [TextStyle] BarOptions [TextStyle]
forall a. IsLabel "barTextStyles" a => a
forall (x :: Symbol) a. IsLabel x a => a
#barTextStyles) (BarOptions -> [[Double]] -> [[(Text, Point Double)]]
barTexts BarOptions
bo (BarData
bd BarData -> Getting [[Double]] BarData [[Double]] -> [[Double]]
forall s a. s -> Getting a s a -> a
^. Getting [[Double]] BarData [[Double]]
forall a. IsLabel "barData" a => a
forall (x :: Symbol) a. IsLabel x a => a
#barData))