{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoFieldSelectors #-}

{- |
A plotly-express-style one-shot plotting API for HTML output: the string-keyed
convenience tier emitting interactive Vega-Lite charts. For the composable
expression-based grammar see "DataFrame.Display.Web.Chart" and its @.Typed@.
-}
module DataFrame.Display.Web.Plot (
    -- * Aggregation
    Agg (..),

    -- * Output
    showInDefaultBrowser,

    -- * Layout
    Size (..),
    defaultSize,

    -- * Bar charts
    Bar (..),
    mkBar,
    bar,

    -- * Histograms
    Histogram (..),
    mkHistogram,
    histogram,

    -- * Scatter plots
    Scatter (..),
    mkScatter,
    scatter,

    -- * Line charts
    Line (..),
    mkLine,
    line,

    -- * Pie charts
    Pie (..),
    mkPie,
    pie,

    -- * Box plots
    Box (..),
    mkBox,
    box,

    -- * Whole-frame plots
    allHistograms,

    -- * Deprecated legacy entry points
    plotHistogram,
    plotScatter,
    plotBars,
    plotLines,
    plotPie,
    plotBoxPlots,
) where

import Control.Monad (forM, void)
import Data.Char (chr)
import qualified Data.List as L
import qualified Data.Maybe
import qualified Data.Text as T
import qualified Data.Text.IO as T
import GHC.Stack (HasCallStack)
import Numeric (showFFloat)
import System.Directory (getHomeDirectory)
import System.Info (os)
import System.Process (
    StdStream (NoStream),
    createProcess,
    proc,
    std_err,
    std_in,
    std_out,
    waitForProcess,
 )
import System.Random (newStdGen, randomRs)

import DataFrame.Display.Internal.Common (
    Agg (..),
    aggLabel,
    aggregateByGroup,
    extractNumericColumn,
    extractStringColumn,
    groupWithOther,
    groupWithOtherForPie,
    isNumericColumn,
 )
import DataFrame.Display.Internal.VegaLite (
    Channel (Color, Theta, X, Y),
    FieldType (..),
    ResolvedField,
    VLSpec (..),
    chanEnc,
    emptySpec,
    numField,
    specHtml,
    textField,
 )
import qualified DataFrame.Display.Internal.VegaLite as VL
import DataFrame.Internal.DataFrame (DataFrame, columnNames)

-- ---------------------------------------------------------------------------
-- Layout
-- ---------------------------------------------------------------------------

-- | Display dimensions for the chart, in pixels.
data Size = Size {Size -> Int
width :: Int, Size -> Int
height :: Int}

defaultSize :: Size
defaultSize :: Size
defaultSize = Int -> Int -> Size
Size Int
600 Int
400

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)

-- | Assemble a chart HTML snippet from resolved data fields and a spec.
renderSpec :: Size -> [ResolvedField] -> VLSpec -> IO String
renderSpec :: Size -> [ResolvedField] -> VLSpec -> IO String
renderSpec Size
sz [ResolvedField]
fields VLSpec
spec = do
    Text
chartId <- IO Text
generateChartId
    let spec' :: VLSpec
spec' = VLSpec
spec{vlWidth = sz.width, vlHeight = sz.height}
    String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text -> [ResolvedField] -> VLSpec -> Text
specHtml Text
chartId [ResolvedField]
fields VLSpec
spec'

-- | Pin a channel's zero anchor explicitly, on or off.
anchorZero :: Bool -> VL.ChannelEnc -> VL.ChannelEnc
anchorZero :: Bool -> ChannelEnc -> ChannelEnc
anchorZero Bool
b ChannelEnc
e = ChannelEnc
e{VL.ceScale = VL.defaultScale{VL.scaleZero = Just b}}

-- ---------------------------------------------------------------------------
-- Bar
-- ---------------------------------------------------------------------------

data Bar = Bar
    { Bar -> Text
x :: T.Text
    , Bar -> Maybe Text
y :: Maybe T.Text
    , Bar -> Agg
agg :: Agg
    , Bar -> Maybe Int
topN :: Maybe Int
    , Bar -> Maybe Text
title :: Maybe T.Text
    , Bar -> Size
size :: Size
    }

mkBar :: T.Text -> Bar
mkBar :: Text -> Bar
mkBar Text
c = Text -> Maybe Text -> Agg -> Maybe Int -> Maybe Text -> Size -> Bar
Bar Text
c Maybe Text
forall a. Maybe a
Nothing Agg
Sum Maybe Int
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Size
defaultSize

bar :: (HasCallStack) => Bar -> DataFrame -> IO String
bar :: HasCallStack => Bar -> DataFrame -> IO String
bar Bar
spec DataFrame
df = do
    let effectiveAgg :: Agg
effectiveAgg = case Bar
spec.y of
            Maybe Text
Nothing -> Agg
Count
            Just Text
_ -> Bar
spec.agg
        rows :: [(Text, Double)]
rows = HasCallStack =>
Agg -> Text -> Maybe Text -> DataFrame -> [(Text, Double)]
Agg -> Text -> Maybe Text -> DataFrame -> [(Text, Double)]
aggregateByGroup Agg
effectiveAgg Bar
spec.x Bar
spec.y DataFrame
df
        rows' :: [(Text, Double)]
rows' = [(Text, Double)]
-> (Int -> [(Text, Double)]) -> Maybe Int -> [(Text, Double)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [(Text, Double)]
rows (Int -> [(Text, Double)] -> [(Text, Double)]
`groupWithOther` [(Text, Double)]
rows) Bar
spec.topN
        chartTitle :: Text
chartTitle = case Bar
spec.title of
            Just Text
s -> Text
s
            Maybe Text
Nothing -> Agg -> Maybe Text -> Text -> Text
autoTitle Agg
effectiveAgg Bar
spec.y Bar
spec.x
        legendLabel :: Text
legendLabel = case Bar
spec.y of
            Maybe Text
Nothing -> Text
"count"
            Just Text
yCol -> Agg -> Text
aggLabel Agg
effectiveAgg Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
yCol Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
        ([Text]
labels, [Double]
values) = [(Text, Double)] -> ([Text], [Double])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Text, Double)]
rows'
        fields :: [ResolvedField]
fields =
            [ Text -> [Text] -> ResolvedField
textField Bar
spec.x [Text]
labels
            , Text -> [Double] -> ResolvedField
numField Text
legendLabel [Double]
values
            ]
        vlSpec :: VLSpec
vlSpec =
            (Mark -> VLSpec
emptySpec Mark
VL.Bar)
                { vlEncodings =
                    [ chanEnc X spec.x Nominal
                    , chanEnc Y legendLabel Quantitative
                    ]
                , vlTitle = Just chartTitle
                }
    Size -> [ResolvedField] -> VLSpec -> IO String
renderSpec Bar
spec.size [ResolvedField]
fields VLSpec
vlSpec

-- ---------------------------------------------------------------------------
-- Histogram
-- ---------------------------------------------------------------------------

data Histogram = Histogram
    { Histogram -> Text
x :: T.Text
    , Histogram -> Int
bins :: Int
    , Histogram -> Maybe Text
title :: Maybe T.Text
    , Histogram -> Size
size :: Size
    }

mkHistogram :: T.Text -> Histogram
mkHistogram :: Text -> Histogram
mkHistogram Text
c = Text -> Int -> Maybe Text -> Size -> Histogram
Histogram Text
c Int
30 Maybe Text
forall a. Maybe a
Nothing Size
defaultSize

histogram :: (HasCallStack) => Histogram -> DataFrame -> IO String
histogram :: HasCallStack => Histogram -> DataFrame -> IO String
histogram Histogram
spec DataFrame
df = do
    let values :: [Double]
values = HasCallStack => Text -> DataFrame -> [Double]
Text -> DataFrame -> [Double]
extractNumericColumn Histogram
spec.x DataFrame
df
        (Double
lo, Double
hi) = 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)
        binWidth :: Double
binWidth = (Double
hi Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
lo) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Histogram
spec.bins
        binStarts :: [Double]
binStarts = [Double
lo Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
binWidth | Int
i <- [Int
0 .. Histogram
spec.bins Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]]
        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]
        counts :: [Double]
counts = (Double -> Double) -> [Double] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Double) -> (Double -> Int) -> Double -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Int
countBin) [Double]
binStarts
        precision :: Int
precision = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Double -> Double
forall a. Num a => a -> a
negate (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Double
forall a. Floating a => a -> a -> a
logBase Double
10 (Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
1e-12 Double
binWidth))
        binLabels :: [Text]
binLabels =
            [String -> Text
T.pack (Maybe Int -> Double -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
precision) Double
b String
"") | Double
b <- [Double]
binStarts]
        chartTitle :: Text
chartTitle = case Histogram
spec.title of
            Just Text
s -> Text
s
            Maybe Text
Nothing -> Text
"histogram of " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Histogram
spec.x
        fields :: [ResolvedField]
fields =
            [ Text -> [Text] -> ResolvedField
textField Histogram
spec.x [Text]
binLabels
            , Text -> [Double] -> ResolvedField
numField Text
"count" [Double]
counts
            ]
        vlSpec :: VLSpec
vlSpec =
            (Mark -> VLSpec
emptySpec Mark
VL.Bar)
                { vlEncodings =
                    [ (chanEnc X spec.x Ordinal){VL.ceSort = Just VL.DataOrder}
                    , chanEnc Y "count" Quantitative
                    ]
                , vlTitle = Just chartTitle
                }
    Size -> [ResolvedField] -> VLSpec -> IO String
renderSpec Histogram
spec.size [ResolvedField]
fields VLSpec
vlSpec

-- ---------------------------------------------------------------------------
-- Scatter
-- ---------------------------------------------------------------------------

{- | 'includeZero' anchors both axes at zero. Off by default so the axes fit
the data — otherwise points far from the origin (e.g. geographic coordinates)
get squashed against the chart edge.
-}
data Scatter = Scatter
    { Scatter -> Text
x :: T.Text
    , Scatter -> Text
y :: T.Text
    , Scatter -> Maybe Text
color :: Maybe T.Text
    , Scatter -> Maybe Text
title :: Maybe T.Text
    , Scatter -> Size
size :: Size
    , Scatter -> Bool
includeZero :: Bool
    }

mkScatter :: T.Text -> T.Text -> Scatter
mkScatter :: Text -> Text -> Scatter
mkScatter Text
xc Text
yc = Text -> Text -> Maybe Text -> Maybe Text -> Size -> Bool -> Scatter
Scatter Text
xc Text
yc Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Size
defaultSize Bool
False

scatter :: (HasCallStack) => Scatter -> DataFrame -> IO String
scatter :: HasCallStack => Scatter -> DataFrame -> IO String
scatter Scatter
spec DataFrame
df = do
    let chartTitle :: Text
chartTitle = case Scatter
spec.title of
            Just Text
s -> Text
s
            Maybe Text
Nothing -> Scatter
spec.x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" vs " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Scatter
spec.y
        xVals :: [Double]
xVals = HasCallStack => Text -> DataFrame -> [Double]
Text -> DataFrame -> [Double]
extractNumericColumn Scatter
spec.x DataFrame
df
        yVals :: [Double]
yVals = HasCallStack => Text -> DataFrame -> [Double]
Text -> DataFrame -> [Double]
extractNumericColumn Scatter
spec.y DataFrame
df
        baseFields :: [ResolvedField]
baseFields = [Text -> [Double] -> ResolvedField
numField Scatter
spec.x [Double]
xVals, Text -> [Double] -> ResolvedField
numField Scatter
spec.y [Double]
yVals]
        baseEncs :: [ChannelEnc]
baseEncs =
            (ChannelEnc -> ChannelEnc) -> [ChannelEnc] -> [ChannelEnc]
forall a b. (a -> b) -> [a] -> [b]
map
                (Bool -> ChannelEnc -> ChannelEnc
anchorZero Scatter
spec.includeZero)
                [Channel -> Text -> FieldType -> ChannelEnc
chanEnc Channel
X Scatter
spec.x FieldType
Quantitative, Channel -> Text -> FieldType -> ChannelEnc
chanEnc Channel
Y Scatter
spec.y FieldType
Quantitative]
        ([ResolvedField]
fields, [ChannelEnc]
encs) = case Scatter
spec.color of
            Maybe Text
Nothing -> ([ResolvedField]
baseFields, [ChannelEnc]
baseEncs)
            Just Text
grp ->
                ( [ResolvedField]
baseFields [ResolvedField] -> [ResolvedField] -> [ResolvedField]
forall a. [a] -> [a] -> [a]
++ [Text -> [Text] -> ResolvedField
textField Text
grp (HasCallStack => Text -> DataFrame -> [Text]
Text -> DataFrame -> [Text]
extractStringColumn Text
grp DataFrame
df)]
                , [ChannelEnc]
baseEncs [ChannelEnc] -> [ChannelEnc] -> [ChannelEnc]
forall a. [a] -> [a] -> [a]
++ [Channel -> Text -> FieldType -> ChannelEnc
chanEnc Channel
Color Text
grp FieldType
Nominal]
                )
        vlSpec :: VLSpec
vlSpec =
            (Mark -> VLSpec
emptySpec Mark
VL.Point)
                { vlEncodings = encs
                , vlTitle = Just chartTitle
                }
    Size -> [ResolvedField] -> VLSpec -> IO String
renderSpec Scatter
spec.size [ResolvedField]
fields VLSpec
vlSpec

-- ---------------------------------------------------------------------------
-- Line
-- ---------------------------------------------------------------------------

{- | 'includeZero' anchors the axes at zero (Vega-Lite's own default). Off
by default so the axes fit the data — a line is position-encoded, so a
forced zero baseline only squashes series far from the origin.
-}
data Line = Line
    { Line -> Text
x :: T.Text
    , Line -> [Text]
y :: [T.Text]
    , Line -> Maybe Text
title :: Maybe T.Text
    , Line -> Size
size :: Size
    , Line -> Bool
includeZero :: Bool
    }

mkLine :: T.Text -> [T.Text] -> Line
mkLine :: Text -> [Text] -> Line
mkLine Text
xc [Text]
ys = Text -> [Text] -> Maybe Text -> Size -> Bool -> Line
Line Text
xc [Text]
ys Maybe Text
forall a. Maybe a
Nothing Size
defaultSize Bool
False

line :: (HasCallStack) => Line -> DataFrame -> IO String
line :: HasCallStack => Line -> DataFrame -> IO String
line Line
spec DataFrame
df = do
    let chartTitle :: Text
chartTitle = case Line
spec.title of
            Just Text
s -> Text
s
            Maybe Text
Nothing -> case Line
spec.y of
                [Text
single] -> Text
single Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" over " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Line
spec.x
                [Text]
_ -> Text -> [Text] -> Text
T.intercalate Text
", " Line
spec.y Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" over " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Line
spec.x
        xVals :: [Double]
xVals = HasCallStack => Text -> DataFrame -> [Double]
Text -> DataFrame -> [Double]
extractNumericColumn Line
spec.x DataFrame
df
        perSeries :: [(Text, [(Double, Double)])]
perSeries =
            [ (Text
col, [Double] -> [Double] -> [(Double, Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Double]
xVals (HasCallStack => Text -> DataFrame -> [Double]
Text -> DataFrame -> [Double]
extractNumericColumn Text
col DataFrame
df))
            | Text
col <- Line
spec.y
            ]
        xsLong :: [Double]
xsLong = [[Double]] -> [Double]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Double
xv | (Double
xv, Double
_) <- [(Double, Double)]
pts] | (Text
_, [(Double, Double)]
pts) <- [(Text, [(Double, Double)])]
perSeries]
        valsLong :: [Double]
valsLong = [[Double]] -> [Double]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Double
v | (Double
_, Double
v) <- [(Double, Double)]
pts] | (Text
_, [(Double, Double)]
pts) <- [(Text, [(Double, Double)])]
perSeries]
        seriesLong :: [Text]
seriesLong = [[Text]] -> [Text]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [Int -> Text -> [Text]
forall a. Int -> a -> [a]
replicate ([(Double, Double)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Double, Double)]
pts) Text
col | (Text
col, [(Double, Double)]
pts) <- [(Text, [(Double, Double)])]
perSeries]
        fields :: [ResolvedField]
fields =
            [ Text -> [Double] -> ResolvedField
numField Line
spec.x [Double]
xsLong
            , Text -> [Double] -> ResolvedField
numField Text
"value" [Double]
valsLong
            , Text -> [Text] -> ResolvedField
textField Text
"series" [Text]
seriesLong
            ]
        vlSpec :: VLSpec
vlSpec =
            (Mark -> VLSpec
emptySpec Mark
VL.Line)
                { vlEncodings =
                    [ anchorZero spec.includeZero (chanEnc X spec.x Quantitative)
                    , anchorZero spec.includeZero (chanEnc Y "value" Quantitative)
                    , chanEnc Color "series" Nominal
                    ]
                , vlTitle = Just chartTitle
                }
    Size -> [ResolvedField] -> VLSpec -> IO String
renderSpec Line
spec.size [ResolvedField]
fields VLSpec
vlSpec

-- ---------------------------------------------------------------------------
-- Pie
-- ---------------------------------------------------------------------------

data Pie = Pie
    { Pie -> Text
values :: T.Text
    , Pie -> Maybe Text
names :: Maybe T.Text
    , Pie -> Agg
agg :: Agg
    , Pie -> Maybe Int
topN :: Maybe Int
    , Pie -> Maybe Text
title :: Maybe T.Text
    , Pie -> Size
size :: Size
    }

mkPie :: T.Text -> Pie
mkPie :: Text -> Pie
mkPie Text
c = Text -> Maybe Text -> Agg -> Maybe Int -> Maybe Text -> Size -> Pie
Pie Text
c Maybe Text
forall a. Maybe a
Nothing Agg
Count (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
8) Maybe Text
forall a. Maybe a
Nothing Size
defaultSize

pie :: (HasCallStack) => Pie -> DataFrame -> IO String
pie :: HasCallStack => Pie -> DataFrame -> IO String
pie Pie
spec DataFrame
df = do
    let vCol :: Text
vCol = Pie
spec.values
        mNames :: Maybe Text
mNames = Pie
spec.names
        a :: Agg
a = Pie
spec.agg
        chartTitle :: Text
chartTitle = case Pie
spec.title of
            Just Text
s -> Text
s
            Maybe Text
Nothing -> case Maybe Text
mNames of
                Just Text
n -> Agg -> Text
aggLabel Agg
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
vCol Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
") by " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
n
                Maybe Text
Nothing -> Agg -> Text
aggLabel Agg
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" of " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
vCol
        rows :: [(Text, Double)]
rows = case (Agg
a, Maybe Text
mNames) of
            (Agg
Count, Maybe Text
Nothing) -> HasCallStack =>
Agg -> Text -> Maybe Text -> DataFrame -> [(Text, Double)]
Agg -> Text -> Maybe Text -> DataFrame -> [(Text, Double)]
aggregateByGroup Agg
Count Text
vCol Maybe Text
forall a. Maybe a
Nothing DataFrame
df
            (Agg
Count, Just Text
n) -> HasCallStack =>
Agg -> Text -> Maybe Text -> DataFrame -> [(Text, Double)]
Agg -> Text -> Maybe Text -> DataFrame -> [(Text, Double)]
aggregateByGroup Agg
Count Text
n Maybe Text
forall a. Maybe a
Nothing DataFrame
df
            (Agg
_, Maybe Text
Nothing) ->
                let xs :: [Double]
xs = HasCallStack => Text -> DataFrame -> [Double]
Text -> DataFrame -> [Double]
extractNumericColumn Text
vCol DataFrame
df
                 in [Text] -> [Double] -> [(Text, Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String -> Text
T.pack (String
"Item " String -> ShowS
forall a. [a] -> [a] -> [a]
++ 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]
xs :: Int]] [Double]
xs
            (Agg
_, Just Text
n) -> HasCallStack =>
Agg -> Text -> Maybe Text -> DataFrame -> [(Text, Double)]
Agg -> Text -> Maybe Text -> DataFrame -> [(Text, Double)]
aggregateByGroup Agg
a Text
n (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
vCol) DataFrame
df
        rows' :: [(Text, Double)]
rows' = [(Text, Double)]
-> (Int -> [(Text, Double)]) -> Maybe Int -> [(Text, Double)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [(Text, Double)]
rows (Int -> [(Text, Double)] -> [(Text, Double)]
`groupWithOtherForPie` [(Text, Double)]
rows) Pie
spec.topN
        ([Text]
labels, [Double]
values) = [(Text, Double)] -> ([Text], [Double])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Text, Double)]
rows'
        catName :: Text
catName = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
Data.Maybe.fromMaybe Text
"category" Maybe Text
mNames
        fields :: [ResolvedField]
fields =
            [ Text -> [Text] -> ResolvedField
textField Text
catName [Text]
labels
            , Text -> [Double] -> ResolvedField
numField Text
"value" [Double]
values
            ]
        vlSpec :: VLSpec
vlSpec =
            (Mark -> VLSpec
emptySpec Mark
VL.Arc)
                { vlEncodings =
                    [ chanEnc Theta "value" Quantitative
                    , chanEnc Color catName Nominal
                    ]
                , vlTitle = Just chartTitle
                }
    Size -> [ResolvedField] -> VLSpec -> IO String
renderSpec Pie
spec.size [ResolvedField]
fields VLSpec
vlSpec

-- ---------------------------------------------------------------------------
-- Box
-- ---------------------------------------------------------------------------

data Box = Box
    { Box -> [Text]
y :: [T.Text]
    , Box -> Maybe Text
title :: Maybe T.Text
    , Box -> Size
size :: Size
    }

mkBox :: [T.Text] -> Box
mkBox :: [Text] -> Box
mkBox [Text]
ys = [Text] -> Maybe Text -> Size -> Box
Box [Text]
ys Maybe Text
forall a. Maybe a
Nothing Size
defaultSize

box :: (HasCallStack) => Box -> DataFrame -> IO String
box :: HasCallStack => Box -> DataFrame -> IO String
box Box
spec DataFrame
df = do
    let series :: [(Text, [Double])]
series = [(Text
col, HasCallStack => Text -> DataFrame -> [Double]
Text -> DataFrame -> [Double]
extractNumericColumn Text
col DataFrame
df) | Text
col <- Box
spec.y]
        variableVals :: [Text]
variableVals = [[Text]] -> [Text]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [Int -> Text -> [Text]
forall a. Int -> a -> [a]
replicate ([Double] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Double]
vs) Text
col | (Text
col, [Double]
vs) <- [(Text, [Double])]
series]
        valueVals :: [Double]
valueVals = [[Double]] -> [Double]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Double]
vs | (Text
_, [Double]
vs) <- [(Text, [Double])]
series]
        chartTitle :: Text
chartTitle = case Box
spec.title of
            Just Text
s -> Text
s
            Maybe Text
Nothing -> Text
"box plot of " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
", " Box
spec.y
        fields :: [ResolvedField]
fields =
            [ Text -> [Text] -> ResolvedField
textField Text
"variable" [Text]
variableVals
            , Text -> [Double] -> ResolvedField
numField Text
"value" [Double]
valueVals
            ]
        vlSpec :: VLSpec
vlSpec =
            (Mark -> VLSpec
emptySpec Mark
VL.Boxplot)
                { vlEncodings =
                    [ chanEnc X "variable" Nominal
                    , chanEnc Y "value" Quantitative
                    ]
                , vlTitle = Just chartTitle
                }
    Size -> [ResolvedField] -> VLSpec -> IO String
renderSpec Box
spec.size [ResolvedField]
fields VLSpec
vlSpec

-- ---------------------------------------------------------------------------
-- Whole-frame helpers
-- ---------------------------------------------------------------------------

{- | Concatenate a histogram for every numeric column in the frame. Useful
as a one-shot exploratory summary.
-}
allHistograms :: (HasCallStack) => DataFrame -> IO String
allHistograms :: HasCallStack => DataFrame -> IO String
allHistograms DataFrame
df = do
    let cols :: [Text]
cols = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (DataFrame -> Text -> Bool
isNumericColumn DataFrame
df) (DataFrame -> [Text]
columnNames DataFrame
df)
    [String]
xs <- [Text] -> (Text -> IO String) -> IO [String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Text]
cols ((Text -> IO String) -> IO [String])
-> (Text -> IO String) -> IO [String]
forall a b. (a -> b) -> a -> b
$ \Text
c -> HasCallStack => Histogram -> DataFrame -> IO String
Histogram -> DataFrame -> IO String
histogram (Text -> Histogram
mkHistogram Text
c) DataFrame
df
    String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
L.intercalate String
"\n" [String]
xs

-- ---------------------------------------------------------------------------
-- Title helper
-- ---------------------------------------------------------------------------

autoTitle :: Agg -> Maybe T.Text -> T.Text -> T.Text
autoTitle :: Agg -> Maybe Text -> Text -> Text
autoTitle Agg
Count Maybe Text
_ Text
groupCol = Text
"count by " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
groupCol
autoTitle Agg
a (Just Text
yCol) Text
groupCol = Agg -> Text
aggLabel Agg
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"(" 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
groupCol
autoTitle Agg
a Maybe Text
Nothing Text
groupCol = Agg -> Text
aggLabel Agg
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" by " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
groupCol

-- ---------------------------------------------------------------------------
-- Deprecated legacy entry points
-- ---------------------------------------------------------------------------

plotHistogram :: (HasCallStack) => T.Text -> DataFrame -> IO String
plotHistogram :: HasCallStack => Text -> DataFrame -> IO String
plotHistogram Text
c = HasCallStack => Histogram -> DataFrame -> IO String
Histogram -> DataFrame -> IO String
histogram (Text -> Histogram
mkHistogram Text
c)
{-# DEPRECATED plotHistogram "use 'histogram (mkHistogram col)' instead" #-}

plotScatter :: (HasCallStack) => T.Text -> T.Text -> DataFrame -> IO String
plotScatter :: HasCallStack => Text -> Text -> DataFrame -> IO String
plotScatter Text
xc Text
yc = HasCallStack => Scatter -> DataFrame -> IO String
Scatter -> DataFrame -> IO String
scatter (Text -> Text -> Scatter
mkScatter Text
xc Text
yc)
{-# DEPRECATED plotScatter "use 'scatter (mkScatter xCol yCol)' instead" #-}

plotBars :: (HasCallStack) => T.Text -> DataFrame -> IO String
plotBars :: HasCallStack => Text -> DataFrame -> IO String
plotBars Text
c = HasCallStack => Bar -> DataFrame -> IO String
Bar -> DataFrame -> IO String
bar (Text -> Bar
mkBar Text
c)
{-# DEPRECATED plotBars "use 'bar (mkBar col)' instead" #-}

plotLines :: (HasCallStack) => T.Text -> [T.Text] -> DataFrame -> IO String
plotLines :: HasCallStack => Text -> [Text] -> DataFrame -> IO String
plotLines Text
xc [Text]
ys = HasCallStack => Line -> DataFrame -> IO String
Line -> DataFrame -> IO String
line (Text -> [Text] -> Line
mkLine Text
xc [Text]
ys)
{-# DEPRECATED plotLines "use 'line (mkLine xCol yCols)' instead" #-}

plotPie :: (HasCallStack) => T.Text -> Maybe T.Text -> DataFrame -> IO String
plotPie :: HasCallStack => Text -> Maybe Text -> DataFrame -> IO String
plotPie Text
c Maybe Text
mLabel =
    let s :: Pie
s = Text -> Pie
mkPie Text
c
     in HasCallStack => Pie -> DataFrame -> IO String
Pie -> DataFrame -> IO String
pie Pie
s{names = mLabel}
{-# DEPRECATED plotPie "use 'pie (mkPie col)' instead" #-}

plotBoxPlots :: (HasCallStack) => [T.Text] -> DataFrame -> IO String
plotBoxPlots :: HasCallStack => [Text] -> DataFrame -> IO String
plotBoxPlots [Text]
ys = HasCallStack => Box -> DataFrame -> IO String
Box -> DataFrame -> IO String
box ([Text] -> Box
mkBox [Text]
ys)
{-# DEPRECATED plotBoxPlots "use 'box (mkBox cols)' instead" #-}

-- ---------------------------------------------------------------------------
-- Browser launcher
-- ---------------------------------------------------------------------------

showInDefaultBrowser :: String -> IO ()
showInDefaultBrowser :: String -> IO ()
showInDefaultBrowser String
p = do
    Text
plotId <- IO Text
generateChartId
    String
home <- IO String
getHomeDirectory
    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"
        fullPath :: String
fullPath =
            if String
os 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 (String -> Text
T.pack String
p)
    case String
os of
        String
"mingw32" -> String -> String -> IO ()
openFileSilently String
"start" String
fullPath
        String
"darwin" -> String -> String -> IO ()
openFileSilently String
"open" String
fullPath
        String
_ -> String -> String -> IO ()
openFileSilently String
"xdg-open" String
fullPath

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)