I'm trying to display periodic updates on the UI for a real-time data feed that may last several hours. I found a nice example of doing type this reactivity with the Shiny observe function in the code below.
library(shiny)
ui <- pageWithSidebar(
# Application title
headerPanel("New Application"),
sidebarPanel(
"Progress: ",
textOutput("counter"),
hr(),
"Elapsed Time (seconds):",
textOutput("elapsed")
),
mainPanel(
textOutput("x")
)
)
server <- function(input, output, session) {
# The number of iterations to perform
maxIter <- 50
# Track the start and elapsed time
startTime <- Sys.time()
output$elapsed <- renderText({
vals$x
round(Sys.time() - startTime)
})
# Create a reactiveValues object where we can track some extra elements
# reactively.
vals <- reactiveValues(x = 0, counter = 0)
# Update the percentage complete
output$counter <- renderText({
paste0(round(vals$counter/maxIter * 100, 1), "%")
})
# Show the value of x
output$x <- renderText({
round(vals$x,2)
})
# Do the actual computation here.
observe({
isolate({
# This is where we do the expensive computing
sum <- 0
for (i in 1:100000){
sum <- sum + rnorm(1)
}
vals$x <- vals$x + sum
# Increment the counter
vals$counter <- vals$counter + 1
})
# If we're not done yet, then schedule this block to execute again ASAP.
# Note that we can be interrupted by other reactive updates to, for
# instance, update a text output.
if (isolate(vals$counter) < maxIter){
invalidateLater(0, session)
}
})
}
shinyApp(ui, server)
This code sample provides periodic UI updates, just like I want to see, except I'd like to select some parameters and click a button to start the real-time data feed. When I try to modify the code above by changing the observe function to the observeEvent function, I can't seem to get it to work and I don't know why. When I run my version (see code below), it does NOT provide periodic updates about its progress and waits until it's finished to update the UI. Here's my code:
library(shiny)
ui <- pageWithSidebar(
# Application title
headerPanel("New Application"),
sidebarPanel(
numericInput("startNumber","Start Number",value=0),
numericInput("iterations","Interations",value=5),
actionButton(inputId = "go",label="Go"),
br(),
"Progress: ",
textOutput("counter"),
hr(),
"Elapsed Time (seconds):",
textOutput("elapsed")
),
mainPanel(
textOutput("x")
)
)
server <- function(input, output, session) {
# Track the start and elapsed time
startTime <- Sys.time()
output$elapsed <- renderText({
vals$x
round(Sys.time() - startTime)
})
# Create a reactiveValues object where we can track some extra elements
# reactively.
vals <- reactiveValues(x = 0, counter = 0)
# Update the percentage complete
output$counter <- renderText({
paste0(round(vals$counter/input$iterations * 100, 1), "%")
})
# Show the value of x
output$x <- renderText({
round(vals$x,2)
})
# Do the actual computation here.
observeEvent (input$go,
{
# The number of iterations to perform
while (vals$counter < isolate(input$iterations)) {
#isolate({
# This is where we do the expensive computing
sum <- input$startNumber
for (i in 1:100000){
sum <- sum + rnorm(1)
}
vals$x <- vals$x + sum
# Increment the counter
vals$counter <- vals$counter + 1
#})
# If we're not done yet, then schedule this block to execute again ASAP.
# Note that we can be interrupted by other reactive updates to, for
# instance, update a text output.
if (vals$counter < isolate(input$iterations)){
invalidateLater(0, session)
}
}
})
}
shinyApp(ui, server)
I'm pretty sure I'm missing an important concept, but I'm baffled.
The issue is that invalidateLater
only works inside a reactive context. observeEvent
wraps all its innards in an implied isolate
rendering it non-reactive.
This observe should do it
observe({
req(input$go)
isolate({
# This is where we do the expensive computing
sum <- 0
for (i in 1:100000){
sum <- sum + rnorm(1)
}
vals$x <- vals$x + sum
# Increment the counter
vals$counter <- vals$counter + 1
})
# If we're not done yet, then schedule this block to execute again ASAP.
# Note that we can be interrupted by other reactive updates to, for
# instance, update a text output.
if (isolate(vals$counter < input$iterations)){
invalidateLater(0, session)
}
})
I think it is difficult to do it within an observeEvent
, so I sticked to the original approach using observe
and isolate
. After playing around with it I came up with the solution below, but I think it can be simplified. One advantage of this solution is, that after clicking the "go" button the first time, the next run is also triggered by clicking on "go" instead of running automatically when the inputs are updated. Further, the 100% label does not change, when input$iterations
is updated, but will only change after click go
. It is also possible to set the number of iterations in a second run to a lower value.
library(shiny)
ui <- pageWithSidebar(
# Application title
headerPanel("New Application"),
sidebarPanel(
numericInput("startNumber","Start Number",value=0),
numericInput("iterations","Interations",value=5),
actionButton(inputId = "go",label="Go"),
br(),
"Progress: ",
textOutput("counter"),
hr(),
"Elapsed Time (seconds):",
textOutput("elapsed")
),
mainPanel(
textOutput("x")
)
)
server <- function(input, output, session) {
# Create a reactiveValues object where we can track some extra elements
# reactively.
vals <- reactiveValues(x = 0,
counter = 0,
go_btn = NULL,
itr = NULL,
tstart = NULL)
# Track the start and elapsed time
output$elapsed <- renderText({
req(vals$tstart)
vals$x
round(Sys.time() - vals$tstart)
})
# Update the percentage complete
output$counter <- renderText({
req(vals$itr)
paste0(round(vals$counter/ vals$itr * 100, 1), "%")
})
# Show the value of x
output$x <- renderText({
round(vals$x,2)
})
observeEvent(input$go, {
if (is.null(vals$go_btn)) {
vals$counter <- 0
vals$go_btn <- 0
vals$itr <- input$iterations
vals$tstart <- Sys.time()
} else {
vals$go_btn <- vals$go_btn + 1
}
})
# Do the actual computation here.
observe({vals$go_btn
req(vals$go_btn)
isolate({
if (vals$counter < input$iterations){
sum <- input$startNumber
for (i in 1:100000){
sum <- sum + rnorm(1)
}
vals$x <- vals$x + sum
vals$counter <- vals$counter + 1
} # close if
}) # close isolate
if (isolate(vals$counter < input$iterations)){
invalidateLater(0, session)
} else {
isolate({
vals$go_btn <- NULL
})
}
}) # close observe
}
shinyApp(ui, server)
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.