Reputation: 129
I created an app (condensed example for illustration) in shiny containing a module whose communication does not work properly.
The ui shall create some Data (DataPack
) (a list
with so far two elements) by clicking the "Load"-button. The data shall then be plotted via the module whereas the x-axis range of each module's plot shall be controlled by a sliderInput
of the ui.
Even though the data created is plotted correctly (on the first run only) here are the particular problems I am facing:
restarting interrupted promise evaluation
warning is being created when DataPack
isn't created or passed to the module yet. Therefore, I understand the warning when Datapack
isn't created yet but not after the first click of the "Load"-button. Is there a way to avoid this? Where does this behavior come from?DataPack
) by clicking the "Load"-button the slider is updated correctly reflecting the (common) length of the data created (n
). However, the initial value set (value = c(0, 150)
) is passed to the modules' plot whereas the updated value (or any other slider position after) by creating the data (i.e. the actual length) after having clicked the "Load"-button is not. Why?Thany you!
library(shiny)
library(TTR)
# module interface
Module_ui <- function(id) {
ns <- NS(id)
plotOutput(ns("Plot"))
}
# module server
Module_Server <- function(input, output, session,
DataPack, DataSetName, xlim) {
output$Plot <- renderPlot({
message(paste("Plot", DataSetName))
plot(DataPack[[DataSetName]],
xlim = c(xlim[1], xlim[2])) })
}
# app ui
ui <- fluidPage(
fluidRow(
column(
6, fluidRow(h4("Data Generation")),
fluidRow(actionButton("InputButton_GetData", "Load", width = "100%"))),
column(
6, fluidRow(h4("Update Plot")),
sliderInput(
"SliderInput_xAxis",
label = NULL,
min = 0,
max = 150,
value = c(0, 150),
animate = TRUE))),
Module_ui("Plot_1"),
Module_ui("Plot_2")
)
# app server
server <- function(input, output, session) {
DataPack <- eventReactive(
input$InputButton_GetData, {
message("Creating DataPack")
n <- round(runif(1, min = 100, max = 500))
message(n)
DataPack <- NULL
DataPack$one <- rnorm(n)
DataPack$two <- rnorm(n)^2
updateSliderInput(
session = session,
inputId = "SliderInput_xAxis",
value = c(1, n),
min = 1,
max = n)
return(DataPack)
})
callModule(Module_Server, "Plot_1",
DataPack = DataPack(),
DataSetName = "one",
xlim = input$SliderInput_xAxis)
callModule(Module_Server, "Plot_2",
DataPack = DataPack(),
DataSetName = "two",
xlim = input$SliderInput_xAxis)
}
shinyApp(ui, server)
Upvotes: 2
Views: 1494
Reputation: 12819
Prefer passing reactives directly to module functions.
Note removed parentheses and inputs wrapped in reactives in callModule(DataPack = DataPack, ....)
, and accordingly DataPack()
instead of DataPack
in module function body.
library(shiny)
library(TTR)
# module interface
Module_ui <- function(id) {
ns <- NS(id)
plotOutput(ns("Plot"))
}
# module server
Module_Server <- function(input, output, session,
DataPack, DataSetName, xlim) {
output$Plot <- renderPlot({
message(paste("Plot", DataSetName))
plot(DataPack()[[DataSetName]],
xlim = c(xlim()[1], xlim()[2])) })
}
# app ui
ui <- fluidPage(
fluidRow(
column(
6, fluidRow(h4("Data Generation")),
fluidRow(actionButton("InputButton_GetData", "Load", width = "100%"))),
column(
6, fluidRow(h4("Update Plot")),
sliderInput(
"SliderInput_xAxis",
label = NULL,
min = 0,
max = 150,
value = c(0, 150),
animate = TRUE))),
Module_ui("Plot_1"),
Module_ui("Plot_2")
)
# app server
server <- function(input, output, session) {
DataPack <- eventReactive(
input$InputButton_GetData, {
message("Creating DataPack")
n <- round(runif(1, min = 100, max = 500))
message(n)
DataPack <- NULL
DataPack$one <- rnorm(n)
DataPack$two <- rnorm(n)^2
updateSliderInput(
session = session,
inputId = "SliderInput_xAxis",
value = c(1, n),
min = 1,
max = n)
return(DataPack)
})
SliderInput_xAxis_rx <- reactive(input$SliderInput_xAxis)
callModule(Module_Server, "Plot_1",
DataPack = DataPack,
DataSetName = "one",
xlim = SliderInput_xAxis_rx)
callModule(Module_Server, "Plot_2",
DataPack = DataPack,
DataSetName = "two",
xlim = SliderInput_xAxis_rx)
}
shinyApp(ui, server)
Edit: Recommended syntax update for Shiny version > 1.5
Module_Server <- function(id,
DataPack, DataSetName, xlim) {
moduleServer(id,
function(input, output, session) {
output$Plot <- renderPlot({
message(paste("Plot", DataSetName))
plot(DataPack()[[DataSetName]],
xlim = c(xlim()[1], xlim()[2])) })
}
)
}
server <- function(input, output, session) {
DataPack <- eventReactive(input$InputButton_GetData, {
message("Creating DataPack")
n <- round(runif(1, min = 100, max = 500))
message(n)
DataPack <- NULL
DataPack$one <- rnorm(n)
DataPack$two <- rnorm(n)^2
updateSliderInput(session = session,
inputId = "SliderInput_xAxis",
value = c(1, n), min = 1, max = n)
return(DataPack)
})
SliderInput_xAxis_rx <- reactive(input$SliderInput_xAxis)
Module_Server("Plot_1",
DataPack = DataPack,
DataSetName = "one",
xlim = SliderInput_xAxis_rx)
Module_Server("Plot_2",
DataPack = DataPack,
DataSetName = "two",
xlim = SliderInput_xAxis_rx)
}
Upvotes: 3
Reputation: 84529
I'm not sure what the app is supposed to do but I think you have to pass the reactive conductor DataPack
to the module server, not the value it returns:
Module_Server <- function(input, output, session,
DataPack, DataSetName, xlim) {
output$Plot <- renderPlot({
message(paste("Plot", DataSetName))
plot(DataPack()[[DataSetName]], # note the parentheses
xlim = c(xlim[1], xlim[2])) })
}
callModule(Module_Server, "Plot_1",
DataPack = DataPack, # no parentheses
DataSetName = "one",
xlim = input$SliderInput_xAxis)
callModule(Module_Server, "Plot_2",
DataPack = DataPack, # no parentheses
DataSetName = "two",
xlim = input$SliderInput_xAxis)
Upvotes: 1