Shiny Module Functions: Communication Between Modules

app.R

# Adapted from https://rpodcast.shinyapps.io/modules_article1/ to test callModule as a function.

# load packages
library(shiny)
library(AmesHousing)
library(dplyr)
library(rlang)
library(ggplot2)
library(scales)

# load separate module and function scripts
source("modules.R")
source("helpers.R")

# user interface
ui <- fluidPage(

  titlePanel("Ames Housing Data Explorer"),

  fluidRow(
    column(
      width = 3,
      wellPanel(
        varselect_mod_ui("plot1_vars")
      )
    ),
    column(
      width = 6,
      scatterplot_mod_ui("plots")
    ),
    column(
      width = 3,
      wellPanel(
        varselect_mod_ui("plot2_vars")
      )
    )
  )
)

# server logic
server <- function(input, output, session) {

  # prepare dataset
  ames <- make_ames()

  # execute plot variable selection modules
  plot1vars <- varselect_mod("plot1_vars")
  plot2vars <- varselect_mod("plot2_vars")

  # execute scatterplot module
  res <- scatterplot_mod("plots",
                         dataset = ames,
                         plot1vars = plot1vars,
                         plot2vars = plot2vars)
}

# Run the application
shinyApp(ui = ui, server = server)

helpers.R

# I didn't change anything here, just including for completeness.

plot_labeller <- function(l, varname) {
  if (varname == "Sale_Price") {
    res <- dollar(l)
  } else {
    res <- comma(l)
  }
  return(res)
}

#' Produce scatterplot with variables selected by the user
#'
#' @param data data frame with variables necessary for scatterplot
#' @param xvar variable (string format) to be used on x-axis
#' @param yvar variable (string format) to be used on y-axis
#'
#' @return {\code{ggplot2} object for the scatterplot
#' @export
#'
#' @examples
#' plot_obj <- scatter_sales(data = ames, xvar = "Lot_Frontage", yvar = "Sale_Price")
#' plot_obj
scatter_sales <- function(dataset, xvar, yvar) {

  x <- rlang::sym(xvar)
  y <- rlang::sym(yvar)

  p <- ggplot(dataset, aes(x = !!x, y = !!y)) +
    geom_point() +
    scale_x_continuous(labels = function(l) plot_labeller(l, varname = xvar)) +
    scale_y_continuous(labels = function(l) plot_labeller(l, varname = yvar)) +
    theme(axis.title = element_text(size = rel(1.2)),
          axis.text = element_text(size = rel(1.1)))

  return(p)
}

modules.R

# Added scatterplot_mod and varselect_mod

#' Variable selection for plot user interface
#'
#' @param id, character used to specify namespace, see \code{shiny::\link[shiny]{NS}}
#'
#' @return a \code{shiny::\link[shiny]{tagList}} containing UI elements
varselect_mod_ui <- function(id) {
  ns <- NS(id)

  # define choices for X and Y variable selection
  var_choices <- list(
    `Sale price` = "Sale_Price",
    `Total basement square feet` = "Total_Bsmt_SF",
    `First floor square feet` = "First_Flr_SF",
    `Lot Frontage` = "Lot_Frontage",
    `Lot Area` = "Lot_Area",
    `Masonry vaneer area` = "Mas_Vnr_Area",
    `1st floor square feet` = "First_Flr_SF",
    `2nd floor square feet` = "Second_Flr_SF",
    `Low quality finished square feet` = "Low_Qual_Fin_SF",
    `Above grade living area square feet` = "Gr_Liv_Area",
    `Garage area square feet` = "Garage_Area"
  )

  # assemble UI elements
  tagList(
    selectInput(
      ns("xvar"),
      "Select X variable",
      choices = var_choices,
      selected = "Lot_Area"
    ),
    selectInput(
      ns("yvar"),
      "Select Y variable",
      choices = var_choices,
      selected = "Sale_Price"
    )
  )
}

#' Variable selection module server-side processing
#'
#' @param input,output,session standard \code{shiny} boilerplate
#'
#' @return list with following components
#' \describe{
#'   \item{xvar}{reactive character indicating x variable selection}
#'   \item{yvar}{reactive character indicating y variable selection}
#' }
varselect_mod_server <- function(input, output, session) {

  return(
    list(
      xvar = reactive({ input$xvar }),
      yvar = reactive({ input$yvar })
    )
  )
}

varselect_mod <- function(id) {
  callModule(varselect_mod_server, id)
}

#' Scatterplot module user interface
#'
#' @param id, character used to specify namespace, see \code{shiny::\link[shiny]{NS}}
#'
#' @return a \code{shiny::\link[shiny]{tagList}} containing UI elements
#' @export
#'
#' @examples
scatterplot_mod_ui <- function(id) {
  ns <- NS(id)

  tagList(
    fluidRow(
      column(
        width = 6,
        plotOutput(ns("plot1"))
      ),
      column(
        width = 6,
        plotOutput(ns("plot2"))
      )
    )
  )
}

#' Scatterplot module server-side processing
#'
#' This module produces a scatterplot with the sales price against a variable selected by the user.
#'
#' @param input,output,session standard \code{shiny} boilerplate
#' @param dataset data frame (non-reactive) with variables necessary for scatterplot
#' @param plot1_vars list containing reactive x-variable name (called `xvar`) and y-variable name (called `yvar`) for plot 1
#' @param plot2_vars list containing reactive x-variable name (called `xvar`) and y-variable name (called `yvar`) for plot 2
scatterplot_mod_server <- function(input,
                                   output,
                                   session,
                                   dataset,
                                   plot1vars,
                                   plot2vars) {

  plot1_obj <- reactive({
    p <- scatter_sales(dataset, xvar = plot1vars$xvar(), yvar = plot1vars$yvar())
    return(p)
  })

  plot2_obj <- reactive({
    p <- scatter_sales(dataset, xvar = plot2vars$xvar(), yvar = plot2vars$yvar())
    return(p)
  })

  output$plot1 <- renderPlot({
    plot1_obj()
  })

  output$plot2 <- renderPlot({
    plot2_obj()
  })
}

scatterplot_mod <- function(id,
                            dataset,
                            plot1vars,
                            plot2vars) {
  callModule(scatterplot_mod_server,
             id,
             dataset,
             plot1vars,
             plot2vars)
}