R/kpis.R

In IskanderBlue/morseldash: Makes Building Dashboards for Morsel Easier

# KPI pieces

#' Makes UI for sample size KPI boxes.
#'
#' Makes UI for sample size KPI boxes showing reviews/ reviewers / offices in sample.
#' @export
#' @seealso \code{\link{sampleSize}}
#' @param id Module namespace.
#' @param hovertext string, RLumShiny::tooltip's text parameter; displayed when cursor hovers over plot
#' @return A shiny tagList() containing formatted text.
sampleSizeUI <- function(id, hovertext = paste0("Some reviewers have submitted ",
                                                "multiple reviews; number of ",
                                                "offices an underestimate.")) {
  ns <- shiny::NS(id)
  shiny::tagList(
    shinydashboard::box(
      title = "SAMPLE SIZE", status = "info", width = 12,
      solidHeader = TRUE, collapsible = TRUE,
      shiny::uiOutput(ns("sample_size")),
      RLumShiny::tooltip(ns("sample_size"), hovertext),
      "Reviews/ reviewers/ offices selected"))
}
#' Makes sample size KPI boxes, server-side.
#'
#' Makes sample size KPI boxesshowing reviews/ reviewers / offices in sample (server-side).
#' @export
#' @seealso \code{\link{sampleSizeUI}}
#' @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.
sampleSize <- function(input, output, session, fdat) {
  sample_size_reactive <- shiny::reactive({
    val_dat(fdat())
    rro <- paste0(
      fdat() %>% dplyr::count(),
      ' / ',
      fdat() %>%
        dplyr::mutate('email_lower' = tolower(Email)) %>%
        dplyr::distinct(email_lower) %>%
        dplyr::count() %>%
        unlist(),
      ' / ',
      fdat() %>%
        dplyr::mutate('company_name_lower' = tolower(`Company Name`)) %>%
        dplyr::mutate(company_name_lower = gsub(x = company_name_lower,
                                         "[[:punct:]]", " ")) %>%
        dplyr::distinct(company_name_lower) %>%
        dplyr::count() %>%
        unlist()
    )
    tags$h6(rro)
  })
  output$sample_size <- shiny::renderUI({sample_size_reactive()})
}

#' Makes UI for generic KPI gauge.
#'
#' Makes UI for generic KPI gauge.
#' @export
#' @seealso \code{\link{userFractionGauge}}
#' @param id Module namespace.
#' @return A flexdashboard gauge.
userFractionGaugeUI <- function(id) {
  ns <- shiny::NS(id)
  flexdashboard::gaugeOutput(ns("user_fraction_gauge"),
                             width = "100%", height = "100%")
}
#' Server-side code for generic KPI gauge.
#'
#' Server-side code for generic KPI gauge.  Uses dplyr:: functions to figure out what percentage of users were previous aware of the product.
#' @export
#' @seealso \code{\link{userFractionGaugeUI}}
#' @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 pcol numeric, the number of fdat's column containing the question of interest.
#' @param threshold numeric, the cutoff between positive and negative colors.
#' @param pos_options vector, all the strings in fdat[[pcol]] that are considered 'good' responses.
#' @param symbol string, indicates unit of numeric output (eg. "\%").
#' @param title string, title for gauge.
#' @param minRange numeric, minimum value for gauge.
#' @param maxRange numeric, maximum value for gauge.
#' @param reversed_values logical, indicates whether to flip values (e.g. gauge_value <- maxRange - gauge_value )
#' @param reversed_colors logical, indicates whether low values are 'good'/green and high values are 'bad'/red or not.
userFractionGauge <- function(input, output, session, fdat,
                              pcol, threshold, pos_options = "Yes",
                              symbol = "%", title = "Indicator",
                              minRange = 0, maxRange = 100,
                              reversed_values = FALSE,
                              reversed_colors = FALSE) {
  gauge_reactive <- shiny::reactive({
    val_dat(fdat())
    gauge_value <- fdat() %>% average_weighted_by_user(pcol, pos_options)
    if (isTRUE(reversed_values)) {gauge_value <- maxRange - gauge_value}
    reversable_gauge(
      gauge_value, threshold(),  label_text = title,  symbol = symbol,
      min_val = minRange, max_val = maxRange, reversed = reversed_colors)
  })
  output$user_fraction_gauge <- flexdashboard::renderGauge({gauge_reactive()})
}

#' Makes UI for generic KPI gauge & slider.
#'
#' Makes UI for generic KPI gauge & slider.
#' @export
#' @seealso \code{\link{userFractionGaugeSlider}}
#' @param id Module namespace.
#' @param hovertext string, RLumShiny::tooltip's text parameter; displayed when cursor hovers over plot; not working currently.
#' @param label string, label for KPI
#' @param minval numeric, minimum value for slider.
#' @param maxval numeric, maximum value for slider.
#' @param val numeric, starting value for slider.
#' @return A shiny tagList() containing a flexdashboard gauge and sliderInput.
userFractionGaugeSliderUI <- function(id, hovertext = NULL, label = "Threshold",
                                      minval = 0, maxval = 100, val = 50) {
  ns <- shiny::NS(id)
  shiny::tagList(
    userFractionGaugeUI(ns("ufg_slider")),
    shiny::sliderInput(ns("threshold"), label, min = minval, max = maxval, value = val),
    RLumShiny::tooltip(ns("threshold"), hovertext)
  )
}
#' Server-side code for generic KPI gauge & slider.
#'
#' Server-side code for generic KPI gauge & slider.  Essentially calls userFractionGauge().
#' @export
#' @seealso \code{\link{userFractionGaugeSliderUI}} \code{\link{userFractionGauge}}
#' @inheritParams userFractionGauge
userFractionGaugeSlider <- function(input, output, session, fdat,
                              pcol,
                              pos_options = "Yes", symbol = "%",
                              title = "Indicator", minRange = 0, maxRange = 100,
                              reversed_values = FALSE, reversed_colors = FALSE) {
  shiny::callModule(
    userFractionGauge, "ufg_slider", fdat, pcol,
    threshold = reactive(input$threshold), pos_options, symbol, title,
    minRange, maxRange, reversed_values, reversed_colors)
}


# Awareness KPI gauge

#' Wrapper for userFractionGaugeSliderUI for awareness KPI gauge & slider.
#'
#' Wrapper for userFractionGaugeSliderUI for awareness KPI gauge & slider.
#' @export
#' @seealso \code{\link{awarenessGauge}}, \code{\link{userFractionGaugeSliderUI}}
#' @inheritParams userFractionGaugeSliderUI
#' @return A shiny tagList() containing a flexdashboard gauge and sliderInput.
awarenessGaugeUI <- function(
  id, hovertext = "Cutoff for percentage of in-sample awareness due to Morsel",
  label = "Awareness", minval = 0, maxval = 100, val = 50) {

  ns <- shiny::NS(id)
  userFractionGaugeSliderUI(
    ns("awareness_kpi"), hovertext = hovertext, label = label,
    minval = minval, maxval = maxval, val = val)
}
#' Wrapper for userFractionGaugeSlider server-side code for awareness KPI gauge & slider.
#'
#' Wrapper for userFractionGaugeSlider server-side code for awareness KPI gauge & slider.
#' @export
#' @seealso \code{\link{awarenessGaugeUI}}, \code{\link{userFractionGaugeSlider}}
#' @inheritParams userFractionGaugeSlider
awarenessGauge <- function(input, output, session, fdat, pcol = awareness_col,
                           pos_options = "No", symbol = "%",
                           title = "Aware due to Morsel", minRange = 0, maxRange = 100,
                           reversed_values = FALSE, reversed_colors = FALSE) {
  shiny::callModule(
    userFractionGaugeSlider, "awareness_kpi", fdat, awareness_col, pos_options,
    symbol, title, minRange, maxRange, reversed_values, reversed_colors)
}

# Intent KPI gauge

#' Wrapper for userFractionGaugeSliderUI for intent KPI gauge & slider.
#'
#' Wrapper for userFractionGaugeSliderUI for intent KPI gauge & slider.
#' @export
#' @seealso \code{\link{intentGauge}}, \code{\link{userFractionGaugeSliderUI}}
#' @param id Module namespace.
#' @param hovertext string, RLumShiny::tooltip's text parameter; displayed when cursor hovers over plot
#' @param label string, label for KPI
#' @return A shiny tagList() containing a flexdashboard gauge and sliderInput.
intentGaugeUI <- function(id, hovertext = 'Cutoff for intent percentage (includes only unequivocal "Yes" responses).',
                          label = "Purchase Intent") {
  ns <- shiny::NS(id)
  userFractionGaugeSliderUI(ns("intent_kpi"), hovertext, label)
}
#' Wrapper for userFractionGaugeSlider server-side code for intent KPI gauge & slider.
#'
#' Wrapper for userFractionGaugeSlider server-side code for intent KPI gauge & slider.
#' @export
#' @seealso \code{\link{intentGaugeUI}}, \code{\link{userFractionGaugeSlider}}
#' @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.
#' @param pos_options vector, all the strings in fdat[[intent_col]] that are considered 'good' responses.
#' @param symbol string, indicates unit of numeric output (eg. "\%").
#' @param title string, title for gauge.
intentGauge <- function(input, output, session, fdat, intent_col,
                        pos_options = "Yes", symbol = "%",
                        title = "Intend to Purchase") {
  shiny::callModule(
    userFractionGaugeSlider, "intent_kpi", fdat, intent_col, pos_options,
    symbol, title)
}

#' Makes UI for awareness multiplier KPI.
#'
#' Makes UI for awareness multiplier KPI; formated text.
#' @export
#' @seealso \code{\link{awarenessMultiplier}}
#' @param id Module namespace.
#' @param hovertext string, RLumShiny::tooltip's text parameter; displayed when cursor hovers over plot
#' @return A shiny tagList() containing formatted text.
awarenessMultiplierUI <- function(id, hovertext = 'Reviewers who were not previously aware of any of the products selected.  Unequivocal "No" responses (divided by unequivocal "Yes" responses); ignores users with mixed responses.') {
  # hovertext is RLumShiny::tooltip's text parameter
  ns = shiny::NS(id)
  shiny::tagList(
    "In sample awareness increased by",
    shiny::uiOutput(ns("multiplier")),
    RLumShiny::tooltip(ns("multiplier"), hovertext, placement = "auto")
  )
}
#' Server-side code for awareness multiplier KPI.
#'
#' Server-side code for awareness multiplier KPI.  Uses dplyr:: functions to figure out by how much awareness has increased among the reviewers.
#' @export
#' @seealso \code{\link{awarenessMultiplierUI}}
#' @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 awareness_col numeric, the number of fdat's column containing the awareness question.
#' @param aware_options vector, all the strings in fdat$awareness_col that are counted as 'aware'.
#' @param unaware_options vector, all the strings in fdat$awareness_col that are counted as 'unaware'.
awarenessMultiplier <- function(input, output, session, fdat,
                                awareness_col,
                                aware_options = "Yes",
                                unaware_options = "No") {
  awareness_multiplier_reactive <- shiny::reactive({
    val_dat(fdat())
    ba <- fdat() %>% # Base awareness
      dplyr::rename(primary_col = awareness_col) %>%
      cc()
    y <- ba %>%  # yesses
      dplyr::filter(primary_col %in% aware_options) %>%
      dplyr::select(n) %>%
      colSums()
    n <- ba %>% # noes
      dplyr::filter(primary_col %in% unaware_options) %>%
      dplyr::select(n) %>%
      colSums()
    mult <- n[[1]]/y[[1]] # multiplier
    mult <- mult %>%
      prod(100) %>%
      round(0) %>%
      paste0('% / ', n[[1]], " people")
    tags$h6(mult)
  })
  output$multiplier <- shiny::renderUI({awareness_multiplier_reactive()})
}

# Understanding KPI gauge (awareness tab)
#' Makes UI for understanding KPI gauge & slider.
#'
#' Makes UI for understanding KPI gauge & slider.
#' @export
#' @seealso \code{\link{understandingGauge}}
#' @param id Module namespace.
#' @param hovertext string, RLumShiny::tooltip's text parameter; displayed when cursor hovers over plot
#' @return A shiny tagList() containing a flexdashboard gauge and sliderInput.
understandingGaugeUI <- function(id, hovertext = "Average response to \\'I understand what [this product] is\\'.") {
  # hovertext is shinyBS::bsTooltip's title parameter
  ns <- shiny::NS(id)
  shiny::tagList(
    flexdashboard::gaugeOutput(ns("understanding"),
                               width = "100%", height = "100%"),
    RLumShiny::tooltip(ns("understanding"), hovertext),
    shiny::sliderInput(ns("understanding_threshold"),
                       "Understanding threshold:",
                       min = 1, max = 5, value = 4, step = 0.1)
  )
}
#' Server-side code for understanding KPI gauge & slider.
#'
#' Server-side code for understanding KPI gauge & slider.  Average value re: how well users understand what product is about.  Makes use of gauge_preset().
#' @export
#' @seealso \code{\link{understandingGaugeUI}}
#' @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 understanding_col numeric, the number of fdat's column containing the understanding question.
understandingGauge <- function(input, output, session, fdat, understanding_col) {
  output$understanding <- flexdashboard::renderGauge({
    val_dat(fdat())
    gauge_preset(fdat(), understanding_col, "Understanding",
                 input$understanding_threshold, 1, 5)
  })
}

#' Makes UI for products selected box.
#'
#' Makes UI for products selected box.
#' @export
#' @seealso \code{\link{selected}}
#' @param id Module namespace.
#' @return A shiny tagList() containing formatted text.
selectedUI <- function(id) {
  ns <- shiny::NS(id)
  shiny::tagList(
    shinydashboard::box(
      title = "PRODUCTS SELECTED", status = "info",
      width = 12, solidHeader = TRUE,
      shiny::uiOutput(ns("products_selected")))
  )
}
#' Server-side code for products selected box.
#'
#' Server-side code for products selected box.  Makes use of display_prod()
#' @export
#' @seealso \code{\link{selectedUI}} \code{\link{display_prod}}
#' @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 pshort vector, strings summarizing products list (eg. X product variants --> 1 base product);
#' @param pvar vector, numerics, the number of different variants summarized by each pshort element
selected <- function(input, output, session, fdat, pshort, pvar) {
  output$products_selected <- shiny::renderUI({
    display_prod(fdat(), pshort, pvar)
  })
}





#' Makes UI for a generic KPI gauge.
#'
#' Makes UI for a generic KPI gauge measuring % of response.
#' @export
#' @seealso \code{\link{percentGauge}}
#' @param id Module namespace.
#' @param hovertext string, RLumShiny::tooltip's text parameter; displayed when cursor hovers over plot
#' @param label string, label for slider to be pasted just before "threshold:".
#' @return A shiny tagList() containing a flexdashboard gauge.
percentGaugeUI <- function(id, hovertext = NULL, label = "Percent Threshold:") {
  ns <- shiny::NS(id)
  shiny::tagList(
    flexdashboard::gaugeOutput(
      ns("percent_gauge"), width = "100%", height = "100%"),
    RLumShiny::tooltip(ns("percent_gauge"), hovertext, placement = "auto"),
    shiny::sliderInput(ns("percent_threshold"), paste(label),
                       min = 0, max = 100, value = 40)
  )
}
#' Server-side code for a generic KPI gauge.
#'
#' Server-side code for a generic KPI gauge.  Uses dplyr:: functions to figure out the percentage.
#' @export
#' @seealso \code{\link{percentGaugeUI}}
#' @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 pcol numeric, the number of fdat's column containing the question of interest.
#' @param p_options vector, all the strings in fdat[[pcol]] that are counted as positive (e.g. "Yes").
#' @param gauge_label string, label for gauge
#' @param reversed_values logical, indicates whether to flip values (e.g. gauge_value <- 100 - gauge_value )
percentGauge <- function(input, output, session, fdat,
                         pcol, p_options, gauge_label, reversed_values = FALSE) {
  percent_gauge_reactive <- shiny::reactive({
    val_dat(fdat())
    gauge_value <- fdat() %>%
      average_weighted_by_user(pcol, p_options)
    gauge_value <- ifelse(isTRUE(reversed_values), 100-gauge_value, gauge_value)
    flexdashboard::gauge(
      gauge_value,
      min = 0, max = 100, symbol = '%', label = gauge_label,
      flexdashboard::gaugeSectors(
        success = c(input$percent_threshold + 0.5, 100),
        warning = c(input$percent_threshold - 0.5, input$percent_threshold + 0.5),
        danger = c(0, input$percent_threshold - 0.5))
    )
  })
  output$percent_gauge <- flexdashboard::renderGauge({percent_gauge_reactive()})
}