R/pivot.R

Defines functions pivot.table renderPivot pivotOutput pivot

# pivot.R ----------------------------------------------------------------


# Header
# Filename:       pivot.R
# Description:    Contains functions for plotting pivot table charts from js package pivottable using standrad inputs.
# Author:         Nicolas Berta
# Email :         nicolas.berta@gmail.com
# Start Date:     17 October 2017
# Last Revision:  17 October 2017
# Version:        0.0.1
#

# Version History:

# Version   Date                Action
# ----------------------------------
# 0.0.1     17 October 2017     Initial issue

# # Default settings for plotter pivot:
# pivot.defset = defset %<==>% list(
#   # Valid classes for all dimensions
#   dimclass  = list(x = valid.classes, y = valid.classes),
#   multiples = c('x','y'),
#   withRowNames  = F
# )



# https://github.com/nicolaskruchten/pivottable/wiki/Parameters
# Check d3pie from this developer: https://github.com/smartinsightsfromdata/rd3pie

pivot <- function(
  data,
  rows = NULL,
  cols = NULL,
  aggregatorName = NULL,
  vals = NULL,
  rendererName = NULL,
  sorter = NULL,
  exclusions = NULL,
  inclusions = NULL,
  ...,
  width = NULL,
  height = NULL
) {
  # check for data.frame, data.table, or array
  if( length(intersect(class(data),c("data.frame", "data.table", "table","structable", "ftable" ))) == 0 ) {
    stop( "data should be a data.frame, data.table, or table", call.=F)
  }

  #convert table to data.frame
  if( length(intersect(c("table","structable", "ftable"), class(data))) > 0 ) data <- as.data.frame( data )

  params <- list(
    rows = rows,
    cols = cols,
    aggregatorName = aggregatorName,
    vals = vals,
    rendererName = rendererName,
    sorter = sorter,
    ...
  )

  #   auto_box vectors of length 1
  params <- Map( function(p){
    if(length(p) == 1 ){
      p = list(p)
    }
    return(p)
  }
  , params
  )
  # exlusions & inclusions need to be "excluded" from auto_boxing
  par <- list(
    exclusions = exclusions,
    inclusions = inclusions
  )

  params <- c(params, par)

  # remove NULL parameters
  params <- Filter(Negate(is.null), params)

  x <- list(
    data = data,
    params = params
  )

  htmlwidgets::createWidget(
    name = 'pivot',
    x,
    width = width,
    height = height,
    package = 'rvis'
  )
}

## Widget output function for use in Shiny
##
## @param outputId Shiny output ID
## @param width width default '100\%'
## @param height height default '500px'
##
## @examples
##
##   # A simple example - this goes in the ui part of a shiny application
##
##   # pivotOutput("pivot")
##
##
## @export
pivotOutput <- function(outputId, width = '100%', height = '500px'){
  shinyWidgetOutput(outputId, 'pivot', width, height, package = 'rvis')
}

## Widget render function for use in Shiny
##
## @param expr pivot expression
## @param env environment
## @param quoted logical, default = FALSE
##
## @examples
##
##   # A simple example - this goes in the server part of a shiny application
##
##   # output$pivot <- renderPivot({
##   #          pivot(data =   canadianElections   ,  rows = c( "Province"),cols="Party",
##   #          vals = "votes", aggregatorName = "Sum", rendererName = "Table",
##   #          width="100%", height="500px")
##   # })
##
##
##
## @export
renderPivot <- function(expr, env = parent.frame(), quoted = FALSE) {
  if (!quoted) { expr <- substitute(expr) } # force quoted
  shinyRenderWidget(expr, pivotOutput, env, quoted = TRUE)
}


NULL


## Plots a pivot table chart
## @param data data.frame or data.table (R>=1.9.6 for safety) with data to use in the pivot table
## @param rows String name of the column in the data.frame to prepopulate
##              the \strong{rows} of the pivot table.
## @param cols String name of the column in the data.frame to prepopulate
##              the \strong{columns} of the pivot table.
## @param aggregatorName String name of the pivottable.js aggregator to prepopulate the pivot table.
## @param vals String name of the column in the data.frame to use with \code{aggregatorName}. Must be additive (i.e a number).
## @param rendererName List name of the renderer selected, e.g. Table, Heatmap, Treemap etc.
## @param sorter String name this allows to implement a javascript function to specify the ad hoc sorting of certain values. See vignette for an example.
##              It is especially useful with time divisions like days of the week or months of the year (where the alphabetical order does not work).
## @param inclusions List this optional parameter allows to filter the members of a particular dimension "by inclusion".
##              Using the 'Titanic' example, to display only the "Crew" member in the "Class" dimension, it is convenient to filter by inclusion using `inclusions=list(Class="Crew")`.
##              Please note that this only pre-selects the visible filter(s) on the pivot table: the other dimension members are still availabe for selection if needed.
## @param exclusions String this optional parameter allows to filter the members of a particular dimension "by exclusion".
##              Using the 'Titanic' example, to display only the "1st", "2nd" and "3rd" members in the "Class" dimension, it is convenient to filter by exclusion using `exclusions=list(Class="Crew")`.
##              Please note that this only pre-selects the visible filter(s) on the pivot table: the other dimension members are still availabe for selection if needed.
## @param width width parameter
## @param height height parameter
##
## @param ... list other \href{https://github.com/nicolaskruchten/pivottable/wiki/Parameters}{parameters} that
##            can be passed to \code{pivotUI}. See Nicolas's Wiki for more details.
##            A further example of parameter is onRefresh. This parameters (shiny-only) introduces a JS function that allows to get back server side the list of parameters selected by the user.
##            An example is: onRefresh=htmlwidgets::JS("function(config) { Shiny.onInputChange('myPivotData', config); }")
##            This setting makes available server-side a function input$myPivotData that gives back a list (of lists) with all the slice & dice parameters offered by pivottable.
##            See the example onRefresh-shiny.R for an example of how to use this feature.
##            Example of usage could be:
##            These parameters could be saved and re-sent to the user.
##            Alternative they could be used to subset the data item for saving as csv.
##
## @examples
##
##  # use Titanic dataset provided in base R - simple creation with just data
##
##  pivot.table( Titanic )
##
##  # prepopulate multiple columns and multiple rows
##
##  pivot.table( Titanic, rows = c("Class","Sex"), cols = c("Age","Survived" ) )
##
##
##  # A more complete example:
##
##  pivot.table(
##  Titanic,
##  rows = "Survived",
##  cols = c("Class","Sex"),
##  aggregatorName = "Sum as Fraction of Columns",
##  vals = "Freq",
##  rendererName = "Table Barchart"
##  )
##
## # An example with inclusions and exclusions filters:
##
## pivot.table(
## Titanic,
## rows = "Survived",
## cols = c("Class","Sex"),
## aggregatorName = "Sum as Fraction of Columns",
## inclusions = list( Survived = list("Yes")),
## exclusions= list( Class = list( "Crew")),
## vals = "Freq",
## rendererName = "Table Barchart"
## )
##
##
##
##
## @import htmlwidgets
##
## @export
pivot.table = function(obj, ...){

  pivot(obj, ...)
}
genpack/viser documentation built on Jan. 4, 2025, 10:11 p.m.