{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ExplicitNamespaces #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE FlexibleContexts #-}
module DataFrame.Display.Terminal.Plot where

import qualified Data.List as L
import qualified Data.Map as M
import qualified Data.Text as T
import qualified Data.Vector as V
import qualified Data.Vector.Generic as VG
import qualified Data.Vector.Unboxed as VU
import qualified Type.Reflection as Ref

import Control.Monad ( forM_, forM )
import Data.Bifunctor ( first )
import Data.Char ( ord, chr )
import DataFrame.Display.Terminal.Colours
import DataFrame.Internal.Column (Column(..), Columnable)
import DataFrame.Internal.DataFrame (DataFrame(..))
import DataFrame.Operations.Core
import Data.Maybe (fromMaybe)
import Data.Typeable (Typeable)
import Data.Type.Equality
    ( type (:~:)(Refl), TestEquality(testEquality) )
import GHC.Stack (HasCallStack)
import Text.Printf ( printf )
import Type.Reflection (typeRep)

data HistogramOrientation = VerticalHistogram | HorizontalHistogram

data PlotColumns = PlotAll | PlotSubset [T.Text]

plotHistograms :: HasCallStack => PlotColumns -> HistogramOrientation -> DataFrame -> IO ()
plotHistograms :: HasCallStack =>
PlotColumns -> HistogramOrientation -> DataFrame -> IO ()
plotHistograms PlotColumns
plotSet HistogramOrientation
orientation DataFrame
df = do
    let cs :: [Text]
cs = case PlotColumns
plotSet of
            PlotColumns
PlotAll       -> DataFrame -> [Text]
columnNames DataFrame
df
            PlotSubset [Text]
xs -> DataFrame -> [Text]
columnNames DataFrame
df [Text] -> [Text] -> [Text]
forall a. Eq a => [a] -> [a] -> [a]
`L.intersect` [Text]
xs
    [Text] -> (Text -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Text]
cs ((Text -> IO ()) -> IO ()) -> (Text -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Text
cname -> do
        HasCallStack =>
Text -> Maybe Column -> HistogramOrientation -> DataFrame -> IO ()
Text -> Maybe Column -> HistogramOrientation -> DataFrame -> IO ()
plotForColumn Text
cname (Vector (Maybe Column) -> Int -> Maybe Column
forall a. Vector a -> Int -> a
(V.!) (DataFrame -> Vector (Maybe Column)
columns DataFrame
df) (DataFrame -> Map Text Int
columnIndices DataFrame
df Map Text Int -> Text -> Int
forall k a. Ord k => Map k a -> k -> a
M.! Text
cname)) HistogramOrientation
orientation DataFrame
df


plotHistogramsBy :: HasCallStack => T.Text -> PlotColumns -> HistogramOrientation -> DataFrame -> IO ()
plotHistogramsBy :: HasCallStack =>
Text -> PlotColumns -> HistogramOrientation -> DataFrame -> IO ()
plotHistogramsBy Text
col PlotColumns
plotSet HistogramOrientation
orientation DataFrame
df = do
    let cs :: [Text]
cs = case PlotColumns
plotSet of
            PlotColumns
PlotAll       -> DataFrame -> [Text]
columnNames DataFrame
df
            PlotSubset [Text]
xs -> DataFrame -> [Text]
columnNames DataFrame
df [Text] -> [Text] -> [Text]
forall a. Eq a => [a] -> [a] -> [a]
`L.intersect` [Text]
xs
    [Text] -> (Text -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Text]
cs ((Text -> IO ()) -> IO ()) -> (Text -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Text
cname -> do
        let plotColumn :: Maybe Column
plotColumn = Vector (Maybe Column) -> Int -> Maybe Column
forall a. Vector a -> Int -> a
(V.!) (DataFrame -> Vector (Maybe Column)
columns DataFrame
df) (DataFrame -> Map Text Int
columnIndices DataFrame
df Map Text Int -> Text -> Int
forall k a. Ord k => Map k a -> k -> a
M.! Text
cname)
        let byColumn :: Maybe Column
byColumn = Vector (Maybe Column) -> Int -> Maybe Column
forall a. Vector a -> Int -> a
(V.!) (DataFrame -> Vector (Maybe Column)
columns DataFrame
df) (DataFrame -> Map Text Int
columnIndices DataFrame
df Map Text Int -> Text -> Int
forall k a. Ord k => Map k a -> k -> a
M.! Text
col)
        HasCallStack =>
Text
-> Text
-> Maybe Column
-> Maybe Column
-> HistogramOrientation
-> DataFrame
-> IO ()
Text
-> Text
-> Maybe Column
-> Maybe Column
-> HistogramOrientation
-> DataFrame
-> IO ()
plotForColumnBy Text
col Text
cname Maybe Column
byColumn Maybe Column
plotColumn HistogramOrientation
orientation DataFrame
df

-- Plot code adapted from: https://alexwlchan.net/2018/ascii-bar-charts/
plotForColumnBy :: HasCallStack => T.Text -> T.Text -> Maybe Column -> Maybe Column -> HistogramOrientation -> DataFrame -> IO ()
plotForColumnBy :: HasCallStack =>
Text
-> Text
-> Maybe Column
-> Maybe Column
-> HistogramOrientation
-> DataFrame
-> IO ()
plotForColumnBy Text
_ Text
_ Maybe Column
Nothing Maybe Column
_ HistogramOrientation
_ DataFrame
_ = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
plotForColumnBy Text
byCol Text
cname (Just (BoxedColumn (Vector a
byColumn :: V.Vector a))) (Just (BoxedColumn (Vector a
plotColumn :: V.Vector b))) HistogramOrientation
orientation DataFrame
df = do
    let zipped :: Vector (String, String)
zipped = (a -> a -> (String, String))
-> Vector a -> Vector a -> Vector (String, String)
forall (v :: * -> *) a b c.
(Vector v a, Vector v b, Vector v c) =>
(a -> b -> c) -> v a -> v b -> v c
VG.zipWith (\a
left a
right -> (a -> String
forall a. Show a => a -> String
show a
left, a -> String
forall a. Show a => a -> String
show a
right)) Vector a
plotColumn Vector a
byColumn
    let counts :: [((String, String), Int)]
counts = Vector (String, String) -> [((String, String), Int)]
forall a. Ord a => Vector a -> [(a, Int)]
countOccurrences Vector (String, String)
zipped
    if [((String, String), Int)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [((String, String), Int)]
counts Bool -> Bool -> Bool
|| [((String, String), Int)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [((String, String), Int)]
counts Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
20
    then () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    else case HistogramOrientation
orientation of
        HistogramOrientation
VerticalHistogram -> String -> IO ()
forall a. HasCallStack => String -> a
error String
"Vertical histograms aren't yet supported"
        HistogramOrientation
HorizontalHistogram -> HasCallStack => Text -> [((String, String), Int)] -> IO ()
Text -> [((String, String), Int)] -> IO ()
plotGivenCounts' Text
cname [((String, String), Int)]
counts
plotForColumnBy Text
byCol Text
cname (Just (UnboxedColumn Vector a
byColumn)) (Just (BoxedColumn Vector a
plotColumn)) HistogramOrientation
orientation DataFrame
df = do
    let zipped :: Vector (String, String)
zipped = (a -> a -> (String, String))
-> Vector a -> Vector a -> Vector (String, String)
forall (v :: * -> *) a b c.
(Vector v a, Vector v b, Vector v c) =>
(a -> b -> c) -> v a -> v b -> v c
VG.zipWith (\a
left a
right -> (a -> String
forall a. Show a => a -> String
show a
left, a -> String
forall a. Show a => a -> String
show a
right)) Vector a
plotColumn (Vector a -> Vector a
forall (v :: * -> *) a (w :: * -> *).
(Vector v a, Vector w a) =>
v a -> w a
V.convert Vector a
byColumn)
    let counts :: [((String, String), Int)]
counts = Vector (String, String) -> [((String, String), Int)]
forall a. Ord a => Vector a -> [(a, Int)]
countOccurrences Vector (String, String)
zipped
    if [((String, String), Int)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [((String, String), Int)]
counts Bool -> Bool -> Bool
|| [((String, String), Int)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [((String, String), Int)]
counts Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
20
    then () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    else case HistogramOrientation
orientation of
        HistogramOrientation
VerticalHistogram -> String -> IO ()
forall a. HasCallStack => String -> a
error String
"Vertical histograms aren't yet supported"
        HistogramOrientation
HorizontalHistogram -> HasCallStack => Text -> [((String, String), Int)] -> IO ()
Text -> [((String, String), Int)] -> IO ()
plotGivenCounts' Text
cname [((String, String), Int)]
counts
plotForColumnBy Text
byCol Text
cname (Just (BoxedColumn Vector a
byColumn)) (Just (UnboxedColumn Vector a
plotColumn)) HistogramOrientation
orientation DataFrame
df = do
    let zipped :: Vector (String, String)
zipped = (a -> a -> (String, String))
-> Vector a -> Vector a -> Vector (String, String)
forall (v :: * -> *) a b c.
(Vector v a, Vector v b, Vector v c) =>
(a -> b -> c) -> v a -> v b -> v c
VG.zipWith (\a
left a
right -> (a -> String
forall a. Show a => a -> String
show a
left, a -> String
forall a. Show a => a -> String
show a
right)) (Vector a -> Vector a
forall (v :: * -> *) a (w :: * -> *).
(Vector v a, Vector w a) =>
v a -> w a
V.convert Vector a
plotColumn) (Vector a -> Vector a
forall (v :: * -> *) a (w :: * -> *).
(Vector v a, Vector w a) =>
v a -> w a
V.convert Vector a
byColumn)
    let counts :: [((String, String), Int)]
counts = Vector (String, String) -> [((String, String), Int)]
forall a. Ord a => Vector a -> [(a, Int)]
countOccurrences Vector (String, String)
zipped
    if [((String, String), Int)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [((String, String), Int)]
counts Bool -> Bool -> Bool
|| [((String, String), Int)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [((String, String), Int)]
counts Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
20
    then () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    else case HistogramOrientation
orientation of
        -- VerticalHistogram -> plotVerticalGivenCounts cname counts
        HistogramOrientation
HorizontalHistogram -> HasCallStack => Text -> [((String, String), Int)] -> IO ()
Text -> [((String, String), Int)] -> IO ()
plotGivenCounts' Text
cname [((String, String), Int)]
counts
plotForColumnBy Text
byCol Text
cname (Just (UnboxedColumn Vector a
byColumn)) (Just (UnboxedColumn Vector a
plotColumn)) HistogramOrientation
orientation DataFrame
df = do
    let zipped :: Vector (String, String)
zipped = (a -> a -> (String, String))
-> Vector a -> Vector a -> Vector (String, String)
forall (v :: * -> *) a b c.
(Vector v a, Vector v b, Vector v c) =>
(a -> b -> c) -> v a -> v b -> v c
VG.zipWith (\a
left a
right -> (a -> String
forall a. Show a => a -> String
show a
left, a -> String
forall a. Show a => a -> String
show a
right)) (Vector a -> Vector a
forall (v :: * -> *) a (w :: * -> *).
(Vector v a, Vector w a) =>
v a -> w a
V.convert Vector a
plotColumn) (Vector a -> Vector a
forall (v :: * -> *) a (w :: * -> *).
(Vector v a, Vector w a) =>
v a -> w a
V.convert Vector a
byColumn)
    let counts :: [((String, String), Int)]
counts = Vector (String, String) -> [((String, String), Int)]
forall a. Ord a => Vector a -> [(a, Int)]
countOccurrences Vector (String, String)
zipped
    if [((String, String), Int)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [((String, String), Int)]
counts Bool -> Bool -> Bool
|| [((String, String), Int)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [((String, String), Int)]
counts Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
20
    then () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    else case HistogramOrientation
orientation of
        HistogramOrientation
VerticalHistogram -> String -> IO ()
forall a. HasCallStack => String -> a
error String
"Vertical histograms aren't yet supported"
        HistogramOrientation
HorizontalHistogram -> HasCallStack => Text -> [((String, String), Int)] -> IO ()
Text -> [((String, String), Int)] -> IO ()
plotGivenCounts' Text
cname [((String, String), Int)]
counts
-- TODO: Add Optional columns
plotForColumnBy Text
_ Text
_ Maybe Column
_ Maybe Column
_ HistogramOrientation
_ DataFrame
_ = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- Plot code adapted from: https://alexwlchan.net/2018/ascii-bar-charts/
plotForColumn :: HasCallStack => T.Text -> Maybe Column -> HistogramOrientation -> DataFrame -> IO ()
plotForColumn :: HasCallStack =>
Text -> Maybe Column -> HistogramOrientation -> DataFrame -> IO ()
plotForColumn Text
_ Maybe Column
Nothing HistogramOrientation
_ DataFrame
_ = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
plotForColumn Text
cname (Just (BoxedColumn (Vector a
column :: V.Vector a))) HistogramOrientation
orientation DataFrame
df = do
    let TypeRep a
repa :: Ref.TypeRep a = forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
Ref.typeRep @a
        TypeRep Text
repText :: Ref.TypeRep T.Text = forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
Ref.typeRep @T.Text
        TypeRep String
repString :: Ref.TypeRep String = forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
Ref.typeRep @String
    let counts :: [(String, Int)]
counts = case TypeRep a
repa TypeRep a -> TypeRep Text -> Maybe (a :~: Text)
forall a b. TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
`testEquality` TypeRep Text
repText of
            Just a :~: Text
Refl -> ((Text, Int) -> (String, Int)) -> [(Text, Int)] -> [(String, Int)]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> String) -> (Text, Int) -> (String, Int)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Text -> String
T.unpack) ([(Text, Int)] -> [(String, Int)])
-> [(Text, Int)] -> [(String, Int)]
forall a b. (a -> b) -> a -> b
$ forall a. Columnable a => Text -> DataFrame -> [(a, Int)]
valueCounts @T.Text Text
cname DataFrame
df
            Maybe (a :~: Text)
Nothing -> case TypeRep a
repa TypeRep a -> TypeRep String -> Maybe (a :~: String)
forall a b. TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
`testEquality` TypeRep String
repString of
                Just a :~: String
Refl -> forall a. Columnable a => Text -> DataFrame -> [(a, Int)]
valueCounts @String Text
cname DataFrame
df
                -- Support other scalar types.
                Maybe (a :~: String)
Nothing -> [] -- numericHistogram column
    if [(String, Int)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(String, Int)]
counts Bool -> Bool -> Bool
|| [(String, Int)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(String, Int)]
counts Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
20
    then String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> Vector a -> String
forall a.
(HasCallStack, Columnable a) =>
Text -> Vector a -> String
numericHistogram Text
cname (Vector a -> Vector a
forall (v :: * -> *) a (w :: * -> *).
(Vector v a, Vector w a) =>
v a -> w a
V.convert Vector a
column)
    else case HistogramOrientation
orientation of
        HistogramOrientation
VerticalHistogram -> HasCallStack => Text -> [(String, Int)] -> IO ()
Text -> [(String, Int)] -> IO ()
plotVerticalGivenCounts Text
cname [(String, Int)]
counts
        HistogramOrientation
HorizontalHistogram -> HasCallStack => Text -> [(String, Int)] -> IO ()
Text -> [(String, Int)] -> IO ()
plotGivenCounts Text
cname [(String, Int)]
counts
plotForColumn Text
cname (Just (UnboxedColumn (Vector a
column :: VU.Vector a))) HistogramOrientation
orientation DataFrame
df = do
    let TypeRep a
repa :: Ref.TypeRep a = forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
Ref.typeRep @a
        TypeRep Text
repText :: Ref.TypeRep T.Text = forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
Ref.typeRep @T.Text
        TypeRep String
repString :: Ref.TypeRep String = forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
Ref.typeRep @String
    let counts :: [(String, Int)]
counts = case TypeRep a
repa TypeRep a -> TypeRep Text -> Maybe (a :~: Text)
forall a b. TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
`testEquality` TypeRep Text
repText of
            Just a :~: Text
Refl -> ((Text, Int) -> (String, Int)) -> [(Text, Int)] -> [(String, Int)]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> String) -> (Text, Int) -> (String, Int)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Text -> String
forall a. Show a => a -> String
show) ([(Text, Int)] -> [(String, Int)])
-> [(Text, Int)] -> [(String, Int)]
forall a b. (a -> b) -> a -> b
$ forall a. Columnable a => Text -> DataFrame -> [(a, Int)]
valueCounts @T.Text Text
cname DataFrame
df
            Maybe (a :~: Text)
Nothing -> case TypeRep a
repa TypeRep a -> TypeRep String -> Maybe (a :~: String)
forall a b. TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
`testEquality` TypeRep String
repString of
                Just a :~: String
Refl -> forall a. Columnable a => Text -> DataFrame -> [(a, Int)]
valueCounts @String Text
cname DataFrame
df
                -- Support other scalar types.
                Maybe (a :~: String)
Nothing -> []
    if [(String, Int)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(String, Int)]
counts Bool -> Bool -> Bool
|| [(String, Int)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(String, Int)]
counts Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
20
    then String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> Vector a -> String
forall a.
(HasCallStack, Columnable a) =>
Text -> Vector a -> String
numericHistogram Text
cname (Vector a -> Vector a
forall (v :: * -> *) a (w :: * -> *).
(Vector v a, Vector w a) =>
v a -> w a
V.convert Vector a
column)
    else case HistogramOrientation
orientation of
        HistogramOrientation
VerticalHistogram -> HasCallStack => Text -> [(String, Int)] -> IO ()
Text -> [(String, Int)] -> IO ()
plotVerticalGivenCounts Text
cname [(String, Int)]
counts
        HistogramOrientation
HorizontalHistogram -> HasCallStack => Text -> [(String, Int)] -> IO ()
Text -> [(String, Int)] -> IO ()
plotGivenCounts Text
cname [(String, Int)]
counts
plotForColumn Text
_ Maybe Column
_ HistogramOrientation
_ DataFrame
_ = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

plotGivenCounts :: HasCallStack => T.Text -> [(String, Int)] -> IO ()
plotGivenCounts :: HasCallStack => Text -> [(String, Int)] -> IO ()
plotGivenCounts Text
cname [(String, Int)]
counts = do
    String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"\nHistogram for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
cname String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n"
    let n :: Int
n = Int
8 :: Int
    let maxValue :: Int
maxValue = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ ((String, Int) -> Int) -> [(String, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (String, Int) -> Int
forall a b. (a, b) -> b
snd [(String, Int)]
counts
    let increment :: Int
increment = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Int
maxValue Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
50)
    let longestLabelLength :: Int
longestLabelLength = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ ((String, Int) -> Int) -> [(String, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int)
-> ((String, Int) -> String) -> (String, Int) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, Int) -> String
forall a b. (a, b) -> a
fst) [(String, Int)]
counts
    let longestBar :: Int
longestBar = Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ (Int
maxValue Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
increment) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
    let border :: String
border = String
"|" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
longestLabelLength Int -> Int -> Int
forall a. Num a => a -> a -> a
+ String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Int -> String
forall a. Show a => a -> String
show Int
maxValue) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
longestBar Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
6) Char
'-' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"|"
    [String]
body <- [(String, Int)] -> ((String, Int) -> IO String) -> IO [String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(String, Int)]
counts (((String, Int) -> IO String) -> IO [String])
-> ((String, Int) -> IO String) -> IO [String]
forall a b. (a -> b) -> a -> b
$ \(String
label, Int
count) -> do
        let barChunks :: Int
barChunks = Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ (Int
count Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
increment) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
        let remainder :: Int
remainder = Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ (Int
count Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
increment) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n      
        let fractional :: String
fractional = ([Int -> Char
chr (Char -> Int
ord Char
'█' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
remainder Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) | Int
remainder Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0])
        let bar :: String
bar = Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
barChunks Char
'█' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fractional
        let disp :: String
disp = if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
bar then String
"| " else String
bar
        let hist :: String
hist=  String
"|" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
brightGreen (String -> Int -> String
leftJustify String
label Int
longestLabelLength) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" | " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                    String -> Int -> String
leftJustify (Int -> String
forall a. Show a => a -> String
show Int
count) (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Int -> String
forall a. Show a => a -> String
show Int
maxValue)) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" |" String -> String -> String
forall a. [a] -> [a] -> [a]
++
                    String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
brightBlue String
bar
        String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String
hist String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
border
    (String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> IO ()
putStrLn (String
border String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
body)
    Char -> IO ()
putChar Char
'\n'

plotVerticalGivenCounts :: HasCallStack => T.Text -> [(String, Int)] -> IO ()
plotVerticalGivenCounts :: HasCallStack => Text -> [(String, Int)] -> IO ()
plotVerticalGivenCounts Text
cname [(String, Int)]
counts' = do
    String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"\nHistogram for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
cname String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n"
    let n :: Int
n = Int
8 :: Int
    let clip :: String -> String
clip String
s = if String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
n then Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
n String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".." else String
s
    let counts :: [(String, Int)]
counts = ((String, Int) -> (String, Int))
-> [(String, Int)] -> [(String, Int)]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> String) -> (String, Int) -> (String, Int)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first String -> String
clip) [(String, Int)]
counts'
    let maxValue :: Int
maxValue = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ ((String, Int) -> Int) -> [(String, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (String, Int) -> Int
forall a b. (a, b) -> b
snd [(String, Int)]
counts
    let increment :: Int
increment = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Int
maxValue Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
10)
    let longestLabelLength :: Int
longestLabelLength = Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (((String, Int) -> Int) -> [(String, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int)
-> ((String, Int) -> String) -> (String, Int) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, Int) -> String
forall a b. (a, b) -> a
fst) [(String, Int)]
counts)
    let longestBar :: Int
longestBar = Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ (Int
maxValue Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
increment) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
    let border :: String
border = String
"‾" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
longestBar Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Char
'|' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"+"
    let maximumLineLength :: Int
maximumLineLength = String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
border
    [[String]]
body <- [(String, Int)] -> ((String, Int) -> IO [String]) -> IO [[String]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(String, Int)]
counts (((String, Int) -> IO [String]) -> IO [[String]])
-> ((String, Int) -> IO [String]) -> IO [[String]]
forall a b. (a -> b) -> a -> b
$ \(String
label, Int
count) -> do
        let barChunks :: Int
barChunks = Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ (Int
count Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
increment) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
        let remainder :: Int
remainder = Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ (Int
count Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
increment) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
        let fractional :: String
fractional = ([Int -> Char
chr (Char -> Int
ord Char
'█' Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
remainder Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) | Int
remainder Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0])
        let bar :: String
bar = Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
barChunks Char
'█' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fractional
        let disp :: String
disp = if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
bar then String
"| " else String
bar
        let hist :: String
hist = String
"‾" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
bar
        [String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> IO [String]) -> [String] -> IO [String]
forall a b. (a -> b) -> a -> b
$ Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
longestLabelLength (String -> Int -> String
leftJustify String
hist Int
maximumLineLength) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
border]
    let fullGraph :: [String]
fullGraph = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
brightBlue ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
rotate ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String
border String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[String]]
body
    let partition :: Int
partition = Int -> [Int] -> Int
forall a. Ord a => a -> [a] -> a
smallestPartition Int
increment [Int]
intPlotRanges
    let increments :: [Int]
increments = [Int] -> [Int]
forall a. [a] -> [a]
reverse [Int
0, Int
maxValue Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2 , Int
maxValue Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
partition]
    let incString :: [String]
incString = [String] -> [String]
forall a. [a] -> [a]
reverse ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Int -> String
`leftJustify` (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Int -> String
forall a. Show a => a -> String
show Int
maxValue) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ Integer -> String
forall a. Show a => a -> String
show Integer
0 String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Int -> String -> [String]
forall a. Int -> a -> [a]
replicate ([String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
fullGraph 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) String
" "
                            [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [Int -> String
forall a. Show a => a -> String
show (Int
maxValue Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2)]
                            [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ Int -> String -> [String]
forall a. Int -> a -> [a]
replicate ([String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
fullGraph 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) String
" "
                            [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [Int -> String
forall a. Show a => a -> String
show (Int
maxValue Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
partition)]
                            [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
""]
    (String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> IO ()
putStrLn ((String -> String -> String) -> [String] -> [String] -> [String]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith String -> String -> String
forall a. [a] -> [a] -> [a]
(++) [String]
incString [String]
fullGraph)
    String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Int -> String
forall a. Show a => a -> String
show Int
maxValue) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Char
' ' String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords (((String, Int) -> String) -> [(String, Int)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> String
brightGreen (String -> String)
-> ((String, Int) -> String) -> (String, Int) -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Int -> String) -> Int -> String -> String
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> Int -> String
leftJustify Int
longestLabelLength (String -> String)
-> ((String, Int) -> String) -> (String, Int) -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, Int) -> String
forall a b. (a, b) -> a
fst) [(String, Int)]
counts)
    Char -> IO ()
putChar Char
'\n'

leftJustify :: String -> Int -> String
leftJustify :: String -> Int -> String
leftJustify String
s Int
n = String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ 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
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s)) Char
' '


plotGivenCounts' :: HasCallStack => T.Text -> [((String, String), Int)] -> IO ()
plotGivenCounts' :: HasCallStack => Text -> [((String, String), Int)] -> IO ()
plotGivenCounts' Text
cname [((String, String), Int)]
counts = do
    String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"\nHistogram for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
cname String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n"
    let n :: Int
n = Int
8 :: Int
    let maxValue :: Int
maxValue = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (((String, String), Int) -> Int)
-> [((String, String), Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ((String, String), Int) -> Int
forall a b. (a, b) -> b
snd [((String, String), Int)]
counts
    let increment :: Int
increment = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Int
maxValue Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
50)
    let longestLabelLength :: Int
longestLabelLength = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (((String, String), Int) -> Int)
-> [((String, String), Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length(String -> Int)
-> (((String, String), Int) -> String)
-> ((String, String), Int)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\(String
a, String
b) -> String
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
b) ((String, String) -> String)
-> (((String, String), Int) -> (String, String))
-> ((String, String), Int)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, String), Int) -> (String, String)
forall a b. (a, b) -> a
fst) [((String, String), Int)]
counts
    let longestBar :: Int
longestBar = Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ (Int
maxValue Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
increment) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
    let border :: String
border = String
"|" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
longestLabelLength Int -> Int -> Int
forall a. Num a => a -> a -> a
+ String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Int -> String
forall a. Show a => a -> String
show Int
maxValue) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
longestBar Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
6) Char
'-' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"|"
    [String]
body <- [((String, String), Int)]
-> (((String, String), Int) -> IO String) -> IO [String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [((String, String), Int)]
counts ((((String, String), Int) -> IO String) -> IO [String])
-> (((String, String), Int) -> IO String) -> IO [String]
forall a b. (a -> b) -> a -> b
$ \((String
plotCol, String
byCol), Int
count) -> do
        let barChunks :: Int
barChunks = Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ (Int
count Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
increment) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
        let remainder :: Int
remainder = Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ (Int
count Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
increment) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
        let fractional :: String
fractional = ([Int -> Char
chr (Char -> Int
ord Char
'█' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
remainder Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) | Int
remainder Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0])
        let bar :: String
bar = Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
barChunks Char
'█' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fractional
        let disp :: String
disp = if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
bar then String
"| " else String
bar
        let label :: String
label = String
plotCol String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
byCol
        let hist :: String
hist=  String
"|" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
brightGreen (String -> Int -> String
leftJustify String
label Int
longestLabelLength) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" | " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                    String -> Int -> String
leftJustify (Int -> String
forall a. Show a => a -> String
show Int
count) (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Int -> String
forall a. Show a => a -> String
show Int
maxValue)) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" |" String -> String -> String
forall a. [a] -> [a] -> [a]
++
                    String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
brightBlue String
bar
        String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String
hist String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
border
    (String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> IO ()
putStrLn (String
border String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
body)
    Char -> IO ()
putChar Char
'\n'

numericHistogram :: forall a . (HasCallStack, Columnable a)
                         => T.Text
                         -> V.Vector a
                         -> String
numericHistogram :: forall a.
(HasCallStack, Columnable a) =>
Text -> Vector a -> String
numericHistogram Text
name Vector a
xs = let
    config :: HistogramConfig
config = HistogramConfig
defaultConfig {
            title = Just (T.unpack name),
            width = 30,
            height = 10
        }
    in HistogramConfig -> [Double] -> String
createHistogram HistogramConfig
config (Vector Double -> [Double]
forall a. Vector a -> [a]
V.toList Vector Double
xs')
        where
            xs' :: Vector Double
xs' = case TypeRep a -> TypeRep Double -> Maybe (a :~: Double)
forall a b. TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @a) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @Double) of
                Just a :~: Double
Refl -> Vector a
Vector Double
xs
                Maybe (a :~: Double)
Nothing -> case TypeRep a -> TypeRep Int -> Maybe (a :~: Int)
forall a b. TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @a) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @Int) of
                    Just a :~: Int
Refl -> (a -> Double) -> Vector a -> Vector Double
forall a b. (a -> b) -> Vector a -> Vector b
V.map a -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Vector a
xs
                    Maybe (a :~: Int)
Nothing -> case TypeRep a -> TypeRep Integer -> Maybe (a :~: Integer)
forall a b. TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @a) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @Integer) of
                        Just a :~: Integer
Refl -> (a -> Double) -> Vector a -> Vector Double
forall a b. (a -> b) -> Vector a -> Vector b
V.map a -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Vector a
xs
                        Maybe (a :~: Integer)
Nothing -> Vector Double
forall a. Vector a
V.empty

smallestPartition :: (Ord a) => a -> [a] -> a
-- TODO: Find a more graceful way to handle this.
smallestPartition :: forall a. Ord a => a -> [a] -> a
smallestPartition a
p [] = String -> a
forall a. HasCallStack => String -> a
error String
"Data range too large to plot"
smallestPartition a
p (a
x:a
y:[a]
rest)
    | a
p a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
y = a
x
    | Bool
otherwise = a -> [a] -> a
forall a. Ord a => a -> [a] -> a
smallestPartition a
p (a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
rest)
smallestPartition a
p (a
x:[a]
rest)
    | a
p a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
x = a
x
    | Bool
otherwise = String -> a
forall a. HasCallStack => String -> a
error String
""

largestPartition :: (Ord a) => a -> [a] -> a
-- TODO: Find a more graceful way to handle this.
largestPartition :: forall a. Ord a => a -> [a] -> a
largestPartition a
p [] = String -> a
forall a. HasCallStack => String -> a
error String
"Data range too large to plot"
largestPartition a
p (a
x:[a]
rest)
    | a
p a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
x = a
x
    | Bool
otherwise = a -> [a] -> a
forall a. Ord a => a -> [a] -> a
largestPartition a
p [a]
rest

intPlotRanges :: [Int]
intPlotRanges :: [Int]
intPlotRanges = [Int
1, Int
5,
                Int
10, Int
50,
                Int
100, Int
500,
                Int
1_000, Int
5_000,
                Int
10_000, Int
50_000,
                Int
100_000, Int
500_000,
                Int
1_000_000, Int
5_000_000]

rotate :: [String] -> [String]
rotate :: [String] -> [String]
rotate [] = []
rotate [String]
xs
    | [String] -> String
forall a. HasCallStack => [a] -> a
head [String]
xs String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"" = []
    | Bool
otherwise = (String -> Char) -> [String] -> String
forall a b. (a -> b) -> [a] -> [b]
map String -> Char
forall a. HasCallStack => [a] -> a
last [String]
xs String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String] -> [String]
rotate ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
forall a. HasCallStack => [a] -> [a]
init [String]
xs)


countOccurrences :: Ord a => V.Vector a -> [(a, Int)]
countOccurrences :: forall a. Ord a => Vector a -> [(a, Int)]
countOccurrences Vector a
xs = Map a Int -> [(a, Int)]
forall k a. Map k a -> [(k, a)]
M.toList (Map a Int -> [(a, Int)]) -> Map a Int -> [(a, Int)]
forall a b. (a -> b) -> a -> b
$ (a -> Map a Int -> Map a Int) -> Map a Int -> Vector a -> Map a Int
forall (v :: * -> *) a b.
Vector v a =>
(a -> b -> b) -> b -> v a -> b
VG.foldr a -> Map a Int -> Map a Int
forall {k} {a}. (Ord k, Num a) => k -> Map k a -> Map k a
count Map a Int
initMap Vector a
xs
    where initMap :: Map a Int
initMap = [(a, Int)] -> Map a Int
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ((a -> (a, Int)) -> [a] -> [(a, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (, Int
0) (Vector a -> [a]
forall a. Vector a -> [a]
V.toList Vector a
xs))
          count :: k -> Map k a -> Map k a
count k
k = (a -> a -> a) -> k -> a -> Map k a -> Map k a
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith a -> a -> a
forall a. Num a => a -> a -> a
(+) k
k a
1

data HistogramConfig = HistogramConfig {
    HistogramConfig -> Int
width :: Int,          -- Width of the histogram in characters
    HistogramConfig -> Int
height :: Int,         -- Height of the histogram in rows
    HistogramConfig -> Char
barChar :: Char,       -- Character to use for bars
    HistogramConfig -> Maybe String
title :: Maybe String  -- Optional title for the histogram
}

defaultConfig :: HistogramConfig
defaultConfig :: HistogramConfig
defaultConfig = HistogramConfig {
    width :: Int
width = Int
40,
    height :: Int
height = Int
15,
    barChar :: Char
barChar = Char
'█',
    title :: Maybe String
title = Maybe String
forall a. Maybe a
Nothing
}

-- Calculate the histogram bins and counts
calculateBins :: [Double] -> Int -> [(Double, Int)]
calculateBins :: [Double] -> Int -> [(Double, Int)]
calculateBins [Double]
values Int
numBins =
    let minVal :: Double
minVal = [Double] -> Double
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Double]
values
        maxVal :: Double
maxVal = [Double] -> Double
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Double]
values
        binWidth :: Double
binWidth = (Double
maxVal Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
minVal) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
numBins
        toBin :: Double -> Integer
toBin Double
x = Double -> Integer
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
minVal) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
binWidth)
        bins :: [Integer]
bins = (Double -> Integer) -> [Double] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map Double -> Integer
toBin [Double]
values
        counts :: [Int]
counts = ([Integer] -> Int) -> [[Integer]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [Integer] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([[Integer]] -> [Int])
-> ([Integer] -> [[Integer]]) -> [Integer] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Integer] -> [[Integer]]
forall a. Eq a => [a] -> [[a]]
L.group ([Integer] -> [[Integer]])
-> ([Integer] -> [Integer]) -> [Integer] -> [[Integer]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Integer] -> [Integer]
forall a. Ord a => [a] -> [a]
L.sort ([Integer] -> [Int]) -> [Integer] -> [Int]
forall a b. (a -> b) -> a -> b
$ [Integer]
bins
        binValues :: [Double]
binValues = [Double
minVal Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
binWidth) | Int
i <- [Int
0..Int
numBinsInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]]
    in [Double] -> [Int] -> [(Double, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Double]
binValues ([Int]
counts [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ Int -> [Int]
forall a. a -> [a]
repeat Int
0)

-- Format a number with appropriate scaling (k, M, B, etc.)
formatNumber :: Double -> String
formatNumber :: Double -> String
formatNumber Double
n
    | Double
n Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
1e9  = String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%.1fB" (Double
n Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1e9)
    | Double
n Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
1e6  = String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%.1fM" (Double
n Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1e6)
    | Double
n Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
1e3  = String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%.1fk" (Double
n Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1e3)
    | Bool
otherwise = String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%.1f" Double
n

-- Create the ASCII histogram
createHistogram :: HistogramConfig -> [Double] -> String
createHistogram :: HistogramConfig -> [Double] -> String
createHistogram HistogramConfig
_ [] = []
createHistogram HistogramConfig
config [Double]
values =
    let bins :: [(Double, Int)]
bins = [Double] -> Int -> [(Double, Int)]
calculateBins [Double]
values (HistogramConfig -> Int
width HistogramConfig
config)
        maxCount :: Int
maxCount = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ ((Double, Int) -> Int) -> [(Double, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Double, Int) -> Int
forall a b. (a, b) -> b
snd [(Double, Int)]
bins
        scaleY :: Double
scaleY = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maxCount Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (HistogramConfig -> Int
height HistogramConfig
config)

        -- Create Y-axis labels
        yLabels :: [String]
yLabels = [Double -> String
formatNumber (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
scaleY) | Int
i <- [HistogramConfig -> Int
height HistogramConfig
config, HistogramConfig -> Int
height HistogramConfig
configInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1..Int
0]]
        maxYLabelWidth :: Int
maxYLabelWidth = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (String -> Int) -> [String] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
yLabels

        -- Create X-axis labels
        xValues :: [Double]
xValues = ((Double, Int) -> Double) -> [(Double, Int)] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (Double, Int) -> Double
forall a b. (a, b) -> a
fst [(Double, Int)]
bins
        xLabels :: [String]
xLabels = (Double -> String) -> [Double] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Double -> String
formatNumber [[Double] -> Double
forall a. HasCallStack => [a] -> a
head [Double]
xValues, [Double] -> Double
forall a. HasCallStack => [a] -> a
last [Double]
xValues]

        -- Create histogram rows
        makeRow :: Int -> String
        makeRow :: Int -> String
makeRow Int
row =
            let threshold :: Double
threshold = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (HistogramConfig -> Int
height HistogramConfig
config Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
row) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
scaleY
                barLine :: String
barLine = ((Double, Int) -> Char) -> [(Double, Int)] -> String
forall a b. (a -> b) -> [a] -> [b]
map (\(Double
_, Int
count) ->
                    if Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
count Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
threshold
                    then HistogramConfig -> Char
barChar HistogramConfig
config
                    else Char
' ') [(Double, Int)]
bins
            in String -> Int -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%*s |%s" Int
maxYLabelWidth ([String]
yLabels [String] -> Int -> String
forall a. HasCallStack => [a] -> Int -> a
!! Int
row) (String -> String
brightBlue (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ (String -> Char -> String) -> String -> String -> String
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl' (\String
acc Char
c -> Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:Char
'|'Char -> String -> String
forall a. a -> [a] -> [a]
:String
acc) String
"" String
barLine)

        -- Build the complete histogram
        histogramRows :: [String]
histogramRows = (Int -> String) -> [Int] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Int -> String
makeRow [Int
0..HistogramConfig -> Int
height HistogramConfig
config Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
        xAxis :: String
xAxis = Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
maxYLabelWidth Char
' ' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
L.intercalate (Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (HistogramConfig -> Int
width HistogramConfig
config Int -> Int -> Int
forall a. Num a => a -> a -> a
- [String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
xLabels)) Char
' ') [String]
xLabels

        -- Add title if provided
        titleLine :: String
titleLine = case HistogramConfig -> Maybe String
title HistogramConfig
config of
            Just String
t  -> String
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n\n"
            Maybe String
Nothing -> String
""

    in String
titleLine String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unlines ([String]
histogramRows [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
xAxis])