In the following Shiny app, a long calculation is performed when an action button (run) is pressed.The output is shown at the end of the calculation.
A clock is shown in the app. While the long calculation is ongoing, the clock does not update.
Is it possible to have the clock updating while the calculation is ongoing?
Code:
library(shiny)
n <- c(1:42E7)
ui <- fluidPage(
actionButton(inputId = "run", label = "Run a long calculation"),
verbatimTextOutput("calc"),
verbatimTextOutput("time")
)
server <- function(input, output) {
x <- observeEvent(input$run,{
output$calc <- renderText({
head(sqrt(n))
})
})
output$time <- renderText({
invalidateLater(1000)
print(as.character(Sys.time()))
})
}
shinyApp(ui = ui, server = server)
Thanks in anticipation,
Chris
This answer doesn't work yet, I put it here just so you can pick up after me.
You need to update to the dev version of Shiny (remotes::install_github("rstudio/shiny")).
I replaced your toy example with a Sys.sleep() because transfering the big vector required to raise option future.globals.maxSize and was still causing my machine to crash anyway.
library(shiny)
library(promises)
library(future)
plan(multiprocess)
ui <- fluidPage(
actionButton(inputId = "run",
label = "Run a long calculation"),
verbatimTextOutput("calc"),
verbatimTextOutput("time")
)
server <- function(input, output, session) {
observeEvent(input$run,{
output$calc <- renderText({
future({
Sys.sleep(5)
42
}) %...>%
head() %...>%
print()
})
})
output$time <- renderPrint({
invalidateLater(1000)
as.character(Sys.time())
})
}
shinyApp(ui = ui, server = server)
I expected it to work, but the "expensive operation" is still blocking, I haven't figured out why yet. Hopefully it'll still be useful.
ref: https://rstudio.github.io/promises
Related
I'm new to Shiny and have hit a problem I can't find an answer for. Basically, I have a Shiny app that does some long calculations in a loop and I want it to output a "progress report" every few iterations. However, even though I reassign my reactive variable within the loop, the output doesn't update until the loop (or entire function?) has finished.
Here is a simplified test case of what I mean:
library(shiny)
# Basic interface
ui <- fluidPage(
actionButton("run", "Run"),
textOutput("textbox")
)
# Basic server with loop
server <- function(input, output) {
textvals=reactiveValues(a=0)
observeEvent(input$run, {
for(i in 1:10){
textvals$a=i # Expect output to update here, but doesn't
Sys.sleep(0.1) # Slight pause so isn't instantaneous
}
})
output$textbox <- renderText({
textvals$a
})
}
# Run the application
shinyApp(ui = ui, server = server)
What I would expect is that the display would update 1, 2, 3, ... 10 as the loop executes. Instead, it just jumps straight from 0 to 10. How can I force an update partway through the loop?
Thank you.
With using invalidateLater you can get something closed to what you want. Not the shortest way to do it I think, but it may help you to find a better solution.
library(shiny)
# Basic interface
ui <- fluidPage(
actionButton("run", "Run"),
textOutput("textbox")
)
# Basic server with loop
server <- function(input, output, session) {
textvals <- reactiveVal(0)
active <- reactiveVal(FALSE)
output$textbox <- renderText({
textvals()
})
observe({
invalidateLater(1000, session)
isolate({
if (active()) {
textvals(textvals() + 1)
if (textvals() > 9) {
active(FALSE)
}
}
})
})
observeEvent(input$run, {
active(TRUE)
})
}
# Run the application
shinyApp(ui = ui, server = server)
By the way, reactive and for loops don't really get on well. This may help : https://gist.github.com/bborgesr/e1ce7305f914f9ca762c69509dda632e
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)
I have a simple shiny module where I want to get the sum from two slider inputs:
The module codes are:
Module
custSliderGroupInput <- function(id,slider1Name,slider2Name){
ns <- NS(id)
tagList(sliderInput(ns("slider1"),slider1Name,1,100,50),
sliderInput(ns("slider2"),slider2Name,1,20,10))
}
custSliderGroup <- function(input,output,session){
rv <- reactiveVal()
observeEvent(c(input$slider1,input$slider2),{
rv <- reactive({input$slider1 + input$slider2})
print(rv())
return(list(result = rv()))
})
}
In my app.R, I want to display the result on using textOutput, but it doesn't work and no error is displayed. (the value does get printed in the console though.)
App
library(shiny)
ui <- fluidPage(
custSliderGroupInput("myslider","A","B"),
textOutput("text")
)
server <- function(input, output,session){
output$text <- renderText({
callModule(custSliderGroup,"myslider")$result
})
}
shinyApp(ui = ui, server = server)
I searched on Google and StackOverflow, but all solutions just don't work.
The message does get printed in the console:
But nothing displayed on UI:
I somehow solved it by doing this:
Module:
custSliderGroupInput <- function(id,slider1Name,slider2Name){
ns <- NS(id)
tagList(sliderInput(ns("slider1"),slider1Name,1,100,50),
sliderInput(ns("slider2"),slider2Name,1,20,10))
}
custSliderGroup <- function(input,output,session){
rv <- input$slider1 + input$slider2
return(rv)
}
App
ui <- fluidPage(
custSliderGroupInput("myslider","A","B"),
textOutput("text")
)
server <- function(input, output,session){
output$text <- renderText({
callModule(custSliderGroup,"myslider")
})
}
shinyApp(ui = ui, server = server)
I don't know why, but it seems like using functionalities such as reactive() or observeEvent() makes the module environment too complicated and does more harm than good. It just works by simplifying the codes. If anyone knows how this theoretically works or doesn't work please post your answer!
Thanks a lot!
I want to render a text to notify the user that a task is going to run, but it seems that shiny executes all code in server first then it moves to UI.
Here is an example:
library(shiny)
ui <- fluidPage(
mainPanel(
textOutput("ptext")
))
server <- function(input, output) {
output$ptext <- renderText("creating a dataframe")
df <- matrix(rnorm(10000),nrow = 10) # a large dataset
output$ptext <- renderText("dataframe created !!")
}
shinyApp(ui = ui, server = server)
In the above example, I never see "creating a dataframe", How to render that text first before executing the rest of the code.
It's not the most beautiful, but if you can use an input for status messages like this, you can relay what's going on ...
library(shiny)
ui <- fluidPage(
mainPanel(
textInput("notice", "Status", "creating a dataframe"),
textOutput("ptext")
)
)
server <- function(input, output, session) {
dat <- reactive({
Sys.sleep(3)
matrix(rnorm(10000), nrow = 10)
})
output$ptext <- renderText({
req(dat())
updateTextInput(session, "notice", value = "dataframe created !!")
return("hello world")
})
}
shinyApp(ui = ui, server = server)
(Note the addition of session to the arguments to server, necessary to use updateTextInput(session, ...).)
You could get more complex by using dynamic UI creation and deletion, or object hiding (perhaps using shinyjs), but that is getting a bit more complex than I think you may want.