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

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

A terminal-based plotting library that renders beautiful charts using Unicode
Braille characters and ANSI colors. Granite provides a variety of chart types
including scatter plots, line graphs, bar charts, pie charts, histograms,
heatmaps, and box plots.

= Basic Usage

Create a simple scatter plot:

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

main = do
  let points = [(x, sin x) | x <- [0, 0.1 .. 6.28]]
      chart = scatter [series "sin(x)" points] defPlot
  T.putStrLn chart
@

= Customization

Plots can be customized using record update syntax:

@
let customPlot = defPlot
      { widthChars = 80
      , heightChars = 30
      , plotTitle = "My Chart"
      , legendPos = LegendBottom
      }
@

= Terminal Requirements

This library requires a terminal that supports:

  * Unicode (specifically Braille patterns U+2800-U+28FF)
  * ANSI color codes
  * Monospace font with proper Braille character rendering
-}
module Granite (
    -- * Plot Configuration
    Plot (..),
    defPlot,
    LegendPos (..),

    -- * Formatting
    Color (..),
    LabelFormatter,
    AxisEnv (..),

    -- * Data Preparation
    series,
    bins,
    Bins (..),

    -- * Chart Types
    histogram,
    bars,
    scatter,
    pie,
    stackedBars,
    heatmap,
    lineGraph,
    boxPlot,

    -- * Plotly-Express-style helpers
    area,
    ribbon,
    density,
    errorBars,
    funnel,
    polarLine,
    waterfall,
    distPlot,
    gauss,

    -- * Differential flame graphs
    FlameNode (..),
    FlameOpts (..),
    defFlameOpts,
    flameDiff,
) where

import Data.Bits (xor, (.&.))
import Data.List qualified as List
import Data.Maybe
import Data.Text (Text)
import Data.Text qualified as Text
import Numeric (showEFloat, showFFloat)
import Text.Printf

import Granite.Color (Color (..), paint, paletteColors, pieColors)
import Granite.Flame (
    FlameNode (..),
    FlameOpts (..),
    defFlameOpts,
    flameDiff,
 )
import Granite.Internal.LegacyChart qualified as LC
import Granite.Internal.Util (
    addAt,
    angleWithin,
    clamp,
    ellipsisize,
    eps,
    gridWidth,
    justifyRight,
    maximum',
    minimum',
    mod',
    normalize,
    quartiles,
    setAt,
    ticks1D,
    updateAt,
    wcswidth,
 )
import Granite.Render.Pipeline (renderChartTerminal)
import Granite.Render.Terminal (
    Canvas (..),
    fillDotsC,
    lineDotsC,
    newCanvas,
    renderCanvas,
    setDotC,
 )

-- | Position of the legend in the plot.
data LegendPos
    = -- | Display legend on the right side of the plot
      LegendRight
    | -- | Display legend below the plot
      LegendBottom
    | -- | Do not display legend.
      LegendNone
    deriving (LegendPos -> LegendPos -> Bool
(LegendPos -> LegendPos -> Bool)
-> (LegendPos -> LegendPos -> Bool) -> Eq LegendPos
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LegendPos -> LegendPos -> Bool
== :: LegendPos -> LegendPos -> Bool
$c/= :: LegendPos -> LegendPos -> Bool
/= :: LegendPos -> LegendPos -> Bool
Eq, Int -> LegendPos -> ShowS
[LegendPos] -> ShowS
LegendPos -> String
(Int -> LegendPos -> ShowS)
-> (LegendPos -> String)
-> ([LegendPos] -> ShowS)
-> Show LegendPos
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LegendPos -> ShowS
showsPrec :: Int -> LegendPos -> ShowS
$cshow :: LegendPos -> String
show :: LegendPos -> String
$cshowList :: [LegendPos] -> ShowS
showList :: [LegendPos] -> ShowS
Show)

{- | Plot configuration parameters.

Controls the appearance and layout of generated charts.
-}
data Plot = Plot
    { Plot -> Int
widthChars :: Int
    -- ^ Width of the plot area in terminal characters (default: 60)
    , Plot -> Int
heightChars :: Int
    -- ^ Height of the plot area in terminal characters (default: 20)
    , Plot -> Int
leftMargin :: Int
    -- ^ Space reserved for y-axis labels (default: 6)
    , Plot -> Int
bottomMargin :: Int
    -- ^ Space reserved for x-axis labels (default: 2)
    , Plot -> Int
titleMargin :: Int
    -- ^ Space above the plot for the title (default: 1)
    , Plot -> (Maybe Double, Maybe Double)
xBounds :: (Maybe Double, Maybe Double)
    {- ^ Optional manual x-axis bounds (min, max).
    'Nothing' uses automatic bounds with 5% padding.
    -}
    , Plot -> (Maybe Double, Maybe Double)
yBounds :: (Maybe Double, Maybe Double)
    {- ^ Optional manual y-axis bounds (min, max).
    'Nothing' uses automatic bounds with 5% padding.
    -}
    , Plot -> Text
plotTitle :: Text
    -- ^ Title displayed above the plot (default: empty)
    , Plot -> LegendPos
legendPos :: LegendPos
    -- ^ Position of the legend (default: 'LegendRight')
    , Plot -> [Color]
colorPalette :: [Color]
    -- ^ Color palette that'll be used by the plot.
    , Plot -> LabelFormatter
xFormatter :: LabelFormatter
    -- ^ Formatter for x-axis labels.
    , Plot -> LabelFormatter
yFormatter :: LabelFormatter
    -- ^ Formatter for y-axis labels.
    , Plot -> Int
xNumTicks :: Int
    -- ^ Number of ticks on the x axis.
    , Plot -> Int
yNumTicks :: Int
    -- ^ Number of ticks on the y axis.
    }

{- | Default plot configuration.

Creates a 60×20 character plot with reasonable defaults:

@
defPlot = Plot
  { widthChars   = 60
  , heightChars  = 20
  , leftMargin   = 6
  , bottomMargin = 2
  , titleMargin  = 1
  , xBounds      = (Nothing, Nothing)
  , yBounds      = (Nothing, Nothing)
  , plotTitle    = ""
  , legendPos    = LegendRight
  , colorPalette = [ BrightBlue, BrightMagenta, BrightCyan, BrightGreen, BrightYellow, BrightRed, BrightWhite, BrightBlack]
  , xFormatter   = \\ _ _ v -> show v
  , yFormatter   = \\ _ _ v -> show v
  , xNumTicks    = 2
  , yNumTicks    = 2
  }
@
-}
defPlot :: Plot
defPlot :: Plot
defPlot =
    Plot
        { widthChars :: Int
widthChars = Int
60
        , heightChars :: Int
heightChars = Int
20
        , leftMargin :: Int
leftMargin = Int
6
        , bottomMargin :: Int
bottomMargin = Int
2
        , titleMargin :: Int
titleMargin = Int
1
        , xBounds :: (Maybe Double, Maybe Double)
xBounds = (Maybe Double
forall a. Maybe a
Nothing, Maybe Double
forall a. Maybe a
Nothing)
        , yBounds :: (Maybe Double, Maybe Double)
yBounds = (Maybe Double
forall a. Maybe a
Nothing, Maybe Double
forall a. Maybe a
Nothing)
        , plotTitle :: Text
plotTitle = Text
""
        , legendPos :: LegendPos
legendPos = LegendPos
LegendRight
        , colorPalette :: [Color]
colorPalette = [Color]
paletteColors
        , xFormatter :: LabelFormatter
xFormatter = LabelFormatter
fmt
        , yFormatter :: LabelFormatter
yFormatter = LabelFormatter
fmt
        , xNumTicks :: Int
xNumTicks = Int
3
        , yNumTicks :: Int
yNumTicks = Int
3
        }

{- | Axis-aware, width-limited, tick-label formatter.

Given:

   * axis context
   * a per-tick width budget (in terminal cells)
   * and the raw tick value.

returns the label to render.
-}
type LabelFormatter =
    -- | Axis context (domain, tick index/count, etc)
    AxisEnv ->
    -- | Slot width budget in characters for this tick.
    Int ->
    -- | Raw data value for the tick
    Double ->
    -- | Rendered label (if it doesn't fit in the slot it will be truncated)
    Text.Text

-- | What the formatter gets to know about the axis/ticks
data AxisEnv = AxisEnv
    { AxisEnv -> (Double, Double)
domain :: (Double, Double)
    -- ^ min/max of the axis in data space
    , AxisEnv -> Int
tickIndex :: Int
    -- ^ index of THIS tick [0..tickCount-1]
    , AxisEnv -> Int
tickCount :: Int
    -- ^ total number of ticks
    }

{- | Create a named data series for multi-series plots.

@
let s1 = series "Dataset A" [(1,2), (2,4), (3,6)]
    s2 = series "Dataset B" [(1,3), (2,5), (3,7)]
    chart = scatter [s1, s2] defPlot
@
-}
series ::
    -- | Name of the series (appears in legend)
    Text ->
    -- | List of (x, y) data points
    [(Double, Double)] ->
    (Text, [(Double, Double)])
series :: Text -> [(Double, Double)] -> (Text, [(Double, Double)])
series = (,)

{- | Create a scatter plot from multiple data series.

Each series is rendered with a different color and pattern.
Points are plotted using Braille characters for sub-character resolution.

==== __Example__

@
let points1 = [(x, x^2) | x <- [-3, -2.5 .. 3]]
    points2 = [(x, 2*x + 1) | x <- [-3, -2.5 .. 3]]
    chart = scatter [series "y = x²" points1,
                     series "y = 2x + 1" points2] defPlot
@
-}
scatter ::
    -- | List of named data series
    [(Text, [(Double, Double)])] ->
    -- | Plot configuration
    Plot ->
    -- | Rendered chart as Text
    Text
scatter :: [(Text, [(Double, Double)])] -> Plot -> Text
scatter [(Text, [(Double, Double)])]
sers Plot
cfg =
    let wC :: Int
wC = Plot -> Int
widthChars Plot
cfg
        hC :: Int
hC = Plot -> Int
heightChars Plot
cfg
        plotC :: Canvas
plotC = Int -> Int -> Canvas
newCanvas Int
wC Int
hC
        (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)
        sx :: Double -> Int
sx Double
x =
            Int -> Int -> Int -> Int
forall a. Ord a => a -> a -> a -> a
clamp Int
0 (Int
wC Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2 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
round ((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
* Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
wC Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))
        sy :: Double -> Int
sy Double
y =
            Int -> Int -> Int -> Int
forall a. Ord a => a -> a -> a -> a
clamp Int
0 (Int
hC Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
4 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
round ((Double
ymax Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
y) 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
* Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
hC Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))
        pats :: [Pat]
pats = [Pat] -> [Pat]
forall a. HasCallStack => [a] -> [a]
cycle [Pat]
palette
        cols :: [Color]
cols = [Color] -> [Color]
forall a. HasCallStack => [a] -> [a]
cycle (Plot -> [Color]
colorPalette Plot
cfg)
        withSty :: [(Text, [(Double, Double)], Pat, Color)]
withSty = ((Text, [(Double, Double)])
 -> Pat -> Color -> (Text, [(Double, Double)], Pat, Color))
-> [(Text, [(Double, Double)])]
-> [Pat]
-> [Color]
-> [(Text, [(Double, Double)], Pat, Color)]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 (\(Text
n, [(Double, Double)]
ps) Pat
p Color
c -> (Text
n, [(Double, Double)]
ps, Pat
p, Color
c)) [(Text, [(Double, Double)])]
sers [Pat]
pats [Color]
cols
        drawOne :: Canvas -> (a, t (Double, Double), Pat, Color) -> Canvas
drawOne Canvas
c0 (a
_name, t (Double, Double)
pts, Pat
pat, Color
col) =
            (Canvas -> (Double, Double) -> Canvas)
-> Canvas -> t (Double, Double) -> Canvas
forall b a. (b -> a -> b) -> b -> t a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl'
                ( \Canvas
c (Double
x, Double
y) ->
                    let xd :: Int
xd = Double -> Int
sx Double
x; yd :: Int
yd = Double -> Int
sy Double
y
                     in if Pat -> Int -> Int -> Bool
ink Pat
pat Int
xd Int
yd then Canvas -> Int -> Int -> Maybe Color -> Canvas
setDotC Canvas
c Int
xd Int
yd (Color -> Maybe Color
forall a. a -> Maybe a
Just Color
col) else Canvas
c
                )
                Canvas
c0
                t (Double, Double)
pts
        cDone :: Canvas
cDone = (Canvas -> (Text, [(Double, Double)], Pat, Color) -> Canvas)
-> Canvas -> [(Text, [(Double, Double)], Pat, Color)] -> Canvas
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' Canvas -> (Text, [(Double, Double)], Pat, Color) -> Canvas
forall {t :: * -> *} {a}.
Foldable t =>
Canvas -> (a, t (Double, Double), Pat, Color) -> Canvas
drawOne Canvas
plotC [(Text, [(Double, Double)], Pat, Color)]
withSty
        ax :: Text
ax = Plot -> Canvas -> (Double, Double) -> (Double, Double) -> Text
axisify Plot
cfg Canvas
cDone (Double
xmin, Double
xmax) (Double
ymin, Double
ymax)
        legend :: Text
legend =
            LegendPos -> Int -> [(Text, Pat, Color)] -> Text
legendBlock
                (Plot -> LegendPos
legendPos Plot
cfg)
                (Plot -> Int
leftMargin Plot
cfg Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Plot -> Int
widthChars Plot
cfg)
                [(Text
n, Pat
p, Color
col) | (Text
n, [(Double, Double)]
_, Pat
p, Color
col) <- [(Text, [(Double, Double)], Pat, Color)]
withSty]
     in Plot -> Text -> Text -> Text
drawFrame Plot
cfg Text
ax Text
legend

{- | Create a line graph connecting data points.

Similar to 'scatter' but connects consecutive points with lines.
Points are automatically sorted by x-coordinate before connecting.

==== __Example__

@
let sine = [(x, sin x) | x <- [0, 0.1 .. 2*pi]]
    cosine = [(x, cos x) | x <- [0, 0.1 .. 2*pi]]
    chart = lineGraph [series "sin" sine, series "cos" cosine] defPlot
@
-}
lineGraph ::
    -- | List of named data series
    [(Text, [(Double, Double)])] ->
    -- | Plot configuration
    Plot ->
    -- | Rendered chart as Text
    Text
lineGraph :: [(Text, [(Double, Double)])] -> Plot -> Text
lineGraph [(Text, [(Double, Double)])]
sers Plot
cfg =
    let wC :: Int
wC = Plot -> Int
widthChars Plot
cfg
        hC :: Int
hC = Plot -> Int
heightChars Plot
cfg
        plotC :: Canvas
plotC = Int -> Int -> Canvas
newCanvas Int
wC Int
hC
        (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)
        sx :: Double -> Int
sx Double
x =
            Int -> Int -> Int -> Int
forall a. Ord a => a -> a -> a -> a
clamp Int
0 (Int
wC Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2 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
round ((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
* Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
wC Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))
        sy :: Double -> Int
sy Double
y =
            Int -> Int -> Int -> Int
forall a. Ord a => a -> a -> a -> a
clamp Int
0 (Int
hC Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
4 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
round ((Double
ymax Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
y) 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
* Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
hC Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))

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

        drawSeries :: ((a, [(Double, Double)]), Color) -> Canvas -> Canvas
drawSeries ((a
_name, [(Double, Double)]
pts), Color
col) Canvas
c0 =
            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
                dotPairs :: [((Double, Double), (Double, Double))]
dotPairs = [(Double, Double)]
-> [(Double, Double)] -> [((Double, Double), (Double, Double))]
forall a b. [a] -> [b] -> [(a, b)]
zip [(Double, Double)]
sortedPts (Int -> [(Double, Double)] -> [(Double, Double)]
forall a. Int -> [a] -> [a]
drop Int
1 [(Double, Double)]
sortedPts)
             in (Canvas -> ((Double, Double), (Double, Double)) -> Canvas)
-> Canvas -> [((Double, Double), (Double, Double))] -> Canvas
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl'
                    ( \Canvas
c ((Double
x1, Double
y1), (Double
x2, Double
y2)) ->
                        (Int, Int) -> (Int, Int) -> Maybe Color -> Canvas -> Canvas
lineDotsC (Double -> Int
sx Double
x1, Double -> Int
sy Double
y1) (Double -> Int
sx Double
x2, Double -> Int
sy Double
y2) (Color -> Maybe Color
forall a. a -> Maybe a
Just Color
col) Canvas
c
                    )
                    Canvas
c0
                    [((Double, Double), (Double, Double))]
dotPairs

        cDone :: Canvas
cDone = (Canvas -> ((Text, [(Double, Double)]), Color) -> Canvas)
-> Canvas -> [((Text, [(Double, Double)]), Color)] -> Canvas
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' ((((Text, [(Double, Double)]), Color) -> Canvas -> Canvas)
-> Canvas -> ((Text, [(Double, Double)]), Color) -> Canvas
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Text, [(Double, Double)]), Color) -> Canvas -> Canvas
forall {a}. ((a, [(Double, Double)]), Color) -> Canvas -> Canvas
drawSeries) Canvas
plotC [((Text, [(Double, Double)]), Color)]
withSty
        ax :: Text
        ax :: Text
ax = Plot -> Canvas -> (Double, Double) -> (Double, Double) -> Text
axisify Plot
cfg Canvas
cDone (Double
xmin, Double
xmax) (Double
ymin, Double
ymax)
        legend :: Text
        legend :: Text
legend =
            LegendPos -> Int -> [(Text, Pat, Color)] -> Text
legendBlock
                (Plot -> LegendPos
legendPos Plot
cfg)
                (Plot -> Int
leftMargin Plot
cfg Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Plot -> Int
widthChars Plot
cfg)
                [(Text
n, Pat
Solid, Color
col) | ((Text
n, [(Double, Double)]
_), Color
col) <- [((Text, [(Double, Double)]), Color)]
withSty]
     in Plot -> Text -> Text -> Text
drawFrame Plot
cfg Text
ax Text
legend

{- | Create a bar chart from categorical data.

Each bar is colored differently and labeled with its category name.

==== __Example__

@
let fruits = [(\"Apple\", 45.2), (\"Banana\", 38.1), (\"Orange\", 52.7)]
    chart = bars fruits defPlot { plotTitle = "Fruit Sales" }
@
-}
bars ::
    -- | List of (category, value) pairs
    [(Text, Double)] ->
    -- | Plot configuration
    Plot ->
    -- | Rendered chart as Text
    Text
bars :: [(Text, Double)] -> Plot -> Text
bars [(Text, Double)]
kvs Plot
cfg =
    let wC :: Int
wC = Plot -> Int
widthChars Plot
cfg
        hC :: Int
hC = Plot -> Int
heightChars 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)

        cats :: [(Text, Double, Color)]
        cats :: [(Text, Double, Color)]
cats =
            [ (Text
name, Double -> Double
forall a. Num a => a -> a
abs Double
v Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
vmax, Color
col)
            | ((Text
name, Double
v), Color
col) <- [(Text, Double)] -> [Color] -> [((Text, Double), Color)]
forall a b. [a] -> [b] -> [(a, b)]
zip [(Text, Double)]
kvs ([Color] -> [Color]
forall a. HasCallStack => [a] -> [a]
cycle (Plot -> [Color]
colorPalette Plot
cfg))
            ]

        nCats :: Int
nCats = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
wC ([(Text, Double, Color)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Text, Double, Color)]
cats)

        (Int
base, Int
extra) =
            if Int
nCats Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then (Int
0, Int
0) else (Int
wC Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
nCats, Int
wC Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
wC Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
nCats Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
nCats)
        widths :: [Int]
widths = [Int
base Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
extra then Int
1 else Int
0) | Int
i <- [Int
0 .. Int
nCats Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]]

        catGroups :: [[(String, Maybe Color)]]
        catGroups :: [[(String, Maybe Color)]]
catGroups =
            [ Int -> (String, Maybe Color) -> [(String, Maybe Color)]
forall a. Int -> a -> [a]
replicate Int
w (Int -> Double -> String
colGlyphs Int
hC Double
f, Color -> Maybe Color
forall a. a -> Maybe a
Just Color
col)
            | ((Text
_, Double
f, Color
col), Int
w) <- [(Text, Double, Color)] -> [Int] -> [((Text, Double, Color), Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [(Text, Double, Color)]
cats [Int]
widths
            ]

        gutterCol :: (String, Maybe a)
gutterCol = (Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
hC Char
' ', Maybe a
forall a. Maybe a
Nothing)
        columns :: [(String, Maybe Color)]
columns = [(String, Maybe Color)]
-> [[(String, Maybe Color)]] -> [(String, Maybe Color)]
forall a. [a] -> [[a]] -> [a]
List.intercalate [(String, Maybe Color)
forall {a}. (String, Maybe a)
gutterCol] [[(String, Maybe Color)]]
catGroups

        grid :: [[(Char, Maybe Color)]]
        grid :: [[(Char, Maybe Color)]]
grid =
            [ [(String
glyphs String -> Int -> Char
forall a. HasCallStack => [a] -> Int -> a
!! Int
y, Maybe Color
mc) | (String
glyphs, Maybe Color
mc) <- [(String, Maybe Color)]
columns]
            | Int
y <- [Int
0 .. Int
hC Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
            ]

        ax :: Text
ax =
            Plot
-> [[(Char, Maybe Color)]]
-> (Double, Double)
-> (Double, Double)
-> [Text]
-> Maybe Int
-> Text
axisifyGrid
                Plot
cfg
                [[(Char, Maybe Color)]]
grid
                (Double
0, 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))
                (Double
0, Double
vmax)
                [Text]
catNames
                ((Int -> Int) -> Maybe Int -> Maybe Int
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ([Int] -> Maybe Int
forall a. [a] -> Maybe a
listToMaybe [Int]
widths))
        legendWidth :: Int
legendWidth = Plot -> Int
leftMargin Plot
cfg Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [[(Char, Maybe Color)]] -> Int
forall a. [[a]] -> Int
gridWidth [[(Char, Maybe Color)]]
grid
        legend :: Text
legend =
            LegendPos -> Int -> [(Text, Pat, Color)] -> Text
legendBlock
                (Plot -> LegendPos
legendPos Plot
cfg)
                Int
legendWidth
                [(Text
name, Pat
Checker, Color
col) | (Text
name, Double
_, Color
col) <- [(Text, Double, Color)]
cats]
     in Plot -> Text -> Text -> Text
drawFrame Plot
cfg Text
ax Text
legend

{- | Create a stacked bar chart.

Each category can have multiple stacked components.

==== __Example__

@
let sales = [(\"Q1\", [(\"Product A\", 100), (\"Product B\", 150)]),
             (\"Q2\", [(\"Product A\", 120), (\"Product B\", 180)])]
    chart = stackedBars sales defPlot
@
-}
stackedBars ::
    -- | Categories with stacked components
    [(Text, [(Text, Double)])] ->
    -- | Plot configuration
    Plot ->
    -- | Rendered chart as Text
    Text
stackedBars :: [(Text, [(Text, Double)])] -> Plot -> Text
stackedBars [(Text, [(Text, Double)])]
categories Plot
cfg =
    let wC :: Int
wC = Plot -> Int
widthChars Plot
cfg
        hC :: Int
hC = Plot -> Int
heightChars 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)]
series') | (Text
_, [(Text, Double)]
series') <- [(Text, [(Text, Double)])]
categories]
        maxHeight :: Double
maxHeight = [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)

        nCats :: Int
nCats = [(Text, [(Text, Double)])] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Text, [(Text, Double)])]
categories
        (Int
base, Int
extra) =
            if Int
nCats Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
                then (Int
0, Int
0)
                else (Int
wC Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
nCats, Int
wC Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
wC Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
nCats Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
nCats)
        widths :: [Int]
widths = [Int
base Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
extra then Int
1 else Int
0) | Int
i <- [Int
0 .. Int
nCats Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]]

        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

        makeBar :: (a, [(Text, Double)]) -> Int -> [[(Char, Maybe Color)]]
makeBar (a
_, [(Text, Double)]
series') Int
width =
            let 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
maxHeight | (Text
_, Double
v) <- [(Text, Double)]
series']
                segments :: [(Text, Double, Double)]
segments = [Text] -> [Double] -> [Double] -> [(Text, Double, Double)]
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)]
series') [Double]
cumHeights (Int -> [Double] -> [Double]
forall a. Int -> [a] -> [a]
drop Int
1 [Double]
cumHeights)

                makeColumn :: [(Char, Maybe Color)]
                makeColumn :: [(Char, Maybe Color)]
makeColumn =
                    [ let heightFromBottom :: Double
heightFromBottom = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
hC Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
y) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
hC
                          findSegment :: [(Text, Double, Double)] -> (Char, Maybe Color)
findSegment [] = (Char
' ', Maybe Color
forall a. Maybe a
Nothing)
                          findSegment ((Text
name, Double
bottom, Double
top) : [(Text, Double, Double)]
rest) =
                            if Double
heightFromBottom Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
bottom Bool -> Bool -> Bool
&& Double
heightFromBottom Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
top
                                then (Char
'█', Text -> [(Text, Color)] -> Maybe Color
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
name [(Text, Color)]
seriesColors)
                                else [(Text, Double, Double)] -> (Char, Maybe Color)
findSegment [(Text, Double, Double)]
rest
                       in [(Text, Double, Double)] -> (Char, Maybe Color)
findSegment [(Text, Double, Double)]
segments
                    | Int
y <- [Int
0 .. Int
hC Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
                    ]
             in Int -> [(Char, Maybe Color)] -> [[(Char, Maybe Color)]]
forall a. Int -> a -> [a]
replicate Int
width [(Char, Maybe Color)]
makeColumn

        gutterCol :: [(Char, Maybe a)]
gutterCol = Int -> (Char, Maybe a) -> [(Char, Maybe a)]
forall a. Int -> a -> [a]
replicate Int
hC (Char
' ', Maybe a
forall a. Maybe a
Nothing)
        allBars :: [[[(Char, Maybe Color)]]]
allBars = ((Text, [(Text, Double)]) -> Int -> [[(Char, Maybe Color)]])
-> [(Text, [(Text, Double)])] -> [Int] -> [[[(Char, Maybe Color)]]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Text, [(Text, Double)]) -> Int -> [[(Char, Maybe Color)]]
forall {a}. (a, [(Text, Double)]) -> Int -> [[(Char, Maybe Color)]]
makeBar [(Text, [(Text, Double)])]
categories [Int]
widths
        columns :: [[(Char, Maybe Color)]]
columns = [[(Char, Maybe Color)]]
-> [[[(Char, Maybe Color)]]] -> [[(Char, Maybe Color)]]
forall a. [a] -> [[a]] -> [a]
List.intercalate [[(Char, Maybe Color)]
forall {a}. [(Char, Maybe a)]
gutterCol] [[[(Char, Maybe Color)]]]
allBars

        grid :: [[(Char, Maybe Color)]]
grid = [[[(Char, Maybe Color)]
col [(Char, Maybe Color)] -> Int -> (Char, Maybe Color)
forall a. HasCallStack => [a] -> Int -> a
!! Int
y | [(Char, Maybe Color)]
col <- [[(Char, Maybe Color)]]
columns] | Int
y <- [Int
0 .. Int
hC Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]]

        ax :: Text
        ax :: Text
ax =
            Plot
-> [[(Char, Maybe Color)]]
-> (Double, Double)
-> (Double, Double)
-> [Text]
-> Maybe Int
-> Text
axisifyGrid
                Plot
cfg
                [[(Char, Maybe Color)]]
grid
                (Double
0, 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))
                (Double
0, Double
maxHeight)
                (((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)
                ((Int -> Int) -> Maybe Int -> Maybe Int
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ([Int] -> Maybe Int
forall a. [a] -> Maybe a
listToMaybe [Int]
widths))
        legend :: Text
        legend :: Text
legend =
            LegendPos -> Int -> [(Text, Pat, Color)] -> Text
legendBlock
                (Plot -> LegendPos
legendPos Plot
cfg)
                ( Plot -> Int
leftMargin Plot
cfg
                    Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                    Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [[(Char, Maybe Color)]] -> Int
forall a. [[a]] -> Int
gridWidth [[(Char, Maybe Color)]]
grid
                )
                [(Text
name, Pat
Solid, Color
col) | (Text
name, Color
col) <- [(Text, Color)]
seriesColors]
     in Plot -> Text -> Text -> Text
drawFrame Plot
cfg Text
ax Text
legend

-- | Defines the binning parameters.
data Bins = Bins
    { Bins -> Int
nBins :: Int
    , Bins -> Double
lo :: Double
    , Bins -> Double
hi :: Double
    }
    deriving (Bins -> Bins -> Bool
(Bins -> Bins -> Bool) -> (Bins -> Bins -> Bool) -> Eq Bins
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Bins -> Bins -> Bool
== :: Bins -> Bins -> Bool
$c/= :: Bins -> Bins -> Bool
/= :: Bins -> Bins -> Bool
Eq, Int -> Bins -> ShowS
[Bins] -> ShowS
Bins -> String
(Int -> Bins -> ShowS)
-> (Bins -> String) -> ([Bins] -> ShowS) -> Show Bins
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Bins -> ShowS
showsPrec :: Int -> Bins -> ShowS
$cshow :: Bins -> String
show :: Bins -> String
$cshowList :: [Bins] -> ShowS
showList :: [Bins] -> ShowS
Show)

{- | Create a bin configuration for histograms.

@
bins 10 0 100  -- 10 bins from 0 to 100
bins 20 (-5) 5 -- 20 bins from -5 to 5
@
-}
bins :: Int -> Double -> Double -> Bins
bins :: Int -> Double -> Double -> Bins
bins Int
n Double
a Double
b = Int -> Double -> Double -> Bins
Bins (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 Int
n) (Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
a Double
b) (Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
a Double
b)

{- | Create a histogram from numerical data.

Data is binned according to the provided 'Bins' configuration.

==== __Example__

@
import System.Random

-- Generate random normal-like distribution
let values = take 1000 $ randomRs (0, 100) gen
    chart = histogram (bins 20 0 100) values defPlot
@
-}
histogram ::
    -- | Binning configuration
    Bins ->
    -- | Raw data values to bin
    [Double] ->
    -- | Plot configuration
    Plot ->
    -- | Rendered chart as Text
    Text
histogram :: Bins -> [Double] -> Plot -> Text
histogram (Bins Int
n Double
a Double
b) [Double]
xs Plot
cfg =
    let 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
n
        binIx :: Double -> Int
binIx Double
x = Int -> Int -> Int -> Int
forall a. Ord a => a -> a -> a -> a
clamp Int
0 (Int
n 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)
        counts :: [Int]
counts =
            ([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
n Int
0 :: [Int])
                [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]
counts))
        fracs0 :: [Double]
fracs0 = [Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
c Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
maxC | Int
c <- [Int]
counts]

        wData :: Int
wData = Plot -> Int
widthChars Plot
cfg
        hC :: Int
hC = Plot -> Int
heightChars Plot
cfg
        colsF :: [Double]
colsF = Int -> [Double] -> [Double]
resampleToWidth Int
wData [Double]
fracs0

        dataCols :: [(String, Maybe Color)]
dataCols = [(Int -> Double -> String
colGlyphs Int
hC Double
f, Color -> Maybe Color
forall a. a -> Maybe a
Just Color
BrightCyan) | Double
f <- [Double]
colsF]
        grid :: [[(Char, Maybe Color)]]
        grid :: [[(Char, Maybe Color)]]
grid =
            [ [((String, Maybe Color) -> String
forall a b. (a, b) -> a
fst (String, Maybe Color)
col String -> Int -> Char
forall a. HasCallStack => [a] -> Int -> a
!! Int
y, (String, Maybe Color) -> Maybe Color
forall a b. (a, b) -> b
snd (String, Maybe Color)
col) | (String, Maybe Color)
col <- [(String, Maybe Color)]
dataCols]
            | Int
y <- [Int
0 .. Int
hC Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
            ]

        ax :: Text
ax =
            Plot
-> [[(Char, Maybe Color)]]
-> (Double, Double)
-> (Double, Double)
-> [Text]
-> Maybe Int
-> Text
axisifyGrid Plot
cfg [[(Char, Maybe Color)]]
grid (Double
a, Double
b) (Double
0, Double
maxC) [] Maybe Int
forall a. Maybe a
Nothing
        legendWidth :: Int
legendWidth = Plot -> Int
leftMargin Plot
cfg Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [[(Char, Maybe Color)]] -> Int
forall a. [[a]] -> Int
gridWidth [[(Char, Maybe Color)]]
grid
        legend :: Text
legend = LegendPos -> Int -> [(Text, Pat, Color)] -> Text
legendBlock (Plot -> LegendPos
legendPos Plot
cfg) Int
legendWidth [(Text
"count", Pat
Solid, Color
BrightCyan)]
     in Plot -> Text -> Text -> Text
drawFrame Plot
cfg Text
ax Text
legend

{- | Create a pie chart showing proportions.

Values are normalized to sum to 100%. Negative values are treated as zero.

==== __Example__

@
let browsers = [(\"Chrome\", 65), (\"Firefox\", 20), (\"Safari\", 10), (\"Other\", 5)]
    chart = pie browsers defPlot { plotTitle = "Browser Market Share" }
@
-}
pie ::
    -- | List of (category, value) pairs
    [(Text, Double)] ->
    -- | Plot configuration
    Plot ->
    -- | Rendered chart as Text
    Text
pie :: [(Text, Double)] -> Plot -> Text
pie [(Text, Double)]
parts0 Plot
cfg =
    let parts :: [(Text, Double)]
parts = [(Text, Double)] -> [(Text, Double)]
normalize [(Text, Double)]
parts0
        wC :: Int
wC = Plot -> Int
widthChars Plot
cfg
        hC :: Int
hC = Plot -> Int
heightChars Plot
cfg
        plotC :: Canvas
plotC = Int -> Int -> Canvas
newCanvas Int
wC Int
hC
        wDots :: Int
wDots = Int
wC Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2
        hDots :: Int
hDots = Int
hC Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
4
        r :: Int
r = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int
wDots Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) (Int
hDots Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2)
        cx :: Int
cx = Int
wDots Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
        cy :: Int
cy = Int
hDots Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
        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
        wedges :: [Double]
wedges = (Double -> (Text, Double) -> Double)
-> Double -> [(Text, Double)] -> [Double]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl (\Double
a (Text
_, Double
p) -> Double
a 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]
wedges (Int -> [Double] -> [Double]
forall a. Int -> [a] -> [a]
drop Int
1 [Double]
wedges)
        names :: [Text]
names = ((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
        cols :: [Color]
cols = [Color] -> [Color]
forall a. HasCallStack => [a] -> [a]
cycle [Color]
pieColors
        withP :: [(Text, (Double, Double), Color)]
        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]
names [(Double, Double)]
angles [Color]
cols

        drawOne :: (a, (Double, Double), Color) -> Canvas -> Canvas
drawOne (a
_name, (Double
a0, Double
a1), Color
col) Canvas
c0 =
            let inside :: Int -> Int -> Bool
inside Int
x Int
y =
                    let dx :: Double
dx = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
cx)
                        dy :: Double
dy = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
cy Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
y)
                        rr2 :: Double
rr2 = Double
dx Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
dx Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
dy Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
dy
                        r2 :: Double
r2 = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
r)
                        ang :: Double
ang = Double -> Double -> Double
forall a. RealFloat a => a -> a -> a
atan2 Double
dy Double
dx Double -> Double -> Double
`mod'` (Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
forall a. Floating a => a
pi)
                     in Double
rr2 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
r2 Bool -> Bool -> Bool
&& Double -> Double -> Double -> Bool
angleWithin Double
ang Double
a0 Double
a1
             in (Int, Int)
-> (Int, Int)
-> (Int -> Int -> Bool)
-> Maybe Color
-> Canvas
-> Canvas
fillDotsC (Int
cx Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
r, Int
cy Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
r) (Int
cx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
r, Int
cy Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
r) Int -> Int -> Bool
inside (Color -> Maybe Color
forall a. a -> Maybe a
Just Color
col) Canvas
c0

        cDone :: Canvas
cDone = (Canvas -> (Text, (Double, Double), Color) -> Canvas)
-> Canvas -> [(Text, (Double, Double), Color)] -> Canvas
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' (((Text, (Double, Double), Color) -> Canvas -> Canvas)
-> Canvas -> (Text, (Double, Double), Color) -> Canvas
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Text, (Double, Double), Color) -> Canvas -> Canvas
forall {a}. (a, (Double, Double), Color) -> Canvas -> Canvas
drawOne) Canvas
plotC [(Text, (Double, Double), Color)]
withP
        ax :: Text
ax = Plot -> Canvas -> (Double, Double) -> (Double, Double) -> Text
axisify Plot
cfg Canvas
cDone (Double
0, Double
1) (Double
0, Double
1)
        legend :: Text
legend =
            LegendPos -> Int -> [(Text, Pat, Color)] -> Text
legendBlock
                (Plot -> LegendPos
legendPos Plot
cfg)
                (Plot -> Int
leftMargin Plot
cfg Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Plot -> Int
widthChars Plot
cfg)
                [(Text
n, Pat
Solid, Color
col) | (Text
n, (Double, Double)
_, Color
col) <- [(Text, (Double, Double), Color)]
withP]
     in Plot -> Text -> Text -> Text
drawFrame Plot
cfg Text
ax Text
legend

{- | Create a heatmap visualization of a 2D matrix.

Values are mapped to a color gradient from blue (low) to red (high).

==== __Example__

@
let matrix = [[x * y | x <- [1..10]] | y <- [1..10]]
    chart = heatmap matrix defPlot { plotTitle = "Multiplication Table" }
@
-}
heatmap ::
    -- | 2D matrix of values (rows × columns)
    [[Double]] ->
    -- | Plot configuration
    Plot ->
    -- | Rendered chart as Text
    Text
heatmap :: [[Double]] -> Plot -> Text
heatmap [[Double]]
matrix Plot
cfg =
    let rows :: Int
rows = [[Double]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Double]]
matrix
        cols :: Int
cols = [[Double]] -> Int
forall a. [[a]] -> Int
gridWidth [[Double]]
matrix

        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

        intensityColors :: [Color]
intensityColors =
            [ Color
Blue
            , Color
BrightBlue
            , Color
Cyan
            , Color
BrightCyan
            , Color
Green
            , Color
BrightGreen
            , Color
Yellow
            , Color
BrightYellow
            , Color
Magenta
            , Color
BrightRed
            , Color
Red
            ]

        colorForValue :: Double -> Color
colorForValue Double
v =
            if Double
vrange Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
eps
                then Color
Green
                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 = 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 ([Color] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Color]
intensityColors Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))
                        idx' :: Int
idx' = Int -> Int -> Int -> Int
forall a. Ord a => a -> a -> a -> a
clamp Int
0 ([Color] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Color]
intensityColors Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
idx
                     in [Color]
intensityColors [Color] -> Int -> Color
forall a. HasCallStack => [a] -> Int -> a
!! Int
idx'

        displayGrid :: [[(Char, Maybe Color)]]
displayGrid =
            [ [ let
                    matrixRow :: Int
matrixRow = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int
rows Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) ((Int
plotH Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
rows Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
plotH)
                    matrixCol :: Int
matrixCol = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int
cols Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
cols Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
plotW)
                    val :: Double
val = [[Double]]
matrix [[Double]] -> Int -> [Double]
forall a. HasCallStack => [a] -> Int -> a
!! Int
matrixRow [Double] -> Int -> Double
forall a. HasCallStack => [a] -> Int -> a
!! Int
matrixCol
                 in
                    (Char
'█', Color -> Maybe Color
forall a. a -> Maybe a
Just (Double -> Color
colorForValue Double
val))
              | Int
j <- [Int
0 .. Int
plotW Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
              ]
            | Int
i <- [Int
0 .. Int
plotH Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
            ]

        plotW :: Int
plotW = Plot -> Int
widthChars Plot
cfg
        plotH :: Int
plotH = Plot -> Int
heightChars Plot
cfg

        colLabels :: [Text]
colLabels = [String -> Text
Text.pack (Int -> String
forall a. Show a => a -> String
show Int
i) | Int
i <- [Int
0 .. Int
cols Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]]
        rowLabels :: [Text]
rowLabels = [String -> Text
Text.pack (Int -> String
forall a. Show a => a -> String
show Int
i) | Int
i <- [Int] -> [Int]
forall a. [a] -> [a]
reverse [Int
0 .. Int
rows Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]]

        cellHeight :: Double
cellHeight = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
plotH Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
rows
        yTicks :: [(Int, Text)]
yTicks =
            [ ( forall a b. (RealFrac a, Integral b) => a -> b
round @Double @Int (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
cellHeight Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
cellHeight Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2)
              , [Text]
rowLabels [Text] -> Int -> Text
forall a. HasCallStack => [a] -> Int -> a
!! Int
i
              )
            | Int
i <- [Int
0 .. Int
rows Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
            ]

        left :: Int
left = Plot -> Int
leftMargin Plot
cfg
        baseLbl :: [Text]
baseLbl = Int -> Text -> [Text]
forall a. Int -> a -> [a]
replicate Int
plotH (Int -> Text -> Text
Text.replicate Int
left Text
" ")
        yLabels :: [Text]
yLabels =
            ([Text] -> (Int, Text) -> [Text])
-> [Text] -> [(Int, Text)] -> [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'
                ( \[Text]
acc (Int
row, Text
lbl) ->
                    [Text] -> Int -> Text -> [Text]
forall a. [a] -> Int -> a -> [a]
setAt [Text]
acc Int
row (Int -> Text -> Text
justifyRight Int
left (Int -> Text -> Text
ellipsisize Int
left Text
lbl))
                )
                [Text]
baseLbl
                [(Int, Text)]
yTicks

        renderRow :: [(Char, Maybe Color)] -> Text
renderRow [(Char, Maybe Color)]
cells =
            [Text] -> Text
Text.concat
                (((Char, Maybe Color) -> Text) -> [(Char, Maybe Color)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Char
ch, Maybe Color
mc) -> Text -> (Color -> Text) -> Maybe Color -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Char -> Text
Text.singleton Char
ch) (Color -> Char -> Text
`paint` Char
ch) Maybe Color
mc) [(Char, Maybe Color)]
cells)
        attachY :: [Text]
attachY = (Text -> [(Char, Maybe Color)] -> Text)
-> [Text] -> [[(Char, Maybe Color)]] -> [Text]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Text
lbl [(Char, Maybe Color)]
cells -> Text
lbl Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"│" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [(Char, Maybe Color)] -> Text
renderRow [(Char, Maybe Color)]
cells) [Text]
yLabels [[(Char, Maybe Color)]]
displayGrid

        xBar :: Text
xBar = Int -> Text -> Text
Text.replicate Int
left Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"└" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
Text.replicate Int
plotW Text
"─"
        xLine :: Text
xLine =
            Text -> Int -> [Text] -> Text
placeGridLabels
                (Int -> Text -> Text
Text.replicate (Int
left Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Text
" ")
                (Int
plotW Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
cols)
                [Text]
colLabels

        ax :: Text
ax = [Text] -> Text
Text.unlines ([Text]
attachY [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
xBar, Text
xLine])

        gradientLegend :: Text
gradientLegend =
            String -> Text
Text.pack (String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%.2f " Double
vmin)
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
Text.concat ((Color -> Text) -> [Color] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Color -> Char -> Text
`paint` Char
'█') [Color]
intensityColors)
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (String -> Double -> String
forall r. PrintfType r => String -> r
printf String
" %.2f" Double
vmax)
     in Plot -> Text -> Text -> Text
drawFrame Plot
cfg Text
ax Text
gradientLegend

{- | Create a box plot showing statistical distributions.

Displays quartiles, median, and min/max values for each dataset.

==== __Example__

@
let data1 = [1.2, 2.3, 2.1, 3.4, 2.8, 4.1, 3.9]
    data2 = [5.1, 4.8, 6.2, 5.9, 7.1, 6.5, 5.5]
    chart = boxPlot [("Group A", data1), ("Group B", data2)] defPlot
@

The box plot displays:

  * Box: First quartile (Q1) to third quartile (Q3)
  * Line inside box: Median (Q2)
  * Whiskers: Minimum and maximum values
-}
boxPlot ::
    -- | Named datasets
    [(Text, [Double])] ->
    -- | Plot configuration
    Plot ->
    -- | Rendered chart as Text
    Text
boxPlot :: [(Text, [Double])] -> Plot -> Text
boxPlot [(Text, [Double])]
datasets Plot
cfg =
    let wC :: Int
wC = Plot -> Int
widthChars Plot
cfg
        hC :: Int
hC = Plot -> Int
heightChars 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
        boxWidth :: Int
boxWidth = if Int
nBoxes Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Int
1 else Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Int
wC Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` (Int
nBoxes Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2))
        spacing :: Int
spacing = if Int
nBoxes Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1 then Int
0 else (Int
wC Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
boxWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
nBoxes) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` (Int
nBoxes Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

        scaleY :: Double -> Int
scaleY Double
v =
            Int -> Int -> Int -> Int
forall a. Ord a => a -> a -> a -> a
clamp Int
0 (Int
hC 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
round ((Double
ymax Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
v) 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
* Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
hC Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))

        emptyGrid :: [[(Char, Maybe a)]]
emptyGrid = Int -> [(Char, Maybe a)] -> [[(Char, Maybe a)]]
forall a. Int -> a -> [a]
replicate Int
hC (Int -> (Char, Maybe a) -> [(Char, Maybe a)]
forall a. Int -> a -> [a]
replicate Int
wC (Char
' ', Maybe a
forall a. Maybe a
Nothing))

        drawBox :: [[(Char, Maybe Color)]]
-> (Int, (a, (Double, Double, Double, Double, Double)))
-> [[(Char, Maybe Color)]]
drawBox [[(Char, Maybe Color)]]
grid (Int
idx, (a
_name, (Double
minV, Double
q1, Double
median, Double
q3, Double
maxV))) =
            let xStart :: Int
xStart = Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
boxWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
spacing)
                xMid :: Int
xMid = Int
xStart Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
boxWidth Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
                xEnd :: Int
xEnd = Int
xStart Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
boxWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1

                minRow :: Int
minRow = Double -> Int
scaleY Double
minV
                q1Row :: Int
q1Row = Double -> Int
scaleY Double
q1
                medRow :: Int
medRow = Double -> Int
scaleY Double
median
                q3Row :: Int
q3Row = Double -> Int
scaleY Double
q3
                maxRow :: Int
maxRow = Double -> Int
scaleY Double
maxV

                col :: Color
col = [Color]
pieColors [Color] -> Int -> Color
forall a. HasCallStack => [a] -> Int -> a
!! (Int
idx Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` [Color] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Color]
pieColors)

                grid1 :: [[(Char, Maybe Color)]]
grid1 = [[(Char, Maybe Color)]]
-> Int
-> Int
-> Int
-> Char
-> Maybe Color
-> [[(Char, Maybe Color)]]
forall {a} {b}.
[[(a, b)]] -> Int -> Int -> Int -> a -> b -> [[(a, b)]]
drawVLine [[(Char, Maybe Color)]]
grid Int
xMid Int
minRow Int
q1Row Char
'│' (Color -> Maybe Color
forall a. a -> Maybe a
Just Color
col)
                grid2 :: [[(Char, Maybe Color)]]
grid2 = [[(Char, Maybe Color)]]
-> Int
-> Int
-> Int
-> Char
-> Maybe Color
-> [[(Char, Maybe Color)]]
forall {a} {b}.
[[(a, b)]] -> Int -> Int -> Int -> a -> b -> [[(a, b)]]
drawVLine [[(Char, Maybe Color)]]
grid1 Int
xMid Int
q3Row Int
maxRow Char
'│' (Color -> Maybe Color
forall a. a -> Maybe a
Just Color
col)

                grid3 :: [[(Char, Maybe Color)]]
grid3 = [[(Char, Maybe Color)]]
-> Int
-> Int
-> Int
-> Char
-> Maybe Color
-> [[(Char, Maybe Color)]]
forall {a} {b}.
[[(a, b)]] -> Int -> Int -> Int -> a -> b -> [[(a, b)]]
drawHLine [[(Char, Maybe Color)]]
grid2 Int
xStart Int
xEnd Int
q1Row Char
'─' (Color -> Maybe Color
forall a. a -> Maybe a
Just Color
col)
                grid4 :: [[(Char, Maybe Color)]]
grid4 = [[(Char, Maybe Color)]]
-> Int
-> Int
-> Int
-> Char
-> Maybe Color
-> [[(Char, Maybe Color)]]
forall {a} {b}.
[[(a, b)]] -> Int -> Int -> Int -> a -> b -> [[(a, b)]]
drawHLine [[(Char, Maybe Color)]]
grid3 Int
xStart Int
xEnd Int
q3Row Char
'─' (Color -> Maybe Color
forall a. a -> Maybe a
Just Color
col)
                grid5 :: [[(Char, Maybe Color)]]
grid5 = [[(Char, Maybe Color)]]
-> Int
-> Int
-> Int
-> Char
-> Maybe Color
-> [[(Char, Maybe Color)]]
forall {a} {b}.
[[(a, b)]] -> Int -> Int -> Int -> a -> b -> [[(a, b)]]
drawVLine [[(Char, Maybe Color)]]
grid4 Int
xStart Int
q1Row Int
q3Row Char
'│' (Color -> Maybe Color
forall a. a -> Maybe a
Just Color
col)
                grid6 :: [[(Char, Maybe Color)]]
grid6 = [[(Char, Maybe Color)]]
-> Int
-> Int
-> Int
-> Char
-> Maybe Color
-> [[(Char, Maybe Color)]]
forall {a} {b}.
[[(a, b)]] -> Int -> Int -> Int -> a -> b -> [[(a, b)]]
drawVLine [[(Char, Maybe Color)]]
grid5 Int
xEnd Int
q1Row Int
q3Row Char
'│' (Color -> Maybe Color
forall a. a -> Maybe a
Just Color
col)

                grid7 :: [[(Char, Maybe Color)]]
grid7 = [[(Char, Maybe Color)]]
-> Int
-> Int
-> Int
-> Char
-> Maybe Color
-> [[(Char, Maybe Color)]]
forall {a} {b}.
[[(a, b)]] -> Int -> Int -> Int -> a -> b -> [[(a, b)]]
drawHLine [[(Char, Maybe Color)]]
grid6 Int
xStart Int
xEnd Int
medRow Char
'═' (Color -> Maybe Color
forall a. a -> Maybe a
Just Color
col)

                grid8 :: [[(Char, Maybe Color)]]
grid8 = [[(Char, Maybe Color)]]
-> Int -> Int -> Char -> Maybe Color -> [[(Char, Maybe Color)]]
forall {a} {b}. [[(a, b)]] -> Int -> Int -> a -> b -> [[(a, b)]]
setGridChar [[(Char, Maybe Color)]]
grid7 Int
xMid Int
minRow Char
'┴' (Color -> Maybe Color
forall a. a -> Maybe a
Just Color
col)
                grid9 :: [[(Char, Maybe Color)]]
grid9 = [[(Char, Maybe Color)]]
-> Int -> Int -> Char -> Maybe Color -> [[(Char, Maybe Color)]]
forall {a} {b}. [[(a, b)]] -> Int -> Int -> a -> b -> [[(a, b)]]
setGridChar [[(Char, Maybe Color)]]
grid8 Int
xMid Int
maxRow Char
'┬' (Color -> Maybe Color
forall a. a -> Maybe a
Just Color
col)
             in [[(Char, Maybe Color)]]
grid9

        finalGrid :: [[(Char, Maybe Color)]]
finalGrid = ([[(Char, Maybe Color)]]
 -> (Int, (Text, (Double, Double, Double, Double, Double)))
 -> [[(Char, Maybe Color)]])
-> [[(Char, Maybe Color)]]
-> [(Int, (Text, (Double, Double, Double, Double, Double)))]
-> [[(Char, Maybe Color)]]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' [[(Char, Maybe Color)]]
-> (Int, (Text, (Double, Double, Double, Double, Double)))
-> [[(Char, Maybe Color)]]
forall {a}.
[[(Char, Maybe Color)]]
-> (Int, (a, (Double, Double, Double, Double, Double)))
-> [[(Char, Maybe Color)]]
drawBox [[(Char, Maybe Color)]]
forall {a}. [[(Char, Maybe a)]]
emptyGrid ([Int]
-> [(Text, (Double, Double, Double, Double, Double))]
-> [(Int, (Text, (Double, Double, Double, Double, Double)))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 ..] [(Text, (Double, Double, Double, Double, Double))]
stats)

        left :: Int
left = Plot -> Int
leftMargin Plot
cfg
        baseLbl :: [Text]
baseLbl = Int -> Text -> [Text]
forall a. Int -> a -> [a]
replicate Int
hC (Int -> Text -> Text
Text.replicate Int
left Text
" ")

        yTicks :: [(Int, Double)]
yTicks = Int -> Int -> (Double, Double) -> Bool -> [(Int, Double)]
ticks1D Int
hC (Plot -> Int
yNumTicks Plot
cfg) (Double
ymin, Double
ymax) Bool
True
        yEnv :: Int -> AxisEnv
yEnv Int
n = (Double, Double) -> Int -> Int -> AxisEnv
AxisEnv (Double
ymin, Double
ymax) Int
n (Plot -> Int
yNumTicks Plot
cfg)
        ySlot :: Int
ySlot = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 Int
left
        yLabels :: [Text]
yLabels =
            ([Text] -> (Int, Double) -> [Text])
-> [Text] -> [(Int, 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'
                ( \[Text]
acc (Int
row, Double
v) ->
                    [Text] -> Int -> Text -> [Text]
forall a. [a] -> Int -> a -> [a]
setAt [Text]
acc Int
row (Text -> [Text]) -> (Text -> Text) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
ellipsisize Int
left (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
justifyRight Int
left (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$
                        Plot -> LabelFormatter
yFormatter Plot
cfg (Int -> AxisEnv
yEnv Int
row) Int
ySlot Double
v
                )
                [Text]
baseLbl
                [(Int, Double)]
yTicks

        renderRow :: [(Char, Maybe Color)] -> Text
renderRow [(Char, Maybe Color)]
cells =
            [Text] -> Text
Text.concat
                (((Char, Maybe Color) -> Text) -> [(Char, Maybe Color)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Char
ch, Maybe Color
mc) -> Text -> (Color -> Text) -> Maybe Color -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Char -> Text
Text.singleton Char
ch) (Color -> Char -> Text
`paint` Char
ch) Maybe Color
mc) [(Char, Maybe Color)]
cells)
        attachY :: [Text]
attachY = (Text -> [(Char, Maybe Color)] -> Text)
-> [Text] -> [[(Char, Maybe Color)]] -> [Text]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Text
lbl [(Char, Maybe Color)]
cells -> Text
lbl Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"│" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [(Char, Maybe Color)] -> Text
renderRow [(Char, Maybe Color)]
cells) [Text]
yLabels [[(Char, Maybe Color)]]
finalGrid

        xBar :: Text
xBar = Int -> Text -> Text
Text.replicate Int
left Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"└" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
Text.replicate Int
wC Text
"─"

        xLine :: Text
xLine =
            (Text -> (Int, Text) -> Text) -> Text -> [(Int, Text)] -> 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'
                ( \Text
acc (Int
idx, Text
name) ->
                    let boxCenter :: Int
boxCenter = Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
boxWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
spacing) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
boxWidth Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
                        lblWidth :: Int
lblWidth = Text -> Int
wcswidth Text
name
                        lblStart :: Int
lblStart = Int
left Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
boxCenter Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
lblWidth Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
                     in Int -> Text -> Text
Text.take Int
lblStart Text
acc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
Text.drop (Int
lblStart Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Text -> Int
wcswidth Text
name) Text
acc
                )
                (Int -> Text -> Text
Text.replicate (Int
left Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
wC) Text
" ")
                ([Int] -> [Text] -> [(Int, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 ..] (((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))

        ax :: Text
ax = [Text] -> Text
Text.unlines ([Text]
attachY [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
xBar, Text
xLine])

        legend :: Text
legend =
            LegendPos -> Int -> [(Text, Pat, Color)] -> Text
legendBlock
                (Plot -> LegendPos
legendPos Plot
cfg)
                (Plot -> Int
leftMargin Plot
cfg Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Plot -> Int
widthChars Plot
cfg)
                [ (Text
name, Pat
Solid, [Color]
pieColors [Color] -> Int -> Color
forall a. HasCallStack => [a] -> Int -> a
!! (Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` [Color] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Color]
pieColors))
                | (Int
i, (Text
name, (Double, Double, Double, Double, Double)
_)) <- [Int]
-> [(Text, (Double, Double, Double, Double, Double))]
-> [(Int, (Text, (Double, Double, Double, Double, Double)))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 ..] [(Text, (Double, Double, Double, Double, Double))]
stats
                ]
     in Plot -> Text -> Text -> Text
drawFrame Plot
cfg Text
ax Text
legend
  where
    drawVLine :: [[(a, b)]] -> Int -> Int -> Int -> a -> b -> [[(a, b)]]
drawVLine [[(a, b)]]
grid Int
x Int
y1 Int
y2 a
ch b
col =
        let yStart :: Int
yStart = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
y1 Int
y2
            yEnd :: Int
yEnd = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
y1 Int
y2
         in ([[(a, b)]] -> Int -> [[(a, b)]])
-> [[(a, b)]] -> [Int] -> [[(a, b)]]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' (\[[(a, b)]]
g Int
y -> [[(a, b)]] -> Int -> Int -> a -> b -> [[(a, b)]]
forall {a} {b}. [[(a, b)]] -> Int -> Int -> a -> b -> [[(a, b)]]
setGridChar [[(a, b)]]
g Int
x Int
y a
ch b
col) [[(a, b)]]
grid [Int
yStart .. Int
yEnd]

    drawHLine :: [[(a, b)]] -> Int -> Int -> Int -> a -> b -> [[(a, b)]]
drawHLine [[(a, b)]]
grid Int
x1 Int
x2 Int
y a
ch b
col =
        let xStart :: Int
xStart = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
x1 Int
x2
            xEnd :: Int
xEnd = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
x1 Int
x2
         in ([[(a, b)]] -> Int -> [[(a, b)]])
-> [[(a, b)]] -> [Int] -> [[(a, b)]]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' (\[[(a, b)]]
g Int
x -> [[(a, b)]] -> Int -> Int -> a -> b -> [[(a, b)]]
forall {a} {b}. [[(a, b)]] -> Int -> Int -> a -> b -> [[(a, b)]]
setGridChar [[(a, b)]]
g Int
x Int
y a
ch b
col) [[(a, b)]]
grid [Int
xStart .. Int
xEnd]

    setGridChar :: [[(a, b)]] -> Int -> Int -> a -> b -> [[(a, b)]]
setGridChar [[(a, b)]]
grid Int
x Int
y a
ch b
col =
        [[(a, b)]] -> Int -> ([(a, b)] -> [(a, b)]) -> [[(a, b)]]
forall a. [a] -> Int -> (a -> a) -> [a]
updateAt [[(a, b)]]
grid Int
y (\[(a, b)]
row -> [(a, b)] -> Int -> (a, b) -> [(a, b)]
forall a. [a] -> Int -> a -> [a]
setAt [(a, b)]
row Int
x (a
ch, b
col))

data Pat = Solid | Checker | DiagA | DiagB | Sparse deriving (Pat -> Pat -> Bool
(Pat -> Pat -> Bool) -> (Pat -> Pat -> Bool) -> Eq Pat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Pat -> Pat -> Bool
== :: Pat -> Pat -> Bool
$c/= :: Pat -> Pat -> Bool
/= :: Pat -> Pat -> Bool
Eq, Int -> Pat -> ShowS
[Pat] -> ShowS
Pat -> String
(Int -> Pat -> ShowS)
-> (Pat -> String) -> ([Pat] -> ShowS) -> Show Pat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Pat -> ShowS
showsPrec :: Int -> Pat -> ShowS
$cshow :: Pat -> String
show :: Pat -> String
$cshowList :: [Pat] -> ShowS
showList :: [Pat] -> ShowS
Show)

ink :: Pat -> Int -> Int -> Bool
ink :: Pat -> Int -> Int -> Bool
ink Pat
Solid Int
_ Int
_ = Bool
True
ink Pat
Checker Int
x Int
y = (Int
x Int -> Int -> Int
forall a. Bits a => a -> a -> a
`xor` Int
y) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
ink Pat
DiagA Int
x Int
y = (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
y) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
3 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
1
ink Pat
DiagB Int
x Int
y = (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
y) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
3 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
1
ink Pat
Sparse Int
x Int
y = Int
x Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& Int
y Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
3 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0

palette :: [Pat]
palette :: [Pat]
palette = [Pat
Solid, Pat
Checker, Pat
DiagA, Pat
DiagB, Pat
Sparse]

fmt :: AxisEnv -> Int -> Double -> Text
fmt :: LabelFormatter
fmt AxisEnv
_ Int
_ Double
v
    | Double -> Double
forall a. Num a => a -> a
abs Double
v Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
10000 Bool -> Bool -> Bool
|| Double -> Double
forall a. Num a => a -> a
abs Double
v Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
0.01 Bool -> Bool -> Bool
&& Double
v Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
/= Double
0 =
        String -> Text
Text.pack (Maybe Int -> Double -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showEFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1) Double
v String
"")
    | Bool
otherwise = String -> Text
Text.pack (Maybe Int -> Double -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1) Double
v String
"")

drawFrame :: Plot -> Text -> Text -> Text
drawFrame :: Plot -> Text -> Text -> Text
drawFrame Plot
cfg Text
contentWithAxes Text
legendBlockStr =
    [Text] -> Text
Text.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
        (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter
            (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
Text.null)
            [Plot -> Text
plotTitle Plot
cfg, Text
contentWithAxes, Text
legendBlockStr]

slotBudget :: Int -> Int -> Int
slotBudget :: Int -> Int -> Int
slotBudget Int
plotPixels Int
numTicks =
    Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Int
plotPixels 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
numTicks)

axisify :: Plot -> Canvas -> (Double, Double) -> (Double, Double) -> Text
axisify :: Plot -> Canvas -> (Double, Double) -> (Double, Double) -> Text
axisify Plot
cfg Canvas
c (Double
xmin, Double
xmax) (Double
ymin, Double
ymax) =
    let plotW :: Int
plotW = Canvas -> Int
cW Canvas
c
        plotH :: Int
plotH = Canvas -> Int
cH Canvas
c
        left :: Int
left = Plot -> Int
leftMargin Plot
cfg
        pad :: Text
pad = Int -> Text -> Text
Text.replicate Int
left Text
" "

        yTicks :: [(Int, Double)]
        yTicks :: [(Int, Double)]
yTicks = Int -> Int -> (Double, Double) -> Bool -> [(Int, Double)]
ticks1D Int
plotH (Plot -> Int
yNumTicks Plot
cfg) (Double
ymin, Double
ymax) Bool
True

        baseLbl :: [Text]
        baseLbl :: [Text]
baseLbl = Int -> Text -> [Text]
forall a. Int -> a -> [a]
replicate Int
plotH Text
pad

        yEnv :: Int -> AxisEnv
yEnv Int
n = (Double, Double) -> Int -> Int -> AxisEnv
AxisEnv (Double
ymin, Double
ymax) Int
n Int
3
        ySlot :: Int
ySlot = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 Int
left
        yLabels :: [Text]
yLabels =
            ([Text] -> (Int, Double) -> [Text])
-> [Text] -> [(Int, 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'
                ( \[Text]
acc (Int
row, Double
v) ->
                    [Text] -> Int -> Text -> [Text]
forall a. [a] -> Int -> a -> [a]
setAt [Text]
acc Int
row
                        (Text -> [Text]) -> (Text -> Text) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
ellipsisize Int
left
                        (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
justifyRight Int
left
                        (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Plot -> LabelFormatter
yFormatter Plot
cfg (Int -> AxisEnv
yEnv Int
row) Int
ySlot Double
v
                )
                [Text]
baseLbl
                [(Int, Double)]
yTicks

        canvasLines :: [Text]
canvasLines = Text -> [Text]
Text.lines (Canvas -> Text
renderCanvas Canvas
c)
        attachY :: [Text]
attachY = (Text -> Text -> Text) -> [Text] -> [Text] -> [Text]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Text
lbl Text
line -> Text
lbl Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"│" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
line) [Text]
yLabels [Text]
canvasLines

        xBar :: Text
xBar = Text
pad Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"└" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
Text.replicate Int
plotW Text
"─"

        xTicks :: [(Int, Double)]
        xTicks :: [(Int, Double)]
xTicks = Int -> Int -> (Double, Double) -> Bool -> [(Int, Double)]
ticks1D Int
plotW (Plot -> Int
xNumTicks Plot
cfg) (Double
xmin, Double
xmax) Bool
False

        xEnv :: Int -> AxisEnv
xEnv Int
n = (Double, Double) -> Int -> Int -> AxisEnv
AxisEnv (Double
xmin, Double
xmax) Int
n Int
3
        slotW :: Int
slotW = Int -> Int -> Int
slotBudget Int
plotW (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 ([(Int, Double)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Int, Double)]
xTicks))
        xLine :: Text
xLine =
            Text -> Int -> [(Int, Text)] -> Text
placeLabels
                (Int -> Text -> Text
Text.replicate (Int
left Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
plotW) Text
" ")
                (Int
left Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                [(Int
x, Plot -> LabelFormatter
xFormatter Plot
cfg (Int -> AxisEnv
xEnv Int
i) Int
slotW Double
v) | (Int
i, (Int
x, Double
v)) <- [Int] -> [(Int, Double)] -> [(Int, (Int, Double))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 ..] [(Int, Double)]
xTicks]
     in [Text] -> Text
Text.unlines ([Text]
attachY [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
xBar, Text
xLine])

axisifyGrid ::
    Plot ->
    [[(Char, Maybe Color)]] ->
    (Double, Double) ->
    (Double, Double) ->
    [Text] ->
    Maybe Int ->
    Text
axisifyGrid :: Plot
-> [[(Char, Maybe Color)]]
-> (Double, Double)
-> (Double, Double)
-> [Text]
-> Maybe Int
-> Text
axisifyGrid Plot
cfg [[(Char, Maybe Color)]]
grid (Double
xmin, Double
xmax) (Double
ymin, Double
ymax) [Text]
categories Maybe Int
w =
    let plotH :: Int
plotH = [[(Char, Maybe Color)]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[(Char, Maybe Color)]]
grid
        plotW :: Int
plotW = [[(Char, Maybe Color)]] -> Int
forall a. [[a]] -> Int
gridWidth [[(Char, Maybe Color)]]
grid
        left :: Int
left = Plot -> Int
leftMargin Plot
cfg
        pad :: Text
pad = Int -> Text -> Text
Text.replicate Int
left Text
" "

        yTicks :: [(Int, Double)]
yTicks = Int -> Int -> (Double, Double) -> Bool -> [(Int, Double)]
ticks1D Int
plotH (Plot -> Int
yNumTicks Plot
cfg) (Double
ymin, Double
ymax) Bool
True
        baseLbl :: [Text]
baseLbl = Int -> Text -> [Text]
forall a. Int -> a -> [a]
List.replicate Int
plotH Text
pad

        yEnv :: Int -> AxisEnv
yEnv Int
n = (Double, Double) -> Int -> Int -> AxisEnv
AxisEnv (Double
ymin, Double
ymax) Int
n (Plot -> Int
yNumTicks Plot
cfg)
        ySlot :: Int
ySlot = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 Int
left
        yLabels :: [Text]
yLabels =
            ([Text] -> (Int, Double) -> [Text])
-> [Text] -> [(Int, 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'
                ( \[Text]
acc (Int
row, Double
v) ->
                    [Text] -> Int -> Text -> [Text]
forall a. [a] -> Int -> a -> [a]
setAt [Text]
acc Int
row
                        (Text -> [Text]) -> (Text -> Text) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
ellipsisize Int
left
                        (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
justifyRight Int
left
                        (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Plot -> LabelFormatter
yFormatter Plot
cfg (Int -> AxisEnv
yEnv Int
row) Int
ySlot Double
v
                )
                [Text]
baseLbl
                [(Int, Double)]
yTicks

        renderRow :: [(Char, Maybe Color)] -> Text
        renderRow :: [(Char, Maybe Color)] -> Text
renderRow [(Char, Maybe Color)]
cells =
            [Text] -> Text
Text.concat
                (((Char, Maybe Color) -> Text) -> [(Char, Maybe Color)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Char
ch, Maybe Color
mc) -> Text -> (Color -> Text) -> Maybe Color -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Char -> Text
Text.singleton Char
ch) (Color -> Char -> Text
`paint` Char
ch) Maybe Color
mc) [(Char, Maybe Color)]
cells)

        attachY :: [Text]
attachY = (Text -> [(Char, Maybe Color)] -> Text)
-> [Text] -> [[(Char, Maybe Color)]] -> [Text]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Text
lbl [(Char, Maybe Color)]
cells -> Text
lbl Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"│" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [(Char, Maybe Color)] -> Text
renderRow [(Char, Maybe Color)]
cells) [Text]
yLabels [[(Char, Maybe Color)]]
grid

        xBar :: Text
xBar = Text
pad Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"└" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
Text.replicate Int
plotW Text
"─"

        hasCategories :: Bool
hasCategories = Bool -> Bool
not ([Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
categories) Bool -> Bool -> Bool
&& Bool -> Bool
not ((Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Text -> Bool
Text.null [Text]
categories)

        xLine :: Text
xLine =
            if Bool
hasCategories
                then
                    let slotW :: Int
slotW =
                            Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe
                                ( Int -> Int -> Int
slotBudget
                                    Int
plotW
                                    (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Plot -> Int
xNumTicks Plot
cfg))
                                )
                                Maybe Int
w
                        nSlots :: Int
nSlots = Int
plotW Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
slotW
                        xTicks :: [(Int, Double)]
xTicks = Int -> Int -> (Double, Double) -> Bool -> [(Int, Double)]
ticks1D Int
plotW Int
nSlots (Double
xmin, Double
xmax) Bool
False
                     in Text -> Int -> [Text] -> Text
placeGridLabels
                            (Int -> Text -> Text
Text.replicate (Int
left Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Text
" ")
                            Int
slotW
                            (Int -> Int -> [Text] -> [Text]
keepPercentiles ([Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
categories) ([(Int, Double)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Int, Double)]
xTicks Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [Text]
categories)
                else
                    let xTicks :: [(Int, Double)]
xTicks = Int -> Int -> (Double, Double) -> Bool -> [(Int, Double)]
ticks1D Int
plotW (Plot -> Int
xNumTicks Plot
cfg) (Double
xmin, Double
xmax) Bool
False
                        xEnv :: Int -> AxisEnv
xEnv Int
i = (Double, Double) -> Int -> Int -> AxisEnv
AxisEnv (Double
xmin, Double
xmax) Int
i (Plot -> Int
xNumTicks Plot
cfg)
                        slotW :: Int
slotW = Int -> Int -> Int
slotBudget Int
plotW (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 ([(Int, Double)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Int, Double)]
xTicks))
                     in Text -> Int -> [(Int, Text)] -> Text
placeLabels
                            (Int -> Text -> Text
Text.replicate (Int
left Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
plotW) Text
" ")
                            (Int
left Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                            [(Int
x, Plot -> LabelFormatter
xFormatter Plot
cfg (Int -> AxisEnv
xEnv Int
i) Int
slotW Double
v) | (Int
i, (Int
x, Double
v)) <- [Int] -> [(Int, Double)] -> [(Int, (Int, Double))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 ..] [(Int, Double)]
xTicks]
     in [Text] -> Text
Text.unlines ([Text]
attachY [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
xBar, Text
xLine])

keepPercentiles :: Int -> Int -> [Text] -> [Text]
keepPercentiles :: Int -> Int -> [Text] -> [Text]
keepPercentiles Int
n Int
k [Text]
xs
    | Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = []
    | [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
xs = Int -> Text -> [Text]
forall a. Int -> a -> [a]
replicate Int
k Text
""
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1 = Int -> Text -> [Text]
forall a. Int -> a -> [a]
replicate Int
k Text
""
    | Bool
otherwise = (Int -> Text) -> [Int] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Text
valueAt [Int
0 .. Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2] [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [[Text] -> Text
forall a. HasCallStack => [a] -> a
last [Text]
xs]
  where
    m :: Int
m = [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
xs
    pairs :: [(Int, Text)]
    pairs :: [(Int, Text)]
pairs =
        [ ( Int
slotIx
          , [Text]
xs [Text] -> Int -> Text
forall a. HasCallStack => [a] -> Int -> a
!! Int
srcIx
          )
        | Int
i <- [Int
0 .. Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2]
        , let srcIx :: Int
srcIx = (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
        , let slotIx :: Int
slotIx = (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
        ]

    valueAt :: Int -> Text
    valueAt :: Int -> Text
valueAt Int
i = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Int -> [(Int, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
List.lookup Int
i [(Int, Text)]
pairs

placeLabels :: Text -> Int -> [(Int, Text)] -> Text
placeLabels :: Text -> Int -> [(Int, Text)] -> Text
placeLabels Text
base Int
off = (Text -> (Int, Text) -> Text) -> Text -> [(Int, Text)] -> 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' Text -> (Int, Text) -> Text
place Text
base
  where
    place :: Text -> (Int, Text) -> Text
    place :: Text -> (Int, Text) -> Text
place Text
acc (Int
x, Text
s) =
        let i :: Int
i = Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x
         in Int -> Text -> Text
Text.take Int
i Text
acc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
Text.drop (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Text -> Int
wcswidth Text
s) Text
acc

placeGridLabels :: Text -> Int -> [Text] -> Text
placeGridLabels :: Text -> Int -> [Text] -> Text
placeGridLabels Text
base Int
slotW = (Text -> Text -> Text) -> Text -> [Text] -> 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' Text -> Text -> Text
place Text
base
  where
    place :: Text -> Text -> Text
    place :: Text -> Text -> Text
place Text
acc Text
s =
        let lblWidth :: Int
lblWidth = Text -> Int
wcswidth Text
s
            padding :: Int
padding = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 ((Int
slotW Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
lblWidth) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2)
            centered :: Text
centered = Int -> Text -> Text
Text.replicate Int
padding Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s
         in Text
acc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
Text.take Int
slotW (Text
centered Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
Text.replicate Int
slotW Text
" ")

legendBlock :: LegendPos -> Int -> [(Text, Pat, Color)] -> Text
legendBlock :: LegendPos -> Int -> [(Text, Pat, Color)] -> Text
legendBlock LegendPos
LegendBottom Int
width [(Text, Pat, Color)]
entries =
    let cells :: [Text]
cells = [Pat -> Color -> Text
sample Pat
pat Color
col Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name | (Text
name, Pat
pat, Color
col) <- [(Text, Pat, Color)]
entries]
        line :: Text
line = Text -> [Text] -> Text
Text.intercalate Text
"   " [Text]
cells
        pad :: Text
pad =
            let vis :: Int
vis = Text -> Int
wcswidth Text
line
             in if Int
vis Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
width then Int -> Text -> Text
Text.replicate ((Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
vis) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) Text
" " else Text
""
     in Text
pad Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
line
legendBlock LegendPos
LegendRight Int
_ [(Text, Pat, Color)]
entries =
    [Text] -> Text
Text.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
        ((Text, Pat, Color) -> Text) -> [(Text, Pat, Color)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Text
name, Pat
pat, Color
col) -> Pat -> Color -> Text
sample Pat
pat Color
col Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name) [(Text, Pat, Color)]
entries
legendBlock LegendPos
LegendNone Int
_ [(Text, Pat, Color)]
_ = Text
""

sample :: Pat -> Color -> Text
sample :: Pat -> Color -> Text
sample Pat
p Color
col =
    let c :: Canvas
c =
            (Canvas -> (Int, Int) -> Canvas)
-> Canvas -> [(Int, Int)] -> Canvas
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl'
                ( \Canvas
cv (Int
dx, Int
dy) -> if Pat -> Int -> Int -> Bool
ink Pat
p Int
dx Int
dy then Canvas -> Int -> Int -> Maybe Color -> Canvas
setDotC Canvas
cv (Int
dx Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
2) (Int
dy Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
4) (Color -> Maybe Color
forall a. a -> Maybe a
Just Color
col) else Canvas
cv
                )
                (Int -> Int -> Canvas
newCanvas Int
1 Int
1)
                [(Int
x, Int
y) | Int
y <- [Int
0 .. Int
3], Int
x <- [Int
0 .. Int
1]]
        s :: Text
s = Canvas -> Text
renderCanvas Canvas
c
     in (Char -> Bool) -> Text -> Text
Text.dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n') Text
s

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

blockChar :: Int -> Char
blockChar :: Int -> Char
blockChar Int
n = case Int -> Int -> Int -> Int
forall a. Ord a => a -> a -> a -> a
clamp Int
0 Int
8 Int
n of
    Int
0 -> Char
' '
    Int
1 -> Char
'▁'
    Int
2 -> Char
'▂'
    Int
3 -> Char
'▃'
    Int
4 -> Char
'▄'
    Int
5 -> Char
'▅'
    Int
6 -> Char
'▆'
    Int
7 -> Char
'▇'
    Int
_ -> Char
'█'

colGlyphs :: Int -> Double -> String
colGlyphs :: Int -> Double -> String
colGlyphs Int
hC Double
frac =
    let total :: Int
total = Int
hC Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8
        ticks :: Int
ticks = Int -> Int -> Int -> Int
forall a. Ord a => a -> a -> a -> a
clamp Int
0 Int
total (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Double
frac Double -> Double -> Double
forall a. Num a => a -> a -> a
* Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
total))
        full :: Int
full = Int
ticks Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8
        rem8 :: Int
rem8 = Int
ticks Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
full Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8
        topPad :: Int
topPad = Int
hC Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
full Int -> Int -> Int
forall a. Num a => a -> a -> a
- (if Int
rem8 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then Int
1 else Int
0)
        middle :: String
middle = [Int -> Char
blockChar Int
rem8 | Int
rem8 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0]
     in Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
topPad Char
' ' String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
middle String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
full Char
'█'

resampleToWidth :: Int -> [Double] -> [Double]
resampleToWidth :: Int -> [Double] -> [Double]
resampleToWidth Int
w [Double]
xs
    | Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = []
    | [Double] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Double]
xs = Int -> Double -> [Double]
forall a. Int -> a -> [a]
replicate Int
w Double
0
    | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
w = [Double]
xs
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
w = Int -> [Double]
avgGroup (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w :: Double)))
    | Bool
otherwise = [Double]
replicateOut
  where
    n :: Int
n = [Double] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Double]
xs
    avgGroup :: Int -> [Double]
avgGroup Int
g =
        [[Double] -> Double
forall {t :: * -> *} {a}. (Foldable t, Fractional a) => t a -> a
avg (Int -> [Double] -> [Double]
forall a. Int -> [a] -> [a]
take Int
g (Int -> [Double] -> [Double]
forall a. Int -> [a] -> [a]
drop (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
g) [Double]
xs)) | Int
i <- [Int
0 .. Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]]
      where
        avg :: t a -> a
avg t a
ys = if t a -> Bool
forall a. t a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null t a
ys then a
0 else t a -> a
forall a. Num a => t a -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum t a
ys a -> a -> a
forall a. Fractional a => a -> a -> a
/ Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (t a -> Int
forall a. t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
ys)
    replicateOut :: [Double]
replicateOut =
        let base :: Int
base = Int
w Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
n
            extra :: Int
extra = Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
base Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
n
         in [[Double]] -> [Double]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                [ Int -> Double -> [Double]
forall a. Int -> a -> [a]
replicate (Int
base Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
extra then Int
1 else Int
0)) Double
v
                | (Int
i, Double
v) <- [Int] -> [Double] -> [(Int, Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 ..] [Double]
xs
                ]

-- | Filled-area chart with the curve closed down to @y=0@.
area :: [(Text, [(Double, Double)])] -> Plot -> Text
area :: [(Text, [(Double, Double)])] -> Plot -> Text
area [(Text, [(Double, Double)])]
sers Plot
cfg =
    Chart -> Text
renderChartTerminal (Chart -> Text) -> Chart -> Text
forall a b. (a -> b) -> a -> b
$
        [(Text, [(Double, Double)])] -> Int -> Int -> Text -> Chart
LC.areaChart [(Text, [(Double, Double)])]
sers (Plot -> Int
widthChars Plot
cfg) (Plot -> Int
heightChars Plot
cfg) (Plot -> Text
plotTitle Plot
cfg)

-- | Filled band between @(x, ymin, ymax)@ curves — e.g. CI envelopes.
ribbon :: [(Text, [(Double, Double, Double)])] -> Plot -> Text
ribbon :: [(Text, [(Double, Double, Double)])] -> Plot -> Text
ribbon [(Text, [(Double, Double, Double)])]
sers Plot
cfg =
    Chart -> Text
renderChartTerminal (Chart -> Text) -> Chart -> Text
forall a b. (a -> b) -> a -> b
$
        [(Text, [(Double, Double, Double)])] -> Int -> Int -> Text -> Chart
LC.ribbonChart [(Text, [(Double, Double, Double)])]
sers (Plot -> Int
widthChars Plot
cfg) (Plot -> Int
heightChars Plot
cfg) (Plot -> Text
plotTitle Plot
cfg)

-- | Gaussian KDE per series (Silverman bandwidth).
density :: [(Text, [Double])] -> Plot -> Text
density :: [(Text, [Double])] -> Plot -> Text
density [(Text, [Double])]
sers Plot
cfg =
    Chart -> Text
renderChartTerminal (Chart -> Text) -> Chart -> Text
forall a b. (a -> b) -> a -> b
$
        [(Text, [Double])] -> Int -> Int -> Text -> Chart
LC.densityChart [(Text, [Double])]
sers (Plot -> Int
widthChars Plot
cfg) (Plot -> Int
heightChars Plot
cfg) (Plot -> Text
plotTitle Plot
cfg)

-- | Points with vertical error bars: @(x, y, ymin, ymax)@ per row.
errorBars :: [(Text, [(Double, Double, Double, Double)])] -> Plot -> Text
errorBars :: [(Text, [(Double, Double, Double, Double)])] -> Plot -> Text
errorBars [(Text, [(Double, Double, Double, Double)])]
sers Plot
cfg =
    Chart -> Text
renderChartTerminal (Chart -> Text) -> Chart -> Text
forall a b. (a -> b) -> a -> b
$
        [(Text, [(Double, Double, Double, Double)])]
-> Int -> Int -> Text -> Chart
LC.errorBarsChart [(Text, [(Double, Double, Double, Double)])]
sers (Plot -> Int
widthChars Plot
cfg) (Plot -> Int
heightChars Plot
cfg) (Plot -> Text
plotTitle Plot
cfg)

-- | Horizontal bars sized by their values.
funnel :: [(Text, Double)] -> Plot -> Text
funnel :: [(Text, Double)] -> Plot -> Text
funnel [(Text, Double)]
stages Plot
cfg =
    Chart -> Text
renderChartTerminal (Chart -> Text) -> Chart -> Text
forall a b. (a -> b) -> a -> b
$
        [(Text, Double)] -> Int -> Int -> Text -> Chart
LC.funnelChart [(Text, Double)]
stages (Plot -> Int
widthChars Plot
cfg) (Plot -> Int
heightChars Plot
cfg) (Plot -> Text
plotTitle Plot
cfg)

-- | Polar line chart; theta in radians CCW from +x.
polarLine :: [(Text, [(Double, Double)])] -> Plot -> Text
polarLine :: [(Text, [(Double, Double)])] -> Plot -> Text
polarLine [(Text, [(Double, Double)])]
sers Plot
cfg =
    Chart -> Text
renderChartTerminal (Chart -> Text) -> Chart -> Text
forall a b. (a -> b) -> a -> b
$
        [(Text, [(Double, Double)])] -> Int -> Int -> Text -> Chart
LC.polarLineChart [(Text, [(Double, Double)])]
sers (Plot -> Int
widthChars Plot
cfg) (Plot -> Int
heightChars Plot
cfg) (Plot -> Text
plotTitle Plot
cfg)

-- | Waterfall chart: rows are @(label, start, end)@.
waterfall :: [(Text, Double, Double)] -> Plot -> Text
waterfall :: [(Text, Double, Double)] -> Plot -> Text
waterfall [(Text, Double, Double)]
rows Plot
cfg =
    Chart -> Text
renderChartTerminal (Chart -> Text) -> Chart -> Text
forall a b. (a -> b) -> a -> b
$
        [(Text, Double, Double)] -> Int -> Int -> Text -> Chart
LC.waterfallChart [(Text, Double, Double)]
rows (Plot -> Int
widthChars Plot
cfg) (Plot -> Int
heightChars Plot
cfg) (Plot -> Text
plotTitle Plot
cfg)

-- | Histogram + KDE overlay per series.
distPlot :: [(Text, [Double])] -> Plot -> Text
distPlot :: [(Text, [Double])] -> Plot -> Text
distPlot [(Text, [Double])]
sers Plot
cfg =
    Chart -> Text
renderChartTerminal (Chart -> Text) -> Chart -> Text
forall a b. (a -> b) -> a -> b
$
        [(Text, [Double])] -> Int -> Int -> Text -> Chart
LC.distPlotChart [(Text, [Double])]
sers (Plot -> Int
widthChars Plot
cfg) (Plot -> Int
heightChars Plot
cfg) (Plot -> Text
plotTitle Plot
cfg)

{- | Gaussian / normal-distribution chart in standard-deviation (z-score) units.

Given a population sample, 'gauss' computes the mean (μ) and standard deviation
(σ), draws the kernel-density estimate of the distribution as a stippled bell
curve, and annotates named markers at their z-score positions. The marker with
the largest z-score is highlighted as the outlier.

This reproduces the "where does X sit on the curve?" style of chart: a smooth
density curve filled with scattered dots, an x-axis labelled in σ units, and
lollipop annotations dropping from each named value down to the axis.

==== __Example__

@
let -- goals + assists per 90 for every attacker in the league
    population = ...
    stars =
        [ ("Lewandowski", 1.05)
        , ("Mbappé",      1.02)
        , ("Haaland",     1.10)
        , ("Ronaldo",     1.12)
        , ("Messi",       1.45)
        ]
chart = gauss population stars defPlot{plotTitle = "g + a per 90"}
@
-}
gauss ::
    -- | Population sample (used to compute μ and σ)
    [Double] ->
    -- | Named markers as @(label, raw value)@; the largest z is highlighted
    [(Text, Double)] ->
    -- | Plot configuration
    Plot ->
    -- | Rendered chart as Text
    Text
gauss :: [Double] -> [(Text, Double)] -> Plot -> Text
gauss [Double]
population [(Text, Double)]
markers Plot
cfg =
    let n :: Int
n = [Double] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Double]
population
        mu :: Double
mu = if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Double
0 else [Double] -> Double
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Double]
population Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
        var :: Double
var =
            if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2
                then Double
0
                else [Double] -> Double
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [(Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
mu) Double -> Int -> Double
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
2 :: Int) | Double
x <- [Double]
population] Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
        sigma :: Double
sigma = Double -> Double
forall {a}. Floating a => a -> a
sqrt (Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
var Double
eps)
        z :: Double -> Double
z Double
v = (Double
v Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
mu) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
sigma

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

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

        wC :: Int
wC = Plot -> Int
widthChars Plot
cfg
        hC :: Int
hC = Plot -> Int
heightChars Plot
cfg
        wDots :: Int
wDots = Int
wC Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2
        hDots :: Int
hDots = Int
hC Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
4
        left :: Int
left = Plot -> Int
leftMargin Plot
cfg

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

        xAtDot :: a -> Double
xAtDot a
xd = Double
zmin Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (a -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
xd 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
wDots Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
zspan
        colDens :: [Double]
colDens = [Double -> Double
dens (Int -> Double
forall {a}. Integral a => a -> Double
xAtDot Int
xd) | Int
xd <- [Int
0 .. Int
wDots Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]]
        dmax :: Double
dmax = [Double] -> Double
maximum' [Double]
colDens Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
eps

        -- Curve fills up to ~90% of the canvas height at its peak.
        topFrac :: Double
topFrac = Double
0.9
        yTopOf :: Double -> Int
yTopOf Double
d =
            Int -> Int -> Int -> Int
forall a. Ord a => a -> a -> a -> a
clamp Int
0 (Int
hDots 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
round (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
hDots Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- (Double
d Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
dmax) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
topFrac))

        -- Deterministic stipple so the fill looks scattered but is reproducible.
        inkStip :: a -> a -> Bool
inkStip a
xd a
yd =
            let a :: a
a = a
xd a -> a -> a
forall a. Num a => a -> a -> a
* a
374761393 a -> a -> a
forall a. Num a => a -> a -> a
+ (a
yd a -> a -> a
forall a. Num a => a -> a -> a
+ a
1) a -> a -> a
forall a. Num a => a -> a -> a
* a
668265263
                b :: a
b = (a
a a -> a -> a
forall a. Bits a => a -> a -> a
`xor` (a
a a -> a -> a
forall a. Integral a => a -> a -> a
`div` a
13)) a -> a -> a
forall a. Num a => a -> a -> a
* a
1274126177
             in (a -> a
forall a. Num a => a -> a
abs a
b a -> a -> a
forall a. Integral a => a -> a -> a
`mod` a
100) a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
46

        -- Map a z value to a dot column / character column.
        sxz :: Double -> Int
sxz Double
zz = Int -> Int -> Int -> Int
forall a. Ord a => a -> a -> a -> a
clamp Int
0 (Int
wDots 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
round ((Double
zz Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
zmin) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
zspan Double -> Double -> Double
forall a. Num a => a -> a -> a
* Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
wDots Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)))
        sxChar :: Double -> Int
sxChar Double
zz = Int
left Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Double -> Int
sxz Double
zz Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2

        curveCol :: Color
curveCol = Color
BrightWhite
        fillCol :: Color
fillCol = Color
BrightBlack
        meanCol :: Color
meanCol = Color
BrightBlack

        -- Stipple under the curve + draw the curve outline.
        canvas0 :: Canvas
canvas0 = Int -> Int -> Canvas
newCanvas Int
wC Int
hC
        drawCol :: Canvas -> (Int, Double) -> Canvas
drawCol Canvas
c (Int
xd, Double
d) =
            let yt :: Int
yt = Double -> Int
yTopOf Double
d
                c1 :: Canvas
c1 = Canvas -> Int -> Int -> Maybe Color -> Canvas
setDotC Canvas
c Int
xd Int
yt (Color -> Maybe Color
forall a. a -> Maybe a
Just Color
curveCol)
             in (Canvas -> Int -> Canvas) -> Canvas -> [Int] -> Canvas
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl'
                    (\Canvas
cc Int
yd -> if Int -> Int -> Bool
forall {a}. (Bits a, Integral a) => a -> a -> Bool
inkStip Int
xd Int
yd then Canvas -> Int -> Int -> Maybe Color -> Canvas
setDotC Canvas
cc Int
xd Int
yd (Color -> Maybe Color
forall a. a -> Maybe a
Just Color
fillCol) else Canvas
cc)
                    Canvas
c1
                    [Int
yt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 .. Int
hDots Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
        cFilled :: Canvas
cFilled = (Canvas -> (Int, Double) -> Canvas)
-> Canvas -> [(Int, Double)] -> Canvas
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' Canvas -> (Int, Double) -> Canvas
drawCol Canvas
canvas0 ([Int] -> [Double] -> [(Int, Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 ..] [Double]
colDens)

        -- Faint dashed guide at the mean (z = 0), if it is inside the domain.
        cMean :: Canvas
cMean =
            if Double
zmin Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
0 Bool -> Bool -> Bool
&& Double
zmax Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
0
                then
                    let xd0 :: Int
xd0 = Double -> Int
sxz Double
0
                     in (Canvas -> Int -> Canvas) -> Canvas -> [Int] -> Canvas
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl'
                            (\Canvas
cc Int
yd -> if Int
yd Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
4 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2 then Canvas -> Int -> Int -> Maybe Color -> Canvas
setDotC Canvas
cc Int
xd0 Int
yd (Color -> Maybe Color
forall a. a -> Maybe a
Just Color
meanCol) else Canvas
cc)
                            Canvas
cFilled
                            [Int
0 .. Int
hDots Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
                else Canvas
cFilled

        -- Lollipop leader lines for each marker (highlighted one is brighter).
        markerColor :: Double -> Color
markerColor Double
zz = if Double
zz Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
maxMarkerZ Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
eps then Color
BrightMagenta else Color
BrightCyan
        drawMarker :: Canvas -> (a, Double) -> Canvas
drawMarker Canvas
c (a
_name, Double
zz) =
            let xd :: Int
xd = Double -> Int
sxz Double
zz
                col :: Color
col = Double -> Color
markerColor Double
zz
                c1 :: Canvas
c1 = (Int, Int) -> (Int, Int) -> Maybe Color -> Canvas -> Canvas
lineDotsC (Int
xd, Int
hDots Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int
xd, Int
0) (Color -> Maybe Color
forall a. a -> Maybe a
Just Color
col) Canvas
c
             in if Double
zz Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
maxMarkerZ Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
eps
                    then
                        (Canvas -> (Int, Int) -> Canvas)
-> Canvas -> [(Int, Int)] -> Canvas
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl'
                            (\Canvas
cc (Int
ax, Int
ay) -> Canvas -> Int -> Int -> Maybe Color -> Canvas
setDotC Canvas
cc Int
ax Int
ay (Color -> Maybe Color
forall a. a -> Maybe a
Just Color
col))
                            Canvas
c1
                            [ (Int
xd Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dx, Int
hDots Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dy)
                            | Int
dx <- [-Int
1, Int
0, Int
1]
                            , Int
dy <- [-Int
1, Int
0]
                            ]
                    else Canvas
c1
        cMarked :: Canvas
cMarked = (Canvas -> (Text, Double) -> Canvas)
-> Canvas -> [(Text, Double)] -> Canvas
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' Canvas -> (Text, Double) -> Canvas
forall {a}. Canvas -> (a, Double) -> Canvas
drawMarker Canvas
cMean [(Text, Double)]
zsMark

        -- Plot body: blank y-axis gutter + axis bar + canvas.
        plotLines :: [Text]
plotLines =
            [ Int -> Text -> Text
Text.replicate Int
left Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"│" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ln
            | Text
ln <- Text -> [Text]
Text.lines (Canvas -> Text
renderCanvas Canvas
cMarked)
            ]

        -- Annotation band above the plot: marker labels stacked to avoid overlap.
        -- Enough rows that tightly clustered tail markers each get their own line.
        annRows :: Int
annRows = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
6 ([(Text, Double)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Text, Double)]
zsMark))
        chartW :: Int
chartW = Int
left Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
wC
        sigmaTxt :: a -> Text
sigmaTxt a
zz = String -> Text
Text.pack (Maybe Int -> a -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1) a
zz String
"") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"σ"
        sortedM :: [(Text, Double)]
sortedM = ((Text, Double) -> Int) -> [(Text, Double)] -> [(Text, Double)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
List.sortOn (\(Text
_, Double
zz) -> Double -> Int
sxz Double
zz) [(Text, Double)]
zsMark
        assign :: [[(Int, Int)]]
-> [(Int, Int, Text, Color)]
-> [(Text, Double)]
-> ([[(Int, Int)]], [(Int, Int, Text, Color)])
assign [[(Int, Int)]]
occ [(Int, Int, Text, Color)]
acc [] = ([[(Int, Int)]]
occ, [(Int, Int, Text, Color)]
acc)
        assign [[(Int, Int)]]
occ [(Int, Int, Text, Color)]
acc ((Text
name, Double
zz) : [(Text, Double)]
rest) =
            let lbl :: Text
lbl = Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Double -> Text
forall {a}. RealFloat a => a -> Text
sigmaTxt Double
zz
                w :: Int
w = Text -> Int
wcswidth Text
lbl
                center :: Int
center = Double -> Int
sxChar Double
zz
                start :: Int
start = Int -> Int -> Int -> Int
forall a. Ord a => a -> a -> a -> a
clamp Int
0 (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
chartW Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
w)) (Int
center Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
w Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2)
                end :: Int
end = Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
w
                fits :: Int -> Bool
fits Int
r = ((Int, Int) -> Bool) -> [(Int, Int)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\(Int
s, Int
e) -> Int
end Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
s Bool -> Bool -> Bool
|| Int
start Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
e Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ([[(Int, Int)]]
occ [[(Int, Int)]] -> Int -> [(Int, Int)]
forall a. HasCallStack => [a] -> Int -> a
!! Int
r)
                row :: Int
row = case (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
filter Int -> Bool
fits [Int
0 .. Int
annRows Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1] of
                    (Int
r : [Int]
_) -> Int
r
                    [] -> Int
annRows Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
                occ' :: [[(Int, Int)]]
occ' = [[(Int, Int)]]
-> Int -> ([(Int, Int)] -> [(Int, Int)]) -> [[(Int, Int)]]
forall a. [a] -> Int -> (a -> a) -> [a]
updateAt [[(Int, Int)]]
occ Int
row ((Int
start, Int
end) :)
             in [[(Int, Int)]]
-> [(Int, Int, Text, Color)]
-> [(Text, Double)]
-> ([[(Int, Int)]], [(Int, Int, Text, Color)])
assign [[(Int, Int)]]
occ' ((Int
row, Int
start, Text
lbl, Double -> Color
markerColor Double
zz) (Int, Int, Text, Color)
-> [(Int, Int, Text, Color)] -> [(Int, Int, Text, Color)]
forall a. a -> [a] -> [a]
: [(Int, Int, Text, Color)]
acc) [(Text, Double)]
rest
        ([[(Int, Int)]]
_, [(Int, Int, Text, Color)]
placements) = [[(Int, Int)]]
-> [(Int, Int, Text, Color)]
-> [(Text, Double)]
-> ([[(Int, Int)]], [(Int, Int, Text, Color)])
assign (Int -> [(Int, Int)] -> [[(Int, Int)]]
forall a. Int -> a -> [a]
replicate Int
annRows []) [] [(Text, Double)]
sortedM
        baseCells :: [(Char, Maybe a)]
baseCells = Int -> (Char, Maybe a) -> [(Char, Maybe a)]
forall a. Int -> a -> [a]
replicate Int
chartW (Char
' ', Maybe a
forall a. Maybe a
Nothing)
        putLabel :: [[(Char, Maybe a)]] -> (Int, Int, Text, a) -> [[(Char, Maybe a)]]
putLabel [[(Char, Maybe a)]]
grid (Int
row, Int
start, Text
lbl, a
col) =
            [[(Char, Maybe a)]]
-> Int
-> ([(Char, Maybe a)] -> [(Char, Maybe a)])
-> [[(Char, Maybe a)]]
forall a. [a] -> Int -> (a -> a) -> [a]
updateAt [[(Char, Maybe a)]]
grid Int
row (([(Char, Maybe a)] -> [(Char, Maybe a)]) -> [[(Char, Maybe a)]])
-> ([(Char, Maybe a)] -> [(Char, Maybe a)]) -> [[(Char, Maybe a)]]
forall a b. (a -> b) -> a -> b
$ \[(Char, Maybe a)]
cells ->
                ([(Char, Maybe a)] -> (Int, Char) -> [(Char, Maybe a)])
-> [(Char, Maybe a)] -> [(Int, Char)] -> [(Char, Maybe a)]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl'
                    (\[(Char, Maybe a)]
cs (Int
i, Char
ch) -> [(Char, Maybe a)] -> Int -> (Char, Maybe a) -> [(Char, Maybe a)]
forall a. [a] -> Int -> a -> [a]
setAt [(Char, Maybe a)]
cs (Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i) (Char
ch, a -> Maybe a
forall a. a -> Maybe a
Just a
col))
                    [(Char, Maybe a)]
cells
                    ([Int] -> String -> [(Int, Char)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 ..] (Text -> String
Text.unpack Text
lbl))
        annGrid :: [[(Char, Maybe Color)]]
annGrid = ([[(Char, Maybe Color)]]
 -> (Int, Int, Text, Color) -> [[(Char, Maybe Color)]])
-> [[(Char, Maybe Color)]]
-> [(Int, Int, Text, Color)]
-> [[(Char, Maybe Color)]]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' [[(Char, Maybe Color)]]
-> (Int, Int, Text, Color) -> [[(Char, Maybe Color)]]
forall {a}.
[[(Char, Maybe a)]] -> (Int, Int, Text, a) -> [[(Char, Maybe a)]]
putLabel (Int -> [(Char, Maybe Color)] -> [[(Char, Maybe Color)]]
forall a. Int -> a -> [a]
replicate Int
annRows [(Char, Maybe Color)]
forall {a}. [(Char, Maybe a)]
baseCells) [(Int, Int, Text, Color)]
placements
        renderCells :: [(Char, Maybe Color)] -> Text
renderCells =
            [Text] -> Text
Text.concat
                ([Text] -> Text)
-> ([(Char, Maybe Color)] -> [Text])
-> [(Char, Maybe Color)]
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Char, Maybe Color) -> Text) -> [(Char, Maybe Color)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\(Char
ch, Maybe Color
mc) -> Text -> (Color -> Text) -> Maybe Color -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Char -> Text
Text.singleton Char
ch) (Color -> Char -> Text
`paint` Char
ch) Maybe Color
mc)
        annLines :: [Text]
annLines = if [(Text, Double)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Text, Double)]
zsMark then [] else ([(Char, Maybe Color)] -> Text)
-> [[(Char, Maybe Color)]] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map [(Char, Maybe Color)] -> Text
renderCells [[(Char, Maybe Color)]]
annGrid

        -- σ x-axis: an integer tick for each standard deviation in range.
        xBar :: Text
xBar = Int -> Text -> Text
Text.replicate Int
left Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"└" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
Text.replicate Int
wC Text
"─"
        sigInts :: [Int]
sigInts = [Int
k | Int
k <- [Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
ceiling Double
zmin .. Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor Double
zmax :: Int], Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0]
        xTickPlacements :: [(Int, Text)]
xTickPlacements =
            [ (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Double -> Int
sxChar (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
k) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
wcswidth Text
lbl Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2), Text
lbl)
            | Int
k <- [Int]
sigInts
            , let lbl :: Text
lbl = String -> Text
Text.pack (Int -> String
forall a. Show a => a -> String
show Int
k) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"σ"
            ]
        xLine :: Text
xLine = Text -> Int -> [(Int, Text)] -> Text
placeLabels (Int -> Text -> Text
Text.replicate Int
chartW Text
" ") Int
0 [(Int, Text)]
xTickPlacements
        avgLine :: [Text]
avgLine =
            if Double
zmin Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
0 Bool -> Bool -> Bool
&& Double
zmax Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
0
                then
                    let lbl :: Text
lbl = Text
"average" :: Text
                        start :: Int
start = Int -> Int -> Int -> Int
forall a. Ord a => a -> a -> a -> a
clamp Int
0 (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
chartW Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
wcswidth Text
lbl)) (Double -> Int
sxChar Double
0 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
wcswidth Text
lbl Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2)
                     in [Text -> Int -> [(Int, Text)] -> Text
placeLabels (Int -> Text -> Text
Text.replicate Int
chartW Text
" ") Int
0 [(Int
start, Text
lbl)]]
                else []

        showD2 :: a -> Text
showD2 a
v = String -> Text
Text.pack (Maybe Int -> a -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
2) a
v String
"")
        footer :: Text
footer =
            Int -> Text -> Text
Text.replicate Int
left Text
" "
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"μ="
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Double -> Text
forall {a}. RealFloat a => a -> Text
showD2 Double
mu
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"   σ="
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Double -> Text
forall {a}. RealFloat a => a -> Text
showD2 Double
sigma
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ( case ((Text, Double) -> Double) -> [(Text, Double)] -> [(Text, Double)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
List.sortOn (Double -> Double
forall a. Num a => a -> a
negate (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)]
zsMark of
                        ((Text
hiName, Double
hiZ) : [(Text, Double)]
_) ->
                            Text
"   "
                                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
Text.concat ((Char -> Text) -> String -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Color -> Char -> Text
paint Color
BrightMagenta) (Text -> String
Text.unpack (Text
"◆ " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
hiName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Double -> Text
forall {a}. RealFloat a => a -> Text
sigmaTxt Double
hiZ)))
                        [] -> Text
""
                   )

        allLines :: [Text]
allLines =
            (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
Text.null) [Plot -> Text
plotTitle Plot
cfg]
                [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
annLines
                [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
plotLines
                [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
xBar, Text
xLine]
                [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
avgLine
                [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
footer]
     in [Text] -> Text
Text.unlines [Text]
allLines