I want to make any modules I make as a portal set of separated parts of input and output, as demonstrated at Shiny - Communication between modules
There in the Motivating Example of Ames Housing Data Exporter, only two input variables xvar and yvar are used, but in general I have much more different set of input variables.
I could decrease the number of hard-coding xvar and yvar, as seen in the reprex I put below, but I cannot figure out how to make varselect_mod_server without hard-coding. How can I do that?
e.g. Is there a way to get the full list of input variable names defined in its corresponding varselect_mod_ui? Then I can do list_ret[[varname]] = reactive({ input[[varname]] }). As they are in reactive({ input$blabla }), accessing simply by names(input) does not work. Thanks in advance.
# varselect_mod_server <- function(input, output, session) {
varselect_mod_server <- function(id) {
moduleServer(id, function(input, output, session) {
# print(str(input))
# l_ret <- list()
# for (varn in names(input)){
# print(varn)
# l_ret[[varn]] = reactive({ input[[varn]] })
# }
# return(l_ret)
return(
list(
xvar = reactive({ input$xvar })
,
yvar = reactive({ input$yvar })
)
)
})
}
A reprex that I modified from the original code is as follows.
- Use
moduleServerinstead ofcallModule. - Make one plot in one output, not two plots side by side in one output.
- Don't use
scatter_salesinhelpers.Rto decrease hard-coding of input variable names.
app.R
#
# This is a Shiny web application. You can run the application by clicking
# the 'Run App' button above.
#
# Find out more about building applications with Shiny here:
#
# http://shiny.rstudio.com/
#
library(shiny)
# load packages
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")
tagList(
fluidRow(
column(
width = 6,
scatterplot_single_mod_ui("plot1")
),
column(
width = 6,
scatterplot_single_mod_ui("plot2")
)
)
)
),
column(
width = 3,
wellPanel(
varselect_mod_ui("plot2_vars")
)
)
)
)
# server logic
server <- function(input, output, session) {
# prepare dataset
ames <- make_ames() # AmesHousing
# execute plot variable selection modules
plot1vars <- varselect_mod_server("plot1_vars")
plot2vars <- varselect_mod_server("plot2_vars")
# plot1vars <- callModule(varselect_mod_server, "plot1_vars")
# plot2vars <- callModule(varselect_mod_server, "plot2_vars")
# execute scatterplot module
res1 <- scatterplot_single_mod_server("plot1",
dataset = ames,
plotvars = plot1vars)
res2 <- scatterplot_single_mod_server("plot2",
dataset = ames,
plotvars = plot2vars)
# res <- scatterplot_mod_server("plots",
# dataset = ames,
# plot1vars = plot1vars,
# plot2vars = plot2vars)
# res <- callModule(scatterplot_mod_server,
# "plots",
# dataset = ames,
# plot1vars = plot1vars,
# plot2vars = plot2vars)
}
# Run the application
shinyApp(ui = ui, server = server)
modules.R
- Not changed are:
varselect_mod_uivarselect_mod_server
- Modified are:
scatterplot_single_mod_uiscatterplot_single_mod_server- Output one plot, instead of outputting two plots together in the original
scatterplot_mod_uiandscatterplot_single_mod_server.
#' 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) {
varselect_mod_server <- function(id) {
moduleServer(id, function(input, output, session) {
# print(str(input))
# l_ret <- list()
# for (varn in names(input)){
# print(varn)
# l_ret[[varn]] = reactive({ input[[varn]] })
# }
# return(l_ret)
return(
list(
xvar = reactive({ input$xvar })
,
yvar = reactive({ input$yvar })
)
)
})
}
#' 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_single_mod_ui <- function(id) {
ns <- NS(id)
plotOutput(ns("plotn"))
# 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 plotvars list containing reactive x-variable name (called `xvar`) and y-variable name (called `yvar`) for plot
scatterplot_single_mod_server <- function(id,
dataset,
plotvars) {
moduleServer(id, function(input, output, session) {
plotn_obj <- reactive({
# str(plotvars)
# print(plotvars[['xvar']])
# print(names(plotvars))
var_entities <- list()
var_symbols <- list()
for (varn in names(plotvars)){
var_entities[[varn]] <- plotvars[[varn]]()
}
xvar <- var_entities[['xvar']]
yvar <- var_entities[['yvar']]
# for (varn in c('xvar', 'yvar')){ #when only small subset of input need to be symbolized.
for (varn in names(plotvars)){ #do symbolized for all input vars.
var_symbols[[varn]] <- rlang::sym(var_entities[[varn]])
}
x <- var_symbols[['xvar']]
y <- var_symbols[['yvar']]
# xvar <- plotvars$xvar()
# yvar <- plotvars$yvar()
# x <- rlang::sym(xvar)
# y <- rlang::sym(yvar)
p <- ggplot(dataset, aes(x = !!x, y = !!y)) + # ok, as orig
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)))
# x <- rlang::sym(plotvars$xvar())
# y <- rlang::sym(plotvars$yvar())
#
# p <- ggplot(dataset, aes(x = !!x, y = !!y)) + # ok, as orig
# geom_point() +
# scale_x_continuous(labels = function(l) plot_labeller(l, varname = plotvars$xvar())) +
# scale_y_continuous(labels = function(l) plot_labeller(l, varname = plotvars$yvar())) +
# theme(axis.title = element_text(size = rel(1.2)),
# axis.text = element_text(size = rel(1.1)))
# p <- scatter_sales(dataset, xvar = plotvars$xvar(), yvar = plotvars$yvar())
return(p)
})
# plot2_obj <- reactive({
# p <- scatter_sales(dataset, xvar = plot2vars$xvar(), yvar = plot2vars$yvar())
# return(p)
# })
output$plotn <- renderPlot({
plotn_obj()
})
# output$plot2 <- renderPlot({
# plot2_obj()
# })
})
}
helpers.R
- Omit
scatter_sales. Instead corresponding codes are written inscatterplot_single_mod_server.
plot_labeller <- function(l, varname) {
if (varname == "Sale_Price") {
res <- dollar(l)
} else {
res <- comma(l)
}
return(res)
}
