R/dynamic_table.R

In HarryRosen/hrimodules: Harry Rosen Inc Shiny Modules

#' Dynamic Table UI for bs4Dash
#'
#' Creates a dynamic dataTable for the reactive dataset handled by the table_data() function
#' and is served to the server side based on an input dataset
#'
#' @param id string the id from which to generate a namespace for the module
#' @param name The name of the datatable
#' @param tbl_width string the label for the left UI element
#' @param handler_width numeric the width of the right UI element column (of 12)
#'
#' @return HTML code for UI corresponding to the `dynamic_table_server()` function
#'
#' @export
dynamic_table_ui = function(id,
                            name = "Dynamic DataTable",
                            tbl_width = 12,
                            handler_width = 3) {
  ns = NS(id)


  fluidRow(column(width = tbl_width, DT::dataTableOutput(ns("dt"), width = "100%")))
}



#' Dynamic Table for the bs4Dash Template
#'
#' Generate a server for handling a dynamic table and download handler function
#' for a data.frame being displayed
#'
#' @param input standard shiny input onject
#' @param output standard shiny output object
#' @param session standard shiny session object
#' @param base_data a *reactive* `data.frame` with at least two string columns:
#' - `store`
#' - `segment`
#' @param handler_col_styles `character array` array to handle the column styles into the excel file
#' @param handler_col_names `character array` array to handle the column names for the excel file
#' @param excel_title `character` title passed to the excel file
#' @param excel_subtitle `character` subtitle passed to the excel file
#' @param excel_sheetname `character` sheet name passed to the excel file
#' @param file_name `character` file name to be set for the downloadable excel file
#' @param currency_pattern `character` file name to be set for the downloadable excel file
#' @param pct_pattern `character` file name to be set for the downloadable excel file
#' @param file_name `character` file name to be set for the downloadable excel file
#' @param currency_pattern The pattern for columns to format as a currency
#' @param pct_pattern The pattern for columns to format as a percentage
#' @param path location of additional resources, specifically the RowGroups.js
#' @param extensions the selected extensions to add to the datatable output
#' @param colour_cols The columns selected for adding colours
#' @param server Server-side rendering of the data in a datatable output
#' @param row_names Whether or not to enable row_names of the dynamic table
#' @param escape Whether or not to provide the escape option for elements in the datatable
#' @param opts Additional options to be passed to a datatable object
#'
#' @return a *reactive* `data.frame` with the same structure as `base_data`
#' but containing only the rows represented by the UI selections
#'
#' @import magrittr
#'
#' @export
dynamic_table_server = function(input,
                                output,
                                session,
                                base_data,
                                handler_col_styles = c('text',
                                                       'text',
                                                       'count',
                                                       'count',
                                                       'percent',
                                                       "count",
                                                       "count",
                                                       "percent"),
                                handler_col_names = c(
                                  "Store Code",
                                  "Store Name",
                                  "Clients (#)",
                                  "Called (#)",
                                  "Completed (%)",
                                  "In SLX (#)",
                                  "In Herringbone (#)",
                                  "Likely False (%)"
                                ),
                                excel_title = "Top Client Focus List",
                                excel_subtitle = "All Stores",
                                excel_sheetname = "Chain",
                                file_name = "The Excel File",
                                currency_pattern = "sale|returns|spend",
                                pct_pattern = "\\%",
                                path = "www",
                                extensions = c('Buttons', 'FixedColumns', 'RowGroup'),
                                colour_cols = list(c(3:7, 13:15), c(8:12)),
                                server = T,
                                row_names = NULL,
                                escape = F,
                                opts = dt_opts()) {
  #Determine if the column names field is a reactive value
  if (is.reactive(handler_col_names)) {
    observe(handler_col_names())
    col_names <- reactive(handler_col_names())
  } else{
    #If it isn't a reactive value, make it a reactive!
    col_names <- reactive(handler_col_names)
  }
  #Determine if the column styles field is a reactive value
  if (is.reactive(handler_col_styles)) {
    observe(handler_col_styles())
    col_styles <- reactive(handler_col_styles())
  } else{
    #If it isn't a reactive value, make it a reactive!
    col_styles <- reactive(handler_col_styles)
  }
  # folder containing dataTables.rowsGroup.js
  # dep <-
  #   htmltools::htmlDependency(
  #     name = "RowsGroup",
  #     version =  "2.0.0",
  #     src = "www",
  #     script = "dataTables.rowsGroup.js"
  #   )

  #Requirements check to ensure that there are essential columns that exist in the dataframe
  df_ <- reactive({
    base_data()
  })
  #Display the data frame in a renderDataTable piece
  output[['dt']] <- DT::renderDataTable({
    req(nrow(df_()) > 0)
    DT::datatable(
      df_(),
      rownames = row_names,
      colnames = col_names(),
      extensions = extensions,
      options = opts,
      escape = escape
    ) -> dtable
    if (length(which(grepl(
      currency_pattern, tolower(col_names())
    ))) > 0)
      dtable %<>% DT::formatCurrency(which(grepl(
        currency_pattern, tolower(col_names())
      )), digits = 0)
    if (length(which(grepl(pct_pattern, tolower(col_names(

    ))))) > 0)
      dtable %<>% DT::formatPercentage(which(grepl(pct_pattern, tolower(col_names(

      )))))

    # dtable$dependencies <- c(dtable$dependencies, list(dep))
    if (length(colour_cols) >= 1)
      dtable %<>% DT::formatStyle(columns = colour_cols[[1]], backgroundColor = "#f9f9f9")
    if (length(colour_cols) >= 2)
      dtable %<>% DT::formatStyle(columns = colour_cols[[2]], backgroundColor = "#f2f2f2")

    dtable
  }, server = server)

}