{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}

{-|
Module      : Graphics.Vega.VegaLite.Transform
Copyright   : (c) Douglas Burke, 2018-2021
License     : BSD3

Maintainer  : dburke.gw@gmail.com
Stability   : unstable
Portability : CPP, OverloadedStrings

Types related to data transformation.

Note that this does not include some of the \"obvious\" types,
in particular @Operation@ and @Filter@ as these types are
inter-related and end up requiring a number of other types unrelated
to transformations.

-}

module Graphics.Vega.VegaLite.Transform
       ( Operation(..)
       , Window(..)
       , WOperation(..)
       , BinProperty(..)
       , WindowProperty(..)
       , ImputeProperty(..)
       , ImMethod(..)

         -- not for external export
       , aggregate_
       , op_
       , binned_
       , impute_
       , bin
       , binProperty
       , operationSpec
       , windowTS
       , joinAggregateTS
       , imputeTS

       ) where

import qualified Data.Aeson as A
import qualified Data.Text as T

import Data.Aeson ((.=), object, toJSON)
import Data.Aeson.Types (Pair)
import Data.Maybe (mapMaybe)

#if !(MIN_VERSION_base(4, 12, 0))
import Data.Monoid ((<>))
#endif

import Graphics.Vega.VegaLite.Data
  ( DataValue
  , DataValues
  , dataValueSpec
  , dataValuesSpecs
  )
import Graphics.Vega.VegaLite.Foundation
  ( FieldName
  , SortField
  , sortFieldSpec
  -- , field_
  , fromT
  , allowNull
  )
import Graphics.Vega.VegaLite.Specification
  ( VLSpec
  , TransformSpec(..)
  , SelectionLabel
  )


{-|

Type of aggregation operation. See the
<https://vega.github.io/vega-lite/docs/aggregate.html#ops Vega-Lite documentation>
for more details.

The @Average@ constructor was removed in version @0.4.0.0@; use 'Mean' instead.

-}
data Operation
    = ArgMax (Maybe FieldName)
      -- ^ An input data object containing the maximum field value to be used
      --   in an aggregation operation.
      --
      --   If supplied as part of an encoding aggregation, the parameter
      --   should be 'Just' the name of the field to maximise. When used
      --   as part of a transform the parameter should be 'Nothing' as the
      --   field is specified in the 'Graphics.Vega.VegaLite.aggregate' call.
      --
      --   Encoding example, to find the production budget for the maximum
      --   US grossing film in each genre:
      --
      --   @
      --   'Graphics.Vega.VegaLite.encoding'
      --     . 'Graphics.Vega.VegaLite.position' 'Graphics.Vega.VegaLite.X'
      --                [ 'Graphics.Vega.VegaLite.PName' \"Production_Budget\"
      --                , 'Graphics.Vega.VegaLite.PmType' 'Graphics.Vega.VegaLite.Quantitative'
      --                , 'Graphics.Vega.VegaLite.PAggregate' ('ArgMax' ('Just' \"US_Gross\"))
      --                ]
      --     . 'Graphics.Vega.VegaLite.position' 'Graphics.Vega.VegaLite.Y' ['Graphics.Vega.VegaLite.PName' \"Major_Genre\", 'Graphics.Vega.VegaLite.PmType' 'Graphics.Vega.VegaLite.Nominal']
      --   @
      --
      --   An example of its use as part of an 'Graphics.Vega.VegaLite.aggregate' call:
      --
      --   @
      --   'Graphics.Vega.VegaLite.transform'
      --     . 'Graphics.Vega.VegaLite.aggregate'
      --         [ 'Graphics.Vega.VegaLite.opAs' ('ArgMax' 'Nothing') \"US_Gross\" \"amUSGross\"]
      --         [\"Major_Genre\"]
      --   @
      --
      --   The optional field name was added in the @0.4.0.0@ release.
    | ArgMin (Maybe FieldName)
      -- ^ An input data object containing the minimum field value to be used
      --   in an aggregation operation. See 'ArgMax' for a discussion of the
      --   optional argument.
      --
      --   The optional field name was added in the @0.4.0.0@ release.
    | CI0
      -- ^ Lower 95% confidence interval to be used in an aggregation operation.
    | CI1
      -- ^ Upper 95% confidence interval to be used in an aggregation operation.
    | Count
      -- ^ Total count of data objects to be used in an aggregation operation.
    | Distinct
      -- ^ Count of distinct data objects to be used in an aggregation operation.
    | Max
      -- ^ Maximum field value to be used in an aggregation operation.
    | Mean
      -- ^ Mean field value to be used in an aggregation operation.
    | Median
      -- ^ Median field value to be used in an aggregation operation.
    | Min
      -- ^ Minimum field value to be used in an aggregation operation.
    | Missing
      -- ^ Count of @null@ or @undefined@ field value to be used in an aggregation operation.
    | Product
      -- ^ Product of field values to be used in an aggregate operation.
      --
      --   This was added in Vega-Lite 4.6.0.
      --
      --   @since 0.7.0.0
    | Q1
      -- ^ Lower quartile boundary of field values to be used in an aggregation operation.
    | Q3
      -- ^ Upper quartile boundary of field values to be used in an aggregation operation.
    | Stderr
      -- ^ Standard error of field values to be used in an aggregate operation.
    | Stdev
      -- ^ Sample standard deviation of field values to be used in an aggregate operation.
    | StdevP
      -- ^ Population standard deviation of field values to be used in an aggregate operation.
    | Sum
      -- ^ Sum of field values to be used in an aggregate operation.
    | Valid
      -- ^ Count of values that are not @null@, @undefined@, or @NaN@ to be used in an
      -- aggregation operation.
    | Variance
      -- ^ Sample variance of field values to be used in an aggregate operation.
    | VarianceP
      -- ^ Population variance of field values to be used in an aggregate operation.


-- Unlike Elm, not checking if the string is empty for ArgMin/Max

operationSpec :: Operation -> VLSpec
operationSpec :: Operation -> VLSpec
operationSpec (ArgMax Maybe FieldName
Nothing) = VLSpec
"argmax"
operationSpec (ArgMax (Just FieldName
s)) = [Pair] -> VLSpec
object [Key
"argmax" Key -> FieldName -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= FieldName
s]
operationSpec (ArgMin Maybe FieldName
Nothing) = VLSpec
"argmin"
operationSpec (ArgMin (Just FieldName
s)) = [Pair] -> VLSpec
object [Key
"argmin" Key -> FieldName -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= FieldName
s]
operationSpec Operation
CI0 = VLSpec
"ci0"
operationSpec Operation
CI1 = VLSpec
"ci1"
operationSpec Operation
Count = VLSpec
"count"
operationSpec Operation
Distinct = VLSpec
"distinct"
operationSpec Operation
Max = VLSpec
"max"
operationSpec Operation
Mean = VLSpec
"mean"
operationSpec Operation
Median = VLSpec
"median"
operationSpec Operation
Min = VLSpec
"min"
operationSpec Operation
Missing = VLSpec
"missing"
operationSpec Operation
Product = VLSpec
"product"
operationSpec Operation
Q1 = VLSpec
"q1"
operationSpec Operation
Q3 = VLSpec
"q3"
operationSpec Operation
Stderr = VLSpec
"stderr"
operationSpec Operation
Stdev = VLSpec
"stdev"
operationSpec Operation
StdevP = VLSpec
"stdevp"
operationSpec Operation
Sum = VLSpec
"sum"
operationSpec Operation
Valid = VLSpec
"valid"
operationSpec Operation
Variance = VLSpec
"variance"
operationSpec Operation
VarianceP = VLSpec
"variancep"


aggregate_ :: Operation -> Pair
aggregate_ :: Operation -> Pair
aggregate_ Operation
op = Key
"aggregate" Key -> VLSpec -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Operation -> VLSpec
operationSpec Operation
op

op_ :: Operation -> Pair
op_ :: Operation -> Pair
op_ Operation
op = Key
"op" Key -> VLSpec -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Operation -> VLSpec
operationSpec Operation
op


-- | Window transformations.
--
--   @since 0.4.0.0

data Window
    = WAggregateOp Operation
      -- ^ An aggregrate operation to be used in a window transformation.
    | WOp WOperation
      -- ^ Window-specific operation to be used in a window transformation.
    | WParam Int
      -- ^ Numeric parameter for window-only operations that can be parameterised
      --   ('Ntile', 'Lag', 'Lead' and 'NthValue').
    | WField FieldName
      -- ^ Field for which to compute a window operation. Not needed for operations
      --   that do not apply to fields such as 'Count', 'Rank', and 'DenseRank'.


windowFieldProperty :: Window -> Pair
windowFieldProperty :: Window -> Pair
windowFieldProperty (WAggregateOp Operation
op) = Key
"op" Key -> VLSpec -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Operation -> VLSpec
operationSpec Operation
op
windowFieldProperty (WOp WOperation
op) = Key
"op" Key -> FieldName -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= WOperation -> FieldName
wOperationLabel WOperation
op
windowFieldProperty (WParam Int
n) = Key
"param" Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
n
windowFieldProperty (WField FieldName
f) = Key
"field" Key -> FieldName -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= FieldName
f  -- was "field_ f"


-- | Window-specific operation for transformations (for use with 'WOp').
--
--   @since 0.4.0.0

data WOperation
    = RowNumber
      -- ^ Assign consecutive row number to values in a data object to be applied in a window transform.
    | Rank
      -- ^ Rank function to be applied in a window transform.
    | DenseRank
      -- ^ Dense rank function to be applied in a window transform.
    | PercentRank
      -- ^ Percentile of values in a sliding window to be applied in a window transform.
    | CumeDist
      -- ^ Cumulative distribution function to be applied in a window transform.
    | Ntile
      -- ^ Value preceding the current object in a sliding window to be applied in a window transform.
    | Lag
      -- ^ Value preceding the current object in a sliding window to be applied in a window transform.
    | Lead
      -- ^ Value following the current object in a sliding window to be applied in a window transform.
    | FirstValue
      -- ^ First value in a sliding window to be applied in a window transform.
    | LastValue
      -- ^ Last value in a sliding window to be applied in a window transform.
    | NthValue
      -- ^ Nth value in a sliding window to be applied in a window transform.


wOperationLabel :: WOperation -> T.Text
wOperationLabel :: WOperation -> FieldName
wOperationLabel WOperation
RowNumber = FieldName
"row_number"
wOperationLabel WOperation
Rank = FieldName
"rank"
wOperationLabel WOperation
DenseRank = FieldName
"dense_rank"
wOperationLabel WOperation
PercentRank = FieldName
"percent_rank"
wOperationLabel WOperation
CumeDist = FieldName
"cume_dist"
wOperationLabel WOperation
Ntile = FieldName
"ntile"
wOperationLabel WOperation
Lag = FieldName
"lag"
wOperationLabel WOperation
Lead = FieldName
"lead"
wOperationLabel WOperation
FirstValue = FieldName
"first_value"
wOperationLabel WOperation
LastValue = FieldName
"last_value"
wOperationLabel WOperation
NthValue = FieldName
"nth_value"

{-|

Type of binning property to customise. See the
<https://vega.github.io/vega-lite/docs/bin.html Vega-Lite documentation> for
more details.

This is used with: 'Graphics.Vega.VegaLite.binAs', 'Graphics.Vega.VegaLite.DBin', 'Graphics.Vega.VegaLite.FBin', 'Graphics.Vega.VegaLite.HBin', 'Graphics.Vega.VegaLite.MBin', 'Graphics.Vega.VegaLite.OBin',
'Graphics.Vega.VegaLite.PBin', and 'Graphics.Vega.VegaLite.TBin'.

-}

-- based on schema 3.3.0 #/definitions/BinParams

data BinProperty
    = AlreadyBinned Bool
      -- ^ Should the input data be treated as already binned?
      --
      --   @since 0.4.0.0
    | BinAnchor Double
      -- ^ A value in the binned domain at which to anchor the bins, shifting the bin
      --   boundaries if necessary to ensure that a boundary aligns with the anchor
      --   value.
      --
      --   @since 0.4.0.0
    | Base Double
      -- ^ The number base to use for automatic bin determination.
      --
      --   Default is @10@.
    | Divide [Double]
      -- ^ Scale factors indicating allowable subdivisions.
      --
      --   Default is @[5, 2]@.
      --
      --   Prior to @0.4.0.0@ the @Divide@ constructor took two numbers.
    | Extent Double Double
      -- ^ The range (minimum, maximum) of the desired bin values.
    | MaxBins Int
      -- ^ The maxium number of bins.
      --
      --   Default is @6@ for 'Graphics.Vega.VegaLite.row', 'Graphics.Vega.VegaLite.column', and 'Graphics.Vega.VegaLite.shape' channels,
      --   @10@ otherwise.
    | MinStep Double
      -- ^ A minimum allowable step size.
    | Nice Bool
      -- ^ If @True@, the bin boundaries are adjusted to use human-friendly values,
      --   such as multiples of ten.
      --
      --   Default is @True@.
    | SelectionExtent SelectionLabel
      -- ^ Set the range based on an interactive selection. The label
      --   must reference an interval selection, but this constraint is
      --   /not enforced/ at compile or run time.
      --
      --   @
      --   sel = 'Graphics.Vega.VegaLite.selection'
      --         . 'Graphics.Vega.VegaLite.select' \"brush\" 'Graphics.Vega.VegaLite.Interval' [ 'Graphics.Vega.VegaLite.Encodings' [ 'Graphics.Vega.VegaLite.ChX' ] ]
      --   enc = 'Graphics.Vega.VegaLite.encoding'
      --         . 'Graphics.Vega.VegaLite.position' 'Graphics.Vega.VegaLite.X' [ 'Graphics.Vega.VegaLite.PName' \"temperature\"
      --                      , 'Graphics.Vega.VegaLite.PmType' 'Graphics.Vega.VegaLite.Quantitative'
      --                      , 'Graphics.Vega.VegaLite.PBin' [ 'SelectionExtent' \"brush\" ]
      --                      ]
      --   @
      --
      --   @since 0.5.0.0
    | Step Double
      -- ^ The step size to use between bins.
      --
      --   If specified, 'MaxBins' and other related options are ignored.
    | Steps [Double]
      -- ^ Pick the step size from this list.


binProperty :: BinProperty -> Pair
binProperty :: BinProperty -> Pair
binProperty (AlreadyBinned Bool
b) = Key
"binned" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
b
binProperty (BinAnchor Double
x) = Key
"anchor" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
binProperty (Base Double
x) = Key
"base" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
binProperty (Divide [Double]
xs) = Key
"divide" Key -> [Double] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Double]
xs
binProperty (Extent Double
mn Double
mx) = Key
"extent" Key -> [Double] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [ Double
mn, Double
mx ]
binProperty (SelectionExtent FieldName
s) = Key
"extent" Key -> VLSpec -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> VLSpec
object [ Key
"selection" Key -> FieldName -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= FieldName
s ]
binProperty (MaxBins Int
n) = Key
"maxbins" Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
n
binProperty (MinStep Double
x) = Key
"minstep" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
binProperty (Nice Bool
b) = Key
"nice" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
b
binProperty (Step Double
x) = Key
"step" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
x
binProperty (Steps [Double]
xs) = Key
"steps" Key -> [Double] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Double]
xs


bin :: [BinProperty] -> Pair
bin :: [BinProperty] -> Pair
bin [] = Key
"bin" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
True
bin [BinProperty]
xs = Key
"bin" Key -> VLSpec -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> VLSpec
object ((BinProperty -> Pair) -> [BinProperty] -> [Pair]
forall a b. (a -> b) -> [a] -> [b]
map BinProperty -> Pair
binProperty [BinProperty]
xs)

binned_ :: Pair
binned_ :: Pair
binned_ = Key
"bin" Key -> VLSpec -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= FieldName -> VLSpec
fromT FieldName
"binned"


-- | Properties for a window transform.
--
--   @since 0.4.0.0

data WindowProperty
    = WFrame (Maybe Int) (Maybe Int)
      -- ^ Moving window for use by a window transform. When a number is
      --   given, via @Just@, then it indicates the offset from the current
      --   data object. A @Nothing@ indicates an un-bounded number of rows
      --   preceding or following the current data object.
    | WIgnorePeers Bool
      -- ^ Should the sliding window in a window transform ignore peer
      --   values (those considered identical by the sort criteria).
    | WGroupBy [FieldName]
      -- ^ The fields for partitioning data objects in a window transform
      --   into separate windows. If not specified, all points will be in a
      --   single group.
    | WSort [SortField]
      -- ^ Comparator for sorting data objects within a window transform.


-- This is different to how Elm's VegaLite handles this (as of version 1.12.0)
-- Helpers for windowPropertySpec

wpFrame , wpIgnorePeers, wpGroupBy, wpSort :: WindowProperty -> Maybe VLSpec
wpFrame :: WindowProperty -> Maybe VLSpec
wpFrame (WFrame Maybe Int
m1 Maybe Int
m2) = VLSpec -> Maybe VLSpec
forall a. a -> Maybe a
Just ([VLSpec] -> VLSpec
forall a. ToJSON a => a -> VLSpec
toJSON [Maybe Int -> VLSpec
allowNull Maybe Int
m1, Maybe Int -> VLSpec
allowNull Maybe Int
m2])
wpFrame WindowProperty
_ = Maybe VLSpec
forall a. Maybe a
Nothing

wpIgnorePeers :: WindowProperty -> Maybe VLSpec
wpIgnorePeers (WIgnorePeers Bool
b) = VLSpec -> Maybe VLSpec
forall a. a -> Maybe a
Just (Bool -> VLSpec
forall a. ToJSON a => a -> VLSpec
toJSON Bool
b)
wpIgnorePeers WindowProperty
_ = Maybe VLSpec
forall a. Maybe a
Nothing

wpGroupBy :: WindowProperty -> Maybe VLSpec
wpGroupBy (WGroupBy [FieldName]
fs) = VLSpec -> Maybe VLSpec
forall a. a -> Maybe a
Just ([FieldName] -> VLSpec
forall a. ToJSON a => a -> VLSpec
toJSON [FieldName]
fs)
wpGroupBy WindowProperty
_ = Maybe VLSpec
forall a. Maybe a
Nothing

wpSort :: WindowProperty -> Maybe VLSpec
wpSort (WSort [SortField]
sfs) = VLSpec -> Maybe VLSpec
forall a. a -> Maybe a
Just ([VLSpec] -> VLSpec
forall a. ToJSON a => a -> VLSpec
toJSON ((SortField -> VLSpec) -> [SortField] -> [VLSpec]
forall a b. (a -> b) -> [a] -> [b]
map SortField -> VLSpec
sortFieldSpec [SortField]
sfs))
wpSort WindowProperty
_ = Maybe VLSpec
forall a. Maybe a
Nothing

windowTS ::
  [([Window], FieldName)]
  -> [WindowProperty]
  -> TransformSpec
windowTS :: [([Window], FieldName)] -> [WindowProperty] -> TransformSpec
windowTS [([Window], FieldName)]
wss [WindowProperty]
wps =
  let addField :: Key -> (WindowProperty -> Maybe v) -> [a]
addField Key
n WindowProperty -> Maybe v
a = case (WindowProperty -> Maybe v) -> [WindowProperty] -> [v]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe WindowProperty -> Maybe v
a [WindowProperty]
wps of
                       [v
x] -> [Key
n Key -> v -> a
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= v
x]
                       [v]
_ -> []

      winFieldDef :: ([Window], v) -> VLSpec
winFieldDef ([Window]
ws, v
out) = [Pair] -> VLSpec
object (Key
"as" Key -> v -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= v
out Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: (Window -> Pair) -> [Window] -> [Pair]
forall a b. (a -> b) -> [a] -> [b]
map Window -> Pair
windowFieldProperty [Window]
ws)

      fields :: [Pair]
fields = [ Key
"window" Key -> [VLSpec] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (([Window], FieldName) -> VLSpec)
-> [([Window], FieldName)] -> [VLSpec]
forall a b. (a -> b) -> [a] -> [b]
map ([Window], FieldName) -> VLSpec
forall v. ToJSON v => ([Window], v) -> VLSpec
winFieldDef [([Window], FieldName)]
wss ]
               [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> Key -> (WindowProperty -> Maybe VLSpec) -> [Pair]
forall a v.
(KeyValue a, ToJSON v) =>
Key -> (WindowProperty -> Maybe v) -> [a]
addField Key
"frame" WindowProperty -> Maybe VLSpec
wpFrame
               [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> Key -> (WindowProperty -> Maybe VLSpec) -> [Pair]
forall a v.
(KeyValue a, ToJSON v) =>
Key -> (WindowProperty -> Maybe v) -> [a]
addField Key
"ignorePeers" WindowProperty -> Maybe VLSpec
wpIgnorePeers
               [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> Key -> (WindowProperty -> Maybe VLSpec) -> [Pair]
forall a v.
(KeyValue a, ToJSON v) =>
Key -> (WindowProperty -> Maybe v) -> [a]
addField Key
"groupby" WindowProperty -> Maybe VLSpec
wpGroupBy
               [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> Key -> (WindowProperty -> Maybe VLSpec) -> [Pair]
forall a v.
(KeyValue a, ToJSON v) =>
Key -> (WindowProperty -> Maybe v) -> [a]
addField Key
"sort" WindowProperty -> Maybe VLSpec
wpSort

  in VLSpec -> TransformSpec
TS ([Pair] -> VLSpec
object [Pair]
fields)


joinAggregateTS :: [VLSpec] -> [WindowProperty] -> TransformSpec
joinAggregateTS :: [VLSpec] -> [WindowProperty] -> TransformSpec
joinAggregateTS [VLSpec]
ops [WindowProperty]
wps =
  let addField :: Key -> (WindowProperty -> Maybe v) -> [a]
addField Key
n WindowProperty -> Maybe v
a = case (WindowProperty -> Maybe v) -> [WindowProperty] -> [v]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe WindowProperty -> Maybe v
a [WindowProperty]
wps of
                       [v
x] -> [Key
n Key -> v -> a
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= v
x]
                       [v]
_ -> []

      fields :: [Pair]
fields = [ Key
"joinaggregate" Key -> [VLSpec] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [VLSpec]
ops ]
               [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> Key -> (WindowProperty -> Maybe VLSpec) -> [Pair]
forall a v.
(KeyValue a, ToJSON v) =>
Key -> (WindowProperty -> Maybe v) -> [a]
addField Key
"frame" WindowProperty -> Maybe VLSpec
wpFrame
               [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> Key -> (WindowProperty -> Maybe VLSpec) -> [Pair]
forall a v.
(KeyValue a, ToJSON v) =>
Key -> (WindowProperty -> Maybe v) -> [a]
addField Key
"ignorePeers" WindowProperty -> Maybe VLSpec
wpIgnorePeers
               [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> Key -> (WindowProperty -> Maybe VLSpec) -> [Pair]
forall a v.
(KeyValue a, ToJSON v) =>
Key -> (WindowProperty -> Maybe v) -> [a]
addField Key
"groupby" WindowProperty -> Maybe VLSpec
wpGroupBy
               [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> Key -> (WindowProperty -> Maybe VLSpec) -> [Pair]
forall a v.
(KeyValue a, ToJSON v) =>
Key -> (WindowProperty -> Maybe v) -> [a]
addField Key
"sort" WindowProperty -> Maybe VLSpec
wpSort

  in VLSpec -> TransformSpec
TS ([Pair] -> VLSpec
object [Pair]
fields)


-- | This is used with 'Graphics.Vega.VegaLite.impute' and 'Graphics.Vega.VegaLite.PImpute'.
--
--   @since 0.4.0.0

data ImputeProperty
    = ImFrame (Maybe Int) (Maybe Int)
      -- ^ 1d window over which data imputation values are generated. The two
      --   parameters should either be @Just@ a number indicating the offset from the current
      --   data object, or @Nothing@ to indicate unbounded rows preceding or following the
      --   current data object.
    | ImKeyVals DataValues
      -- ^ Key values to be considered for imputation.
    | ImKeyValSequence Double Double Double
      -- ^ Key values to be considered for imputation as a sequence of numbers between
      --   a start (first parameter), to less than an end (second parameter) in steps of
      --   the third parameter.
    | ImMethod ImMethod
      -- ^ How is the imputed value constructed.
      --
      --   When using @ImMethod 'ImValue'@, the replacement value is
      --   set with 'ImNewValue'.
    | ImGroupBy [FieldName]
      -- ^ Allow imputing of missing values on a per-group basis. For use with the impute
      --   transform only and not a channel encoding.
    | ImNewValue DataValue
      -- ^ The replacement value (when using @ImMethod 'ImValue'@).


imputeProperty :: ImputeProperty -> Pair
imputeProperty :: ImputeProperty -> Pair
imputeProperty (ImFrame Maybe Int
m1 Maybe Int
m2) = Key
"frame" Key -> [VLSpec] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Maybe Int -> VLSpec) -> [Maybe Int] -> [VLSpec]
forall a b. (a -> b) -> [a] -> [b]
map Maybe Int -> VLSpec
allowNull [Maybe Int
m1, Maybe Int
m2]
imputeProperty (ImKeyVals DataValues
dVals) = Key
"keyvals" Key -> [VLSpec] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= DataValues -> [VLSpec]
dataValuesSpecs DataValues
dVals
imputeProperty (ImKeyValSequence Double
start Double
stop Double
step) =
  Key
"keyvals" Key -> VLSpec -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> VLSpec
object [Key
"start" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
start, Key
"stop" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
stop, Key
"step" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
step]
imputeProperty (ImMethod ImMethod
method) = Key
"method" Key -> FieldName -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ImMethod -> FieldName
imMethodLabel ImMethod
method
imputeProperty (ImNewValue DataValue
dVal) = Key
"value" Key -> VLSpec -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= DataValue -> VLSpec
dataValueSpec DataValue
dVal
imputeProperty (ImGroupBy [FieldName]
_) = Key
"groupby" Key -> VLSpec -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= VLSpec
A.Null


imputePropertySpecFrame, imputePropertySpecKeyVals,
  imputePropertySpecKeyValSequence, imputePropertySpecGroupBy,
  imputePropertySpecMethod, imputePropertySpecValue :: ImputeProperty -> Maybe VLSpec

imputePropertySpecFrame :: ImputeProperty -> Maybe VLSpec
imputePropertySpecFrame (ImFrame Maybe Int
m1 Maybe Int
m2) = VLSpec -> Maybe VLSpec
forall a. a -> Maybe a
Just ([VLSpec] -> VLSpec
forall a. ToJSON a => a -> VLSpec
toJSON ((Maybe Int -> VLSpec) -> [Maybe Int] -> [VLSpec]
forall a b. (a -> b) -> [a] -> [b]
map Maybe Int -> VLSpec
allowNull [Maybe Int
m1, Maybe Int
m2]))
imputePropertySpecFrame ImputeProperty
_ = Maybe VLSpec
forall a. Maybe a
Nothing

imputePropertySpecKeyVals :: ImputeProperty -> Maybe VLSpec
imputePropertySpecKeyVals (ImKeyVals DataValues
dVals) = VLSpec -> Maybe VLSpec
forall a. a -> Maybe a
Just ([VLSpec] -> VLSpec
forall a. ToJSON a => a -> VLSpec
toJSON (DataValues -> [VLSpec]
dataValuesSpecs DataValues
dVals))
imputePropertySpecKeyVals ImputeProperty
_ = Maybe VLSpec
forall a. Maybe a
Nothing

imputePropertySpecKeyValSequence :: ImputeProperty -> Maybe VLSpec
imputePropertySpecKeyValSequence (ImKeyValSequence Double
start Double
stop Double
step) =
  let obj :: [Pair]
obj = [Key
"start" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
start, Key
"stop" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
stop, Key
"step" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Double
step]
  in VLSpec -> Maybe VLSpec
forall a. a -> Maybe a
Just ([Pair] -> VLSpec
object [Pair]
obj)
imputePropertySpecKeyValSequence ImputeProperty
_ = Maybe VLSpec
forall a. Maybe a
Nothing

imputePropertySpecGroupBy :: ImputeProperty -> Maybe VLSpec
imputePropertySpecGroupBy (ImGroupBy [FieldName]
fields) = VLSpec -> Maybe VLSpec
forall a. a -> Maybe a
Just ([FieldName] -> VLSpec
forall a. ToJSON a => a -> VLSpec
toJSON [FieldName]
fields)
imputePropertySpecGroupBy ImputeProperty
_ = Maybe VLSpec
forall a. Maybe a
Nothing

imputePropertySpecMethod :: ImputeProperty -> Maybe VLSpec
imputePropertySpecMethod (ImMethod ImMethod
method) = VLSpec -> Maybe VLSpec
forall a. a -> Maybe a
Just (FieldName -> VLSpec
forall a. ToJSON a => a -> VLSpec
toJSON (ImMethod -> FieldName
imMethodLabel ImMethod
method))
imputePropertySpecMethod ImputeProperty
_ = Maybe VLSpec
forall a. Maybe a
Nothing

imputePropertySpecValue :: ImputeProperty -> Maybe VLSpec
imputePropertySpecValue (ImNewValue DataValue
dVal) = VLSpec -> Maybe VLSpec
forall a. a -> Maybe a
Just (DataValue -> VLSpec
dataValueSpec DataValue
dVal)
imputePropertySpecValue ImputeProperty
_ = Maybe VLSpec
forall a. Maybe a
Nothing


impute_ :: [ImputeProperty] -> Pair
impute_ :: [ImputeProperty] -> Pair
impute_ [ImputeProperty]
ips = Key
"impute" Key -> VLSpec -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> VLSpec
object ((ImputeProperty -> Pair) -> [ImputeProperty] -> [Pair]
forall a b. (a -> b) -> [a] -> [b]
map ImputeProperty -> Pair
imputeProperty [ImputeProperty]
ips)


imputeTS ::
  FieldName
  -- ^ The data field to process.
  -> FieldName
  -- ^ The key field to uniquely identify data objects within a group.
  -> [ImputeProperty]
  -- ^ Define how the imputation works.
  -> TransformSpec
imputeTS :: FieldName -> FieldName -> [ImputeProperty] -> TransformSpec
imputeTS FieldName
field FieldName
key [ImputeProperty]
imProps =
  let addField :: Key -> (ImputeProperty -> Maybe v) -> [a]
addField Key
n ImputeProperty -> Maybe v
a = case (ImputeProperty -> Maybe v) -> [ImputeProperty] -> [v]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ImputeProperty -> Maybe v
a [ImputeProperty]
imProps of
                       [v
x] -> [Key
n Key -> v -> a
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= v
x]
                       [v]
_ -> []

      fields :: [Pair]
fields = [ Key
"impute" Key -> FieldName -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= FieldName
field
               , Key
"key" Key -> FieldName -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= FieldName
key ]
               [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> Key -> (ImputeProperty -> Maybe VLSpec) -> [Pair]
forall a v.
(KeyValue a, ToJSON v) =>
Key -> (ImputeProperty -> Maybe v) -> [a]
addField Key
"frame" ImputeProperty -> Maybe VLSpec
imputePropertySpecFrame
               -- TODO: can we combine the keyvals options?
               [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> Key -> (ImputeProperty -> Maybe VLSpec) -> [Pair]
forall a v.
(KeyValue a, ToJSON v) =>
Key -> (ImputeProperty -> Maybe v) -> [a]
addField Key
"keyvals" ImputeProperty -> Maybe VLSpec
imputePropertySpecKeyVals
               [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> Key -> (ImputeProperty -> Maybe VLSpec) -> [Pair]
forall a v.
(KeyValue a, ToJSON v) =>
Key -> (ImputeProperty -> Maybe v) -> [a]
addField Key
"keyvals" ImputeProperty -> Maybe VLSpec
imputePropertySpecKeyValSequence
               [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> Key -> (ImputeProperty -> Maybe VLSpec) -> [Pair]
forall a v.
(KeyValue a, ToJSON v) =>
Key -> (ImputeProperty -> Maybe v) -> [a]
addField Key
"method" ImputeProperty -> Maybe VLSpec
imputePropertySpecMethod
               [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> Key -> (ImputeProperty -> Maybe VLSpec) -> [Pair]
forall a v.
(KeyValue a, ToJSON v) =>
Key -> (ImputeProperty -> Maybe v) -> [a]
addField Key
"groupby" ImputeProperty -> Maybe VLSpec
imputePropertySpecGroupBy
               [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> Key -> (ImputeProperty -> Maybe VLSpec) -> [Pair]
forall a v.
(KeyValue a, ToJSON v) =>
Key -> (ImputeProperty -> Maybe v) -> [a]
addField Key
"value" ImputeProperty -> Maybe VLSpec
imputePropertySpecValue

  in VLSpec -> TransformSpec
TS ([Pair] -> VLSpec
object [Pair]
fields)


-- | Imputation method to use when replacing values.
--
--   @since 0.4.0.0

data ImMethod
  = ImMin
    -- ^ Use the minimum value.
  | ImMax
    -- ^ Use the maximum value.
  | ImMean
    -- ^ Use the mean value.
  | ImMedian
    -- ^ Use the median value.
  | ImValue
    -- ^ Use a replacement value (set with @ImNewValue@).


imMethodLabel :: ImMethod -> T.Text
imMethodLabel :: ImMethod -> FieldName
imMethodLabel ImMethod
ImMin = FieldName
"min"
imMethodLabel ImMethod
ImMax = FieldName
"max"
imMethodLabel ImMethod
ImMean = FieldName
"mean"
imMethodLabel ImMethod
ImMedian = FieldName
"median"
imMethodLabel ImMethod
ImValue = FieldName
"value"