-- TODO: Remove bang patterns now that strict is enabled.
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Strict #-}

module Granite
  (
    Plot(..), defPlot, LegendPos(..)
  , series
  , bins, histogram
  , bars
  , scatter
  , pie
  , stackedBars
  , heatmap
  , lineGraph
  , boxPlot
  ) where

import Data.Char (chr)
import Data.List (foldl', intercalate, intersperse, dropWhileEnd, sortOn, sort)
import Numeric (showFFloat, showEFloat)
import Data.Bits ((.&.), (.|.), xor)

data LegendPos = LegendRight | LegendBottom 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)

data Plot = Plot
  { Plot -> Int
widthChars   :: !Int
  , Plot -> Int
heightChars  :: !Int
  , Plot -> Int
leftMargin   :: !Int
  , Plot -> Int
bottomMargin :: !Int
  , Plot -> Int
titleMargin  :: !Int
  , Plot -> LegendPos
legendPos    :: !LegendPos
  } 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)

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
  , legendPos :: LegendPos
legendPos    = LegendPos
LegendRight
  }

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 -> String
ansiOn :: Color -> String
ansiOn Color
c = String
"\ESC[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Color -> Int
ansiCode Color
c) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"m"
ansiOff :: String
ansiOff :: String
ansiOff = String
"\ESC[0m"

paint :: Color -> Char -> String
paint :: Color -> Char -> String
paint Color
c Char
ch = if Char
ch Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ' then String
" " else Color -> String
ansiOn Color
c String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
ch] String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
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
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
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 -> String
renderCanvas :: Canvas -> String
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 :: [[String]]
rows = [ [ 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 String -> (Color -> String) -> Maybe Color -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char
ch] (\Color
c -> Color -> Char -> String
paint Color
c Char
ch) Maybe Color
mc
               | Int
x <- [Int
0..Int
wInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] ]
             | Int
y <- [Int
0..Int
hInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] ]
  in [String] -> String
unlines (([String] -> String) -> [[String]] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[String]]
rows)

justifyRight :: Int -> String -> String
justifyRight :: Int -> ShowS
justifyRight Int
n String
s = Int -> Char -> String
forall a. Int -> a -> [a]
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
- String -> Int
wcswidth String
s)) Char
' ' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

wcswidth :: String -> Int
wcswidth :: String -> Int
wcswidth = Int -> String -> Int
forall {t}. Num t => t -> String -> t
go Int
0
  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 -> String
fmt :: Double -> String
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
1000 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) = ShowS
forall {p}. p -> p
strip (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                                 = ShowS
forall {p}. p -> p
strip (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
"")
  where
    strip :: p -> p
strip p
s = p
s

drawFrame :: Plot -> String -> String -> String -> String
drawFrame :: Plot -> String -> String -> ShowS
drawFrame Plot
_cfg String
titleStr String
contentWithAxes String
legendBlockStr =
  [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null)
    ( [String
titleStr | Bool -> Bool
not (String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
titleStr)]
   [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
contentWithAxes]
   [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
legendBlockStr | Bool -> Bool
not (String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
legendBlockStr)] )

axisify :: Plot -> Canvas -> (Double,Double) -> (Double,Double) -> String
axisify :: Plot -> Canvas -> (Double, Double) -> (Double, Double) -> String
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 :: String
pad   = Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
left Char
' '

      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 :: [String]
baseLbl = Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
plotH String
pad
      setAt :: [a] -> Int -> a -> [a]
setAt [a]
xs Int
i a
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
>= [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs = [a]
xs
                   | Bool
otherwise               = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
i [a]
xs [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ a
v a -> [a] -> [a]
forall 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]
xs
      yLabels :: [String]
yLabels = ([String] -> (Int, Double) -> [String])
-> [String] -> [(Int, Double)] -> [String]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\[String]
acc (Int
row,Double
v) -> [String] -> Int -> String -> [String]
forall {a}. [a] -> Int -> a -> [a]
setAt [String]
acc Int
row (Int -> ShowS
justifyRight Int
left (Double -> String
fmt Double
v)))
                       [String]
baseLbl [(Int, Double)]
yTicks

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

      xBar :: String
xBar   = String
pad String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"│" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
plotW Char
'─'
      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 :: String
xLine  = String -> Int -> [(Int, String)] -> String
placeLabels (Int -> Char -> String
forall a. Int -> a -> [a]
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) Char
' ') (Int
left Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                           [ (Int
x, Double -> String
fmt Double
v) | (Int
x,Double
v) <- [(Int, Double)]
xLbls ]
  in [String] -> String
unlines ([String]
attachY [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
xBar, String
xLine])

axisifyGrid :: Plot -> [[(Char, Maybe Color)]] -> (Double,Double) -> (Double,Double) -> String
axisifyGrid :: Plot
-> [[(Char, Maybe Color)]]
-> (Double, Double)
-> (Double, Double)
-> String
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 = if [[(Char, Maybe Color)]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[(Char, Maybe Color)]]
grid then Int
0 else [(Char, Maybe Color)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([[(Char, Maybe Color)]] -> [(Char, Maybe Color)]
forall a. HasCallStack => [a] -> a
head [[(Char, Maybe Color)]]
grid)
      left :: Int
left  = Plot -> Int
leftMargin Plot
cfg
      pad :: String
pad   = Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
left Char
' '

      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 :: [String]
baseLbl = Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
plotH String
pad
      setAt :: [a] -> Int -> a -> [a]
setAt [a]
xs Int
i a
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
>= [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs = [a]
xs
                   | Bool
otherwise               = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
i [a]
xs [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ a
v a -> [a] -> [a]
forall 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]
xs
      yLabels :: [String]
yLabels = ([String] -> (Int, Double) -> [String])
-> [String] -> [(Int, Double)] -> [String]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\[String]
acc (Int
row,Double
v) -> [String] -> Int -> String -> [String]
forall {a}. [a] -> Int -> a -> [a]
setAt [String]
acc Int
row (Int -> ShowS
justifyRight Int
left (Double -> String
fmt Double
v)))
                       [String]
baseLbl [(Int, Double)]
yTicks

      renderRow :: [(Char, Maybe Color)] -> String
renderRow [(Char, Maybe Color)]
cells = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ String -> (Color -> String) -> Maybe Color -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char
ch] (\Color
c -> Color -> Char -> String
paint Color
c Char
ch) Maybe Color
mc | (Char
ch, Maybe Color
mc) <- [(Char, Maybe Color)]
cells ]
      attachY :: [String]
attachY = (String -> [(Char, Maybe Color)] -> String)
-> [String] -> [[(Char, Maybe Color)]] -> [String]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\String
lbl [(Char, Maybe Color)]
cells -> String
lbl String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"│" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [(Char, Maybe Color)] -> String
renderRow [(Char, Maybe Color)]
cells) [String]
yLabels [[(Char, Maybe Color)]]
grid

      xBar :: String
xBar   = String
pad String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"│" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
plotW Char
'─'
      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 :: String
xLine  = String -> Int -> [(Int, String)] -> String
placeLabels (Int -> Char -> String
forall a. Int -> a -> [a]
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) Char
' ') (Int
left Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                           [ (Int
x, Double -> String
fmt Double
v) | (Int
x,Double
v) <- [(Int, Double)]
xLbls ]
  in [String] -> String
unlines ([String]
attachY [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
xBar, String
xLine])

placeLabels :: String -> Int -> [(Int,String)] -> String
placeLabels :: String -> Int -> [(Int, String)] -> String
placeLabels String
base Int
off [(Int, String)]
xs = (String -> (Int, String) -> String)
-> String -> [(Int, String)] -> String
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' String -> (Int, String) -> String
place String
base [(Int, String)]
xs
  where
    place :: String -> (Int, String) -> String
place String
acc (Int
x,String
s) =
      let i :: Int
i = Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x
      in Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
i String
acc String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> ShowS
forall a. Int -> [a] -> [a]
drop (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ String -> Int
wcswidth String
s) String
acc

legendBlock :: LegendPos -> Int -> [(String, Pat, Color)] -> String
legendBlock :: LegendPos -> Int -> [(String, Pat, Color)] -> String
legendBlock LegendPos
LegendBottom Int
width [(String, Pat, Color)]
entries =
  let cells :: [String]
cells = [ Pat -> Color -> String
sample Pat
pat Color
col String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name | (String
name, Pat
pat, Color
col) <- [(String, Pat, Color)]
entries ]
      line :: String
line  = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"   " [String]
cells
      pad :: String
pad   = let vis :: Int
vis = String -> Int
wcswidth String
line
              in if Int
vis Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
width then Int -> Char -> String
forall a. Int -> a -> [a]
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) Char
' ' else String
""
  in String
pad String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
line
legendBlock LegendPos
LegendRight Int
_ [(String, Pat, Color)]
entries =
  [String] -> String
unlines [ Pat -> Color -> String
sample Pat
pat Color
col String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name | (String
name, Pat
pat, Color
col) <- [(String, Pat, Color)]
entries ]

sample :: Pat -> Color -> String
sample :: Pat -> Color -> String
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
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 :: String
s = Canvas -> String
renderCanvas Canvas
c
  in (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n') String
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 :: [(Double,Double)] -> (Double,Double,Double,Double)
boundsXY :: [(Double, Double)] -> (Double, Double, Double, Double)
boundsXY [(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
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Double]
xs; xmax :: Double
xmax = [Double] -> Double
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Double]
xs
      ymin :: Double
ymin = [Double] -> Double
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Double]
ys; ymax :: Double
ymax = [Double] -> Double
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
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
xmin Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
padx, Double
xmax Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
padx, Double
ymin Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
pady, Double
ymax Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
pady)

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

series :: String -> [(Double,Double)] -> (String, [(Double,Double)])
series :: String -> [(Double, Double)] -> (String, [(Double, Double)])
series = (,)

scatter :: String -> [(String, [(Double,Double)])] -> Plot -> String
scatter :: String -> [(String, [(Double, Double)])] -> Plot -> String
scatter String
title [(String, [(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) = [(Double, Double)] -> (Double, Double, Double, Double)
boundsXY (((String, [(Double, Double)]) -> [(Double, Double)])
-> [(String, [(Double, Double)])] -> [(Double, Double)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (String, [(Double, Double)]) -> [(Double, Double)]
forall a b. (a, b) -> b
snd [(String, [(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 :: [(String, [(Double, Double)], Pat, Color)]
withSty = ((String, [(Double, Double)])
 -> Pat -> Color -> (String, [(Double, Double)], Pat, Color))
-> [(String, [(Double, Double)])]
-> [Pat]
-> [Color]
-> [(String, [(Double, Double)], Pat, Color)]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 (\(!String
n,![(Double, Double)]
ps) Pat
p Color
c -> (String
n,[(Double, Double)]
ps,Pat
p,Color
c)) [(String, [(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
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 -> (String, [(Double, Double)], Pat, Color) -> Canvas)
-> Canvas -> [(String, [(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
foldl' (((String, [(Double, Double)], Pat, Color) -> Canvas -> Canvas)
-> Canvas -> (String, [(Double, Double)], Pat, Color) -> Canvas
forall a b c. (a -> b -> c) -> b -> a -> c
flip (String, [(Double, Double)], Pat, Color) -> Canvas -> Canvas
forall {t :: * -> *} {a}.
Foldable t =>
(a, t (Double, Double), Pat, Color) -> Canvas -> Canvas
drawOne) Canvas
plotC [(String, [(Double, Double)], Pat, Color)]
withSty
      ax :: String
ax    = Plot -> Canvas -> (Double, Double) -> (Double, Double) -> String
axisify Plot
cfg Canvas
cDone (Double
xmin,Double
xmax) (Double
ymin,Double
ymax)
      legend :: String
legend = LegendPos -> Int -> [(String, Pat, Color)] -> String
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)
                 [ (String
n,Pat
p, Color
col) | (String
n,[(Double, Double)]
_,Pat
p,Color
col) <- [(String, [(Double, Double)], Pat, Color)]
withSty ]
      titled :: String
titled = if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
title then String
"" else String
title
  in Plot -> String -> String -> ShowS
drawFrame Plot
cfg String
titled String
ax String
legend


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. [a] -> [a] -> [a]
++ String
middle String -> ShowS
forall 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 ]

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

histogram :: String -> Bins -> [Double] -> Plot -> String
histogram :: String -> Bins -> [Double] -> Plot -> String
histogram String
title (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
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]
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 :: String
ax     = Plot
-> [[(Char, Maybe Color)]]
-> (Double, Double)
-> (Double, Double)
-> String
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
+ (if [[(Char, Maybe Color)]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[(Char, Maybe Color)]]
grid then Int
0 else [(Char, Maybe Color)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([[(Char, Maybe Color)]] -> [(Char, Maybe Color)]
forall a. HasCallStack => [a] -> a
head [[(Char, Maybe Color)]]
grid))
      legend :: String
legend = LegendPos -> Int -> [(String, Pat, Color)] -> String
legendBlock (Plot -> LegendPos
legendPos Plot
cfg) Int
legendWidth [(String
"count", Pat
Solid, Color
BrightCyan)]
      titled :: String
titled = if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
title then String
"" else String
title
  in Plot -> String -> String -> ShowS
drawFrame Plot
cfg String
titled String
ax String
legend

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

bars :: String -> [(String, Double)] -> Plot -> String
bars :: String -> [(String, Double)] -> Plot -> String
bars String
title [(String, Double)]
kvs Plot
cfg =
  let wC :: Int
wC   = Plot -> Int
widthChars Plot
cfg
      hC :: Int
hC   = Plot -> Int
heightChars Plot
cfg
      vals :: [Double]
vals = ((String, Double) -> Double) -> [(String, Double)] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (String, Double) -> Double
forall a b. (a, b) -> b
snd [(String, Double)]
kvs
      vmax :: Double
vmax = [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 -> Double) -> [Double] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map Double -> Double
forall a. Num a => a -> a
abs [Double]
vals)

      cats :: [(String, Double, Color)]
      cats :: [(String, Double, Color)]
cats = [ (String
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)
             | (!(!String
name, !Double
v), !Color
col) <- [(String, Double)] -> [Color] -> [((String, Double), Color)]
forall a b. [a] -> [b] -> [(a, b)]
zip [(String, Double)]
kvs ([Color] -> [Color]
forall a. HasCallStack => [a] -> [a]
cycle [Color]
paletteColors) ]

      nCats :: Int
nCats = [(String, Double, Color)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(String, 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)
        | ((String
_, Double
f, Color
col), Int
w) <- [(String, Double, Color)]
-> [Int] -> [((String, Double, Color), Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [(String, 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]
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 :: String
ax     = Plot
-> [[(Char, Maybe Color)]]
-> (Double, Double)
-> (Double, Double)
-> String
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
+ (if [[(Char, Maybe Color)]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[(Char, Maybe Color)]]
grid then Int
0 else [(Char, Maybe Color)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([[(Char, Maybe Color)]] -> [(Char, Maybe Color)]
forall a. HasCallStack => [a] -> a
head [[(Char, Maybe Color)]]
grid))
      legend :: String
legend = LegendPos -> Int -> [(String, Pat, Color)] -> String
legendBlock (Plot -> LegendPos
legendPos Plot
cfg) Int
legendWidth
                 [ (String
name, Pat
Checker, Color
col) | (String
name, Double
_, Color
col) <- [(String, Double, Color)]
cats ]
      titled :: String
titled = if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
title then String
"" else String
title
  in Plot -> String -> String -> ShowS
drawFrame Plot
cfg String
titled String
ax String
legend

pie :: String -> [(String, Double)] -> Plot -> String
pie :: String -> [(String, Double)] -> Plot -> String
pie String
title [(String, Double)]
parts0 Plot
cfg =
  let parts :: [(String, Double)]
parts = [(String, Double)] -> [(String, Double)]
normalize [(String, 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 -> (String, Double) -> Double)
-> Double -> [(String, Double)] -> [Double]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl (\Double
a (String
_,!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 [(String, Double)]
parts
      angles :: [(Double, Double)]
angles = [Double] -> [Double] -> [(Double, Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Double]
wedges ([Double] -> [Double]
forall a. HasCallStack => [a] -> [a]
tail [Double]
wedges)
      names :: [String]
names  = ((String, Double) -> String) -> [(String, Double)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, Double) -> String
forall a b. (a, b) -> a
fst [(String, Double)]
parts
      cols :: [Color]
cols   = [Color] -> [Color]
forall a. HasCallStack => [a] -> [a]
cycle [Color]
pieColors
      withP :: [(String, (Double, Double), Color)]
withP  = (String
 -> (Double, Double) -> Color -> (String, (Double, Double), Color))
-> [String]
-> [(Double, Double)]
-> [Color]
-> [(String, (Double, Double), Color)]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 (\String
n (Double, Double)
ang Color
col -> (String
n,(Double, Double)
ang,Color
col)) [String]
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 -> (String, (Double, Double), Color) -> Canvas)
-> Canvas -> [(String, (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
foldl' (((String, (Double, Double), Color) -> Canvas -> Canvas)
-> Canvas -> (String, (Double, Double), Color) -> Canvas
forall a b c. (a -> b -> c) -> b -> a -> c
flip (String, (Double, Double), Color) -> Canvas -> Canvas
forall {a}. (a, (Double, Double), Color) -> Canvas -> Canvas
drawOne) Canvas
plotC [(String, (Double, Double), Color)]
withP
      ax :: String
ax     = Plot -> Canvas -> (Double, Double) -> (Double, Double) -> String
axisify Plot
cfg Canvas
cDone (Double
0,Double
1) (Double
0,Double
1)
      legend :: String
legend = LegendPos -> Int -> [(String, Pat, Color)] -> String
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)
                 [ (String
n, Pat
Solid, Color
col) | (String
n,(Double, Double)
_,Color
col) <- [(String, (Double, Double), Color)]
withP ]
      titled :: String
titled= if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
title then String
"" else String
title
  in Plot -> String -> String -> ShowS
drawFrame Plot
cfg String
titled String
ax String
legend

normalize :: [(String, Double)] -> [(String, Double)]
normalize :: [(String, Double)] -> [(String, Double)]
normalize [(String, 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 (((String, Double) -> Double) -> [(String, Double)] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (Double -> Double
forall a. Num a => a -> a
abs (Double -> Double)
-> ((String, Double) -> Double) -> (String, Double) -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, Double) -> Double
forall a b. (a, b) -> b
snd) [(String, Double)]
xs) Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
1e-12
  in [ (String
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)) | (!String
n,!Double
v) <- [(String, 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

lineGraph :: String -> [(String, [(Double,Double)])] -> Plot -> String
lineGraph :: String -> [(String, [(Double, Double)])] -> Plot -> String
lineGraph String
title [(String, [(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) = [(Double, Double)] -> (Double, Double, Double, Double)
boundsXY (((String, [(Double, Double)]) -> [(Double, Double)])
-> [(String, [(Double, Double)])] -> [(Double, Double)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (String, [(Double, Double)]) -> [(Double, Double)]
forall a b. (a, b) -> b
snd [(String, [(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 :: [((String, [(Double, Double)]), Color)]
withSty = [(String, [(Double, Double)])]
-> [Color] -> [((String, [(Double, Double)]), Color)]
forall a b. [a] -> [b] -> [(a, b)]
zip [(String, [(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]
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 ([(Double, Double)] -> [(Double, Double)]
forall a. HasCallStack => [a] -> [a]
tail [(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
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 -> ((String, [(Double, Double)]), Color) -> Canvas)
-> Canvas -> [((String, [(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
foldl' ((((String, [(Double, Double)]), Color) -> Canvas -> Canvas)
-> Canvas -> ((String, [(Double, Double)]), Color) -> Canvas
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((String, [(Double, Double)]), Color) -> Canvas -> Canvas
forall {a}. ((a, [(Double, Double)]), Color) -> Canvas -> Canvas
drawSeries) Canvas
plotC [((String, [(Double, Double)]), Color)]
withSty
      ax :: String
ax = Plot -> Canvas -> (Double, Double) -> (Double, Double) -> String
axisify Plot
cfg Canvas
cDone (Double
xmin,Double
xmax) (Double
ymin,Double
ymax)
      legend :: String
legend = LegendPos -> Int -> [(String, Pat, Color)] -> String
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)
                 [(String
n, Pat
Solid, Color
col) | (!(!String
n,[(Double, Double)]
_), !Color
col) <- [((String, [(Double, Double)]), Color)]
withSty]
      titled :: String
titled = if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
title then String
"" else String
title
  in Plot -> String -> String -> ShowS
drawFrame Plot
cfg String
titled String
ax String
legend

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

boxPlot :: String -> [(String, [Double])] -> Plot -> String
boxPlot :: String -> [(String, [Double])] -> Plot -> String
boxPlot String
title [(String, [Double])]
datasets Plot
cfg =
  let wC :: Int
wC = Plot -> Int
widthChars Plot
cfg
      hC :: Int
hC = Plot -> Int
heightChars Plot
cfg

      stats :: [(String, (Double, Double, Double, Double, Double))]
stats = [(String
name, [Double] -> (Double, Double, Double, Double, Double)
quartiles [Double]
vals) | (!String
name, ![Double]
vals) <- [(String, [Double])]
datasets]

      allVals :: [Double]
allVals = ((String, [Double]) -> [Double])
-> [(String, [Double])] -> [Double]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (String, [Double]) -> [Double]
forall a b. (a, b) -> b
snd [(String, [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
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Double]
allVals Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double -> Double
forall a. Num a => a -> a
abs ([Double] -> Double
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
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
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Double]
allVals Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double -> Double
forall a. Num a => a -> a
abs ([Double] -> Double
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Double]
allVals) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
0.1

      nBoxes :: Int
nBoxes = [(String, [Double])] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(String, [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, (String, (Double, Double, Double, Double, Double)))
 -> [[(Char, Maybe Color)]])
-> [[(Char, Maybe Color)]]
-> [(Int, (String, (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
foldl' [[(Char, Maybe Color)]]
-> (Int, (String, (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]
-> [(String, (Double, Double, Double, Double, Double))]
-> [(Int, (String, (Double, Double, Double, Double, Double)))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [(String, (Double, Double, Double, Double, Double))]
stats)
      
      ax :: String
ax = Plot
-> [[(Char, Maybe Color)]]
-> (Double, Double)
-> (Double, Double)
-> String
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 :: String
legend = LegendPos -> Int -> [(String, Pat, Color)] -> String
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)
                 [(String
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, (String
name, (Double, Double, Double, Double, Double)
_)) <- [Int]
-> [(String, (Double, Double, Double, Double, Double))]
-> [(Int, (String, (Double, Double, Double, Double, Double)))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [(String, (Double, Double, Double, Double, Double))]
stats]
      titled :: String
titled = if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
title then String
"" else String
title
  in Plot -> String -> String -> ShowS
drawFrame Plot
cfg String
titled String
ax String
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
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
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
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([[(a, b)]] -> [(a, b)]
forall a. HasCallStack => [a] -> a
head [[(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. [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. [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. [a] -> [a] -> [a]
++ [a
v] [a] -> [a] -> [a]
forall 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

heatmap :: String -> [[Double]] -> Plot -> String
heatmap :: String -> [[Double]] -> Plot -> String
heatmap String
title [[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 = if [[Double]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Double]]
matrix then Int
0 else [Double] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([[Double]] -> [Double]
forall a. HasCallStack => [a] -> a
head [[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
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
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
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Double]
allVals
      vrange :: Double
vrange = Double
vmax Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
vmin Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
eps

      intensityColors :: [Color]
intensityColors = 
        [ Color
Blue, Color
Cyan, Color
BrightCyan, Color
Green, Color
BrightGreen, 
          Color
Yellow, Color
BrightYellow, Color
Red, Color
BrightRed, Color
Magenta, Color
BrightMagenta
        ]
      
      colorForValue :: Double -> Color
colorForValue Double
v =
        let norm :: Double
norm = Double -> Double -> Double -> Double
forall a. Ord a => a -> a -> a -> a
clamp Double
0 Double
1 ((Double
v Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
vmin) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
vrange)
            idx :: Int
idx = Int -> Int -> Int -> Int
forall a. Ord a => a -> a -> a -> a
clamp Int
0 ([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) 
                        (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)))
        in [Color]
intensityColors [Color] -> Int -> Color
forall a. HasCallStack => [a] -> Int -> a
!! Int
idx
      
      wC :: Int
wC = Plot -> Int
widthChars Plot
cfg
      hC :: Int
hC = Plot -> Int
heightChars Plot
cfg
      
      resampleMatrix :: [[Double]]
resampleMatrix = 
        let getVal :: p -> p -> Double
getVal p
row p
col = 
              let ri :: Double
ri = p -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral p
row Double -> Double -> Double
forall a. Num a => a -> a -> a
* Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
rows Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
hC Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
                  ci :: Double
ci = p -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral p
col Double -> Double -> Double
forall a. Num a => a -> a -> a
* Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
cols Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
wC Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
                  r0 :: Int
r0 = Int -> Int -> Int -> Int
forall a. Ord a => a -> a -> a -> a
clamp Int
0 (Int
rows Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor Double
ri)
                  r1 :: Int
r1 = Int -> Int -> Int -> Int
forall a. Ord a => a -> a -> a -> a
clamp Int
0 (Int
rows Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
ceiling Double
ri)
                  c0 :: Int
c0 = Int -> Int -> Int -> Int
forall a. Ord a => a -> a -> a -> a
clamp Int
0 (Int
cols Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor Double
ci)
                  c1 :: Int
c1 = Int -> Int -> Int -> Int
forall a. Ord a => a -> a -> a -> a
clamp Int
0 (Int
cols Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
ceiling Double
ci)

                  v00 :: Double
v00 = ([[Double]]
matrix [[Double]] -> Int -> [Double]
forall a. HasCallStack => [a] -> Int -> a
!! Int
r0) [Double] -> Int -> Double
forall a. HasCallStack => [a] -> Int -> a
!! Int
c0
                  v01 :: Double
v01 = if Int
c1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
cols then ([[Double]]
matrix [[Double]] -> Int -> [Double]
forall a. HasCallStack => [a] -> Int -> a
!! Int
r0) [Double] -> Int -> Double
forall a. HasCallStack => [a] -> Int -> a
!! Int
c1 else Double
v00
                  v10 :: Double
v10 = if Int
r1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
rows then ([[Double]]
matrix [[Double]] -> Int -> [Double]
forall a. HasCallStack => [a] -> Int -> a
!! Int
r1) [Double] -> Int -> Double
forall a. HasCallStack => [a] -> Int -> a
!! Int
c0 else Double
v00
                  v11 :: Double
v11 = if Int
r1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
rows Bool -> Bool -> Bool
&& Int
c1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
cols then ([[Double]]
matrix [[Double]] -> Int -> [Double]
forall a. HasCallStack => [a] -> Int -> a
!! Int
r1) [Double] -> Int -> Double
forall a. HasCallStack => [a] -> Int -> a
!! Int
c1 else Double
v00
                  fr :: Double
fr = Double
ri Double -> Double -> Double
forall a. Num a => a -> a -> a
- Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
r0
                  fc :: Double
fc = Double
ci Double -> Double -> Double
forall a. Num a => a -> a -> a
- Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
c0
                  v0 :: Double
v0 = Double
v00 Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
fc) Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
v01 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
fc
                  v1 :: Double
v1 = Double
v10 Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
fc) Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
v11 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
fc
              in Double
v0 Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
fr) Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
v1 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
fr
        in [[Int -> Int -> Double
forall {p} {p}. (Integral p, Integral p) => p -> p -> Double
getVal Int
i Int
j | Int
j <- [Int
0..Int
wCInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]] | Int
i <- [Int
0..Int
hCInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]]

      grid :: [[(Char, Maybe Color)]]
grid = [[(Char
'█', Color -> Maybe Color
forall a. a -> Maybe a
Just (Double -> Color
colorForValue Double
val)) | Double
val <- [Double]
row] 
             | [Double]
row <- [[Double]]
resampleMatrix]
      
      ax :: String
ax = Plot
-> [[(Char, Maybe Color)]]
-> (Double, Double)
-> (Double, Double)
-> String
axisifyGrid Plot
cfg [[(Char, Maybe Color)]]
grid (Double
0, Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
cols) 
                               (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
rows, Double
0) 

      legendColors :: [Color]
legendColors = Int -> [Color] -> [Color]
forall a. Int -> [a] -> [a]
take Int
9 [Color]
intensityColors
      gradientLegend :: String
gradientLegend = String
"Min " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [Color -> Char -> String
paint Color
col Char
'█' | Color
col <- [Color]
legendColors] String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" Max"
      
      titled :: String
titled = if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
title then String
"" else String
title
  in Plot -> String -> String -> ShowS
drawFrame Plot
cfg String
titled String
ax String
gradientLegend

stackedBars :: String -> [(String, [(String, Double)])] -> Plot -> String
stackedBars :: String -> [(String, [(String, Double)])] -> Plot -> String
stackedBars String
title [(String, [(String, Double)])]
categories Plot
cfg =
  let wC :: Int
wC = Plot -> Int
widthChars Plot
cfg
      hC :: Int
hC = Plot -> Int
heightChars Plot
cfg

      seriesNames :: [String]
seriesNames = if [(String, [(String, Double)])] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(String, [(String, Double)])]
categories Bool -> Bool -> Bool
|| [(String, Double)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ((String, [(String, Double)]) -> [(String, Double)]
forall a b. (a, b) -> b
snd ([(String, [(String, Double)])] -> (String, [(String, Double)])
forall a. HasCallStack => [a] -> a
head [(String, [(String, Double)])]
categories))
                    then []
                    else ((String, Double) -> String) -> [(String, Double)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, Double) -> String
forall a b. (a, b) -> a
fst ((String, [(String, Double)]) -> [(String, Double)]
forall a b. (a, b) -> b
snd ([(String, [(String, Double)])] -> (String, [(String, Double)])
forall a. HasCallStack => [a] -> a
head [(String, [(String, Double)])]
categories))
      
      totals :: [Double]
totals = [[Double] -> Double
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (((String, Double) -> Double) -> [(String, Double)] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (String, Double) -> Double
forall a b. (a, b) -> b
snd [(String, Double)]
series') | (String
_, [(String, Double)]
series') <- [(String, [(String, 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 = [(String, [(String, Double)])] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(String, [(String, 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 :: [(String, Color)]
seriesColors = [String] -> [Color] -> [(String, Color)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
seriesNames [Color]
cols
      
      
      makeBar :: (a, [(String, Double)]) -> Int -> [[(Char, Maybe Color)]]
makeBar (a
_, [(String, 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 | (String
_, Double
v) <- [(String, Double)]
series']
            segments :: [(String, Double, Double)]
segments = [String] -> [Double] -> [Double] -> [(String, Double, Double)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 (((String, Double) -> String) -> [(String, Double)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, Double) -> String
forall a b. (a, b) -> a
fst [(String, Double)]
series') [Double]
cumHeights ([Double] -> [Double]
forall a. HasCallStack => [a] -> [a]
tail [Double]
cumHeights)
            
            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 :: [(String, Double, Double)] -> (Char, Maybe Color)
findSegment [] = (Char
' ', Maybe Color
forall a. Maybe a
Nothing)
                    findSegment ((String
name, Double
bottom, Double
top):[(String, 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
'█', String -> [(String, Color)] -> Maybe Color
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
name [(String, Color)]
seriesColors)
                      else [(String, Double, Double)] -> (Char, Maybe Color)
findSegment [(String, Double, Double)]
rest
                in [(String, Double, Double)] -> (Char, Maybe Color)
findSegment [(String, 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 = ((String, [(String, Double)]) -> Int -> [[(Char, Maybe Color)]])
-> [(String, [(String, Double)])]
-> [Int]
-> [[[(Char, Maybe Color)]]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (String, [(String, Double)]) -> Int -> [[(Char, Maybe Color)]]
forall {a}.
(a, [(String, Double)]) -> Int -> [[(Char, Maybe Color)]]
makeBar [(String, [(String, 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]
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 :: String
ax = Plot
-> [[(Char, Maybe Color)]]
-> (Double, Double)
-> (Double, Double)
-> String
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 :: String
legend = LegendPos -> Int -> [(String, Pat, Color)] -> String
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
+ 
                          (if [[(Char, Maybe Color)]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[(Char, Maybe Color)]]
grid then Int
0 else [(Char, Maybe Color)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([[(Char, Maybe Color)]] -> [(Char, Maybe Color)]
forall a. HasCallStack => [a] -> a
head [[(Char, Maybe Color)]]
grid)))
                 [(String
name, Pat
Solid, Color
col) | (String
name, Color
col) <- [(String, Color)]
seriesColors]
      titled :: String
titled = if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
title then String
"" else String
title
  in Plot -> String -> String -> ShowS
drawFrame Plot
cfg String
titled String
ax String
legend

-- 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 {-# UNPACK #-} !Int {-# UNPACK #-} !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. [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. [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. [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. [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)      = [a]
ys1
          (!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)