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

-- | Various common chart patterns.
module Chart.Various
  ( -- * sub-chart patterns
    xify,
    xify',
    yify,
    yify',
    addLineX,
    addLineY,
    stdLineChart,
    stdLines,
    lineLegend,
    tsAxes,
    titlesHud,
    gpalette,
    gpaletteStyle,
    blendMidLineStyles,

    -- * chart patterns
    quantileChart,
    digitChart,
    scatterChart,
    histChart,
    quantileHistChart,
    digitSurfaceChart,
    tableChart,
  )
where

import Chart
import Control.Lens
import Data.Bifunctor
import Data.Foldable
import qualified Data.HashMap.Strict as HashMap
import Data.Maybe
import Data.Text (Text)
import Data.Time (UTCTime (..))
import NumHask.Prelude (one)
import NumHask.Space

-- | convert from [a] to [Point a], by adding the index as the x axis
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 [XY a], by adding the index as the x axis
xify' :: [Double] -> [XY Double]
xify' :: [Double] -> [XY Double]
xify' [Double]
ys =
  (Double -> Double -> XY Double)
-> [Double] -> [Double] -> [XY Double]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Double -> Double -> XY Double
forall a. a -> a -> XY a
P [Double
0 ..] [Double]
ys

-- | convert from [a] to [Point a], by adding the index as the y axis
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 ..]

-- | convert from [a] to [XY a], by adding the index as the y axis
yify' :: [Double] -> [XY Double]
yify' :: [Double] -> [XY Double]
yify' [Double]
xs =
  (Double -> Double -> XY Double)
-> [Double] -> [Double] -> [XY Double]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Double -> Double -> XY Double
forall a. a -> a -> XY a
P [Double]
xs [Double
0 ..]

-- | add a horizontal line at y
addLineX :: Double -> LineStyle -> [Chart Double] -> [Chart Double]
addLineX :: Double -> LineStyle -> [Chart Double] -> [Chart Double]
addLineX Double
y LineStyle
ls [Chart Double]
cs = [Chart Double]
cs [Chart Double] -> [Chart Double] -> [Chart Double]
forall a. Semigroup a => a -> a -> a
<> [Chart Double
l]
  where
    l :: Chart Double
l = Annotation -> [XY Double] -> Chart Double
forall a. Annotation -> [XY a] -> Chart a
Chart (LineStyle -> Annotation
LineA LineStyle
ls) (Point Double -> XY Double
forall a. Point a -> XY a
PointXY (Point Double -> XY Double) -> [Point Double] -> [XY Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
lx Double
y, Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
ux Double
y])
    (Rect Double
lx Double
ux Double
_ Double
_) = Rect Double -> Maybe (Rect Double) -> Rect Double
forall a. a -> Maybe a -> a
fromMaybe Rect Double
forall a. Multiplicative a => a
one (Maybe (Rect Double) -> Rect Double)
-> Maybe (Rect Double) -> Rect Double
forall a b. (a -> b) -> a -> b
$ [Rect Double] -> Maybe (Rect Double)
forall a. Ord a => [Rect a] -> Maybe (Rect a)
foldRect ([Rect Double] -> Maybe (Rect Double))
-> [Rect Double] -> Maybe (Rect Double)
forall a b. (a -> b) -> a -> b
$ [[Rect Double]] -> [Rect Double]
forall a. Monoid a => [a] -> a
mconcat ([[Rect Double]] -> [Rect Double])
-> [[Rect Double]] -> [Rect Double]
forall a b. (a -> b) -> a -> b
$ (XY Double -> Rect Double) -> [XY Double] -> [Rect Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap XY Double -> Rect Double
forall a. XY a -> Rect a
toRect ([XY Double] -> [Rect Double])
-> (Chart Double -> [XY Double]) -> Chart Double -> [Rect Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Chart Double -> [XY Double]
forall a. Chart a -> [XY a]
xys (Chart Double -> [Rect Double])
-> [Chart Double] -> [[Rect Double]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Chart Double]
cs

-- | add a verticle line at x
addLineY :: Double -> LineStyle -> [Chart Double] -> [Chart Double]
addLineY :: Double -> LineStyle -> [Chart Double] -> [Chart Double]
addLineY Double
x LineStyle
ls [Chart Double]
cs = [Chart Double]
cs [Chart Double] -> [Chart Double] -> [Chart Double]
forall a. Semigroup a => a -> a -> a
<> [Chart Double
zeroLine]
  where
    zeroLine :: Chart Double
zeroLine = Annotation -> [XY Double] -> Chart Double
forall a. Annotation -> [XY a] -> Chart a
Chart (LineStyle -> Annotation
LineA LineStyle
ls) (Point Double -> XY Double
forall a. Point a -> XY a
PointXY (Point Double -> XY Double) -> [Point Double] -> [XY Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
x Double
ly, Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
x Double
uy])
    (Rect Double
_ Double
_ Double
ly Double
uy) = Rect Double -> Maybe (Rect Double) -> Rect Double
forall a. a -> Maybe a -> a
fromMaybe Rect Double
forall a. Multiplicative a => a
one (Maybe (Rect Double) -> Rect Double)
-> Maybe (Rect Double) -> Rect Double
forall a b. (a -> b) -> a -> b
$ [Rect Double] -> Maybe (Rect Double)
forall a. Ord a => [Rect a] -> Maybe (Rect a)
foldRect ([Rect Double] -> Maybe (Rect Double))
-> [Rect Double] -> Maybe (Rect Double)
forall a b. (a -> b) -> a -> b
$ [[Rect Double]] -> [Rect Double]
forall a. Monoid a => [a] -> a
mconcat ([[Rect Double]] -> [Rect Double])
-> [[Rect Double]] -> [Rect Double]
forall a b. (a -> b) -> a -> b
$ (XY Double -> Rect Double) -> [XY Double] -> [Rect Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap XY Double -> Rect Double
forall a. XY a -> Rect a
toRect ([XY Double] -> [Rect Double])
-> (Chart Double -> [XY Double]) -> Chart Double -> [Rect Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Chart Double -> [XY Double]
forall a. Chart a -> [XY a]
xys (Chart Double -> [Rect Double])
-> [Chart Double] -> [[Rect Double]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Chart Double]
cs

-- | interpret a [[Double]] as a series of lines with x coordinates of [0..]
stdLineChart :: Double -> [Colour] -> [[Double]] -> [Chart Double]
stdLineChart :: Double -> [Colour] -> [[Double]] -> [Chart Double]
stdLineChart Double
w [Colour]
p [[Double]]
xss =
  (Colour -> [Double] -> Chart Double)
-> [Colour] -> [[Double]] -> [Chart Double]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
    ( \Colour
c [Double]
xs ->
        Annotation -> [XY Double] -> Chart Double
forall a. Annotation -> [XY a] -> Chart a
Chart
          (LineStyle -> Annotation
LineA (LineStyle
defaultLineStyle LineStyle -> (LineStyle -> LineStyle) -> LineStyle
forall a b. a -> (a -> b) -> b
& IsLabel "color" (ASetter LineStyle LineStyle Colour Colour)
ASetter LineStyle LineStyle Colour Colour
#color ASetter LineStyle LineStyle Colour Colour
-> Colour -> LineStyle -> LineStyle
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Colour
c LineStyle -> (LineStyle -> LineStyle) -> LineStyle
forall a b. a -> (a -> b) -> b
& IsLabel "width" (ASetter LineStyle LineStyle Double Double)
ASetter LineStyle LineStyle Double Double
#width ASetter LineStyle LineStyle Double Double
-> Double -> LineStyle -> LineStyle
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Double
w))
          ([Double] -> [XY Double]
xify' [Double]
xs)
    )
    [Colour]
p
    [[Double]]
xss

-- | Can of the main palette
stdLines :: Double -> [LineStyle]
stdLines :: Double -> [LineStyle]
stdLines Double
w = (\Colour
c -> LineStyle
defaultLineStyle LineStyle -> (LineStyle -> LineStyle) -> LineStyle
forall a b. a -> (a -> b) -> b
& IsLabel "color" (ASetter LineStyle LineStyle Colour Colour)
ASetter LineStyle LineStyle Colour Colour
#color ASetter LineStyle LineStyle Colour Colour
-> Colour -> LineStyle -> LineStyle
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Colour
c LineStyle -> (LineStyle -> LineStyle) -> LineStyle
forall a b. a -> (a -> b) -> b
& IsLabel "width" (ASetter LineStyle LineStyle Double Double)
ASetter LineStyle LineStyle Double Double
#width ASetter LineStyle LineStyle Double Double
-> Double -> LineStyle -> LineStyle
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Double
w) (Colour -> LineStyle) -> [Colour] -> [LineStyle]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Colour]
palette1_

-- | Legend template for a line chart.
lineLegend :: Double -> [Text] -> [Colour] -> (LegendOptions, [(Annotation, Text)])
lineLegend :: Double
-> [Text] -> [Colour] -> (LegendOptions, [(Annotation, Text)])
lineLegend Double
w [Text]
rs [Colour]
cs =
  ( LegendOptions
defaultLegendOptions
      LegendOptions -> (LegendOptions -> LegendOptions) -> LegendOptions
forall a b. a -> (a -> b) -> b
& IsLabel
  "ltext"
  ((TextStyle -> Identity TextStyle)
   -> LegendOptions -> Identity LegendOptions)
(TextStyle -> Identity TextStyle)
-> LegendOptions -> Identity LegendOptions
#ltext ((TextStyle -> Identity TextStyle)
 -> LegendOptions -> Identity LegendOptions)
-> ((Double -> Identity Double) -> TextStyle -> Identity TextStyle)
-> (Double -> Identity Double)
-> LegendOptions
-> Identity LegendOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
  "size"
  ((Double -> Identity Double) -> TextStyle -> Identity TextStyle)
(Double -> Identity Double) -> TextStyle -> Identity TextStyle
#size ((Double -> Identity Double)
 -> LegendOptions -> Identity LegendOptions)
-> Double -> LegendOptions -> LegendOptions
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Double
0.3
      LegendOptions -> (LegendOptions -> LegendOptions) -> LegendOptions
forall a b. a -> (a -> b) -> b
& IsLabel "lplace" (ASetter LegendOptions LegendOptions Place Place)
ASetter LegendOptions LegendOptions Place Place
#lplace ASetter LegendOptions LegendOptions Place Place
-> Place -> LegendOptions -> LegendOptions
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Place
PlaceBottom
      LegendOptions -> (LegendOptions -> LegendOptions) -> LegendOptions
forall a b. a -> (a -> b) -> b
& IsLabel
  "legendFrame"
  (ASetter
     LegendOptions LegendOptions (Maybe RectStyle) (Maybe RectStyle))
ASetter
  LegendOptions LegendOptions (Maybe RectStyle) (Maybe RectStyle)
#legendFrame ASetter
  LegendOptions LegendOptions (Maybe RectStyle) (Maybe RectStyle)
-> Maybe RectStyle -> LegendOptions -> LegendOptions
forall s t a b. ASetter s t a b -> b -> s -> t
.~ RectStyle -> Maybe RectStyle
forall a. a -> Maybe a
Just (Double -> Colour -> Colour -> RectStyle
RectStyle Double
0.02 (Int -> Colour
palette1 Int
5) (Int -> Colour
palette1 Int
4)),
    (LineStyle -> Text -> (Annotation, Text))
-> [LineStyle] -> [Text] -> [(Annotation, Text)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
      (\LineStyle
a Text
r -> (LineStyle -> Annotation
LineA LineStyle
a, Text
r))
      ((\Colour
c -> LineStyle
defaultLineStyle LineStyle -> (LineStyle -> LineStyle) -> LineStyle
forall a b. a -> (a -> b) -> b
& IsLabel "color" (ASetter LineStyle LineStyle Colour Colour)
ASetter LineStyle LineStyle Colour Colour
#color ASetter LineStyle LineStyle Colour Colour
-> Colour -> LineStyle -> LineStyle
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Colour
c LineStyle -> (LineStyle -> LineStyle) -> LineStyle
forall a b. a -> (a -> b) -> b
& IsLabel "width" (ASetter LineStyle LineStyle Double Double)
ASetter LineStyle LineStyle Double Double
#width ASetter LineStyle LineStyle Double Double
-> Double -> LineStyle -> LineStyle
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Double
w) (Colour -> LineStyle) -> [Colour] -> [LineStyle]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Colour]
cs)
      [Text]
rs
  )

-- | Create a hud that has time as the x-axis, based on supplied days, and a rounded yaxis.
tsAxes :: [UTCTime] -> [AxisOptions]
tsAxes :: [UTCTime] -> [AxisOptions]
tsAxes [UTCTime]
ds =
  [ AxisOptions
defaultAxisOptions
      AxisOptions -> (AxisOptions -> AxisOptions) -> AxisOptions
forall a b. a -> (a -> b) -> b
& IsLabel
  "axisTick"
  ((Tick -> Identity Tick) -> AxisOptions -> Identity AxisOptions)
(Tick -> Identity Tick) -> AxisOptions -> Identity AxisOptions
#axisTick ((Tick -> Identity Tick) -> AxisOptions -> Identity AxisOptions)
-> ((TickStyle -> Identity TickStyle) -> Tick -> Identity Tick)
-> (TickStyle -> Identity TickStyle)
-> AxisOptions
-> Identity AxisOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
  "tstyle"
  ((TickStyle -> Identity TickStyle) -> Tick -> Identity Tick)
(TickStyle -> Identity TickStyle) -> Tick -> Identity Tick
#tstyle ((TickStyle -> Identity TickStyle)
 -> AxisOptions -> Identity AxisOptions)
-> TickStyle -> AxisOptions -> AxisOptions
forall s t a b. ASetter s t a b -> b -> s -> t
.~ FormatN -> Int -> TickExtend -> TickStyle
TickRound (Maybe Int -> FormatN
FormatPrec (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
3)) Int
6 TickExtend
TickExtend
      AxisOptions -> (AxisOptions -> AxisOptions) -> AxisOptions
forall a b. a -> (a -> b) -> b
& IsLabel "place" (ASetter AxisOptions AxisOptions Place Place)
ASetter AxisOptions AxisOptions Place Place
#place ASetter AxisOptions AxisOptions Place Place
-> Place -> AxisOptions -> AxisOptions
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Place
PlaceLeft,
    AxisOptions
defaultAxisOptions AxisOptions -> (AxisOptions -> AxisOptions) -> AxisOptions
forall a b. a -> (a -> b) -> b
& IsLabel
  "axisTick"
  ((Tick -> Identity Tick) -> AxisOptions -> Identity AxisOptions)
(Tick -> Identity Tick) -> AxisOptions -> Identity AxisOptions
#axisTick ((Tick -> Identity Tick) -> AxisOptions -> Identity AxisOptions)
-> ((TickStyle -> Identity TickStyle) -> Tick -> Identity Tick)
-> (TickStyle -> Identity TickStyle)
-> AxisOptions
-> Identity AxisOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
  "tstyle"
  ((TickStyle -> Identity TickStyle) -> Tick -> Identity Tick)
(TickStyle -> Identity TickStyle) -> Tick -> Identity Tick
#tstyle
      ((TickStyle -> Identity TickStyle)
 -> AxisOptions -> Identity AxisOptions)
-> TickStyle -> AxisOptions -> AxisOptions
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [(Double, Text)] -> TickStyle
TickPlaced
        ( (Int -> Double) -> (Int, Text) -> (Double, Text)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral
            ((Int, Text) -> (Double, Text))
-> [(Int, Text)] -> [(Double, Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PosDiscontinuous -> Maybe Text -> Int -> [UTCTime] -> [(Int, Text)]
makeTickDates PosDiscontinuous
PosIncludeBoundaries Maybe Text
forall a. Maybe a
Nothing Int
8 [UTCTime]
ds
        )
  ]

-- | common pattern of chart title, x-axis title and y-axis title
titlesHud :: Text -> Text -> Text -> HudOptions
titlesHud :: Text -> Text -> Text -> HudOptions
titlesHud Text
t Text
x Text
y =
  HudOptions
defaultHudOptions
    HudOptions -> (HudOptions -> HudOptions) -> HudOptions
forall a b. a -> (a -> b) -> b
& IsLabel "hudTitles" (ASetter HudOptions HudOptions [Title] [Title])
ASetter HudOptions HudOptions [Title] [Title]
#hudTitles
    ASetter HudOptions HudOptions [Title] [Title]
-> [Title] -> HudOptions -> HudOptions
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [ Text -> Title
defaultTitle Text
t,
         Text -> Title
defaultTitle Text
x Title -> (Title -> Title) -> Title
forall a b. a -> (a -> b) -> b
& IsLabel "place" (ASetter Title Title Place Place)
ASetter Title Title Place Place
#place ASetter Title Title Place Place -> Place -> Title -> Title
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Place
PlaceBottom Title -> (Title -> Title) -> Title
forall a b. a -> (a -> b) -> b
& IsLabel
  "style"
  ((TextStyle -> Identity TextStyle) -> Title -> Identity Title)
(TextStyle -> Identity TextStyle) -> Title -> Identity Title
#style ((TextStyle -> Identity TextStyle) -> Title -> Identity Title)
-> ((Double -> Identity Double) -> TextStyle -> Identity TextStyle)
-> (Double -> Identity Double)
-> Title
-> Identity Title
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
  "size"
  ((Double -> Identity Double) -> TextStyle -> Identity TextStyle)
(Double -> Identity Double) -> TextStyle -> Identity TextStyle
#size ((Double -> Identity Double) -> Title -> Identity Title)
-> Double -> Title -> Title
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Double
0.08,
         Text -> Title
defaultTitle Text
y Title -> (Title -> Title) -> Title
forall a b. a -> (a -> b) -> b
& IsLabel "place" (ASetter Title Title Place Place)
ASetter Title Title Place Place
#place ASetter Title Title Place Place -> Place -> Title -> Title
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Place
PlaceLeft Title -> (Title -> Title) -> Title
forall a b. a -> (a -> b) -> b
& IsLabel
  "style"
  ((TextStyle -> Identity TextStyle) -> Title -> Identity Title)
(TextStyle -> Identity TextStyle) -> Title -> Identity Title
#style ((TextStyle -> Identity TextStyle) -> Title -> Identity Title)
-> ((Double -> Identity Double) -> TextStyle -> Identity TextStyle)
-> (Double -> Identity Double)
-> Title
-> Identity Title
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
  "size"
  ((Double -> Identity Double) -> TextStyle -> Identity TextStyle)
(Double -> Identity Double) -> TextStyle -> Identity TextStyle
#size ((Double -> Identity Double) -> Title -> Identity Title)
-> Double -> Title -> Title
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Double
0.08
       ]

-- | GlyphStyle palette
gpaletteStyle :: Double -> [GlyphStyle]
gpaletteStyle :: Double -> [GlyphStyle]
gpaletteStyle Double
s = (Colour -> (GlyphShape, Double) -> GlyphStyle)
-> [Colour] -> [(GlyphShape, Double)] -> [GlyphStyle]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Colour
c (GlyphShape, Double)
g -> GlyphStyle
defaultGlyphStyle GlyphStyle -> (GlyphStyle -> GlyphStyle) -> GlyphStyle
forall a b. a -> (a -> b) -> b
& IsLabel "size" (ASetter GlyphStyle GlyphStyle Double Double)
ASetter GlyphStyle GlyphStyle Double Double
#size ASetter GlyphStyle GlyphStyle Double Double
-> Double -> GlyphStyle -> GlyphStyle
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Double
s GlyphStyle -> (GlyphStyle -> GlyphStyle) -> GlyphStyle
forall a b. a -> (a -> b) -> b
& IsLabel "color" (ASetter GlyphStyle GlyphStyle Colour Colour)
ASetter GlyphStyle GlyphStyle Colour Colour
#color ASetter GlyphStyle GlyphStyle Colour Colour
-> Colour -> GlyphStyle -> GlyphStyle
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Colour
c GlyphStyle -> (GlyphStyle -> GlyphStyle) -> GlyphStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "shape" (ASetter GlyphStyle GlyphStyle GlyphShape GlyphShape)
ASetter GlyphStyle GlyphStyle GlyphShape GlyphShape
#shape ASetter GlyphStyle GlyphStyle GlyphShape GlyphShape
-> GlyphShape -> GlyphStyle -> GlyphStyle
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (GlyphShape, Double) -> GlyphShape
forall a b. (a, b) -> a
fst (GlyphShape, Double)
g GlyphStyle -> (GlyphStyle -> GlyphStyle) -> GlyphStyle
forall a b. a -> (a -> b) -> b
& IsLabel "borderSize" (ASetter GlyphStyle GlyphStyle Double Double)
ASetter GlyphStyle GlyphStyle Double Double
#borderSize ASetter GlyphStyle GlyphStyle Double Double
-> Double -> GlyphStyle -> GlyphStyle
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (GlyphShape, Double) -> Double
forall a b. (a, b) -> b
snd (GlyphShape, Double)
g) [Colour]
palette1_ [(GlyphShape, Double)]
gpalette

-- | Glyph palette
gpalette :: [(GlyphShape, Double)]
gpalette :: [(GlyphShape, Double)]
gpalette =
  [ (GlyphShape
CircleGlyph, Double
0.01 :: Double),
    (GlyphShape
SquareGlyph, Double
0.01),
    (Double -> GlyphShape
RectSharpGlyph Double
0.75, Double
0.01),
    (Double -> Double -> Double -> GlyphShape
RectRoundedGlyph Double
0.75 Double
0.01 Double
0.01, Double
0.01),
    (Double -> GlyphShape
EllipseGlyph Double
0.75, Double
0),
    (Double -> GlyphShape
VLineGlyph Double
0.005, Double
0.01),
    (Double -> GlyphShape
HLineGlyph Double
0.005, Double
0.01),
    (Point Double -> Point Double -> Point Double -> GlyphShape
TriangleGlyph (Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
0.0 Double
0.0) (Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
1 Double
1) (Double -> Double -> Point Double
forall a. a -> a -> Point a
Point Double
1 Double
0), Double
0.01),
    (Text -> GlyphShape
PathGlyph Text
"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", Double
0.01)
  ]

-- * charts

-- | Chart template for quantiles.
quantileChart ::
  Text ->
  [Text] ->
  [LineStyle] ->
  [AxisOptions] ->
  [[Double]] ->
  ChartSvg
quantileChart :: Text
-> [Text] -> [LineStyle] -> [AxisOptions] -> [[Double]] -> ChartSvg
quantileChart Text
title [Text]
names [LineStyle]
ls [AxisOptions]
as [[Double]]
xs =
  ChartSvg
forall a. Monoid a => a
mempty ChartSvg -> (ChartSvg -> ChartSvg) -> ChartSvg
forall a b. a -> (a -> b) -> b
& IsLabel
  "hudOptions" (ASetter ChartSvg ChartSvg HudOptions HudOptions)
ASetter ChartSvg ChartSvg HudOptions HudOptions
#hudOptions ASetter ChartSvg ChartSvg HudOptions HudOptions
-> HudOptions -> ChartSvg -> ChartSvg
forall s t a b. ASetter s t a b -> b -> s -> t
.~ HudOptions
hudOptions ChartSvg -> (ChartSvg -> ChartSvg) -> ChartSvg
forall a b. a -> (a -> b) -> b
& IsLabel
  "chartList"
  (ASetter ChartSvg ChartSvg [Chart Double] [Chart Double])
ASetter ChartSvg ChartSvg [Chart Double] [Chart Double]
#chartList ASetter ChartSvg ChartSvg [Chart Double] [Chart Double]
-> [Chart Double] -> ChartSvg -> ChartSvg
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Chart Double]
chart'
  where
    hudOptions :: HudOptions
hudOptions =
      HudOptions
defaultHudOptions
        HudOptions -> (HudOptions -> HudOptions) -> HudOptions
forall a b. a -> (a -> b) -> b
& IsLabel "hudTitles" (ASetter HudOptions HudOptions [Title] [Title])
ASetter HudOptions HudOptions [Title] [Title]
#hudTitles ASetter HudOptions HudOptions [Title] [Title]
-> [Title] -> HudOptions -> HudOptions
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Text -> Title
defaultTitle Text
title]
        HudOptions -> (HudOptions -> HudOptions) -> HudOptions
forall a b. a -> (a -> b) -> b
& ( IsLabel
  "hudLegend"
  (ASetter
     HudOptions
     HudOptions
     (Maybe (LegendOptions, [(Annotation, Text)]))
     (Maybe (LegendOptions, [(Annotation, Text)])))
ASetter
  HudOptions
  HudOptions
  (Maybe (LegendOptions, [(Annotation, Text)]))
  (Maybe (LegendOptions, [(Annotation, Text)]))
#hudLegend
              ASetter
  HudOptions
  HudOptions
  (Maybe (LegendOptions, [(Annotation, Text)]))
  (Maybe (LegendOptions, [(Annotation, Text)]))
-> Maybe (LegendOptions, [(Annotation, Text)])
-> HudOptions
-> HudOptions
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (LegendOptions, [(Annotation, Text)])
-> Maybe (LegendOptions, [(Annotation, Text)])
forall a. a -> Maybe a
Just
                ( LegendOptions
defaultLegendOptions
                    LegendOptions -> (LegendOptions -> LegendOptions) -> LegendOptions
forall a b. a -> (a -> b) -> b
& IsLabel
  "ltext"
  ((TextStyle -> Identity TextStyle)
   -> LegendOptions -> Identity LegendOptions)
(TextStyle -> Identity TextStyle)
-> LegendOptions -> Identity LegendOptions
#ltext ((TextStyle -> Identity TextStyle)
 -> LegendOptions -> Identity LegendOptions)
-> ((Double -> Identity Double) -> TextStyle -> Identity TextStyle)
-> (Double -> Identity Double)
-> LegendOptions
-> Identity LegendOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
  "size"
  ((Double -> Identity Double) -> TextStyle -> Identity TextStyle)
(Double -> Identity Double) -> TextStyle -> Identity TextStyle
#size ((Double -> Identity Double)
 -> LegendOptions -> Identity LegendOptions)
-> Double -> LegendOptions -> LegendOptions
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Double
0.1
                    LegendOptions -> (LegendOptions -> LegendOptions) -> LegendOptions
forall a b. a -> (a -> b) -> b
& IsLabel
  "vgap"
  ((Double -> Identity Double)
   -> LegendOptions -> Identity LegendOptions)
(Double -> Identity Double)
-> LegendOptions -> Identity LegendOptions
#vgap ((Double -> Identity Double)
 -> LegendOptions -> Identity LegendOptions)
-> Double -> LegendOptions -> LegendOptions
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Double
0.05
                    LegendOptions -> (LegendOptions -> LegendOptions) -> LegendOptions
forall a b. a -> (a -> b) -> b
& IsLabel
  "innerPad"
  ((Double -> Identity Double)
   -> LegendOptions -> Identity LegendOptions)
(Double -> Identity Double)
-> LegendOptions -> Identity LegendOptions
#innerPad ((Double -> Identity Double)
 -> LegendOptions -> Identity LegendOptions)
-> Double -> LegendOptions -> LegendOptions
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Double
0.2
                    LegendOptions -> (LegendOptions -> LegendOptions) -> LegendOptions
forall a b. a -> (a -> b) -> b
& IsLabel "lplace" (ASetter LegendOptions LegendOptions Place Place)
ASetter LegendOptions LegendOptions Place Place
#lplace ASetter LegendOptions LegendOptions Place Place
-> Place -> LegendOptions -> LegendOptions
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Place
PlaceRight,
                  [Text] -> [Chart Double] -> [(Annotation, Text)]
forall b. [b] -> [Chart Double] -> [(Annotation, b)]
extractAnns [Text]
names [Chart Double]
chart'
                )
          )
        HudOptions -> (HudOptions -> HudOptions) -> HudOptions
forall a b. a -> (a -> b) -> b
& IsLabel
  "hudAxes"
  (ASetter HudOptions HudOptions [AxisOptions] [AxisOptions])
ASetter HudOptions HudOptions [AxisOptions] [AxisOptions]
#hudAxes ASetter HudOptions HudOptions [AxisOptions] [AxisOptions]
-> [AxisOptions] -> HudOptions -> HudOptions
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [AxisOptions]
as
    extractAnns :: [b] -> [Chart Double] -> [(Annotation, b)]
extractAnns = (b -> Chart Double -> (Annotation, b))
-> [b] -> [Chart Double] -> [(Annotation, b)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\b
t Chart Double
c -> (Chart Double
c Chart Double
-> Getting Annotation (Chart Double) Annotation -> Annotation
forall s a. s -> Getting a s a -> a
^. IsLabel "annotation" (Getting Annotation (Chart Double) Annotation)
Getting Annotation (Chart Double) Annotation
#annotation, b
t))

    chart' :: [Chart Double]
chart' =
      (LineStyle -> [XY Double] -> Chart Double)
-> [LineStyle] -> [[XY Double]] -> [Chart Double]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
        (\LineStyle
l [XY Double]
c -> Annotation -> [XY Double] -> Chart Double
forall a. Annotation -> [XY a] -> Chart a
Chart (LineStyle -> Annotation
LineA LineStyle
l) [XY Double]
c)
        [LineStyle]
ls
        ((Double -> Double -> XY Double)
-> [Double] -> [Double] -> [XY Double]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Double -> Double -> XY Double
forall a. a -> a -> XY a
P [Double
0 ..] ([Double] -> [XY Double]) -> [[Double]] -> [[XY Double]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Double]]
xs)

-- | /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 = (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
blend 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 :: [LineStyle]
lo = (\Colour
c -> LineStyle
defaultLineStyle LineStyle -> (LineStyle -> LineStyle) -> LineStyle
forall a b. a -> (a -> b) -> b
& IsLabel "width" (ASetter LineStyle LineStyle Double Double)
ASetter LineStyle LineStyle Double Double
#width ASetter LineStyle LineStyle Double Double
-> Double -> LineStyle -> LineStyle
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Double
w LineStyle -> (LineStyle -> LineStyle) -> LineStyle
forall a b. a -> (a -> b) -> b
& IsLabel "color" (ASetter LineStyle LineStyle Colour Colour)
ASetter LineStyle LineStyle Colour Colour
#color ASetter LineStyle LineStyle Colour Colour
-> Colour -> LineStyle -> LineStyle
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Colour
c) (Colour -> LineStyle) -> [Colour] -> [LineStyle]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Colour]
bs

-- | No idea what this is really.
digitChart ::
  Text ->
  [UTCTime] ->
  [Double] ->
  ChartSvg
digitChart :: Text -> [UTCTime] -> [Double] -> ChartSvg
digitChart Text
title [UTCTime]
utcs [Double]
xs =
  ChartSvg
forall a. Monoid a => a
mempty ChartSvg -> (ChartSvg -> ChartSvg) -> ChartSvg
forall a b. a -> (a -> b) -> b
& IsLabel
  "hudOptions" (ASetter ChartSvg ChartSvg HudOptions HudOptions)
ASetter ChartSvg ChartSvg HudOptions HudOptions
#hudOptions ASetter ChartSvg ChartSvg HudOptions HudOptions
-> HudOptions -> ChartSvg -> ChartSvg
forall s t a b. ASetter s t a b -> b -> s -> t
.~ HudOptions
hudOptions ChartSvg -> (ChartSvg -> ChartSvg) -> ChartSvg
forall a b. a -> (a -> b) -> b
& IsLabel
  "chartList"
  (ASetter ChartSvg ChartSvg [Chart Double] [Chart Double])
ASetter ChartSvg ChartSvg [Chart Double] [Chart Double]
#chartList ASetter ChartSvg ChartSvg [Chart Double] [Chart Double]
-> [Chart Double] -> ChartSvg -> ChartSvg
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Chart Double
c]
  where
    hudOptions :: HudOptions
hudOptions =
      HudOptions
defaultHudOptions
        HudOptions -> (HudOptions -> HudOptions) -> HudOptions
forall a b. a -> (a -> b) -> b
& IsLabel "hudTitles" (ASetter HudOptions HudOptions [Title] [Title])
ASetter HudOptions HudOptions [Title] [Title]
#hudTitles ASetter HudOptions HudOptions [Title] [Title]
-> [Title] -> HudOptions -> HudOptions
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Text -> Title
defaultTitle Text
title]
        HudOptions -> (HudOptions -> HudOptions) -> HudOptions
forall a b. a -> (a -> b) -> b
& IsLabel
  "hudAxes"
  (ASetter HudOptions HudOptions [AxisOptions] [AxisOptions])
ASetter HudOptions HudOptions [AxisOptions] [AxisOptions]
#hudAxes ASetter HudOptions HudOptions [AxisOptions] [AxisOptions]
-> [AxisOptions] -> HudOptions -> HudOptions
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [UTCTime] -> [AxisOptions]
tsAxes [UTCTime]
utcs
    c :: Chart Double
c =
      Annotation -> [XY Double] -> Chart Double
forall a. Annotation -> [XY a] -> Chart a
Chart
        ( GlyphStyle -> Annotation
GlyphA
            ( GlyphStyle
defaultGlyphStyle
                GlyphStyle -> (GlyphStyle -> GlyphStyle) -> GlyphStyle
forall a b. a -> (a -> b) -> b
& IsLabel "color" (ASetter GlyphStyle GlyphStyle Colour Colour)
ASetter GlyphStyle GlyphStyle Colour Colour
#color ASetter GlyphStyle GlyphStyle Colour Colour
-> Colour -> GlyphStyle -> GlyphStyle
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Double -> Double -> Double -> Double -> Colour
Colour Double
0 Double
0 Double
1 Double
1
                GlyphStyle -> (GlyphStyle -> GlyphStyle) -> GlyphStyle
forall a b. a -> (a -> b) -> b
& IsLabel
  "shape" (ASetter GlyphStyle GlyphStyle GlyphShape GlyphShape)
ASetter GlyphStyle GlyphStyle GlyphShape GlyphShape
#shape ASetter GlyphStyle GlyphStyle GlyphShape GlyphShape
-> GlyphShape -> GlyphStyle -> GlyphStyle
forall s t a b. ASetter s t a b -> b -> s -> t
.~ GlyphShape
CircleGlyph
                GlyphStyle -> (GlyphStyle -> GlyphStyle) -> GlyphStyle
forall a b. a -> (a -> b) -> b
& IsLabel "size" (ASetter GlyphStyle GlyphStyle Double Double)
ASetter GlyphStyle GlyphStyle Double Double
#size ASetter GlyphStyle GlyphStyle Double Double
-> Double -> GlyphStyle -> GlyphStyle
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Double
0.01
            )
        )
        ([Double] -> [XY Double]
xify' [Double]
xs)

-- | scatter chart
scatterChart ::
  [[Point Double]] ->
  [Chart Double]
scatterChart :: [[Point Double]] -> [Chart Double]
scatterChart [[Point Double]]
xss = (GlyphStyle -> [Point Double] -> Chart Double)
-> [GlyphStyle] -> [[Point Double]] -> [Chart Double]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\GlyphStyle
gs [Point Double]
xs -> Annotation -> [XY Double] -> Chart Double
forall a. Annotation -> [XY a] -> Chart a
Chart (GlyphStyle -> Annotation
GlyphA GlyphStyle
gs) (Point Double -> XY Double
forall a. Point a -> XY a
PointXY (Point Double -> XY Double) -> [Point Double] -> [XY Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Point Double]
xs)) (Double -> [GlyphStyle]
gpaletteStyle Double
0.02) [[Point Double]]
xss

-- | histogram chart
histChart ::
  Text ->
  Maybe [Text] ->
  Range Double ->
  Int ->
  [Double] ->
  ChartSvg
histChart :: Text -> Maybe [Text] -> Range Double -> Int -> [Double] -> ChartSvg
histChart Text
title Maybe [Text]
names Range Double
r Int
g [Double]
xs =
  BarOptions -> BarData -> ChartSvg
barChart BarOptions
defaultBarOptions BarData
barData
    ChartSvg -> (ChartSvg -> ChartSvg) -> ChartSvg
forall a b. a -> (a -> b) -> b
& (IsLabel
  "hudOptions" (ASetter ChartSvg ChartSvg HudOptions HudOptions)
ASetter ChartSvg ChartSvg HudOptions HudOptions
#hudOptions ASetter ChartSvg ChartSvg HudOptions HudOptions
-> ASetter HudOptions HudOptions [Title] [Title]
-> ([Title] -> Identity [Title])
-> ChartSvg
-> Identity ChartSvg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel "hudTitles" (ASetter HudOptions HudOptions [Title] [Title])
ASetter HudOptions HudOptions [Title] [Title]
#hudTitles (([Title] -> Identity [Title]) -> ChartSvg -> Identity ChartSvg)
-> [Title] -> ChartSvg -> ChartSvg
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Text -> Title
defaultTitle Text
title])
  where
    barData :: BarData
barData = [[Double]] -> Maybe [Text] -> Maybe [Text] -> BarData
BarData [[Double]
hr] Maybe [Text]
names Maybe [Text]
forall a. Maybe a
Nothing
    hcuts :: [Element (Range Double)]
hcuts = Pos
-> Range Double -> Grid (Range Double) -> [Element (Range Double)]
forall s. FieldSpace s => Pos -> s -> Grid s -> [Element s]
grid Pos
OuterPos Range Double
r Int
Grid (Range Double)
g
    h :: Histogram
h = [Double] -> [Double] -> Histogram
forall (f :: * -> *).
Foldable f =>
[Double] -> f Double -> Histogram
fill [Double]
hcuts [Double]
xs
    hr :: [Double]
hr =
      (\(Rect Double
x Double
x' Double
_ Double
_) -> (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
x') Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2)
        (Rect Double -> Double) -> [Rect Double] -> [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DealOvers -> Histogram -> [Rect Double]
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

-- | a chart drawing a histogram based on quantile information
quantileHistChart ::
  Text ->
  Maybe [Text] ->
  -- | quantiles
  [Double] ->
  -- | quantile values
  [Double] ->
  ChartSvg
quantileHistChart :: Text -> Maybe [Text] -> [Double] -> [Double] -> ChartSvg
quantileHistChart Text
title Maybe [Text]
names [Double]
qs [Double]
vs =
  ChartSvg
forall a. Monoid a => a
mempty ChartSvg -> (ChartSvg -> ChartSvg) -> ChartSvg
forall a b. a -> (a -> b) -> b
& IsLabel
  "hudOptions" (ASetter ChartSvg ChartSvg HudOptions HudOptions)
ASetter ChartSvg ChartSvg HudOptions HudOptions
#hudOptions ASetter ChartSvg ChartSvg HudOptions HudOptions
-> HudOptions -> ChartSvg -> ChartSvg
forall s t a b. ASetter s t a b -> b -> s -> t
.~ HudOptions
hudOptions ChartSvg -> (ChartSvg -> ChartSvg) -> ChartSvg
forall a b. a -> (a -> b) -> b
& IsLabel
  "chartList"
  (ASetter ChartSvg ChartSvg [Chart Double] [Chart Double])
ASetter ChartSvg ChartSvg [Chart Double] [Chart Double]
#chartList ASetter ChartSvg ChartSvg [Chart Double] [Chart Double]
-> [Chart Double] -> ChartSvg -> ChartSvg
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Chart Double
chart']
  where
    hudOptions :: HudOptions
hudOptions =
      HudOptions
defaultHudOptions
        HudOptions -> (HudOptions -> HudOptions) -> HudOptions
forall a b. a -> (a -> b) -> b
& IsLabel "hudTitles" (ASetter HudOptions HudOptions [Title] [Title])
ASetter HudOptions HudOptions [Title] [Title]
#hudTitles
        ASetter HudOptions HudOptions [Title] [Title]
-> [Title] -> HudOptions -> HudOptions
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Text -> Title
defaultTitle Text
title]
        HudOptions -> (HudOptions -> HudOptions) -> HudOptions
forall a b. a -> (a -> b) -> b
& IsLabel
  "hudAxes"
  (ASetter HudOptions HudOptions [AxisOptions] [AxisOptions])
ASetter HudOptions HudOptions [AxisOptions] [AxisOptions]
#hudAxes
        ASetter HudOptions HudOptions [AxisOptions] [AxisOptions]
-> [AxisOptions] -> HudOptions -> HudOptions
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [ AxisOptions
-> ([Text] -> AxisOptions) -> Maybe [Text] -> AxisOptions
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
               ( AxisOptions
defaultAxisOptions AxisOptions -> (AxisOptions -> AxisOptions) -> AxisOptions
forall a b. a -> (a -> b) -> b
& IsLabel
  "axisTick"
  ((Tick -> Identity Tick) -> AxisOptions -> Identity AxisOptions)
(Tick -> Identity Tick) -> AxisOptions -> Identity AxisOptions
#axisTick ((Tick -> Identity Tick) -> AxisOptions -> Identity AxisOptions)
-> ((TickStyle -> Identity TickStyle) -> Tick -> Identity Tick)
-> (TickStyle -> Identity TickStyle)
-> AxisOptions
-> Identity AxisOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
  "tstyle"
  ((TickStyle -> Identity TickStyle) -> Tick -> Identity Tick)
(TickStyle -> Identity TickStyle) -> Tick -> Identity Tick
#tstyle
                   ((TickStyle -> Identity TickStyle)
 -> AxisOptions -> Identity AxisOptions)
-> TickStyle -> AxisOptions -> AxisOptions
forall s t a b. ASetter s t a b -> b -> s -> t
.~ FormatN -> Int -> TickExtend -> TickStyle
TickRound (Maybe Int -> FormatN
FormatPrec (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
3)) Int
8 TickExtend
TickExtend
               )
               ( \[Text]
x ->
                   AxisOptions
defaultAxisOptions AxisOptions -> (AxisOptions -> AxisOptions) -> AxisOptions
forall a b. a -> (a -> b) -> b
& IsLabel
  "axisTick"
  ((Tick -> Identity Tick) -> AxisOptions -> Identity AxisOptions)
(Tick -> Identity Tick) -> AxisOptions -> Identity AxisOptions
#axisTick ((Tick -> Identity Tick) -> AxisOptions -> Identity AxisOptions)
-> ((TickStyle -> Identity TickStyle) -> Tick -> Identity Tick)
-> (TickStyle -> Identity TickStyle)
-> AxisOptions
-> Identity AxisOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
  "tstyle"
  ((TickStyle -> Identity TickStyle) -> Tick -> Identity Tick)
(TickStyle -> Identity TickStyle) -> Tick -> Identity Tick
#tstyle
                     ((TickStyle -> Identity TickStyle)
 -> AxisOptions -> Identity AxisOptions)
-> TickStyle -> AxisOptions -> AxisOptions
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [(Double, Text)] -> TickStyle
TickPlaced ([Double] -> [Text] -> [(Double, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Double]
vs [Text]
x)
               )
               Maybe [Text]
names
           ]
    chart' :: Chart Double
chart' = Annotation -> [XY Double] -> Chart Double
forall a. Annotation -> [XY a] -> Chart a
Chart (RectStyle -> Annotation
RectA RectStyle
defaultRectStyle) (Rect Double -> XY Double
forall a. Rect a -> XY a
RectXY (Rect Double -> XY Double) -> [Rect Double] -> [XY Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Rect Double]
hr)
    hr :: [Rect Double]
hr =
      ((Double, Double) -> (Double, Double) -> Rect Double)
-> [(Double, Double)] -> [(Double, Double)] -> [Rect Double]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
        (\(Double
y, Double
w) (Double
x, Double
z) -> Double -> Double -> Double -> Double -> Rect Double
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))

-- | pixel chart of digitized vs digitized counts
digitSurfaceChart ::
  SurfaceStyle ->
  SurfaceLegendOptions ->
  (Text, Text, Text) ->
  [Text] ->
  [(Int, Int)] ->
  [Chart Double]
digitSurfaceChart :: SurfaceStyle
-> SurfaceLegendOptions
-> (Text, Text, Text)
-> [Text]
-> [(Int, Int)]
-> [Chart Double]
digitSurfaceChart SurfaceStyle
pixelStyle SurfaceLegendOptions
plo (Text, Text, Text)
ts [Text]
names [(Int, Int)]
ps =
  Rect Double -> [Hud Double] -> [Chart Double] -> [Chart Double]
runHud (Double -> Rect Double
aspect Double
1) ([Hud Double]
hs0 [Hud Double] -> [Hud Double] -> [Hud Double]
forall a. Semigroup a => a -> a -> a
<> [Hud Double]
hs1) ([Chart Double]
cs0 [Chart Double] -> [Chart Double] -> [Chart Double]
forall a. Semigroup a => a -> a -> a
<> [Chart Double]
cs1)
  where
    l :: Int
l = [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
names
    pts :: Point Int
pts = Int -> Int -> Point Int
forall a. a -> a -> Point a
Point Int
l Int
l
    gr :: Rect Double
    gr :: Rect Double
gr = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Double) -> Rect Int -> Rect Double
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 :: HashMap (Int, Int) Double
mapCount = (HashMap (Int, Int) Double
 -> (Int, Int) -> HashMap (Int, Int) Double)
-> HashMap (Int, Int) Double
-> [(Int, Int)]
-> HashMap (Int, Int) Double
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\HashMap (Int, Int) Double
m (Int, Int)
x -> (Double -> Double -> Double)
-> (Int, Int)
-> Double
-> HashMap (Int, Int) Double
-> HashMap (Int, Int) Double
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> k -> v -> HashMap k v -> HashMap k v
HashMap.insertWith Double -> Double -> Double
forall a. Num a => a -> a -> a
(+) (Int, Int)
x Double
1.0 HashMap (Int, Int) Double
m) HashMap (Int, Int) Double
forall k v. HashMap k v
HashMap.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) -> HashMap (Int, Int) Double -> Maybe Double
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup (Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor Double
x, Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor Double
y) HashMap (Int, Int) Double
mapCount
    ([Hud Double]
hs0, [Chart Double]
cs0) = Rect Double -> HudOptions -> ([Hud Double], [Chart Double])
makeHud Rect Double
gr ((Text, Text, Text) -> [Text] -> HudOptions
qvqHud (Text, Text, Text)
ts [Text]
names)
    ([Chart Double]
cs1, [Hud Double]
hs1) =
      (Point Double -> Double)
-> SurfaceOptions
-> SurfaceLegendOptions
-> ([Chart Double], [Hud Double])
surfacefl
        Point Double -> Double
f
        (SurfaceStyle -> Point Int -> Rect Double -> SurfaceOptions
SurfaceOptions SurfaceStyle
pixelStyle Point Int
pts Rect Double
gr)
        SurfaceLegendOptions
plo

-- style helpers
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
& IsLabel "hudTitles" (ASetter HudOptions HudOptions [Title] [Title])
ASetter HudOptions HudOptions [Title] [Title]
#hudTitles ASetter HudOptions HudOptions [Title] [Title]
-> [Title] -> HudOptions -> HudOptions
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Text, Text, Text) -> [Title]
makeTitles (Text, Text, Text)
ts
    HudOptions -> (HudOptions -> HudOptions) -> HudOptions
forall a b. a -> (a -> b) -> b
& IsLabel
  "hudAxes"
  (ASetter HudOptions HudOptions [AxisOptions] [AxisOptions])
ASetter HudOptions HudOptions [AxisOptions] [AxisOptions]
#hudAxes
      ASetter HudOptions HudOptions [AxisOptions] [AxisOptions]
-> [AxisOptions] -> HudOptions -> HudOptions
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [ AxisOptions
defaultAxisOptions
             AxisOptions -> (AxisOptions -> AxisOptions) -> AxisOptions
forall a b. a -> (a -> b) -> b
& IsLabel
  "axisTick"
  ((Tick -> Identity Tick) -> AxisOptions -> Identity AxisOptions)
(Tick -> Identity Tick) -> AxisOptions -> Identity AxisOptions
#axisTick ((Tick -> Identity Tick) -> AxisOptions -> Identity AxisOptions)
-> ((TickStyle -> Identity TickStyle) -> Tick -> Identity Tick)
-> (TickStyle -> Identity TickStyle)
-> AxisOptions
-> Identity AxisOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
  "tstyle"
  ((TickStyle -> Identity TickStyle) -> Tick -> Identity Tick)
(TickStyle -> Identity TickStyle) -> Tick -> Identity Tick
#tstyle ((TickStyle -> Identity TickStyle)
 -> AxisOptions -> Identity AxisOptions)
-> TickStyle -> AxisOptions -> AxisOptions
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [(Double, Text)] -> TickStyle
TickPlaced ([Double] -> [Text] -> [(Double, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Double
0.5 Double -> Double -> Double
forall a. Num a => a -> a -> a
+) (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
& IsLabel "place" (ASetter AxisOptions AxisOptions Place Place)
ASetter AxisOptions AxisOptions Place Place
#place ASetter AxisOptions AxisOptions Place Place
-> Place -> AxisOptions -> AxisOptions
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Place
PlaceLeft,
           AxisOptions
defaultAxisOptions
             AxisOptions -> (AxisOptions -> AxisOptions) -> AxisOptions
forall a b. a -> (a -> b) -> b
& IsLabel
  "axisTick"
  ((Tick -> Identity Tick) -> AxisOptions -> Identity AxisOptions)
(Tick -> Identity Tick) -> AxisOptions -> Identity AxisOptions
#axisTick ((Tick -> Identity Tick) -> AxisOptions -> Identity AxisOptions)
-> ((TickStyle -> Identity TickStyle) -> Tick -> Identity Tick)
-> (TickStyle -> Identity TickStyle)
-> AxisOptions
-> Identity AxisOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
  "tstyle"
  ((TickStyle -> Identity TickStyle) -> Tick -> Identity Tick)
(TickStyle -> Identity TickStyle) -> Tick -> Identity Tick
#tstyle ((TickStyle -> Identity TickStyle)
 -> AxisOptions -> Identity AxisOptions)
-> TickStyle -> AxisOptions -> AxisOptions
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [(Double, Text)] -> TickStyle
TickPlaced ([Double] -> [Text] -> [(Double, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Double
0.5 Double -> Double -> Double
forall a. Num a => a -> a -> a
+) (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
& IsLabel "place" (ASetter AxisOptions AxisOptions Place Place)
ASetter AxisOptions AxisOptions Place Place
#place ASetter AxisOptions AxisOptions Place Place
-> Place -> AxisOptions -> AxisOptions
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Place
PlaceBottom
         ]

makeTitles :: (Text, Text, Text) -> [Title]
makeTitles :: (Text, Text, Text) -> [Title]
makeTitles (Text
t, Text
xt, Text
yt) =
  [Title] -> [Title]
forall a. [a] -> [a]
reverse
    [ Text -> Title
defaultTitle Text
t,
      Text -> Title
defaultTitle Text
xt Title -> (Title -> Title) -> Title
forall a b. a -> (a -> b) -> b
& IsLabel "place" (ASetter Title Title Place Place)
ASetter Title Title Place Place
#place ASetter Title Title Place Place -> Place -> Title -> Title
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Place
PlaceBottom Title -> (Title -> Title) -> Title
forall a b. a -> (a -> b) -> b
& IsLabel
  "style"
  ((TextStyle -> Identity TextStyle) -> Title -> Identity Title)
(TextStyle -> Identity TextStyle) -> Title -> Identity Title
#style ((TextStyle -> Identity TextStyle) -> Title -> Identity Title)
-> ((Double -> Identity Double) -> TextStyle -> Identity TextStyle)
-> (Double -> Identity Double)
-> Title
-> Identity Title
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
  "size"
  ((Double -> Identity Double) -> TextStyle -> Identity TextStyle)
(Double -> Identity Double) -> TextStyle -> Identity TextStyle
#size ((Double -> Identity Double) -> Title -> Identity Title)
-> Double -> Title -> Title
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Double
0.06,
      Text -> Title
defaultTitle Text
yt Title -> (Title -> Title) -> Title
forall a b. a -> (a -> b) -> b
& IsLabel "place" (ASetter Title Title Place Place)
ASetter Title Title Place Place
#place ASetter Title Title Place Place -> Place -> Title -> Title
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Place
PlaceLeft Title -> (Title -> Title) -> Title
forall a b. a -> (a -> b) -> b
& IsLabel
  "style"
  ((TextStyle -> Identity TextStyle) -> Title -> Identity Title)
(TextStyle -> Identity TextStyle) -> Title -> Identity Title
#style ((TextStyle -> Identity TextStyle) -> Title -> Identity Title)
-> ((Double -> Identity Double) -> TextStyle -> Identity TextStyle)
-> (Double -> Identity Double)
-> Title
-> Identity Title
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsLabel
  "size"
  ((Double -> Identity Double) -> TextStyle -> Identity TextStyle)
(Double -> Identity Double) -> TextStyle -> Identity TextStyle
#size ((Double -> Identity Double) -> Title -> Identity Title)
-> Double -> Title -> Title
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Double
0.06
    ]

-- | Chart for double list of Text.
tableChart :: [[Text]] -> [Chart Double]
tableChart :: [[Text]] -> [Chart Double]
tableChart [[Text]]
tss = ([Text] -> Double -> Chart Double)
-> [[Text]] -> [Double] -> [Chart Double]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\[Text]
ts Double
x -> Annotation -> [XY Double] -> Chart Double
forall a. Annotation -> [XY a] -> Chart a
Chart (TextStyle -> [Text] -> Annotation
TextA TextStyle
defaultTextStyle [Text]
ts) (Double -> Double -> XY Double
forall a. a -> a -> XY a
P Double
x (Double -> XY Double) -> [Double] -> [XY Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> [Double] -> [Double]
forall a. Int -> [a] -> [a]
take ([Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
ts) [Double
0 ..])) [[Text]]
tss [Double
0 ..]