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

-- | Various common chart patterns.
module Prettychart.Charts
  ( simpleLineChart,
    xify,
    yify,
    timeXAxis,
    titles3,
    histChart,
    scatterChart,
    blendMidLineStyles,
    quantileNames,
    quantileChart,
    digitChart,
    quantileHistChart,
    digitSurfaceChart,
  )
where

import Chart hiding (abs)
import Data.Bifunctor
import Data.Foldable
import Data.Map.Strict qualified as Map
import Data.Maybe
import Data.Text (Text)
import Data.Time (UTCTime (..))
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

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

-- | Create a hud that has time as the x-axis, based on supplied UTCTime list.
timeXAxis :: Int -> [UTCTime] -> AxisOptions
timeXAxis :: Int -> [UTCTime] -> AxisOptions
timeXAxis Int
nticks [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 -> 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)) ((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
PosInnerOnly Maybe Text
forall a. Maybe a
Nothing Int
nticks ([Element (Range UTCTime)] -> Range UTCTime
forall s (f :: * -> *).
(Space s, Traversable f) =>
f (Element s) -> s
unsafeSpace1 [UTCTime]
[Element (Range UTCTime)]
ds))

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

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

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

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

-- | Format quantile-style numbers
--
-- >>> quantileNames [0.01, 0.5, 0.99]
-- ["1%","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 Maybe Int
forall a. Maybe a
Nothing (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))

-- | A chart drawing quantiles of a time series
digitChart ::
  [UTCTime] ->
  [Double] ->
  [Text] ->
  ChartOptions
digitChart :: [UTCTime] -> [Double] -> [Text] -> ChartOptions
digitChart [UTCTime]
utcs [Double]
xs [Text]
labels =
  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
    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 (Int -> [UTCTime] -> AxisOptions
timeXAxis Int
8 [UTCTime]
utcs), Double -> AxisOptions -> Priority AxisOptions
forall a. Double -> a -> Priority a
Priority Double
5 ([Text] -> AxisOptions
decileYAxis [Text]
labels)]
    c :: Chart
c =
      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
.~ Double -> Double -> Double -> Double -> Colour
Colour Double
0 Double
0 Double
1 Double
1
            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
0.01
            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
CircleGlyph
        )
        ([Double] -> [Point Double]
xify [Double]
xs)

decileYAxis :: [Text] -> AxisOptions
decileYAxis :: [Text] -> AxisOptions
decileYAxis [Text]
labels =
  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 -> 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 ..]) [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

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

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