如何观察renderUI R Shiny内部的模块输出



我以模块之间的通信为例,将第二个输入模块更改为渲染模块。所以基本上,一旦你点击";显示"按钮,它呈现模块UI和服务器。模块从list(2个reactive的列表(中的2个selectInput输出选择项。我为第一个元素设置了一个观察器,作为我面临的问题的一个最小示例。它只激发一次,但在我选择新值后不会再次激发。

有趣的是,通过调试按钮browser()对模块无功输出的检查表明,该值确实发生了变化。

#' 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 <- setNames(colnames(iris)[1:4], colnames(iris)[1:4])

# assemble UI elements
tagList(
selectInput(
ns("xvar"),
"Select X variable",
choices = var_choices,
selected = colnames(iris)[1]
),
selectInput(
ns("yvar"),
"Select Y variable",
choices = var_choices,
selected = colnames(iris)[2]
)
)
}
#' 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 })
)
)
}
#' 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()
})
}

#' 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() +
theme(axis.title = element_text(size = rel(1.2)),
axis.text = element_text(size = rel(1.1)))

return(p)
}
# 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("Iris Data Explorer"),

fluidRow(
column(
width = 3,
wellPanel(
varselect_mod_ui("plot1_vars")
)
),
column(
width = 5,
scatterplot_mod_ui("plots")
),
column(1, actionButton("show","Show"), actionButton("dbg","Debug")),
column(
width = 3,
wellPanel(
uiOutput("plot2_vars_ui")#varselect_mod_ui("plot2_vars")
)
)
)
)
# server logic
server <- function(input, output, session) {
observer = NULL
# prepare dataset
data <- iris

# execute plot variable selection modules
plot1vars <- callModule(varselect_mod_server, "plot1_vars")
plot2vars <- list(xvar = reactive({colnames(iris)[1]}), yvar = reactive({colnames(iris)[2]}))#callModule(varselect_mod_server, "plot2_vars")

observeEvent(input$show, {
output$plot2_vars_ui = renderUI({

plot2vars__ <<- callModule(varselect_mod_server, "plot2_vars")
observer <<- observeEvent(plot2vars__$xvar, {
print("observer inside renderUI is triggered!")
print(plot2vars$xvar())
#browser()
})
varselect_mod_ui("plot2_vars")
})
})

observeEvent(plot2vars$xvar, {
print("observer outside renderUI")
print(plot2vars$xvar())
#browser()
})

observeEvent(input$dbg, {

browser()
})
# execute scatterplot module
res <- callModule(scatterplot_mod_server,
"plots",
dataset = data,
plot1vars = plot1vars,
plot2vars = plot2vars)
}
# Run the application
shinyApp(ui = ui, server = server)

在这里,我在示例中进一步减少了这个问题,我对observeEvent(input$show, {observeEvent(plot_vars$xvar(), {感到困惑。无功值需要(),输入不需要。

#' 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 <- setNames(colnames(iris)[1:4], colnames(iris)[1:4])

# assemble UI elements
tagList(
selectInput(
ns("xvar"),
"Select X variable",
choices = var_choices,
selected = colnames(iris)[1]
),
selectInput(
ns("yvar"),
"Select Y variable",
choices = var_choices,
selected = colnames(iris)[2]
)
)
}
#' 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 })
)
)
}
#' 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(
width = 6,
plotOutput(ns("plot"))
)
}
#' Scatterplot module server-side processing
#'
#' This module produces a scatterplot with 2 variables
#'
#' @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,
plotvars) {

plot_obj <- reactive({
p <- scatter_plot(dataset, xvar = plotvars$xvar(), yvar = plotvars$yvar())
return(p)
})

output$plot <- renderPlot({
plot_obj()
})
}

#' 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_plot <- function(dataset, xvar, yvar) {

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

p <- ggplot(dataset, aes(x = !!x, y = !!y)) +
geom_point() +
theme(axis.title = element_text(size = rel(1.2)),
axis.text = element_text(size = rel(1.1)))

return(p)
}
# load packages
library(shiny)
library(AmesHousing)
library(dplyr)
library(rlang)
library(ggplot2)
library(scales)
# user interface
ui <- fluidPage(

titlePanel("Iris Data Explorer"),

fluidRow(
column(3, actionButton("show","Show"), actionButton("dbg","Debug"),
textOutput("selection")),
column(
width = 3,
wellPanel(
uiOutput("plot_vars_ui")#varselect_mod_ui("plot2_vars")
)
),
column(
width = 6,
scatterplot_mod_ui("plots")
)
)
)
# server logic
server <- function(input, output, session) {
observer = NULL
# prepare dataset
data <- iris

# execute plot variable selection modules
plot_vars <- list(xvar = reactive({colnames(iris)[1]}), yvar = reactive({colnames(iris)[2]}))#callModule(varselect_mod_server, "plot2_vars")

observeEvent(input$show, {
output$plot_vars_ui = renderUI({

plot_vars <<- callModule(varselect_mod_server, "plot_vars")
# observer <<- observeEvent(plot_vars$xvar, {
#   browser()
#   print("observer inside renderUI is triggered!")
#   print(plot_vars$xvar())
#   #browser()
# })

#observe({#plot_vars$xvar
observeEvent(plot_vars$xvar(), {
#browser()
print("observer inside renderUI is triggered!")
print(plot_vars$xvar())
#browser()
})

#output$selection = renderText({
#   plot_vars$xvar()
#})

varselect_mod_ui("plot_vars")
})
})

observeEvent(plot_vars$xvar, {
print("observer outside renderUI")
print(plot_vars$xvar())
#browser()
})

observeEvent(input$dbg, {

browser()
})
# execute scatterplot module
res <- callModule(scatterplot_mod_server,
"plots",
dataset = data,
plotvars = plot_vars)
}
# Run the application
shinyApp(ui = ui, server = server)

最新更新