From the example below, I would expect the display of user input to only update every 2s (2000ms). But it's not, it's updating just as fast as when I don't include a debounce statement.
if (interactive()) {
options(device.ask.default = FALSE)
ui <- fluidPage(
textInput(inputId = "text",
label = "To see how quickly..."),
textOutput(outputId = "text")
)
server <- function(input, output, session) {
text_input <- reactive({
input$text
})
debounce(text_input, 2000)
output$text <- renderText({
text_input()
})
}
shinyApp(ui, server)
}
You have to assign the result of the debounce() call and use that in your output:
server <- function(input, output, session) {
text_input <- reactive({
input$text
})
text_d <- debounce(text_input, 2000)
output$text <- renderText({
text_d()
})
}
Related
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 understand that I can use debounce with reactive() like this, and this is the sort of behaviour I need, but I want to use reactiveValues() instead.
ui <- fluidPage(
textInput(inputId = "text",
label = "To see how quickly..."),
textOutput(outputId = "text")
)
server <- function(input, output, session) {
text_input <- reactive({
input$text
})
debounce(text_input, 2000)
output$text <- renderText({
text_input()
})
}
shinyApp(ui, server)
}
But I would prefer to use reactiveValues() rather than reactive().
Is there any way to use debounce with reactiveValues()?
This does not work:
ui <- fluidPage(
textInput(inputId = "text",
label = "To see how quickly..."),
textOutput(outputId = "text")
)
server <- function(input, output, session) {
values <- reactiveValues()
observe({
values$text= function(x)input$text
values$t <-
debounce(values$text(),2000)
})
output$text <- renderText({
values$t()
})
}
shinyApp(ui, server)
I get an error Warning: Error in r: could not find function "r", I guess because values is not a reactive expression?
observe isn't needed:
library(shiny)
ui <- fluidPage(
textInput(inputId = "text", label = "To see how quickly..."),
textOutput(outputId = "text")
)
server <- function(input, output, session) {
values <- reactiveValues()
values$t <- debounce(reactive({input$text}), 2000)
output$text <- renderText({
values$t()
})
}
shinyApp(ui, server)
Or without reactiveValues:
library(shiny)
ui <- fluidPage(
textInput(inputId = "text", label = "To see how quickly..."),
textOutput(outputId = "text")
)
server <- function(input, output, session) {
debouncedText <- debounce(reactive({input$text}), 2000)
output$text <- renderText({
debouncedText()
})
}
shinyApp(ui, server)
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)
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)
}
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)
)
}