R/intents_tab.R

In IskanderBlue/morseldash: Makes Building Dashboards for Morsel Easier

# Intents tab

#' UI for all of the plot types for the intent tab.
#'
#' UI for all of the plot types for the intent tab.
#' @export
#' @family intent plots
#' @param id Module namespace.
#' @param box_title string, title for the box containing the plot
#' @param hovertext string, optional; RLumShiny::tooltip's text parameter; displayed when cursor hovers over plot
#' @param namespace string, a namespace distinguishing this plot from other plots
#' @return A shiny tagList() containing a plotly plot.
intentPlotUI <- function(id, box_title = "PURCHASE INTENT",
                         hovertext = NULL, namespace = "purchase") {
  ns <- shiny::NS(id)
  shiny::tagList(
    box_d(title = box_title,
          plotly::plotlyOutput(ns(namespace), height = "600px"),
          RLumShiny::tooltip(ns(namespace), text = hovertext, placement = "auto")
    )
  )
}
##########All of these need to be aggregated by reviewer
#' Server-side code for purchase question plot.
#'
#' Server-side code for purchase question plot.
#' @export
#' @family intent plots
#' @seealso \code{\link{intents_by_awareness_bar}}, \code{\link{spc}}
#' @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 reactive, dataframe, filtered by demographic variables and product.
#' @param pcol numeric, number of column in fdat containing plot's primary column of interest; shown in pie plots, height of bar plots.
#' @param scol reactive, string, name of column in fdat containing plot's secondary column of interest; colouration of bar plots,
#' @param title string, the title of the plot.
#' @param legend_title string, the title of the bar plot's legend (describing scol).
#' @param bar_colors vector, colours for bar plot (colours pcol options); strings (eg. \code{c("#FF00FF", "#00FFFF", "00FF00")}).
#' @param pie_colors vector, colours for pie plot (colours scol options); strings (eg. \code{c("#FF00FF", "#00FFFF", "00FF00")}).
#' @param plot_type string, indicator selecting between bar and pie plot (\code{"Bar"} or \code{"Pie (\%)"}).
#' @param dropNA logical, whether to drop unknown/ NA / Decline to state values in pcol.
purchasePlot <- function(input, output, session, fdat,
                         pcol, scol, title, legend_title,
                         bar_colors, pie_colors, plot_type,
                         dropNA = FALSE) {
  bar <- shiny::reactive({
    if (isTRUE(dropNA)) {
      x <- fdat() %>%
        dplyr::rename(primary_col = pcol, sec_col = scol()) %>%
        dplyr::filter(primary_col != "Decline to state" ) %>%
        dplyr::filter(primary_col != "Unknown" ) %>%
        tidyr::drop_na(primary_col)
    } else {
      x <- fdat() %>%
      dplyr::rename(primary_col = pcol, sec_col = scol())
    }
    val_dat(x)
    x %>%
      intents_by_awareness_bar(names(fdat())[pcol], scol(), bar_colors)
  })
  pie <- shiny::reactive({
    val_dat(fdat())
    fdat() %>%
      dplyr::rename(primary_col = pcol) %>%
      spc(names(fdat())[pcol], pie_colors)
  })
  plt <- shiny::reactive({switch(plot_type(), "Bar" = bar(), "Pie (%)" = pie())})
  output$purchase <- plotly::renderPlotly(plt())
  output$question <- shiny::renderText({title})
  shiny::outputOptions(output, "question", suspendWhenHidden = FALSE)
}
#' Server-side code for consume question plot.
#'
#' Server-side code for consume question plot.
#' @export
#' @family intent plots
#' @seealso \code{\link{spc}}, \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, filtered by demographic variables and product.
#' @param pcol numeric, number of column in fdat containing plot's primary column of interest; shown in pie plots, height of bar plots.
#' @param title string, the title of the plot.
#' @param response_colors vector, colours for plots (colours pcol options); strings (eg. c("#FF00FF", "#00FFFF", "00FF00")).
#' @param plot_type string, indicator selecting between bar and pie plot (\code{"Bar"} or \code{"Pie (\%)"}).
consumePlot <- function(input, output, session, fdat,
                        pcol, title,
                        response_colors, plot_type) {
  pie <- shiny::reactive({
    val_dat(fdat())
    fdat() %>%
      dplyr::rename(primary_col = pcol) %>%
      spc(names(fdat())[pcol], response_colors)
  })
  bar <- reactive({
    val_dat(fdat())
    # o_hierarchy needs to contain only those terms in fdat
    o_hierarchy <- fdat()[[pcol]] %>% factor() %>% levels()
    fdat() %>%
      dplyr::rename(terms = pcol) %>%
      conflicting_evaluations(pcol, o_hierarchy, 1:length(o_hierarchy)) %>%
      horizontal_bars_plot(names(fdat())[pcol], o_hierarchy, response_colors)
  })
  plt <- shiny::reactive({switch(plot_type(), "Bar" = bar(), "Pie (%)" = pie())})
  output$consume <- plotly::renderPlotly(plt())
  output$question <- shiny::renderText({title})
  shiny::outputOptions(output, "question", suspendWhenHidden = FALSE)
}

#' Server-side code for when question plot.
#'
#' Server-side code for when question plot.
#' @export
#' @family intent plots
#' @seealso \code{\link{spc}}, \code{\link{group_by_primary_sec}}, \code{\link{understanding_by_awareness}}
#' @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, number of column in fdat containing plot's primary column of interest; shown in pie plots, height of bar plots.
#' @param title string, the title of the plot.
#' @param response_colors vector, colours for pie plot (colours pcol options); strings (eg. \code{c("#FF00FF", "#00FFFF", "00FF00")}).
#' @param product_colors vector, colours for bar plot (colours product options); strings (eg. \code{c("#FF00FF", "#00FFFF", "00FF00")}).
#' @param plot_type string, indicator selecting between bar and pie plot (\code{"Bar"} or \code{"Pie (\%)"}).
whenPlot <- function(input, output, session, fdat,
                     pcol, title, response_colors,
                     product_colors, plot_type) {
  pie <- shiny::reactive({
    val_dat(fdat())
    fdat() %>%
      dplyr::rename(target = pcol) %>%
      dplyr::mutate(primary_col = strsplit(as.character(target), ", ")) %>%
      tidyr::unnest(primary_col) %>%
      fo("primary_col", when_ordered) %>%
      spc(names(fdat())[pcol], response_colors)
  })

  bar <- shiny::reactive({
    val_dat(fdat())
    fdat() %>%
      dplyr::rename(target = pcol) %>%
      dplyr::mutate(primary_col = strsplit(as.character(target), ", ")) %>%
      tidyr::unnest(primary_col) %>%
      fo("primary_col", when_ordered) %>%
      dplyr::rename(sec_col = Product) %>%
      group_by_primary_sec(arrange_by_total = FALSE) %>%
      understanding_by_awareness(names(fdat())[pcol], "Product", product_colors)
  })
  plt <- shiny::reactive({switch(plot_type(), "Bar" = bar(), "Pie (%)" = pie())})
  output$when <- plotly::renderPlotly(plt())
  output$question <- shiny::renderText({title})
  shiny::outputOptions(output, "question", suspendWhenHidden = FALSE)
}

#' Server-side code for regular question plot.
#'
#' Server-side code for regular question (eg. would you regularly use...) plot.
#' @export
#' @family intent plots
#' @seealso \code{\link{group_by_primary_sec}}, \code{\link{understanding_by_awareness}}
#' @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, number of column in fdat containing plot's primary column of interest.
#' @param title string, the title of the plot.
#' @param product_colors vector, colours for plot (colours product options); strings (eg. c("#FF00FF", "#00FFFF", "00FF00")).
regularPlot <- function(input, output, session, fdat,
                        pcol, title, product_colors) {
  bar <- shiny::reactive({
    val_dat(fdat())
    fdat() %>%
      dplyr::rename(primary_col = pcol) %>%
      dplyr::rename(sec_col = Product) %>%
      group_by_primary_sec(arrange_by_total = FALSE) %>%
      understanding_by_awareness(names(fdat())[pcol],
                                 "Product", product_colors)
  })
  output$regular <- plotly::renderPlotly({bar()})
  output$question <- shiny::renderText({title})
  shiny::outputOptions(output, "question", suspendWhenHidden = FALSE)
}

#' Server-side code for similar products question plot.
#'
#' Server-side code for similar products question (regularly use similar products...) plot.  Note that this does not take into account the possibility that one user could give multiple responses.  Seesgasdgasdgasdg
#' @export
#' @family intent plots
#' @seealso \code{\link{group_by_primary_sec}}, \code{\link{understanding_by_awareness}}
#' @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, number of column in fdat containing plot's primary column of interest.
#' @param title string, the title of the plot.
#' @param product_colors vector, colours for plot (colours product options); strings (eg. c("#FF00FF", "#00FFFF", "00FF00")).
#' @param exclude_string string, denotes products to exclude from fdat (for when the question was not asked about certain products)
#' @param exclude_positions vector, the excluded products' numeric positions on the product_colors vector
similarPlot <- function(input, output, session, fdat,
                        pcol, title, product_colors,
                        exclude_string = NULL, exclude_positions = NULL) {
  # dropping colors for excluded products
  if (is.null(exclude_positions)) {
    color_vec <- product_colors
  } else {
    color_vec <- product_colors[-exclude_positions]
  }
  bar <- shiny::reactive({
    val_dat(fdat() %>% filter(!Product %in% exclude_string))
    fdat() %>%
      dplyr::filter(!Product %in% exclude_string) %>%
      dplyr::rename(primary_col = pcol) %>%
      dplyr::rename(sec_col = Product) %>%
      group_by_primary_sec(arrange_by_total = FALSE) %>%
      understanding_by_awareness(names(fdat())[pcol],
                                 "Product", color_vec)
  })
  output$similar <- plotly::renderPlotly({bar()})
  output$question <- shiny::renderText({title})
  shiny::outputOptions(output, "question", suspendWhenHidden = FALSE)
}

#' Server-side code for replace question plot.
#'
#' Server-side code for replace similar products question (would you replace a similar product...) plot.
#' @export
#' @family intent plots
#' @seealso \code{\link{spc}}
#' @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, number of column in fdat containing plot's primary column of interest.
#' @param title string, the title of the plot.
#' @param response_colors vector, colours for pie plot (colours pcol options); strings (eg. c("#FF00FF", "#00FFFF", "00FF00")).
#' @param include_string string, only products containing string included in this plot (because question only asked of one category of product)
replacePlot <- function(input, output, session, fdat,
                        pcol, title, response_colors, include_string) {
  if (is.null(include_string)) {
    pie <- shiny::reactive({
      val_dat(fdat())
      fdat() %>%
        dplyr::rename(primary_col = pcol) %>%
        spc(names(fdat())[pcol], response_colors)
    })
  } else {
    pie <- shiny::reactive({
      val_dat(fdat() %>% dplyr::filter(stringr::str_detect(Product, include_string)))
      fdat() %>%
        dplyr::filter(stringr::str_detect(Product, include_string)) %>%
        dplyr::rename(primary_col = pcol) %>%
        spc(names(fdat())[pcol], response_colors)
    })
  }

  output$replace <- plotly::renderPlotly({pie()})
  output$question <- shiny::renderText({title})
  shiny::outputOptions(output, "question", suspendWhenHidden = FALSE)
}

#' Server-side code for recommend question plot.
#'
#' Server-side code for recommend question (would you recommend this product...) plot.
#' @export
#' @family intent plots
#' @seealso \code{\link{spc}}
#' @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, number of column in fdat containing plot's primary column of interest.
#' @param title string, the title of the plot.
#' @param response_colors vector, colours for pie plot (colours pcol options); strings (eg. c("#FF00FF", "#00FFFF", "00FF00")).
#' @param include_string string, only products containing string included in this plot (because question only asked of one category of product)
recommendPlot <- function(input, output, session, fdat,
                          pcol, title, response_colors, include_string) {
  if (is.null(include_string)) {
    pie <- shiny::reactive({
      val_dat(fdat())
      fdat() %>%
        dplyr::rename(primary_col = pcol) %>%
        spc(names(fdat())[pcol], response_colors)
    })
  } else {
    pie <- shiny::reactive({
      val_dat(fdat() %>% dplyr::filter(stringr::str_detect(Product, include_string)))
      fdat() %>%
        dplyr::filter(stringr::str_detect(Product, include_string)) %>%
        dplyr::rename(primary_col = pcol) %>%
        spc(names(fdat())[pcol], response_colors)
    })
  }

  output$recommend <- plotly::renderPlotly({pie()})
  output$question <- shiny::renderText({title})
  shiny::outputOptions(output, "question", suspendWhenHidden = FALSE)
}

#' UI for original pepsi plots
#'
#' UI for original pepsi plots; model for future dashes, not necessarily to be reused directly
#' @export
#' @seealso \code{\link{allIntentPlots}}
#' @param id Module namespace.
#' @return A shiny tagList() conditionally containing any of the plotly intent plots.
allIntentPlotsUI <- function(id) {
  ns <- shiny::NS(id)
  shiny::tagList(
    shiny::conditionalPanel(
      condition = "output['chosen_question'] == output['purchase_plot-question']", ns = ns,
      intentPlotUI(ns("purchase_plot"))),
    shiny::conditionalPanel(
      condition = "output['chosen_question'] == output['consume_plot-question']", ns = ns,
      intentPlotUI(ns("consume_plot"), "WHY CONSUME", namespace = "consume")),
    shiny::conditionalPanel(
      condition = "output['chosen_question'] == output['when_plot-question']", ns = ns,
      intentPlotUI(ns("when_plot"), "WHEN CONSUME", namespace = "when")),
    shiny::conditionalPanel(
      condition = "output['chosen_question'] == output['regular_plot-question']", ns = ns,
      intentPlotUI(ns("regular_plot"), "DRINK REGULARLY", namespace = "regular")),
    shiny::conditionalPanel(
      condition = "output['chosen_question'] == output['similar_plot-question']", ns = ns,
      intentPlotUI(ns("similar_plot"), "USE SIMILAR PRODUCTS REGULARLY",
        hovertext = "Not recorded separately for Game Fuel",
        namespace = "similar")),
    shiny::conditionalPanel(
      condition = "output['chosen_question'] == output['replace_plot-question']", ns = ns,
      intentPlotUI(ns("replace_plot"), "REPLACE PRE-WORKOUT BEVERAGE (ROCKSTAR XDURANCE ONLY)",
        hovertext = "Only recorded for Rockstar XDurance",
        namespace = "replace")),
    shiny::conditionalPanel(
      condition = "output['chosen_question'] == output['recommend_plot-question']", ns = ns,
      intentPlotUI(ns("recommend_plot"), "RECOMMEND PRODUCT (ROCKSTAR XDURANCE ONLY)",
        hovertext = "Only recorded for Rockstar XDurance",
        namespace = "recommend"))
  )
}

#' Server-side code for original pepsi plots
#'
#' Server-side code for original pepsi plots; model for future dashes, not necessarily to be reused directly
#' @export
#' @seealso \code{\link{allIntentPlotsUI}}
#' @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, pcol for purchasePlot()
#' @param awareness_col, numeric, scol for purchasePlot()
#' @param consume_col, numeric, pcol for consumePlot()
#' @param when_col, numeric, pcol for whenPlot()
#' @param regular_col, numeric, pcol for regularPlot()
#' @param similar_col, numeric, pcol for similarPlot()
#' @param replace_col, numeric, pcol for replacePlot()
#' @param recommend_col, numeric, pcol for recommendPlot()
#' @param awareness_colors, vector, used as bar_colors, pie_colors for purchasePlot(), response_colors for replacePlot() and recommendPlot()
#' @param consume_colors, vector, used as response_colors for consumePlot()
#' @param when_colors, vector, used as response_colors for whenPlot()
#' @param product_colors, vector, used as product_colors for whenPlot(), regularPlot(), similarPlot()
#' @param exclude_string, string, used as exclude_string in similarPot()
#' @param exclude_positions vector, used as exclude_positions in similarPot()
#' @param include_string, used as include_string for replacePlot(), recommendPlot()
#' @param plot_type, string, used to choose between bar and pie plots in purchasePlot(), consumePlot(), whenPlot()
#' @param intent_question, string, used as condition in allIntentPlotsUI to hide/show appropriate plots
allIntentPlots <- function(input, output, session, fdat,
                       intent_col, awareness_col, consume_col,
                       when_col, regular_col, similar_col,
                       replace_col, recommend_col,
                       awareness_colors, consume_colors, when_colors,
                       product_colors, exclude_string, exclude_positions,
                       include_string, plot_type, intent_question) {
  output$purchase_plot <- shiny::callModule(
    purchasePlot, "purchase_plot", fdat, intent_col, awareness_col,
    "Would you purchase?", "Previous brand awareness",
    awareness_colors, awareness_colors, plot_type)
  output$consume_plot <- shiny::callModule(
    consumePlot, "consume_plot", fdat, consume_col,
    "Why would you consume?", consume_colors, plot_type)
  output$when_plot <- shiny::callModule(
    whenPlot, "when_plot", fdat, when_col,
    "When would you consume?", when_colors, product_colors, plot_type)
  output$regular_plot <- shiny::callModule(
    regularPlot, "regular_plot", fdat, regular_col,
    "Would drink regularly", product_colors)
  output$similar_plot <- shiny::callModule(
    similarPlot, "similar_plot", fdat, similar_col,
    "Use similar products", product_colors, exclude_string, exclude_positions)
  output$replace_plot <- shiny::callModule(
    replacePlot, "replace_plot", fdat, replace_col,
    "Replace Pre-Workout? (RS)", awareness_colors, include_string)
  output$recommend_plot <- shiny::callModule(
    recommendPlot, "recommend_plot", fdat, recommend_col,
    "Would you recommend? (RS)", awareness_colors, include_string)

  output$chosen_question <- shiny::reactive({intent_question()})
  shiny::outputOptions(output, "chosen_question", suspendWhenHidden = FALSE)
}