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.
Related
My shinyapp is build using modules, the radioBox component inputId = modelling_type is created in the server, using a renderUI function and stored under outputId = modelling_type_ui
As I'm using modules, I have name spaced my IDs in the mod_ui, and then in order to (attempt!) to use the same name space function in the mod_server I have called it via ns <- parentsession$ns. This doesn't throw an error. But I would now expect to access the value of the RadioBox via input$modelling_type
This isn't working! So I must be calling the value incorrectly.
Here is the code:
library(shiny)
library(shinyalert)
library(shinydashboard)
library(shinyjs)
library(tidyverse)
# modules ------------------------------------------
mod_ui <- function(id){
ns <- NS(id)
fluidPage(
uiOutput(outputId = ns("modelling_type_ui")),
textOutput(outputId = ns("capture"))
)
}
mod_server <- function(id, parentsession){
moduleServer(id,
function(input, output, server){
ns <- parentsession$ns
output$modelling_type_ui = renderUI({
print(input$modelling_type) # this should not be null
radioButtons(
inputId = ns("modelling_type"),
label = "Choose a modelling technique",
choices = c("OLS",
"Bayesian"),
selected = "OLS")
})
output$capture = renderText({ paste0("modelling type selected:", input$modelling_type) })
})
}
# call app ---------------------------------------
# run app
ui <- function(){ mod_ui("mt") }
server <- function(input, output, session){ mod_server("mt", session) }
shinyApp(ui = ui, server = server)
Any help appreciated. Usually I would just call radioButtons in the UI, and use updateradioButtons function in the server, but I'm dealing with a legacy app which uses the below method repeatedly.
To expand on my comment above, here is a MWE that I believe does what you want.
I'm not sure why you're using uiOutput and renderUI. I assume it's needed in your actual use case, but it's not needed here. Also, there's no need to muck about with parentsession and the like.
One reason why your debug print prints NULL is that you haven't defined the radio group at the time you try to print its value.
library(shiny)
library(tidyverse)
mod_ui <- function(id){
ns <- NS(id)
fluidPage(
uiOutput(outputId = ns("modelling_type_ui")),
textOutput(outputId = ns("capture"))
)
}
mod_server <- function(id) {
moduleServer(
id,
function(input, output, session){
ns <- session$ns
output$modelling_type_ui = renderUI({
radioButtons(
inputId = ns("modelling_type"),
label = "Choose a modelling technique",
choices = c("OLS","Bayesian"),
selected = "OLS"
)
})
output$capture <- renderText({
paste0("modelling type selected: ", input$modelling_type)
})
rv <- reactive({
input$modelling_type
})
return(rv)
}
)
}
ui <- function() {
fluidPage(
mod_ui("mt"),
textOutput("returnValue")
)
}
server <- function(input, output, session) {
modValue <- mod_server("mt")
output$returnValue <- renderText({
paste0("The value returned by the module is ", modValue())
})
}
shinyApp(ui = ui, server = server)
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)
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.
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)
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