R/awareness_tab.R

In IskanderBlue/morseldash: Makes Building Dashboards for Morsel Easier

# Awareness tab

# awareness plot
#' UI for awareness plot.
#'
#' UI for awareness plot.  No current mechanism to select this plot vs. another.
#' @export
#' @seealso \code{\link{awarenessPlot}}
#' @param id Module namespace.
#' @param title string, box title
#' @return A shiny tagList() containing formatted plotly plot.
awarenessPlotUI <- function(id, title = "BRAND AWARENESS") {
  ns <- shiny::NS(id)
  shiny::tagList(
    shiny::column(width = 9,
                  box_d(title = title,
                        plotly::plotlyOutput(ns("awareness"), height = "600px"),
                        infoButtonUI(ns("awareness_info"))
                  )
    )
  )
}
#' Server-side function for awareness plot.
#'
#' Server-side function for awareness plot.  Makes use of spc(), fo(), conflicting_evaluations(), horizontal_bars_plot().
#' @export
#' @seealso \code{\link{awarenessPlotUI}}, \code{\link{spc}}, \code{\link{fo}}, \code{\link{conflicting_evaluations}}, \code{\link{horizontal_bars_plot}}
#' @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, dat but filtered by demographic variables and product.
#' @param awareness_col numeric, the number of fdat's column containing the awareness question.
#' @param awareness_hierarchy vector, ordered factor of every unique string in the column of interest; eg. \code{df[[awareness_col]] \%>\% factor() \%>\% levels()} .
#' @param response_colors vector, colours for the awareness factors in the same order as awareness_hierarchy; strings (eg. \code{c("#FF00FF", "#00FFFF", "00FF00")}).
#' @param plot_type string, (either \code{"Pie (\%)"} or \code{"Bar"}) intended to take the choice of bar vs pie plot as a reactive eg. reactive(input$prev_aware_option) .
#' @param sec_col reactive containing string, (or numeric) denoting column to divide into separate rows/bars by.
#' @param ignore_options (vector of) string(s) to drop from dataframe before going through the data (eg. if certain values of pcol are not relevant).
awarenessPlot <- function(input, output, session, fdat,
                          awareness_col, awareness_hierarchy,
                          response_colors, plot_type, sec_col,
                          ignore_options = "Decline to state") {
  awareness_pie_percent_plot <- shiny::reactive({
    val_dat(fdat())
    x <- fdat() %>% dplyr::rename(primary_col = awareness_col)
    for (i in ignore_options) {x <- x %>% dplyr::filter(primary_col != i)}
    spc(x, names(fdat())[awareness_col], response_colors)
  })

  awareness_bar_plot <- reactive({
    val_dat(fdat())
    x <- fdat() %>% dplyr::rename(terms = awareness_col)
    for (i in ignore_options) {x <- x %>% dplyr::filter(terms != i)}
    # In order to avoid missing values fouling the plot
    x <- x %>%
      dplyr::rename(primary_col = sec_col()) %>%
      dplyr::rename(sec_col = awareness_col) %>%
      group_by_primary_sec() %>% # primary and secondary seem reversed here
      dplyr::rename(sec_tally = total, sec = primary_col)
    x_names <- names(x)[c(-1, -length(names(x)))]
    x %>%
      row_percents(x_names, sify = FALSE) %>%
      dplyr::select(sec, x_names, dplyr::starts_with("p"), dplyr::everything()) %>%
      dplyr::arrange(dplyr::desc(sec)) %>%
      horizontal_bars_plot(names(fdat())[awareness_col],
                           x_names, response_colors)
  })
  awarenessInput <- shiny::reactive({switch(plot_type(),
                                            "Pie (%)" = awareness_pie_percent_plot(),
                                            "Bar" = awareness_bar_plot())})
  output$awareness <- plotly::renderPlotly({awarenessInput()})
  # callModule(infoButton, "awareness_info")
}

# understanding plot
#' UI for understanding plot.
#'
#' UI for understanding plot.  No current mechanism to select this plot vs. another.
#' @export
#' @seealso \code{\link{understandingPlot}}
#' @param id Module namespace.
#' @param hovertext string, optional; RLumShiny::tooltip's text parameter; displayed when cursor hovers over plot
#' @param width numeric, between 1 and 12, used by Bootstrap to determine box width.
#' @param box_title string, title of box.
#' @return A shiny tagList() containing formatted plotly plot.
understandingPlotUI <- function(id, hovertext = NULL,
                                width = 9,
                                box_title = NULL) {
  # hovertext is RLumShiny::tooltip's text parameter
  ns <- shiny::NS(id)
  if (length(box_title) < 1) {
    box_title = shiny::textOutput(ns("question"))
  }
  shiny::tagList(
    shiny::column(width = width,
                  box_d(title = box_title,
                        plotly::plotlyOutput(ns("understanding"), height = "600px"))
    )
  )
}

#' Server-side function for understanding plot.
#'
#' Server-side function for understanding plot.  Makes use of spc(), fo(), conflicting_evaluations(), horizontal_bars_plot().
#' @export
#' @seealso \code{\link{understandingPlotUI}}, \code{\link{spc}}, \code{\link{fo}}, \code{\link{conflicting_evaluations}}, \code{\link{horizontal_bars_plot}}
#' @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, dat but filtered by demographic variables and product.
#' @param understanding_col reactive numeric, the number of fdat's column containing the understanding question.
#' @param awareness_col numeric, the number of fdat's column containing the awareness question.
#' @param color_vec vector, colours for the awareness factors; strings (eg. c("#FF00FF", "#00FFFF", "00FF00")).
#' @param legend_string string, title of plot legend labelling awareness_col factors.
#' @param arrange_by_total logical, whether to reorder factors by count.
understandingPlot <- function(input, output, session, fdat,
                              understanding_col, awareness_col, color_vec,
                              legend_string = "Previous Awareness",
                              arrange_by_total = TRUE) {
  understand_bar_plot <- reactive({
    val_dat(fdat())
    x <- fdat() %>%
      dplyr::rename(primary_col = understanding_col()) %>%
      dplyr::filter(primary_col != "Decline to state") %>%
      dplyr::rename(sec_col = awareness_col) %>%
      group_by_primary_sec(arrange_by_total)
    x <- x[, colSums(x != 0) > 0]
    understanding_by_awareness(x, names(fdat())[understanding_col()],
                               legend_string, color_vec)
  })
  output$understanding <- plotly::renderPlotly({understand_bar_plot()})
  output$question <- renderText({names(fdat())[understanding_col()]})
  shiny::outputOptions(output, "question", suspendWhenHidden = FALSE)

}