{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -Wall #-}
module Chart.Bar
( BarOptions (..),
defaultBarOptions,
BarData (..),
barDataLowerUpper,
barRange,
bars,
barChart,
)
where
import Chart.Types
import Chart.Render
import Control.Lens
import Data.Colour
import Data.FormatN
import Data.Generics.Labels ()
import qualified Data.List.NonEmpty as NonEmpty
import NumHask.Prelude
import NumHask.Space
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)
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
& IsLabel
"hudAxes"
(ASetter HudOptions HudOptions [AxisOptions] [AxisOptions])
ASetter HudOptions HudOptions [AxisOptions] [AxisOptions]
#hudAxes
ASetter HudOptions HudOptions [AxisOptions] [AxisOptions]
-> [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
& IsLabel
"axisTick"
((Tick -> Identity Tick) -> AxisOptions -> Identity AxisOptions)
(Tick -> Identity Tick) -> AxisOptions -> Identity AxisOptions
#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 k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IsLabel
"ltick"
((Maybe (LineStyle, Double)
-> Identity (Maybe (LineStyle, Double)))
-> Tick -> Identity Tick)
(Maybe (LineStyle, Double) -> Identity (Maybe (LineStyle, Double)))
-> Tick -> Identity Tick
#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
& IsLabel "place" (ASetter AxisOptions AxisOptions Place Place)
ASetter AxisOptions AxisOptions Place Place
#place ASetter AxisOptions AxisOptions Place Place
-> 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
& IsLabel "hudTitles" (ASetter HudOptions HudOptions [Title] [Title])
ASetter HudOptions HudOptions [Title] [Title]
#hudTitles ASetter HudOptions HudOptions [Title] [Title]
-> [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
& IsLabel
"hudLegend"
(ASetter
HudOptions
HudOptions
(Maybe (LegendOptions, [(Annotation, Text)]))
(Maybe (LegendOptions, [(Annotation, Text)])))
ASetter
HudOptions
HudOptions
(Maybe (LegendOptions, [(Annotation, Text)]))
(Maybe (LegendOptions, [(Annotation, Text)]))
#hudLegend
ASetter
HudOptions
HudOptions
(Maybe (LegendOptions, [(Annotation, Text)]))
(Maybe (LegendOptions, [(Annotation, Text)]))
-> (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
& IsLabel "lplace" (ASetter LegendOptions LegendOptions Place Place)
ASetter LegendOptions LegendOptions Place Place
#lplace ASetter LegendOptions LegendOptions Place Place
-> 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
& IsLabel "lsize" (ASetter LegendOptions LegendOptions Double Double)
ASetter LegendOptions LegendOptions Double Double
#lsize ASetter LegendOptions LegendOptions Double Double
-> 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
& IsLabel "vgap" (ASetter LegendOptions LegendOptions Double Double)
ASetter LegendOptions LegendOptions Double Double
#vgap ASetter LegendOptions LegendOptions Double Double
-> 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
& IsLabel "hgap" (ASetter LegendOptions LegendOptions Double Double)
ASetter LegendOptions LegendOptions Double Double
#hgap ASetter LegendOptions LegendOptions Double Double
-> 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
& IsLabel
"ltext"
((TextStyle -> Identity TextStyle)
-> LegendOptions -> Identity LegendOptions)
(TextStyle -> Identity TextStyle)
-> LegendOptions -> Identity LegendOptions
#ltext ((TextStyle -> Identity TextStyle)
-> LegendOptions -> Identity LegendOptions)
-> ((Double -> Identity Double) -> TextStyle -> Identity TextStyle)
-> ASetter LegendOptions LegendOptions Double Double
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IsLabel
"size"
((Double -> Identity Double) -> TextStyle -> Identity TextStyle)
(Double -> Identity Double) -> TextStyle -> Identity TextStyle
#size ASetter LegendOptions LegendOptions Double Double
-> 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
& IsLabel
"lscale" (ASetter LegendOptions LegendOptions Double Double)
ASetter LegendOptions LegendOptions Double Double
#lscale ASetter LegendOptions LegendOptions Double Double
-> 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
& IsLabel "color" (ASetter TextStyle TextStyle Colour Colour)
ASetter TextStyle TextStyle Colour Colour
#color ASetter TextStyle TextStyle Colour Colour
-> 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
& IsLabel
"size"
((Double -> Identity Double) -> TextStyle -> Identity TextStyle)
(Double -> Identity Double) -> TextStyle -> Identity TextStyle
#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_
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)
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)
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
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)
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
^. IsLabel
"barRectStyles" (Getting [RectStyle] BarOptions [RectStyle])
Getting [RectStyle] BarOptions [RectStyle]
#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
^. IsLabel "barData" (Getting [[Double]] BarData [[Double]])
Getting [[Double]] BarData [[Double]]
#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
^. IsLabel "outerGap" (Getting Double BarOptions Double)
Getting Double BarOptions Double
#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
^. IsLabel "outerGap" (Getting Double BarOptions Double)
Getting Double BarOptions Double
#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
^. IsLabel "barData" (Getting [[Double]] BarData [[Double]])
Getting [[Double]] BarData [[Double]]
#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 k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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
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
^. IsLabel "barData" (Getting [[Double]] BarData [[Double]])
Getting [[Double]] BarData [[Double]]
#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
^. IsLabel
"barRowLabels" (Getting (Maybe [Text]) BarData (Maybe [Text]))
Getting (Maybe [Text]) BarData (Maybe [Text])
#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 k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> String
forall a b. (Show a, ConvertText String b) => a -> b
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
^. IsLabel "barData" (Getting [[Double]] BarData [[Double]])
Getting [[Double]] BarData [[Double]]
#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
^. IsLabel "barData" (Getting [[Double]] BarData [[Double]])
Getting [[Double]] BarData [[Double]]
#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
^. IsLabel
"barRowLabels" (Getting (Maybe [Text]) BarData (Maybe [Text]))
Getting (Maybe [Text]) BarData (Maybe [Text])
#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
& IsLabel
"axisTick"
((Tick -> Identity Tick) -> AxisOptions -> Identity AxisOptions)
(Tick -> Identity Tick) -> AxisOptions -> Identity AxisOptions
#axisTick ((Tick -> Identity Tick) -> AxisOptions -> Identity AxisOptions)
-> ((TickStyle -> Identity TickStyle) -> Tick -> Identity Tick)
-> (TickStyle -> Identity TickStyle)
-> AxisOptions
-> Identity AxisOptions
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IsLabel
"tstyle"
((TickStyle -> Identity TickStyle) -> Tick -> Identity Tick)
(TickStyle -> Identity TickStyle) -> Tick -> Identity Tick
#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
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
^. IsLabel "barData" (Getting [[Double]] BarData [[Double]])
Getting [[Double]] BarData [[Double]]
#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
^. IsLabel
"barColumnLabels" (Getting (Maybe [Text]) BarData (Maybe [Text]))
Getting (Maybe [Text]) BarData (Maybe [Text])
#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
^. IsLabel
"barRectStyles" (Getting [RectStyle] BarOptions [RectStyle])
Getting [RectStyle] BarOptions [RectStyle]
#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
^. IsLabel "barData" (Getting [[Double]] BarData [[Double]])
Getting [[Double]] BarData [[Double]]
#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
^. IsLabel
"barColumnLabels" (Getting (Maybe [Text]) BarData (Maybe [Text]))
Getting (Maybe [Text]) BarData (Maybe [Text])
#barColumnLabels) [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> Text -> [Text]
forall a. a -> [a]
repeat Text
""
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 .~ bo ^. #barHudOptions &
#hudOptions . #hudLegend %~ fmap (second (const (barLegend bd bo))) &
#hudOptions . #hudAxes %~ tickFirstAxis bd . flipAllAxes (barOrientation bo) &
#chartList .~ bars bo bd <> bool [] (barTextCharts bo bd) (bo ^. #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 k (cat :: k -> k -> *) (a :: k). Category cat => cat 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'
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)
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 k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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
^. IsLabel
"barTextStyles" (Getting [TextStyle] BarOptions [TextStyle])
Getting [TextStyle] BarOptions [TextStyle]
#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
^. IsLabel "barData" (Getting [[Double]] BarData [[Double]])
Getting [[Double]] BarData [[Double]]
#barData))