R/reasons_tab.R

In IskanderBlue/morseldash: Makes Building Dashboards for Morsel Easier

# Reasons tab

#' For making "By Rank" UI option in "Reasons" tab.
#'
#' For making "By Rank" UI option in "Reasons" tab.
#' @seealso \code{\link{reasonsByRank}}
#' @export
#' @param id Module namespace.
#' @return A shiny tagList() containing a formatted plotly plot.
reasonsByRankUI <- function(id) {
  ns <- shiny::NS(id)
  shiny::tagList(
    shiny::fluidRow(
      shiny::column(width = 12,
             shinydashboard::box(
              title = "REASONS BY RANK", status = "primary", width = 12,
              solidHeader = TRUE, collapsible = TRUE,
              plotly::plotlyOutput(ns("rank"))))
    )
  )
}
#' For making "By Rank" option in server-side "Reasons" tab.
#'
#' For making "By Rank" option in server-side "Reasons" tab.  Call with callModule().
#' @seealso \code{\link{reasonsByRankUI}}
#' @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 rank_total string, takes the choice of ranking by total ("Rank by total") or ranking by the top1, then top2 then top3 ("Rank by top1, top2, top3") as a reactive eg. reactive(input$rank_total)
#' @param fdat dataframe, filtered by demographic variables and product.
reasonsByRank <- function(input, output, session, rank_total, fdat) {
  # rank_total takes the choice of ranking by total or ranking by the top1,
  #   then top2 then top3 as a reactive eg. reactive(input$rank_total)
  rbrank <- shiny::reactive({
    rank <- switch(rank_total(),
                   "Rank by total" = rlang::quos(totals, top1, top2, top3),
                   "Rank by top1, top2, top3" = rlang::quos(top1, top2, top3))
    val_dat(fdat())
    fdat() %>%
      tallyer(rank,
              `What is the top reason to drive you to try this product?`,
              `What is the 2nd top reason to drive you to try this product?`,
              `What is the 3rd top reason to drive you to try this product?`) %>%
      bp("Reasons by Rank", rank_colors)
  })
  output$rank <- plotly::renderPlotly({rbrank()})
}

# For making "By Product" option in "Reasons" tab

#' Helper function for reasonsByProduct()
#'
#' Helper function for reasonsByProduct(); generates plot.  Makes use of group_by_primary_sec(), bp().
#' @seealso \code{\link{reasonsByProduct}}, \code{\link{group_by_primary_sec}}, \code{\link{bp}}
#' @param top_cols vector, contains the numbers of fdat's columns containing the top x answers.
#' @param rank numeric, the x of top x; eg. rank = 1 --> top column; rank = 2 --> 2nd top column
#' @param title string, the title of the plot.
#' @param fdat dataframe, filtered by demographic variables and product.
#' @param color_vec vector of strings, colours for the plot (ie. the colour each product is plotted as) eg. c("#FF0000", ...)
#' @return A plotly plot.
reasons_by_product_chart <- function(top_cols, rank, title, fdat, color_vec) {
  val_dat(fdat)
  fdat %>%
    dplyr::rename(primary_col = top_cols[rank], sec_col = Product) %>%
    group_by_primary_sec() %>%
    bp(title, color_vec)
}
#' For making "By Product" UI option in "Reasons" tab.
#'
#' For making "By Product" UI option in "Reasons" tab.
#' @seealso \code{\link{reasonsByProduct}}
#' @export
#' @param id Module namespace.
#' @return A shiny tagList() containing three formatted plotly plots.
reasonsByProductUI <- function(id) {
  ns <- shiny::NS(id)
  shiny::tagList(
    shiny::fluidRow(
      shiny::column(width = 12,
        shinydashboard::box(
          title = "TOP REASONS BY PRODUCT", status = "primary", width = 12,
          solidHeader = TRUE, collapsible = TRUE, plotlyOutput(ns("top1"))))),
    shiny::fluidRow(
      shiny::column(width = 12,
        shinydashboard::box(
          title = "2nd TOP REASONS BY PRODUCT", status = "primary", width = 12,
          solidHeader = TRUE, collapsible = TRUE, plotlyOutput(ns("top2"))))),
    shiny::fluidRow(
      shiny::column(width = 12,
        shinydashboard::box(
          title = "3rd TOP REASONS BY PRODUCT", status = "primary", width = 12,
          solidHeader = TRUE, collapsible = TRUE, plotlyOutput(ns("top3"))))))
}
#' For making "By Product" option in server-side "Reasons" tab.
#'
#' For making "By Product" option in server-side "Reasons" tab. Call with callModule().  Makes use of helper function reasons_by_product_chart().
#' @seealso \code{\link{reasonsByProductUI}}, \code{\link{reasons_by_product_chart}}
#' @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 top_cols vector, contains the numbers of fdat's columns containing the top x answers.
#' @param color_vec vector of strings, colours for the plots (ie. the colour each product is plotted as) eg. c("#FF0000", ...)
reasonsByProduct <- function(input, output, session, fdat, top_cols, color_vec) {
  # See reasons_by_product_chart() for parameters
  t1 <- shiny::reactive({reasons_by_product_chart(
    top_cols, 1, "Top Reasons by Product", fdat(), color_vec)})
  t2 <- shiny::reactive({reasons_by_product_chart(
    top_cols, 2, "2nd Top Reasons by Product", fdat(), color_vec)})
  t3 <- shiny::reactive({reasons_by_product_chart(
    top_cols, 3, "3rd Top Reasons by Product", fdat(), color_vec)})
  output$top1 <- plotly::renderPlotly({t1()})
  output$top2 <- plotly::renderPlotly({t2()})
  output$top3 <- plotly::renderPlotly({t3()})
}