{-# 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 =
  forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith 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 =
  forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith 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 forall a b. a -> (a -> b) -> b
& forall a. IsLabel "color" a => a
#color forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Colour
c forall a b. a -> (a -> b) -> b
& forall a. IsLabel "size" a => a
#size 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
    forall a b. a -> (a -> b) -> b
& forall a. IsLabel "ticks" a => a
#ticks
    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
% forall a. IsLabel "tick" a => a
#tick
    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
      ( forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (t :: * -> *) a. Foldable t => t a -> Int
length [UTCTime]
ds)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PosDiscontinuous
-> Maybe Text -> Int -> Range UTCTime -> [(Double, Text)]
placedTimeLabelContinuous PosDiscontinuous
PosInnerOnly forall a. Maybe a
Nothing Int
nticks (forall s (f :: * -> *).
(Space s, Traversable f) =>
f (Element s) -> s
unsafeSpace1 [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) =
  [ forall a. Double -> a -> Priority a
Priority Double
p (Text -> TitleOptions
defaultTitleOptions Text
t forall a b. a -> (a -> b) -> b
& forall a. IsLabel "style" a => a
#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
% forall a. IsLabel "size" a => a
#size 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),
    forall a. Double -> a -> Priority a
Priority Double
p (Text -> TitleOptions
defaultTitleOptions Text
x forall a b. a -> (a -> b) -> b
& forall a. IsLabel "place" a => a
#place forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Place
PlaceBottom forall a b. a -> (a -> b) -> b
& forall a. IsLabel "style" a => a
#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
% forall a. IsLabel "size" a => a
#size 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),
    forall a. Double -> a -> Priority a
Priority Double
p (Text -> TitleOptions
defaultTitleOptions Text
y forall a b. a -> (a -> b) -> b
& forall a. IsLabel "place" a => a
#place forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Place
PlaceLeft forall a b. a -> (a -> b) -> b
& forall a. IsLabel "style" a => a
#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
% forall a. IsLabel "size" a => a
#size 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 =
  forall a. Monoid a => a
mempty
    forall a b. a -> (a -> b) -> b
& forall a. IsLabel "chartTree" a => a
#chartTree
    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]
    forall a b. a -> (a -> b) -> b
& forall a. IsLabel "hudOptions" a => a
#hudOptions
    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
% forall a. IsLabel "axes" a => a
#axes
    forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ [forall a. Double -> a -> Priority a
Priority Double
5 (AxisOptions
defaultXAxisOptions forall a b. a -> (a -> b) -> b
& forall a. IsLabel "ticks" a => a
#ticks 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
% forall a. IsLabel "lineTick" a => a
#lineTick forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ forall a. Maybe a
Nothing forall a b. a -> (a -> b) -> b
& forall a. IsLabel "ticks" a => a
#ticks 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
% forall a. IsLabel "tick" a => a
#tick 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 (forall a. a -> Maybe a
Just Int
2) Int
4 Bool
True Bool
True) Int
5 TickExtend
NoTickExtend)]
    forall a b. a -> (a -> b) -> b
& forall a. IsLabel "hudOptions" a => a
#hudOptions
    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
% forall a. IsLabel "frames" a => a
#frames
    forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ [forall a. Double -> a -> Priority a
Priority Double
20 (FrameOptions
defaultFrameOptions forall a b. a -> (a -> b) -> b
& forall a. IsLabel "buffer" a => a
#buffer 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 = forall (f :: * -> *).
Foldable f =>
[Double] -> f Double -> Histogram
fill [Double]
hcuts [Double]
xs
    rects :: [ChartBox]
rects =
      forall a. (a -> Bool) -> [a] -> [a]
filter (\(Rect Double
_ Double
_ Double
_ Double
y') -> Double
y' forall a. Eq a => a -> a -> Bool
/= Double
0) forall a b. (a -> b) -> a -> b
$
        DealOvers -> Histogram -> [ChartBox]
makeRects (Double -> DealOvers
IncludeOvers (forall s. (Space s, Subtractive (Element s)) => s -> Element s
NumHask.Space.width Range Double
r forall a. Fractional a => a -> a -> a
/ 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 = 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 forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set forall a. IsLabel "glyphShape" a => a
#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 = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Int
c GlyphShape
g -> (Style
defaultGlyphStyle forall a b. a -> (a -> b) -> b
& forall a. IsLabel "size" a => a
#size forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Double
s forall a b. a -> (a -> b) -> b
& forall a. IsLabel "color" a => a
#color 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 forall a b. a -> (a -> b) -> b
& forall a. IsLabel "glyphShape" a => a
#glyphShape forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ GlyphShape
g forall a b. a -> (a -> b) -> b
& forall a. IsLabel "borderSize" a => a
#borderSize 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 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 = forall a. Monoid a => a
mempty forall a b. a -> (a -> b) -> b
& forall a. IsLabel "hudOptions" a => a
#hudOptions forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ HudOptions
h forall a b. a -> (a -> b) -> b
& forall a. IsLabel "chartTree" a => a
#chartTree 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
        forall a b. a -> (a -> b) -> b
& ( forall a. IsLabel "legends" a => a
#legends
              forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ [ forall a. Double -> a -> Priority a
Priority Double
10 forall a b. (a -> b) -> a -> b
$
                     LegendOptions
defaultLegendOptions
                       forall a b. a -> (a -> b) -> b
& forall a. IsLabel "textStyle" a => a
#textStyle
                       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
% forall a. IsLabel "size" a => a
#size
                       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
                       forall a b. a -> (a -> b) -> b
& forall a. IsLabel "vgap" a => a
#vgap
                       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
                       forall a b. a -> (a -> b) -> b
& forall a. IsLabel "innerPad" a => a
#innerPad
                       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
                       forall a b. a -> (a -> b) -> b
& forall a. IsLabel "place" a => a
#place
                       forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Place
PlaceRight
                       forall a b. a -> (a -> b) -> b
& forall a. IsLabel "legendCharts" a => a
#legendCharts
                       forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
names ((forall a. a -> [a] -> [a]
: []) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Chart]
c)
                 ]
          )
    c :: [Chart]
c =
      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
        (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a. a -> a -> Point a
Point [Double
0 ..] 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 forall a. Maybe a
Nothing 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 = (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l forall a. Num a => a -> a -> a
- Double
1) forall a. Fractional a => a -> a -> a
/ Double
2 :: Double
    cs :: [Double]
cs = (\Int
x -> Double
1 forall a. Num a => a -> a -> a
- forall a. Num a => a -> a
abs (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x forall a. Num a => a -> a -> a
- Double
m) forall a. Fractional a => a -> a -> a
/ Double
m) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int
0 .. (Int
l 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) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Double]
cs
    lo :: [Style]
lo = (\Colour
c -> Style
defaultLineStyle forall a b. a -> (a -> b) -> b
& forall a. IsLabel "size" a => a
#size forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Double
w forall a b. a -> (a -> b) -> b
& forall a. IsLabel "color" a => a
#color forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ Colour
c) 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 = forall a. Monoid a => a
mempty forall a b. a -> (a -> b) -> b
& forall a. IsLabel "chartTree" a => a
#chartTree 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'] forall a b. a -> (a -> b) -> b
& forall a. IsLabel "hudOptions" a => a
#hudOptions 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
        forall a b. a -> (a -> b) -> b
& forall a. IsLabel "axes" a => a
#axes
        forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ [ forall a. Double -> a -> Priority a
Priority Double
5 forall a b. (a -> b) -> a -> b
$
               forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                 ( AxisOptions
axis0
                     forall a b. a -> (a -> b) -> b
& forall a. IsLabel "ticks" a => a
#ticks
                     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
% forall a. IsLabel "tick" a => a
#tick
                     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 (forall a. a -> Maybe a
Just Int
3) Int
4 Bool
True Bool
True) Int
6 TickExtend
TickExtend
                 )
                 ( \[Text]
x ->
                     AxisOptions
axis0
                       forall a b. a -> (a -> b) -> b
& forall a. IsLabel "ticks" a => a
#ticks
                       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
% forall a. IsLabel "tick" a => a
#tick
                       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 (forall a b. [a] -> [b] -> [(a, b)]
zip [Double]
vs [Text]
x)
                 )
                 Maybe [Text]
names
           ]
    axis0 :: AxisOptions
axis0 = AxisOptions
defaultXAxisOptions forall a b. a -> (a -> b) -> b
& forall a. IsLabel "ticks" a => a
#ticks 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
% forall a. IsLabel "lineTick" a => a
#lineTick forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ forall a. Maybe a
Nothing forall a b. a -> (a -> b) -> b
& forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
set (forall a. IsLabel "ticks" a => a
#ticks 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
% forall a. IsLabel "textTick" a => a
#textTick 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
%? forall a. IsLabel "style" a => a
#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
% forall a. IsLabel "size" a => a
#size) Double
0.03
    chart' :: Chart
chart' = Style -> [ChartBox] -> Chart
RectChart Style
defaultRectStyle [ChartBox]
hr
    hr :: [ChartBox]
hr =
      forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
        (\(Double
y, Double
w) (Double
x, Double
z) -> forall a. a -> a -> a -> a -> Rect a
Rect Double
x Double
z Double
0 ((Double
w forall a. Num a => a -> a -> a
- Double
y) forall a. Fractional a => a -> a -> a
/ (Double
z forall a. Num a => a -> a -> a
- Double
x)))
        (forall a b. [a] -> [b] -> [(a, b)]
zip [Double]
qs (forall a. Int -> [a] -> [a]
drop Int
1 [Double]
qs))
        (forall a b. [a] -> [b] -> [(a, b)]
zip [Double]
vs (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 =
  forall a. Monoid a => a
mempty forall a b. a -> (a -> b) -> b
& forall a. IsLabel "chartTree" a => a
#chartTree 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] forall a b. a -> (a -> b) -> b
& forall a. IsLabel "hudOptions" a => a
#hudOptions 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
        forall a b. a -> (a -> b) -> b
& forall a. IsLabel "axes" a => a
#axes
        forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ [forall a. Double -> a -> Priority a
Priority Double
5 (Int -> [UTCTime] -> AxisOptions
timeXAxis Int
8 [UTCTime]
utcs), forall a. Double -> a -> Priority a
Priority Double
5 ([Text] -> AxisOptions
decileYAxis [Text]
labels)]
    c :: Chart
c =
      Style -> [Point Double] -> Chart
GlyphChart
        ( Style
defaultGlyphStyle
            forall a b. a -> (a -> b) -> b
& forall a. IsLabel "color" a => a
#color
            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
            forall a b. a -> (a -> b) -> b
& forall a. IsLabel "size" a => a
#size
            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
            forall a b. a -> (a -> b) -> b
& forall a. IsLabel "glyphShape" a => a
#glyphShape
            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
    forall a b. a -> (a -> b) -> b
& forall a. IsLabel "ticks" a => a
#ticks
    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
% forall a. IsLabel "tick" a => a
#tick
    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 (forall a b. [a] -> [b] -> [(a, b)]
zip ((forall a. Num a => a -> a -> a
+ Double
0.5) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Double
0 ..]) [Text]
labels)
    forall a b. a -> (a -> b) -> b
& forall a. IsLabel "ticks" a => a
#ticks
    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
% forall a. IsLabel "lineTick" a => a
#lineTick
    forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ forall a. Maybe a
Nothing
    forall a b. a -> (a -> b) -> b
& forall a. IsLabel "ticks" a => a
#ticks
    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
% forall a. IsLabel "textTick" a => a
#textTick
    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
%? forall a. IsLabel "style" a => a
#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
% forall a. IsLabel "size" a => a
#size
    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 forall a. Multiplicative a => a
one [Hud]
hs0 ([Chart] -> ChartTree
unnamed [Chart]
cs1)
  where
    l :: Int
l = forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
names forall a. Num a => a -> a -> a
- Int
1
    pts :: Point Int
pts = forall a. a -> a -> Point a
Point Int
l Int
l
    gr :: Rect Double
    gr :: ChartBox
gr = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. a -> a -> a -> a -> Rect a
Rect Int
0 Int
l Int
0 Int
l
    mapCount :: Map (Int, Int) Double
mapCount = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Map (Int, Int) Double
m (Int, Int)
x -> forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith forall a. Num a => a -> a -> a
(+) (Int, Int)
x Double
1.0 Map (Int, Int) Double
m) 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) = forall a. a -> Maybe a -> a
fromMaybe Double
0 forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (forall a b. (RealFrac a, Integral b) => a -> b
floor (Double
1 forall a. Num a => a -> a -> a
+ Double
x), forall a b. (RealFrac a, Integral b) => a -> b
floor (Double
1 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
    forall a b. a -> (a -> b) -> b
& forall a. IsLabel "titles" a => a
#titles
    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
    forall a b. a -> (a -> b) -> b
& forall a. IsLabel "axes" a => a
#axes
    forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ ( forall a. Double -> a -> Priority a
Priority Double
3
           forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ AxisOptions
defaultYAxisOptions
                   forall a b. a -> (a -> b) -> b
& forall a. IsLabel "ticks" a => a
#ticks
                   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
% forall a. IsLabel "tick" a => a
#tick
                   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 (forall a b. [a] -> [b] -> [(a, b)]
zip [Double
0 ..] [Text]
labels)
                   forall a b. a -> (a -> b) -> b
& forall a. IsLabel "ticks" a => a
#ticks
                   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
% forall a. IsLabel "lineTick" a => a
#lineTick
                   forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ forall a. Maybe a
Nothing
                   forall a b. a -> (a -> b) -> b
& forall a. IsLabel "ticks" a => a
#ticks
                   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
% forall a. IsLabel "textTick" a => a
#textTick
                   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
%? forall a. IsLabel "style" a => a
#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
% forall a. IsLabel "size" a => a
#size
                   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
                   forall a b. a -> (a -> b) -> b
& forall a. IsLabel "place" a => a
#place
                   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
                   forall a b. a -> (a -> b) -> b
& forall a. IsLabel "ticks" a => a
#ticks
                   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
% forall a. IsLabel "tick" a => a
#tick
                   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 (forall a b. [a] -> [b] -> [(a, b)]
zip [Double
0 ..] [Text]
labels)
                   forall a b. a -> (a -> b) -> b
& forall a. IsLabel "ticks" a => a
#ticks
                   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
% forall a. IsLabel "lineTick" a => a
#lineTick
                   forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ forall a. Maybe a
Nothing
                   forall a b. a -> (a -> b) -> b
& forall a. IsLabel "ticks" a => a
#ticks
                   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
% forall a. IsLabel "textTick" a => a
#textTick
                   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
%? forall a. IsLabel "style" a => a
#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
% forall a. IsLabel "size" a => a
#size
                   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
               ]
       )