R/gating.R

Defines functions fractionGaugeUI fractionGauge fractionGaugeSliderUI fractionGaugeSlider score_diff_box scoreDiff scoreWidgetUI scoreWidget

Documented in fractionGauge fractionGaugeSlider fractionGaugeSliderUI fractionGaugeUI scoreDiff score_diff_box scoreWidget scoreWidgetUI

#' Makes UI for generic KPI gauge.
#'
#' Makes UI for generic KPI gauge.
#' @export
#' @seealso \code{\link{fractionGauge}} based off of \code{\link{userFractionGaugeUI}}
#' @param id Module namespace.
#' @return A flexdashboard gauge.
fractionGaugeUI <- function(id) {
  ns <- shiny::NS(id)
  flexdashboard::gaugeOutput(ns("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{fractionGaugeUI}} based off of \code{\link{userFractionGauge}}
#' @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 frac numeric, reactive value for gauge
#' @param threshold reactive, numeric or a vector of two numerics, the cutoff between positive and negative colors / positive, neutral, and negative colors.
#' @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.
fractionGauge <- function(input, output, session, frac, threshold,
                          symbol = "%", title = "Indicator",
                          minRange = 0, maxRange = 100,
                          reversed_values = FALSE,
                          reversed_colors = FALSE,
                          colours = c("#00a65a", "#f39c12", "#dd4b39")) { #"#00c3c5", "warning", "#f45050"
  gauge_reactive <- shiny::reactive({
    gauge_value <- frac()
    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,
      colours = colours
      )
  })
  output$fraction_gauge <- flexdashboard::renderGauge({gauge_reactive()})
}

#' Makes UI for generic KPI gauge & slider.
#'
#' Makes UI for generic KPI gauge & slider.
#' @export
#' @seealso \code{\link{fractionGaugeSlider}} based off of \code{\link{userFractionGaugeSliderUI}}
#' @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.
fractionGaugeSliderUI <- function(id, hovertext = NULL, label = "Threshold",
                                      minval = 0, maxval = 100, val = 50) {
  ns <- shiny::NS(id)
  shiny::tagList(
    fractionGaugeUI(ns("fg_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{fractionGaugeSliderUI}} \code{\link{fractionGauge}} based off of \code{\link{userFractionGaugeSlider}}
#' @inheritParams userFractionGauge
fractionGaugeSlider <- function(input, output, session, frac, threshold, symbol = "%",
                                title = "Indicator", minRange = 0, maxRange = 100,
                                reversed_values = FALSE, reversed_colors = FALSE) {
  shiny::callModule(
    fractionGauge, "fg_slider", frac = frac,
    threshold = threshold, symbol, title,
    minRange, maxRange, reversed_values, reversed_colors)
}


#' For creating the valueBox() that compares rating to benchmark.
#'
#' For creating the valueBox() that compares rating to benchmark.
#' @param x numeric, value to show off in the box.
#' @param reversed logical, determines whether positive or negative numbers are considered 'good' / green.
#' @return A shinydashboard::box() object.
score_diff_box <- function(x, label = "Score vs. cutoff") {
  if (x[2] > 0) {
    val <- paste0("+", round(x[2], 2), "%")
  } else { val <- paste0(round(x[2], 2), "%")}
  shinydashboard::valueBox(
    val, label,
    icon = icon_input(x), width = NULL,
    color = color_input(x))
}
#' Server-side function for boxes showing difference between actual score value and benchmark.
#'
#' Server-side function for boxes showing difference between actual score value and benchmark.
#' Uses csatDiffUI() as UI.
#' @seealso \code{\link{csatDiffUI}}, \code{\link{rating_diff_box}}
#' @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 score numeric, score to be compared to benchmark
#' @param color_cutoff numeric, cutoff between different colours for the gauge.
#' @param label string, title for valueBox
#' @param reversed logical, denotes whether gauge colours should be reversed (ie. warning colour for high values, happy colour for low values).
scoreDiff <- function(input, output, session, score, color_cutoff, label) {
  output$diff <- shinydashboard::renderValueBox({
    score_diff_box(score() - color_cutoff(), label = label)
  })
}


#' UI for a score element with title, gauge, and difference.
#'
#' UI for a score element with title, gauge, and difference.
#' @export
#' @seealso \code{\link{scoreWidget}}, \code{\link{csatWidgetUI}}
#' @param id Module namespace.
#' @param title string, labels gauge-diff combo element (probably identical to gauge title).
#' @return A shiny tagList() containing a string (title), gauge, and box (difference).
scoreWidgetUI <- function(id, title = "Overall Score") {
  ns <- shiny::NS(id)
  shiny::tagList(
    title,
    fractionGaugeUI(ns("gauge")),
    csatDiffUI(ns("diff"))
  )
}
#' Server-side function for score element with title, gauge, and difference.
#'
#' Server-side function for score element with title, gauge, and difference.
#' @export
#' @seealso \code{\link{scoreWidgetUI}} \code{\link{csatWidget}}
#' @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 score numeric, score to be displayed
#' @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 symbol string, a symbol to pass through to userFractionGauge(); \'\' / empty by default.
#' @param label string, title for valueBox
scoreWidget <- function(input, output, session, score, color_cutoff,
                        title = "Score",
                        minRange = 0, maxRange = 100,
                        symbol = "%", label = "Score vs. cutoff") {
  shiny::callModule(
    fractionGauge, "gauge", score, color_cutoff, symbol, title,
    minRange, maxRange)
  shiny::callModule(
    scoreDiff, "diff", score, color_cutoff, label)
}
IskanderBlue/morseldash documentation built on Oct. 30, 2019, 7:24 p.m.