{-# LANGUAGE StrictData #-}
{-# 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(..)
  -- * Data Preparation
  , series
  , bins
  -- * Chart Types
  , histogram
  , bars
  , scatter
  , pie
  , stackedBars
  , heatmap
  , lineGraph
  , boxPlot
  ) where

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

-- | Position of the legend in the plot.
data LegendPos 
  = LegendRight   -- ^ Display legend on the right side of the plot
  | LegendBottom  -- ^ Display legend below the plot
  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')
  } deriving (Plot -> Plot -> Bool
(Plot -> Plot -> Bool) -> (Plot -> Plot -> Bool) -> Eq Plot
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Plot -> Plot -> Bool
== :: Plot -> Plot -> Bool
$c/= :: Plot -> Plot -> Bool
/= :: Plot -> Plot -> Bool
Eq, Int -> Plot -> ShowS
[Plot] -> ShowS
Plot -> String
(Int -> Plot -> ShowS)
-> (Plot -> String) -> ([Plot] -> ShowS) -> Show Plot
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Plot -> ShowS
showsPrec :: Int -> Plot -> ShowS
$cshow :: Plot -> String
show :: Plot -> String
$cshowList :: [Plot] -> ShowS
showList :: [Plot] -> ShowS
Show)

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

-- | 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 :: Text                    -- ^ Name of the series (appears in legend)
       -> [(Double, Double)]       -- ^ List of (x, y) data points
       -> (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 :: [(Text, [(Double, Double)])]  -- ^ List of named data series
        -> Plot                           -- ^ Plot configuration
        -> Text                           -- ^ Rendered chart as 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
wCInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
2Int -> 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
wCInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
2Int -> 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
hCInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
4Int -> 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
hCInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
4Int -> 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 [Color]
paletteColors
      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 :: [(Text, [(Double, Double)])]  -- ^ List of named data series
          -> Plot                           -- ^ Plot configuration
          -> Text                           -- ^ Rendered chart as 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
wCInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
2Int -> 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
wCInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
2Int -> 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
hCInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
4Int -> 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
hCInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
4Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1))
      
      cols :: [Color]
cols = [Color] -> [Color]
forall a. HasCallStack => [a] -> [a]
cycle [Color]
paletteColors
      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 :: [(Text, Double)]  -- ^ List of (category, value) pairs
     -> Plot               -- ^ Plot configuration
     -> Text               -- ^ Rendered chart as 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 [Color]
paletteColors) ]

      nCats :: Int
nCats = [(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
nCatsInt -> 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)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([(String, Maybe Color)]
-> [[(String, Maybe Color)]] -> [[(String, Maybe Color)]]
forall a. a -> [a] -> [a]
List.intersperse [(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
hCInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] ]

      ax :: Text
ax     = Plot
-> [[(Char, Maybe Color)]]
-> (Double, Double)
-> (Double, Double)
-> 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)
      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 :: [(Text, [(Text, Double)])]  -- ^ Categories with stacked components
            -> Plot                         -- ^ Plot configuration
            -> Text                         -- ^ Rendered chart as 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
nCatsInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]]
      
      cols :: [Color]
cols = [Color] -> [Color]
forall a. HasCallStack => [a] -> [a]
cycle [Color]
paletteColors
      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
hCInt -> 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)]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(Char, Maybe Color)]]
-> [[[(Char, Maybe Color)]]] -> [[[(Char, Maybe Color)]]]
forall a. a -> [a] -> [a]
List.intersperse [[(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
hCInt -> 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
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)
      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

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 :: Bins         -- ^ Binning configuration
          -> [Double]     -- ^ Raw data values to bin
          -> Plot         -- ^ Plot configuration
          -> Text         -- ^ Rendered chart as 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
nInt -> 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
1Int -> [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)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([(String, Maybe Color)]
-> [[(String, Maybe Color)]] -> [[(String, Maybe Color)]]
forall a. a -> [a] -> [a]
List.intersperse [(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
hCInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] ]

      ax :: Text
ax     = Plot
-> [[(Char, Maybe Color)]]
-> (Double, Double)
-> (Double, Double)
-> 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
1Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
counts)))
      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 :: [(Text, Double)]  -- ^ List of (category, value) pairs
    -> Plot               -- ^ Plot configuration
    -> Text               -- ^ Rendered chart as 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
wCInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
2; hDots :: Int
hDots = Int
hCInt -> 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
2a -> 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))
-> [Text]
-> [(Double, Double)]
-> [Color]
-> [(Text, (Double, Double), Color)]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 (\Text
n (Double, Double)
ang Color
col -> (Text
n,(Double, Double)
ang,Color
col)) [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
dxDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
dx Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
dyDouble -> 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
rInt -> 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
2Double -> 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
x Int
y -> Int -> Int -> Bool
inside Int
x Int
y) (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 :: [[Double]]  -- ^ 2D matrix of values (rows × columns)
        -> Plot         -- ^ Plot configuration
        -> Text         -- ^ Rendered chart as 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
plotWInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]]
        | Int
i <- [Int
0..Int
plotHInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]]

      ax :: Text
ax = Plot
-> [[(Char, Maybe Color)]]
-> (Double, Double)
-> (Double, Double)
-> 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)
      
      gradientLegend :: Text
gradientLegend = (String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ 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
col -> Color -> Char -> Text
paint Color
col Char
'█') [Color]
intensityColors) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> 
                      (String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ 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 :: [(Text, [Double])]  -- ^ Named datasets
        -> Plot                 -- ^ Plot configuration
        -> Text                 -- ^ Rendered chart as 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
hCInt -> 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
hCInt -> 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
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)
      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
yInt -> 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
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [a]
row

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)

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
yInt -> 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
yInt -> 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
wInt -> 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
2Int -> 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
4Int -> 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
c0Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
2Int -> 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
c0Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
4Int -> 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]])
-> [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
hInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] (\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
wInt -> 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
c -> Color -> Char -> Text
paint Color
c Char
ch) Maybe Color
mc)
  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 Text
t = Int -> String -> Int
forall {t}. Num t => t -> String -> t
go Int
0 (Text -> String
Text.unpack Text
t)
  where
    go :: t -> String -> t
go t
acc [] = t
acc
    go t
acc (Char
'\ESC':Char
'[':String
rest) = let rest' :: String
rest' = (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'm') String
rest
                                in case String
rest' of
                                     []     -> t
acc
                                     (Char
_:String
xs) -> t -> String -> t
go t
acc String
xs
    go t
acc (Char
_:String
xs) = t -> String -> t
go (t
acct -> t -> t
forall a. Num a => a -> a -> a
+t
1) String
xs

fmt :: Double -> Text
fmt :: Double -> Text
fmt 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 | Bool -> Bool
not (Text -> Bool
Text.null (Plot -> Text
plotTitle Plot
_cfg))]
   [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
contentWithAxes]
   [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
legendBlockStr | Bool -> Bool
not (Text -> Bool
Text.null Text
legendBlockStr)] )

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
0, Double
ymax), (Int
plotH Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2, (Double
yminDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
ymax)Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2), (Int
plotHInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1, Double
ymin)]
      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
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [Text]
xs

      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 (Double -> Text
fmt Double
v)))
                       [Text]
baseLbl [(Int, Double)]
yTicks

      canvasLines :: [Text]
canvasLines = Text -> [Text]
Text.lines (Canvas -> Text
renderCanvas Canvas
c)
      attachY :: [Text]
      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
"─"
      xLbls :: [(Int, Double)]
xLbls  = [(Int
0, Double
xmin), (Int
plotW Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2, (Double
xminDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
xmax)Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2), (Int
plotWInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1, Double
xmax)]
      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, Double -> Text
fmt Double
v) | (Int
x,Double
v) <- [(Int, Double)]
xLbls ]
  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
axisifyGrid :: Plot
-> [[(Char, Maybe Color)]]
-> (Double, Double)
-> (Double, Double)
-> Text
axisifyGrid Plot
cfg [[(Char, Maybe Color)]]
grid (Double
xmin,Double
xmax) (Double
ymin,Double
ymax) =
  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, Double)]
yTicks  = [(Int
0, Double
ymax), (Int
plotH Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2, (Double
yminDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
ymax)Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2), (Int
plotHInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1, Double
ymin)]

      baseLbl :: [Text]
      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
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [Text]
xs

      yLabels :: [Text]
      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 (Double -> Text
fmt 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 ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ 
        ((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
c -> Color -> Char -> Text
paint Color
c Char
ch) Maybe Color
mc) [(Char, Maybe Color)]
cells

      attachY :: [Text]
      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
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
"─"
      xLbls :: [(Int, Double)]
xLbls  = [(Int
0, Double
xmin), (Int
plotW Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2, (Double
xminDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
xmax)Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2), (Int
plotWInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1, Double
xmax)]
      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, Double) -> (Int, Text)) -> [(Int, Double)] -> [(Int, Text)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Int
x,Double
v) -> (Int
x, Double -> Text
fmt Double
v)) [(Int, Double)]
xLbls)
  in [Text] -> Text
Text.unlines ([Text]
attachY [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
xBar, Text
xLine])

placeLabels :: Text -> Int -> [(Int,Text)] -> Text
placeLabels :: Text -> Int -> [(Int, Text)] -> Text
placeLabels Text
base Int
off [(Int, Text)]
xs = (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 [(Int, Text)]
xs
  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

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

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
fullInt -> 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
rem8Int -> 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
iInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
g) [Double]
xs)) | Int
i <- [Int
0..Int
wInt -> 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
iInt -> 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
2Int -> 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 -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
0 (((Double, [Double]) -> Double)
-> Maybe (Double, [Double]) -> Maybe Double
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (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

-- 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
+ (if Int
hl Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
hr then Int
hl else 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)