I'm creating a Shiny app where user input is parsed and then used to create specific plots. These plots should only be created when the user pushes a corresponding button. The text however should be parsed immediatly when user input changes.
Simplified example:
library(shiny)
ui <- fluidPage(
textAreaInput("txt", "Parse this data:"),
actionButton("go", "Do something with data"),
textOutput("out")
)
server <- function(input, output, session) {
data <- reactive({
message("Parsing data...")
toupper(input$txt)
})
observeEvent(input$go, {
output$out <- data
})
}
shinyApp(ui, server)
The "Parsing data..." message initially only executes when pushing the button, not when changing the input of the textAreaInput.
On top of that, after pushing the button once, the input is parsed immediatly when changed but the output is updated immediatly as well. This also shouldn't happen, it should only change when the button is pressed again.
EDIT
With YBS's answer I found a solution, and using isolate() I don't even need an extra variable:
server <- function(input, output, session) {
data <- reactiveVal()
observeEvent(input$txt, {
message("Parsing data...")
data(toupper(input$txt))
})
observeEvent(input$go, {
output$out <- renderText({ isolate( data() ) })
})
}
Try this
library(shiny)
ui <- fluidPage(
textAreaInput("txt", "Parse this data:"),
actionButton("go", "Do something with data"),
textOutput("out")
)
server <- function(input, output, session) {
rv <- reactiveVal()
data <- reactive({
message("Parsing data...")
toupper(input$txt)
})
observeEvent(input$go, {
rv(data())
})
output$out <- renderText({rv()})
}
shinyApp(ui, server)
Related
I have a modularized application with two "ui" functions (ui and readTzUi) and two "server" functions. For the application I want to read the timezone from a users browser with readTzUi (input#client_time_zone_international) and pass it on to readTzServer.
I have worked out a reproducable example of the app.
As you can see the but_out and out variable can be accessed through the readTzServer, but input$client_time_zone_international results in a NULL value.
Although input$client_time_zone_international is not available in readTzServer, it is available in server (The values of timezone are printed in the console for both readTzServer and server)
A few things that I have tried so far are:
pass input$client_time_zone_international from server to readTzServer with Callmodule
create a global variable of input$client_time_zone_international
capture input$client_time_zone_international in a variable from the readTzUi with Shiny.setInputValue()
All these options did not result in passing the input$client_time_zone_international value to readTzServer.
I hope someone can help me with this problem.
library(shiny)
readTzUi <- function(id, label = "readTz"){
ns <- NS(id)
fluidPage(
tags$script('
$(function() {
$("input#client_time_zone_international").val(Intl.DateTimeFormat().resolvedOptions().timeZone)
});
'),
textInput("client_time_zone_international", "Time zone international", value = ""),
tags$br(),
actionButton(ns("button"), label = label),
verbatimTextOutput(ns("but_out")),
verbatimTextOutput(ns("out"))
)
}
readTzServer <- function(id){
moduleServer(
id,
function(input, output, session){
# This is where I need the timezone value
observe(print(input$client_time_zone_international))
count <- reactiveVal(0)
observeEvent(input$button, {
count(count() + 1)
})
output$but_out <- renderText({
count()
})
count
observe({
output$out <- renderText({
"Hello"
})
})
}
)
}
ui <- fluidPage(
readTzUi("readtz1", "Counter#2")
)
server <- function(input, output, session) {
readTzServer("readtz1")
observe(
print(input$client_time_zone_international)
)
}
shinyApp(ui, server)
This is example how to get a timezone:
library(shiny)
ui <- basicPage(
tags$script("$(document).on('shiny:sessioninitialized', function(event) {
var n = Intl.DateTimeFormat().resolvedOptions().timeZone;
Shiny.onInputChange('client_time', n);});")
)
server <- function(input, output, session) {
observe({
req(input$client_time)
print(input$client_time)
})
}
shinyApp (ui = ui, server = server)
What I want to achieve is to get access to the reactive value passed to a parent module from a child module. The reproducible example below shows the idea. When i click the button in mod_server_btn then its value should be printed out in the console (from within parent module):
library(shiny)
mod_ui_btn <- function(id, label = "ui1UI") {
ns <- NS(id)
shinyUI(fluidPage(
actionButton(ns("confirm"), "Submit", class='btn-primary')
))
}
mod_server_btn <- function(input, output, session) {
cond <- reactive({ input$confirm})
return(cond)
}
ui =fluidPage(
mod_ui_btn("test"),
uiOutput("example")
)
server=shinyServer(function(input, output, session) {
value <- callModule(mod_server_btn,"test")
print(value)
#print(value$cond) # these 3 don't work either
#print(value()$cond)
#print(value())
})
shinyApp(ui=ui,server=server)
However, it doesn't work. When I click the button then I got a text: reactive({input$confirm}) in the console and it's not what I want, I need to access button value. General question is - is it possible at all to get access to reactive value in a parent module?
EDIT: #rbasa, #YBS thanks for your answers. In fact in my real app I need to return more than one reactive value to parent module. Below is slightly changed code - I added second button in mod_ui_btn - now I need to return values from both buttons to the server module. I made a list of reactives but can't get access to them using observe or output$example <-:
library(shiny)
mod_ui_btn <- function(id, label = "ui1UI") {
ns <- NS(id)
shinyUI(fluidPage(
actionButton(ns("confirm"), "Submit", class='btn-primary'),
actionButton(ns("confirm2"), "Submit2", class='btn-primary')
))
}
mod_server_btn <- function(input, output, session) {
return(
list(
cond = reactive({ input$confirm}),
cond2 = reactive({ input$confirm2})
)
)
}
ui =fluidPage(
mod_ui_btn("test"),
verbatimTextOutput("example"),
verbatimTextOutput("example2")
)
server=shinyServer(function(input, output, session) {
value <- callModule(mod_server_btn,"test")
output$example <- renderPrint(value$cond)
output$example2 <- renderPrint(value$cond2)
observe({
print(value$cond) #this is how I usually catch reactives - by their name
print(value$cond2)
})
})
shinyApp(ui=ui,server=server)
I usually use return(list(..some reactive values)) to return more than one ractive value to other module and catch then using their names in parent module. Here it doesn't work even if I use observe. No value is returned.
You can access with value(). I would recommend to change your mod_server_btn to the one shown below, and notice the call in server. EDIT: updated for multiple variables. Try this
library(shiny)
mod_ui_btn <- function(id, label = "ui1UI") {
ns <- NS(id)
shinyUI(fluidPage(
actionButton(ns("confirm"), "Submit", class='btn-primary'),
actionButton(ns("confirm2"), "Submit2", class='btn-primary')
))
}
mod_server_btn <- function(id) {
moduleServer(id, function(input, output, session) {
return(
list(
cond = reactive(input$confirm),
cond2 = reactive(input$confirm2)
)
)
})
}
ui =fluidPage(
mod_ui_btn("test"),
verbatimTextOutput("example"),
verbatimTextOutput("example2")
)
server=shinyServer(function(input, output, session) {
# value <- callModule(mod_server_btn,"test")
value <- mod_server_btn("test")
output$example <- renderPrint(value$cond())
output$example2 <- renderPrint(value$cond2())
observe({
print(value$cond()) #this is how I usually catch reactives - by their name
print(value$cond2())
})
})
shinyApp(ui=ui,server=server)
How to observe when any of the multiple buttons is clicked? For example, we have three buttons, I would like to show the notification when any of the buttons is clicked. Here is an example code
library(shiny)
ui <- fluidPage(
actionButton('button1', 'button1'),actionButton('button2', 'button2'),actionButton('button3', 'button3'))
server <- function(input, output, session) {
observe({
req(input$button1, input$button2, input$button3)
showNotification("This is a notification.")
})
}
shinyApp(ui, server)
The above code is not satisfactory because when initiate the page, only when three buttons are all clicked, notification shows.
Also, is it possible to know which button is cliecked?
Thanks.
Use observeEvent instead and put all your triggers in c()
library(shiny)
ui <- fluidPage(
actionButton('button1', 'button1'),actionButton('button2', 'button2'),actionButton('button3', 'button3'))
server <- function(input, output, session) {
observeEvent(c(input$button1, input$button2, input$button3), ignoreInit = TRUE, {
showNotification("This is a notification.")
})
}
shinyApp(ui, server)
Convert input to a list and use it as your trigger object for an observeEvent:
observeEvent(reactiveValuesToList(input),{
#do something
})
Some alternative ways of doing this:
library(shiny)
library(purrr)
ui <- fluidPage(
actionButton('button1', 'button1'),actionButton('button2', 'button2'),actionButton('button3', 'button3'))
server <- function(input, output, session) {
paste0('button', 1:3) %>%
map(~ observeEvent(input[[.x]], {
showNotification("This is the general notification.")
showNotification(paste(.x, 'pressed'))
}))
}
shinyApp(ui, server)
or using only observe():
library(shiny)
library(stringr)
library(purrr)
ui <- fluidPage(
actionButton('button1', 'button1'),actionButton('button2', 'button2'),actionButton('button3', 'button3'))
server <- function(input, output, session) {
observe({
nms <- str_subset(names(input), 'button')
if ( any(map_lgl(nms,~ input[[.x]] != 0)) ) {
showNotification("This is a notification.")
}
})
}
shinyApp(ui, server)
I'm trying to get an app which updates it output after a set amount of time (i.e. to make text fade away).
In the example code, I would want "Waiting" to display on the actionButton press, then delay for 5 seconds, then the text changes to "Finished".
For some reason the whole observeEvent executes at once, so the outcome is that there is the actionButton is pressed, then there is a 5 second delay with nothing displayed, then "Finished" displays.
Sorry I don't know how to better explain the issue really - but hoping someone can help. If possible I'd like to stick to just R here, without delving too much into javascript.
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
textOutput("text"),
actionButton("press", label = "press")
)
server <- function(input, output) {
num <- reactiveVal()
observeEvent(input$press, {
output$text <- renderText("waiting")
num(1)
})
observe({
if(!is.null(num())){
output$text <- renderText({
Sys.sleep(5)
"finished"
})
}
})
}
shinyApp(ui = ui, server = server)```
You can use the delay() function from shinyjs
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
textOutput("text"),
actionButton("press", label = "press")
)
server <- function(input, output) {
num <- reactiveVal()
observeEvent(input$press, {
output$text <- renderText("waiting")
delay(5000,
output$text <- renderText("finished"))
})
}
shinyApp(ui = ui, server = server)
In my shiny app I have a output which should update itself continuously. But whenever I execute a long-running calculation, the output is just paused. My question is: how to make the output runs continuously and uninterruptible?
Please see the short demo below:
The clock refreshes every one second, but if I click the button which runs for 5 seconds, the clock is paused.
library(shiny)
ui <- fluidPage(
actionButton("button","Expensive calcualtion(takes 5 seconds)"),
tags$p("Current Time:"),
textOutput("time"),
tags$p("Result from clicking button:"),
textOutput("result")
)
server <- function(input, output, session) {
output$time <- renderText({
invalidateLater(1000)
as.character(Sys.time())
})
observeEvent(input$button,{
Sys.sleep(5)
output$result <- renderText(runif(1))
})
}
shinyApp(ui, server)
I tried to use future and promises to make the long-running process runs asynchronously, but it doesn't work. Where is wrong? And is there a better way for achieving this purpose?
library(shiny)
library(future)
library(promises)
plan("multisession")
ui <- fluidPage(
actionButton("button","Expensive calcualtion(takes 5 seconds)"),
tags$p("Current Time:"),
textOutput("time"),
tags$p("Result from clicking button:"),
textOutput("result")
)
server <- function(input, output, session) {
output$time <- renderText({
invalidateLater(1000)
as.character(Sys.time())
})
process <- eventReactive(input$button,{
future({
Sys.sleep(5)
runif(1)
})
})
output$result <- renderText(process())
}
shinyApp(ui, server)
Any help is appreciated!
Thanks #Shree for pointing out the solution. After reading the response from Joe Cheng. It seems like the key is to:
Hide the async operation from Shiny by not having the promise be the last expression.
The problem is resolved by creating a reactive value and assign the promise to it in observeEvent as the side effect.
server <- function(input, output, session) {
output$time <- renderText({
invalidateLater(1000)
as.character(Sys.time())
})
process <- reactiveVal()
observeEvent(input$button,{
output$isbusy <- renderText("busy") # a simple busy indicator
future({
Sys.sleep(5)
runif(1)
}) %...>%
process()
# Hide the async operation from Shiny by not having the promise be the last expression
NULL # important
})
output$result <- renderText({
output$isbusy <- renderText("") # a simple busy indicator
process()
})
}
Your problem is that Sys.sleep() suspends the execution of R expression. You can use things like the delay() function from shinyjs
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(), #You have to add this.
actionButton("button","Expensive calcualtion(takes 5 seconds)"),
tags$p("Current Time:"),
textOutput("time"),
tags$p("Result from clicking button:"),
textOutput("result")
)
server <- function(input, output, session) {
timer <- reactiveTimer(500)
current_time <- reactive({
timer()
as.character(Sys.time())
})
output$time <- renderText(current_time())
observeEvent(input$button,{
delay(5000, output$result <- renderText("result"))
})
}
shinyApp(ui, server)