#' 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)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.