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)
Related
Is it possible to get some R object used in Shiny?
For example, in the following code, I want to get text string inputted by users.
However, the .Last.value dose not the desired text string.
ref
How to store the returned value from a Shiny module in reactiveValues?
Ex code
returnUI = function(id) {
ns <- NS(id)
tagList(
textInput(ns("txt"), "Write something")
)
}
returnServer = function(input, output, session) {
myreturn <- reactiveValues()
observe({ myreturn$txt <- input$txt })
return(myreturn)
}
library(shiny)
source("modules/module_1.R")
ui <- fluidPage(
returnUI("returntxt"),
textOutput("mytxt")
)
server <- function(input, output, session) {
myvals <- reactiveValues(
txt = NULL
)
mytxt <- callModule(returnServer, "returntxt")
observe({
myvals$txt <- mytxt$txt
print(myvals$txt)
})
output$mytxt <- renderText({ myvals$txt })
}
shinyApp(ui, server)
.Last.value
Yes, you can push variables to the global environment (your usual workspace) from a Shiny app running in your console:
library(shiny)
ui <- fluidPage(
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30)
),
mainPanel(NULL)
)
)
server <- function(input, output) {
observe({
my_global_env <- globalenv()
my_global_env$x <- input$bins
})
}
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)
Version 1 below is a toy module that asks for a user input txt, and return the input to the main Shiny app. The main Shiny app then render the text and output it to the screen.
Here I store the return value of the module in a variable called mytxt and I called it through renderText({ mytxt() }).
However, what I actually want to do is to store the returned value to reactiveValues in the main Shiny app. (It doesn't matter if I output it or not as I want to do further evaluations on that value.) But sadly I found no way in making it works. I'm showing my failed codes in Version 2 below.
Version 1 (Correct)
app.R
library(shiny)
source("module_1.R")
ui <- fluidPage(
returnUI("returntxt"),
textOutput("mytxt")
)
server <- function(input, output, session) {
mytxt <- callModule(returnServer, "returntxt")
output$mytxt <- renderText({ mytxt() })
}
shinyApp(ui, server)
module_1.R
returnUI = function(id) {
ns <- NS(id)
tagList(
textInput(ns("txt"), "Write something")
)
}
returnServer = function(input, output, session) {
mytxt <- reactive({
input$txt
})
return(mytxt)
}
Version 2 (Need help!)
app.R
library(shiny)
source("modules/module_1.R")
ui <- fluidPage(
returnUI("returntxt"),
textOutput("mytxt")
)
server <- function(input, output, session) {
myvals <- reactiveValues(
txt = NULL
)
mytxt <- callModule(returnServer, "returntxt")
myvals$txt <- isolate(mytxt())
output$mytxt <- renderText({ myvals$txt })
}
shinyApp(ui, server)
module.R is the same as Version 1.
I just found the answer by returning reactiveValues from the module and use observe :) Woohoo!
app.R
library(shiny)
source("modules/module_1.R")
ui <- fluidPage(
returnUI("returntxt"),
textOutput("mytxt")
)
server <- function(input, output, session) {
myvals <- reactiveValues(
txt = NULL
)
mytxt <- callModule(returnServer, "returntxt")
observe({
myvals$txt <- mytxt$txt
print(myvals$txt)
})
output$mytxt <- renderText({ myvals$txt })
}
shinyApp(ui, server)
module_1.R
returnUI = function(id) {
ns <- NS(id)
tagList(
textInput(ns("txt"), "Write something")
)
}
returnServer = function(input, output, session) {
myreturn <- reactiveValues()
observe({ myreturn$txt <- input$txt })
return(myreturn)
}
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
this is my first question at stackoverflow. I have a problem with modules and renderUI in shiny (1.0.5).
When I use renderUI in
#### Main Part
ui <- bootstrapPage(
uiOutput("DynamicContent")
)
server <- function(input, output,session) {
S_A <- selectInput("S_A_Input" ,"Change Me for print message",choices=1:3 )
output$DynamicContent <- renderUI({
tagList(S_A)
})
observe({
print(input$S_A_Input)
})
}
shinyApp(ui = ui, server = server)
then changing the selectInput will cause changing input$S_A_Input, so the print will occur. That's fine.
On the other hand, input$S_A_Input seems not to work, if I work with modules:
### Module Part
Module_YYY_Server <- function(input, output, session){
S_A <- selectInput("S_A_Input" ,"Change Me for print message",choices=1:3 )
output$DynamicContent <- renderUI({
tagList(S_A)
})
observe({
print(input$S_A_Input)
})
}
Module_YYY_Ui <- function(id){
ns <- NS(id) # Creates Namespace
tagList(
uiOutput("DynamicContent" %>% ns)
)
}
And then calling the module.
#### Main Part
ui <- bootstrapPage(
Module_YYY_Ui("YYY")
)
server <- function(input, output,session) {
callModule(Module_YYY_Server,"YYY")
}
shinyApp(ui = ui, server = server)
I haven't found a solution to this behaviour.
Late to the party but this is another option to solve your problem using
session$ns("id")
Here how it looks like:
Module_YYY_Server <- function(input, output, session){
output$DynamicContent <- renderUI({
selectInput(session$ns("S_A_Input"), "Change Me for print message", choices = 1:3)
})
output$text <- renderText({
req(input$S_A_Input)
input$S_A_Input})
}
Module_YYY_Ui <- function(id){
ns <- NS(id) # Creates Namespace
tagList(
uiOutput(ns("DynamicContent")),
textOutput(ns("text"))
)
}
ui <- bootstrapPage(
Module_YYY_Ui("YYY")
)
server <- function(input, output,session) {
callModule(Module_YYY_Server,"YYY")
}
shinyApp(ui = ui, server = server)
This is based on the example here
While I am sure your example is simplified, If your input$S_A_Input is not changing based on what you are doing, as is the case in your example, I would not recommend using renderUI. Regardless of that, the reason that your input is not printing is because you are not generating it as an output.
Module_YYY_Server <- function(input, output, session){
output$DynamicContent <- renderUI({
ns <- session$ns
tagList(
selectInput("S_A_Input" %>% ns, "Change Me for print message",choices=1:3 )
)
})
output$text <- renderText({input$S_A_Input})
}
Module_YYY_Ui <- function(id){
ns <- NS(id) # Creates Namespace
tagList(
uiOutput("DynamicContent" %>% ns),
textOutput("text" %>% ns)
)
}