{-# 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,
) where

import Data.Bits (xor, (.&.), (.|.))
import Data.Char (chr)
import Data.Function (on)
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

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

-- | Supported ANSI colo(u)rs.
data Color
    = Default
    | Black
    | Red
    | Green
    | Yellow
    | Blue
    | Magenta
    | Cyan
    | White
    | BrightBlack
    | BrightRed
    | BrightGreen
    | BrightYellow
    | BrightBlue
    | BrightMagenta
    | BrightCyan
    | BrightWhite
    deriving (Color -> Color -> Bool
(Color -> Color -> Bool) -> (Color -> Color -> Bool) -> Eq Color
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Color -> Color -> Bool
== :: Color -> Color -> Bool
$c/= :: Color -> Color -> Bool
/= :: Color -> Color -> Bool
Eq, Int -> Color -> ShowS
[Color] -> ShowS
Color -> String
(Int -> Color -> ShowS)
-> (Color -> String) -> ([Color] -> ShowS) -> Show Color
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Color -> ShowS
showsPrec :: Int -> Color -> ShowS
$cshow :: Color -> String
show :: Color -> String
$cshowList :: [Color] -> ShowS
showList :: [Color] -> ShowS
Show)

{- | 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 :: (a, t (Double, Double), Pat, Color) -> Canvas -> Canvas
drawOne (a
_name, t (Double, Double)
pts, Pat
pat, Color
col) Canvas
c0 =
            (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' (((Text, [(Double, Double)], Pat, Color) -> Canvas -> Canvas)
-> Canvas -> (Text, [(Double, Double)], Pat, Color) -> Canvas
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Text, [(Double, Double)], Pat, Color) -> Canvas -> Canvas
forall {t :: * -> *} {a}.
Foldable t =>
(a, t (Double, Double), Pat, Color) -> Canvas -> 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 data = [("Apple", 45.2), ("Banana", 38.1), ("Orange", 52.7)]
    chart = bars data 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
        vals :: [Double]
vals = ((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)]
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, 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)]
kvs)
                ((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
safeHead [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 data = [("Q1", [("Product A", 100), ("Product B", 150)]),
            ("Q2", [("Product A", 120), ("Product B", 180)])]
    chart = stackedBars data 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
safeHead [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]
        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) -> [(String, Maybe Color)])
-> [(String, Maybe Color)] -> [[(String, Maybe Color)]]
forall a b. (a -> b) -> [a] -> [b]
map (String, Maybe Color) -> [(String, Maybe Color)]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [(String, Maybe Color)]
dataCols)

        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)]
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
a, Double
b) (Double
0, 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))) [] 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 data = [("Chrome", 65), ("Firefox", 20), ("Safari", 10), ("Other", 5)]
    chart = pie data 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'

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

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

        ax :: Text
ax =
            Plot
-> [[(Char, Maybe Color)]]
-> (Double, Double)
-> (Double, Double)
-> [Text]
-> Maybe Int
-> Text
axisifyGrid
                Plot
cfg
                [[(Char, Maybe Color)]]
displayGrid
                (Double
0, Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
cols Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
1)
                (Double
0, Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
rows Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
1)
                []
                (Int -> Maybe Int
forall a. a -> Maybe a
Just (Int
plotW Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
cols))

        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)

        ax :: Text
ax =
            Plot
-> [[(Char, Maybe Color)]]
-> (Double, Double)
-> (Double, Double)
-> [Text]
-> Maybe Int
-> Text
axisifyGrid
                Plot
cfg
                [[(Char, Maybe Color)]]
finalGrid
                (Double
0, Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nBoxes)
                (Double
ymin, Double
ymax)
                (((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)
                (Int -> Maybe Int
forall a. a -> Maybe a
Just (Int
boxWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
spacing))
        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 =
        if Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< [[(a, b)]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[(a, b)]]
grid Bool -> Bool -> Bool
&& Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< [[(a, b)]] -> Int
forall a. [[a]] -> Int
gridWidth [[(a, b)]]
grid
            then Int -> [[(a, b)]] -> [[(a, b)]]
forall a. Int -> [a] -> [a]
take Int
y [[(a, b)]]
grid [[(a, b)]] -> [[(a, b)]] -> [[(a, b)]]
forall a. Semigroup a => a -> a -> a
<> [[(a, b)] -> Int -> (a, b) -> [(a, b)]
forall {a}. [a] -> Int -> a -> [a]
setAt ([[(a, b)]]
grid [[(a, b)]] -> Int -> [(a, b)]
forall a. HasCallStack => [a] -> Int -> a
!! Int
y) Int
x (a
ch, b
col)] [[(a, b)]] -> [[(a, b)]] -> [[(a, b)]]
forall a. Semigroup a => a -> a -> a
<> Int -> [[(a, b)]] -> [[(a, b)]]
forall a. Int -> [a] -> [a]
drop (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [[(a, b)]]
grid
            else [[(a, b)]]
grid
      where
        setAt :: [a] -> Int -> a -> [a]
setAt [a]
row Int
i a
v = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
i [a]
row [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
<> [a
v] [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
<> Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [a]
row

ansiCode :: Color -> Int
ansiCode :: Color -> Int
ansiCode Color
Black = Int
30
ansiCode Color
Red = Int
31
ansiCode Color
Green = Int
32
ansiCode Color
Yellow = Int
33
ansiCode Color
Blue = Int
34
ansiCode Color
Magenta = Int
35
ansiCode Color
Cyan = Int
36
ansiCode Color
White = Int
37
ansiCode Color
BrightBlack = Int
90
ansiCode Color
BrightRed = Int
91
ansiCode Color
BrightGreen = Int
92
ansiCode Color
BrightYellow = Int
93
ansiCode Color
BrightBlue = Int
94
ansiCode Color
BrightMagenta = Int
95
ansiCode Color
BrightCyan = Int
96
ansiCode Color
BrightWhite = Int
97
ansiCode Color
Default = Int
39

ansiOn :: Color -> Text
ansiOn :: Color -> Text
ansiOn Color
c = Text
"\ESC[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (Int -> String
forall a. Show a => a -> String
show (Color -> Int
ansiCode Color
c)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"m"

ansiOff :: Text
ansiOff :: Text
ansiOff = Text
"\ESC[0m"

paint :: Color -> Char -> Text
paint :: Color -> Char -> Text
paint Color
c Char
ch = if Char
ch Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ' then Text
" " else Color -> Text
ansiOn Color
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Char -> Text
Text.singleton Char
ch Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ansiOff

paletteColors :: [Color]
paletteColors :: [Color]
paletteColors =
    [ Color
BrightBlue
    , Color
BrightMagenta
    , Color
BrightCyan
    , Color
BrightGreen
    , Color
BrightYellow
    , Color
BrightRed
    , Color
BrightWhite
    , Color
BrightBlack
    ]

pieColors :: [Color]
pieColors :: [Color]
pieColors =
    [ Color
BrightRed
    , Color
BrightGreen
    , Color
BrightYellow
    , Color
BrightBlue
    , Color
BrightMagenta
    , Color
BrightCyan
    , Color
BrightWhite
    , Color
BrightBlack
    ]

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]

data Array2D a = A2D Int Int (Arr a)

getA2D :: Array2D a -> Int -> Int -> a
getA2D :: forall a. Array2D a -> Int -> Int -> a
getA2D (A2D Int
w Int
_ Arr a
xs) Int
x Int
y = Arr a -> Int -> a
forall a. Arr a -> Int -> a
indexA Arr a
xs (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x)

setA2D :: Array2D a -> Int -> Int -> a -> Array2D a
setA2D :: forall a. Array2D a -> Int -> Int -> a -> Array2D a
setA2D (A2D Int
w Int
h Arr a
xs) Int
x Int
y a
v =
    let i :: Int
i = Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x
     in Int -> Int -> Arr a -> Array2D a
forall a. Int -> Int -> Arr a -> Array2D a
A2D Int
w Int
h (Arr a -> Int -> a -> Arr a
forall a. Arr a -> Int -> a -> Arr a
setA Arr a
xs Int
i a
v)

newA2D :: Int -> Int -> a -> Array2D a
newA2D :: forall a. Int -> Int -> a -> Array2D a
newA2D Int
w Int
h a
v = Int -> Int -> Arr a -> Array2D a
forall a. Int -> Int -> Arr a -> Array2D a
A2D Int
w Int
h ([a] -> Arr a
forall a. [a] -> Arr a
fromList (Int -> a -> [a]
forall a. Int -> a -> [a]
replicate (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
h) a
v))

toBit :: Int -> Int -> Int
toBit :: Int -> Int -> Int
toBit Int
ry Int
rx = case (Int
ry, Int
rx) of
    (Int
0, Int
0) -> Int
1
    (Int
1, Int
0) -> Int
2
    (Int
2, Int
0) -> Int
4
    (Int
3, Int
0) -> Int
64
    (Int
0, Int
1) -> Int
8
    (Int
1, Int
1) -> Int
16
    (Int
2, Int
1) -> Int
32
    (Int
3, Int
1) -> Int
128
    (Int, Int)
_ -> Int
0

data Canvas = Canvas
    { Canvas -> Int
cW :: Int
    , Canvas -> Int
cH :: Int
    , Canvas -> Array2D Int
buffer :: Array2D Int
    , Canvas -> Array2D (Maybe Color)
cbuf :: Array2D (Maybe Color)
    }

newCanvas :: Int -> Int -> Canvas
newCanvas :: Int -> Int -> Canvas
newCanvas Int
w Int
h = Int -> Int -> Array2D Int -> Array2D (Maybe Color) -> Canvas
Canvas Int
w Int
h (Int -> Int -> Int -> Array2D Int
forall a. Int -> Int -> a -> Array2D a
newA2D Int
w Int
h Int
0) (Int -> Int -> Maybe Color -> Array2D (Maybe Color)
forall a. Int -> Int -> a -> Array2D a
newA2D Int
w Int
h Maybe Color
forall a. Maybe a
Nothing)

setDotC :: Canvas -> Int -> Int -> Maybe Color -> Canvas
setDotC :: Canvas -> Int -> Int -> Maybe Color -> Canvas
setDotC Canvas
c Int
xDot Int
yDot Maybe Color
mcol
    | Int
xDot Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
yDot Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
xDot Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Canvas -> Int
cW Canvas
c Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2 Bool -> Bool -> Bool
|| Int
yDot Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Canvas -> Int
cH Canvas
c Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
4 = Canvas
c
    | Bool
otherwise =
        let cx :: Int
cx = Int
xDot Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
            cy :: Int
cy = Int
yDot Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
4
            rx :: Int
rx = Int
xDot Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
cx
            ry :: Int
ry = Int
yDot Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
cy
            b :: Int
b = Int -> Int -> Int
toBit Int
ry Int
rx
            m :: Int
m = Array2D Int -> Int -> Int -> Int
forall a. Array2D a -> Int -> Int -> a
getA2D (Canvas -> Array2D Int
buffer Canvas
c) Int
cx Int
cy
            c' :: Canvas
c' = Canvas
c{buffer = setA2D (buffer c) cx cy (m .|. b)}
         in case Maybe Color
mcol of
                Maybe Color
Nothing -> Canvas
c'
                Just Color
col -> Canvas
c'{cbuf = setA2D (cbuf c) cx cy (Just col)}

fillDotsC ::
    (Int, Int) ->
    (Int, Int) ->
    (Int -> Int -> Bool) ->
    Maybe Color ->
    Canvas ->
    Canvas
fillDotsC :: (Int, Int)
-> (Int, Int)
-> (Int -> Int -> Bool)
-> Maybe Color
-> Canvas
-> Canvas
fillDotsC (Int
x0, Int
y0) (Int
x1, Int
y1) Int -> Int -> Bool
p Maybe Color
mcol Canvas
c0 =
    let xs :: [Int]
xs = [Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 Int
x0 .. Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Canvas -> Int
cW Canvas
c0 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
x1]
        ys :: [Int]
ys = [Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 Int
y0 .. Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Canvas -> Int
cH Canvas
c0 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
y1]
     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
c Int
y -> (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
c' Int
x -> if Int -> Int -> Bool
p Int
x Int
y then Canvas -> Int -> Int -> Maybe Color -> Canvas
setDotC Canvas
c' Int
x Int
y Maybe Color
mcol else Canvas
c') Canvas
c [Int]
xs)
            Canvas
c0
            [Int]
ys

renderCanvas :: Canvas -> Text
renderCanvas :: Canvas -> Text
renderCanvas (Canvas Int
w Int
h Array2D Int
a Array2D (Maybe Color)
colA) =
    let glyph :: Int -> Char
glyph Int
0 = Char
' '
        glyph Int
m = Int -> Char
chr (Int
0x2800 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
m)
        rows :: [[Text]]
rows =
            (Int -> [Text]) -> [Int] -> [[Text]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
                ( \Int
y -> ((Int -> Text) -> [Int] -> [Text])
-> [Int] -> (Int -> Text) -> [Text]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Int -> Text) -> [Int] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Int
0 .. Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1] ((Int -> Text) -> [Text]) -> (Int -> Text) -> [Text]
forall a b. (a -> b) -> a -> b
$ \Int
x ->
                    let m :: Int
m = Array2D Int -> Int -> Int -> Int
forall a. Array2D a -> Int -> Int -> a
getA2D Array2D Int
a Int
x Int
y
                        ch :: Char
ch = Int -> Char
glyph Int
m
                        mc :: Maybe Color
mc = Array2D (Maybe Color) -> Int -> Int -> Maybe Color
forall a. Array2D a -> Int -> Int -> a
getA2D Array2D (Maybe Color)
colA Int
x Int
y
                     in 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
                )
                [Int
0 .. Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
     in [Text] -> Text
Text.unlines (([Text] -> Text) -> [[Text]] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Text] -> Text
Text.concat [[Text]]
rows)

justifyRight :: Int -> Text -> Text
justifyRight :: Int -> Text -> Text
justifyRight Int
n Text
s = Int -> Text -> Text
Text.replicate (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
wcswidth Text
s)) Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s

wcswidth :: Text -> Int
wcswidth :: Text -> Int
wcswidth = Int -> Text -> Int
forall {t}. Num t => t -> Text -> t
go Int
0
  where
    go :: t -> Text -> t
go t
acc Text
xs
        | Text -> Bool
Text.null Text
xs = t
acc
        | Text -> Text -> Bool
Text.isPrefixOf Text
"\ESC[" Text
xs =
            let
                rest' :: Text
rest' = (Char -> Bool) -> Text -> Text
Text.dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'm') Text
xs
             in
                if Text -> Bool
Text.null Text
rest' then t
acc else t -> Text -> t
go t
acc (HasCallStack => Text -> Text
Text -> Text
Text.tail Text
rest')
        | Bool
otherwise = t -> Text -> t
go (t
acc t -> t -> t
forall a. Num a => a -> a -> a
+ t
1) (HasCallStack => Text -> Text
Text -> Text
Text.tail Text
xs)

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]

{- | Evenly spaced tick positions in screen space paired with data values.
  If invertY = True, 0 maps to ymax (top row) and 1 maps to ymin (bottom).
-}
ticks1D ::
    -- | screen length in chars (width for X, height for Y)
    Int ->
    -- | requested number of ticks (will clamp to >= 2)
    Int ->
    -- | (vmin, vmax) in data space
    (Double, Double) ->
    -- | invertY? (True for Y axis so row 0 = ymax)
    Bool ->
    -- | (screenPos, dataValue)
    [(Int, Double)]
ticks1D :: Int -> Int -> (Double, Double) -> Bool -> [(Int, Double)]
ticks1D Int
screenLen Int
want (Double
vmin, Double
vmax) Bool
invertY =
    let n :: Int
n = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
2 Int
want
        lastIx :: Int
lastIx = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
screenLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
        toVal :: Double -> Double
toVal Double
t =
            if Bool
invertY
                then Double
vmax Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
t Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
vmax Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
vmin)
                else Double
vmin Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
t Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
vmax Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
vmin)
        mk' :: p -> (a, Double)
mk' p
k =
            let t :: Double
t = if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then Double
0 else p -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral p
k Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
                pos :: a
pos = Double -> a
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Double
t Double -> Double -> Double
forall a. Num a => a -> a -> a
* Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
lastIx)
             in (a
pos, Double -> Double
toVal Double
t)
        raw :: [(Int, Double)]
raw = [Int -> (Int, Double)
forall {p} {a}. (Integral p, Integral a) => p -> (a, Double)
mk' Int
k | Int
k <- [Int
0 .. Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]]
        dedup :: [(Int, Double)]
dedup = ((Int, Double) -> (Int, Double) -> Bool)
-> [(Int, Double)] -> [(Int, Double)]
forall a. (a -> a -> Bool) -> [a] -> [a]
List.nubBy (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Int -> Int -> Bool)
-> ((Int, Double) -> Int) -> (Int, Double) -> (Int, Double) -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Int, Double) -> Int
forall a b. (a, b) -> a
fst) [(Int, Double)]
raw
     in [(Int, Double)]
dedup

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

        setAt :: [Text] -> Int -> Text -> [Text]
        setAt :: [Text] -> Int -> Text -> [Text]
setAt [Text]
xs Int
i Text
v
            | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
xs = [Text]
xs
            | Bool
otherwise = Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
take Int
i [Text]
xs [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
v] [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
drop (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [Text]
xs

        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]
setAt [Text]
acc Int
row (Int -> Text -> Text
justifyRight Int
left (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
x) Int
slotW Double
v) | (Int
x, Double
v) <- [(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

        setAt :: [Text] -> Int -> Text -> [Text]
        setAt :: [Text] -> Int -> Text -> [Text]
setAt [Text]
xs Int
i Text
v
            | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
xs = [Text]
xs
            | Bool
otherwise = Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
take Int
i [Text]
xs [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
v] [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
drop (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [Text]
xs

        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]
setAt [Text]
acc Int
row (Int -> Text -> Text
justifyRight Int
left (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
"─"

        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
        hasCategories :: Bool
hasCategories = Bool -> Bool
not ([Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ((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) [Text]
categories))
        xTicks :: [(Int, Double)]
xTicks = Int -> Int -> (Double, Double) -> Bool -> [(Int, Double)]
ticks1D Int
plotW Int
nSlots (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
nSlots
        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
slotW
                ( if Bool
hasCategories
                    then (Int -> Int -> [Text] -> [Text]
keepPercentiles (Plot -> Int
xNumTicks Plot
cfg) ([(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 [Plot -> LabelFormatter
xFormatter Plot
cfg (Int -> AxisEnv
xEnv Int
i) Int
slotW Double
v | (Int
i, (Int
_, 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 = ([Text] -> [Text]
forall a. HasCallStack => [a] -> [a]
init ((Int -> Text) -> [Int] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ([(Int, Text)] -> Int -> Text
valueAt [(Int, Text)]
pairs) [Int
0 .. Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1])) [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)] -> Int -> Text
    valueAt :: [(Int, Text)] -> Int -> Text
valueAt [] Int
_ = Text
""
    valueAt ((Int
j, Text
v) : [(Int, Text)]
rest) Int
i
        | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j = Text
v
        | Bool
otherwise = [(Int, Text)] -> Int -> Text
valueAt [(Int, Text)]
rest Int
i

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 = Text
acc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
Text.take Int
slotW (Text
s 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

clamp :: (Ord a) => a -> a -> a -> a
clamp :: forall a. Ord a => a -> a -> a -> a
clamp a
low a
high a
x = a -> a -> a
forall a. Ord a => a -> a -> a
max a
low (a -> a -> a
forall a. Ord a => a -> a -> a
min a
high a
x)

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

boundsXY :: Plot -> [(Double, Double)] -> (Double, Double, Double, Double)
boundsXY :: Plot -> [(Double, Double)] -> (Double, Double, Double, Double)
boundsXY Plot
cfg [(Double, Double)]
pts =
    let xs :: [Double]
xs = ((Double, Double) -> Double) -> [(Double, Double)] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (Double, Double) -> Double
forall a b. (a, b) -> a
fst [(Double, Double)]
pts
        ys :: [Double]
ys = ((Double, Double) -> Double) -> [(Double, Double)] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (Double, Double) -> Double
forall a b. (a, b) -> b
snd [(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))
        )

mod' :: Double -> Double -> Double
mod' :: Double -> Double -> Double
mod' Double
a Double
m = Double
a Double -> Double -> Double
forall a. Num a => a -> a -> a
- Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double
a Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
m) :: Int) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
m

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
                ]

addAt :: [Int] -> Int -> Int -> [Int]
addAt :: [Int] -> Int -> Int -> [Int]
addAt [Int]
xs Int
i Int
v = Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
i [Int]
xs [Int] -> [Int] -> [Int]
forall a. Semigroup a => a -> a -> a
<> [[Int]
xs [Int] -> Int -> Int
forall a. HasCallStack => [a] -> Int -> a
!! Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
v] [Int] -> [Int] -> [Int]
forall a. Semigroup a => a -> a -> a
<> Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
drop (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [Int]
xs

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

angleWithin :: Double -> Double -> Double -> Bool
angleWithin :: Double -> Double -> Double -> Bool
angleWithin Double
ang Double
a0 Double
a1
    | Double
a1 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
a0 = Double
ang Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
a0 Bool -> Bool -> Bool
&& Double
ang Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
a1
    | Bool
otherwise = Double
ang Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
a0 Bool -> Bool -> Bool
|| Double
ang Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
a1

lineDotsC :: (Int, Int) -> (Int, Int) -> Maybe Color -> Canvas -> Canvas
lineDotsC :: (Int, Int) -> (Int, Int) -> Maybe Color -> Canvas -> Canvas
lineDotsC (Int
x0, Int
y0) (Int
x1, Int
y1) Maybe Color
mcol Canvas
c0 =
    let dx :: Int
dx = Int -> Int
forall a. Num a => a -> a
abs (Int
x1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
x0)
        sx :: Int
sx = if Int
x0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
x1 then Int
1 else -Int
1
        dy :: Int
dy = Int -> Int
forall a. Num a => a -> a
negate (Int -> Int
forall a. Num a => a -> a
abs (Int
y1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
y0))
        sy :: Int
sy = if Int
y0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
y1 then Int
1 else -Int
1
        go :: Int -> Int -> Int -> Canvas -> Canvas
go Int
x Int
y Int
err Canvas
c
            | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
x1 Bool -> Bool -> Bool
&& Int
y Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
y1 = Canvas -> Int -> Int -> Maybe Color -> Canvas
setDotC Canvas
c Int
x Int
y Maybe Color
mcol
            | Bool
otherwise =
                let e2 :: Int
e2 = Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
err
                    (Int
x', Int
err') = if Int
e2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
dy then (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sx, Int
err Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dy) else (Int
x, Int
err)
                    (Int
y', Int
err'') = if Int
e2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
dx then (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sy, Int
err' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dx) else (Int
y, Int
err')
                 in Int -> Int -> Int -> Canvas -> Canvas
go Int
x' Int
y' Int
err'' (Canvas -> Int -> Int -> Maybe Color -> Canvas
setDotC Canvas
c Int
x Int
y Maybe Color
mcol)
     in Int -> Int -> Int -> Canvas -> Canvas
go Int
x0 Int
y0 (Int
dx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dy) Canvas
c0

quartiles :: [Double] -> (Double, Double, Double, Double, Double)
quartiles :: [Double] -> (Double, Double, Double, Double, Double)
quartiles [] = (Double
0, Double
0, Double
0, Double
0, Double
0) -- Idk. Maybe throw an error here???
quartiles [Double]
xs =
    let sorted :: [Double]
sorted = [Double] -> [Double]
forall a. Ord a => [a] -> [a]
List.sort [Double]
xs
        n :: Int
n = [Double] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Double]
sorted
        q1Idx :: Int
q1Idx = Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
4
        q2Idx :: Int
q2Idx = Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
        q3Idx :: Int
q3Idx = Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
4
        getIdx :: Int -> Double
getIdx Int
i = if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n then [Double]
sorted [Double] -> Int -> Double
forall a. HasCallStack => [a] -> Int -> a
!! Int
i else [Double] -> Double
forall a. HasCallStack => [a] -> a
last [Double]
sorted
     in if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
5
            then let m :: Double
m = [Double] -> Double
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Double]
xs Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n in (Double
m, Double
m, Double
m, Double
m, Double
m)
            else
                ( Double
-> ((Double, [Double]) -> Double)
-> Maybe (Double, [Double])
-> Double
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Double
0 (Double, [Double]) -> Double
forall a b. (a, b) -> a
fst ([Double] -> Maybe (Double, [Double])
forall a. [a] -> Maybe (a, [a])
List.uncons [Double]
sorted)
                , Int -> Double
getIdx Int
q1Idx
                , Int -> Double
getIdx Int
q2Idx
                , Int -> Double
getIdx Int
q3Idx
                , [Double] -> Double
forall a. HasCallStack => [a] -> a
last [Double]
sorted
                )

gridWidth :: [[a]] -> Int
gridWidth :: forall a. [[a]] -> Int
gridWidth [] = Int
0
gridWidth ([a]
x : [[a]]
_) = [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
x

-- | Min and max function for axis bounds which defaults to 0 and 1 when empty.
minimum', maximum' :: [Double] -> Double
minimum' :: [Double] -> Double
minimum' [] = Double
0
minimum' [Double]
xs = [Double] -> Double
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Double]
xs
maximum' :: [Double] -> Double
maximum' [] = Double
1
maximum' [Double]
xs = [Double] -> Double
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Double]
xs

safeHead :: [a] -> Maybe a
safeHead :: forall a. [a] -> Maybe a
safeHead [] = Maybe a
forall a. Maybe a
Nothing
safeHead (a
x : [a]
_) = a -> Maybe a
forall a. a -> Maybe a
Just a
x

-- AVL Tree we'll use as an array.
-- This improves upon the previous implementation that relies
-- on linked list for indexing and update (both O(n)) while keeping
-- the dependencies very light (wouldn't want to install all of containers
-- just to get an int map).
data Arr a
    = E
    | N Int Int (Arr a) a (Arr a)

size :: Arr a -> Int
size :: forall a. Arr a -> Int
size Arr a
E = Int
0
size (N Int
sz Int
_ Arr a
_ a
_ Arr a
_) = Int
sz

height :: Arr a -> Int
height :: forall a. Arr a -> Int
height Arr a
E = Int
0
height (N Int
_ Int
h Arr a
_ a
_ Arr a
_) = Int
h

mk :: Arr a -> a -> Arr a -> Arr a
mk :: forall a. Arr a -> a -> Arr a -> Arr a
mk Arr a
l a
x Arr a
r = Int -> Int -> Arr a -> a -> Arr a -> Arr a
forall a. Int -> Int -> Arr a -> a -> Arr a -> Arr a
N Int
sz Int
h Arr a
l a
x Arr a
r
  where
    sl :: Int
sl = Arr a -> Int
forall a. Arr a -> Int
size Arr a
l
    sr :: Int
sr = Arr a -> Int
forall a. Arr a -> Int
size Arr a
r
    hl :: Int
hl = Arr a -> Int
forall a. Arr a -> Int
height Arr a
l
    hr :: Int
hr = Arr a -> Int
forall a. Arr a -> Int
height Arr a
r
    sz :: Int
sz = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sl Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sr
    h :: Int
h = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
hl Int
hr

rotateL :: Arr a -> Arr a
rotateL :: forall a. Arr a -> Arr a
rotateL (N Int
_ Int
_ Arr a
l a
x (N Int
_ Int
_ Arr a
rl a
y Arr a
rr)) = Arr a -> a -> Arr a -> Arr a
forall a. Arr a -> a -> Arr a -> Arr a
mk (Arr a -> a -> Arr a -> Arr a
forall a. Arr a -> a -> Arr a -> Arr a
mk Arr a
l a
x Arr a
rl) a
y Arr a
rr
rotateL Arr a
_ = String -> Arr a
forall a. HasCallStack => String -> a
error String
"rotateL: malformed tree"

rotateR :: Arr a -> Arr a
rotateR :: forall a. Arr a -> Arr a
rotateR (N Int
_ Int
_ (N Int
_ Int
_ Arr a
ll a
y Arr a
lr) a
x Arr a
r) = Arr a -> a -> Arr a -> Arr a
forall a. Arr a -> a -> Arr a -> Arr a
mk Arr a
ll a
y (Arr a -> a -> Arr a -> Arr a
forall a. Arr a -> a -> Arr a -> Arr a
mk Arr a
lr a
x Arr a
r)
rotateR Arr a
_ = String -> Arr a
forall a. HasCallStack => String -> a
error String
"rotateR: malformed tree"

balance :: Arr a -> Arr a
balance :: forall a. Arr a -> Arr a
balance t :: Arr a
t@(N Int
_ Int
_ Arr a
l a
x Arr a
r)
    | Arr a -> Int
forall a. Arr a -> Int
height Arr a
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Arr a -> Int
forall a. Arr a -> Int
height Arr a
r Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 =
        case Arr a
l of
            N Int
_ Int
_ Arr a
ll a
_ Arr a
lr ->
                if Arr a -> Int
forall a. Arr a -> Int
height Arr a
ll Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Arr a -> Int
forall a. Arr a -> Int
height Arr a
lr
                    then Arr a -> Arr a
forall a. Arr a -> Arr a
rotateR Arr a
t
                    else Arr a -> Arr a
forall a. Arr a -> Arr a
rotateR (Arr a -> a -> Arr a -> Arr a
forall a. Arr a -> a -> Arr a -> Arr a
mk (Arr a -> Arr a
forall a. Arr a -> Arr a
rotateL Arr a
l) a
x Arr a
r)
            Arr a
_ -> Arr a
t
    | Arr a -> Int
forall a. Arr a -> Int
height Arr a
r Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Arr a -> Int
forall a. Arr a -> Int
height Arr a
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 =
        case Arr a
r of
            N Int
_ Int
_ Arr a
rl a
_ Arr a
rr ->
                if Arr a -> Int
forall a. Arr a -> Int
height Arr a
rr Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Arr a -> Int
forall a. Arr a -> Int
height Arr a
rl
                    then Arr a -> Arr a
forall a. Arr a -> Arr a
rotateL Arr a
t
                    else Arr a -> Arr a
forall a. Arr a -> Arr a
rotateL (Arr a -> a -> Arr a -> Arr a
forall a. Arr a -> a -> Arr a -> Arr a
mk Arr a
l a
x (Arr a -> Arr a
forall a. Arr a -> Arr a
rotateR Arr a
r))
            Arr a
_ -> Arr a
t
    | Bool
otherwise = Arr a -> a -> Arr a -> Arr a
forall a. Arr a -> a -> Arr a -> Arr a
mk Arr a
l a
x Arr a
r
balance Arr a
t = Arr a
t

indexA :: Arr a -> Int -> a
indexA :: forall a. Arr a -> Int -> a
indexA Arr a
t Int
i =
    case Arr a
t of
        Arr a
E -> String -> a
forall a. HasCallStack => String -> a
error (String
"index out of bounds: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
i)
        N Int
_ Int
_ Arr a
l a
x Arr a
r ->
            let sl :: Int
sl = Arr a -> Int
forall a. Arr a -> Int
size Arr a
l
             in if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sl Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Arr a -> Int
forall a. Arr a -> Int
size Arr a
r
                    then String -> a
forall a. HasCallStack => String -> a
error (String
"index out of bounds: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
i)
                    else
                        if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sl
                            then Arr a -> Int -> a
forall a. Arr a -> Int -> a
indexA Arr a
l Int
i
                            else
                                if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
sl
                                    then a
x
                                    else Arr a -> Int -> a
forall a. Arr a -> Int -> a
indexA Arr a
r (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sl Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

setA :: Arr a -> Int -> a -> Arr a
setA :: forall a. Arr a -> Int -> a -> Arr a
setA Arr a
t Int
i a
y =
    case Arr a
t of
        Arr a
E -> String -> Arr a
forall a. HasCallStack => String -> a
error (String
"index out of bounds when setting: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
i)
        N Int
_ Int
_ Arr a
l a
x Arr a
r ->
            let sl :: Int
sl = Arr a -> Int
forall a. Arr a -> Int
size Arr a
l
             in if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sl Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Arr a -> Int
forall a. Arr a -> Int
size Arr a
r
                    then String -> Arr a
forall a. HasCallStack => String -> a
error (String
"index out of bounds: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
i)
                    else
                        if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sl
                            then Arr a -> Arr a
forall a. Arr a -> Arr a
balance (Arr a -> a -> Arr a -> Arr a
forall a. Arr a -> a -> Arr a -> Arr a
mk (Arr a -> Int -> a -> Arr a
forall a. Arr a -> Int -> a -> Arr a
setA Arr a
l Int
i a
y) a
x Arr a
r)
                            else
                                if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
sl
                                    then Arr a -> a -> Arr a -> Arr a
forall a. Arr a -> a -> Arr a -> Arr a
mk Arr a
l a
y Arr a
r
                                    else Arr a -> Arr a
forall a. Arr a -> Arr a
balance (Arr a -> a -> Arr a -> Arr a
forall a. Arr a -> a -> Arr a -> Arr a
mk Arr a
l a
x (Arr a -> Int -> a -> Arr a
forall a. Arr a -> Int -> a -> Arr a
setA Arr a
r (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
sl Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) a
y))

fromList :: [a] -> Arr a
fromList :: forall a. [a] -> Arr a
fromList [a]
xs = (Arr a, [a]) -> Arr a
forall a b. (a, b) -> a
fst (Int -> [a] -> (Arr a, [a])
forall a. Int -> [a] -> (Arr a, [a])
build ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs) [a]
xs)
  where
    build :: Int -> [a] -> (Arr a, [a])
    build :: forall a. Int -> [a] -> (Arr a, [a])
build Int
0 [a]
ys = (Arr a
forall a. Arr a
E, [a]
ys)
    build Int
n [a]
ys =
        let (Arr a
l, [a]
ys1) = Int -> [a] -> (Arr a, [a])
forall a. Int -> [a] -> (Arr a, [a])
build (Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) [a]
ys
            (a
x, [a]
ys2) = case [a]
ys1 of
                [] -> String -> (a, [a])
forall a. HasCallStack => String -> a
error String
"IMPOSSIBLE"
                (a
v : [a]
vs) -> (a
v, [a]
vs)
            (Arr a
r, [a]
ys3) = Int -> [a] -> (Arr a, [a])
forall a. Int -> [a] -> (Arr a, [a])
build (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [a]
ys2
         in (Arr a -> a -> Arr a -> Arr a
forall a. Arr a -> a -> Arr a -> Arr a
mk Arr a
l a
x Arr a
r, [a]
ys3)