{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ExplicitNamespaces #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module DataFrame.Display.Web.Plot where

import Control.Monad
import Data.Char
import qualified Data.List as L
import qualified Data.Map as M
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Data.Type.Equality (TestEquality (testEquality), type (:~:) (Refl))
import Data.Typeable (Typeable)
import qualified Data.Vector as V
import qualified Data.Vector.Generic as VG
import qualified Data.Vector.Unboxed as VU
import GHC.Stack (HasCallStack)
import System.Random (newStdGen, randomRs)
import Type.Reflection (typeRep)

import DataFrame.Internal.Column (Column (..), isNumeric)
import qualified DataFrame.Internal.Column as D
import DataFrame.Internal.DataFrame (DataFrame (..), getColumn)
import DataFrame.Operations.Core
import qualified DataFrame.Operations.Subset as D
import System.Directory
import System.Info
import System.Process (
    StdStream (NoStream),
    createProcess,
    proc,
    std_err,
    std_in,
    std_out,
    waitForProcess,
 )

newtype HtmlPlot = HtmlPlot T.Text deriving (Int -> HtmlPlot -> ShowS
[HtmlPlot] -> ShowS
HtmlPlot -> String
(Int -> HtmlPlot -> ShowS)
-> (HtmlPlot -> String) -> ([HtmlPlot] -> ShowS) -> Show HtmlPlot
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HtmlPlot -> ShowS
showsPrec :: Int -> HtmlPlot -> ShowS
$cshow :: HtmlPlot -> String
show :: HtmlPlot -> String
$cshowList :: [HtmlPlot] -> ShowS
showList :: [HtmlPlot] -> ShowS
Show)

data PlotConfig = PlotConfig
    { PlotConfig -> PlotType
plotType :: PlotType
    , PlotConfig -> Text
plotTitle :: T.Text
    , PlotConfig -> Int
plotWidth :: Int
    , PlotConfig -> Int
plotHeight :: Int
    , PlotConfig -> Maybe String
plotFile :: Maybe FilePath
    }

data PlotType
    = Histogram
    | Scatter
    | Line
    | Bar
    | BoxPlot
    | Pie
    | StackedBar
    | Heatmap
    deriving (PlotType -> PlotType -> Bool
(PlotType -> PlotType -> Bool)
-> (PlotType -> PlotType -> Bool) -> Eq PlotType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PlotType -> PlotType -> Bool
== :: PlotType -> PlotType -> Bool
$c/= :: PlotType -> PlotType -> Bool
/= :: PlotType -> PlotType -> Bool
Eq, Int -> PlotType -> ShowS
[PlotType] -> ShowS
PlotType -> String
(Int -> PlotType -> ShowS)
-> (PlotType -> String) -> ([PlotType] -> ShowS) -> Show PlotType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PlotType -> ShowS
showsPrec :: Int -> PlotType -> ShowS
$cshow :: PlotType -> String
show :: PlotType -> String
$cshowList :: [PlotType] -> ShowS
showList :: [PlotType] -> ShowS
Show)

defaultPlotConfig :: PlotType -> PlotConfig
defaultPlotConfig :: PlotType -> PlotConfig
defaultPlotConfig PlotType
ptype =
    PlotConfig
        { plotType :: PlotType
plotType = PlotType
ptype
        , plotTitle :: Text
plotTitle = Text
""
        , plotWidth :: Int
plotWidth = Int
600
        , plotHeight :: Int
plotHeight = Int
400
        , plotFile :: Maybe String
plotFile = Maybe String
forall a. Maybe a
Nothing
        }

chartJsScript :: T.Text
chartJsScript :: Text
chartJsScript =
    Text
"<script src=\"https://cdnjs.cloudflare.com/ajax/libs/Chart.js/2.9.4/Chart.js\"></script>\n"

generateChartId :: IO T.Text
generateChartId :: IO Text
generateChartId = do
    StdGen
gen <- IO StdGen
forall (m :: * -> *). MonadIO m => m StdGen
newStdGen
    let randomWords :: [Int]
randomWords =
            (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
filter
                (\Int
c -> Int
c Int -> [Int] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ([Int
49 .. Int
57] [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
65 .. Int
90] [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
97 .. Int
122]))
                (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take Int
64 ((Int, Int) -> StdGen -> [Int]
forall g. RandomGen g => (Int, Int) -> g -> [Int]
forall a g. (Random a, RandomGen g) => (a, a) -> g -> [a]
randomRs (Int
49, Int
126) StdGen
gen :: [Int]))
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> IO Text) -> Text -> IO Text
forall a b. (a -> b) -> a -> b
$ Text
"chart_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack ((Int -> Char) -> [Int] -> String
forall a b. (a -> b) -> [a] -> [b]
map Int -> Char
chr [Int]
randomWords)

wrapInHTML :: T.Text -> T.Text -> Int -> Int -> T.Text
wrapInHTML :: Text -> Text -> Int -> Int -> Text
wrapInHTML Text
chartId Text
content Int
width Int
height =
    [Text] -> Text
T.concat
        [ Text
"<canvas id=\""
        , Text
chartId
        , Text
"\" style=\"width:100%;max-width:"
        , String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
width)
        , Text
"px;height:"
        , String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
height)
        , Text
"px\"></canvas>\n"
        , Text
"<script src=\"https://cdnjs.cloudflare.com/ajax/libs/Chart.js/2.9.4/Chart.js\"></script>\n"
        , Text
"<script>\n"
        , Text
content
        , Text
"\n</script>\n"
        ]

plotHistogram :: (HasCallStack) => T.Text -> DataFrame -> IO HtmlPlot
plotHistogram :: HasCallStack => Text -> DataFrame -> IO HtmlPlot
plotHistogram Text
colName = HasCallStack => Text -> PlotConfig -> DataFrame -> IO HtmlPlot
Text -> PlotConfig -> DataFrame -> IO HtmlPlot
plotHistogramWith Text
colName (PlotType -> PlotConfig
defaultPlotConfig PlotType
Histogram)

plotHistogramWith ::
    (HasCallStack) => T.Text -> PlotConfig -> DataFrame -> IO HtmlPlot
plotHistogramWith :: HasCallStack => Text -> PlotConfig -> DataFrame -> IO HtmlPlot
plotHistogramWith Text
colName PlotConfig
config DataFrame
df = do
    Text
chartId <- IO Text
generateChartId
    let values :: [Double]
values = HasCallStack => Text -> DataFrame -> [Double]
Text -> DataFrame -> [Double]
extractNumericColumn Text
colName DataFrame
df
        (Double
minVal, Double
maxVal) = if [Double] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Double]
values then (Double
0, Double
1) else ([Double] -> Double
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Double]
values, [Double] -> Double
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Double]
values)
        numBins :: Integer
numBins = Integer
30
        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
/ Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
numBins
        bins :: [Double]
bins = [Double
minVal Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
binWidth | Integer
i <- [Integer
0 .. Integer
numBins Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1]]
        counts :: [Int]
counts = [Double] -> [Double] -> Double -> [Int]
calculateHistogram [Double]
values [Double]
bins Double
binWidth

        labels :: Text
labels =
            Text -> [Text] -> Text
T.intercalate Text
"," [Text
"\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show (Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Double
b :: Int)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\"" | Double
b <- [Double]
bins]
        dataPoints :: Text
dataPoints = Text -> [Text] -> Text
T.intercalate Text
"," [String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
c) | Int
c <- [Int]
counts]

        chartTitle :: Text
chartTitle =
            if Text -> Bool
T.null (PlotConfig -> Text
plotTitle PlotConfig
config)
                then Text
"Histogram of " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
colName
                else PlotConfig -> Text
plotTitle PlotConfig
config

        jsCode :: Text
jsCode =
            [Text] -> Text
T.concat
                [ Text
"new Chart(\""
                , Text
chartId
                , Text
"\", {\n"
                , Text
"  type: \"bar\",\n"
                , Text
"  data: {\n"
                , Text
"    labels: ["
                , Text
labels
                , Text
"],\n"
                , Text
"    datasets: [{\n"
                , Text
"      label: \""
                , Text
colName
                , Text
"\",\n"
                , Text
"      data: ["
                , Text
dataPoints
                , Text
"],\n"
                , Text
"      backgroundColor: \"rgba(75, 192, 192, 0.6)\",\n"
                , Text
"      borderColor: \"rgba(75, 192, 192, 1)\",\n"
                , Text
"      borderWidth: 1\n"
                , Text
"    }]\n"
                , Text
"  },\n"
                , Text
"  options: {\n"
                , Text
"    title: { display: true, text: \""
                , Text
chartTitle
                , Text
"\" },\n"
                , Text
"    scales: {\n"
                , Text
"      yAxes: [{ ticks: { beginAtZero: true } }]\n"
                , Text
"    }\n"
                , Text
"  }\n"
                , Text
"});"
                ]

    HtmlPlot -> IO HtmlPlot
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (HtmlPlot -> IO HtmlPlot) -> HtmlPlot -> IO HtmlPlot
forall a b. (a -> b) -> a -> b
$
        Text -> HtmlPlot
HtmlPlot (Text -> HtmlPlot) -> Text -> HtmlPlot
forall a b. (a -> b) -> a -> b
$
            Text -> Text -> Int -> Int -> Text
wrapInHTML Text
chartId Text
jsCode (PlotConfig -> Int
plotWidth PlotConfig
config) (PlotConfig -> Int
plotHeight PlotConfig
config)

calculateHistogram :: [Double] -> [Double] -> Double -> [Int]
calculateHistogram :: [Double] -> [Double] -> Double -> [Int]
calculateHistogram [Double]
values [Double]
bins Double
binWidth =
    let countBin :: Double -> Int
countBin Double
b = [Double] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Double
v | Double
v <- [Double]
values, Double
v Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
b Bool -> Bool -> Bool
&& Double
v Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
b Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
binWidth]
     in (Double -> Int) -> [Double] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Double -> Int
countBin [Double]
bins

plotScatter :: (HasCallStack) => T.Text -> T.Text -> DataFrame -> IO HtmlPlot
plotScatter :: HasCallStack => Text -> Text -> DataFrame -> IO HtmlPlot
plotScatter Text
xCol Text
yCol = HasCallStack =>
Text -> Text -> PlotConfig -> DataFrame -> IO HtmlPlot
Text -> Text -> PlotConfig -> DataFrame -> IO HtmlPlot
plotScatterWith Text
xCol Text
yCol (PlotType -> PlotConfig
defaultPlotConfig PlotType
Scatter)

plotScatterWith ::
    (HasCallStack) => T.Text -> T.Text -> PlotConfig -> DataFrame -> IO HtmlPlot
plotScatterWith :: HasCallStack =>
Text -> Text -> PlotConfig -> DataFrame -> IO HtmlPlot
plotScatterWith Text
xCol Text
yCol PlotConfig
config DataFrame
df = do
    Text
chartId <- IO Text
generateChartId
    let xVals :: [Double]
xVals = HasCallStack => Text -> DataFrame -> [Double]
Text -> DataFrame -> [Double]
extractNumericColumn Text
xCol DataFrame
df
        yVals :: [Double]
yVals = HasCallStack => Text -> DataFrame -> [Double]
Text -> DataFrame -> [Double]
extractNumericColumn Text
yCol DataFrame
df
        points :: [(Double, Double)]
points = [Double] -> [Double] -> [(Double, Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Double]
xVals [Double]
yVals

        dataPoints :: Text
dataPoints =
            Text -> [Text] -> Text
T.intercalate
                Text
","
                [ Text
"{x:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Double -> String
forall a. Show a => a -> String
show Double
x) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", y:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Double -> String
forall a. Show a => a -> String
show Double
y) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}" | (Double
x, Double
y) <- [(Double, Double)]
points
                ]
        chartTitle :: Text
chartTitle =
            if Text -> Bool
T.null (PlotConfig -> Text
plotTitle PlotConfig
config) then Text
xCol Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" vs " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
yCol else PlotConfig -> Text
plotTitle PlotConfig
config

        jsCode :: Text
jsCode =
            [Text] -> Text
T.concat
                [ Text
"new Chart(\""
                , Text
chartId
                , Text
"\", {\n"
                , Text
"  type: \"scatter\",\n"
                , Text
"  data: {\n"
                , Text
"    datasets: [{\n"
                , Text
"      label: \""
                , Text
chartTitle
                , Text
"\",\n"
                , Text
"      data: ["
                , Text
dataPoints
                , Text
"],\n"
                , Text
"      pointRadius: 4,\n"
                , Text
"      pointBackgroundColor: \"rgb(75, 192, 192)\"\n"
                , Text
"    }]\n"
                , Text
"  },\n"
                , Text
"  options: {\n"
                , Text
"    title: { display: true, text: \""
                , Text
chartTitle
                , Text
"\" },\n"
                , Text
"    scales: {\n"
                , Text
"      xAxes: [{ scaleLabel: { display: true, labelString: \""
                , Text
xCol
                , Text
"\" } }],\n"
                , Text
"      yAxes: [{ scaleLabel: { display: true, labelString: \""
                , Text
yCol
                , Text
"\" } }]\n"
                , Text
"    }\n"
                , Text
"  }\n"
                , Text
"});"
                ]

    HtmlPlot -> IO HtmlPlot
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (HtmlPlot -> IO HtmlPlot) -> HtmlPlot -> IO HtmlPlot
forall a b. (a -> b) -> a -> b
$
        Text -> HtmlPlot
HtmlPlot (Text -> HtmlPlot) -> Text -> HtmlPlot
forall a b. (a -> b) -> a -> b
$
            Text -> Text -> Int -> Int -> Text
wrapInHTML Text
chartId Text
jsCode (PlotConfig -> Int
plotWidth PlotConfig
config) (PlotConfig -> Int
plotHeight PlotConfig
config)

plotScatterBy ::
    (HasCallStack) => T.Text -> T.Text -> T.Text -> DataFrame -> IO HtmlPlot
plotScatterBy :: HasCallStack => Text -> Text -> Text -> DataFrame -> IO HtmlPlot
plotScatterBy Text
xCol Text
yCol Text
grouping = HasCallStack =>
Text -> Text -> Text -> PlotConfig -> DataFrame -> IO HtmlPlot
Text -> Text -> Text -> PlotConfig -> DataFrame -> IO HtmlPlot
plotScatterByWith Text
xCol Text
yCol Text
grouping (PlotType -> PlotConfig
defaultPlotConfig PlotType
Scatter)

plotScatterByWith ::
    (HasCallStack) =>
    T.Text -> T.Text -> T.Text -> PlotConfig -> DataFrame -> IO HtmlPlot
plotScatterByWith :: HasCallStack =>
Text -> Text -> Text -> PlotConfig -> DataFrame -> IO HtmlPlot
plotScatterByWith Text
xCol Text
yCol Text
grouping PlotConfig
config DataFrame
df = do
    Text
chartId <- IO Text
generateChartId
    let vals :: [Text]
vals = HasCallStack => Text -> DataFrame -> [Text]
Text -> DataFrame -> [Text]
extractStringColumn Text
grouping DataFrame
df
        df' :: DataFrame
df' = Text -> Column -> DataFrame -> DataFrame
insertColumn Text
grouping ([Text] -> Column
forall a.
(Columnable a, ColumnifyRep (KindOf a) a) =>
[a] -> Column
D.fromList [Text]
vals) DataFrame
df
        uniqueVals :: [Text]
uniqueVals = [Text] -> [Text]
forall a. Eq a => [a] -> [a]
L.nub [Text]
vals

        colors :: [Text]
colors =
            [Text] -> [Text]
forall a. HasCallStack => [a] -> [a]
cycle
                [ Text
"rgb(255, 99, 132)"
                , Text
"rgb(54, 162, 235)"
                , Text
"rgb(255, 206, 86)"
                , Text
"rgb(75, 192, 192)"
                , Text
"rgb(153, 102, 255)"
                , Text
"rgb(255, 159, 64)"
                ]

    [Text]
datasets <- [(Text, Text)] -> ((Text, Text) -> IO Text) -> IO [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM ([Text] -> [Text] -> [(Text, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
uniqueVals [Text]
colors) (((Text, Text) -> IO Text) -> IO [Text])
-> ((Text, Text) -> IO Text) -> IO [Text]
forall a b. (a -> b) -> a -> b
$ \(Text
val, Text
color) -> do
        let filtered :: DataFrame
filtered = Text -> (Text -> Bool) -> DataFrame -> DataFrame
forall a.
Columnable a =>
Text -> (a -> Bool) -> DataFrame -> DataFrame
D.filter Text
grouping (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
val) DataFrame
df'
            xVals :: [Double]
xVals = HasCallStack => Text -> DataFrame -> [Double]
Text -> DataFrame -> [Double]
extractNumericColumn Text
xCol DataFrame
filtered
            yVals :: [Double]
yVals = HasCallStack => Text -> DataFrame -> [Double]
Text -> DataFrame -> [Double]
extractNumericColumn Text
yCol DataFrame
filtered
            points :: [(Double, Double)]
points = [Double] -> [Double] -> [(Double, Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Double]
xVals [Double]
yVals
            dataPoints :: Text
dataPoints =
                Text -> [Text] -> Text
T.intercalate
                    Text
","
                    [ Text
"{x:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Double -> String
forall a. Show a => a -> String
show Double
x) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", y:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Double -> String
forall a. Show a => a -> String
show Double
y) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}" | (Double
x, Double
y) <- [(Double, Double)]
points
                    ]
        Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> IO Text) -> Text -> IO Text
forall a b. (a -> b) -> a -> b
$
            [Text] -> Text
T.concat
                [ Text
"    {\n"
                , Text
"      label: \""
                , Text
val
                , Text
"\",\n"
                , Text
"      data: ["
                , Text
dataPoints
                , Text
"],\n"
                , Text
"      pointRadius: 4,\n"
                , Text
"      pointBackgroundColor: \""
                , Text
color
                , Text
"\"\n"
                , Text
"    }"
                ]

    let datasetsStr :: Text
datasetsStr = Text -> [Text] -> Text
T.intercalate Text
",\n" [Text]
datasets
        chartTitle :: Text
chartTitle =
            if Text -> Bool
T.null (PlotConfig -> Text
plotTitle PlotConfig
config)
                then Text
xCol Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" vs " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
yCol Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" by " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
grouping
                else PlotConfig -> Text
plotTitle PlotConfig
config

        jsCode :: Text
jsCode =
            [Text] -> Text
T.concat
                [ Text
"new Chart(\""
                , Text
chartId
                , Text
"\", {\n"
                , Text
"  type: \"scatter\",\n"
                , Text
"  data: {\n"
                , Text
"    datasets: [\n"
                , Text
datasetsStr
                , Text
"\n    ]\n"
                , Text
"  },\n"
                , Text
"  options: {\n"
                , Text
"    title: { display: true, text: \""
                , Text
chartTitle
                , Text
"\" },\n"
                , Text
"    scales: {\n"
                , Text
"      xAxes: [{ scaleLabel: { display: true, labelString: \""
                , Text
xCol
                , Text
"\" } }],\n"
                , Text
"      yAxes: [{ scaleLabel: { display: true, labelString: \""
                , Text
yCol
                , Text
"\" } }]\n"
                , Text
"    }\n"
                , Text
"  }\n"
                , Text
"});"
                ]

    HtmlPlot -> IO HtmlPlot
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (HtmlPlot -> IO HtmlPlot) -> HtmlPlot -> IO HtmlPlot
forall a b. (a -> b) -> a -> b
$
        Text -> HtmlPlot
HtmlPlot (Text -> HtmlPlot) -> Text -> HtmlPlot
forall a b. (a -> b) -> a -> b
$
            Text -> Text -> Int -> Int -> Text
wrapInHTML Text
chartId Text
jsCode (PlotConfig -> Int
plotWidth PlotConfig
config) (PlotConfig -> Int
plotHeight PlotConfig
config)

plotLines :: (HasCallStack) => T.Text -> [T.Text] -> DataFrame -> IO HtmlPlot
plotLines :: HasCallStack => Text -> [Text] -> DataFrame -> IO HtmlPlot
plotLines Text
xAxis [Text]
colNames = HasCallStack =>
Text -> [Text] -> PlotConfig -> DataFrame -> IO HtmlPlot
Text -> [Text] -> PlotConfig -> DataFrame -> IO HtmlPlot
plotLinesWith Text
xAxis [Text]
colNames (PlotType -> PlotConfig
defaultPlotConfig PlotType
Line)

plotLinesWith ::
    (HasCallStack) => T.Text -> [T.Text] -> PlotConfig -> DataFrame -> IO HtmlPlot
plotLinesWith :: HasCallStack =>
Text -> [Text] -> PlotConfig -> DataFrame -> IO HtmlPlot
plotLinesWith Text
xAxis [Text]
colNames PlotConfig
config DataFrame
df = do
    Text
chartId <- IO Text
generateChartId
    let xValues :: [Double]
xValues = HasCallStack => Text -> DataFrame -> [Double]
Text -> DataFrame -> [Double]
extractNumericColumn Text
xAxis DataFrame
df
        labels :: Text
labels = Text -> [Text] -> Text
T.intercalate Text
"," [String -> Text
T.pack (Double -> String
forall a. Show a => a -> String
show Double
x) | Double
x <- [Double]
xValues]

        colors :: [Text]
colors =
            [Text] -> [Text]
forall a. HasCallStack => [a] -> [a]
cycle
                [ Text
"rgb(255, 99, 132)"
                , Text
"rgb(54, 162, 235)"
                , Text
"rgb(255, 206, 86)"
                , Text
"rgb(75, 192, 192)"
                , Text
"rgb(153, 102, 255)"
                , Text
"rgb(255, 159, 64)"
                ]

    [Text]
datasets <- [(Text, Text)] -> ((Text, Text) -> IO Text) -> IO [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM ([Text] -> [Text] -> [(Text, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
colNames [Text]
colors) (((Text, Text) -> IO Text) -> IO [Text])
-> ((Text, Text) -> IO Text) -> IO [Text]
forall a b. (a -> b) -> a -> b
$ \(Text
col, Text
color) -> do
        let values :: [Double]
values = HasCallStack => Text -> DataFrame -> [Double]
Text -> DataFrame -> [Double]
extractNumericColumn Text
col DataFrame
df
            dataPoints :: Text
dataPoints = Text -> [Text] -> Text
T.intercalate Text
"," [String -> Text
T.pack (Double -> String
forall a. Show a => a -> String
show Double
v) | Double
v <- [Double]
values]
        Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> IO Text) -> Text -> IO Text
forall a b. (a -> b) -> a -> b
$
            [Text] -> Text
T.concat
                [ Text
"    {\n"
                , Text
"      label: \""
                , Text
col
                , Text
"\",\n"
                , Text
"      data: ["
                , Text
dataPoints
                , Text
"],\n"
                , Text
"      fill: false,\n"
                , Text
"      borderColor: \""
                , Text
color
                , Text
"\",\n"
                , Text
"      tension: 0.1\n"
                , Text
"    }"
                ]

    let datasetsStr :: Text
datasetsStr = Text -> [Text] -> Text
T.intercalate Text
",\n" [Text]
datasets
        chartTitle :: Text
chartTitle = if Text -> Bool
T.null (PlotConfig -> Text
plotTitle PlotConfig
config) then Text
"Line Chart" else PlotConfig -> Text
plotTitle PlotConfig
config

        jsCode :: Text
jsCode =
            [Text] -> Text
T.concat
                [ Text
"new Chart(\""
                , Text
chartId
                , Text
"\", {\n"
                , Text
"  type: \"line\",\n"
                , Text
"  data: {\n"
                , Text
"    labels: ["
                , Text
labels
                , Text
"],\n"
                , Text
"    datasets: [\n"
                , Text
datasetsStr
                , Text
"\n    ]\n"
                , Text
"  },\n"
                , Text
"  options: {\n"
                , Text
"    title: { display: true, text: \""
                , Text
chartTitle
                , Text
"\" },\n"
                , Text
"    scales: {\n"
                , Text
"      xAxes: [{ scaleLabel: { display: true, labelString: \""
                , Text
xAxis
                , Text
"\" } }]\n"
                , Text
"    }\n"
                , Text
"  }\n"
                , Text
"});"
                ]

    HtmlPlot -> IO HtmlPlot
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (HtmlPlot -> IO HtmlPlot) -> HtmlPlot -> IO HtmlPlot
forall a b. (a -> b) -> a -> b
$
        Text -> HtmlPlot
HtmlPlot (Text -> HtmlPlot) -> Text -> HtmlPlot
forall a b. (a -> b) -> a -> b
$
            Text -> Text -> Int -> Int -> Text
wrapInHTML Text
chartId Text
jsCode (PlotConfig -> Int
plotWidth PlotConfig
config) (PlotConfig -> Int
plotHeight PlotConfig
config)

plotBars :: (HasCallStack) => T.Text -> DataFrame -> IO HtmlPlot
plotBars :: HasCallStack => Text -> DataFrame -> IO HtmlPlot
plotBars Text
colName = HasCallStack =>
Text -> Maybe Text -> PlotConfig -> DataFrame -> IO HtmlPlot
Text -> Maybe Text -> PlotConfig -> DataFrame -> IO HtmlPlot
plotBarsWith Text
colName Maybe Text
forall a. Maybe a
Nothing (PlotType -> PlotConfig
defaultPlotConfig PlotType
Bar)

plotBarsWith ::
    (HasCallStack) =>
    T.Text -> Maybe T.Text -> PlotConfig -> DataFrame -> IO HtmlPlot
plotBarsWith :: HasCallStack =>
Text -> Maybe Text -> PlotConfig -> DataFrame -> IO HtmlPlot
plotBarsWith Text
colName Maybe Text
groupByCol PlotConfig
config DataFrame
df =
    case Maybe Text
groupByCol of
        Maybe Text
Nothing -> HasCallStack => Text -> PlotConfig -> DataFrame -> IO HtmlPlot
Text -> PlotConfig -> DataFrame -> IO HtmlPlot
plotSingleBars Text
colName PlotConfig
config DataFrame
df
        Just Text
grpCol -> HasCallStack =>
Text -> Text -> PlotConfig -> DataFrame -> IO HtmlPlot
Text -> Text -> PlotConfig -> DataFrame -> IO HtmlPlot
plotGroupedBarsWith Text
grpCol Text
colName PlotConfig
config DataFrame
df

plotSingleBars ::
    (HasCallStack) => T.Text -> PlotConfig -> DataFrame -> IO HtmlPlot
plotSingleBars :: HasCallStack => Text -> PlotConfig -> DataFrame -> IO HtmlPlot
plotSingleBars Text
colName PlotConfig
config DataFrame
df = do
    Text
chartId <- IO Text
generateChartId
    let barData :: Maybe [(Text, Double)]
barData = HasCallStack => Text -> DataFrame -> Maybe [(Text, Double)]
Text -> DataFrame -> Maybe [(Text, Double)]
getCategoricalCounts Text
colName DataFrame
df
    case Maybe [(Text, Double)]
barData of
        Just [(Text, Double)]
counts -> do
            let grouped :: [(Text, Double)]
grouped = Int -> [(Text, Double)] -> [(Text, Double)]
groupWithOther Int
10 [(Text, Double)]
counts
                labels :: Text
labels = Text -> [Text] -> Text
T.intercalate Text
"," [Text
"\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
label Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\"" | (Text
label, Double
_) <- [(Text, Double)]
grouped]
                dataPoints :: Text
dataPoints = Text -> [Text] -> Text
T.intercalate Text
"," [String -> Text
T.pack (Double -> String
forall a. Show a => a -> String
show Double
val) | (Text
_, Double
val) <- [(Text, Double)]
grouped]
                chartTitle :: Text
chartTitle = if Text -> Bool
T.null (PlotConfig -> Text
plotTitle PlotConfig
config) then Text
colName else PlotConfig -> Text
plotTitle PlotConfig
config

                jsCode :: Text
jsCode =
                    [Text] -> Text
T.concat
                        [ Text
"new Chart(\""
                        , Text
chartId
                        , Text
"\", {\n"
                        , Text
"  type: \"bar\",\n"
                        , Text
"  data: {\n"
                        , Text
"    labels: ["
                        , Text
labels
                        , Text
"],\n"
                        , Text
"    datasets: [{\n"
                        , Text
"      label: \"Count\",\n"
                        , Text
"      data: ["
                        , Text
dataPoints
                        , Text
"],\n"
                        , Text
"      backgroundColor: \"rgba(54, 162, 235, 0.6)\",\n"
                        , Text
"      borderColor: \"rgba(54, 162, 235, 1)\",\n"
                        , Text
"      borderWidth: 1\n"
                        , Text
"    }]\n"
                        , Text
"  },\n"
                        , Text
"  options: {\n"
                        , Text
"    title: { display: true, text: \""
                        , Text
chartTitle
                        , Text
"\" },\n"
                        , Text
"    scales: {\n"
                        , Text
"      yAxes: [{ ticks: { beginAtZero: true } }]\n"
                        , Text
"    }\n"
                        , Text
"  }\n"
                        , Text
"});"
                        ]
            HtmlPlot -> IO HtmlPlot
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (HtmlPlot -> IO HtmlPlot) -> HtmlPlot -> IO HtmlPlot
forall a b. (a -> b) -> a -> b
$
                Text -> HtmlPlot
HtmlPlot (Text -> HtmlPlot) -> Text -> HtmlPlot
forall a b. (a -> b) -> a -> b
$
                    Text -> Text -> Int -> Int -> Text
wrapInHTML Text
chartId Text
jsCode (PlotConfig -> Int
plotWidth PlotConfig
config) (PlotConfig -> Int
plotHeight PlotConfig
config)
        Maybe [(Text, Double)]
Nothing -> do
            let values :: [Double]
values = HasCallStack => Text -> DataFrame -> [Double]
Text -> DataFrame -> [Double]
extractNumericColumn Text
colName DataFrame
df
                labels' :: [Text]
labels' =
                    if [Double] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Double]
values Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
20
                        then Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
take Int
20 [Text
"Item " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Integer -> String
forall a. Show a => a -> String
show Integer
i) | Integer
i <- [Integer
1 ..]]
                        else [Text
"Item " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
i) | Int
i <- [Int
1 .. [Double] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Double]
values]]
                vals :: [Double]
vals = if [Double] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Double]
values Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
20 then Int -> [Double] -> [Double]
forall a. Int -> [a] -> [a]
take Int
20 [Double]
values else [Double]
values
                labels :: Text
labels = Text -> [Text] -> Text
T.intercalate Text
"," [Text
"\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
label Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\"" | Text
label <- [Text]
labels']
                dataPoints :: Text
dataPoints = Text -> [Text] -> Text
T.intercalate Text
"," [String -> Text
T.pack (Double -> String
forall a. Show a => a -> String
show Double
val) | Double
val <- [Double]
vals]
                chartTitle :: Text
chartTitle = if Text -> Bool
T.null (PlotConfig -> Text
plotTitle PlotConfig
config) then Text
colName else PlotConfig -> Text
plotTitle PlotConfig
config

                jsCode :: Text
jsCode =
                    [Text] -> Text
T.concat
                        [ Text
"new Chart(\""
                        , Text
chartId
                        , Text
"\", {\n"
                        , Text
"  type: \"bar\",\n"
                        , Text
"  data: {\n"
                        , Text
"    labels: ["
                        , Text
labels
                        , Text
"],\n"
                        , Text
"    datasets: [{\n"
                        , Text
"      label: \"Value\",\n"
                        , Text
"      data: ["
                        , Text
dataPoints
                        , Text
"],\n"
                        , Text
"      backgroundColor: \"rgba(54, 162, 235, 0.6)\",\n"
                        , Text
"      borderColor: \"rgba(54, 162, 235, 1)\",\n"
                        , Text
"      borderWidth: 1\n"
                        , Text
"    }]\n"
                        , Text
"  },\n"
                        , Text
"  options: {\n"
                        , Text
"    title: { display: true, text: \""
                        , Text
chartTitle
                        , Text
"\" },\n"
                        , Text
"    scales: {\n"
                        , Text
"      yAxes: [{ ticks: { beginAtZero: true } }]\n"
                        , Text
"    }\n"
                        , Text
"  }\n"
                        , Text
"});"
                        ]
            HtmlPlot -> IO HtmlPlot
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (HtmlPlot -> IO HtmlPlot) -> HtmlPlot -> IO HtmlPlot
forall a b. (a -> b) -> a -> b
$
                Text -> HtmlPlot
HtmlPlot (Text -> HtmlPlot) -> Text -> HtmlPlot
forall a b. (a -> b) -> a -> b
$
                    Text -> Text -> Int -> Int -> Text
wrapInHTML Text
chartId Text
jsCode (PlotConfig -> Int
plotWidth PlotConfig
config) (PlotConfig -> Int
plotHeight PlotConfig
config)

plotPie :: (HasCallStack) => T.Text -> Maybe T.Text -> DataFrame -> IO HtmlPlot
plotPie :: HasCallStack => Text -> Maybe Text -> DataFrame -> IO HtmlPlot
plotPie Text
valCol Maybe Text
labelCol = HasCallStack =>
Text -> Maybe Text -> PlotConfig -> DataFrame -> IO HtmlPlot
Text -> Maybe Text -> PlotConfig -> DataFrame -> IO HtmlPlot
plotPieWith Text
valCol Maybe Text
labelCol (PlotType -> PlotConfig
defaultPlotConfig PlotType
Pie)

plotPieWith ::
    (HasCallStack) =>
    T.Text -> Maybe T.Text -> PlotConfig -> DataFrame -> IO HtmlPlot
plotPieWith :: HasCallStack =>
Text -> Maybe Text -> PlotConfig -> DataFrame -> IO HtmlPlot
plotPieWith Text
valCol Maybe Text
labelCol PlotConfig
config DataFrame
df = do
    Text
chartId <- IO Text
generateChartId
    let categoricalData :: Maybe [(Text, Double)]
categoricalData = HasCallStack => Text -> DataFrame -> Maybe [(Text, Double)]
Text -> DataFrame -> Maybe [(Text, Double)]
getCategoricalCounts Text
valCol DataFrame
df
    case Maybe [(Text, Double)]
categoricalData of
        Just [(Text, Double)]
counts -> do
            let grouped :: [(Text, Double)]
grouped = Int -> [(Text, Double)] -> [(Text, Double)]
groupWithOtherForPie Int
8 [(Text, Double)]
counts
                labels :: Text
labels = Text -> [Text] -> Text
T.intercalate Text
"," [Text
"\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
label Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\"" | (Text
label, Double
_) <- [(Text, Double)]
grouped]
                dataPoints :: Text
dataPoints = Text -> [Text] -> Text
T.intercalate Text
"," [String -> Text
T.pack (Double -> String
forall a. Show a => a -> String
show Double
val) | (Text
_, Double
val) <- [(Text, Double)]
grouped]
                colors :: Text
colors = Text -> [Text] -> Text
T.intercalate Text
"," [Text
"\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\"" | Text
c <- Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
take ([(Text, Double)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Text, Double)]
grouped) [Text]
pieColors]
                chartTitle :: Text
chartTitle = if Text -> Bool
T.null (PlotConfig -> Text
plotTitle PlotConfig
config) then Text
valCol else PlotConfig -> Text
plotTitle PlotConfig
config

                jsCode :: Text
jsCode =
                    [Text] -> Text
T.concat
                        [ Text
"new Chart(\""
                        , Text
chartId
                        , Text
"\", {\n"
                        , Text
"  type: \"pie\",\n"
                        , Text
"  data: {\n"
                        , Text
"    labels: ["
                        , Text
labels
                        , Text
"],\n"
                        , Text
"    datasets: [{\n"
                        , Text
"      data: ["
                        , Text
dataPoints
                        , Text
"],\n"
                        , Text
"      backgroundColor: ["
                        , Text
colors
                        , Text
"]\n"
                        , Text
"    }]\n"
                        , Text
"  },\n"
                        , Text
"  options: {\n"
                        , Text
"    title: { display: true, text: \""
                        , Text
chartTitle
                        , Text
"\" }\n"
                        , Text
"  }\n"
                        , Text
"});"
                        ]
            HtmlPlot -> IO HtmlPlot
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (HtmlPlot -> IO HtmlPlot) -> HtmlPlot -> IO HtmlPlot
forall a b. (a -> b) -> a -> b
$
                Text -> HtmlPlot
HtmlPlot (Text -> HtmlPlot) -> Text -> HtmlPlot
forall a b. (a -> b) -> a -> b
$
                    Text -> Text -> Int -> Int -> Text
wrapInHTML Text
chartId Text
jsCode (PlotConfig -> Int
plotWidth PlotConfig
config) (PlotConfig -> Int
plotHeight PlotConfig
config)
        Maybe [(Text, Double)]
Nothing -> do
            let values :: [Double]
values = HasCallStack => Text -> DataFrame -> [Double]
Text -> DataFrame -> [Double]
extractNumericColumn Text
valCol DataFrame
df
                labels' :: [Text]
labels' = case Maybe Text
labelCol of
                    Maybe Text
Nothing -> (Int -> Text) -> [Int] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
i -> Text
"Item " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
i)) [Int
1 .. [Double] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Double]
values]
                    Just Text
lCol -> HasCallStack => Text -> DataFrame -> [Text]
Text -> DataFrame -> [Text]
extractStringColumn Text
lCol DataFrame
df
                pieData :: [(Text, Double)]
pieData = [Text] -> [Double] -> [(Text, Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
labels' [Double]
values
                grouped :: [(Text, Double)]
grouped =
                    if [(Text, Double)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Text, Double)]
pieData Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10
                        then Int -> [(Text, Double)] -> [(Text, Double)]
groupWithOtherForPie Int
8 [(Text, Double)]
pieData
                        else [(Text, Double)]
pieData
                labels :: Text
labels = Text -> [Text] -> Text
T.intercalate Text
"," [Text
"\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
label Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\"" | (Text
label, Double
_) <- [(Text, Double)]
grouped]
                dataPoints :: Text
dataPoints = Text -> [Text] -> Text
T.intercalate Text
"," [String -> Text
T.pack (Double -> String
forall a. Show a => a -> String
show Double
val) | (Text
_, Double
val) <- [(Text, Double)]
grouped]
                colors :: Text
colors = Text -> [Text] -> Text
T.intercalate Text
"," [Text
"\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\"" | Text
c <- Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
take ([(Text, Double)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Text, Double)]
grouped) [Text]
pieColors]
                chartTitle :: Text
chartTitle = if Text -> Bool
T.null (PlotConfig -> Text
plotTitle PlotConfig
config) then Text
valCol else PlotConfig -> Text
plotTitle PlotConfig
config

                jsCode :: Text
jsCode =
                    [Text] -> Text
T.concat
                        [ Text
"new Chart(\""
                        , Text
chartId
                        , Text
"\", {\n"
                        , Text
"  type: \"pie\",\n"
                        , Text
"  data: {\n"
                        , Text
"    labels: ["
                        , Text
labels
                        , Text
"],\n"
                        , Text
"    datasets: [{\n"
                        , Text
"      data: ["
                        , Text
dataPoints
                        , Text
"],\n"
                        , Text
"      backgroundColor: ["
                        , Text
colors
                        , Text
"]\n"
                        , Text
"    }]\n"
                        , Text
"  },\n"
                        , Text
"  options: {\n"
                        , Text
"    title: { display: true, text: \""
                        , Text
chartTitle
                        , Text
"\" }\n"
                        , Text
"  }\n"
                        , Text
"});"
                        ]
            HtmlPlot -> IO HtmlPlot
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (HtmlPlot -> IO HtmlPlot) -> HtmlPlot -> IO HtmlPlot
forall a b. (a -> b) -> a -> b
$
                Text -> HtmlPlot
HtmlPlot (Text -> HtmlPlot) -> Text -> HtmlPlot
forall a b. (a -> b) -> a -> b
$
                    Text -> Text -> Int -> Int -> Text
wrapInHTML Text
chartId Text
jsCode (PlotConfig -> Int
plotWidth PlotConfig
config) (PlotConfig -> Int
plotHeight PlotConfig
config)

pieColors :: [T.Text]
pieColors :: [Text]
pieColors =
    [ Text
"rgb(255, 99, 132)"
    , Text
"rgb(54, 162, 235)"
    , Text
"rgb(255, 206, 86)"
    , Text
"rgb(75, 192, 192)"
    , Text
"rgb(153, 102, 255)"
    , Text
"rgb(255, 159, 64)"
    , Text
"rgb(201, 203, 207)"
    , Text
"rgb(255, 99, 71)"
    , Text
"rgb(60, 179, 113)"
    , Text
"rgb(238, 130, 238)"
    ]

plotStackedBars ::
    (HasCallStack) => T.Text -> [T.Text] -> DataFrame -> IO HtmlPlot
plotStackedBars :: HasCallStack => Text -> [Text] -> DataFrame -> IO HtmlPlot
plotStackedBars Text
categoryCol [Text]
valueColumns = HasCallStack =>
Text -> [Text] -> PlotConfig -> DataFrame -> IO HtmlPlot
Text -> [Text] -> PlotConfig -> DataFrame -> IO HtmlPlot
plotStackedBarsWith Text
categoryCol [Text]
valueColumns (PlotType -> PlotConfig
defaultPlotConfig PlotType
StackedBar)

plotStackedBarsWith ::
    (HasCallStack) => T.Text -> [T.Text] -> PlotConfig -> DataFrame -> IO HtmlPlot
plotStackedBarsWith :: HasCallStack =>
Text -> [Text] -> PlotConfig -> DataFrame -> IO HtmlPlot
plotStackedBarsWith Text
categoryCol [Text]
valueColumns PlotConfig
config DataFrame
df = do
    Text
chartId <- IO Text
generateChartId
    let categories :: [Text]
categories = HasCallStack => Text -> DataFrame -> [Text]
Text -> DataFrame -> [Text]
extractStringColumn Text
categoryCol DataFrame
df
        uniqueCategories :: [Text]
uniqueCategories = [Text] -> [Text]
forall a. Eq a => [a] -> [a]
L.nub [Text]
categories

        colors :: [Text]
colors =
            [Text] -> [Text]
forall a. HasCallStack => [a] -> [a]
cycle
                [ Text
"rgb(255, 99, 132)"
                , Text
"rgb(54, 162, 235)"
                , Text
"rgb(255, 206, 86)"
                , Text
"rgb(75, 192, 192)"
                , Text
"rgb(153, 102, 255)"
                , Text
"rgb(255, 159, 64)"
                ]

    [Text]
datasets <- [(Text, Text)] -> ((Text, Text) -> IO Text) -> IO [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM ([Text] -> [Text] -> [(Text, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
valueColumns [Text]
colors) (((Text, Text) -> IO Text) -> IO [Text])
-> ((Text, Text) -> IO Text) -> IO [Text]
forall a b. (a -> b) -> a -> b
$ \(Text
col, Text
color) -> do
        [Double]
dataVals <- [Text] -> (Text -> IO Double) -> IO [Double]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Text]
uniqueCategories ((Text -> IO Double) -> IO [Double])
-> (Text -> IO Double) -> IO [Double]
forall a b. (a -> b) -> a -> b
$ \Text
cat -> do
            let indices :: [Int]
indices = [Int
i | (Int
i, Text
c) <- [Int] -> [Text] -> [(Int, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 ..] [Text]
categories, Text
c Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
cat]
                allValues :: [Double]
allValues = HasCallStack => Text -> DataFrame -> [Double]
Text -> DataFrame -> [Double]
extractNumericColumn Text
col DataFrame
df
                values :: [Double]
values = [[Double]
allValues [Double] -> Int -> Double
forall a. HasCallStack => [a] -> Int -> a
!! Int
i | Int
i <- [Int]
indices, Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< [Double] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Double]
allValues]
            Double -> IO Double
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> IO Double) -> Double -> IO Double
forall a b. (a -> b) -> a -> b
$ [Double] -> Double
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Double]
values
        let dataPoints :: Text
dataPoints = Text -> [Text] -> Text
T.intercalate Text
"," [String -> Text
T.pack (Double -> String
forall a. Show a => a -> String
show Double
v) | Double
v <- [Double]
dataVals]
        Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> IO Text) -> Text -> IO Text
forall a b. (a -> b) -> a -> b
$
            [Text] -> Text
T.concat
                [ Text
"    {\n"
                , Text
"      label: \""
                , Text
col
                , Text
"\",\n"
                , Text
"      data: ["
                , Text
dataPoints
                , Text
"],\n"
                , Text
"      backgroundColor: \""
                , Text
color
                , Text
"\"\n"
                , Text
"    }"
                ]

    let datasetsStr :: Text
datasetsStr = Text -> [Text] -> Text
T.intercalate Text
",\n" [Text]
datasets
        labels :: Text
labels = Text -> [Text] -> Text
T.intercalate Text
"," [Text
"\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
cat Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\"" | Text
cat <- [Text]
uniqueCategories]
        chartTitle :: Text
chartTitle = if Text -> Bool
T.null (PlotConfig -> Text
plotTitle PlotConfig
config) then Text
"Stacked Bar Chart" else PlotConfig -> Text
plotTitle PlotConfig
config

        jsCode :: Text
jsCode =
            [Text] -> Text
T.concat
                [ Text
"new Chart(\""
                , Text
chartId
                , Text
"\", {\n"
                , Text
"  type: \"bar\",\n"
                , Text
"  data: {\n"
                , Text
"    labels: ["
                , Text
labels
                , Text
"],\n"
                , Text
"    datasets: [\n"
                , Text
datasetsStr
                , Text
"\n    ]\n"
                , Text
"  },\n"
                , Text
"  options: {\n"
                , Text
"    title: { display: true, text: \""
                , Text
chartTitle
                , Text
"\" },\n"
                , Text
"    scales: {\n"
                , Text
"      xAxes: [{ stacked: true }],\n"
                , Text
"      yAxes: [{ stacked: true, ticks: { beginAtZero: true } }]\n"
                , Text
"    }\n"
                , Text
"  }\n"
                , Text
"});"
                ]

    HtmlPlot -> IO HtmlPlot
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (HtmlPlot -> IO HtmlPlot) -> HtmlPlot -> IO HtmlPlot
forall a b. (a -> b) -> a -> b
$
        Text -> HtmlPlot
HtmlPlot (Text -> HtmlPlot) -> Text -> HtmlPlot
forall a b. (a -> b) -> a -> b
$
            Text -> Text -> Int -> Int -> Text
wrapInHTML Text
chartId Text
jsCode (PlotConfig -> Int
plotWidth PlotConfig
config) (PlotConfig -> Int
plotHeight PlotConfig
config)

plotBoxPlots :: (HasCallStack) => [T.Text] -> DataFrame -> IO HtmlPlot
plotBoxPlots :: HasCallStack => [Text] -> DataFrame -> IO HtmlPlot
plotBoxPlots [Text]
colNames = HasCallStack => [Text] -> PlotConfig -> DataFrame -> IO HtmlPlot
[Text] -> PlotConfig -> DataFrame -> IO HtmlPlot
plotBoxPlotsWith [Text]
colNames (PlotType -> PlotConfig
defaultPlotConfig PlotType
BoxPlot)

plotBoxPlotsWith ::
    (HasCallStack) => [T.Text] -> PlotConfig -> DataFrame -> IO HtmlPlot
plotBoxPlotsWith :: HasCallStack => [Text] -> PlotConfig -> DataFrame -> IO HtmlPlot
plotBoxPlotsWith [Text]
colNames PlotConfig
config DataFrame
df = do
    Text
chartId <- IO Text
generateChartId
    [(Text, Double, Double, Double, Double, Double)]
boxData <- [Text]
-> (Text -> IO (Text, Double, Double, Double, Double, Double))
-> IO [(Text, Double, Double, Double, Double, Double)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Text]
colNames ((Text -> IO (Text, Double, Double, Double, Double, Double))
 -> IO [(Text, Double, Double, Double, Double, Double)])
-> (Text -> IO (Text, Double, Double, Double, Double, Double))
-> IO [(Text, Double, Double, Double, Double, Double)]
forall a b. (a -> b) -> a -> b
$ \Text
col -> do
        let values :: [Double]
values = HasCallStack => Text -> DataFrame -> [Double]
Text -> DataFrame -> [Double]
extractNumericColumn Text
col DataFrame
df
            sorted :: [Double]
sorted = [Double] -> [Double]
forall a. Ord a => [a] -> [a]
L.sort [Double]
values
            n :: Int
n = [Double] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Double]
values
            q1 :: Double
q1 = [Double]
sorted [Double] -> Int -> Double
forall a. HasCallStack => [a] -> Int -> a
!! (Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
4)
            median :: Double
median = [Double]
sorted [Double] -> Int -> Double
forall a. HasCallStack => [a] -> Int -> a
!! (Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2)
            q3 :: Double
q3 = [Double]
sorted [Double] -> Int -> Double
forall a. HasCallStack => [a] -> Int -> a
!! (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)
            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
        (Text, Double, Double, Double, Double, Double)
-> IO (Text, Double, Double, Double, Double, Double)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
col, Double
minVal, Double
q1, Double
median, Double
q3, Double
maxVal)

    let labels :: Text
labels = Text -> [Text] -> Text
T.intercalate Text
"," [Text
"\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
col Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\"" | (Text
col, Double
_, Double
_, Double
_, Double
_, Double
_) <- [(Text, Double, Double, Double, Double, Double)]
boxData]
        medians :: Text
medians = Text -> [Text] -> Text
T.intercalate Text
"," [String -> Text
T.pack (Double -> String
forall a. Show a => a -> String
show Double
med) | (Text
_, Double
_, Double
_, Double
med, Double
_, Double
_) <- [(Text, Double, Double, Double, Double, Double)]
boxData]
        chartTitle :: Text
chartTitle = if Text -> Bool
T.null (PlotConfig -> Text
plotTitle PlotConfig
config) then Text
"Box Plot" else PlotConfig -> Text
plotTitle PlotConfig
config

        jsCode :: Text
jsCode =
            [Text] -> Text
T.concat
                [ Text
"new Chart(\""
                , Text
chartId
                , Text
"\", {\n"
                , Text
"  type: \"bar\",\n"
                , Text
"  data: {\n"
                , Text
"    labels: ["
                , Text
labels
                , Text
"],\n"
                , Text
"    datasets: [{\n"
                , Text
"      label: \"Median\",\n"
                , Text
"      data: ["
                , Text
medians
                , Text
"],\n"
                , Text
"      backgroundColor: \"rgba(75, 192, 192, 0.6)\",\n"
                , Text
"      borderColor: \"rgba(75, 192, 192, 1)\",\n"
                , Text
"      borderWidth: 1\n"
                , Text
"    }]\n"
                , Text
"  },\n"
                , Text
"  options: {\n"
                , Text
"    title: { display: true, text: \""
                , Text
chartTitle
                , Text
" (showing medians)\" },\n"
                , Text
"    scales: {\n"
                , Text
"      yAxes: [{ ticks: { beginAtZero: true } }]\n"
                , Text
"    }\n"
                , Text
"  }\n"
                , Text
"});"
                ]

    HtmlPlot -> IO HtmlPlot
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (HtmlPlot -> IO HtmlPlot) -> HtmlPlot -> IO HtmlPlot
forall a b. (a -> b) -> a -> b
$
        Text -> HtmlPlot
HtmlPlot (Text -> HtmlPlot) -> Text -> HtmlPlot
forall a b. (a -> b) -> a -> b
$
            Text -> Text -> Int -> Int -> Text
wrapInHTML Text
chartId Text
jsCode (PlotConfig -> Int
plotWidth PlotConfig
config) (PlotConfig -> Int
plotHeight PlotConfig
config)

plotGroupedBarsWith ::
    (HasCallStack) => T.Text -> T.Text -> PlotConfig -> DataFrame -> IO HtmlPlot
plotGroupedBarsWith :: HasCallStack =>
Text -> Text -> PlotConfig -> DataFrame -> IO HtmlPlot
plotGroupedBarsWith = HasCallStack =>
Int -> Text -> Text -> PlotConfig -> DataFrame -> IO HtmlPlot
Int -> Text -> Text -> PlotConfig -> DataFrame -> IO HtmlPlot
plotGroupedBarsWithN Int
10

plotGroupedBarsWithN ::
    (HasCallStack) =>
    Int -> T.Text -> T.Text -> PlotConfig -> DataFrame -> IO HtmlPlot
plotGroupedBarsWithN :: HasCallStack =>
Int -> Text -> Text -> PlotConfig -> DataFrame -> IO HtmlPlot
plotGroupedBarsWithN Int
n Text
groupCol Text
valCol PlotConfig
config DataFrame
df = do
    Text
chartId <- IO Text
generateChartId
    let colIsNumeric :: Bool
colIsNumeric = Text -> DataFrame -> Bool
isNumericColumnCheck Text
valCol DataFrame
df

    if Bool
colIsNumeric
        then do
            let groups :: [Text]
groups = HasCallStack => Text -> DataFrame -> [Text]
Text -> DataFrame -> [Text]
extractStringColumn Text
groupCol DataFrame
df
                values :: [Double]
values = HasCallStack => Text -> DataFrame -> [Double]
Text -> DataFrame -> [Double]
extractNumericColumn Text
valCol DataFrame
df
                m :: Map Text Double
m = (Double -> Double -> Double) -> [(Text, Double)] -> Map Text Double
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith Double -> Double -> Double
forall a. Num a => a -> a -> a
(+) ([Text] -> [Double] -> [(Text, Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
groups [Double]
values)
                grouped :: [(Text, Double)]
grouped = (Text -> (Text, Double)) -> [Text] -> [(Text, Double)]
forall a b. (a -> b) -> [a] -> [b]
map (\Text
v -> (Text
v, Map Text Double
m Map Text Double -> Text -> Double
forall k a. Ord k => Map k a -> k -> a
M.! Text
v)) [Text]
groups
                labels :: Text
labels = Text -> [Text] -> Text
T.intercalate Text
"," [Text
"\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
label Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\"" | (Text
label, Double
_) <- [(Text, Double)]
grouped]
                dataPoints :: Text
dataPoints = Text -> [Text] -> Text
T.intercalate Text
"," [String -> Text
T.pack (Double -> String
forall a. Show a => a -> String
show Double
val) | (Text
_, Double
val) <- [(Text, Double)]
grouped]
                chartTitle :: Text
chartTitle =
                    if Text -> Bool
T.null (PlotConfig -> Text
plotTitle PlotConfig
config)
                        then Text
groupCol Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" by " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
valCol
                        else PlotConfig -> Text
plotTitle PlotConfig
config

                jsCode :: Text
jsCode =
                    [Text] -> Text
T.concat
                        [ Text
"new Chart(\""
                        , Text
chartId
                        , Text
"\", {\n"
                        , Text
"  type: \"bar\",\n"
                        , Text
"  data: {\n"
                        , Text
"    labels: ["
                        , Text
labels
                        , Text
"],\n"
                        , Text
"    datasets: [{\n"
                        , Text
"      label: \""
                        , Text
valCol
                        , Text
"\",\n"
                        , Text
"      data: ["
                        , Text
dataPoints
                        , Text
"],\n"
                        , Text
"      backgroundColor: \"rgba(54, 162, 235, 0.6)\",\n"
                        , Text
"      borderColor: \"rgba(54, 162, 235, 1)\",\n"
                        , Text
"      borderWidth: 1\n"
                        , Text
"    }]\n"
                        , Text
"  },\n"
                        , Text
"  options: {\n"
                        , Text
"    title: { display: true, text: \""
                        , Text
chartTitle
                        , Text
"\" },\n"
                        , Text
"    scales: {\n"
                        , Text
"      yAxes: [{ ticks: { beginAtZero: true } }]\n"
                        , Text
"    }\n"
                        , Text
"  }\n"
                        , Text
"});"
                        ]
            HtmlPlot -> IO HtmlPlot
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (HtmlPlot -> IO HtmlPlot) -> HtmlPlot -> IO HtmlPlot
forall a b. (a -> b) -> a -> b
$
                Text -> HtmlPlot
HtmlPlot (Text -> HtmlPlot) -> Text -> HtmlPlot
forall a b. (a -> b) -> a -> b
$
                    Text -> Text -> Int -> Int -> Text
wrapInHTML Text
chartId Text
jsCode (PlotConfig -> Int
plotWidth PlotConfig
config) (PlotConfig -> Int
plotHeight PlotConfig
config)
        else do
            let groups :: [Text]
groups = HasCallStack => Text -> DataFrame -> [Text]
Text -> DataFrame -> [Text]
extractStringColumn Text
groupCol DataFrame
df
                vals :: [Text]
vals = HasCallStack => Text -> DataFrame -> [Text]
Text -> DataFrame -> [Text]
extractStringColumn Text
valCol DataFrame
df
                pairs :: [(Text, Text)]
pairs = [Text] -> [Text] -> [(Text, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
groups [Text]
vals
                counts :: [(Text, Integer)]
counts =
                    Map Text Integer -> [(Text, Integer)]
forall k a. Map k a -> [(k, a)]
M.toList (Map Text Integer -> [(Text, Integer)])
-> Map Text Integer -> [(Text, Integer)]
forall a b. (a -> b) -> a -> b
$
                        (Integer -> Integer -> Integer)
-> [(Text, Integer)] -> Map Text Integer
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith
                            Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(+)
                            [(Text
g Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" - " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
v, Integer
1) | (Text
g, Text
v) <- [(Text, Text)]
pairs]
                finalCounts :: [(Text, Double)]
finalCounts = Int -> [(Text, Double)] -> [(Text, Double)]
groupWithOther Int
n [(Text
k, Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
v) | (Text
k, Integer
v) <- [(Text, Integer)]
counts]
                labels :: Text
labels = Text -> [Text] -> Text
T.intercalate Text
"," [Text
"\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
label Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\"" | (Text
label, Double
_) <- [(Text, Double)]
finalCounts]
                dataPoints :: Text
dataPoints = Text -> [Text] -> Text
T.intercalate Text
"," [String -> Text
T.pack (Double -> String
forall a. Show a => a -> String
show Double
val) | (Text
_, Double
val) <- [(Text, Double)]
finalCounts]
                chartTitle :: Text
chartTitle =
                    if Text -> Bool
T.null (PlotConfig -> Text
plotTitle PlotConfig
config)
                        then Text
groupCol Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" by " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
valCol
                        else PlotConfig -> Text
plotTitle PlotConfig
config

                jsCode :: Text
jsCode =
                    [Text] -> Text
T.concat
                        [ Text
"new Chart(\""
                        , Text
chartId
                        , Text
"\", {\n"
                        , Text
"  type: \"bar\",\n"
                        , Text
"  data: {\n"
                        , Text
"    labels: ["
                        , Text
labels
                        , Text
"],\n"
                        , Text
"    datasets: [{\n"
                        , Text
"      label: \"Count\",\n"
                        , Text
"      data: ["
                        , Text
dataPoints
                        , Text
"],\n"
                        , Text
"      backgroundColor: \"rgba(54, 162, 235, 0.6)\",\n"
                        , Text
"      borderColor: \"rgba(54, 162, 235, 1)\",\n"
                        , Text
"      borderWidth: 1\n"
                        , Text
"    }]\n"
                        , Text
"  },\n"
                        , Text
"  options: {\n"
                        , Text
"    title: { display: true, text: \""
                        , Text
chartTitle
                        , Text
"\" },\n"
                        , Text
"    scales: {\n"
                        , Text
"      yAxes: [{ ticks: { beginAtZero: true } }]\n"
                        , Text
"    }\n"
                        , Text
"  }\n"
                        , Text
"});"
                        ]
            HtmlPlot -> IO HtmlPlot
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (HtmlPlot -> IO HtmlPlot) -> HtmlPlot -> IO HtmlPlot
forall a b. (a -> b) -> a -> b
$
                Text -> HtmlPlot
HtmlPlot (Text -> HtmlPlot) -> Text -> HtmlPlot
forall a b. (a -> b) -> a -> b
$
                    Text -> Text -> Int -> Int -> Text
wrapInHTML Text
chartId Text
jsCode (PlotConfig -> Int
plotWidth PlotConfig
config) (PlotConfig -> Int
plotHeight PlotConfig
config)

-- TODO: Move these helpers to a common module.

isNumericColumn :: DataFrame -> T.Text -> Bool
isNumericColumn :: DataFrame -> Text -> Bool
isNumericColumn DataFrame
df Text
colName = Bool -> (Column -> Bool) -> Maybe Column -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False Column -> Bool
isNumeric (Text -> DataFrame -> Maybe Column
getColumn Text
colName DataFrame
df)

isNumericColumnCheck :: T.Text -> DataFrame -> Bool
isNumericColumnCheck :: Text -> DataFrame -> Bool
isNumericColumnCheck Text
colName DataFrame
df = DataFrame -> Text -> Bool
isNumericColumn DataFrame
df Text
colName

extractStringColumn :: (HasCallStack) => T.Text -> DataFrame -> [T.Text]
extractStringColumn :: HasCallStack => Text -> DataFrame -> [Text]
extractStringColumn Text
colName DataFrame
df =
    case Text -> Map Text Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
colName (DataFrame -> Map Text Int
columnIndices DataFrame
df) of
        Maybe Int
Nothing -> String -> [Text]
forall a. HasCallStack => String -> a
error (String -> [Text]) -> String -> [Text]
forall a b. (a -> b) -> a -> b
$ String
"Column " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
colName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" not found"
        Just Int
idx ->
            let col :: Column
col = DataFrame -> Vector Column
columns DataFrame
df Vector Column -> Int -> Column
forall a. Vector a -> Int -> a
V.! Int
idx
             in case Column
col of
                    BoxedColumn (Vector a
vec :: V.Vector a) -> case 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 (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 @T.Text) of
                        Just a :~: Text
Refl -> Vector Text -> [Text]
forall a. Vector a -> [a]
V.toList Vector a
Vector Text
vec
                        Maybe (a :~: Text)
Nothing -> Vector Text -> [Text]
forall a. Vector a -> [a]
V.toList (Vector Text -> [Text]) -> Vector Text -> [Text]
forall a b. (a -> b) -> a -> b
$ (a -> Text) -> Vector a -> Vector Text
forall a b. (a -> b) -> Vector a -> Vector b
V.map (String -> Text
T.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show) Vector a
vec
                    UnboxedColumn Vector a
vec -> Vector Text -> [Text]
forall a. Vector a -> [a]
V.toList (Vector Text -> [Text]) -> Vector Text -> [Text]
forall a b. (a -> b) -> a -> b
$ (a -> Text) -> Vector a -> Vector Text
forall (v :: * -> *) a b.
(Vector v a, Vector v b) =>
(a -> b) -> v a -> v b
VG.map (String -> Text
T.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show) (Vector a -> Vector a
forall (v :: * -> *) a (w :: * -> *).
(Vector v a, Vector w a) =>
v a -> w a
VG.convert Vector a
vec)
                    OptionalColumn (Vector (Maybe a)
vec :: V.Vector (Maybe a)) -> case 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 (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 @T.Text) of
                        Maybe (a :~: Text)
Nothing -> Vector Text -> [Text]
forall a. Vector a -> [a]
V.toList (Vector Text -> [Text]) -> Vector Text -> [Text]
forall a b. (a -> b) -> a -> b
$ (Maybe a -> Text) -> Vector (Maybe a) -> Vector Text
forall a b. (a -> b) -> Vector a -> Vector b
V.map (String -> Text
T.pack (String -> Text) -> (Maybe a -> String) -> Maybe a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe a -> String
forall a. Show a => a -> String
show) Vector (Maybe a)
vec
                        Just a :~: Text
Refl -> Vector Text -> [Text]
forall a. Vector a -> [a]
V.toList (Vector Text -> [Text]) -> Vector Text -> [Text]
forall a b. (a -> b) -> a -> b
$ (Maybe Text -> Text) -> Vector (Maybe Text) -> Vector Text
forall a b. (a -> b) -> Vector a -> Vector b
V.map (Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"Nothing" (Text
"Just " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)) Vector (Maybe a)
Vector (Maybe Text)
vec

extractNumericColumn :: (HasCallStack) => T.Text -> DataFrame -> [Double]
extractNumericColumn :: HasCallStack => Text -> DataFrame -> [Double]
extractNumericColumn Text
colName DataFrame
df =
    case Text -> Map Text Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
colName (DataFrame -> Map Text Int
columnIndices DataFrame
df) of
        Maybe Int
Nothing -> String -> [Double]
forall a. HasCallStack => String -> a
error (String -> [Double]) -> String -> [Double]
forall a b. (a -> b) -> a -> b
$ String
"Column " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
colName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" not found"
        Just Int
idx ->
            let col :: Column
col = DataFrame -> Vector Column
columns DataFrame
df Vector Column -> Int -> Column
forall a. Vector a -> Int -> a
V.! Int
idx
             in case Column
col of
                    BoxedColumn Vector a
vec -> Vector a -> [Double]
forall a. (Typeable a, Show a) => Vector a -> [Double]
vectorToDoubles Vector a
vec
                    UnboxedColumn Vector a
vec -> Vector a -> [Double]
forall a. (Typeable a, Unbox a, Show a) => Vector a -> [Double]
unboxedVectorToDoubles Vector a
vec
                    Column
_ -> []

vectorToDoubles :: forall a. (Typeable a, Show a) => V.Vector a -> [Double]
vectorToDoubles :: forall a. (Typeable a, Show a) => Vector a -> [Double]
vectorToDoubles Vector a
vec =
    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 Double -> [Double]
forall a. Vector a -> [a]
V.toList Vector a
Vector Double
vec
        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 -> Vector Double -> [Double]
forall a. Vector a -> [a]
V.toList (Vector Double -> [Double]) -> Vector Double -> [Double]
forall a b. (a -> b) -> a -> b
$ (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
vec
            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 -> Vector Double -> [Double]
forall a. Vector a -> [a]
V.toList (Vector Double -> [Double]) -> Vector Double -> [Double]
forall a b. (a -> b) -> a -> b
$ (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
vec
                Maybe (a :~: Integer)
Nothing -> case TypeRep a -> TypeRep Float -> Maybe (a :~: Float)
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 @Float) of
                    Just a :~: Float
Refl -> Vector Double -> [Double]
forall a. Vector a -> [a]
V.toList (Vector Double -> [Double]) -> Vector Double -> [Double]
forall a b. (a -> b) -> a -> b
$ (a -> Double) -> Vector a -> Vector Double
forall a b. (a -> b) -> Vector a -> Vector b
V.map a -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Vector a
vec
                    Maybe (a :~: Float)
Nothing -> String -> [Double]
forall a. HasCallStack => String -> a
error (String -> [Double]) -> String -> [Double]
forall a b. (a -> b) -> a -> b
$ String
"Column is not numeric (type: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TypeRep a -> String
forall a. Show a => a -> String
show (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @a) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"

unboxedVectorToDoubles ::
    forall a. (Typeable a, VU.Unbox a, Show a) => VU.Vector a -> [Double]
unboxedVectorToDoubles :: forall a. (Typeable a, Unbox a, Show a) => Vector a -> [Double]
unboxedVectorToDoubles Vector a
vec =
    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 Double -> [Double]
forall a. Unbox a => Vector a -> [a]
VU.toList Vector a
Vector Double
vec
        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 -> Vector Double -> [Double]
forall a. Unbox a => Vector a -> [a]
VU.toList (Vector Double -> [Double]) -> Vector Double -> [Double]
forall a b. (a -> b) -> a -> b
$ (a -> Double) -> Vector a -> Vector Double
forall a b. (Unbox a, Unbox b) => (a -> b) -> Vector a -> Vector b
VU.map a -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Vector a
vec
            Maybe (a :~: Int)
Nothing -> case TypeRep a -> TypeRep Float -> Maybe (a :~: Float)
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 @Float) of
                Just a :~: Float
Refl -> Vector Double -> [Double]
forall a. Unbox a => Vector a -> [a]
VU.toList (Vector Double -> [Double]) -> Vector Double -> [Double]
forall a b. (a -> b) -> a -> b
$ (a -> Double) -> Vector a -> Vector Double
forall a b. (Unbox a, Unbox b) => (a -> b) -> Vector a -> Vector b
VU.map a -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac Vector a
vec
                Maybe (a :~: Float)
Nothing -> String -> [Double]
forall a. HasCallStack => String -> a
error (String -> [Double]) -> String -> [Double]
forall a b. (a -> b) -> a -> b
$ String
"Column is not numeric (type: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TypeRep a -> String
forall a. Show a => a -> String
show (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @a) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"

getCategoricalCounts ::
    (HasCallStack) => T.Text -> DataFrame -> Maybe [(T.Text, Double)]
getCategoricalCounts :: HasCallStack => Text -> DataFrame -> Maybe [(Text, Double)]
getCategoricalCounts Text
colName DataFrame
df =
    case Text -> Map Text Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
colName (DataFrame -> Map Text Int
columnIndices DataFrame
df) of
        Maybe Int
Nothing -> String -> Maybe [(Text, Double)]
forall a. HasCallStack => String -> a
error (String -> Maybe [(Text, Double)])
-> String -> Maybe [(Text, Double)]
forall a b. (a -> b) -> a -> b
$ String
"Column " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
colName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" not found"
        Just Int
idx ->
            let col :: Column
col = DataFrame -> Vector Column
columns DataFrame
df Vector Column -> Int -> Column
forall a. Vector a -> Int -> a
V.! Int
idx
             in case Column
col of
                    BoxedColumn (Vector a
vec :: V.Vector a) ->
                        let counts :: [(a, Int)]
counts = Vector a -> [(a, Int)]
forall a. (Ord a, Show a) => Vector a -> [(a, Int)]
countValues Vector a
vec
                         in case 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 (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 @T.Text) of
                                Maybe (a :~: Text)
Nothing -> [(Text, Double)] -> Maybe [(Text, Double)]
forall a. a -> Maybe a
Just [(String -> Text
T.pack (a -> String
forall a. Show a => a -> String
show a
k), Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
v) | (a
k, Int
v) <- [(a, Int)]
counts]
                                Just a :~: Text
Refl -> [(Text, Double)] -> Maybe [(Text, Double)]
forall a. a -> Maybe a
Just [(a
Text
k, Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
v) | (a
k, Int
v) <- [(a, Int)]
counts]
                    UnboxedColumn Vector a
vec ->
                        let counts :: [(a, Int)]
counts = Vector a -> [(a, Int)]
forall a. (Ord a, Show a, Unbox a) => Vector a -> [(a, Int)]
countValuesUnboxed Vector a
vec
                         in [(Text, Double)] -> Maybe [(Text, Double)]
forall a. a -> Maybe a
Just [(String -> Text
T.pack (a -> String
forall a. Show a => a -> String
show a
k), Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
v) | (a
k, Int
v) <- [(a, Int)]
counts]
                    OptionalColumn (Vector (Maybe a)
vec :: V.Vector (Maybe a)) ->
                        let counts :: [(Maybe a, Int)]
counts = Vector (Maybe a) -> [(Maybe a, Int)]
forall a. (Ord a, Show a) => Vector a -> [(a, Int)]
countValues Vector (Maybe a)
vec
                         in case 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 (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 @T.Text) of
                                Maybe (a :~: Text)
Nothing -> [(Text, Double)] -> Maybe [(Text, Double)]
forall a. a -> Maybe a
Just [((String -> Text
T.pack (String -> Text) -> (Maybe a -> String) -> Maybe a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe a -> String
forall a. Show a => a -> String
show) Maybe a
k, Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
v) | (Maybe a
k, Int
v) <- [(Maybe a, Int)]
counts]
                                Just a :~: Text
Refl ->
                                    [(Text, Double)] -> Maybe [(Text, Double)]
forall a. a -> Maybe a
Just
                                        [(Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"Nothing" (Text
"Just " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) Maybe a
Maybe Text
k, Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
v) | (Maybe a
k, Int
v) <- [(Maybe a, Int)]
counts]
  where
    countValues :: (Ord a, Show a) => V.Vector a -> [(a, Int)]
    countValues :: forall a. (Ord a, Show a) => Vector a -> [(a, Int)]
countValues Vector a
vec = 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 a b. (a -> b -> b) -> b -> Vector a -> b
V.foldr' (\a
x Map a Int
acc -> (Int -> Int -> Int) -> a -> Int -> Map a Int -> Map a Int
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) a
x Int
1 Map a Int
acc) Map a Int
forall k a. Map k a
M.empty Vector a
vec

    countValuesUnboxed :: (Ord a, Show a, VU.Unbox a) => VU.Vector a -> [(a, Int)]
    countValuesUnboxed :: forall a. (Ord a, Show a, Unbox a) => Vector a -> [(a, Int)]
countValuesUnboxed Vector a
vec = 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 a b. Unbox a => (a -> b -> b) -> b -> Vector a -> b
VU.foldr' (\a
x Map a Int
acc -> (Int -> Int -> Int) -> a -> Int -> Map a Int -> Map a Int
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) a
x Int
1 Map a Int
acc) Map a Int
forall k a. Map k a
M.empty Vector a
vec

groupWithOther :: Int -> [(T.Text, Double)] -> [(T.Text, Double)]
groupWithOther :: Int -> [(Text, Double)] -> [(Text, Double)]
groupWithOther Int
n [(Text, Double)]
items =
    let sorted :: [(Text, Double)]
sorted = ((Text, Double) -> Double) -> [(Text, Double)] -> [(Text, Double)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
L.sortOn (Double -> Double
forall a. Num a => a -> a
negate (Double -> Double)
-> ((Text, Double) -> Double) -> (Text, Double) -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Double) -> Double
forall a b. (a, b) -> b
snd) [(Text, Double)]
items
        ([(Text, Double)]
topN, [(Text, Double)]
rest) = Int -> [(Text, Double)] -> ([(Text, Double)], [(Text, Double)])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
n [(Text, Double)]
sorted
        otherSum :: Double
otherSum = [Double] -> Double
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (((Text, Double) -> Double) -> [(Text, Double)] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Double) -> Double
forall a b. (a, b) -> b
snd [(Text, Double)]
rest)
        result :: [(Text, Double)]
result =
            if [(Text, Double)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Text, Double)]
rest Bool -> Bool -> Bool
|| Double
otherSum Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0
                then [(Text, Double)]
topN
                else [(Text, Double)]
topN [(Text, Double)] -> [(Text, Double)] -> [(Text, Double)]
forall a. [a] -> [a] -> [a]
++ [(Text
"Other (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show ([(Text, Double)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Text, Double)]
rest)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" items)", Double
otherSum)]
     in [(Text, Double)]
result

groupWithOtherForPie :: Int -> [(T.Text, Double)] -> [(T.Text, Double)]
groupWithOtherForPie :: Int -> [(Text, Double)] -> [(Text, Double)]
groupWithOtherForPie Int
n [(Text, Double)]
items =
    let total :: Double
total = [Double] -> Double
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (((Text, Double) -> Double) -> [(Text, Double)] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Double) -> Double
forall a b. (a, b) -> b
snd [(Text, Double)]
items)
        sorted :: [(Text, Double)]
sorted = ((Text, Double) -> Double) -> [(Text, Double)] -> [(Text, Double)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
L.sortOn (Double -> Double
forall a. Num a => a -> a
negate (Double -> Double)
-> ((Text, Double) -> Double) -> (Text, Double) -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Double) -> Double
forall a b. (a, b) -> b
snd) [(Text, Double)]
items
        ([(Text, Double)]
topN, [(Text, Double)]
rest) = Int -> [(Text, Double)] -> ([(Text, Double)], [(Text, Double)])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
n [(Text, Double)]
sorted
        otherSum :: Double
otherSum = [Double] -> Double
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (((Text, Double) -> Double) -> [(Text, Double)] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Double) -> Double
forall a b. (a, b) -> b
snd [(Text, Double)]
rest)
        otherPct :: Int
otherPct = Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Double
100 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
otherSum Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
total) :: Int
        result :: [(Text, Double)]
result =
            if [(Text, Double)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Text, Double)]
rest Bool -> Bool -> Bool
|| Double
otherSum Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0
                then [(Text, Double)]
topN
                else
                    [(Text, Double)]
topN
                        [(Text, Double)] -> [(Text, Double)] -> [(Text, Double)]
forall a. [a] -> [a] -> [a]
++ [
                               ( Text
"Other ("
                                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show ([(Text, Double)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Text, Double)]
rest))
                                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" items, "
                                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
otherPct)
                                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"%)"
                               , Double
otherSum
                               )
                           ]
     in [(Text, Double)]
result

plotBarsTopN :: (HasCallStack) => Int -> T.Text -> DataFrame -> IO HtmlPlot
plotBarsTopN :: HasCallStack => Int -> Text -> DataFrame -> IO HtmlPlot
plotBarsTopN Int
n Text
colName = HasCallStack =>
Int -> Text -> PlotConfig -> DataFrame -> IO HtmlPlot
Int -> Text -> PlotConfig -> DataFrame -> IO HtmlPlot
plotBarsTopNWith Int
n Text
colName (PlotType -> PlotConfig
defaultPlotConfig PlotType
Bar)

plotBarsTopNWith ::
    (HasCallStack) => Int -> T.Text -> PlotConfig -> DataFrame -> IO HtmlPlot
plotBarsTopNWith :: HasCallStack =>
Int -> Text -> PlotConfig -> DataFrame -> IO HtmlPlot
plotBarsTopNWith Int
n Text
colName PlotConfig
config DataFrame
df = do
    let config' :: PlotConfig
config' = PlotConfig
config{plotTitle = plotTitle config <> " (Top " <> T.pack (show n) <> ")"}
    HasCallStack =>
Text -> Maybe Text -> PlotConfig -> DataFrame -> IO HtmlPlot
Text -> Maybe Text -> PlotConfig -> DataFrame -> IO HtmlPlot
plotBarsWith Text
colName Maybe Text
forall a. Maybe a
Nothing PlotConfig
config' DataFrame
df

plotValueCounts :: (HasCallStack) => T.Text -> DataFrame -> IO HtmlPlot
plotValueCounts :: HasCallStack => Text -> DataFrame -> IO HtmlPlot
plotValueCounts Text
colName = HasCallStack =>
Text -> Int -> PlotConfig -> DataFrame -> IO HtmlPlot
Text -> Int -> PlotConfig -> DataFrame -> IO HtmlPlot
plotValueCountsWith Text
colName Int
10 (PlotType -> PlotConfig
defaultPlotConfig PlotType
Bar)

plotValueCountsWith ::
    (HasCallStack) => T.Text -> Int -> PlotConfig -> DataFrame -> IO HtmlPlot
plotValueCountsWith :: HasCallStack =>
Text -> Int -> PlotConfig -> DataFrame -> IO HtmlPlot
plotValueCountsWith Text
colName Int
maxBars PlotConfig
config DataFrame
df = do
    let config' :: PlotConfig
config' = PlotConfig
config{plotTitle = "Value counts for " <> colName}
    HasCallStack =>
Int -> Text -> PlotConfig -> DataFrame -> IO HtmlPlot
Int -> Text -> PlotConfig -> DataFrame -> IO HtmlPlot
plotBarsTopNWith Int
maxBars Text
colName PlotConfig
config' DataFrame
df

plotAllHistograms :: (HasCallStack) => DataFrame -> IO HtmlPlot
plotAllHistograms :: HasCallStack => DataFrame -> IO HtmlPlot
plotAllHistograms DataFrame
df = do
    let numericCols :: [Text]
numericCols = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (DataFrame -> Text -> Bool
isNumericColumn DataFrame
df) (DataFrame -> [Text]
columnNames DataFrame
df)
    [HtmlPlot]
xs <- [Text] -> (Text -> IO HtmlPlot) -> IO [HtmlPlot]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Text]
numericCols ((Text -> IO HtmlPlot) -> IO [HtmlPlot])
-> (Text -> IO HtmlPlot) -> IO [HtmlPlot]
forall a b. (a -> b) -> a -> b
$ \Text
col -> do
        HasCallStack => Text -> DataFrame -> IO HtmlPlot
Text -> DataFrame -> IO HtmlPlot
plotHistogram Text
col DataFrame
df
    let allPlots :: Text
allPlots = (Text -> HtmlPlot -> Text) -> Text -> [HtmlPlot] -> Text
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl' (\Text
acc (HtmlPlot Text
contents) -> Text
acc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contents) Text
"" [HtmlPlot]
xs
    HtmlPlot -> IO HtmlPlot
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> HtmlPlot
HtmlPlot Text
allPlots)

plotCategoricalSummary :: (HasCallStack) => DataFrame -> IO HtmlPlot
plotCategoricalSummary :: HasCallStack => DataFrame -> IO HtmlPlot
plotCategoricalSummary DataFrame
df = do
    let cols :: [Text]
cols = DataFrame -> [Text]
columnNames DataFrame
df
    [HtmlPlot]
xs <- [Text] -> (Text -> IO HtmlPlot) -> IO [HtmlPlot]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Text]
cols ((Text -> IO HtmlPlot) -> IO [HtmlPlot])
-> (Text -> IO HtmlPlot) -> IO [HtmlPlot]
forall a b. (a -> b) -> a -> b
$ \Text
col -> do
        let counts :: Maybe [(Text, Double)]
counts = HasCallStack => Text -> DataFrame -> Maybe [(Text, Double)]
Text -> DataFrame -> Maybe [(Text, Double)]
getCategoricalCounts Text
col DataFrame
df
        case Maybe [(Text, Double)]
counts of
            Just [(Text, Double)]
c -> do
                if [(Text, Double)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Text, Double)]
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
                    then
                        ( do
                            let numUnique :: Int
numUnique = [(Text, Double)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Text, Double)]
c
                            String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
                                String
"\n<!-- " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
col String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
numUnique String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" unique values) -->"
                            if Int
numUnique Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
15 then HasCallStack => Int -> Text -> DataFrame -> IO HtmlPlot
Int -> Text -> DataFrame -> IO HtmlPlot
plotBarsTopN Int
10 Text
col DataFrame
df else HasCallStack => Text -> DataFrame -> IO HtmlPlot
Text -> DataFrame -> IO HtmlPlot
plotBars Text
col DataFrame
df
                        )
                    else HtmlPlot -> IO HtmlPlot
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> HtmlPlot
HtmlPlot Text
"")
            Maybe [(Text, Double)]
Nothing -> HtmlPlot -> IO HtmlPlot
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> HtmlPlot
HtmlPlot Text
"")
    let allPlots :: Text
allPlots = (Text -> HtmlPlot -> Text) -> Text -> [HtmlPlot] -> Text
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl' (\Text
acc (HtmlPlot Text
contents) -> Text
acc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contents) Text
"" [HtmlPlot]
xs
    HtmlPlot -> IO HtmlPlot
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> HtmlPlot
HtmlPlot Text
allPlots)

plotBarsWithPercentages :: (HasCallStack) => T.Text -> DataFrame -> IO HtmlPlot
plotBarsWithPercentages :: HasCallStack => Text -> DataFrame -> IO HtmlPlot
plotBarsWithPercentages Text
colName DataFrame
df = do
    let config :: PlotConfig
config = (PlotType -> PlotConfig
defaultPlotConfig PlotType
Bar){plotTitle = "Distribution of " <> colName}
    HasCallStack =>
Text -> Maybe Text -> PlotConfig -> DataFrame -> IO HtmlPlot
Text -> Maybe Text -> PlotConfig -> DataFrame -> IO HtmlPlot
plotBarsWith Text
colName Maybe Text
forall a. Maybe a
Nothing PlotConfig
config DataFrame
df

smartPlotBars :: (HasCallStack) => T.Text -> DataFrame -> IO HtmlPlot
smartPlotBars :: HasCallStack => Text -> DataFrame -> IO HtmlPlot
smartPlotBars Text
colName DataFrame
df = do
    let counts :: Maybe [(Text, Double)]
counts = HasCallStack => Text -> DataFrame -> Maybe [(Text, Double)]
Text -> DataFrame -> Maybe [(Text, Double)]
getCategoricalCounts Text
colName DataFrame
df
    case Maybe [(Text, Double)]
counts of
        Just [(Text, Double)]
c -> do
            let numUnique :: Int
numUnique = [(Text, Double)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Text, Double)]
c
                config :: PlotConfig
config =
                    (PlotType -> PlotConfig
defaultPlotConfig PlotType
Bar)
                        { plotTitle = colName <> " (" <> T.pack (show numUnique) <> " unique values)"
                        }
            if Int
numUnique Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
12
                then HasCallStack =>
Text -> Maybe Text -> PlotConfig -> DataFrame -> IO HtmlPlot
Text -> Maybe Text -> PlotConfig -> DataFrame -> IO HtmlPlot
plotBarsWith Text
colName Maybe Text
forall a. Maybe a
Nothing PlotConfig
config DataFrame
df
                else HasCallStack =>
Int -> Text -> PlotConfig -> DataFrame -> IO HtmlPlot
Int -> Text -> PlotConfig -> DataFrame -> IO HtmlPlot
plotBarsTopNWith Int
10 Text
colName PlotConfig
config DataFrame
df
        Maybe [(Text, Double)]
Nothing -> HasCallStack => Text -> DataFrame -> IO HtmlPlot
Text -> DataFrame -> IO HtmlPlot
plotBars Text
colName DataFrame
df

showInDefaultBrowser :: HtmlPlot -> IO ()
showInDefaultBrowser :: HtmlPlot -> IO ()
showInDefaultBrowser (HtmlPlot Text
p) = do
    Text
plotId <- IO Text
generateChartId
    String
home <- IO String
getHomeDirectory
    let operatingSystem :: String
operatingSystem = String
os
    let path :: String
path = String
"plot-" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
plotId String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
".html"

    let fullPath :: String
fullPath =
            if String
operatingSystem String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"mingw32"
                then String
home String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\\" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
path
                else String
home String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"/" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
path
    String -> IO ()
putStr String
"Saving plot to: "
    String -> IO ()
putStrLn String
fullPath
    String -> Text -> IO ()
T.writeFile String
fullPath Text
p
    if String
operatingSystem String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"mingw32"
        then String -> String -> IO ()
openFileSilently String
"start" String
fullPath
        else String -> String -> IO ()
openFileSilently String
"xdg-open" String
fullPath
    () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

openFileSilently :: FilePath -> FilePath -> IO ()
openFileSilently :: String -> String -> IO ()
openFileSilently String
program String
path = do
    (Maybe Handle
_, Maybe Handle
_, Maybe Handle
_, ProcessHandle
ph) <-
        CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess
            (String -> [String] -> CreateProcess
proc String
program [String
path])
                { std_in = NoStream
                , std_out = NoStream
                , std_err = NoStream
                }
    IO ExitCode -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
ph)