{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
{-# OPTIONS_GHC -Wall #-}
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)
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 -> LegendOptions
barLegendOptions :: LegendOptions
}
deriving (Int -> BarOptions -> ShowS
[BarOptions] -> ShowS
BarOptions -> String
(Int -> BarOptions -> ShowS)
-> (BarOptions -> String)
-> ([BarOptions] -> ShowS)
-> Show BarOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
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)
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
& Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions
-> HudOptions -> ChartSvg -> ChartSvg
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set IsLabel
"hudOptions"
(Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions)
Optic A_Lens NoIx ChartSvg ChartSvg HudOptions HudOptions
#hudOptions (BarOptions -> BarData -> HudOptions
barHudOptions BarOptions
bo BarData
bd)
ChartSvg -> (ChartSvg -> ChartSvg) -> ChartSvg
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartSvg ChartSvg ChartTree ChartTree
-> ChartTree -> ChartSvg -> ChartSvg
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
[Chart] -> [Chart] -> [Chart]
forall a. Semigroup a => a -> a -> a
<> [Chart] -> [Chart] -> Bool -> [Chart]
forall a. a -> a -> Bool -> a
bool [] (BarOptions -> BarData -> [Chart]
barTextCharts BarOptions
bo BarData
bd) (Optic' A_Lens NoIx BarOptions Bool -> BarOptions -> Bool
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view IsLabel "displayValues" (Optic' A_Lens NoIx BarOptions Bool)
Optic' A_Lens NoIx BarOptions Bool
#displayValues BarOptions
bo)
)
)
barHudOptions :: BarOptions -> BarData -> HudOptions
barHudOptions :: BarOptions -> BarData -> HudOptions
barHudOptions BarOptions
bo BarData
bd =
HudOptions
forall a. Monoid a => a
mempty
HudOptions -> (HudOptions -> HudOptions) -> HudOptions
forall a b. a -> (a -> b) -> b
& IsLabel
"axes"
(Optic
A_Lens
NoIx
HudOptions
HudOptions
[(Double, AxisOptions)]
[(Double, AxisOptions)])
Optic
A_Lens
NoIx
HudOptions
HudOptions
[(Double, AxisOptions)]
[(Double, AxisOptions)]
#axes
Optic
A_Lens
NoIx
HudOptions
HudOptions
[(Double, AxisOptions)]
[(Double, AxisOptions)]
-> [(Double, AxisOptions)] -> HudOptions -> HudOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ [ (Double
1, AxisOptions
axis1),
(Double
1, AxisOptions
axis2)
]
HudOptions -> (HudOptions -> HudOptions) -> HudOptions
forall a b. a -> (a -> b) -> b
& IsLabel
"legends"
(Optic
A_Lens
NoIx
HudOptions
HudOptions
[(Double, LegendOptions)]
[(Double, LegendOptions)])
Optic
A_Lens
NoIx
HudOptions
HudOptions
[(Double, LegendOptions)]
[(Double, LegendOptions)]
#legends
Optic
A_Lens
NoIx
HudOptions
HudOptions
[(Double, LegendOptions)]
[(Double, LegendOptions)]
-> [(Double, LegendOptions)] -> HudOptions -> HudOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ [ (Double
10, LegendOptions
o LegendOptions -> (LegendOptions -> LegendOptions) -> LegendOptions
forall a b. a -> (a -> b) -> b
& IsLabel
"content"
(Optic
A_Lens
NoIx
LegendOptions
LegendOptions
[(Text, Chart)]
[(Text, Chart)])
Optic
A_Lens
NoIx
LegendOptions
LegendOptions
[(Text, Chart)]
[(Text, Chart)]
#content Optic
A_Lens
NoIx
LegendOptions
LegendOptions
[(Text, Chart)]
[(Text, Chart)]
-> [(Text, Chart)] -> LegendOptions -> LegendOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ BarOptions -> BarData -> [(Text, Chart)]
barLegendContent BarOptions
bo BarData
bd)
]
where
o :: LegendOptions
o = Optic' A_Lens NoIx BarOptions LegendOptions
-> BarOptions -> LegendOptions
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view IsLabel
"barLegendOptions" (Optic' A_Lens NoIx BarOptions LegendOptions)
Optic' A_Lens NoIx BarOptions LegendOptions
#barLegendOptions BarOptions
bo
axis1 :: AxisOptions
axis1 = (AxisOptions -> AxisOptions)
-> (AxisOptions -> AxisOptions)
-> Bool
-> AxisOptions
-> AxisOptions
forall a. a -> a -> Bool -> a
bool AxisOptions -> AxisOptions
forall a. a -> a
id AxisOptions -> AxisOptions
flipAxis (BarOptions -> Orientation
barOrientation BarOptions
bo Orientation -> Orientation -> Bool
forall a. Eq a => a -> a -> Bool
== Orientation
Vert) (AxisOptions
defaultAxisOptions AxisOptions -> (AxisOptions -> AxisOptions) -> AxisOptions
forall a b. a -> (a -> b) -> b
& IsLabel
"ticks" (Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks)
Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
#ticks Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
-> Optic
A_Lens
NoIx
Ticks
Ticks
(Maybe (LineStyle, Double))
(Maybe (LineStyle, Double))
-> Optic
A_Lens
NoIx
AxisOptions
AxisOptions
(Maybe (LineStyle, Double))
(Maybe (LineStyle, Double))
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
% IsLabel
"ltick"
(Optic
A_Lens
NoIx
Ticks
Ticks
(Maybe (LineStyle, Double))
(Maybe (LineStyle, Double)))
Optic
A_Lens
NoIx
Ticks
Ticks
(Maybe (LineStyle, Double))
(Maybe (LineStyle, Double))
#ltick Optic
A_Lens
NoIx
AxisOptions
AxisOptions
(Maybe (LineStyle, Double))
(Maybe (LineStyle, Double))
-> Maybe (LineStyle, Double) -> AxisOptions -> AxisOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Maybe (LineStyle, Double)
forall a. Maybe a
Nothing AxisOptions -> (AxisOptions -> AxisOptions) -> AxisOptions
forall a b. a -> (a -> b) -> b
& IsLabel
"ticks" (Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks)
Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
#ticks Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
-> Optic A_Lens NoIx Ticks Ticks TickStyle TickStyle
-> Optic A_Lens NoIx AxisOptions AxisOptions TickStyle TickStyle
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% IsLabel "style" (Optic A_Lens NoIx Ticks Ticks TickStyle TickStyle)
Optic A_Lens NoIx Ticks Ticks TickStyle TickStyle
#style Optic A_Lens NoIx AxisOptions AxisOptions TickStyle TickStyle
-> TickStyle -> AxisOptions -> AxisOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ BarData -> TickStyle
barTicks BarData
bd)
axis2 :: AxisOptions
axis2 = (AxisOptions -> AxisOptions)
-> (AxisOptions -> AxisOptions)
-> Bool
-> AxisOptions
-> AxisOptions
forall a. a -> a -> Bool -> a
bool AxisOptions -> AxisOptions
forall a. a -> a
id AxisOptions -> AxisOptions
flipAxis (BarOptions -> Orientation
barOrientation BarOptions
bo Orientation -> Orientation -> Bool
forall a. Eq a => a -> a -> Bool
== Orientation
Hori) AxisOptions
defaultAxisOptions
defaultBarOptions :: BarOptions
defaultBarOptions :: BarOptions
defaultBarOptions =
[RectStyle]
-> [TextStyle]
-> Double
-> Double
-> Double
-> Double
-> Bool
-> FormatN
-> Bool
-> Orientation
-> 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 (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
2) Bool
True)
Bool
False
Orientation
Hori
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)) (Int -> RectStyle) -> [Int] -> [RectStyle]
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 TextStyle -> (TextStyle -> TextStyle) -> TextStyle
forall a b. a -> (a -> b) -> b
& IsLabel
"color" (Optic A_Lens NoIx TextStyle TextStyle Colour Colour)
Optic A_Lens NoIx TextStyle TextStyle Colour Colour
#color Optic A_Lens NoIx TextStyle TextStyle Colour Colour
-> Colour -> TextStyle -> TextStyle
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 TextStyle -> (TextStyle -> TextStyle) -> TextStyle
forall a b. a -> (a -> b) -> b
& IsLabel
"size" (Optic A_Lens NoIx TextStyle TextStyle Double Double)
Optic A_Lens NoIx TextStyle TextStyle Double Double
#size Optic A_Lens NoIx TextStyle TextStyle Double Double
-> Double -> TextStyle -> TextStyle
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) (Int -> TextStyle) -> [Int] -> [TextStyle]
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]
data BarData = BarData
{ BarData -> [[Double]]
barData :: [[Double]],
BarData -> [Text]
barRowLabels :: [Text],
BarData -> [Text]
barColumnLabels :: [Text]
}
deriving (Int -> BarData -> ShowS
[BarData] -> ShowS
BarData -> String
(Int -> BarData -> ShowS)
-> (BarData -> String) -> ([BarData] -> ShowS) -> Show BarData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
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 LegendOptions
_) [[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. Num a => a -> a -> a
+ (Double
ogap Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2) Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
z Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
bstep)
(Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Double
ogap Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2) Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
z Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
bstep Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
bstep Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
igap')
Double
yl
Double
yh
)
)
[Double
0 ..]
[(Double, Double)]
ys
n :: Double
n = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([[Double]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Double]]
bs')
bstep :: Double
bstep = (Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- (Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
1) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
ogap Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Double
n Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
1) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
igap') Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
n
igap' :: Double
igap' = Double
igap Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- (Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
1) Double -> Double -> Double
forall a. Num 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 -> (Double, Double)) -> [Double] -> [(Double, Double)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Double
0,)) [[Double]]
bs
Bool
True -> ([Double] -> [(Double, Double)])
-> [[Double]] -> [[(Double, Double)]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Double -> (Double, Double)) -> [Double] -> [(Double, Double)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Double
0,)) ([[Double]] -> [[Double]]
accRows [[Double]]
bs)
barRange ::
[[Double]] -> Rect Double
barRange :: [[Double]] -> Rect Double
barRange [[Double]]
ys = Maybe (Rect Double) -> Rect Double
singletonGuard (Maybe (Rect Double) -> Rect Double)
-> Maybe (Rect Double) -> Rect Double
forall a b. (a -> b) -> a -> b
$ Rect Double -> Maybe (Rect Double)
forall a. a -> Maybe a
Just (Rect Double -> Maybe (Rect Double))
-> Rect Double -> Maybe (Rect Double)
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Double -> Double -> Rect Double
forall a. a -> a -> a -> a -> Rect a
Rect Double
0 (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Double) -> Int -> Double
forall a b. (a -> b) -> a -> b
$ [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) = Range Double -> Maybe (Range Double) -> Range Double
forall a. a -> Maybe a -> a
fromMaybe Range Double
forall a. Multiplicative a => a
one (Maybe (Range Double) -> Range Double)
-> Maybe (Range Double) -> Range Double
forall a b. (a -> b) -> a -> b
$ [Element (Range Double)] -> Maybe (Range Double)
forall s (f :: * -> *).
(Space s, Traversable f) =>
f (Element s) -> Maybe s
space1 ([Element (Range Double)] -> Maybe (Range Double))
-> [Element (Range Double)] -> Maybe (Range Double)
forall a b. (a -> b) -> a -> b
$ [[Double]] -> [Double]
forall a. Monoid a => [a] -> a
mconcat [[Double]]
ys
bars :: BarOptions -> BarData -> [Chart]
bars :: BarOptions -> BarData -> [Chart]
bars BarOptions
bo BarData
bd = [Chart] -> [Chart] -> Bool -> [Chart]
forall a. a -> a -> Bool -> a
bool [Chart]
cs [] ([Double] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Double] -> Bool) -> [Double] -> Bool
forall a b. (a -> b) -> a -> b
$ [[Double]] -> [Double]
forall a. Monoid a => [a] -> a
mconcat ([[Double]] -> [Double]) -> [[Double]] -> [Double]
forall a b. (a -> b) -> a -> b
$ Optic' A_Lens NoIx BarData [[Double]] -> BarData -> [[Double]]
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view IsLabel "barData" (Optic' A_Lens NoIx BarData [[Double]])
Optic' A_Lens NoIx BarData [[Double]]
#barData BarData
bd)
where
cs :: [Chart]
cs = (RectStyle -> [Rect Double] -> Chart)
-> [RectStyle] -> [[Rect Double]] -> [Chart]
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 BarOptions
-> Optic' A_Lens NoIx BarOptions [RectStyle] -> [RectStyle]
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "barRectStyles" (Optic' A_Lens NoIx BarOptions [RectStyle])
Optic' A_Lens NoIx BarOptions [RectStyle]
#barRectStyles [RectStyle] -> [RectStyle] -> [RectStyle]
forall a. Semigroup a => a -> a -> a
<> RectStyle -> [RectStyle]
forall a. a -> [a]
repeat RectStyle
defaultRectStyle) (BarOptions -> [[Double]] -> [[Rect Double]]
barRects BarOptions
bo (BarData
bd BarData -> Optic' A_Lens NoIx BarData [[Double]] -> [[Double]]
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "barData" (Optic' A_Lens NoIx BarData [[Double]])
Optic' A_Lens NoIx BarData [[Double]]
#barData)) [Chart] -> [Chart] -> [Chart]
forall a. Semigroup a => a -> a -> a
<> [[Rect Double] -> Chart
BlankChart [Double -> Double -> Double -> Double -> Rect Double
forall a. a -> a -> a -> a -> Rect a
Rect (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
- (BarOptions
bo BarOptions -> Optic' A_Lens NoIx BarOptions Double -> Double
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "outerGap" (Optic' A_Lens NoIx BarOptions Double)
Optic' A_Lens NoIx BarOptions Double
#outerGap)) (Double
z Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (BarOptions
bo BarOptions -> Optic' A_Lens NoIx BarOptions Double -> Double
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "outerGap" (Optic' A_Lens NoIx BarOptions Double)
Optic' A_Lens NoIx BarOptions Double
#outerGap)) Double
y Double
w]]
(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
$ [[Rect Double]] -> [Rect Double]
forall a. Monoid a => [a] -> a
mconcat ([[Rect Double]] -> [Rect Double])
-> [[Rect Double]] -> [Rect Double]
forall a b. (a -> b) -> a -> b
$ BarOptions -> [[Double]] -> [[Rect Double]]
barRects BarOptions
bo (BarData
bd BarData -> Optic' A_Lens NoIx BarData [[Double]] -> [[Double]]
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "barData" (Optic' A_Lens NoIx BarData [[Double]])
Optic' A_Lens NoIx BarData [[Double]]
#barData)
maxRows :: [[Double]] -> Int
maxRows :: [[Double]] -> Int
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. Num 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] -> [Double]) -> [[Double]] -> [[Double]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Double] -> [Double]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList ([[Double]] -> [[Double]]) -> [[Double]] -> [[Double]]
forall a b. (a -> b) -> a -> b
$ [[Double]] -> [[Double]]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList [[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 -> Optic' A_Lens NoIx BarData [[Double]] -> [[Double]]
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "barData" (Optic' A_Lens NoIx BarData [[Double]])
Optic' A_Lens NoIx BarData [[Double]]
#barData) = TickStyle
TickNone
| [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (BarData
bd BarData -> Optic' A_Lens NoIx BarData [Text] -> [Text]
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "barRowLabels" (Optic' A_Lens NoIx BarData [Text])
Optic' A_Lens NoIx BarData [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 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 -> Optic' A_Lens NoIx BarData [[Double]] -> [[Double]]
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "barData" (Optic' A_Lens NoIx BarData [[Double]])
Optic' A_Lens NoIx BarData [[Double]]
#barData) Int -> Int -> Int
forall a. Num 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 -> Optic' A_Lens NoIx BarData [[Double]] -> [[Double]]
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "barData" (Optic' A_Lens NoIx BarData [[Double]])
Optic' A_Lens NoIx BarData [[Double]]
#barData)) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$
(BarData
bd BarData -> Optic' A_Lens NoIx BarData [Text] -> [Text]
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "barRowLabels" (Optic' A_Lens NoIx BarData [Text])
Optic' A_Lens NoIx BarData [Text]
#barRowLabels) [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> Text -> [Text]
forall a. a -> [a]
repeat Text
""
barLegendContent :: BarOptions -> BarData -> [(Text, Chart)]
barLegendContent :: BarOptions -> BarData -> [(Text, Chart)]
barLegendContent BarOptions
bo BarData
bd
| [[Double]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (BarData
bd BarData -> Optic' A_Lens NoIx BarData [[Double]] -> [[Double]]
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "barData" (Optic' A_Lens NoIx BarData [[Double]])
Optic' A_Lens NoIx BarData [[Double]]
#barData) = []
| [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (BarData
bd BarData -> Optic' A_Lens NoIx BarData [Text] -> [Text]
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "barColumnLabels" (Optic' A_Lens NoIx BarData [Text])
Optic' A_Lens NoIx BarData [Text]
#barColumnLabels) = []
| Bool
otherwise =
[Text] -> [Chart] -> [(Text, Chart)]
forall a b. [a] -> [b] -> [(a, b)]
zip
(Optic' A_Lens NoIx BarData [Text] -> BarData -> [Text]
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view IsLabel "barColumnLabels" (Optic' A_Lens NoIx BarData [Text])
Optic' A_Lens NoIx BarData [Text]
#barColumnLabels BarData
bd [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> Text -> [Text]
forall a. a -> [a]
repeat Text
"")
((\RectStyle
s -> RectStyle -> [Rect Double] -> Chart
RectChart RectStyle
s [Rect Double
forall a. Multiplicative a => a
one]) (RectStyle -> Chart) -> [RectStyle] -> [Chart]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> [RectStyle] -> [RectStyle]
forall a. Int -> [a] -> [a]
take ([[Double]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Optic' A_Lens NoIx BarData [[Double]] -> BarData -> [[Double]]
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view IsLabel "barData" (Optic' A_Lens NoIx BarData [[Double]])
Optic' A_Lens NoIx BarData [[Double]]
#barData BarData
bd)) (BarOptions
bo BarOptions
-> Optic' A_Lens NoIx BarOptions [RectStyle] -> [RectStyle]
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "barRectStyles" (Optic' A_Lens NoIx BarOptions [RectStyle])
Optic' A_Lens NoIx BarOptions [RectStyle]
#barRectStyles))
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. Num a => a -> a -> a
- (Double
negd Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
w Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
y))) (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Double
d Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
w Double -> Double -> Double
forall a. Num 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 LegendOptions
_) [[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. Num a => a -> a -> a
+ (Double
ogap Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2) Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
z Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
bstep Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
bstep Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
igap' Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2)
Double
y'
)
[Double
0 ..]
[Double]
y
n :: Double
n = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([[Double]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Double]]
bs')
bstep :: Double
bstep = (Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- (Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
1) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
ogap Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Double
n Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
1) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
igap') Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
n
igap' :: Double
igap' = Double
igap Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- (Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
1) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
ogap)
barTextCharts :: BarOptions -> BarData -> [Chart]
barTextCharts :: BarOptions -> BarData -> [Chart]
barTextCharts BarOptions
bo BarData
bd =
(TextStyle -> [(Text, Point Double)] -> Chart)
-> [TextStyle] -> [[(Text, Point Double)]] -> [Chart]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith TextStyle -> [(Text, Point Double)] -> Chart
TextChart (BarOptions
bo BarOptions
-> Optic' A_Lens NoIx BarOptions [TextStyle] -> [TextStyle]
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "barTextStyles" (Optic' A_Lens NoIx BarOptions [TextStyle])
Optic' A_Lens NoIx BarOptions [TextStyle]
#barTextStyles [TextStyle] -> [TextStyle] -> [TextStyle]
forall a. Semigroup a => a -> a -> a
<> TextStyle -> [TextStyle]
forall a. a -> [a]
repeat TextStyle
defaultTextStyle) (BarOptions -> [[Double]] -> [[(Text, Point Double)]]
barTexts BarOptions
bo (BarData
bd BarData -> Optic' A_Lens NoIx BarData [[Double]] -> [[Double]]
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel "barData" (Optic' A_Lens NoIx BarData [[Double]])
Optic' A_Lens NoIx BarData [[Double]]
#barData))