{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Strict #-}

{- |
Module      : Granite.Svg
Copyright   : (c) 2025
License     : MIT
Maintainer  : mschavinda@gmail.com

SVG plotting backend that mirrors the API of "Granite". Each chart
function returns a self-contained SVG document as 'Text'.
-}
module Granite.Svg (
    Plot (..),
    defPlot,
    LegendPos (..),
    Color (..),
    AxisEnv (..),
    LabelFormatter,
    Bins (..),
    bins,
    series,
    scatter,
    lineGraph,
    bars,
    stackedBars,
    histogram,
    pie,
    heatmap,
    boxPlot,
    area,
    ribbon,
    density,
    errorBars,
    funnel,
    polarLine,
    waterfall,
    distPlot,
    gauss,
) where

import Data.List qualified as List
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import Data.Text qualified as T
import Granite (
    AxisEnv (..),
    Bins (..),
    Color (..),
    LabelFormatter,
    LegendPos (..),
    Plot (..),
    bins,
    defPlot,
    series,
 )
import Granite.Color (colorHex)
import Granite.Internal.LegacyChart qualified as LC
import Granite.Internal.Util (
    addAt,
    clamp,
    eps,
    maximum',
    minimum',
    normalize,
    quartiles,
    showD,
    ticks1D,
 )
import Granite.Render.Pipeline (renderChartSvg)
import Granite.Render.Svg (
    attr,
    svgCircle,
    svgDoc,
    svgLine,
    svgPath,
    svgPolyline,
    svgRect,
    svgText,
 )
import Numeric (showFFloat)

cW :: Double
cW :: Double
cW = Double
10

cH :: Double
cH :: Double
cH = Double
16

labelFontSize :: Double
labelFontSize :: Double
labelFontSize = Double
11

titleFontSize :: Double
titleFontSize :: Double
titleFontSize = Double
14

heatColors :: [Text]
heatColors :: [Text]
heatColors =
    [ Text
"#2980b9"
    , Text
"#3498db"
    , Text
"#16a085"
    , Text
"#1abc9c"
    , Text
"#27ae60"
    , Text
"#2ecc71"
    , Text
"#f1c40f"
    , Text
"#f39c12"
    , Text
"#9b59b6"
    , Text
"#e74c3c"
    , Text
"#c0392b"
    ]

boundsXY :: Plot -> [(Double, Double)] -> (Double, Double, Double, Double)
boundsXY :: Plot -> [(Double, Double)] -> (Double, Double, Double, Double)
boundsXY Plot
cfg [(Double, Double)]
pts =
    let ([Double]
xs, [Double]
ys) = [(Double, Double)] -> ([Double], [Double])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Double, Double)]
pts
        xmin :: Double
xmin = [Double] -> Double
minimum' [Double]
xs
        xmax :: Double
xmax = [Double] -> Double
maximum' [Double]
xs
        ymin :: Double
ymin = [Double] -> Double
minimum' [Double]
ys
        ymax :: Double
ymax = [Double] -> Double
maximum' [Double]
ys
        padx :: Double
padx = (Double
xmax Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
xmin) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
0.05 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
1e-9
        pady :: Double
pady = (Double
ymax Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
ymin) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
0.05 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
1e-9
     in ( Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe (Double
xmin Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
padx) ((Maybe Double, Maybe Double) -> Maybe Double
forall a b. (a, b) -> a
fst (Plot -> (Maybe Double, Maybe Double)
xBounds Plot
cfg))
        , Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe (Double
xmax Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
padx) ((Maybe Double, Maybe Double) -> Maybe Double
forall a b. (a, b) -> b
snd (Plot -> (Maybe Double, Maybe Double)
xBounds Plot
cfg))
        , Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe (Double
ymin Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
pady) ((Maybe Double, Maybe Double) -> Maybe Double
forall a b. (a, b) -> a
fst (Plot -> (Maybe Double, Maybe Double)
yBounds Plot
cfg))
        , Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe (Double
ymax Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
pady) ((Maybe Double, Maybe Double) -> Maybe Double
forall a b. (a, b) -> b
snd (Plot -> (Maybe Double, Maybe Double)
yBounds Plot
cfg))
        )

data Layout = Layout
    { Layout -> Double
svgW :: !Double
    , Layout -> Double
svgH :: !Double
    , Layout -> Double
plotX :: !Double
    , Layout -> Double
plotY :: !Double
    , Layout -> Double
plotW :: !Double
    , Layout -> Double
plotH :: !Double
    }

mkLayout :: Plot -> Layout
mkLayout :: Plot -> Layout
mkLayout Plot
cfg =
    let pw :: Double
pw = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Plot -> Int
widthChars Plot
cfg) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
cW
        ph :: Double
ph = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Plot -> Int
heightChars Plot
cfg) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
cH
        lm :: Double
lm = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Plot -> Int
leftMargin Plot
cfg) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
cW Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
10
        tm :: Double
tm =
            if Text -> Bool
T.null (Plot -> Text
plotTitle Plot
cfg)
                then Double
10
                else Double
titleFontSize Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
20
        bm :: Double
bm = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Plot -> Int
bottomMargin Plot
cfg) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
cH Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
10
        rm :: Double
rm = case Plot -> LegendPos
legendPos Plot
cfg of
            LegendPos
LegendRight -> Double
120
            LegendPos
_ -> Double
20
        lb :: Double
lb = case Plot -> LegendPos
legendPos Plot
cfg of
            LegendPos
LegendBottom -> Double
30
            LegendPos
_ -> Double
0
     in Layout
            { svgW :: Double
svgW = Double
lm Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
pw Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
rm
            , svgH :: Double
svgH = Double
tm Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
ph Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
bm Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
lb
            , plotX :: Double
plotX = Double
lm
            , plotY :: Double
plotY = Double
tm
            , plotW :: Double
plotW = Double
pw
            , plotH :: Double
plotH = Double
ph
            }

drawTitle :: Plot -> Layout -> Text
drawTitle :: Plot -> Layout -> Text
drawTitle Plot
cfg Layout
lay
    | Text -> Bool
T.null (Plot -> Text
plotTitle Plot
cfg) = Text
""
    | Bool
otherwise =
        Double -> Double -> Text -> Text -> Double -> Text -> Text
svgText
            (Layout -> Double
plotX Layout
lay Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Layout -> Double
plotW Layout
lay Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2)
            (Layout -> Double
plotY Layout
lay Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
8)
            Text
"middle"
            Text
"#222"
            Double
titleFontSize
            (Plot -> Text
plotTitle Plot
cfg)

drawAxes :: Plot -> Layout -> (Double, Double) -> (Double, Double) -> Text
drawAxes :: Plot -> Layout -> (Double, Double) -> (Double, Double) -> Text
drawAxes Plot
cfg Layout
lay (Double
xmin, Double
xmax) (Double
ymin, Double
ymax) =
    let px :: Double
px = Layout -> Double
plotX Layout
lay
        py :: Double
py = Layout -> Double
plotY Layout
lay
        pw :: Double
pw = Layout -> Double
plotW Layout
lay
        ph :: Double
ph = Layout -> Double
plotH Layout
lay

        xAxis :: Text
xAxis = Double -> Double -> Double -> Double -> Text -> Double -> Text
svgLine Double
px (Double
py Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
ph) (Double
px Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
pw) (Double
py Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
ph) Text
"#aaa" Double
1
        yAxis :: Text
yAxis = Double -> Double -> Double -> Double -> Text -> Double -> Text
svgLine Double
px Double
py Double
px (Double
py Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
ph) Text
"#aaa" Double
1

        yN :: Int
yN = Plot -> Int
yNumTicks Plot
cfg
        yTks :: [(Int, Double)]
yTks = Int -> Int -> (Double, Double) -> Bool -> [(Int, Double)]
ticks1D (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Double
ph) Int
yN (Double
ymin, Double
ymax) Bool
True
        ySlot :: Int
ySlot = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Plot -> Int
leftMargin Plot
cfg)
        yEnv :: Int -> AxisEnv
yEnv Int
i = (Double, Double) -> Int -> Int -> AxisEnv
AxisEnv (Double
ymin, Double
ymax) Int
i Int
yN
        yElems :: Text
yElems =
            [Text] -> Text
T.concat
                [ let frac :: Double
frac = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pos Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
1 (Double
ph Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
1)
                      yy :: Double
yy = Double
py Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
frac Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
ph
                      lbl :: Text
lbl = Plot -> LabelFormatter
yFormatter Plot
cfg (Int -> AxisEnv
yEnv Int
i) Int
ySlot Double
v
                   in Double -> Double -> Double -> Double -> Text -> Double -> Text
svgLine Double
px Double
yy (Double
px Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
4) Double
yy Text
"#aaa" Double
1
                        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Text -> Text -> Double -> Text -> Text
svgText (Double
px Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
8) (Double
yy Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
4) Text
"end" Text
"#555" Double
labelFontSize Text
lbl
                        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Double -> Double -> Text -> Double -> Text
svgLine Double
px Double
yy (Double
px Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
pw) Double
yy Text
"#eee" Double
0.5
                | (Int
i, (Int
pos, Double
v)) <- [Int] -> [(Int, Double)] -> [(Int, (Int, Double))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 ..] [(Int, Double)]
yTks
                ]

        xN :: Int
xN = Plot -> Int
xNumTicks Plot
cfg
        xTks :: [(Int, Double)]
xTks = Int -> Int -> (Double, Double) -> Bool -> [(Int, Double)]
ticks1D (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Double
pw) Int
xN (Double
xmin, Double
xmax) Bool
False
        xSlot :: Int
xSlot = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Double
pw Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 Int
xN)
        xEnv :: Int -> AxisEnv
xEnv Int
i = (Double, Double) -> Int -> Int -> AxisEnv
AxisEnv (Double
xmin, Double
xmax) Int
i Int
xN
        xElems :: Text
xElems =
            [Text] -> Text
T.concat
                [ let frac :: Double
frac = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pos Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
1 (Double
pw Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
1)
                      xx :: Double
xx = Double
px Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
frac Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
pw
                      lbl :: Text
lbl = Plot -> LabelFormatter
xFormatter Plot
cfg (Int -> AxisEnv
xEnv Int
i) Int
xSlot Double
v
                   in Double -> Double -> Double -> Double -> Text -> Double -> Text
svgLine Double
xx (Double
py Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
ph) Double
xx (Double
py Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
ph Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
4) Text
"#aaa" Double
1
                        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Text -> Text -> Double -> Text -> Text
svgText Double
xx (Double
py Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
ph Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
16) Text
"middle" Text
"#555" Double
labelFontSize Text
lbl
                        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Double -> Double -> Text -> Double -> Text
svgLine Double
xx Double
py Double
xx (Double
py Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
ph) Text
"#eee" Double
0.5
                | (Int
i, (Int
pos, Double
v)) <- [Int] -> [(Int, Double)] -> [(Int, (Int, Double))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 ..] [(Int, Double)]
xTks
                ]
     in Text
xAxis Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
yAxis Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
yElems Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
xElems

drawCatAxes :: Plot -> Layout -> (Double, Double) -> [Text] -> Text
drawCatAxes :: Plot -> Layout -> (Double, Double) -> [Text] -> Text
drawCatAxes Plot
cfg Layout
lay (Double
ymin, Double
ymax) [Text]
catNames =
    let px :: Double
px = Layout -> Double
plotX Layout
lay
        py :: Double
py = Layout -> Double
plotY Layout
lay
        pw :: Double
pw = Layout -> Double
plotW Layout
lay
        ph :: Double
ph = Layout -> Double
plotH Layout
lay

        xAxis :: Text
xAxis = Double -> Double -> Double -> Double -> Text -> Double -> Text
svgLine Double
px (Double
py Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
ph) (Double
px Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
pw) (Double
py Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
ph) Text
"#aaa" Double
1
        yAxis :: Text
yAxis = Double -> Double -> Double -> Double -> Text -> Double -> Text
svgLine Double
px Double
py Double
px (Double
py Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
ph) Text
"#aaa" Double
1

        yN :: Int
yN = Plot -> Int
yNumTicks Plot
cfg
        yTks :: [(Int, Double)]
yTks = Int -> Int -> (Double, Double) -> Bool -> [(Int, Double)]
ticks1D (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Double
ph) Int
yN (Double
ymin, Double
ymax) Bool
True
        ySlot :: Int
ySlot = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Plot -> Int
leftMargin Plot
cfg)
        yEnv :: Int -> AxisEnv
yEnv Int
i = (Double, Double) -> Int -> Int -> AxisEnv
AxisEnv (Double
ymin, Double
ymax) Int
i Int
yN
        yElems :: Text
yElems =
            [Text] -> Text
T.concat
                [ let frac :: Double
frac = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pos Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
1 (Double
ph Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
1)
                      yy :: Double
yy = Double
py Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
frac Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
ph
                      lbl :: Text
lbl = Plot -> LabelFormatter
yFormatter Plot
cfg (Int -> AxisEnv
yEnv Int
i) Int
ySlot Double
v
                   in Double -> Double -> Double -> Double -> Text -> Double -> Text
svgLine Double
px Double
yy (Double
px Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
4) Double
yy Text
"#aaa" Double
1
                        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Text -> Text -> Double -> Text -> Text
svgText (Double
px Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
8) (Double
yy Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
4) Text
"end" Text
"#555" Double
labelFontSize Text
lbl
                        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Double -> Double -> Text -> Double -> Text
svgLine Double
px Double
yy (Double
px Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
pw) Double
yy Text
"#eee" Double
0.5
                | (Int
i, (Int
pos, Double
v)) <- [Int] -> [(Int, Double)] -> [(Int, (Int, Double))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 ..] [(Int, Double)]
yTks
                ]

        n :: Int
n = [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
catNames
        catElems :: Text
catElems =
            [Text] -> Text
T.concat
                [ let xx :: Double
xx = Double
px Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
0.5) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
pw Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
                   in Double -> Double -> Text -> Text -> Double -> Text -> Text
svgText Double
xx (Double
py Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
ph Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
16) Text
"middle" Text
"#555" Double
labelFontSize Text
name
                | (Int
i, Text
name) <- [Int] -> [Text] -> [(Int, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 :: Int ..] [Text]
catNames
                ]
     in Text
xAxis Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
yAxis Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
yElems Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
catElems

drawLegend :: Plot -> Layout -> [(Text, Color)] -> Text
drawLegend :: Plot -> Layout -> [(Text, Color)] -> Text
drawLegend Plot
cfg Layout
lay [(Text, Color)]
entries = case Plot -> LegendPos
legendPos Plot
cfg of
    LegendPos
LegendNone -> Text
""
    LegendPos
LegendRight ->
        let lx :: Double
lx = Layout -> Double
plotX Layout
lay Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Layout -> Double
plotW Layout
lay Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
15
            ly :: Double
ly = Layout -> Double
plotY Layout
lay Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
5
         in [Text] -> Text
T.concat
                [ Double -> Double -> Double -> Double -> Text -> Text -> Text
svgRect Double
lx (Double
ly Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
20) Double
12 Double
12 (Color -> Text
colorHex Color
col) Text
""
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Text -> Text -> Double -> Text -> Text
svgText
                        (Double
lx Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
16)
                        (Double
ly Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
20 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
10)
                        Text
"start"
                        Text
"#555"
                        Double
labelFontSize
                        Text
name
                | (Int
i, (Text
name, Color
col)) <- [Int] -> [(Text, Color)] -> [(Int, (Text, Color))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 :: Int ..] [(Text, Color)]
entries
                ]
    LegendPos
LegendBottom ->
        let ly :: Double
ly = Layout -> Double
svgH Layout
lay Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
18
            totalW :: Double
totalW = [Double] -> Double
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Double
30 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Text -> Int
T.length Text
name) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
7 | (Text
name, Color
_) <- [(Text, Color)]
entries]
            startX :: Double
startX = Layout -> Double
plotX Layout
lay Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Layout -> Double
plotW Layout
lay Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
totalW) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2
         in (Double, Text) -> Text
forall a b. (a, b) -> b
snd ((Double, Text) -> Text) -> (Double, Text) -> Text
forall a b. (a -> b) -> a -> b
$
                ((Double, Text) -> (Text, Color) -> (Double, Text))
-> (Double, Text) -> [(Text, Color)] -> (Double, Text)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl'
                    ( \(Double
x, Text
acc) (Text
name, Color
col) ->
                        let elem' :: Text
elem' =
                                Double -> Double -> Double -> Double -> Text -> Text -> Text
svgRect Double
x (Double
ly Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
1) Double
12 Double
12 (Color -> Text
colorHex Color
col) Text
""
                                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Text -> Text -> Double -> Text -> Text
svgText (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
16) (Double
ly Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
9) Text
"start" Text
"#555" Double
labelFontSize Text
name
                            w :: Double
w = Double
30 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Text -> Int
T.length Text
name) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
7
                         in (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
w, Text
acc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
elem')
                    )
                    (Double
startX, Text
"")
                    [(Text, Color)]
entries

mapX :: Layout -> Double -> Double -> Double -> Double
mapX :: Layout -> Double -> Double -> Double -> Double
mapX Layout
lay Double
xmin Double
xmax Double
x =
    Layout -> Double
plotX Layout
lay Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
xmin) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
xmax Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
xmin Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
eps) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Layout -> Double
plotW Layout
lay

mapY :: Layout -> Double -> Double -> Double -> Double
mapY :: Layout -> Double -> Double -> Double -> Double
mapY Layout
lay Double
ymin Double
ymax Double
y =
    Layout -> Double
plotY Layout
lay Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Layout -> Double
plotH Layout
lay Double -> Double -> Double
forall a. Num a => a -> a -> a
- (Double
y Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
ymin) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
ymax Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
ymin Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
eps) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Layout -> Double
plotH Layout
lay

scatter ::
    [(Text, [(Double, Double)])] ->
    Plot ->
    Text
scatter :: [(Text, [(Double, Double)])] -> Plot -> Text
scatter [(Text, [(Double, Double)])]
sers Plot
cfg =
    let lay :: Layout
lay = Plot -> Layout
mkLayout Plot
cfg
        (Double
xmin, Double
xmax, Double
ymin, Double
ymax) = Plot -> [(Double, Double)] -> (Double, Double, Double, Double)
boundsXY Plot
cfg (((Text, [(Double, Double)]) -> [(Double, Double)])
-> [(Text, [(Double, Double)])] -> [(Double, Double)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Text, [(Double, Double)]) -> [(Double, Double)]
forall a b. (a, b) -> b
snd [(Text, [(Double, Double)])]
sers)
        cols :: [Color]
cols = [Color] -> [Color]
forall a. HasCallStack => [a] -> [a]
cycle (Plot -> [Color]
colorPalette Plot
cfg)
        withCol :: [((Text, [(Double, Double)]), Color)]
withCol = [(Text, [(Double, Double)])]
-> [Color] -> [((Text, [(Double, Double)]), Color)]
forall a b. [a] -> [b] -> [(a, b)]
zip [(Text, [(Double, Double)])]
sers [Color]
cols

        points :: Text
points =
            [Text] -> Text
T.concat
                [ [Text] -> Text
T.concat
                    [ Double -> Double -> Double -> Text -> Text
svgCircle
                        (Layout -> Double -> Double -> Double -> Double
mapX Layout
lay Double
xmin Double
xmax Double
x)
                        (Layout -> Double -> Double -> Double -> Double
mapY Layout
lay Double
ymin Double
ymax Double
y)
                        Double
3
                        (Color -> Text
colorHex Color
col)
                    | (Double
x, Double
y) <- [(Double, Double)]
pts
                    ]
                | ((Text
_, [(Double, Double)]
pts), Color
col) <- [((Text, [(Double, Double)]), Color)]
withCol
                ]

        axes :: Text
axes = Plot -> Layout -> (Double, Double) -> (Double, Double) -> Text
drawAxes Plot
cfg Layout
lay (Double
xmin, Double
xmax) (Double
ymin, Double
ymax)
        title :: Text
title = Plot -> Layout -> Text
drawTitle Plot
cfg Layout
lay
        legend :: Text
legend = Plot -> Layout -> [(Text, Color)] -> Text
drawLegend Plot
cfg Layout
lay [(Text
n, Color
col) | ((Text
n, [(Double, Double)]
_), Color
col) <- [((Text, [(Double, Double)]), Color)]
withCol]
     in Double -> Double -> Text -> Text
svgDoc (Layout -> Double
svgW Layout
lay) (Layout -> Double
svgH Layout
lay) (Text
title Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
axes Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
points Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
legend)

lineGraph ::
    [(Text, [(Double, Double)])] ->
    Plot ->
    Text
lineGraph :: [(Text, [(Double, Double)])] -> Plot -> Text
lineGraph [(Text, [(Double, Double)])]
sers Plot
cfg =
    let lay :: Layout
lay = Plot -> Layout
mkLayout Plot
cfg
        (Double
xmin, Double
xmax, Double
ymin, Double
ymax) = Plot -> [(Double, Double)] -> (Double, Double, Double, Double)
boundsXY Plot
cfg (((Text, [(Double, Double)]) -> [(Double, Double)])
-> [(Text, [(Double, Double)])] -> [(Double, Double)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Text, [(Double, Double)]) -> [(Double, Double)]
forall a b. (a, b) -> b
snd [(Text, [(Double, Double)])]
sers)
        cols :: [Color]
cols = [Color] -> [Color]
forall a. HasCallStack => [a] -> [a]
cycle (Plot -> [Color]
colorPalette Plot
cfg)
        withCol :: [((Text, [(Double, Double)]), Color)]
withCol = [(Text, [(Double, Double)])]
-> [Color] -> [((Text, [(Double, Double)]), Color)]
forall a b. [a] -> [b] -> [(a, b)]
zip [(Text, [(Double, Double)])]
sers [Color]
cols

        lines' :: Text
lines' =
            [Text] -> Text
T.concat
                [ let sortedPts :: [(Double, Double)]
sortedPts = ((Double, Double) -> Double)
-> [(Double, Double)] -> [(Double, Double)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
List.sortOn (Double, Double) -> Double
forall a b. (a, b) -> a
fst [(Double, Double)]
pts
                      svgPts :: [(Double, Double)]
svgPts =
                        [ (Layout -> Double -> Double -> Double -> Double
mapX Layout
lay Double
xmin Double
xmax Double
x, Layout -> Double -> Double -> Double -> Double
mapY Layout
lay Double
ymin Double
ymax Double
y)
                        | (Double
x, Double
y) <- [(Double, Double)]
sortedPts
                        ]
                   in [(Double, Double)] -> Text -> Double -> Text
svgPolyline [(Double, Double)]
svgPts (Color -> Text
colorHex Color
col) Double
2
                | ((Text
_, [(Double, Double)]
pts), Color
col) <- [((Text, [(Double, Double)]), Color)]
withCol
                ]

        axes :: Text
axes = Plot -> Layout -> (Double, Double) -> (Double, Double) -> Text
drawAxes Plot
cfg Layout
lay (Double
xmin, Double
xmax) (Double
ymin, Double
ymax)
        title :: Text
title = Plot -> Layout -> Text
drawTitle Plot
cfg Layout
lay
        legend :: Text
legend = Plot -> Layout -> [(Text, Color)] -> Text
drawLegend Plot
cfg Layout
lay [(Text
n, Color
col) | ((Text
n, [(Double, Double)]
_), Color
col) <- [((Text, [(Double, Double)]), Color)]
withCol]
     in Double -> Double -> Text -> Text
svgDoc (Layout -> Double
svgW Layout
lay) (Layout -> Double
svgH Layout
lay) (Text
title Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
axes Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
lines' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
legend)

bars ::
    [(Text, Double)] ->
    Plot ->
    Text
bars :: [(Text, Double)] -> Plot -> Text
bars [(Text, Double)]
kvs Plot
cfg =
    let lay :: Layout
lay = Plot -> Layout
mkLayout Plot
cfg
        ([Text]
catNames, [Double]
vals) = [(Text, Double)] -> ([Text], [Double])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Text, Double)]
kvs
        vmax :: Double
vmax = [Double] -> Double
maximum' ((Double -> Double) -> [Double] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map Double -> Double
forall a. Num a => a -> a
abs [Double]
vals)
        cols :: [Color]
cols = [Color] -> [Color]
forall a. HasCallStack => [a] -> [a]
cycle (Plot -> [Color]
colorPalette Plot
cfg)
        n :: Int
n = [(Text, Double)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Text, Double)]
kvs

        barGap :: Double
barGap = Double
0.15
        groupW :: Double
groupW = Layout -> Double
plotW Layout
lay Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 Int
n)

        rects :: Text
rects =
            [Text] -> Text
T.concat
                [ let barW :: Double
barW = Double
groupW Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
barGap)
                      barH :: Double
barH = Double -> Double
forall a. Num a => a -> a
abs Double
v Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
vmax Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
eps) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Layout -> Double
plotH Layout
lay
                      bx :: Double
bx = Layout -> Double
plotX Layout
lay Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
groupW Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
groupW Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
barGap
                      by :: Double
by = Layout -> Double
plotY Layout
lay Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Layout -> Double
plotH Layout
lay Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
barH
                   in Double -> Double -> Double -> Double -> Text -> Text -> Text
svgRect Double
bx Double
by Double
barW Double
barH (Color -> Text
colorHex Color
col) (Text -> Text -> Text
attr Text
"rx" Text
"2")
                | (Int
i, (Text
_, Double
v), Color
col) <- [Int]
-> [(Text, Double)] -> [Color] -> [(Int, (Text, Double), Color)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Int
0 :: Int ..] [(Text, Double)]
kvs [Color]
cols
                ]

        axes :: Text
axes = Plot -> Layout -> (Double, Double) -> [Text] -> Text
drawCatAxes Plot
cfg Layout
lay (Double
0, Double
vmax) [Text]
catNames
        title :: Text
title = Plot -> Layout -> Text
drawTitle Plot
cfg Layout
lay
        legend :: Text
legend = Plot -> Layout -> [(Text, Color)] -> Text
drawLegend Plot
cfg Layout
lay [(Text
name, Color
col) | ((Text
name, Double
_), Color
col) <- [(Text, Double)] -> [Color] -> [((Text, Double), Color)]
forall a b. [a] -> [b] -> [(a, b)]
zip [(Text, Double)]
kvs [Color]
cols]
     in Double -> Double -> Text -> Text
svgDoc (Layout -> Double
svgW Layout
lay) (Layout -> Double
svgH Layout
lay) (Text
title Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
axes Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
rects Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
legend)

stackedBars ::
    [(Text, [(Text, Double)])] ->
    Plot ->
    Text
stackedBars :: [(Text, [(Text, Double)])] -> Plot -> Text
stackedBars [(Text, [(Text, Double)])]
categories Plot
cfg =
    let lay :: Layout
lay = Plot -> Layout
mkLayout Plot
cfg
        seriesNames :: [Text]
seriesNames = case [(Text, [(Text, Double)])]
categories of
            [] -> []
            ((Text, [(Text, Double)])
c : [(Text, [(Text, Double)])]
_) -> ((Text, Double) -> Text) -> [(Text, Double)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Double) -> Text
forall a b. (a, b) -> a
fst ((Text, [(Text, Double)]) -> [(Text, Double)]
forall a b. (a, b) -> b
snd (Text, [(Text, Double)])
c)

        totals :: [Double]
totals = [[Double] -> Double
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (((Text, Double) -> Double) -> [(Text, Double)] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Double) -> Double
forall a b. (a, b) -> b
snd [(Text, Double)]
s) | (Text
_, [(Text, Double)]
s) <- [(Text, [(Text, Double)])]
categories]
        maxH :: Double
maxH = [Double] -> Double
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Double
1e-12 Double -> [Double] -> [Double]
forall a. a -> [a] -> [a]
: [Double]
totals)

        cols :: [Color]
cols = [Color] -> [Color]
forall a. HasCallStack => [a] -> [a]
cycle (Plot -> [Color]
colorPalette Plot
cfg)
        seriesColors :: [(Text, Color)]
seriesColors = [Text] -> [Color] -> [(Text, Color)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
seriesNames [Color]
cols

        nCats :: Int
nCats = [(Text, [(Text, Double)])] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Text, [(Text, Double)])]
categories
        barGap :: Double
barGap = Double
0.1
        groupW :: Double
groupW = Layout -> Double
plotW Layout
lay Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 Int
nCats)

        rects :: Text
rects =
            [Text] -> Text
T.concat
                [ let barW :: Double
barW = Double
groupW Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
barGap)
                      bx :: Double
bx = Layout -> Double
plotX Layout
lay Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ci Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
groupW Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
groupW Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
barGap
                      cumHeights :: [Double]
cumHeights = (Double -> Double -> Double) -> Double -> [Double] -> [Double]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl Double -> Double -> Double
forall a. Num a => a -> a -> a
(+) Double
0 [Double
v Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
maxH | (Text
_, Double
v) <- [(Text, Double)]
segs]
                   in [Text] -> Text
T.concat
                        [ let bot :: Double
bot = [Double]
cumHeights [Double] -> Int -> Double
forall a. HasCallStack => [a] -> Int -> a
!! Int
si
                              top :: Double
top = [Double]
cumHeights [Double] -> Int -> Double
forall a. HasCallStack => [a] -> Int -> a
!! (Int
si Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                              segH :: Double
segH = (Double
top Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
bot) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Layout -> Double
plotH Layout
lay
                              segY :: Double
segY = Layout -> Double
plotY Layout
lay Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Layout -> Double
plotH Layout
lay Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
top Double -> Double -> Double
forall a. Num a => a -> a -> a
* Layout -> Double
plotH Layout
lay
                              col :: Color
col = Color -> Maybe Color -> Color
forall a. a -> Maybe a -> a
fromMaybe Color
BrightBlue (Text -> [(Text, Color)] -> Maybe Color
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
sn [(Text, Color)]
seriesColors)
                           in Double -> Double -> Double -> Double -> Text -> Text -> Text
svgRect Double
bx Double
segY Double
barW Double
segH (Color -> Text
colorHex Color
col) (Text -> Text -> Text
attr Text
"rx" Text
"1")
                        | (Int
si, (Text
sn, Double
_)) <- [Int] -> [(Text, Double)] -> [(Int, (Text, Double))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 :: Int ..] [(Text, Double)]
segs
                        ]
                | (Int
ci, (Text
_, [(Text, Double)]
segs)) <- [Int]
-> [(Text, [(Text, Double)])] -> [(Int, (Text, [(Text, Double)]))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 :: Int ..] [(Text, [(Text, Double)])]
categories
                ]

        catNames :: [Text]
catNames = ((Text, [(Text, Double)]) -> Text)
-> [(Text, [(Text, Double)])] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, [(Text, Double)]) -> Text
forall a b. (a, b) -> a
fst [(Text, [(Text, Double)])]
categories
        axes :: Text
axes = Plot -> Layout -> (Double, Double) -> [Text] -> Text
drawCatAxes Plot
cfg Layout
lay (Double
0, Double
maxH) [Text]
catNames
        title :: Text
title = Plot -> Layout -> Text
drawTitle Plot
cfg Layout
lay
        legend :: Text
legend = Plot -> Layout -> [(Text, Color)] -> Text
drawLegend Plot
cfg Layout
lay [(Text
n, Color
col) | (Text
n, Color
col) <- [(Text, Color)]
seriesColors]
     in Double -> Double -> Text -> Text
svgDoc (Layout -> Double
svgW Layout
lay) (Layout -> Double
svgH Layout
lay) (Text
title Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
axes Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
rects Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
legend)

histogram ::
    Bins ->
    [Double] ->
    Plot ->
    Text
histogram :: Bins -> [Double] -> Plot -> Text
histogram (Bins Int
nB Double
a Double
b) [Double]
xs Plot
cfg =
    let lay :: Layout
lay = Plot -> Layout
mkLayout Plot
cfg
        step :: Double
step = (Double
b Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
a) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nB
        binIx :: Double -> Int
binIx Double
x = Int -> Int -> Int -> Int
forall a. Ord a => a -> a -> a -> a
clamp Int
0 (Int
nB Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor ((Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
a) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
step)
        counts0 :: [Int]
        counts0 :: [Int]
counts0 =
            ([Int] -> Double -> [Int]) -> [Int] -> [Double] -> [Int]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl'
                ( \[Int]
acc Double
x ->
                    if Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
a Bool -> Bool -> Bool
|| Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
b
                        then [Int]
acc
                        else [Int] -> Int -> Int -> [Int]
addAt [Int]
acc (Double -> Int
binIx Double
x) Int
1
                )
                (Int -> Int -> [Int]
forall a. Int -> a -> [a]
replicate Int
nB Int
0)
                [Double]
xs
        maxC :: Double
maxC = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Int
1 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int]
counts0)) :: Double

        barW :: Double
barW = Layout -> Double
plotW Layout
lay Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nB
        rects :: Text
rects =
            [Text] -> Text
T.concat
                [ let v :: Double
v = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
c
                      barH :: Double
barH = Double
v Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
maxC Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
eps) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Layout -> Double
plotH Layout
lay
                      bx :: Double
bx = Layout -> Double
plotX Layout
lay Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
barW
                      by :: Double
by = Layout -> Double
plotY Layout
lay Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Layout -> Double
plotH Layout
lay Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
barH
                   in Double -> Double -> Double -> Double -> Text -> Text -> Text
svgRect Double
bx Double
by (Double
barW Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
1) Double
barH (Color -> Text
colorHex Color
BrightCyan) Text
""
                | (Int
i, Int
c) <- [Int] -> [Int] -> [(Int, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 :: Int ..] [Int]
counts0
                ]

        axes :: Text
axes = Plot -> Layout -> (Double, Double) -> (Double, Double) -> Text
drawAxes Plot
cfg Layout
lay (Double
a, Double
b) (Double
0, Double
maxC)
        title :: Text
title = Plot -> Layout -> Text
drawTitle Plot
cfg Layout
lay
        legend :: Text
legend = Plot -> Layout -> [(Text, Color)] -> Text
drawLegend Plot
cfg Layout
lay [(Text
"count", Color
BrightCyan)]
     in Double -> Double -> Text -> Text
svgDoc (Layout -> Double
svgW Layout
lay) (Layout -> Double
svgH Layout
lay) (Text
title Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
axes Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
rects Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
legend)

pie ::
    [(Text, Double)] ->
    Plot ->
    Text
pie :: [(Text, Double)] -> Plot -> Text
pie [(Text, Double)]
parts0 Plot
cfg =
    let lay :: Layout
lay = Plot -> Layout
mkLayout Plot
cfg
        parts :: [(Text, Double)]
parts = [(Text, Double)] -> [(Text, Double)]
normalize [(Text, Double)]
parts0

        cxP :: Double
cxP = Layout -> Double
plotX Layout
lay Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Layout -> Double
plotW Layout
lay Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2
        cyP :: Double
cyP = Layout -> Double
plotY Layout
lay Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Layout -> Double
plotH Layout
lay Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2
        r :: Double
r = Double -> Double -> Double
forall a. Ord a => a -> a -> a
min (Layout -> Double
plotW Layout
lay Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2) (Layout -> Double
plotH Layout
lay Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
0.85

        toAng :: a -> a
toAng a
p = a
p a -> a -> a
forall a. Num a => a -> a -> a
* a
2 a -> a -> a
forall a. Num a => a -> a -> a
* a
forall a. Floating a => a
pi
        wedgeAngles :: [Double]
wedgeAngles = (Double -> (Text, Double) -> Double)
-> Double -> [(Text, Double)] -> [Double]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl (\Double
acc (Text
_, Double
p) -> Double
acc Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double -> Double
forall {a}. Floating a => a -> a
toAng Double
p) Double
0 [(Text, Double)]
parts
        angles :: [(Double, Double)]
angles = [Double] -> [Double] -> [(Double, Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Double]
wedgeAngles (Int -> [Double] -> [Double]
forall a. Int -> [a] -> [a]
drop Int
1 [Double]
wedgeAngles)

        cols :: [Color]
cols = [Color] -> [Color]
forall a. HasCallStack => [a] -> [a]
cycle (Plot -> [Color]
colorPalette Plot
cfg)
        withP :: [(Text, (Double, Double), Color)]
withP = [Text]
-> [(Double, Double)]
-> [Color]
-> [(Text, (Double, Double), Color)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 (((Text, Double) -> Text) -> [(Text, Double)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Double) -> Text
forall a b. (a, b) -> a
fst [(Text, Double)]
parts) [(Double, Double)]
angles [Color]
cols

        slices :: Text
slices =
            [Text] -> Text
T.concat
                [ let (Double
a0, Double
a1) = (Double, Double)
ang
                      x0 :: Double
x0 = Double
cxP Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
r Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall {a}. Floating a => a -> a
cos Double
a0
                      y0 :: Double
y0 = Double
cyP Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
r Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall {a}. Floating a => a -> a
sin Double
a0
                      x1 :: Double
x1 = Double
cxP Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
r Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall {a}. Floating a => a -> a
cos Double
a1
                      y1 :: Double
y1 = Double
cyP Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
r Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall {a}. Floating a => a -> a
sin Double
a1
                      largeArc :: Text
largeArc = if Double
a1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
a0 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
forall a. Floating a => a
pi then Text
"1" else Text
"0"
                      d :: Text
d =
                        Text
"M "
                            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Double -> Text
showD Double
cxP
                            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" "
                            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Double -> Text
showD Double
cyP
                            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" L "
                            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Double -> Text
showD Double
x0
                            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" "
                            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Double -> Text
showD Double
y0
                            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" A "
                            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Double -> Text
showD Double
r
                            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" "
                            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Double -> Text
showD Double
r
                            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" 0 "
                            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
largeArc
                            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" 0 "
                            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Double -> Text
showD Double
x1
                            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" "
                            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Double -> Text
showD Double
y1
                            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" Z"
                   in Text -> Text -> Text -> Text
svgPath Text
d (Color -> Text
colorHex Color
col) (Text -> Text -> Text
attr Text
"stroke" Text
"white" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text -> Text
attr Text
"stroke-width" Text
"2")
                | (Text
_, (Double, Double)
ang, Color
col) <- [(Text, (Double, Double), Color)]
withP
                ]

        title :: Text
title = Plot -> Layout -> Text
drawTitle Plot
cfg Layout
lay
        legend :: Text
legend = Plot -> Layout -> [(Text, Color)] -> Text
drawLegend Plot
cfg Layout
lay [(Text
n, Color
col) | (Text
n, (Double, Double)
_, Color
col) <- [(Text, (Double, Double), Color)]
withP]
     in Double -> Double -> Text -> Text
svgDoc (Layout -> Double
svgW Layout
lay) (Layout -> Double
svgH Layout
lay) (Text
title Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
slices Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
legend)

heatmap ::
    [[Double]] ->
    Plot ->
    Text
heatmap :: [[Double]] -> Plot -> Text
heatmap [[Double]]
matrix Plot
cfg =
    let lay :: Layout
lay = Plot -> Layout
mkLayout Plot
cfg
        rows :: Int
rows = [[Double]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Double]]
matrix
        cols :: Int
cols = case [[Double]]
matrix of
            [] -> Int
0
            ([Double]
r : [[Double]]
_) -> [Double] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Double]
r

        allVals :: [Double]
allVals = [[Double]] -> [Double]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Double]]
matrix
        vmin :: Double
vmin = if [Double] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Double]
allVals then Double
0 else [Double] -> Double
minimum' [Double]
allVals
        vmax :: Double
vmax = if [Double] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Double]
allVals then Double
1 else [Double] -> Double
maximum' [Double]
allVals
        vrange :: Double
vrange = Double
vmax Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
vmin

        nColors :: Int
nColors = [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
heatColors
        colorForVal :: Double -> Text
colorForVal Double
v =
            if Double
vrange Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
eps
                then [Text]
heatColors [Text] -> Int -> Text
forall a. HasCallStack => [a] -> Int -> a
!! (Int
nColors Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2)
                else
                    let norm :: Double
norm = Double -> Double -> Double -> Double
forall a. Ord a => a -> a -> a -> a
clamp Double
0 Double
1 ((Double
v Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
vmin) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
vrange)
                        idx :: Int
idx = Int -> Int -> Int -> Int
forall a. Ord a => a -> a -> a -> a
clamp Int
0 (Int
nColors Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double
norm Double -> Double -> Double
forall a. Num a => a -> a -> a
* Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
nColors Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)))
                     in [Text]
heatColors [Text] -> Int -> Text
forall a. HasCallStack => [a] -> Int -> a
!! Int
idx

        cellW :: Double
cellW = Layout -> Double
plotW Layout
lay Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 Int
cols)
        cellH :: Double
cellH = Layout -> Double
plotH Layout
lay Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 Int
rows)

        cells :: Text
cells =
            [Text] -> Text
T.concat
                [ [Text] -> Text
T.concat
                    [ let cx :: Double
cx = Layout -> Double
plotX Layout
lay Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
c Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
cellW
                          cy :: Double
cy = Layout -> Double
plotY Layout
lay Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
r Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
cellH
                          dataRow :: Int
dataRow = Int
rows Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
r
                          v :: Double
v = ([[Double]]
matrix [[Double]] -> Int -> [Double]
forall a. HasCallStack => [a] -> Int -> a
!! Int
dataRow) [Double] -> Int -> Double
forall a. HasCallStack => [a] -> Int -> a
!! Int
c
                       in Double -> Double -> Double -> Double -> Text -> Text -> Text
svgRect Double
cx Double
cy Double
cellW Double
cellH (Double -> Text
colorForVal Double
v) Text
""
                    | Int
c <- [Int
0 .. Int
cols Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
                    ]
                | Int
r <- [Int
0 .. Int
rows Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
                ]

        colLabels :: Text
colLabels =
            [Text] -> Text
T.concat
                [ Double -> Double -> Text -> Text -> Double -> Text -> Text
svgText
                    (Layout -> Double
plotX Layout
lay Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
c Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
0.5) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
cellW)
                    (Layout -> Double
plotY Layout
lay Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Layout -> Double
plotH Layout
lay Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
16)
                    Text
"middle"
                    Text
"#555"
                    Double
labelFontSize
                    (String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
c))
                | Int
c <- [Int
0 .. Int
cols Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
                ]
        rowLabels :: Text
rowLabels =
            [Text] -> Text
T.concat
                [ Double -> Double -> Text -> Text -> Double -> Text -> Text
svgText
                    (Layout -> Double
plotX Layout
lay Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
8)
                    (Layout -> Double
plotY Layout
lay Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
r Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
0.5) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
cellH Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
4)
                    Text
"end"
                    Text
"#555"
                    Double
labelFontSize
                    (String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show (Int
rows Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
r)))
                | Int
r <- [Int
0 .. Int
rows Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
                ]

        border :: Text
border =
            Double -> Double -> Double -> Double -> Text -> Text -> Text
svgRect
                (Layout -> Double
plotX Layout
lay)
                (Layout -> Double
plotY Layout
lay)
                (Layout -> Double
plotW Layout
lay)
                (Layout -> Double
plotH Layout
lay)
                Text
"none"
                (Text -> Text -> Text
attr Text
"stroke" Text
"#aaa" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text -> Text
attr Text
"stroke-width" Text
"1")

        title :: Text
title = Plot -> Layout -> Text
drawTitle Plot
cfg Layout
lay

        gradLegend :: Text
gradLegend =
            let gw :: Double
gw = Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
200 (Layout -> Double
plotW Layout
lay Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
0.5)
                gh :: Double
gh = Double
12
                gx :: Double
gx = Layout -> Double
plotX Layout
lay Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Layout -> Double
plotW Layout
lay Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
gw) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2
                gy :: Double
gy = Layout -> Double
svgH Layout
lay Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
22
                nSteps :: Int
nSteps = Int
20 :: Int
                stepW :: Double
stepW = Double
gw Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nSteps
             in Double -> Double -> Text -> Text -> Double -> Text -> Text
svgText
                    (Double
gx Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
5)
                    (Double
gy Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
10)
                    Text
"end"
                    Text
"#555"
                    Double
labelFontSize
                    (String -> Text
T.pack (Maybe Int -> Double -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
2) Double
vmin String
""))
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
T.concat
                        [ let t :: Double
t = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nSteps
                              v :: Double
v = Double
vmin Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
t Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
vrange
                           in Double -> Double -> Double -> Double -> Text -> Text -> Text
svgRect (Double
gx Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
stepW) Double
gy Double
stepW Double
gh (Double -> Text
colorForVal Double
v) Text
""
                        | Int
i <- [Int
0 .. Int
nSteps Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
                        ]
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Text -> Text -> Double -> Text -> Text
svgText
                        (Double
gx Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
gw Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
5)
                        (Double
gy Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
10)
                        Text
"start"
                        Text
"#555"
                        Double
labelFontSize
                        (String -> Text
T.pack (Maybe Int -> Double -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
2) Double
vmax String
""))
     in Double -> Double -> Text -> Text
svgDoc
            (Layout -> Double
svgW Layout
lay)
            (Layout -> Double
svgH Layout
lay)
            (Text
title Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
cells Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
colLabels Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
rowLabels Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
border Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
gradLegend)

boxPlot ::
    [(Text, [Double])] ->
    Plot ->
    Text
boxPlot :: [(Text, [Double])] -> Plot -> Text
boxPlot [(Text, [Double])]
datasets Plot
cfg =
    let lay :: Layout
lay = Plot -> Layout
mkLayout Plot
cfg
        stats :: [(Text, (Double, Double, Double, Double, Double))]
stats = [(Text
name, [Double] -> (Double, Double, Double, Double, Double)
quartiles [Double]
vals) | (Text
name, [Double]
vals) <- [(Text, [Double])]
datasets]

        allVals :: [Double]
allVals = ((Text, [Double]) -> [Double]) -> [(Text, [Double])] -> [Double]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Text, [Double]) -> [Double]
forall a b. (a, b) -> b
snd [(Text, [Double])]
datasets
        ymin :: Double
ymin = if [Double] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Double]
allVals then Double
0 else [Double] -> Double
minimum' [Double]
allVals Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double -> Double
forall a. Num a => a -> a
abs ([Double] -> Double
minimum' [Double]
allVals) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
0.1
        ymax :: Double
ymax = if [Double] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Double]
allVals then Double
1 else [Double] -> Double
maximum' [Double]
allVals Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double -> Double
forall a. Num a => a -> a
abs ([Double] -> Double
maximum' [Double]
allVals) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
0.1

        nBoxes :: Int
nBoxes = [(Text, [Double])] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Text, [Double])]
datasets
        cols :: [Color]
cols = [Color] -> [Color]
forall a. HasCallStack => [a] -> [a]
cycle (Plot -> [Color]
colorPalette Plot
cfg)

        groupW :: Double
groupW = Layout -> Double
plotW Layout
lay Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 Int
nBoxes)
        boxW :: Double
boxW = Double
groupW Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
0.6

        scY :: Double -> Double
scY Double
v = Layout -> Double
plotY Layout
lay Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Layout -> Double
plotH Layout
lay Double -> Double -> Double
forall a. Num a => a -> a -> a
- (Double
v Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
ymin) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
ymax Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
ymin Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
eps) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Layout -> Double
plotH Layout
lay

        boxes :: Text
boxes =
            [Text] -> Text
T.concat
                [ let bx :: Double
bx = Layout -> Double
plotX Layout
lay Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
groupW Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Double
groupW Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
boxW) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2
                      midX :: Double
midX = Double
bx Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
boxW Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2
                      (Double
minV, Double
q1, Double
med, Double
q3, Double
maxV) = (Double, Double, Double, Double, Double)
qs
                      col :: Text
col = Color -> Text
colorHex Color
c

                      whiskerBot :: Text
whiskerBot = Double -> Double -> Double -> Double -> Text -> Double -> Text
svgLine Double
midX (Double -> Double
scY Double
minV) Double
midX (Double -> Double
scY Double
q1) Text
col Double
1.5
                      capBot :: Text
capBot = Double -> Double -> Double -> Double -> Text -> Double -> Text
svgLine (Double
bx Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
boxW Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
0.25) (Double -> Double
scY Double
minV) (Double
bx Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
boxW Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
0.75) (Double -> Double
scY Double
minV) Text
col Double
1.5

                      boxY :: Double
boxY = Double -> Double
scY Double
q3
                      boxH :: Double
boxH = Double -> Double
scY Double
q1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double -> Double
scY Double
q3
                      box :: Text
box =
                        Double -> Double -> Double -> Double -> Text -> Text -> Text
svgRect
                            Double
bx
                            Double
boxY
                            Double
boxW
                            Double
boxH
                            Text
col
                            ( Text -> Text -> Text
attr Text
"fill-opacity" Text
"0.3"
                                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text -> Text
attr Text
"stroke" Text
col
                                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text -> Text
attr Text
"stroke-width" Text
"1.5"
                                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text -> Text
attr Text
"rx" Text
"2"
                            )

                      medLine :: Text
medLine = Double -> Double -> Double -> Double -> Text -> Double -> Text
svgLine Double
bx (Double -> Double
scY Double
med) (Double
bx Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
boxW) (Double -> Double
scY Double
med) Text
col Double
2.5

                      whiskerTop :: Text
whiskerTop = Double -> Double -> Double -> Double -> Text -> Double -> Text
svgLine Double
midX (Double -> Double
scY Double
q3) Double
midX (Double -> Double
scY Double
maxV) Text
col Double
1.5
                      capTop :: Text
capTop = Double -> Double -> Double -> Double -> Text -> Double -> Text
svgLine (Double
bx Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
boxW Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
0.25) (Double -> Double
scY Double
maxV) (Double
bx Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
boxW Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
0.75) (Double -> Double
scY Double
maxV) Text
col Double
1.5
                   in Text
whiskerBot Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
capBot Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
whiskerTop Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
capTop Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
box Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
medLine
                | (Int
i, (Text
_, (Double, Double, Double, Double, Double)
qs), Color
c) <- [Int]
-> [(Text, (Double, Double, Double, Double, Double))]
-> [Color]
-> [(Int, (Text, (Double, Double, Double, Double, Double)), Color)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Int
0 :: Int ..] [(Text, (Double, Double, Double, Double, Double))]
stats [Color]
cols
                ]

        catNames :: [Text]
catNames = ((Text, [Double]) -> Text) -> [(Text, [Double])] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, [Double]) -> Text
forall a b. (a, b) -> a
fst [(Text, [Double])]
datasets
        axes :: Text
axes = Plot -> Layout -> (Double, Double) -> [Text] -> Text
drawCatAxes Plot
cfg Layout
lay (Double
ymin, Double
ymax) [Text]
catNames
        title :: Text
title = Plot -> Layout -> Text
drawTitle Plot
cfg Layout
lay
        legend :: Text
legend = Plot -> Layout -> [(Text, Color)] -> Text
drawLegend Plot
cfg Layout
lay [(Text
name, Color
col) | ((Text
name, (Double, Double, Double, Double, Double)
_), Color
col) <- [(Text, (Double, Double, Double, Double, Double))]
-> [Color]
-> [((Text, (Double, Double, Double, Double, Double)), Color)]
forall a b. [a] -> [b] -> [(a, b)]
zip [(Text, (Double, Double, Double, Double, Double))]
stats [Color]
cols]
     in Double -> Double -> Text -> Text
svgDoc (Layout -> Double
svgW Layout
lay) (Layout -> Double
svgH Layout
lay) (Text
title Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
axes Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
boxes Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
legend)

area :: [(Text, [(Double, Double)])] -> Plot -> Text
area :: [(Text, [(Double, Double)])] -> Plot -> Text
area [(Text, [(Double, Double)])]
sers Plot
cfg =
    Chart -> Text
renderChartSvg (Chart -> Text) -> Chart -> Text
forall a b. (a -> b) -> a -> b
$
        [(Text, [(Double, Double)])] -> Int -> Int -> Text -> Chart
LC.areaChart [(Text, [(Double, Double)])]
sers (Plot -> Int
widthChars Plot
cfg) (Plot -> Int
heightChars Plot
cfg) (Plot -> Text
plotTitle Plot
cfg)

ribbon :: [(Text, [(Double, Double, Double)])] -> Plot -> Text
ribbon :: [(Text, [(Double, Double, Double)])] -> Plot -> Text
ribbon [(Text, [(Double, Double, Double)])]
sers Plot
cfg =
    Chart -> Text
renderChartSvg (Chart -> Text) -> Chart -> Text
forall a b. (a -> b) -> a -> b
$
        [(Text, [(Double, Double, Double)])] -> Int -> Int -> Text -> Chart
LC.ribbonChart [(Text, [(Double, Double, Double)])]
sers (Plot -> Int
widthChars Plot
cfg) (Plot -> Int
heightChars Plot
cfg) (Plot -> Text
plotTitle Plot
cfg)

density :: [(Text, [Double])] -> Plot -> Text
density :: [(Text, [Double])] -> Plot -> Text
density [(Text, [Double])]
sers Plot
cfg =
    Chart -> Text
renderChartSvg (Chart -> Text) -> Chart -> Text
forall a b. (a -> b) -> a -> b
$
        [(Text, [Double])] -> Int -> Int -> Text -> Chart
LC.densityChart [(Text, [Double])]
sers (Plot -> Int
widthChars Plot
cfg) (Plot -> Int
heightChars Plot
cfg) (Plot -> Text
plotTitle Plot
cfg)

errorBars :: [(Text, [(Double, Double, Double, Double)])] -> Plot -> Text
errorBars :: [(Text, [(Double, Double, Double, Double)])] -> Plot -> Text
errorBars [(Text, [(Double, Double, Double, Double)])]
sers Plot
cfg =
    Chart -> Text
renderChartSvg (Chart -> Text) -> Chart -> Text
forall a b. (a -> b) -> a -> b
$
        [(Text, [(Double, Double, Double, Double)])]
-> Int -> Int -> Text -> Chart
LC.errorBarsChart [(Text, [(Double, Double, Double, Double)])]
sers (Plot -> Int
widthChars Plot
cfg) (Plot -> Int
heightChars Plot
cfg) (Plot -> Text
plotTitle Plot
cfg)

funnel :: [(Text, Double)] -> Plot -> Text
funnel :: [(Text, Double)] -> Plot -> Text
funnel [(Text, Double)]
stages Plot
cfg =
    Chart -> Text
renderChartSvg (Chart -> Text) -> Chart -> Text
forall a b. (a -> b) -> a -> b
$
        [(Text, Double)] -> Int -> Int -> Text -> Chart
LC.funnelChart [(Text, Double)]
stages (Plot -> Int
widthChars Plot
cfg) (Plot -> Int
heightChars Plot
cfg) (Plot -> Text
plotTitle Plot
cfg)

polarLine :: [(Text, [(Double, Double)])] -> Plot -> Text
polarLine :: [(Text, [(Double, Double)])] -> Plot -> Text
polarLine [(Text, [(Double, Double)])]
sers Plot
cfg =
    Chart -> Text
renderChartSvg (Chart -> Text) -> Chart -> Text
forall a b. (a -> b) -> a -> b
$
        [(Text, [(Double, Double)])] -> Int -> Int -> Text -> Chart
LC.polarLineChart [(Text, [(Double, Double)])]
sers (Plot -> Int
widthChars Plot
cfg) (Plot -> Int
heightChars Plot
cfg) (Plot -> Text
plotTitle Plot
cfg)

waterfall :: [(Text, Double, Double)] -> Plot -> Text
waterfall :: [(Text, Double, Double)] -> Plot -> Text
waterfall [(Text, Double, Double)]
rows Plot
cfg =
    Chart -> Text
renderChartSvg (Chart -> Text) -> Chart -> Text
forall a b. (a -> b) -> a -> b
$
        [(Text, Double, Double)] -> Int -> Int -> Text -> Chart
LC.waterfallChart [(Text, Double, Double)]
rows (Plot -> Int
widthChars Plot
cfg) (Plot -> Int
heightChars Plot
cfg) (Plot -> Text
plotTitle Plot
cfg)

distPlot :: [(Text, [Double])] -> Plot -> Text
distPlot :: [(Text, [Double])] -> Plot -> Text
distPlot [(Text, [Double])]
sers Plot
cfg =
    Chart -> Text
renderChartSvg (Chart -> Text) -> Chart -> Text
forall a b. (a -> b) -> a -> b
$
        [(Text, [Double])] -> Int -> Int -> Text -> Chart
LC.distPlotChart [(Text, [Double])]
sers (Plot -> Int
widthChars Plot
cfg) (Plot -> Int
heightChars Plot
cfg) (Plot -> Text
plotTitle Plot
cfg)

-- | Gaussian / normal-distribution chart in standard-deviation (z-score) units.
-- Mirrors 'Granite.gauss': a KDE bell curve with a stippled scatter fill, an
-- x-axis labelled in σ units, and lollipop annotations for named markers
-- (the largest z highlighted as the outlier).
gauss ::
    -- | Population sample (used to compute μ and σ)
    [Double] ->
    -- | Named markers as @(label, raw value)@; the largest z is highlighted
    [(Text, Double)] ->
    Plot ->
    Text
gauss :: [Double] -> [(Text, Double)] -> Plot -> Text
gauss [Double]
population [(Text, Double)]
markers Plot
cfg =
    let n :: Int
n = [Double] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Double]
population
        mu :: Double
mu = if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Double
0 else [Double] -> Double
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Double]
population Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
        var :: Double
var =
            if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2
                then Double
0
                else [Double] -> Double
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [(Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
mu) Double -> Int -> Double
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
2 :: Int) | Double
x <- [Double]
population] Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
        sigma :: Double
sigma = Double -> Double
forall {a}. Floating a => a -> a
sqrt (Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
var Double
eps)
        z :: Double -> Double
z Double
v = (Double
v Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
mu) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
sigma

        zsData :: [Double]
zsData = (Double -> Double) -> [Double] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map Double -> Double
z [Double]
population
        zsMark :: [(Text, Double)]
zsMark = [(Text
name, Double -> Double
z Double
v) | (Text
name, Double
v) <- [(Text, Double)]
markers]
        maxMarkerZ :: Double
maxMarkerZ = [Double] -> Double
maximum' (Double
0 Double -> [Double] -> [Double]
forall a. a -> [a] -> [a]
: [Double
zz | (Text
_, Double
zz) <- [(Text, Double)]
zsMark])

        allZ :: [Double]
allZ = [Double]
zsData [Double] -> [Double] -> [Double]
forall a. Semigroup a => a -> a -> a
<> [Double
zz | (Text
_, Double
zz) <- [(Text, Double)]
zsMark]
        zlo0 :: Double
zlo0 = [Double] -> Double
minimum' (Double
0 Double -> [Double] -> [Double]
forall a. a -> [a] -> [a]
: [Double]
allZ)
        zhi0 :: Double
zhi0 = [Double] -> Double
maximum' (Double
1 Double -> [Double] -> [Double]
forall a. a -> [a] -> [a]
: [Double]
allZ)
        padz :: Double
padz = (Double
zhi0 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
zlo0) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
0.06 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
1e-9
        zmin :: Double
zmin = Double
zlo0 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
padz
        zmax :: Double
zmax = Double
zhi0 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
padz

        -- Gaussian KDE in z-space (Silverman bandwidth).
        sdz :: Double
sdz =
            let m :: Double
m = [Double] -> Double
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Double]
zsData Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 Int
n)
             in Double -> Double
forall {a}. Floating a => a -> a
sqrt (Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
eps ([Double] -> Double
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [(Double
zz Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
m) Double -> Int -> Double
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
2 :: Int) | Double
zz <- [Double]
zsData] Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))))
        hbw :: Double
hbw = Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
1e-6 (Double
1.06 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
sdz Double -> Double -> Double
forall a. Num a => a -> a -> a
* Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 Int
n) Double -> Double -> Double
forall a. Floating a => a -> a -> a
** (-Double
0.2))
        dens :: Double -> Double
dens Double
x =
            [Double] -> Double
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Double -> Double
forall {a}. Floating a => a -> a
exp (Double -> Double
forall a. Num a => a -> a
negate ((Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
zz) Double -> Int -> Double
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
2 :: Int)) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
hbw Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
hbw)) | Double
zz <- [Double]
zsData]
                Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 Int
n) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
hbw Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall {a}. Floating a => a -> a
sqrt (Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
forall a. Floating a => a
pi))

        lay :: Layout
lay = Plot -> Layout
mkLayout Plot
cfg
        baseY :: Double
baseY = Layout -> Double
plotY Layout
lay Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Layout -> Double
plotH Layout
lay
        mx :: Double -> Double
mx = Layout -> Double -> Double -> Double -> Double
mapX Layout
lay Double
zmin Double
zmax

        nGrid :: Int
nGrid = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
8 (Plot -> Int
widthChars Plot
cfg Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
3)
        zAt :: a -> Double
zAt a
i = Double
zmin Double -> Double -> Double
forall a. Num a => a -> a -> a
+ a -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
i Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nGrid Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
zmax Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
zmin)
        densVals :: [Double]
densVals = [Double -> Double
dens (Int -> Double
forall {a}. Integral a => a -> Double
zAt Int
i) | Int
i <- [Int
0 .. Int
nGrid]]
        dmax :: Double
dmax = [Double] -> Double
maximum' [Double]
densVals Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
eps
        topFrac :: Double
topFrac = Double
0.9
        densToY :: Double -> Double
densToY Double
d = Double
baseY Double -> Double -> Double
forall a. Num a => a -> a -> a
- (Double
d Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
dmax) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
topFrac Double -> Double -> Double
forall a. Num a => a -> a -> a
* Layout -> Double
plotH Layout
lay

        curvePts :: [(Double, Double)]
curvePts = [(Double -> Double
mx (Int -> Double
forall {a}. Integral a => a -> Double
zAt Int
i), Double -> Double
densToY Double
d) | (Int
i, Double
d) <- [Int] -> [Double] -> [(Int, Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 :: Int ..] [Double]
densVals]

        -- Light fill under the curve.
        fillPath :: Text
fillPath =
            Text -> Text -> Text -> Text
svgPath
                ( Text
"M "
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Double -> Text
showD ((Double, Double) -> Double
forall a b. (a, b) -> a
fst ([(Double, Double)] -> (Double, Double)
forall a. HasCallStack => [a] -> a
head [(Double, Double)]
curvePts))
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" "
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Double -> Text
showD Double
baseY
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" "
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
T.concat [Text
"L " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Double -> Text
showD Double
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Double -> Text
showD Double
y Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " | (Double
x, Double
y) <- [(Double, Double)]
curvePts]
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"L "
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Double -> Text
showD ((Double, Double) -> Double
forall a b. (a, b) -> a
fst ([(Double, Double)] -> (Double, Double)
forall a. HasCallStack => [a] -> a
last [(Double, Double)]
curvePts))
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" "
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Double -> Text
showD Double
baseY
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" Z"
                )
                Text
"#dfe4e8"
                (Text -> Text -> Text
attr Text
"fill-opacity" Text
"0.6")
        curveStroke :: Text
curveStroke = [(Double, Double)] -> Text -> Double -> Text
svgPolyline [(Double, Double)]
curvePts Text
"#5b6770" Double
2

        -- Faint dashed guide at the mean (z = 0).
        meanLine :: Text
meanLine
            | Double
zmin Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
0 Bool -> Bool -> Bool
&& Double
zmax Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
0 =
                Text
"<line"
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text -> Text
attr Text
"x1" (Double -> Text
showD (Double -> Double
mx Double
0))
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text -> Text
attr Text
"y1" (Double -> Text
showD (Layout -> Double
plotY Layout
lay))
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text -> Text
attr Text
"x2" (Double -> Text
showD (Double -> Double
mx Double
0))
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text -> Text
attr Text
"y2" (Double -> Text
showD Double
baseY)
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text -> Text
attr Text
"stroke" Text
"#cfd6dc"
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text -> Text
attr Text
"stroke-width" Text
"1"
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text -> Text
attr Text
"stroke-dasharray" Text
"3 4"
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/>\n"
            | Bool
otherwise = Text
""

        -- Deterministic scatter fill, dot count per column ∝ curve height.
        nx :: Int
nx = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
4 (Plot -> Int
widthChars Plot
cfg)
        cellPx :: Double
cellPx = Double
14 :: Double
        hashI :: a -> a
hashI a
a = let b :: a
b = a
a a -> a -> a
forall a. Num a => a -> a -> a
* a
1103515245 a -> a -> a
forall a. Num a => a -> a -> a
+ a
12345 in a
b a -> a -> a
forall a. Num a => a -> a -> a
* a
1103515245 a -> a -> a
forall a. Num a => a -> a -> a
+ a
12345
        frac :: a -> a
frac a
k = a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a -> a
forall a. Num a => a -> a
abs (a -> a
forall a. Num a => a -> a
hashI a
k) a -> a -> a
forall a. Integral a => a -> a -> a
`mod` a
1000) a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
1000
        dots :: Text
dots =
            [Text] -> Text
T.concat
                [ let zc :: Double
zc = Double
zmin Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
gx Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
0.5) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nx Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
zmax Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
zmin)
                      cxc :: Double
cxc = Double -> Double
mx Double
zc
                      yTop :: Double
yTop = Double -> Double
densToY (Double -> Double
dens Double
zc)
                      colHpx :: Double
colHpx = Double
baseY Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
yTop
                      rowsHere :: Int
rowsHere = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double
colHpx Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
cellPx)) :: Int
                   in [Text] -> Text
T.concat
                        [ let kk :: Int
kk = Int
gx Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
gy
                           in if Int -> Int
forall a. Num a => a -> a
abs (Int -> Int
forall a. Num a => a -> a
hashI (Int
kk Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
31 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7)) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
100 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
78
                                then Text
""
                                else
                                    let jx :: Double
jx = (Int -> Double
forall {a} {a}. (Fractional a, Integral a) => a -> a
frac (Int
kk Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
0.5) Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Layout -> Double
plotW Layout
lay Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nx)
                                        jy :: Double
jy = (Int -> Double
forall {a} {a}. (Fractional a, Integral a) => a -> a
frac (Int
kk Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
5 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
0.5) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
cellPx
                                        dx :: Double
dx = Double
cxc Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
jx
                                        dy :: Double
dy = Double
yTop Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
gy Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
0.5) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 Int
rowsHere) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
colHpx Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
jy
                                     in Double -> Double -> Double -> Text -> Text
svgCircle Double
dx Double
dy Double
1.3 Text
"#aeb4bb"
                        | Int
gy <- [Int
0 .. Int
rowsHere Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
                        ]
                | Int
gx <- [Int
0 .. Int
nx Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
                ]

        -- σ x-axis: a tick for each integer standard deviation in range.
        xBaseline :: Text
xBaseline = Double -> Double -> Double -> Double -> Text -> Double -> Text
svgLine (Layout -> Double
plotX Layout
lay) Double
baseY (Layout -> Double
plotX Layout
lay Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Layout -> Double
plotW Layout
lay) Double
baseY Text
"#aaa" Double
1
        sigInts :: [Int]
sigInts = [Int
k | Int
k <- [Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
ceiling Double
zmin .. Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor Double
zmax :: Int], Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0]
        xticks :: Text
xticks =
            [Text] -> Text
T.concat
                [ let xx :: Double
xx = Double -> Double
mx (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
k)
                   in Double -> Double -> Double -> Double -> Text -> Double -> Text
svgLine Double
xx Double
baseY Double
xx (Double
baseY Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
5) Text
"#aaa" Double
1
                        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Text -> Text -> Double -> Text -> Text
svgText Double
xx (Double
baseY Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
18) Text
"middle" Text
"#777" Double
labelFontSize (String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
k) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"σ")
                | Int
k <- [Int]
sigInts
                ]
        avgLbl :: Text
avgLbl
            | Double
zmin Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
0 Bool -> Bool -> Bool
&& Double
zmax Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
0 =
                Double -> Double -> Text -> Text -> Double -> Text -> Text
svgText (Double -> Double
mx Double
0) (Double
baseY Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
18) Text
"middle" Text
"#999" Double
labelFontSize Text
"average"
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Text -> Text -> Double -> Text -> Text
svgText (Double -> Double
mx Double
0) (Double
baseY Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
32) Text
"middle" Text
"#bbb" (Double
labelFontSize Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
1) (String -> Text
T.pack (Maybe Int -> Double -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
2) Double
mu String
""))
            | Bool
otherwise = Text
""

        -- Lollipop annotations, stacked into lanes so labels never overlap.
        sigmaTxt :: a -> Text
sigmaTxt a
zz = String -> Text
T.pack (Maybe Int -> a -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1) a
zz String
"") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"σ"
        lblOf :: (Text, a) -> Text
lblOf (Text
name, a
zz) = Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> a -> Text
forall {a}. RealFloat a => a -> Text
sigmaTxt a
zz
        wpx :: Text -> a
wpx Text
s = Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Text -> Int
T.length Text
s) a -> a -> a
forall a. Num a => a -> a -> a
* a
6.2
        sortedM :: [(Text, Double)]
sortedM = ((Text, Double) -> Double) -> [(Text, Double)] -> [(Text, Double)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
List.sortOn (\(Text
_, Double
zz) -> Double -> Double
mx Double
zz) [(Text, Double)]
zsMark
        updLane :: [a] -> Int -> a -> [a]
updLane [a]
occ Int
i a
v =
            let need :: Int
need = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
occ
                occ' :: [a]
occ' = if Int
need Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then [a]
occ [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
<> Int -> a -> [a]
forall a. Int -> a -> [a]
replicate Int
need (-a
1 a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
0) else [a]
occ
             in [if Int
j Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
i then a
v else a
e | (Int
j, a
e) <- [Int] -> [a] -> [(Int, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 ..] [a]
occ']
        place :: [Double] -> [(Text, Double)] -> [(Int, Text, Double, Text)]
place [Double]
_ [] = []
        place [Double]
occ ((Text
name, Double
zz) : [(Text, Double)]
rest) =
            let s :: Text
s = (Text, Double) -> Text
forall {a}. RealFloat a => (Text, a) -> Text
lblOf (Text
name, Double
zz)
                cx :: Double
cx = Double -> Double
mx Double
zz
                start :: Double
start = Double
cx Double -> Double -> Double
forall a. Num a => a -> a -> a
- Text -> Double
forall {a}. Fractional a => Text -> a
wpx Text
s Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2
                pick :: [Double] -> t -> t
pick [Double]
es t
i = case [Double]
es of
                    [] -> t
i
                    (Double
e : [Double]
es') -> if Double
start Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
e Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
6 then t
i else [Double] -> t -> t
pick [Double]
es' (t
i t -> t -> t
forall a. Num a => a -> a -> a
+ t
1)
                row :: Int
row = [Double] -> Int -> Int
forall {t}. Num t => [Double] -> t -> t
pick [Double]
occ Int
0
             in (Int
row, Text
name, Double
zz, Text
s) (Int, Text, Double, Text)
-> [(Int, Text, Double, Text)] -> [(Int, Text, Double, Text)]
forall a. a -> [a] -> [a]
: [Double] -> [(Text, Double)] -> [(Int, Text, Double, Text)]
place ([Double] -> Int -> Double -> [Double]
forall {a}. Fractional a => [a] -> Int -> a -> [a]
updLane [Double]
occ Int
row (Double
cx Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Text -> Double
forall {a}. Fractional a => Text -> a
wpx Text
s Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2)) [(Text, Double)]
rest
        placed :: [(Int, Text, Double, Text)]
placed = [Double] -> [(Text, Double)] -> [(Int, Text, Double, Text)]
place [] [(Text, Double)]
sortedM

        anchorFor :: Double -> a
anchorFor Double
cx
            | Double
cx Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Layout -> Double
plotX Layout
lay Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Layout -> Double
plotW Layout
lay Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
0.82 = a
"end"
            | Double
cx Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Layout -> Double
plotX Layout
lay Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Layout -> Double
plotW Layout
lay Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
0.18 = a
"start"
            | Bool
otherwise = a
"middle"

        markerEls :: Text
markerEls =
            [Text] -> Text
T.concat
                [ let cx :: Double
cx = Double -> Double
mx Double
zz
                      isHi :: Bool
isHi = Double
zz Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
maxMarkerZ Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
eps
                      col :: Text
col = if Bool
isHi then Text
"#ff2e88" else Text
"#3a86c8"
                      labelY :: Double
labelY = Layout -> Double
plotY Layout
lay Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
12 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
row Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
15
                      fontSz :: Double
fontSz = if Bool
isHi then Double
labelFontSize Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
2 else Double
labelFontSize
                   in Double -> Double -> Double -> Double -> Text -> Double -> Text
svgLine Double
cx Double
baseY Double
cx (Double
labelY Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
4) Text
col (if Bool
isHi then Double
1.8 else Double
1)
                        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Double -> Text -> Text
svgCircle Double
cx Double
baseY (if Bool
isHi then Double
6 else Double
3) Text
col
                        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Double -> Double -> Text -> Text -> Double -> Text -> Text
svgText Double
cx Double
labelY (Double -> Text
forall {a}. IsString a => Double -> a
anchorFor Double
cx) Text
col Double
fontSz Text
s
                | (Int
row, Text
_name, Double
zz, Text
s) <- [(Int, Text, Double, Text)]
placed
                ]

        title :: Text
title = Plot -> Layout -> Text
drawTitle Plot
cfg Layout
lay
     in Double -> Double -> Text -> Text
svgDoc
            (Layout -> Double
svgW Layout
lay)
            (Layout -> Double
svgH Layout
lay)
            (Text
title Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fillPath Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
meanLine Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
dots Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
curveStroke Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
xBaseline Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
xticks Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
avgLbl Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
markerEls)