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

-- | Various common chart patterns.
module Prettychart.Charts
  ( simpleLineChart,
    xify,
    yify,
    timeXAxis,
    titles3,
    histChart,
    gpalette,
    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 =
  LineStyle -> [[Point Double]] -> Chart
LineChart
    (LineStyle
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
defaultAxisOptions
    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 "style" a => a
#style
      forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ [(Double, Text)] -> TickStyle
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 :: Priority -> (Text, Text, Text) -> [(Priority, Title)]
titles3 :: Priority -> (Text, Text, Text) -> [(Priority, Title)]
titles3 Priority
p (Text
t, Text
x, Text
y) =
  [ (Priority
p, Text -> Title
defaultTitle 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),
    (Priority
p, Text -> Title
defaultTitle 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),
    (Priority
p, Text -> Title
defaultTitle 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 "charts" a => a
#charts 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" [RectStyle -> [Rect Double] -> Chart
RectChart RectStyle
defaultRectStyle [Rect Double]
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
.~ [(Priority
5, AxisOptions
defaultAxisOptions 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 "ltick" a => a
#ltick 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 "style" a => a
#style 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 -> TickStyle
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
.~ [(Priority
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 :: [Rect Double]
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 -> [Rect Double]
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 GlyphStyle -> [Point Double] -> Chart
GlyphChart (Double -> Double -> [GlyphStyle]
gpaletteStyle Double
0.04 Double
0.01) [[Point Double]]
xss

-- | GlyphStyle palette
gpaletteStyle :: Double -> Double -> [GlyphStyle]
gpaletteStyle :: Double -> Double -> [GlyphStyle]
gpaletteStyle Double
s Double
bs = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Int
c GlyphShape
g -> GlyphStyle
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
palette1 Int
c forall a b. a -> (a -> b) -> b
& forall a. IsLabel "shape" a => a
#shape 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) [Int
0 ..] [GlyphShape]
gpalette

-- | Glyph palette
gpalette :: [GlyphShape]
gpalette :: [GlyphShape]
gpalette =
  [ GlyphShape
CircleGlyph,
    GlyphShape
SquareGlyph,
    Double -> GlyphShape
RectSharpGlyph Double
0.75,
    Double -> Double -> Double -> GlyphShape
RectRoundedGlyph Double
0.75 Double
0.01 Double
0.01,
    Double -> GlyphShape
EllipseGlyph Double
0.75,
    GlyphShape
VLineGlyph,
    GlyphShape
HLineGlyph,
    Point Double -> Point Double -> Point Double -> GlyphShape
TriangleGlyph (forall a. a -> a -> Point a
Point Double
0.0 Double
0.0) (forall a. a -> a -> Point a
Point Double
1 Double
1) (forall a. a -> a -> Point a
Point Double
1 Double
0),
    ByteString -> ScaleBorder -> GlyphShape
PathGlyph ByteString
"M0.05,-0.03660254037844387 A0.1 0.1 0.0 0 1 0.0,0.05 0.1 0.1 0.0 0 1 -0.05,-0.03660254037844387 0.1 0.1 0.0 0 1 0.05,-0.03660254037844387 Z" ScaleBorder
ScaleBorder
  ]

-- | Chart template for quantiles.
quantileChart ::
  [Text] ->
  [LineStyle] ->
  [[Double]] ->
  ChartOptions
quantileChart :: [Text] -> [LineStyle] -> [[Double]] -> ChartOptions
quantileChart [Text]
names [LineStyle]
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 "charts" a => a
#charts 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
.~ [ ( Priority
10,
                     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
        (\LineStyle
l [Point Double]
x -> LineStyle -> [[Point Double]] -> Chart
LineChart LineStyle
l [[Point Double]
x])
        [LineStyle]
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) -> [LineStyle]
blendMidLineStyles :: Int -> Double -> (Colour, Colour) -> [LineStyle]
blendMidLineStyles Int
l Double
w (Colour
c1, Colour
c2) = [LineStyle]
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 :: [LineStyle]
lo = (\Colour
c -> LineStyle
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 "charts" a => a
#charts 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
.~ [ ( Priority
5,
                 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 "style" a => a
#style
                         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 -> TickStyle
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 "style" a => a
#style
                           forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ [(Double, Text)] -> TickStyle
TickPlaced (forall a b. [a] -> [b] -> [(a, b)]
zip [Double]
vs [Text]
x)
                   )
                   Maybe [Text]
names
               )
             ]
    axis0 :: AxisOptions
axis0 = AxisOptions
defaultAxisOptions 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 "ltick" a => a
#ltick 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 "ttick" a => a
#ttick) forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (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))
    chart' :: Chart
chart' = RectStyle -> [Rect Double] -> Chart
RectChart RectStyle
defaultRectStyle [Rect Double]
hr
    hr :: [Rect Double]
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 "charts" a => a
#charts 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
.~ [(Priority
5, Int -> [UTCTime] -> AxisOptions
timeXAxis Int
8 [UTCTime]
utcs), (Priority
5, [Text] -> AxisOptions
decileYAxis [Text]
labels)]
    c :: Chart
c =
      GlyphStyle -> [Point Double] -> Chart
GlyphChart
        ( GlyphStyle
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 "shape" a => a
#shape forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ GlyphShape
CircleGlyph
            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
        )
        ([Double] -> [Point Double]
xify [Double]
xs)

decileYAxis :: [Text] -> AxisOptions
decileYAxis :: [Text] -> AxisOptions
decileYAxis [Text]
labels =
  AxisOptions
defaultAxisOptions
    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 "style" a => a
#style forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ [(Double, Text)] -> TickStyle
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 "ltick" a => a
#ltick 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 "ttick" a => a
#ttick forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (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

-- | 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 =
  Rect Double -> [Hud] -> ChartTree -> ChartTree
runHud (Double -> Rect Double
aspect Double
1) [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 :: Rect Double
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
    ([Hud]
hs0, Rect Double
_) = HudOptions -> Rect Double -> ([Hud], Rect Double)
toHuds ((Text, Text, Text) -> [Text] -> HudOptions
qvqHud (Text, Text, Text)
ts [Text]
names) Rect Double
gr
    ([Chart]
cs1, Range Double
_) =
      (Point Double -> Double)
-> SurfaceOptions -> ([Chart], Range Double)
surfacef
        Point Double -> Double
f
        (SurfaceStyle -> Point Int -> Rect Double -> SurfaceOptions
SurfaceOptions SurfaceStyle
pixelStyle Point Int
pts Rect Double
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
.~ Priority -> (Text, Text, Text) -> [(Priority, Title)]
titles3 Priority
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
.~ ( (Priority
3,)
             forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ AxisOptions
defaultAxisOptions
                     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 "style" a => a
#style forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ [(Double, Text)] -> TickStyle
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 "ltick" a => a
#ltick 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 "ttick" a => a
#ttick forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (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
defaultAxisOptions
                     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 "style" a => a
#style forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ [(Double, Text)] -> TickStyle
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 "ltick" a => a
#ltick 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 "ttick" a => a
#ttick forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> (a -> b) -> s -> t
%~ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (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
PlaceBottom
                 ]
         )