I'm trying to generalise Shiny modules so different functions can be passed through, but the expected behaviour of reactivity is not working - could someone point me in the right direction? I have a reprex below that illustrates my problem.
I expect that the dynamic selection of view_id
to change values in the renderShiny()
function. It works on app load but changing selections do not flow through.
Is it something to do with the environment the module function is created within?
library(shiny)
create_shiny_module_funcs <- function(data_f,
model_f,
outputShiny,
renderShiny){
server_func <- function(input, output, session, view_id, ...){
gadata <- shiny::reactive({
# BUG: this view_id is not reactive but I want it to be
data_f(view_id(), ...)
})
model_output <- shiny::reactive({
shiny::validate(shiny::need(gadata(),
message = "Waiting for data"))
model_f(gadata(), ...)
})
output$ui_out <- renderShiny({
shiny::validate(shiny::need(model_output(),
message = "Waiting for model output"))
message("Rendering model output")
model_output()
}, ...)
return(model_output)
}
ui_func <- function(id, ...){
ns <- shiny::NS(id)
outputShiny(outputId = ns("ui_out"), ...)
}
list(
shiny_module = list(
server = server_func,
ui = ui_func
)
)
}
# create the shiny module
ff <- create_shiny_module_funcs(
data_f = function(view_id) mtcars[, view_id],
model_f = function(x) mean(x),
outputShiny = shiny::textOutput,
renderShiny = function(x) shiny::renderText(paste("Mean is: ", x))
)
## ui.R
ui <- fluidPage(title = "module bug Shiny Demo",
h1("Debugging"),
selectInput("select", label = "Select", choices = c("mpg","cyl","disp")),
textOutput("view_id"),
ff$shiny_module$ui("demo1"),
br()
)
## server.R
server <- function(input, output, session){
view_id <- reactive({
req(input$select)
input$select
})
callModule(ff$shiny_module$server, "demo1", view_id = view_id)
output$view_id <- renderText(paste("Selected: ", input$select))
}
# run the app
shinyApp(ui, server)