R/notes.R

In IskanderBlue/morseldash: Makes Building Dashboards for Morsel Easier

#' #' Makes UI for intent KPI gauge & slider.
#' #'
#' #' Makes UI for intent KPI gauge & slider.
#' #' @export
#' #' @seealso \code{\link{intentGauge}}
#' #' @param id Module namespace.
#' #' @param hovertext string, shinyBS::bsTooltip's title parameter; displayed when cursor hovers over plot
#' #' @return A shiny tagList() containing a flexdashboard gauge and sliderInput.
#' newCsatGaugeUI <- function(id, hovertext = NULL) {
#'   ns <- shiny::NS(id)
#'   shiny::tagList(
#'     flexdashboard::gaugeOutput(
#'       ns("csat_gauge"), width = "100%", height = "100%"),
#'     shinyBS::bsTooltip(id = ns("csat_gauge"), hovertext, placement = "top")
#'   )
#' }
#' #' Server-side code for intent KPI gauge & slider.
#' #'
#' #' Server-side code for intent KPI gauge & slider.  Uses dplyr:: functions to figure out what percentage of users intend to buy the product.
#' #' @export
#' #' @seealso \code{\link{intentGaugeUI}}
#' #' @param input Required for shiny modules' server functions.
#' #' @param output Required for shiny modules' server functions.
#' #' @param session Required for shiny modules' server functions.
#' #' @param ddat dataframe, data filtered by desired variables (probably demographic or demographic and product).
#' #' @param pcol numeric, number of the column in fdat containing data for gauge.
#' #' @param title string, gauge's title.
#' #' @param color_cutoff numeric, cutoff between different colours for the gauge.
#' #' @param minRange numeric, gauge's minimum value.
#' #' @param maxRange numeric, gauge's maximum value.
#' #' @param reversed logical, denotes whether gauge colours should be reversed (ie. warning colour for high values, happy colour for low values).
#' #' @param symbol string, e.g. "%" or "miles" or whatever unit your gauge is showing.
#' newCsatGauge <- function(#OLD: input, output, session, fdat, intent_col,
#'                       input, output, session, ddat, pcol, title,
#'                       color_cutoff, minRange, maxRange, reversed, symbol = NULL) {
#'   csat_gauge_reactive <- shiny::reactive({
#'     val_dat(ddat())
#'     flexdashboard::gauge(
#'       ddat() %>%
#'         dplyr::rename(target_col = pcol) %>%
#'         dplyr::group_by(target_col) %>%
#'         dplyr::count() %>%
#'         dplyr::ungroup() %>%
#'         dplyr::mutate(per=`n`/sum(`n`)) %>%
#'         dplyr::filter(target_col %in% "Yes") %>%
#'         dplyr::select(`per`) %>%
#'         colSums() %>%
#'         prod(100) %>%
#'         round(2),
#'       min = minRange, max = maxRange, symbol = symbol, label = title,
#'       flexdashboard::gaugeSectors(
#'         success = c(color_cutoff + 0.5, maxRange),
#'         warning = c(color_cutoff - 0.5, color_cutoff + 0.5),
#'         danger = c(minRange, color_cutoff - 0.5),
#'         colors = c("success", "warning", "danger"))
#'     )
#'   })
#'   output$csat_gauge <- flexdashboard::renderGauge({csat_gauge_reactive()})
#' }
# awareness_col <- 13
# intent_col <- 44
# recommend_col <- 42
# sprouts_col <- 46
# reversed = FALSE
# for (i in c(awareness_col, intent_col, recommend_col, sprouts_col)) {
#   print(rating_diff_value(df, i, 10) %>% rating_diff_box(reversed))
# }
# min_val = 0
# max_val = 100
# warning_range = 10
# flexdashboard::gaugeSectors(
#   success = c(min_val, warning_range-0.05),
#   warning = c(warning_range-0.05, warning_range+0.05),
#   danger = c(warning_range+0.05, max_val))
# lt <- "test-text"
# wr <- 10

# gauge_preset(df, awareness_col, lt, wr, max_val = 100)
# wd <- getwd()
# setwd("/home/rob/Documents/repos/Reporting/theo")
# setwd(wd)

# df


# Obsolete
#' # Intent KPI gauge
#'
#' #' Makes UI for intent KPI gauge & slider.
#' #'
#' #' Makes UI for intent KPI gauge & slider.
#' #' @export
#' #' @seealso \code{\link{intentGauge}}
#' #' @param id Module namespace.
#' #' @param hovertext string, shinyBS::bsTooltip's title parameter; displayed when cursor hovers over plot
#' #' @return A shiny tagList() containing a flexdashboard gauge and sliderInput.
#' intentGaugeUI <- function(id, hovertext = NULL) {
#'   ns <- shiny::NS(id)
#'   shiny::tagList(
#'     flexdashboard::gaugeOutput(
#'       ns("percentage"), width = "100%", height = "100%"),
#'     shiny::sliderInput(ns("purchase_threshold"), "Purchase intent threshold:",
#'                        min = 0, max = 100, value = 40),
#'     shinyBS::bsTooltip(id = ns("percentage"), hovertext, placement = "top")
#'   )
#' }
#' #' Server-side code for intent KPI gauge & slider.
#' #'
#' #' Server-side code for intent KPI gauge & slider.  Uses dplyr:: functions to figure out what percentage of users intend to buy the product.
#' #' @export
#' #' @seealso \code{\link{intentGaugeUI}}
#' #' @param input Required for shiny modules' server functions.
#' #' @param output Required for shiny modules' server functions.
#' #' @param session Required for shiny modules' server functions.
#' #' @param fdat dataframe, filtered by demographic variables and product.
#' #' @param intent_col numeric, the number of fdat's column containing the intent question.
#' intentGauge <- function(input, output, session, fdat, intent_col) {
#'   # intent_col is the number of fdat's column containing the intent question
#'   purchase_gauge_reactive <- shiny::reactive({
#'     val_dat(fdat())
#'     flexdashboard::gauge(
#'       fdat() %>%
#'         dplyr::rename(target_col = intent_col) %>%
#'         dplyr::group_by(target_col) %>%
#'         dplyr::count() %>%
#'         dplyr::ungroup() %>%
#'         dplyr::mutate(per=`n`/sum(`n`)) %>%
#'         dplyr::filter(target_col %in% "Yes") %>%
#'         dplyr::select(`per`) %>%
#'         colSums() %>%
#'         prod(100) %>%
#'         round(2),
#'       min = 0, max = 100, symbol = '%', label = paste("Intend to purchase"),
#'       flexdashboard::gaugeSectors(
#'         success = c(input$purchase_threshold + 0.5, 100),
#'         warning = c(input$purchase_threshold - 0.5,
#'                     input$purchase_threshold + 0.5),
#'         danger = c(0, input$purchase_threshold - 0.5),
#'         colors = c("success", "warning", "danger"))
#'     )
#'   })
#'   output$percentage <- flexdashboard::renderGauge({purchase_gauge_reactive()})
#' }



### NOT WORKING
#' #' For updating thresholds/ benchmarks.
#' #'
#' #' For updating thresholds/ benchmarks.
#' #' @export
#' #' @seealso \code{\link{benchmarker}}
#' #' @param id Module namespace.
#' #' @return A shiny tagList() containing a pickerInput and either a sliderInput or another pickerInput.
#' benchmarkerUI <- function(id) {
#'   ns <- shiny::NS(id)
#'   shiny::uiOutput(ns("threshold"))
#' }
#' #' Server-side code for updating thresholds/ benchmarks.
#' #'
#' #' Server-side code for updating thresholds/ benchmarks.
#' #' @export
#' #' @param input Required for shiny modules' server functions.
#' #' @param output Required for shiny modules' server functions.
#' #' @param session Required for shiny modules' server functions.
#' #' @param threshDefaults vector, named values; names: strings displayed on picker, values: numeric values or defaults.
#' #' @param minVal numeric, minimum value for slider; default 0
#' #' @param maxVal numeric, maximum valuefor slider; default 100
#' #' @return The current benchmark value.
#' benchmarker <- function(input, output, session,
#'                         threshDefaults, minVal = 0, maxVal = 100) {
#'   threshhold <- reactiveValues(value = threshDefaults[1])
#'   observe({threshhold[['value']]  <- input$thresh_picker})
#'   observe({threshhold[['value']]  <- input$thresh_slider})
#'   output$threshold <- renderUI(
#'     tagList(
#'       shinyWidgets::pickerInput(
#'         inputId = session$ns("thresh_picker"),
#'         label = "Select benchmark:",
#'         choices = names(threshDefaults), selected = names(threshDefaults)[1]
#'       ),
#'       shiny::conditionalPanel(
#'         condition = "input.thresh_picker == 'slider'",
#'         shiny::sliderInput(
#'           inputId = session$ns("thresh_slider"),
#'           label = "Select own value:",
#'           min = minVal, max = maxVal,
#'           value = threshold[['value']]
#'         )
#'       ),
#'       shiny::conditionalPanel(
#'         condition = "input.thresh_picker != 'slider'",
#'         shinyWidgets::pickerInput(
#'           inputId = session$ns("thresh_display"),
#'           label = "Benchmark selected:",
#'           min = threshold[['value']] - 0.001,
#'           max = threshold[['value']] + 0.001,
#'           step = 0.05,
#'           value = threshold[['value']]
#'         )
#'       )
#'     )
#'   )
#'   return(reactive({threshold[['value']]}))
#' }


# # Eliminates multiple responses per person -- but adds response for each product
# group_by_primary_sec <- function(x, arrange_by_total = TRUE, mode_by_user = TRUE) {
#   if (isTRUE(mode_by_user)) {
#     m <- x %>%
#       dplyr::group_by(Email) %>%
#       dplyr::summarize(m = md(primary_col)) %>%
#       dplyr::ungroup()
#     tdf <- x %>%
#       dplyr::left_join(m, by = c("Email" = "Email")) %>%
#       dplyr::mutate(m = ifelse(is.null(primary_col), NULL, m)) %>%
#       dplyr::select(-primary_col) %>%
#       dplyr::rename(primary_col = m)
#   } else { tdf <- x }
#   tdf <- tdf %>%
#     group_by(primary_col, sec_col) %>%
#     dplyr::summarize(n = n()) %>%
#     dplyr::ungroup() %>%
#     tidyr::spread(sec_col, n, fill = 0, drop = FALSE) %>%
#     dplyr::mutate(total = rowSums(
#       dplyr::select(., -primary_col)
#     ))
#   if (arrange_by_total == TRUE) {
#     tdf <- tdf %>%
#       dplyr::arrange(total)
#   }
#   return(tdf)
# }