Shiny reactivity not working in subModules - r

Because my shiny app has become quite large I've recently put some code into modules (also to reuse the code multiple times in different places). Somehow parts of the code do not work anymore as expected.
In this example I have a module which filters data according to input elements and return a reactive data.frame. In the mainPanel I have a module which creates a dataTable from the filtered data. But the reactivity does not work, when I change the selectInput, the dataTable does not update.
library(shiny)
library(DT)
filtersUI <- function(id) {
ns <- NS(id)
selectizeInput(
ns("Species"), label = "Species",
choices = levels(iris$Species),
selected = "virginica"
)
}
filters <- function(input, output, session, .data) {
inputs <- reactive({
list("Species" = input[["Species"]])
})
reactive({
.data[.data$Species %in% inputs()[["Species"]], ]
})
}
dataTableUI <- function(id) {
ns <- NS(id)
DT::dataTableOutput(ns("data.table"))
}
dataTable <- function(input, output, session, .data) {
output$data.table <- DT::renderDataTable({
DT::datatable(.data)
})
}
appUI <- function(id) {
ns <- NS(id)
sidebarLayout(
sidebarPanel(
filtersUI(ns("filter"))
),
mainPanel(
dataTableUI(ns("data.table"))
)
)
}
app <- function(input, output, session, .data) {
data.subset <- callModule(filters, "filter", .data = .data)
callModule(dataTable, "data.table", .data = data.subset())
}
ui <- fluidPage(
appUI("app")
)
server <- function(input, output, session) {
callModule(app, "app", .data = iris)
}
shinyApp(ui, server)
But when copying the code from the subModules into the app module, the code works fine:
library(shiny)
library(DT)
appUI <- function(id) {
ns <- NS(id)
sidebarLayout(
sidebarPanel(
selectizeInput(
ns("Species"), label = "Species",
choices = levels(iris$Species),
selected = "virginica"
)
),
mainPanel(
DT::dataTableOutput(ns("data.table"))
)
)
}
app <- function(input, output, session, .data) {
inputs <- reactive({
list("Species" = input[["Species"]])
})
data.subset <- reactive({
.data[.data$Species %in% inputs()[["Species"]], ]
})
output$data.table <- DT::renderDataTable({
DT::datatable(data.subset())
})
}
ui <- fluidPage(
appUI("app")
)
server <- function(input, output, session) {
callModule(app, "app", .data = iris)
}
shinyApp(ui, server)
I know the modular structure looks like overkill in this simple example, but in my real app I have lots of code in the modules, which I deleted to make this example minimal. So it would be nice to have a solution using the same modular structure as in the first code snippet. Any ideas why it fails?

You did a very nice job creating a repoducible example with submodules. However, the issue does in fact not have anything to do with submodules. You just need to pass the reactive object data.subset differently. Instead of
callModule(dataTable, "data.table", .data = data.subset())
you should use
callModule(dataTable, "data.table", .data = data.subset)
to pass the reactive itself rather than its current value. The value can then be "resolved" in DT::renderDataTable like this
output$data.table <- DT::renderDataTable({
DT::datatable({.data()})
})
The way you coded it, the data at "construction time" i.e. the unfiltered dataset is sent to the module and it can't be observed along the way.
To be clear: The commented lines (## remove parantheses here and ## add parantheses here) are the only ones I changed from your original code.
library(shiny)
library(DT)
filtersUI <- function(id) {
ns <- NS(id)
selectizeInput(
ns("Species"), label = "Species",
choices = levels(iris$Species),
selected = "virginica"
)
}
filters <- function(input, output, session, .data) {
inputs <- reactive({
list("Species" = input[["Species"]])
})
reactive({
.data[.data$Species %in% inputs()[["Species"]], ]
})
}
dataTableUI <- function(id) {
ns <- NS(id)
DT::dataTableOutput(ns("data.table"))
}
dataTable <- function(input, output, session, .data) {
output$data.table <- DT::renderDataTable({
DT::datatable({.data()}) ## add parantheses here
})
}
appUI <- function(id) {
ns <- NS(id)
sidebarLayout(
sidebarPanel(
filtersUI(ns("filter"))
),
mainPanel(
dataTableUI(ns("data.table"))
)
)
}
app <- function(input, output, session, .data) {
data.subset <- callModule(filters, "filter", .data = .data)
callModule(dataTable, "data.table", .data = data.subset) ## remove parantheses here
}
ui <- fluidPage(
appUI("app")
)
server <- function(input, output, session) {
callModule(app, "app", .data = iris)
}
shinyApp(ui, server)
To sum things up, here is a quote from Joe Cheng to a similar issue
Hi Mark, the code in linkedScatter itself is correct; but when calling callModule, you want to pass the reactive itself by name (car_data) without reading it (car_data()).
callModule(linkedScatter, "scatters", car_data)
This is similar to how you can pass a function by name to something like lapply:
lapply(letters, toupper) # works
lapply(letters, toupper()) # doesn't work

Related

change dataset with dropdown

I am developing a Shiny app in golem that displays data in a DT. I want the user to be able to select a dataset. This is the first time I am trying to pass reactive values from a Shiny module, and for some reason the DT is not updating when another dataset is selected. Reprex below, thanks for your help!
reprex::reprex({
library(tidyverse)
library(shiny)
# modules -----------------------------------------------------------------
## filter_source----------------------------------------------------------
mod_filter_source_ui <- function(id) {
ns <- NS(id)
tagList(
shiny::selectInput(
ns("dataset"),
label = "select dataset",
choices = c("cars", "pressure", "diamonds"),
selectize = TRUE
))
}
mod_filter_source_server <- function(id) {
moduleServer(id, function(input, output, session) {
ns <- session$ns
df_dataset <- shiny::reactive({
switch(input$dataset,
"cars"= cars,
"pressure" = pressure,
"diamonds" = diamonds)
})
return(df_dataset)
})
}
## render_table ------------------------------------------------------------
mod_table_ui <- function(id){
ns <- NS(id)
tagList(
DT::dataTableOutput(ns("table_out"))
)
}
mod_table_server <- function(id, df){
moduleServer( id, function(input, output, session){
ns <- session$ns
output$table_out <- DT::renderDataTable(df)
})
}
# ui ----------------------------------------------------------------------
app_ui <- function(request) {
tagList(
fluidPage(
mod_filter_source_ui("selected_dataset"),
mod_table_ui("main_table")
)
)
}
# server ------------------------------------------------------------------
app_server <- function(input, output, session) {
df_dataset_val <- mod_filter_source_server("selected_dataset")
mod_table_server("main_table", df = df_dataset_val())
}
# run ---------------------------------------------------------------------
shinyApp(app_ui, app_server)
})
There is a subtle difference between a reactive (df_dataset_val) and the value of a reactive (df_dataset_val()). You got it right in the definition of your filter module server and returned the reactive rather than its value. But you got it wrong in your call to your table module server and passed the current value of the reactive, rather than the reactive itself.
Replace mod_table_server("main_table", df = df_dataset_val()) with mod_table_server("main_table", df = df_dataset_val) and you should be good to go.
See the highlighted text at the end of the "Writing server functions" section of this RStudio article.

shinymeta: how to use expandChain in modules?

I'm making an app with modules in which the user can create as many UI as he wants. Each UI contain one table and I would like to give the possibility to the user to see the code for each of this table separately, not in a unique chunk. Therefore, I included the part of the code with expandChain in my module (module_server).
However, expandChain won't detect the reactive stuff I'm calling because the name of this stuff changes since it is created in a module. Take a look at the app below:
library(dplyr)
library(shiny)
library(shinymeta)
library(WDI)
module_ui <- function(id){
ns <- NS(id)
tagList(
fluidRow(
actionButton(ns("show_table"), "Show table"),
actionButton(ns("show_code"), "Show code"),
tableOutput(ns("table"))
)
)
}
module_server <- function(input, output, session){
data <- metaReactive2({
req(input$show_table)
isolate(metaExpr({
mtcars
}))
})
output$table <- renderTable({
data()
})
observeEvent(input$show_code, {
showModal(modalDialog(
renderPrint({
expandChain(data())
})
))
})
}
ui <- fluidPage(
actionButton("launch", "Launch")
)
server <- function(input, output, session) {
count <- reactiveValues(value = 0)
observeEvent(input$launch, {
count$value <- count$value + 1
insertUI(selector = "#launch",
where = "afterEnd",
ui = module_ui(count$value))
callModule(module_server, count$value)
})
}
shinyApp(ui, server)
When I try to show the code for the table generated, I have the error:
Warning: Error in : <text>:2:2: unexpected input
1: `1_data` <- mtcars
2: 1_
^
133: <Anonymous>
Since the module renames data() by adding a number, data() is not recognized by expandChain. I tried with:
expandChain(paste0(id, "_data()"))
without success (since expandChain does not support character).
Does anybody know how to do it?
Also asked on RStudio Community
Here's the solution given on RStudio Community (see the link for some additional details):
library(dplyr)
library(shiny)
library(shinymeta)
library(WDI)
module_ui <- function(id){
ns <- NS(id)
tagList(
fluidRow(
actionButton(ns("show_table"), "Show table"),
actionButton(ns("show_code"), "Show code"),
tableOutput(ns("table"))
)
)
}
module_server <- function(input, output, session){
data <- metaReactive2({
req(input$show_table)
isolate(metaExpr({
mtcars
}))
})
output$table <- renderTable({
data()
})
observeEvent(input$show_code, {
showModal(modalDialog(
renderPrint({
expandChain(data())
})
))
})
}
ui <- fluidPage(
actionButton("launch", "Launch")
)
server <- function(input, output, session) {
count <- reactiveValues(value = 0)
observeEvent(input$launch, {
count$value <- count$value + 1
insertUI(selector = "#launch",
where = "afterEnd",
ui = module_ui(paste0("x", count$value)))
callModule(module_server, paste0("x", count$value))
})
}
shinyApp(ui, server)

Shiny: Error when referring to renderUI's id inside the module

I'm building a Shiny module with renderUI where I refer to IDs produced inside the module server function:
library(shiny)
library(DT)
library(dplyr)
module_ui <- function(id){
ns <- shiny::NS(id)
shiny::tagList(
fluidPage(uiOutput('test_ui'))
)
}
module <- function(input, output, session) {
ns <- session$ns
output$test_ui <- renderUI({
shiny::fluidPage(
shiny::selectizeInput(
inputId = ns('plot_vars'),
label = 'Choose variables to plot',
choices = colnames(mtcars),
selected = colnames(select(mtcars, mpg, wt)),
multiple = TRUE
),
verbatimTextOutput(ns('text')),
DT::dataTableOutput(ns('d_plot'))
)
})
output$text <- renderText({
input$plot_vars
})
output$d_plot <- DT::renderDataTable({
input_data <- mtcars[, input$plot_vars]
DT::datatable(input_data)
})
}
ui <- module_ui('XXX')
server <- callModule(module, 'XXX')
shinyApp(ui, server)
Despite applying ns() religiously throughout, I'm getting the following error when running server module function:
Error in session$makeScope(id) : attempt to apply non-function
Can't see what's causing the problem here, any hints would be very much appreciated!
First, you have to use ns in module_ui:
module_ui <- function(id){
ns <- NS(id)
tagList(
fluidPage(uiOutput(ns('test_ui')))
)
}
You have to define ui and server like this:
ui <- fluidPage(
module_ui('XXX')
)
server <- function(input, output, session){
callModule(module, 'XXX')
}
Something else: set drop = FALSE when you select some columns of a dataframe:
input_data <- mtcars[, input$plot_vars, drop = FALSE]
otherwise you get a vector if you select only one column, with drop=FALSE you get a dataframe with a single column.

Make shiny module reactive

The example app below has two shiny modules. The first module displays a table with randomly generated values as well as an action button, which, when clicked, generates new values. The second module displays the data set generated in the first one.
How do I make the second table change with the first one?
Thank you.
app.R
library(shiny)
source("modules.R")
ui <- fluidPage(
fluidRow(
column(6, table1_moduleUI("table1")),
column(6, table2_moduleUI("table2"))
)
)
server <- function(input, output, session) {
table1 <- callModule(table1_module, "table1")
callModule(table2_module, "table2", table_data = table1$values)
}
shinyApp(ui, server)
modules.R
# Module for table 1
table1_moduleUI <- function(id){
ns <- NS(id)
tagList(
tableOutput(ns("table")),
actionButton(ns("submit"), label = "Change values")
)
}
table1_module <- function(input, output, session) {
table <- reactiveValues()
observeEvent(input$submit, {
table$values <- replicate(3, rnorm(10))
}, ignoreNULL = FALSE)
output$table <- renderTable({
table$values
})
return(table)
}
# Module for table 2
table2_moduleUI <- function(id){
ns <- NS(id)
tableOutput(ns("table"))
}
table2_module <- function(input, output, session, table_data){
output$table <- renderTable({
table_data
})
}
The second module seems to be missing in the question but the logic seems to be straight forward. The issue here is that you are passing the value of the reactive expression to the second module when you use,
callModule(table2_module, "table2", table_data = table1$values)
instead, you want to pass the reactive value, which tells R to invalidate the outputs when the reactive values changes,
callModule(table2_module, "table2", table_data = table1)
here is the complete app,
library(shiny)
# Module for table 1
table1_moduleUI <- function(id){
ns <- NS(id)
tagList(
tableOutput(ns("table")),
actionButton(ns("submit"), label = "Change values")
)
}
table2_moduleUI <- function(id){
ns <- NS(id)
tableOutput(ns("table"))
}
table1_module <- function(input, output, session) {
table <- reactiveValues()
observeEvent(input$submit, {
table$values <- replicate(3, rnorm(10))
}, ignoreNULL = FALSE)
output$table <- renderTable({
table$values
})
return(table)
}
table2_module <- function(input, output, session,table_data) {
output$table <- renderTable({
table_data
})
}
ui <- fluidPage(
fluidRow(
column(6, table1_moduleUI("table1")),
column(6, table2_moduleUI("table2"))
)
)
server <- function(input, output, session) {
table1 <- callModule(table1_module, "table1")
callModule(table2_module, "table2", table_data = table1$values)
}
shinyApp(ui, server)
As a caveat, if you are wanting to display a dataframe, using reactive values seems to be overkill. When we want to return a reactive expression, intead of initializing a reactive variable and setting it in an observer we can simply use reactive() or eventReactive(), this is what they are there for! So let's use it. Reactive values have their space, and in my experience are used relatively sparingly.
library(shiny)
# Module for table 1
table1_moduleUI <- function(id){
ns <- NS(id)
tagList(
tableOutput(ns("table")),
actionButton(ns("submit"), label = "Change values")
)
}
table2_moduleUI <- function(id){
ns <- NS(id)
tableOutput(ns("table"))
}
table1_module <- function(input, output, session) {
table = eventReactive(input$submit, {
replicate(3, rnorm(10))
}, ignoreNULL = FALSE)
output$table <- renderTable({
table()
})
return(table)
}
table2_module <- function(input, output, session,table_data) {
output$table <- renderTable({
table_data()
})
}
ui <- fluidPage(
fluidRow(
column(6, table1_moduleUI("table1")),
column(6, table2_moduleUI("table2"))
)
)
server <- function(input, output, session) {
table1 <- callModule(table1_module, "table1")
callModule(table2_module, "table2", table_data = table1)
}
shinyApp(ui, server)

shiny module selectInput is not reactive

For some reason using a selectInput in a module is not reacting to changes of the input value. I added a minimum example to demonstrate my issue. If I write the same code without a module, i.e. pasting the ui and server code of the module to the main server and ui functions without the namespace function works.
I don't really see the issue with my code.
require(shiny)
ui <- function(){
dummyUI("test")
}
server <- function(input, output, session) {
callModule(dummy, "test")
}
dummyUI <- function(id) {
ns <-NS(id)
uiOutput(width = 6, ns("selectMaterial"))
}
dummy <- function(input, output, session) {
# render UI for the filters
output$selectMaterial <- renderUI({
selectInput(
inputId = "selectMaterial",
label = "Choose Materials" ,
choices = c("a","b"),
multiple = TRUE)
})
observeEvent(input$selectMaterial ,{print("hi")})
}
shinyApp(ui(), server)
As mentioned in this article (section "Using renderUI within modules
"), you need to use the namespace function in renderUI.
require(shiny)
ui <- function(){
dummyUI("test")
}
server <- function(input, output, session) {
callModule(dummy, "test")
}
dummyUI <- function(id) {
ns <-NS(id)
uiOutput(width = 6, ns("selectMaterial"))
}
dummy <- function(input, output, session) {
# render UI for the filters
output$selectMaterial <- renderUI({
selectInput(
inputId = session$ns("selectMaterial"), ## <= namespace here
label = "Choose Materials" ,
choices = c("a","b"),
multiple = TRUE)
})
observeEvent(input$selectMaterial ,{print("hi")})
}
shinyApp(ui(), server)

Resources