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

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

An SVG-based plotting backend that mirrors the API of "Granite".
Every chart function returns a self-contained SVG document as 'Text'.

= Basic Usage

@
{\-# LANGUAGE OverloadedStrings #-\}
import qualified Data.Text.IO as T
import Granite.Svg

main = do
  let chart = bars [(\"Q1\",12),(\"Q2\",18),(\"Q3\",9),(\"Q4\",15)]
                   defPlot { plotTitle = \"Sales\" }
  T.writeFile \"chart.svg\" chart
@
-}
module Granite.Svg (
    -- * Re-exports from Granite
    Plot (..),
    defPlot,
    LegendPos (..),
    Color (..),
    AxisEnv (..),
    LabelFormatter,
    Bins (..),
    bins,
    series,

    -- * Chart types (SVG output)
    scatter,
    lineGraph,
    bars,
    stackedBars,
    histogram,
    pie,
    heatmap,
    boxPlot,
) where

import Data.List qualified as List
import Data.Maybe (fromMaybe, listToMaybe)
import Data.Text (Text)
import Data.Text qualified as T
import Granite (
    AxisEnv (..),
    Bins (..),
    Color (..),
    LabelFormatter,
    LegendPos (..),
    Plot (..),
    bins,
    defPlot,
    series,
 )
import Numeric (showFFloat)

------------------------------------------------------------------------
-- Scaling constants
------------------------------------------------------------------------

-- | Pixels per terminal character width.
cW :: Double
cW :: Double
cW = Double
10

-- | Pixels per terminal character height.
cH :: Double
cH :: Double
cH = Double
16

-- | Font size for axis labels (px).
labelFontSize :: Double
labelFontSize :: Double
labelFontSize = Double
11

-- | Font size for chart title (px).
titleFontSize :: Double
titleFontSize :: Double
titleFontSize = Double
14

------------------------------------------------------------------------
-- Colour mapping  (ANSI → hex)
------------------------------------------------------------------------

colorHex :: Color -> Text
colorHex :: Color -> Text
colorHex Color
Default = Text
"#555555"
colorHex Color
Black = Text
"#2c3e50"
colorHex Color
Red = Text
"#c0392b"
colorHex Color
Green = Text
"#27ae60"
colorHex Color
Yellow = Text
"#f39c12"
colorHex Color
Blue = Text
"#2980b9"
colorHex Color
Magenta = Text
"#8e44ad"
colorHex Color
Cyan = Text
"#16a085"
colorHex Color
White = Text
"#ecf0f1"
colorHex Color
BrightBlack = Text
"#7f8c8d"
colorHex Color
BrightRed = Text
"#e74c3c"
colorHex Color
BrightGreen = Text
"#2ecc71"
colorHex Color
BrightYellow = Text
"#f1c40f"
colorHex Color
BrightBlue = Text
"#3498db"
colorHex Color
BrightMagenta = Text
"#9b59b6"
colorHex Color
BrightCyan = Text
"#1abc9c"
colorHex Color
BrightWhite = Text
"#bdc3c7"

-- Heatmap intensity palette (low → high).
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"
    ]

------------------------------------------------------------------------
-- Helpers copied from Granite (not exported there)
------------------------------------------------------------------------

clamp :: (Ord a) => a -> a -> a -> a
clamp :: forall a. Ord a => a -> a -> a -> a
clamp a
lo a
hi a
x = a -> a -> a
forall a. Ord a => a -> a -> a
max a
lo (a -> a -> a
forall a. Ord a => a -> a -> a
min a
hi a
x)

eps :: Double
eps :: Double
eps = Double
1e-12

minimum', maximum' :: [Double] -> Double
minimum' :: [Double] -> Double
minimum' [] = Double
0
minimum' [Double]
xs = [Double] -> Double
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Double]
xs
maximum' :: [Double] -> Double
maximum' [] = Double
1
maximum' [Double]
xs = [Double] -> Double
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Double]
xs

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

quartiles :: [Double] -> (Double, Double, Double, Double, Double)
quartiles :: [Double] -> (Double, Double, Double, Double, Double)
quartiles [] = (Double
0, Double
0, Double
0, Double
0, Double
0)
quartiles [Double]
xs =
    let sorted :: [Double]
sorted = [Double] -> [Double]
forall a. Ord a => [a] -> [a]
List.sort [Double]
xs
        n :: Int
n = [Double] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Double]
sorted
        q1Idx :: Int
q1Idx = Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
4
        q2Idx :: Int
q2Idx = Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
        q3Idx :: Int
q3Idx = Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
4
        getIdx :: Int -> Double
getIdx Int
i = if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n then [Double]
sorted [Double] -> Int -> Double
forall a. HasCallStack => [a] -> Int -> a
!! Int
i else [Double] -> Double
forall a. HasCallStack => [a] -> a
last [Double]
sorted
     in if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
5
            then let m :: Double
m = [Double] -> Double
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Double]
xs 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
m, Double
m, Double
m, Double
m, Double
m)
            else
                ( Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
0 ([Double] -> Maybe Double
forall a. [a] -> Maybe a
listToMaybe [Double]
sorted)
                , Int -> Double
getIdx Int
q1Idx
                , Int -> Double
getIdx Int
q2Idx
                , Int -> Double
getIdx Int
q3Idx
                , [Double] -> Double
forall a. HasCallStack => [a] -> a
last [Double]
sorted
                )

normalize :: [(Text, Double)] -> [(Text, Double)]
normalize :: [(Text, Double)] -> [(Text, Double)]
normalize [(Text, Double)]
xs =
    let s :: Double
s = [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 (Double -> Double
forall a. Num a => a -> a
abs (Double -> Double)
-> ((Text, Double) -> Double) -> (Text, Double) -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Double) -> Double
forall a b. (a, b) -> b
snd) [(Text, Double)]
xs) Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
1e-12
     in [(Text
n, Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
0 (Double
v Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
s)) | (Text
n, Double
v) <- [(Text, Double)]
xs]

ticks1D ::
    Int ->
    Int ->
    (Double, Double) ->
    Bool ->
    [(Int, Double)]
ticks1D :: Int -> Int -> (Double, Double) -> Bool -> [(Int, Double)]
ticks1D Int
screenLen Int
want (Double
vmin, Double
vmax) Bool
invertY =
    let n :: Int
n = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
2 Int
want
        lastIx :: Int
lastIx = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
screenLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
        toVal :: Double -> Double
toVal Double
t =
            if Bool
invertY
                then Double
vmax Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
t Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
vmax Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
vmin)
                else 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
vmax Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
vmin)
        mk' :: p -> (a, Double)
mk' p
k =
            let t :: Double
t = if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then Double
0 else p -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral p
k 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)
                pos :: a
pos = Double -> a
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Double
t Double -> Double -> Double
forall a. Num a => a -> a -> a
* Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
lastIx)
             in (a
pos, Double -> Double
toVal Double
t)
        raw :: [(Int, Double)]
raw = [Int -> (Int, Double)
forall {p} {a}. (Integral p, Integral a) => p -> (a, Double)
mk' Int
k | Int
k <- [Int
0 .. Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]]
     in ((Int, Double) -> (Int, Double) -> Bool)
-> [(Int, Double)] -> [(Int, Double)]
forall a. (a -> a -> Bool) -> [a] -> [a]
List.nubBy (\(Int, Double)
a (Int, Double)
b -> (Int, Double) -> Int
forall a b. (a, b) -> a
fst (Int, Double)
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (Int, Double) -> Int
forall a b. (a, b) -> a
fst (Int, Double)
b) [(Int, Double)]
raw

------------------------------------------------------------------------
-- Layout record
------------------------------------------------------------------------

data Layout = Layout
    { Layout -> Double
svgW :: !Double
    , Layout -> Double
svgH :: !Double
    , Layout -> Double
plotX :: !Double -- left edge of plot area
    , Layout -> Double
plotY :: !Double -- top edge of plot area
    , Layout -> Double
plotW :: !Double -- width of plot area
    , Layout -> Double
plotH :: !Double -- height of plot area
    }

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 -- extra padding
        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
            }

------------------------------------------------------------------------
-- SVG primitives
------------------------------------------------------------------------

showD :: Double -> Text
showD :: Double -> Text
showD Double
d
    | Double
d Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Double
d :: Int) = String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Double
d :: Int))
    | Bool
otherwise = 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
d String
"")

escXml :: Text -> Text
escXml :: Text -> Text
escXml =
    HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"&" Text
"&amp;"
        (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"<" Text
"&lt;"
        (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
">" Text
"&gt;"
        (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"\"" Text
"&quot;"

attr :: Text -> Text -> Text
attr :: Text -> Text -> Text
attr Text
k Text
v = Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
k Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"=\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
v Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\""

svgDoc :: Double -> Double -> Text -> Text
svgDoc :: Double -> Double -> Text -> Text
svgDoc Double
w Double
h Text
content =
    Text
"<svg xmlns=\"http://www.w3.org/2000/svg\""
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text -> Text
attr Text
"viewBox" (Text
"0 0 " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Double -> Text
showD Double
w 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
h)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text -> Text
attr Text
"width" (Double -> Text
showD Double
w)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text -> Text
attr Text
"height" (Double -> Text
showD Double
h)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text -> Text
attr Text
"font-family" Text
"system-ui, -apple-system, sans-serif"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
">\n"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"<rect width=\"100%\" height=\"100%\" fill=\"white\"/>\n"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
content
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"</svg>\n"

svgRect :: Double -> Double -> Double -> Double -> Text -> Text -> Text
svgRect :: Double -> Double -> Double -> Double -> Text -> Text -> Text
svgRect Double
x Double
y Double
w Double
h Text
fill Text
extra =
    Text
"<rect"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text -> Text
attr Text
"x" (Double -> Text
showD Double
x)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text -> Text
attr Text
"y" (Double -> Text
showD Double
y)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text -> Text
attr Text
"width" (Double -> Text
showD Double
w)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text -> Text
attr Text
"height" (Double -> Text
showD Double
h)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text -> Text
attr Text
"fill" Text
fill
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
extra
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/>\n"

svgCircle :: Double -> Double -> Double -> Text -> Text
svgCircle :: Double -> Double -> Double -> Text -> Text
svgCircle Double
cx Double
cy Double
r Text
fill =
    Text
"<circle"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text -> Text
attr Text
"cx" (Double -> Text
showD Double
cx)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text -> Text
attr Text
"cy" (Double -> Text
showD Double
cy)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text -> Text
attr Text
"r" (Double -> Text
showD Double
r)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text -> Text
attr Text
"fill" Text
fill
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/>\n"

svgLine :: Double -> Double -> Double -> Double -> Text -> Double -> Text
svgLine :: Double -> Double -> Double -> Double -> Text -> Double -> Text
svgLine Double
x1 Double
y1 Double
x2 Double
y2 Text
stroke Double
strokeW =
    Text
"<line"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text -> Text
attr Text
"x1" (Double -> Text
showD Double
x1)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text -> Text
attr Text
"y1" (Double -> Text
showD Double
y1)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text -> Text
attr Text
"x2" (Double -> Text
showD Double
x2)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text -> Text
attr Text
"y2" (Double -> Text
showD Double
y2)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text -> Text
attr Text
"stroke" Text
stroke
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text -> Text
attr Text
"stroke-width" (Double -> Text
showD Double
strokeW)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/>\n"

svgPolyline :: [(Double, Double)] -> Text -> Double -> Text
svgPolyline :: [(Double, Double)] -> Text -> Double -> Text
svgPolyline [(Double, Double)]
pts Text
stroke Double
strokeW =
    Text
"<polyline"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text -> Text
attr Text
"points" (Text -> [Text] -> Text
T.intercalate Text
" " [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 | (Double
x, Double
y) <- [(Double, Double)]
pts])
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text -> Text
attr Text
"fill" Text
"none"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text -> Text
attr Text
"stroke" Text
stroke
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text -> Text
attr Text
"stroke-width" (Double -> Text
showD Double
strokeW)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text -> Text
attr Text
"stroke-linejoin" Text
"round"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text -> Text
attr Text
"stroke-linecap" Text
"round"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/>\n"

svgText :: Double -> Double -> Text -> Text -> Double -> Text -> Text
svgText :: Double -> Double -> Text -> Text -> Double -> Text -> Text
svgText Double
x Double
y Text
anchor Text
fill Double
size Text
content =
    Text
"<text"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text -> Text
attr Text
"x" (Double -> Text
showD Double
x)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text -> Text
attr Text
"y" (Double -> Text
showD Double
y)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text -> Text
attr Text
"text-anchor" Text
anchor
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text -> Text
attr Text
"fill" Text
fill
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text -> Text
attr Text
"font-size" (Double -> Text
showD Double
size)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
">"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
escXml Text
content
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"</text>\n"

svgPath :: Text -> Text -> Text -> Text
svgPath :: Text -> Text -> Text -> Text
svgPath Text
d Text
fill Text
extra =
    Text
"<path"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text -> Text
attr Text
"d" Text
d
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text -> Text
attr Text
"fill" Text
fill
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
extra
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/>\n"

------------------------------------------------------------------------
-- Shared drawing: title, axes, legend
------------------------------------------------------------------------

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

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

        -- Y ticks
        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 -- grid line
                | (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
                ]

        -- X ticks
        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 -- grid line
                | (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

        -- Y ticks (value axis)
        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
                ]

        -- X category labels
        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

------------------------------------------------------------------------
-- Coordinate mapping
------------------------------------------------------------------------

-- | Map data X to SVG X.
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

-- | Map data Y to SVG Y (flipped: higher values → lower Y).
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
------------------------------------------------------------------------

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)

------------------------------------------------------------------------
-- LINE GRAPH
------------------------------------------------------------------------

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

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 -- 15% gap on each side
        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)

------------------------------------------------------------------------
-- STACKED BARS
------------------------------------------------------------------------

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

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

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

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 -- flip: row 0 at bottom
                          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]
                ]

        -- Axis labels: column indices on x, row indices on y
        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]
                ]

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

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

------------------------------------------------------------------------
-- BOX PLOT
------------------------------------------------------------------------

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

                      -- Whisker: min to Q1
                      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

                      -- Box: Q1 to Q3
                      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"
                            )

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

                      -- Whisker: Q3 to max
                      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)

addAt :: [Int] -> Int -> Int -> [Int]
addAt :: [Int] -> Int -> Int -> [Int]
addAt [Int]
xs Int
i Int
v = [Int] -> Int -> (Int -> Int) -> [Int]
forall a. [a] -> Int -> (a -> a) -> [a]
updateAt [Int]
xs Int
i (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
v)

updateAt :: [a] -> Int -> (a -> a) -> [a]
updateAt :: forall a. [a] -> Int -> (a -> a) -> [a]
updateAt [a]
xs Int
i a -> a
f
    | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = [a]
xs
    | Bool
otherwise = [a] -> Int -> [a]
forall {t}. (Eq t, Num t) => [a] -> t -> [a]
go [a]
xs Int
i
  where
    go :: [a] -> t -> [a]
go [] t
_ = []
    go (a
x : [a]
rest) t
0 = a -> a
f a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
rest
    go (a
x : [a]
rest) t
n = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> t -> [a]
go [a]
rest (t
n t -> t -> t
forall a. Num a => a -> a -> a
- t
1)