{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}

-- | Various common (& pretty) chart patterns.
module Prettychart.Charts
  ( UtcAxisStyle (..),
    defaultUtcAxisStyle,
    utcAxis,
    DecileAxisStyle (..),
    defaultDecileAxisStyle,
    qsAxisStyle,
    decileAxis,
    DigitChartStyle (..),
    defaultDigitChartStyle,
    digitChart,
    UtcLineChartStyle (..),
    defaultUtcLineChartStyle,
    utcLineChart,
    CountChartStyle (..),
    defaultCountChartStyle,
    countChart,
    simpleRectChart,
    simpleLineChart,
    simpleScatterChart,
    xify,
    yify,
    titles3,
    histChart,
    hhistChart,
    hhistCharts,
    scatterChart,
    blendMidLineStyles,
    quantileNames,
    quantileChart,
    quantileHistChart,
    digitSurfaceChart,
  )
where

import Chart hiding (abs)
import Control.Category ((>>>))
import Data.Bifunctor
import Data.Bool
import Data.Foldable
import Data.List qualified as List
import Data.Map.Strict qualified as Map
import Data.Maybe
import Data.Text (Text)
import Data.Time (UTCTime (..))
import GHC.Generics
import NumHask.Space
import Optics.Core

-- $setup
--
-- >>> :set -Wno-type-defaults
-- >>> import Chart
-- >>> import Prettychart.Charts
-- >>> import Data.Text (pack, Text)
-- >>> import qualified Data.Text as Text
-- >>> import qualified Data.Text.IO as Text

-- | UTC (time) axis style
data UtcAxisStyle
  = UtcAxisStyle
  { UtcAxisStyle -> Bool
cont :: Bool,
    UtcAxisStyle -> PosDiscontinuous
posd :: PosDiscontinuous,
    UtcAxisStyle -> Maybe Text
utcFormat :: Maybe Text,
    UtcAxisStyle -> Int
nTicks :: Int
  }
  deriving ((forall x. UtcAxisStyle -> Rep UtcAxisStyle x)
-> (forall x. Rep UtcAxisStyle x -> UtcAxisStyle)
-> Generic UtcAxisStyle
forall x. Rep UtcAxisStyle x -> UtcAxisStyle
forall x. UtcAxisStyle -> Rep UtcAxisStyle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UtcAxisStyle -> Rep UtcAxisStyle x
from :: forall x. UtcAxisStyle -> Rep UtcAxisStyle x
$cto :: forall x. Rep UtcAxisStyle x -> UtcAxisStyle
to :: forall x. Rep UtcAxisStyle x -> UtcAxisStyle
Generic)

-- | default UTC (time) axis style
defaultUtcAxisStyle :: UtcAxisStyle
defaultUtcAxisStyle :: UtcAxisStyle
defaultUtcAxisStyle = Bool -> PosDiscontinuous -> Maybe Text -> Int -> UtcAxisStyle
UtcAxisStyle Bool
True PosDiscontinuous
PosInnerOnly (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"%b %y") Int
8

-- | Create a hud that has time as the x-axis based on supplied UTCTime list.
utcAxis :: UtcAxisStyle -> [UTCTime] -> AxisOptions
utcAxis :: UtcAxisStyle -> [UTCTime] -> AxisOptions
utcAxis UtcAxisStyle
s [UTCTime]
ds =
  AxisOptions
defaultXAxisOptions
    AxisOptions -> (AxisOptions -> AxisOptions) -> AxisOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
#ticks
    Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
-> Optic A_Lens NoIx Ticks Ticks Tick Tick
-> Optic A_Lens NoIx AxisOptions AxisOptions Tick Tick
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
% Optic A_Lens NoIx Ticks Ticks Tick Tick
#tick
    Optic A_Lens NoIx AxisOptions AxisOptions Tick Tick
-> Tick -> AxisOptions -> AxisOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ [(Double, Text)] -> Tick
TickPlaced
      ( [(Double, Text)] -> [(Double, Text)] -> Bool -> [(Double, Text)]
forall a. a -> a -> Bool -> a
bool
          (((Int, Text) -> (Double, Text))
-> [(Int, Text)] -> [(Double, Text)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Int -> Double) -> (Int, Text) -> (Double, Text)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral) ([(Int, Text)] -> [(Double, Text)])
-> [(Int, Text)] -> [(Double, Text)]
forall a b. (a -> b) -> a -> b
$ ([(Int, Text)], [UTCTime]) -> [(Int, Text)]
forall a b. (a, b) -> a
fst (([(Int, Text)], [UTCTime]) -> [(Int, Text)])
-> ([(Int, Text)], [UTCTime]) -> [(Int, Text)]
forall a b. (a -> b) -> a -> b
$ PosDiscontinuous
-> Maybe Text -> Int -> [UTCTime] -> ([(Int, Text)], [UTCTime])
placedTimeLabelDiscontinuous PosDiscontinuous
posd Maybe Text
utcFormat Int
nTicks [UTCTime]
ds)
          ((Double -> Double) -> (Double, Text) -> (Double, Text)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Double -> Double -> Double
forall a. Num a => a -> a -> a
* Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([UTCTime] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [UTCTime]
ds Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) ((Double, Text) -> (Double, Text))
-> [(Double, Text)] -> [(Double, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PosDiscontinuous
-> Maybe Text -> Int -> Range UTCTime -> [(Double, Text)]
placedTimeLabelContinuous PosDiscontinuous
posd Maybe Text
utcFormat Int
nTicks ([Element (Range UTCTime)] -> Range UTCTime
forall s (f :: * -> *).
(Space s, Traversable f) =>
f (Element s) -> s
unsafeSpace1 [UTCTime]
[Element (Range UTCTime)]
ds))
          Bool
cont
      )
  where
    cont :: Bool
cont = Optic' A_Lens NoIx UtcAxisStyle Bool -> UtcAxisStyle -> Bool
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx UtcAxisStyle Bool
#cont UtcAxisStyle
s
    posd :: PosDiscontinuous
posd = Optic' A_Lens NoIx UtcAxisStyle PosDiscontinuous
-> UtcAxisStyle -> PosDiscontinuous
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx UtcAxisStyle PosDiscontinuous
#posd UtcAxisStyle
s
    utcFormat :: Maybe Text
utcFormat = Optic' A_Lens NoIx UtcAxisStyle (Maybe Text)
-> UtcAxisStyle -> Maybe Text
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx UtcAxisStyle (Maybe Text)
#utcFormat UtcAxisStyle
s
    nTicks :: Int
nTicks = Optic' A_Lens NoIx UtcAxisStyle Int -> UtcAxisStyle -> Int
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx UtcAxisStyle Int
#nTicks UtcAxisStyle
s

-- | Decile (quantile) axis style
data DecileAxisStyle
  = DecileAxisStyle
  { DecileAxisStyle -> Double
size :: Double,
    DecileAxisStyle -> [Text]
labels :: [Text]
  }
  deriving ((forall x. DecileAxisStyle -> Rep DecileAxisStyle x)
-> (forall x. Rep DecileAxisStyle x -> DecileAxisStyle)
-> Generic DecileAxisStyle
forall x. Rep DecileAxisStyle x -> DecileAxisStyle
forall x. DecileAxisStyle -> Rep DecileAxisStyle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DecileAxisStyle -> Rep DecileAxisStyle x
from :: forall x. DecileAxisStyle -> Rep DecileAxisStyle x
$cto :: forall x. Rep DecileAxisStyle x -> DecileAxisStyle
to :: forall x. Rep DecileAxisStyle x -> DecileAxisStyle
Generic)

-- | Default decile (quantile) axis style
defaultDecileAxisStyle :: DecileAxisStyle
defaultDecileAxisStyle :: DecileAxisStyle
defaultDecileAxisStyle = Double -> [Text] -> DecileAxisStyle
DecileAxisStyle Double
0.04 []

-- | Convert a list of quantiles to 'DecileAxisStyle'
qsAxisStyle :: [Double] -> DecileAxisStyle
qsAxisStyle :: [Double] -> DecileAxisStyle
qsAxisStyle [Double]
qs = DecileAxisStyle
defaultDecileAxisStyle DecileAxisStyle
-> (DecileAxisStyle -> DecileAxisStyle) -> DecileAxisStyle
forall a b. a -> (a -> b) -> b
& Optic' A_Lens NoIx DecileAxisStyle [Text]
-> [Text] -> DecileAxisStyle -> DecileAxisStyle
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic' A_Lens NoIx DecileAxisStyle [Text]
#labels ([Double] -> [Text]
forall (f :: * -> *). Functor f => f Double -> f Text
quantileNames [Double]
qs)

-- | Create an axis from a style.
decileAxis :: DecileAxisStyle -> AxisOptions
decileAxis :: DecileAxisStyle -> AxisOptions
decileAxis DecileAxisStyle
s =
  AxisOptions
defaultYAxisOptions
    AxisOptions -> (AxisOptions -> AxisOptions) -> AxisOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx AxisOptions AxisOptions Tick Tick
-> Tick -> AxisOptions -> AxisOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
#ticks Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
-> Optic A_Lens NoIx Ticks Ticks Tick Tick
-> Optic A_Lens NoIx AxisOptions AxisOptions Tick Tick
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
% Optic A_Lens NoIx Ticks Ticks Tick Tick
#tick) ([(Double, Text)] -> Tick
TickPlaced ([Double] -> [Text] -> [(Double, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
0.5) (Double -> Double) -> [Double] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Double
0 ..]) (Optic' A_Lens NoIx DecileAxisStyle [Text]
-> DecileAxisStyle -> [Text]
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx DecileAxisStyle [Text]
#labels DecileAxisStyle
s)))
    AxisOptions -> (AxisOptions -> AxisOptions) -> AxisOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens
  NoIx
  AxisOptions
  AxisOptions
  (Maybe TickStyle)
  (Maybe TickStyle)
-> Maybe 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
set (Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
#ticks Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
-> Optic
     A_Lens NoIx Ticks Ticks (Maybe TickStyle) (Maybe TickStyle)
-> Optic
     A_Lens
     NoIx
     AxisOptions
     AxisOptions
     (Maybe TickStyle)
     (Maybe 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
% Optic A_Lens NoIx Ticks Ticks (Maybe TickStyle) (Maybe TickStyle)
#lineTick) Maybe TickStyle
forall a. Maybe a
Nothing
    AxisOptions -> (AxisOptions -> AxisOptions) -> AxisOptions
forall a b. a -> (a -> b) -> b
& Optic An_AffineTraversal NoIx AxisOptions AxisOptions Double Double
-> 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
set (Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
#ticks Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
-> Optic
     A_Lens NoIx Ticks Ticks (Maybe TickStyle) (Maybe TickStyle)
-> Optic
     A_Lens
     NoIx
     AxisOptions
     AxisOptions
     (Maybe TickStyle)
     (Maybe 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
% Optic A_Lens NoIx Ticks Ticks (Maybe TickStyle) (Maybe TickStyle)
#textTick Optic
  A_Lens
  NoIx
  AxisOptions
  AxisOptions
  (Maybe TickStyle)
  (Maybe TickStyle)
-> Optic A_Lens NoIx TickStyle TickStyle Style Style
-> Optic
     An_AffineTraversal NoIx AxisOptions AxisOptions Style Style
forall (is :: IxList) (js :: IxList) (ks :: IxList) k k' l m s t u
       v a b.
(AppendIndices is js ks, JoinKinds k A_Prism k',
 JoinKinds k' l m) =>
Optic k is s t (Maybe u) (Maybe v)
-> Optic l js u v a b -> Optic m ks s t a b
%? Optic A_Lens NoIx TickStyle TickStyle Style Style
#style Optic An_AffineTraversal NoIx AxisOptions AxisOptions Style Style
-> Optic A_Lens NoIx Style Style Double Double
-> Optic
     An_AffineTraversal NoIx AxisOptions AxisOptions Double 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
% Optic A_Lens NoIx Style Style Double Double
#size) (Optic' A_Lens NoIx DecileAxisStyle Double
-> DecileAxisStyle -> Double
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx DecileAxisStyle Double
#size DecileAxisStyle
s)

-- | Chart style for a digit chart
data DigitChartStyle
  = DigitChartStyle
  { DigitChartStyle -> Maybe UtcAxisStyle
utcAxisStyle :: Maybe UtcAxisStyle,
    DigitChartStyle -> Maybe DecileAxisStyle
decileAxisStyle :: Maybe DecileAxisStyle,
    DigitChartStyle -> Style
glyphStyle :: Style,
    DigitChartStyle -> Bool
hasLegend :: Bool
  }
  deriving ((forall x. DigitChartStyle -> Rep DigitChartStyle x)
-> (forall x. Rep DigitChartStyle x -> DigitChartStyle)
-> Generic DigitChartStyle
forall x. Rep DigitChartStyle x -> DigitChartStyle
forall x. DigitChartStyle -> Rep DigitChartStyle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DigitChartStyle -> Rep DigitChartStyle x
from :: forall x. DigitChartStyle -> Rep DigitChartStyle x
$cto :: forall x. Rep DigitChartStyle x -> DigitChartStyle
to :: forall x. Rep DigitChartStyle x -> DigitChartStyle
Generic)

-- | Default chart style for a digit chart
defaultDigitChartStyle :: DigitChartStyle
defaultDigitChartStyle :: DigitChartStyle
defaultDigitChartStyle = Maybe UtcAxisStyle
-> Maybe DecileAxisStyle -> Style -> Bool -> DigitChartStyle
DigitChartStyle (UtcAxisStyle -> Maybe UtcAxisStyle
forall a. a -> Maybe a
Just UtcAxisStyle
defaultUtcAxisStyle) Maybe DecileAxisStyle
forall a. Maybe a
Nothing (Style
defaultGlyphStyle Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Double Double
-> Double -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Double Double
#size Double
0.01) Bool
True

-- | A chart drawing a (quantiled or digitized) time series
digitChart ::
  DigitChartStyle ->
  [UTCTime] ->
  [Int] ->
  ChartOptions
digitChart :: DigitChartStyle -> [UTCTime] -> [Int] -> ChartOptions
digitChart DigitChartStyle
s [UTCTime]
utcs [Int]
xs =
  ChartOptions
forall a. Monoid a => a
mempty ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
#chartTree Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
-> ChartTree -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ [Chart] -> ChartTree
unnamed [Chart
c] ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
#hudOptions Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
-> HudOptions -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ HudOptions
hudOptions
  where
    xaxis :: [AxisOptions]
xaxis = Optic' A_Lens NoIx DigitChartStyle (Maybe UtcAxisStyle)
-> DigitChartStyle -> Maybe UtcAxisStyle
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx DigitChartStyle (Maybe UtcAxisStyle)
#utcAxisStyle DigitChartStyle
s Maybe UtcAxisStyle
-> (Maybe UtcAxisStyle -> Maybe AxisOptions) -> Maybe AxisOptions
forall a b. a -> (a -> b) -> b
& (UtcAxisStyle -> AxisOptions)
-> Maybe UtcAxisStyle -> Maybe AxisOptions
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\UtcAxisStyle
c -> UtcAxisStyle -> [UTCTime] -> AxisOptions
utcAxis UtcAxisStyle
c [UTCTime]
utcs) Maybe AxisOptions
-> (Maybe AxisOptions -> [AxisOptions]) -> [AxisOptions]
forall a b. a -> (a -> b) -> b
& Maybe AxisOptions -> [AxisOptions]
forall a. Maybe a -> [a]
maybeToList
    yaxis :: [AxisOptions]
yaxis = Optic' A_Lens NoIx DigitChartStyle (Maybe DecileAxisStyle)
-> DigitChartStyle -> Maybe DecileAxisStyle
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx DigitChartStyle (Maybe DecileAxisStyle)
#decileAxisStyle DigitChartStyle
s Maybe DecileAxisStyle
-> (Maybe DecileAxisStyle -> Maybe AxisOptions)
-> Maybe AxisOptions
forall a b. a -> (a -> b) -> b
& (DecileAxisStyle -> AxisOptions)
-> Maybe DecileAxisStyle -> Maybe AxisOptions
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DecileAxisStyle -> AxisOptions
decileAxis Maybe AxisOptions
-> (Maybe AxisOptions -> [AxisOptions]) -> [AxisOptions]
forall a b. a -> (a -> b) -> b
& Maybe AxisOptions -> [AxisOptions]
forall a. Maybe a -> [a]
maybeToList
    hudOptions :: HudOptions
hudOptions =
      HudOptions
defaultHudOptions
        HudOptions -> (HudOptions -> HudOptions) -> HudOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority AxisOptions]
  [Priority AxisOptions]
-> [Priority 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
set Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority AxisOptions]
  [Priority AxisOptions]
#axes ((AxisOptions -> Priority AxisOptions)
-> [AxisOptions] -> [Priority AxisOptions]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Double -> AxisOptions -> Priority AxisOptions
forall a. Double -> a -> Priority a
Priority Double
5) ([AxisOptions]
xaxis [AxisOptions] -> [AxisOptions] -> [AxisOptions]
forall a. Semigroup a => a -> a -> a
<> [AxisOptions]
yaxis))
    c :: Chart
c = Style -> [Point Double] -> Chart
GlyphChart (Optic' A_Lens NoIx DigitChartStyle Style
-> DigitChartStyle -> Style
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx DigitChartStyle Style
#glyphStyle DigitChartStyle
s) ([Double] -> [Point Double]
xify (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Double) -> [Int] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int]
xs))

-- | Style of a UTC line chart.
data UtcLineChartStyle = UtcLineChartStyle
  { UtcLineChartStyle -> Style
lineStyle :: Style,
    UtcLineChartStyle -> Maybe UtcAxisStyle
utcAxisStyle :: Maybe UtcAxisStyle,
    UtcLineChartStyle -> Maybe AxisOptions
yAxisStyle :: Maybe AxisOptions,
    UtcLineChartStyle -> Maybe LegendOptions
legendStyle :: Maybe LegendOptions
  }
  deriving ((forall x. UtcLineChartStyle -> Rep UtcLineChartStyle x)
-> (forall x. Rep UtcLineChartStyle x -> UtcLineChartStyle)
-> Generic UtcLineChartStyle
forall x. Rep UtcLineChartStyle x -> UtcLineChartStyle
forall x. UtcLineChartStyle -> Rep UtcLineChartStyle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UtcLineChartStyle -> Rep UtcLineChartStyle x
from :: forall x. UtcLineChartStyle -> Rep UtcLineChartStyle x
$cto :: forall x. Rep UtcLineChartStyle x -> UtcLineChartStyle
to :: forall x. Rep UtcLineChartStyle x -> UtcLineChartStyle
Generic)

-- | Default style of a UTC line chart.
defaultUtcLineChartStyle :: UtcLineChartStyle
defaultUtcLineChartStyle :: UtcLineChartStyle
defaultUtcLineChartStyle = Style
-> Maybe UtcAxisStyle
-> Maybe AxisOptions
-> Maybe LegendOptions
-> UtcLineChartStyle
UtcLineChartStyle (Style
defaultLineStyle Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Double Double
-> Double -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Double Double
#size Double
0.005) (UtcAxisStyle -> Maybe UtcAxisStyle
forall a. a -> Maybe a
Just UtcAxisStyle
defaultUtcAxisStyle) (AxisOptions -> Maybe AxisOptions
forall a. a -> Maybe a
Just (AxisOptions -> Maybe AxisOptions)
-> AxisOptions -> Maybe AxisOptions
forall a b. (a -> b) -> a -> b
$ AxisOptions
defaultYAxisOptions AxisOptions -> (AxisOptions -> AxisOptions) -> AxisOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx AxisOptions AxisOptions Place Place
-> Place -> AxisOptions -> AxisOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx AxisOptions AxisOptions Place Place
#place Place
PlaceLeft AxisOptions -> (AxisOptions -> AxisOptions) -> AxisOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx AxisOptions AxisOptions Tick Tick
-> Tick -> AxisOptions -> AxisOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
#ticks Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
-> Optic A_Lens NoIx Ticks Ticks Tick Tick
-> Optic A_Lens NoIx AxisOptions AxisOptions Tick Tick
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
% Optic A_Lens NoIx Ticks Ticks Tick Tick
#tick) (FormatN -> Int -> TickExtend -> Tick
TickRound (FStyle -> Maybe Int -> Int -> Bool -> Bool -> FormatN
FormatN FStyle
FSPercent (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
2) Int
4 Bool
True Bool
True) Int
6 TickExtend
TickExtend)) (LegendOptions -> Maybe LegendOptions
forall a. a -> Maybe a
Just (LegendOptions
defaultLegendOptions LegendOptions -> (LegendOptions -> LegendOptions) -> LegendOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx LegendOptions LegendOptions Place Place
-> Place -> LegendOptions -> LegendOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx LegendOptions LegendOptions Place Place
#place Place
PlaceBottom LegendOptions -> (LegendOptions -> LegendOptions) -> LegendOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens NoIx LegendOptions LegendOptions (Maybe Style) (Maybe Style)
-> Maybe Style -> LegendOptions -> LegendOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic
  A_Lens NoIx LegendOptions LegendOptions (Maybe Style) (Maybe Style)
#frame (Style -> Maybe Style
forall a. a -> Maybe a
Just (Style -> Maybe Style) -> Style -> Maybe Style
forall a b. (a -> b) -> a -> b
$ Double -> Colour -> Style
border Double
0.01 Colour
light) LegendOptions -> (LegendOptions -> LegendOptions) -> LegendOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx LegendOptions LegendOptions Double Double
-> Double -> LegendOptions -> LegendOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic A_Lens NoIx LegendOptions LegendOptions Style Style
#textStyle Optic A_Lens NoIx LegendOptions LegendOptions Style Style
-> Optic A_Lens NoIx Style Style Double Double
-> Optic A_Lens NoIx LegendOptions LegendOptions Double 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
% Optic A_Lens NoIx Style Style Double Double
#size) Double
0.2 LegendOptions -> (LegendOptions -> LegendOptions) -> LegendOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens
  NoIx
  LegendOptions
  LegendOptions
  HudChartSection
  HudChartSection
-> HudChartSection -> LegendOptions -> LegendOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic
  A_Lens
  NoIx
  LegendOptions
  LegendOptions
  HudChartSection
  HudChartSection
#anchorTo HudChartSection
HudStyleSection))

-- | Line chart for a UTC time series.
utcLineChart :: UtcLineChartStyle -> [Text] -> [(UTCTime, [Double])] -> ChartOptions
utcLineChart :: UtcLineChartStyle
-> [Text] -> [(UTCTime, [Double])] -> ChartOptions
utcLineChart UtcLineChartStyle
s [Text]
labels [(UTCTime, [Double])]
xs = ChartOptions
forall a. Monoid a => a
mempty ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
#chartTree Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
-> ChartTree -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Text -> [Chart] -> ChartTree
named Text
"day" [Chart]
cs ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
#hudOptions Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
-> HudOptions -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ HudOptions
h
  where
    cs :: [Chart]
cs = (Colour -> [Double] -> Chart) -> [Colour] -> [[Double]] -> [Chart]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Colour
c [Double]
xs' -> Style -> [[Point Double]] -> Chart
LineChart (Optic' A_Lens NoIx UtcLineChartStyle Style
-> UtcLineChartStyle -> Style
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx UtcLineChartStyle Style
#lineStyle UtcLineChartStyle
s Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Colour Colour
-> Colour -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style Colour Colour
#color Colour
c) [[Double] -> [Point Double]
xify [Double]
xs']) ((\Int
x -> Int -> Double -> Colour
paletteO Int
x Double
0.7) (Int -> Colour) -> [Int] -> [Colour]
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]) ([[Double]] -> [[Double]]
forall a. [[a]] -> [[a]]
List.transpose ([[Double]] -> [[Double]]) -> [[Double]] -> [[Double]]
forall a b. (a -> b) -> a -> b
$ (UTCTime, [Double]) -> [Double]
forall a b. (a, b) -> b
snd ((UTCTime, [Double]) -> [Double])
-> [(UTCTime, [Double])] -> [[Double]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(UTCTime, [Double])]
xs)
    xaxis :: [AxisOptions]
xaxis = Optic' A_Lens NoIx UtcLineChartStyle (Maybe UtcAxisStyle)
-> UtcLineChartStyle -> Maybe UtcAxisStyle
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx UtcLineChartStyle (Maybe UtcAxisStyle)
#utcAxisStyle UtcLineChartStyle
s Maybe UtcAxisStyle
-> (Maybe UtcAxisStyle -> Maybe AxisOptions) -> Maybe AxisOptions
forall a b. a -> (a -> b) -> b
& (UtcAxisStyle -> AxisOptions)
-> Maybe UtcAxisStyle -> Maybe AxisOptions
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\UtcAxisStyle
c -> UtcAxisStyle -> [UTCTime] -> AxisOptions
utcAxis UtcAxisStyle
c (((UTCTime, [Double]) -> UTCTime)
-> [(UTCTime, [Double])] -> [UTCTime]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (UTCTime, [Double]) -> UTCTime
forall a b. (a, b) -> a
fst [(UTCTime, [Double])]
xs)) Maybe AxisOptions
-> (Maybe AxisOptions -> [AxisOptions]) -> [AxisOptions]
forall a b. a -> (a -> b) -> b
& Maybe AxisOptions -> [AxisOptions]
forall a. Maybe a -> [a]
maybeToList
    yaxis :: [AxisOptions]
yaxis = Optic' A_Lens NoIx UtcLineChartStyle (Maybe AxisOptions)
-> UtcLineChartStyle -> Maybe AxisOptions
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx UtcLineChartStyle (Maybe AxisOptions)
#yAxisStyle UtcLineChartStyle
s Maybe AxisOptions
-> (Maybe AxisOptions -> [AxisOptions]) -> [AxisOptions]
forall a b. a -> (a -> b) -> b
& Maybe AxisOptions -> [AxisOptions]
forall a. Maybe a -> [a]
maybeToList
    leg :: [Priority LegendOptions]
leg = Optic' A_Lens NoIx UtcLineChartStyle (Maybe LegendOptions)
-> UtcLineChartStyle -> Maybe LegendOptions
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx UtcLineChartStyle (Maybe LegendOptions)
#legendStyle UtcLineChartStyle
s Maybe LegendOptions
-> (Maybe LegendOptions -> Maybe (Priority LegendOptions))
-> Maybe (Priority LegendOptions)
forall a b. a -> (a -> b) -> b
& (LegendOptions -> Priority LegendOptions)
-> Maybe LegendOptions -> Maybe (Priority LegendOptions)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (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
set Optic
  A_Lens
  NoIx
  LegendOptions
  LegendOptions
  [(Text, [Chart])]
  [(Text, [Chart])]
#legendCharts ((Text -> Chart -> (Text, [Chart]))
-> [Text] -> [Chart] -> [(Text, [Chart])]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Text
t Chart
c -> (Text
t, [Chart
c])) [Text]
labels [Chart]
cs) (LegendOptions -> LegendOptions)
-> (LegendOptions -> Priority LegendOptions)
-> LegendOptions
-> Priority LegendOptions
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Double -> LegendOptions -> Priority LegendOptions
forall a. Double -> a -> Priority a
Priority Double
12) Maybe (Priority LegendOptions)
-> (Maybe (Priority LegendOptions) -> [Priority LegendOptions])
-> [Priority LegendOptions]
forall a b. a -> (a -> b) -> b
& Maybe (Priority LegendOptions) -> [Priority LegendOptions]
forall a. Maybe a -> [a]
maybeToList
    h :: HudOptions
h = HudOptions
defaultHudOptions HudOptions -> (HudOptions -> HudOptions) -> HudOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority AxisOptions]
  [Priority AxisOptions]
-> [Priority 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
set Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority AxisOptions]
  [Priority AxisOptions]
#axes ((AxisOptions -> Priority AxisOptions)
-> [AxisOptions] -> [Priority AxisOptions]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Double -> AxisOptions -> Priority AxisOptions
forall a. Double -> a -> Priority a
Priority Double
5) ([AxisOptions]
xaxis [AxisOptions] -> [AxisOptions] -> [AxisOptions]
forall a. Semigroup a => a -> a -> a
<> [AxisOptions]
yaxis)) HudOptions -> (HudOptions -> HudOptions) -> HudOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority LegendOptions]
  [Priority LegendOptions]
-> [Priority 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
set Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority LegendOptions]
  [Priority LegendOptions]
#legends [Priority LegendOptions]
leg

-- | Chart template for quantiles.
quantileChart ::
  [Text] ->
  [Style] ->
  [[Double]] ->
  ChartOptions
quantileChart :: [Text] -> [Style] -> [[Double]] -> ChartOptions
quantileChart [Text]
names [Style]
ls [[Double]]
xs = ChartOptions
forall a. Monoid a => a
mempty ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
#hudOptions Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
-> HudOptions -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ HudOptions
h ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
#chartTree Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
-> ChartTree -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ [Chart] -> ChartTree
unnamed [Chart]
c
  where
    h :: HudOptions
h =
      HudOptions
defaultHudOptions
        HudOptions -> (HudOptions -> HudOptions) -> HudOptions
forall a b. a -> (a -> b) -> b
& ( Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority LegendOptions]
  [Priority LegendOptions]
#legends
              Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority LegendOptions]
  [Priority LegendOptions]
-> [Priority 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 -> LegendOptions -> Priority LegendOptions
forall a. Double -> a -> Priority a
Priority Double
10 (LegendOptions -> Priority LegendOptions)
-> LegendOptions -> Priority LegendOptions
forall a b. (a -> b) -> a -> b
$
                     LegendOptions
defaultLegendOptions
                       LegendOptions -> (LegendOptions -> LegendOptions) -> LegendOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx LegendOptions LegendOptions Style Style
#textStyle
                       Optic A_Lens NoIx LegendOptions LegendOptions Style Style
-> Optic A_Lens NoIx Style Style Double Double
-> Optic A_Lens NoIx LegendOptions LegendOptions Double 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
% Optic A_Lens NoIx Style Style Double Double
#size
                       Optic A_Lens NoIx LegendOptions LegendOptions Double Double
-> Double -> LegendOptions -> LegendOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Double
0.1
                       LegendOptions -> (LegendOptions -> LegendOptions) -> LegendOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx LegendOptions LegendOptions Double Double
#vgap
                       Optic A_Lens NoIx LegendOptions LegendOptions Double Double
-> Double -> LegendOptions -> LegendOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Double
0.05
                       LegendOptions -> (LegendOptions -> LegendOptions) -> LegendOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx LegendOptions LegendOptions Double Double
#innerPad
                       Optic A_Lens NoIx LegendOptions LegendOptions Double Double
-> Double -> LegendOptions -> LegendOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Double
0.2
                       LegendOptions -> (LegendOptions -> LegendOptions) -> LegendOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx LegendOptions LegendOptions Place Place
#place
                       Optic A_Lens NoIx LegendOptions LegendOptions Place Place
-> Place -> LegendOptions -> LegendOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Place
PlaceRight
                       LegendOptions -> (LegendOptions -> LegendOptions) -> LegendOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens
  NoIx
  LegendOptions
  LegendOptions
  [(Text, [Chart])]
  [(Text, [Chart])]
#legendCharts
                       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
.~ [Text] -> [[Chart]] -> [(Text, [Chart])]
forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
names ((Chart -> [Chart] -> [Chart]
forall a. a -> [a] -> [a]
: []) (Chart -> [Chart]) -> [Chart] -> [[Chart]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Chart]
c)
                 ]
          )
    c :: [Chart]
c =
      (Style -> [Point Double] -> Chart)
-> [Style] -> [[Point Double]] -> [Chart]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
        (\Style
l [Point Double]
x -> Style -> [[Point Double]] -> Chart
LineChart Style
l [[Point Double]
x])
        [Style]
ls
        ((Double -> Double -> Point Double)
-> [Double] -> [Double] -> [Point Double]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Double -> Double -> Point Double
forall a. a -> a -> Point a
Point [Double
0 ..] ([Double] -> [Point Double]) -> [[Double]] -> [[Point Double]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Double]]
xs)

-- | convert from [a] to [Point a], by adding the index as the x axis
--
-- >>> xify [1..3]
-- [Point 0.0 1.0,Point 1.0 2.0,Point 2.0 3.0]
xify :: [Double] -> [Point Double]
xify :: [Double] -> [Point Double]
xify [Double]
ys =
  (Double -> Double -> Point Double)
-> [Double] -> [Double] -> [Point Double]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Double -> Double -> Point Double
forall a. a -> a -> Point a
Point [Double
0 ..] [Double]
ys

-- | convert from [a] to [Point a], by adding the index as the y axis
--
-- >>> yify [1..3]
-- [Point 1.0 0.0,Point 2.0 1.0,Point 3.0 2.0]
yify :: [Double] -> [Point Double]
yify :: [Double] -> [Point Double]
yify [Double]
xs =
  (Double -> Double -> Point Double)
-> [Double] -> [Double] -> [Point Double]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Double -> Double -> Point Double
forall a. a -> a -> Point a
Point [Double]
xs [Double
0 ..]

-- | interpret a [Double] as a line with x coordinates of [0..]
simpleLineChart :: Double -> Colour -> [Double] -> Chart
simpleLineChart :: Double -> Colour -> [Double] -> Chart
simpleLineChart Double
w Colour
c [Double]
xs =
  Style -> [[Point Double]] -> Chart
LineChart
    (Style
defaultLineStyle Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Colour Colour
#color Optic A_Lens NoIx Style Style Colour Colour
-> Colour -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Colour
c Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Double Double
#size Optic A_Lens NoIx Style Style Double Double
-> Double -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Double
w)
    [[Double] -> [Point Double]
xify [Double]
xs]

-- | interpret a [Double] as a scatter chart with x coordinates of [0..]
simpleScatterChart :: Double -> Colour -> [Double] -> Chart
simpleScatterChart :: Double -> Colour -> [Double] -> Chart
simpleScatterChart Double
w Colour
c [Double]
xs =
  Style -> [Point Double] -> Chart
GlyphChart
    (Style
defaultGlyphStyle Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Colour Colour
#color Optic A_Lens NoIx Style Style Colour Colour
-> Colour -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Colour
c Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Double Double
#size Optic A_Lens NoIx Style Style Double Double
-> Double -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Double
w)
    ([Double] -> [Point Double]
xify [Double]
xs)

-- | common pattern of chart title, x-axis title and y-axis title
titles3 :: Double -> (Text, Text, Text) -> [Priority TitleOptions]
titles3 :: Double -> (Text, Text, Text) -> [Priority TitleOptions]
titles3 Double
p (Text
t, Text
x, Text
y) =
  [ Double -> TitleOptions -> Priority TitleOptions
forall a. Double -> a -> Priority a
Priority Double
p (Text -> TitleOptions
defaultTitleOptions Text
t TitleOptions -> (TitleOptions -> TitleOptions) -> TitleOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx TitleOptions TitleOptions Style Style
#style Optic A_Lens NoIx TitleOptions TitleOptions Style Style
-> Optic A_Lens NoIx Style Style Double Double
-> Optic A_Lens NoIx TitleOptions TitleOptions Double 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
% Optic A_Lens NoIx Style Style Double Double
#size Optic A_Lens NoIx TitleOptions TitleOptions Double Double
-> Double -> TitleOptions -> TitleOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Double
0.08),
    Double -> TitleOptions -> Priority TitleOptions
forall a. Double -> a -> Priority a
Priority Double
p (Text -> TitleOptions
defaultTitleOptions Text
x TitleOptions -> (TitleOptions -> TitleOptions) -> TitleOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx TitleOptions TitleOptions Place Place
#place Optic A_Lens NoIx TitleOptions TitleOptions Place Place
-> Place -> TitleOptions -> TitleOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Place
PlaceBottom TitleOptions -> (TitleOptions -> TitleOptions) -> TitleOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx TitleOptions TitleOptions Style Style
#style Optic A_Lens NoIx TitleOptions TitleOptions Style Style
-> Optic A_Lens NoIx Style Style Double Double
-> Optic A_Lens NoIx TitleOptions TitleOptions Double 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
% Optic A_Lens NoIx Style Style Double Double
#size Optic A_Lens NoIx TitleOptions TitleOptions Double Double
-> Double -> TitleOptions -> TitleOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Double
0.05),
    Double -> TitleOptions -> Priority TitleOptions
forall a. Double -> a -> Priority a
Priority Double
p (Text -> TitleOptions
defaultTitleOptions Text
y TitleOptions -> (TitleOptions -> TitleOptions) -> TitleOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx TitleOptions TitleOptions Place Place
#place Optic A_Lens NoIx TitleOptions TitleOptions Place Place
-> Place -> TitleOptions -> TitleOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Place
PlaceLeft TitleOptions -> (TitleOptions -> TitleOptions) -> TitleOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx TitleOptions TitleOptions Style Style
#style Optic A_Lens NoIx TitleOptions TitleOptions Style Style
-> Optic A_Lens NoIx Style Style Double Double
-> Optic A_Lens NoIx TitleOptions TitleOptions Double 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
% Optic A_Lens NoIx Style Style Double Double
#size Optic A_Lens NoIx TitleOptions TitleOptions Double Double
-> Double -> TitleOptions -> TitleOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Double
0.05)
  ]

-- | countChart style
data CountChartStyle = CountChartStyle
  { CountChartStyle -> Maybe Text
title :: Maybe Text,
    CountChartStyle -> Colour
titleColour :: Colour,
    CountChartStyle -> Maybe LegendOptions
legendStyle :: Maybe LegendOptions
  }
  deriving ((forall x. CountChartStyle -> Rep CountChartStyle x)
-> (forall x. Rep CountChartStyle x -> CountChartStyle)
-> Generic CountChartStyle
forall x. Rep CountChartStyle x -> CountChartStyle
forall x. CountChartStyle -> Rep CountChartStyle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CountChartStyle -> Rep CountChartStyle x
from :: forall x. CountChartStyle -> Rep CountChartStyle x
$cto :: forall x. Rep CountChartStyle x -> CountChartStyle
to :: forall x. Rep CountChartStyle x -> CountChartStyle
Generic)

-- | Default CountChart style
defaultCountChartStyle :: CountChartStyle
defaultCountChartStyle :: CountChartStyle
defaultCountChartStyle = Maybe Text -> Colour -> Maybe LegendOptions -> CountChartStyle
CountChartStyle (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"count") (Int -> Double -> Colour
paletteO Int
10 Double
0.7) (LegendOptions -> Maybe LegendOptions
forall a. a -> Maybe a
Just (LegendOptions
defaultLegendOptions LegendOptions -> (LegendOptions -> LegendOptions) -> LegendOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx LegendOptions LegendOptions Place Place
-> Place -> LegendOptions -> LegendOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx LegendOptions LegendOptions Place Place
#place Place
PlaceRight LegendOptions -> (LegendOptions -> LegendOptions) -> LegendOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens NoIx LegendOptions LegendOptions (Maybe Style) (Maybe Style)
-> Maybe Style -> LegendOptions -> LegendOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic
  A_Lens NoIx LegendOptions LegendOptions (Maybe Style) (Maybe Style)
#frame (Style -> Maybe Style
forall a. a -> Maybe a
Just (Style -> Maybe Style) -> Style -> Maybe Style
forall a b. (a -> b) -> a -> b
$ Double -> Colour -> Style
border Double
0.01 Colour
light) LegendOptions -> (LegendOptions -> LegendOptions) -> LegendOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx LegendOptions LegendOptions Double Double
-> Double -> LegendOptions -> LegendOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic A_Lens NoIx LegendOptions LegendOptions Style Style
#textStyle Optic A_Lens NoIx LegendOptions LegendOptions Style Style
-> Optic A_Lens NoIx Style Style Double Double
-> Optic A_Lens NoIx LegendOptions LegendOptions Double 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
% Optic A_Lens NoIx Style Style Double Double
#size) Double
0.2 LegendOptions -> (LegendOptions -> LegendOptions) -> LegendOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens
  NoIx
  LegendOptions
  LegendOptions
  HudChartSection
  HudChartSection
-> HudChartSection -> LegendOptions -> LegendOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic
  A_Lens
  NoIx
  LegendOptions
  LegendOptions
  HudChartSection
  HudChartSection
#anchorTo HudChartSection
HudStyleSection))

-- | Count chart
countChart :: CountChartStyle -> [Text] -> [Int] -> ChartOptions
countChart :: CountChartStyle -> [Text] -> [Int] -> ChartOptions
countChart CountChartStyle
s [Text]
ls [Int]
cs =
  BarOptions -> BarData -> ChartOptions
barChart BarOptions
defaultBarOptions ([[Double]] -> [Text] -> [Text] -> BarData
BarData ([[Double]] -> [[Double]]
forall a. [[a]] -> [[a]]
List.transpose [Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Double) -> [Int] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int]
cs]) [] [Text]
ls) ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens
  NoIx
  ChartOptions
  ChartOptions
  [Priority AxisOptions]
  [Priority AxisOptions]
-> [Priority AxisOptions] -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
#hudOptions Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
-> Optic
     A_Lens
     NoIx
     HudOptions
     HudOptions
     [Priority AxisOptions]
     [Priority AxisOptions]
-> Optic
     A_Lens
     NoIx
     ChartOptions
     ChartOptions
     [Priority AxisOptions]
     [Priority AxisOptions]
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
% Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority AxisOptions]
  [Priority AxisOptions]
#axes) [] ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Traversal (Int : NoIx) ChartOptions ChartOptions Double Double
-> Double -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
#chartTree Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
-> Optic A_Traversal NoIx ChartTree ChartTree [Chart] [Chart]
-> Optic A_Traversal NoIx ChartOptions ChartOptions [Chart] [Chart]
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
% Optic A_Traversal NoIx ChartTree ChartTree [Chart] [Chart]
charts' Optic A_Traversal NoIx ChartOptions ChartOptions [Chart] [Chart]
-> Optic A_Traversal (Int : NoIx) [Chart] [Chart] Chart Chart
-> Optic
     A_Traversal (Int : NoIx) ChartOptions ChartOptions Chart Chart
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
% Optic A_Traversal (Int : NoIx) [Chart] [Chart] Chart Chart
forall i s t a b. Each i s t a b => IxTraversal i s t a b
each Optic
  A_Traversal (Int : NoIx) ChartOptions ChartOptions Chart Chart
-> Optic A_Lens NoIx Chart Chart Style Style
-> Optic
     A_Traversal (Int : NoIx) ChartOptions ChartOptions Style Style
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
% Optic A_Lens NoIx Chart Chart Style Style
#chartStyle Optic
  A_Traversal (Int : NoIx) ChartOptions ChartOptions Style Style
-> Optic A_Lens NoIx Style Style Double Double
-> Optic
     A_Traversal (Int : NoIx) ChartOptions ChartOptions Double 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
% Optic A_Lens NoIx Style Style Double Double
#borderSize) Double
0 ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic An_AffineTraversal NoIx ChartOptions ChartOptions Place Place
-> Place -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
#hudOptions Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
-> Optic
     A_Lens
     NoIx
     HudOptions
     HudOptions
     [Priority LegendOptions]
     [Priority LegendOptions]
-> Optic
     A_Lens
     NoIx
     ChartOptions
     ChartOptions
     [Priority LegendOptions]
     [Priority LegendOptions]
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
% Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority LegendOptions]
  [Priority LegendOptions]
#legends Optic
  A_Lens
  NoIx
  ChartOptions
  ChartOptions
  [Priority LegendOptions]
  [Priority LegendOptions]
-> Optic
     (IxKind [Priority LegendOptions])
     NoIx
     [Priority LegendOptions]
     [Priority LegendOptions]
     (IxValue [Priority LegendOptions])
     (IxValue [Priority LegendOptions])
-> Optic
     An_AffineTraversal
     NoIx
     ChartOptions
     ChartOptions
     (IxValue [Priority LegendOptions])
     (IxValue [Priority LegendOptions])
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
% Index [Priority LegendOptions]
-> Optic
     (IxKind [Priority LegendOptions])
     NoIx
     [Priority LegendOptions]
     [Priority LegendOptions]
     (IxValue [Priority LegendOptions])
     (IxValue [Priority LegendOptions])
forall m. Ixed m => Index m -> Optic' (IxKind m) NoIx m (IxValue m)
ix Index [Priority LegendOptions]
0 Optic
  An_AffineTraversal
  NoIx
  ChartOptions
  ChartOptions
  (IxValue [Priority LegendOptions])
  (IxValue [Priority LegendOptions])
-> Optic
     A_Lens
     NoIx
     (IxValue [Priority LegendOptions])
     (IxValue [Priority LegendOptions])
     LegendOptions
     LegendOptions
-> Optic
     An_AffineTraversal
     NoIx
     ChartOptions
     ChartOptions
     LegendOptions
     LegendOptions
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
% Optic
  A_Lens
  NoIx
  (IxValue [Priority LegendOptions])
  (IxValue [Priority LegendOptions])
  LegendOptions
  LegendOptions
#item Optic
  An_AffineTraversal
  NoIx
  ChartOptions
  ChartOptions
  LegendOptions
  LegendOptions
-> Optic A_Lens NoIx LegendOptions LegendOptions Place Place
-> Optic
     An_AffineTraversal NoIx ChartOptions ChartOptions Place Place
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
% Optic A_Lens NoIx LegendOptions LegendOptions Place Place
#place) Place
PlaceRight ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens
  NoIx
  ChartOptions
  ChartOptions
  [Priority TitleOptions]
  [Priority TitleOptions]
-> [Priority TitleOptions] -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
#hudOptions Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
-> Optic
     A_Lens
     NoIx
     HudOptions
     HudOptions
     [Priority TitleOptions]
     [Priority TitleOptions]
-> Optic
     A_Lens
     NoIx
     ChartOptions
     ChartOptions
     [Priority TitleOptions]
     [Priority TitleOptions]
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
% Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority TitleOptions]
  [Priority TitleOptions]
#titles) (Maybe (Priority TitleOptions) -> [Priority TitleOptions]
forall a. Maybe a -> [a]
maybeToList (Maybe (Priority TitleOptions) -> [Priority TitleOptions])
-> Maybe (Priority TitleOptions) -> [Priority TitleOptions]
forall a b. (a -> b) -> a -> b
$ (Text -> Priority TitleOptions)
-> Maybe Text -> Maybe (Priority TitleOptions)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Text
t -> Double -> TitleOptions -> Priority TitleOptions
forall a. Double -> a -> Priority a
Priority Double
5 (Text -> TitleOptions
defaultTitleOptions Text
t TitleOptions -> (TitleOptions -> TitleOptions) -> TitleOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx TitleOptions TitleOptions Double Double
-> Double -> TitleOptions -> TitleOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic A_Lens NoIx TitleOptions TitleOptions Style Style
#style Optic A_Lens NoIx TitleOptions TitleOptions Style Style
-> Optic A_Lens NoIx Style Style Double Double
-> Optic A_Lens NoIx TitleOptions TitleOptions Double 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
% Optic A_Lens NoIx Style Style Double Double
#size) Double
0.06 TitleOptions -> (TitleOptions -> TitleOptions) -> TitleOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx TitleOptions TitleOptions Double Double
-> Double -> TitleOptions -> TitleOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx TitleOptions TitleOptions Double Double
#anchoring (-Double
0.5) TitleOptions -> (TitleOptions -> TitleOptions) -> TitleOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx TitleOptions TitleOptions Colour Colour
-> Colour -> TitleOptions -> TitleOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (Optic A_Lens NoIx TitleOptions TitleOptions Style Style
#style Optic A_Lens NoIx TitleOptions TitleOptions Style Style
-> Optic A_Lens NoIx Style Style Colour Colour
-> Optic A_Lens NoIx TitleOptions TitleOptions Colour Colour
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
% Optic A_Lens NoIx Style Style Colour Colour
#color) (Optic' A_Lens NoIx CountChartStyle Colour
-> CountChartStyle -> Colour
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx CountChartStyle Colour
#titleColour CountChartStyle
s))) (Optic' A_Lens NoIx CountChartStyle (Maybe Text)
-> CountChartStyle -> Maybe Text
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx CountChartStyle (Maybe Text)
#title CountChartStyle
s))

-- | Simple Rect chart
simpleRectChart ::
  [Double] ->
  Style ->
  ChartOptions
simpleRectChart :: [Double] -> Style -> ChartOptions
simpleRectChart [Double]
xs Style
s =
  ChartOptions
forall a. Monoid a => a
mempty
    ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
-> ChartTree -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set
      #chartTree
      (Text -> [Chart] -> ChartTree
named Text
"simpleRectChart" [Style -> [ChartBox] -> Chart
RectChart Style
s [ChartBox]
rects])
    ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens
  NoIx
  ChartOptions
  ChartOptions
  [Priority AxisOptions]
  [Priority AxisOptions]
-> [Priority AxisOptions] -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set
      (Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
#hudOptions Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
-> Optic
     A_Lens
     NoIx
     HudOptions
     HudOptions
     [Priority AxisOptions]
     [Priority AxisOptions]
-> Optic
     A_Lens
     NoIx
     ChartOptions
     ChartOptions
     [Priority AxisOptions]
     [Priority AxisOptions]
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
% Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority AxisOptions]
  [Priority AxisOptions]
#axes)
      [Double -> AxisOptions -> Priority AxisOptions
forall a. Double -> a -> Priority a
Priority Double
5 (AxisOptions
defaultYAxisOptions AxisOptions -> (AxisOptions -> AxisOptions) -> AxisOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
#ticks Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
-> Optic
     A_Lens NoIx Ticks Ticks (Maybe TickStyle) (Maybe TickStyle)
-> Optic
     A_Lens
     NoIx
     AxisOptions
     AxisOptions
     (Maybe TickStyle)
     (Maybe 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
% Optic A_Lens NoIx Ticks Ticks (Maybe TickStyle) (Maybe TickStyle)
#lineTick Optic
  A_Lens
  NoIx
  AxisOptions
  AxisOptions
  (Maybe TickStyle)
  (Maybe TickStyle)
-> Maybe 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
.~ Maybe TickStyle
forall a. Maybe a
Nothing AxisOptions -> (AxisOptions -> AxisOptions) -> AxisOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
#ticks Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
-> Optic A_Lens NoIx Ticks Ticks Tick Tick
-> Optic A_Lens NoIx AxisOptions AxisOptions Tick Tick
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
% Optic A_Lens NoIx Ticks Ticks Tick Tick
#tick Optic A_Lens NoIx AxisOptions AxisOptions Tick Tick
-> Tick -> AxisOptions -> AxisOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ FormatN -> Int -> TickExtend -> Tick
TickRound (FStyle -> Maybe Int -> Int -> Bool -> Bool -> FormatN
FormatN FStyle
FSCommaPrec (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
2) Int
4 Bool
True Bool
True) Int
5 TickExtend
NoTickExtend)]
  where
    rects :: [ChartBox]
rects = (Double -> Double -> ChartBox)
-> [Double] -> [Double] -> [ChartBox]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Double
x Double
i -> Double -> Double -> Double -> Double -> ChartBox
forall a. a -> a -> a -> a -> Rect a
Rect Double
i (Double
i Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
1) (Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
0 Double
x) (Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
0 Double
x)) [Double]
xs [Double
0 ..]

-- | histogram chart
histChart ::
  Range Double ->
  Int ->
  [Double] ->
  ChartOptions
histChart :: Range Double -> Int -> [Double] -> ChartOptions
histChart Range Double
r Int
g [Double]
xs =
  ChartOptions
forall a. Monoid a => a
mempty
    ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
#chartTree
    Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
-> ChartTree -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Text -> [Chart] -> ChartTree
named Text
"histogram" [Style -> [ChartBox] -> Chart
RectChart Style
defaultRectStyle [ChartBox]
rects]
    ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
#hudOptions
    Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
-> Optic
     A_Lens
     NoIx
     HudOptions
     HudOptions
     [Priority AxisOptions]
     [Priority AxisOptions]
-> Optic
     A_Lens
     NoIx
     ChartOptions
     ChartOptions
     [Priority AxisOptions]
     [Priority AxisOptions]
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
% Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority AxisOptions]
  [Priority AxisOptions]
#axes
    Optic
  A_Lens
  NoIx
  ChartOptions
  ChartOptions
  [Priority AxisOptions]
  [Priority AxisOptions]
-> [Priority AxisOptions] -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ [Double -> AxisOptions -> Priority AxisOptions
forall a. Double -> a -> Priority a
Priority Double
5 (AxisOptions
defaultXAxisOptions AxisOptions -> (AxisOptions -> AxisOptions) -> AxisOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
#ticks Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
-> Optic
     A_Lens NoIx Ticks Ticks (Maybe TickStyle) (Maybe TickStyle)
-> Optic
     A_Lens
     NoIx
     AxisOptions
     AxisOptions
     (Maybe TickStyle)
     (Maybe 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
% Optic A_Lens NoIx Ticks Ticks (Maybe TickStyle) (Maybe TickStyle)
#lineTick Optic
  A_Lens
  NoIx
  AxisOptions
  AxisOptions
  (Maybe TickStyle)
  (Maybe TickStyle)
-> Maybe 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
.~ Maybe TickStyle
forall a. Maybe a
Nothing AxisOptions -> (AxisOptions -> AxisOptions) -> AxisOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
#ticks Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
-> Optic A_Lens NoIx Ticks Ticks Tick Tick
-> Optic A_Lens NoIx AxisOptions AxisOptions Tick Tick
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
% Optic A_Lens NoIx Ticks Ticks Tick Tick
#tick Optic A_Lens NoIx AxisOptions AxisOptions Tick Tick
-> Tick -> AxisOptions -> AxisOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ FormatN -> Int -> TickExtend -> Tick
TickRound (FStyle -> Maybe Int -> Int -> Bool -> Bool -> FormatN
FormatN FStyle
FSCommaPrec (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
2) Int
4 Bool
True Bool
True) Int
5 TickExtend
NoTickExtend)]
    ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
#hudOptions
    Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
-> Optic
     A_Lens
     NoIx
     HudOptions
     HudOptions
     [Priority FrameOptions]
     [Priority FrameOptions]
-> Optic
     A_Lens
     NoIx
     ChartOptions
     ChartOptions
     [Priority FrameOptions]
     [Priority FrameOptions]
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
% Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority FrameOptions]
  [Priority FrameOptions]
#frames
    Optic
  A_Lens
  NoIx
  ChartOptions
  ChartOptions
  [Priority FrameOptions]
  [Priority FrameOptions]
-> [Priority FrameOptions] -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ [Double -> FrameOptions -> Priority FrameOptions
forall a. Double -> a -> Priority a
Priority Double
20 (FrameOptions
defaultFrameOptions FrameOptions -> (FrameOptions -> FrameOptions) -> FrameOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx FrameOptions FrameOptions Double Double
#buffer Optic A_Lens NoIx FrameOptions FrameOptions Double Double
-> Double -> FrameOptions -> FrameOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Double
0.05)]
  where
    hcuts :: [Double]
hcuts = Pos -> Bool -> Range Double -> Int -> [Double]
gridSensible Pos
OuterPos Bool
False Range Double
r Int
g
    h :: Histogram
h = [Double] -> [Double] -> Histogram
forall (f :: * -> *).
Foldable f =>
[Double] -> f Double -> Histogram
fill [Double]
hcuts [Double]
xs
    rects :: [ChartBox]
rects =
      (ChartBox -> Bool) -> [ChartBox] -> [ChartBox]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Rect Double
_ Double
_ Double
_ Double
y') -> Double
y' Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
/= Double
0) ([ChartBox] -> [ChartBox]) -> [ChartBox] -> [ChartBox]
forall a b. (a -> b) -> a -> b
$
        DealOvers -> Histogram -> [ChartBox]
makeRects (Double -> DealOvers
IncludeOvers (Range Double -> Element (Range Double)
forall s. (Space s, Subtractive (Element s)) => s -> Element s
NumHask.Space.width Range Double
r Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
g)) Histogram
h

-- | horizontal histogram chart
hhistChart ::
  Range Double ->
  Int ->
  [Double] ->
  ChartOptions
hhistChart :: Range Double -> Int -> [Double] -> ChartOptions
hhistChart Range Double
r Int
g [Double]
xs =
  ChartOptions
forall a. Monoid a => a
mempty
    ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
-> ChartTree -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
#chartTree (Text -> [Chart] -> ChartTree
named Text
"hhistogram" [Style -> [ChartBox] -> Chart
RectChart Style
defaultRectStyle (ChartBox -> ChartBox
forall a. Rect a -> Rect a
flipAxes (ChartBox -> ChartBox) -> [ChartBox] -> [ChartBox]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ChartBox]
rects)])
  where
    hcuts :: [Double]
hcuts = Pos -> Bool -> Range Double -> Int -> [Double]
gridSensible Pos
OuterPos Bool
False Range Double
r Int
g
    h :: Histogram
h = [Double] -> [Double] -> Histogram
forall (f :: * -> *).
Foldable f =>
[Double] -> f Double -> Histogram
fill [Double]
hcuts [Double]
xs
    rects :: [ChartBox]
rects = DealOvers -> Histogram -> [ChartBox]
makeRects (Double -> DealOvers
IncludeOvers (Range Double -> Element (Range Double)
forall s. (Space s, Subtractive (Element s)) => s -> Element s
NumHask.Space.width Range Double
r Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
g)) Histogram
h

-- | horizontal histogram chart
hhistCharts ::
  Range Double ->
  Int ->
  [(Style, [Double])] ->
  ChartOptions
hhistCharts :: Range Double -> Int -> [(Style, [Double])] -> ChartOptions
hhistCharts Range Double
r Int
g [(Style, [Double])]
xs =
  ChartOptions
forall a. Monoid a => a
mempty
    ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
-> ChartTree -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
#chartTree (Text -> [Chart] -> ChartTree
named Text
"hhistogram" (([ChartBox] -> Style -> Chart)
-> [[ChartBox]] -> [Style] -> [Chart]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\[ChartBox]
r Style
s -> Style -> [ChartBox] -> Chart
RectChart Style
s (ChartBox -> ChartBox
forall a. Rect a -> Rect a
flipAxes (ChartBox -> ChartBox) -> [ChartBox] -> [ChartBox]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ChartBox]
r)) [[ChartBox]]
rects ((Style, [Double]) -> Style
forall a b. (a, b) -> a
fst ((Style, [Double]) -> Style) -> [(Style, [Double])] -> [Style]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Style, [Double])]
xs)))
  where
    hcuts :: [Double]
hcuts = Pos -> Bool -> Range Double -> Int -> [Double]
gridSensible Pos
OuterPos Bool
False Range Double
r Int
g
    hs :: [Histogram]
hs = [Double] -> [Double] -> Histogram
forall (f :: * -> *).
Foldable f =>
[Double] -> f Double -> Histogram
fill [Double]
hcuts ([Double] -> Histogram)
-> ((Style, [Double]) -> [Double])
-> (Style, [Double])
-> Histogram
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Style, [Double]) -> [Double]
forall a b. (a, b) -> b
snd ((Style, [Double]) -> Histogram)
-> [(Style, [Double])] -> [Histogram]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Style, [Double])]
xs
    rects :: [[ChartBox]]
rects = DealOvers -> Histogram -> [ChartBox]
makeRects (Double -> DealOvers
IncludeOvers (Range Double -> Element (Range Double)
forall s. (Space s, Subtractive (Element s)) => s -> Element s
NumHask.Space.width Range Double
r Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
g)) (Histogram -> [ChartBox]) -> [Histogram] -> [[ChartBox]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Histogram]
hs

-- | scatter chart
scatterChart ::
  [[Point Double]] ->
  [Chart]
scatterChart :: [[Point Double]] -> [Chart]
scatterChart [[Point Double]]
xss = ((Style, GlyphShape) -> [Point Double] -> Chart)
-> [(Style, GlyphShape)] -> [[Point Double]] -> [Chart]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\(Style
s, GlyphShape
sh) [Point Double]
ps -> Style -> [Point Double] -> Chart
GlyphChart (Style
s Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style GlyphShape GlyphShape
-> GlyphShape -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set Optic A_Lens NoIx Style Style GlyphShape GlyphShape
#glyphShape GlyphShape
sh) [Point Double]
ps) (Double -> Double -> [(Style, GlyphShape)]
gpaletteStyle Double
0.04 Double
0.01) [[Point Double]]
xss

-- | GlyphStyle palette
gpaletteStyle :: Double -> Double -> [(Style, GlyphShape)]
gpaletteStyle :: Double -> Double -> [(Style, GlyphShape)]
gpaletteStyle Double
s Double
bs = (Int -> GlyphShape -> (Style, GlyphShape))
-> [Int] -> [GlyphShape] -> [(Style, GlyphShape)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Int
c GlyphShape
g -> (Style
defaultGlyphStyle Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Double Double
#size Optic A_Lens NoIx Style Style Double Double
-> Double -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Double
s Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Colour Colour
#color Optic A_Lens NoIx Style Style Colour Colour
-> Colour -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Int -> Colour
palette Int
c Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style GlyphShape GlyphShape
#glyphShape Optic A_Lens NoIx Style Style GlyphShape GlyphShape
-> GlyphShape -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ GlyphShape
g Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Double Double
#borderSize Optic A_Lens NoIx Style Style Double Double
-> Double -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Double
bs, GlyphShape
g)) [Int
0 ..] (Int -> GlyphShape
gpalette (Int -> GlyphShape) -> [Int] -> [GlyphShape]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int
0 .. Int
8])

-- | Format quantile-style numbers
--
-- >>> quantileNames [0.01, 0.5, 0.99]
-- ["1.0%","50%","99%"]
quantileNames :: (Functor f) => f Double -> f Text
quantileNames :: forall (f :: * -> *). Functor f => f Double -> f Text
quantileNames f Double
qs = (SigFig -> Text) -> Maybe Int -> Double -> Text
percent SigFig -> Text
commaSF (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
2) (Double -> Text) -> f Double -> f Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f Double
qs

-- | @blendMidLineStyle n w@ produces n lines of width w interpolated between two colors.
blendMidLineStyles :: Int -> Double -> (Colour, Colour) -> [Style]
blendMidLineStyles :: Int -> Double -> (Colour, Colour) -> [Style]
blendMidLineStyles Int
l Double
w (Colour
c1, Colour
c2) = [Style]
lo
  where
    m :: Double
m = (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
1) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2 :: Double
    cs :: [Double]
cs = (\Int
x -> Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double -> Double
forall a. Num a => a -> a
abs (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
m) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
m) (Int -> Double) -> [Int] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int
0 .. (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)]
    bs :: [Colour]
bs = (\Double
x -> Double -> Colour -> Colour -> Colour
mix Double
x Colour
c1 Colour
c2) (Double -> Colour) -> [Double] -> [Colour]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Double]
cs
    lo :: [Style]
lo = (\Colour
c -> Style
defaultLineStyle Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Double Double
#size Optic A_Lens NoIx Style Style Double Double
-> Double -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Double
w Style -> (Style -> Style) -> Style
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx Style Style Colour Colour
#color Optic A_Lens NoIx Style Style Colour Colour
-> Colour -> Style -> Style
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Colour
c) (Colour -> Style) -> [Colour] -> [Style]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Colour]
bs

-- | A histogram based on quantile information
quantileHistChart ::
  -- | quantile names
  Maybe [Text] ->
  -- | quantiles
  [Double] ->
  -- | quantile values
  [Double] ->
  ChartOptions
quantileHistChart :: Maybe [Text] -> [Double] -> [Double] -> ChartOptions
quantileHistChart Maybe [Text]
names [Double]
qs [Double]
vs = ChartOptions
forall a. Monoid a => a
mempty ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
#chartTree Optic A_Lens NoIx ChartOptions ChartOptions ChartTree ChartTree
-> ChartTree -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ [Chart] -> ChartTree
unnamed [Chart
chart'] ChartOptions -> (ChartOptions -> ChartOptions) -> ChartOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
#hudOptions Optic A_Lens NoIx ChartOptions ChartOptions HudOptions HudOptions
-> HudOptions -> ChartOptions -> ChartOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ HudOptions
hudOptions
  where
    hudOptions :: HudOptions
hudOptions =
      HudOptions
defaultHudOptions
        HudOptions -> (HudOptions -> HudOptions) -> HudOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority AxisOptions]
  [Priority AxisOptions]
#axes
        Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority AxisOptions]
  [Priority AxisOptions]
-> [Priority 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 -> AxisOptions -> Priority AxisOptions
forall a. Double -> a -> Priority a
Priority Double
5 (AxisOptions -> Priority AxisOptions)
-> AxisOptions -> Priority AxisOptions
forall a b. (a -> b) -> a -> b
$
               AxisOptions
-> ([Text] -> AxisOptions) -> Maybe [Text] -> AxisOptions
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                 ( AxisOptions
axis0
                     AxisOptions -> (AxisOptions -> AxisOptions) -> AxisOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
#ticks
                     Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
-> Optic A_Lens NoIx Ticks Ticks Tick Tick
-> Optic A_Lens NoIx AxisOptions AxisOptions Tick Tick
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
% Optic A_Lens NoIx Ticks Ticks Tick Tick
#tick
                     Optic A_Lens NoIx AxisOptions AxisOptions Tick Tick
-> Tick -> AxisOptions -> AxisOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ FormatN -> Int -> TickExtend -> Tick
TickRound (FStyle -> Maybe Int -> Int -> Bool -> Bool -> FormatN
FormatN FStyle
FSDecimal (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
3) Int
4 Bool
True Bool
True) Int
6 TickExtend
TickExtend
                 )
                 ( \[Text]
x ->
                     AxisOptions
axis0
                       AxisOptions -> (AxisOptions -> AxisOptions) -> AxisOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
#ticks
                       Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
-> Optic A_Lens NoIx Ticks Ticks Tick Tick
-> Optic A_Lens NoIx AxisOptions AxisOptions Tick Tick
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
% Optic A_Lens NoIx Ticks Ticks Tick Tick
#tick
                       Optic A_Lens NoIx AxisOptions AxisOptions Tick Tick
-> Tick -> AxisOptions -> AxisOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ [(Double, Text)] -> Tick
TickPlaced ([Double] -> [Text] -> [(Double, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Double]
vs [Text]
x)
                 )
                 Maybe [Text]
names
           ]
    axis0 :: AxisOptions
axis0 = AxisOptions
defaultXAxisOptions AxisOptions -> (AxisOptions -> AxisOptions) -> AxisOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
#ticks Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
-> Optic
     A_Lens NoIx Ticks Ticks (Maybe TickStyle) (Maybe TickStyle)
-> Optic
     A_Lens
     NoIx
     AxisOptions
     AxisOptions
     (Maybe TickStyle)
     (Maybe 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
% Optic A_Lens NoIx Ticks Ticks (Maybe TickStyle) (Maybe TickStyle)
#lineTick Optic
  A_Lens
  NoIx
  AxisOptions
  AxisOptions
  (Maybe TickStyle)
  (Maybe TickStyle)
-> Maybe 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
.~ Maybe TickStyle
forall a. Maybe a
Nothing AxisOptions -> (AxisOptions -> AxisOptions) -> AxisOptions
forall a b. a -> (a -> b) -> b
& Optic An_AffineTraversal NoIx AxisOptions AxisOptions Double Double
-> 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
set (Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
#ticks Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
-> Optic
     A_Lens NoIx Ticks Ticks (Maybe TickStyle) (Maybe TickStyle)
-> Optic
     A_Lens
     NoIx
     AxisOptions
     AxisOptions
     (Maybe TickStyle)
     (Maybe 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
% Optic A_Lens NoIx Ticks Ticks (Maybe TickStyle) (Maybe TickStyle)
#textTick Optic
  A_Lens
  NoIx
  AxisOptions
  AxisOptions
  (Maybe TickStyle)
  (Maybe TickStyle)
-> Optic A_Lens NoIx TickStyle TickStyle Style Style
-> Optic
     An_AffineTraversal NoIx AxisOptions AxisOptions Style Style
forall (is :: IxList) (js :: IxList) (ks :: IxList) k k' l m s t u
       v a b.
(AppendIndices is js ks, JoinKinds k A_Prism k',
 JoinKinds k' l m) =>
Optic k is s t (Maybe u) (Maybe v)
-> Optic l js u v a b -> Optic m ks s t a b
%? Optic A_Lens NoIx TickStyle TickStyle Style Style
#style Optic An_AffineTraversal NoIx AxisOptions AxisOptions Style Style
-> Optic A_Lens NoIx Style Style Double Double
-> Optic
     An_AffineTraversal NoIx AxisOptions AxisOptions Double 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
% Optic A_Lens NoIx Style Style Double Double
#size) Double
0.03
    chart' :: Chart
chart' = Style -> [ChartBox] -> Chart
RectChart Style
defaultRectStyle [ChartBox]
hr
    hr :: [ChartBox]
hr =
      ((Double, Double) -> (Double, Double) -> ChartBox)
-> [(Double, Double)] -> [(Double, Double)] -> [ChartBox]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
        (\(Double
y, Double
w) (Double
x, Double
z) -> Double -> Double -> Double -> Double -> ChartBox
forall a. a -> a -> a -> a -> Rect a
Rect Double
x Double
z Double
0 ((Double
w Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
y) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
z Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
x)))
        ([Double] -> [Double] -> [(Double, Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Double]
qs (Int -> [Double] -> [Double]
forall a. Int -> [a] -> [a]
drop Int
1 [Double]
qs))
        ([Double] -> [Double] -> [(Double, Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Double]
vs (Int -> [Double] -> [Double]
forall a. Int -> [a] -> [a]
drop Int
1 [Double]
vs))

-- | Surface chart of quantile vs quantile counts
digitSurfaceChart ::
  SurfaceStyle ->
  SurfaceLegendOptions ->
  (Text, Text, Text) ->
  [Text] ->
  [(Int, Int)] ->
  ChartTree
digitSurfaceChart :: SurfaceStyle
-> SurfaceLegendOptions
-> (Text, Text, Text)
-> [Text]
-> [(Int, Int)]
-> ChartTree
digitSurfaceChart SurfaceStyle
pixelStyle SurfaceLegendOptions
_ (Text, Text, Text)
ts [Text]
names [(Int, Int)]
ps =
  ChartBox -> [Hud] -> ChartTree -> ChartTree
runHudWith ChartBox
forall a. Multiplicative a => a
one [Hud]
hs0 ([Chart] -> ChartTree
unnamed [Chart]
cs1)
  where
    l :: Int
l = [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
names Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    pts :: Point Int
pts = Int -> Int -> Point Int
forall a. a -> a -> Point a
Point Int
l Int
l
    gr :: Rect Double
    gr :: ChartBox
gr = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Double) -> Rect Int -> ChartBox
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Int -> Int -> Int -> Rect Int
forall a. a -> a -> a -> a -> Rect a
Rect Int
0 Int
l Int
0 Int
l
    mapCount :: Map (Int, Int) Double
mapCount = (Map (Int, Int) Double -> (Int, Int) -> Map (Int, Int) Double)
-> Map (Int, Int) Double -> [(Int, Int)] -> Map (Int, Int) Double
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Map (Int, Int) Double
m (Int, Int)
x -> (Double -> Double -> Double)
-> (Int, Int)
-> Double
-> Map (Int, Int) Double
-> Map (Int, Int) Double
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith Double -> Double -> Double
forall a. Num a => a -> a -> a
(+) (Int, Int)
x Double
1.0 Map (Int, Int) Double
m) Map (Int, Int) Double
forall k a. Map k a
Map.empty [(Int, Int)]
ps
    f :: Point Double -> Double
    f :: Point Double -> Double
f (Point Double
x Double
y) = Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
0 (Maybe Double -> Double) -> Maybe Double -> Double
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> Map (Int, Int) Double -> Maybe Double
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
x), Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
y)) Map (Int, Int) Double
mapCount
    (Maybe ChartBox
_, [Hud]
hs0) = HudOptions -> ChartBox -> (Maybe ChartBox, [Hud])
toHuds ((Text, Text, Text) -> [Text] -> HudOptions
qvqHud (Text, Text, Text)
ts [Text]
names) ChartBox
gr
    ([Chart]
cs1, Range Double
_) =
      (Point Double -> Double)
-> SurfaceOptions -> ([Chart], Range Double)
surfacef
        Point Double -> Double
f
        (SurfaceStyle -> Point Int -> ChartBox -> SurfaceOptions
SurfaceOptions SurfaceStyle
pixelStyle Point Int
pts ChartBox
gr)

-- | Hud for a qvq chart.
qvqHud :: (Text, Text, Text) -> [Text] -> HudOptions
qvqHud :: (Text, Text, Text) -> [Text] -> HudOptions
qvqHud (Text, Text, Text)
ts [Text]
labels =
  HudOptions
defaultHudOptions
    HudOptions -> (HudOptions -> HudOptions) -> HudOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority TitleOptions]
  [Priority TitleOptions]
#titles
    Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority TitleOptions]
  [Priority TitleOptions]
-> [Priority TitleOptions] -> 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 -> (Text, Text, Text) -> [Priority TitleOptions]
titles3 Double
5 (Text, Text, Text)
ts
    HudOptions -> (HudOptions -> HudOptions) -> HudOptions
forall a b. a -> (a -> b) -> b
& Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority AxisOptions]
  [Priority AxisOptions]
#axes
    Optic
  A_Lens
  NoIx
  HudOptions
  HudOptions
  [Priority AxisOptions]
  [Priority AxisOptions]
-> [Priority 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 -> AxisOptions -> Priority AxisOptions
forall a. Double -> a -> Priority a
Priority Double
3
           (AxisOptions -> Priority AxisOptions)
-> [AxisOptions] -> [Priority AxisOptions]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ AxisOptions
defaultYAxisOptions
                   AxisOptions -> (AxisOptions -> AxisOptions) -> AxisOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
#ticks
                   Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
-> Optic A_Lens NoIx Ticks Ticks Tick Tick
-> Optic A_Lens NoIx AxisOptions AxisOptions Tick Tick
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
% Optic A_Lens NoIx Ticks Ticks Tick Tick
#tick
                   Optic A_Lens NoIx AxisOptions AxisOptions Tick Tick
-> Tick -> AxisOptions -> AxisOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ [(Double, Text)] -> Tick
TickPlaced ([Double] -> [Text] -> [(Double, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Double
0 ..] [Text]
labels)
                   AxisOptions -> (AxisOptions -> AxisOptions) -> AxisOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
#ticks
                   Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
-> Optic
     A_Lens NoIx Ticks Ticks (Maybe TickStyle) (Maybe TickStyle)
-> Optic
     A_Lens
     NoIx
     AxisOptions
     AxisOptions
     (Maybe TickStyle)
     (Maybe 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
% Optic A_Lens NoIx Ticks Ticks (Maybe TickStyle) (Maybe TickStyle)
#lineTick
                   Optic
  A_Lens
  NoIx
  AxisOptions
  AxisOptions
  (Maybe TickStyle)
  (Maybe TickStyle)
-> Maybe 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
.~ Maybe TickStyle
forall a. Maybe a
Nothing
                   AxisOptions -> (AxisOptions -> AxisOptions) -> AxisOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
#ticks
                   Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
-> Optic
     A_Lens NoIx Ticks Ticks (Maybe TickStyle) (Maybe TickStyle)
-> Optic
     A_Lens
     NoIx
     AxisOptions
     AxisOptions
     (Maybe TickStyle)
     (Maybe 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
% Optic A_Lens NoIx Ticks Ticks (Maybe TickStyle) (Maybe TickStyle)
#textTick
                   Optic
  A_Lens
  NoIx
  AxisOptions
  AxisOptions
  (Maybe TickStyle)
  (Maybe TickStyle)
-> Optic A_Lens NoIx TickStyle TickStyle Style Style
-> Optic
     An_AffineTraversal NoIx AxisOptions AxisOptions Style Style
forall (is :: IxList) (js :: IxList) (ks :: IxList) k k' l m s t u
       v a b.
(AppendIndices is js ks, JoinKinds k A_Prism k',
 JoinKinds k' l m) =>
Optic k is s t (Maybe u) (Maybe v)
-> Optic l js u v a b -> Optic m ks s t a b
%? Optic A_Lens NoIx TickStyle TickStyle Style Style
#style
                   Optic An_AffineTraversal NoIx AxisOptions AxisOptions Style Style
-> Optic A_Lens NoIx Style Style Double Double
-> Optic
     An_AffineTraversal NoIx AxisOptions AxisOptions Double 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
% Optic A_Lens NoIx Style Style Double Double
#size
                   Optic An_AffineTraversal NoIx AxisOptions AxisOptions Double Double
-> 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
.~ Double
0.03
                   AxisOptions -> (AxisOptions -> AxisOptions) -> AxisOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx AxisOptions AxisOptions Place Place
#place
                   Optic A_Lens NoIx AxisOptions AxisOptions Place Place
-> Place -> AxisOptions -> AxisOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Place
PlaceLeft,
                 AxisOptions
defaultXAxisOptions
                   AxisOptions -> (AxisOptions -> AxisOptions) -> AxisOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
#ticks
                   Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
-> Optic A_Lens NoIx Ticks Ticks Tick Tick
-> Optic A_Lens NoIx AxisOptions AxisOptions Tick Tick
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
% Optic A_Lens NoIx Ticks Ticks Tick Tick
#tick
                   Optic A_Lens NoIx AxisOptions AxisOptions Tick Tick
-> Tick -> AxisOptions -> AxisOptions
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ [(Double, Text)] -> Tick
TickPlaced ([Double] -> [Text] -> [(Double, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Double
0 ..] [Text]
labels)
                   AxisOptions -> (AxisOptions -> AxisOptions) -> AxisOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
#ticks
                   Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
-> Optic
     A_Lens NoIx Ticks Ticks (Maybe TickStyle) (Maybe TickStyle)
-> Optic
     A_Lens
     NoIx
     AxisOptions
     AxisOptions
     (Maybe TickStyle)
     (Maybe 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
% Optic A_Lens NoIx Ticks Ticks (Maybe TickStyle) (Maybe TickStyle)
#lineTick
                   Optic
  A_Lens
  NoIx
  AxisOptions
  AxisOptions
  (Maybe TickStyle)
  (Maybe TickStyle)
-> Maybe 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
.~ Maybe TickStyle
forall a. Maybe a
Nothing
                   AxisOptions -> (AxisOptions -> AxisOptions) -> AxisOptions
forall a b. a -> (a -> b) -> b
& Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
#ticks
                   Optic A_Lens NoIx AxisOptions AxisOptions Ticks Ticks
-> Optic
     A_Lens NoIx Ticks Ticks (Maybe TickStyle) (Maybe TickStyle)
-> Optic
     A_Lens
     NoIx
     AxisOptions
     AxisOptions
     (Maybe TickStyle)
     (Maybe 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
% Optic A_Lens NoIx Ticks Ticks (Maybe TickStyle) (Maybe TickStyle)
#textTick
                   Optic
  A_Lens
  NoIx
  AxisOptions
  AxisOptions
  (Maybe TickStyle)
  (Maybe TickStyle)
-> Optic A_Lens NoIx TickStyle TickStyle Style Style
-> Optic
     An_AffineTraversal NoIx AxisOptions AxisOptions Style Style
forall (is :: IxList) (js :: IxList) (ks :: IxList) k k' l m s t u
       v a b.
(AppendIndices is js ks, JoinKinds k A_Prism k',
 JoinKinds k' l m) =>
Optic k is s t (Maybe u) (Maybe v)
-> Optic l js u v a b -> Optic m ks s t a b
%? Optic A_Lens NoIx TickStyle TickStyle Style Style
#style
                   Optic An_AffineTraversal NoIx AxisOptions AxisOptions Style Style
-> Optic A_Lens NoIx Style Style Double Double
-> Optic
     An_AffineTraversal NoIx AxisOptions AxisOptions Double 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
% Optic A_Lens NoIx Style Style Double Double
#size
                   Optic An_AffineTraversal NoIx AxisOptions AxisOptions Double Double
-> 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
.~ Double
0.03
               ]
       )