Shiny: How to Stop Processing Invalidatelater() After Data Was Abtained or at the Given Time

Update shiny output from for loop inside observeEvent using reactiveValues

I rewrote your sever codes to make it working.

You cannot update UI in a loop as I already mentioned in the comment, it isn't how Shiny works. Use invalidateLater() to do something similar to a for loop.

And also, invalidateLater() doesn't work in observeEvent, so you need to write the loop logic in observe()

isolate() is used to prevent recursive triggering of the observer, so it only re-evaluate every 0.5 second based on invalidateLater(500)

server = function(input, output, session){
  vars = reactiveValues(cc="",ct=0)
  startSearch <- reactiveVal(FALSE)
  startSearch <- eventReactive(input$searchgt,{
    TRUE
  })

  observe({
    req(startSearch())
    if (isolate(vars$ct) < 10){
      invalidateLater(500)
      isolate({
        vars$ct=vars$ct+1
        vars$cc=paste('<b style="color:blue">',"Searching...",vars$ct,"</b>")
        vars$busca = try(print("Something"),silent = T)
      })
    } else {
      vars$cc=paste('<b style="color:red">',"Some warning.","</b>")
    }

  })

  output$warngt = renderUI({HTML(vars$cc)})
}

How to start and stop invalidateLater function

shinyApp(
  ui = fluidPage(
    useShinyjs(), 
    "Count:", textOutput("number", inline = TRUE), br(),
    actionButton("start", "Start"), br(),
    "The button will be pressed automatically every 3 seconds",br(),
    actionButton("stop", "Stop"), br(),
    "The counter will stop when the button is pressed"
  ),
  server = function(input, output) {
    observe(cat(str(reactiveValuesToList(input)), "\n"))
    output$number <- renderText({
      input$start
    })
    observe({
      if (!input$stop) {
        click("start")
        invalidateLater(3000)
      }
    })
  }
)

observe(cat(str(reactiveValuesToList(input)), "\n")) is a "shiny dev trick" of mine to help me see what's happening. input$stop is initially 0. The first time it's clicked, it's incremented to 1 and the condition becomes false.

See also this answer: https://stackoverflow.com/a/47486524/6197649

---

Edit per your comment:

server = function(input, output, session) {

    output$number <- renderText({
      input$start
    })

    stop_2 <- reactiveVal(FALSE)

    observeEvent(input$stop, stop_2(TRUE))

    observeEvent(input$start, if (stop_2()) stop_2(FALSE))

    observe({
      if (isolate(!stop_2() && input$start)) click("start") 
      invalidateLater(3000)
    })

  }

This is a workaround because of the impossibility to reset an actionButton.

Invalidate Later in Shiny

The issue is that when something is being updated, the default .css gives it a class of .recalculating and that is what makes it look gray. You can fix this by putting

tags$style(type="text/css",
  ".recalculating { opacity: 1.0; }"
)

in your ui.r or putting the equivalent in you .css ifyou are using one. Obviously, if you know CSS you can experiment with other ideas as well.

How do I make sure that a shiny reactive plot only changes once all other reactives finish changing?

Edit 2019-02-14

Since Shiny 1.0.0 (released after I originally wrote this answer), there is now a debounce function which adds functionality to help with this kind of task. For the most part, this avoids the need for the code I originally wrote, although under the hood it works in a similar manner. However, as far as I can tell, debounce doesn't offer any way of short-circuiting the delay with a redraw action button along the lines of what I'd done here. I've therefore created a modified version of debounce that offers this functionality:

library(shiny)
library(magrittr)

# Redefined in global namespace since it's not exported from shiny
`%OR%` <- shiny:::`%OR%`
debounce_sc <- function(r, millis, priority = 100, domain = getDefaultReactiveDomain(), short_circuit = NULL) 
{
  force(r)
  force(millis)
  if (!is.function(millis)) {
    origMillis <- millis
    millis <- function() origMillis
  }
  v <- reactiveValues(trigger = NULL, when = NULL)
  firstRun <- TRUE
  observe({
    r()
    if (firstRun) {
      firstRun <<- FALSE
      return()
    }
    v$when <- Sys.time() + millis()/1000
  }, label = "debounce tracker", domain = domain, priority = priority)
  # New code here to short circuit the timer when the short_circuit reactive
  # triggers
  if (inherits(short_circuit, "reactive")) {
    observe({
      short_circuit()
      v$when <- Sys.time()
    }, label = "debounce short circuit", domain = domain, priority = priority)
  }
  # New code ends
  observe({
    if (is.null(v$when)) 
      return()
    now <- Sys.time()
    if (now >= v$when) {
      v$trigger <- isolate(v$trigger %OR% 0) %% 999999999 + 
        1
      v$when <- NULL
    }
    else {
      invalidateLater((v$when - now) * 1000)
    }
  }, label = "debounce timer", domain = domain, priority = priority)
  er <- eventReactive(v$trigger, {
    r()
  }, label = "debounce result", ignoreNULL = FALSE, domain = domain)
  primer <- observe({
    primer$destroy()
    er()
  }, label = "debounce primer", domain = domain, priority = priority)
  er
}

This then permits a simplified shiny application. I've switched to the single file mode of working, but the UI remains the same as the original one.

ui <- fluidPage(
  titlePanel("Old Faithful Geyser Data"),
  sidebarLayout(
    sidebarPanel(
      sliderInput("bins",
                  "Number of bins:",
                  min = 1,
                  max = 50,
                  value = 30),
      selectInput("column", "Column", colnames(faithful), selected = "waiting"),
      actionButton("redraw", "Redraw")
    ),
    mainPanel(
      plotOutput("distPlot")
    )
  )
)
server <- function(input, output, session) {
  reac <- reactive(list(bins = input$bins, column  = input$column)) %>% 
    debounce_sc(5000, short_circuit = reactive(input$redraw))

  # Only triggered by the debounced reactive
  output$distPlot <- renderPlot({
    x    <- faithful[, reac()$column]
    bins <- seq(min(x), max(x), length.out = reac()$bins + 1)
    hist(x, breaks = bins, col = 'darkgray', border = 'white',
         main = sprintf("Histogram of %s", reac()$column))
  })
}
shinyApp(ui, server)

Original version (pre Shiny 1.0.0)

You haven't provided a reproducible example, so I've gone with something based on the Shiny faithful example that is the default in RStudio. The solution I've got will always have a (configurable) 5 second delay between an input changing and the graph being redrawn. Each change in input resets the timer. There's also a redraw button for the impatient which redraws the graph immediately. The values of the reactive value 'redraw' and the inputs are shown in the console every time an input changes or the timer ticks. This should be removed for production use. Hopefully this meets your needs!

library(shiny)
shinyUI(fluidPage(
  titlePanel("Old Faithful Geyser Data"),
  sidebarLayout(
    sidebarPanel(
      sliderInput("bins",
                  "Number of bins:",
                  min = 1,
                  max = 50,
                  value = 30),
      selectInput("column", "Column", colnames(faithful), selected = "waiting"),
      actionButton("redraw", "Redraw")
    ),
    mainPanel(
      plotOutput("distPlot")
    )
  )
))

server.R

library(shiny)
shinyServer(function(input, output, session) {
  reac <- reactiveValues(redraw = TRUE, bins = isolate(input$bins), column  = isolate(input$column))

  # If any inputs are changed, set the redraw parameter to FALSE
  observe({
    input$bins
    input$column
    reac$redraw <- FALSE
  })

  # This event will also fire for any inputs, but will also fire for
  # a timer and with the 'redraw now' button.
  # The net effect is that when an input is changed, a 5 second timer
  # is started. This will be reset any time that a further input is
  # changed. If it is allowed to lapse (or if the button is pressed)
  # then the inputs are copied into the reactiveValues which in turn
  # trigger the plot to be redrawn.
  observe({
    invalidateLater(5000, session)
    input$bins
    input$column
    input$redraw
    isolate(cat(reac$redraw, input$bins, input$column, "\n"))
    if (isolate(reac$redraw)) {
      reac$bins <- input$bins
      reac$column <- input$column
    } else {
      isolate(reac$redraw <- TRUE)
    }
  })

  # Only triggered when the copies of the inputs in reac are updated
  # by the code above
  output$distPlot <- renderPlot({
      x    <- faithful[, reac$column]
      bins <- seq(min(x), max(x), length.out = reac$bins + 1)
      hist(x, breaks = bins, col = 'darkgray', border = 'white',
           main = sprintf("Histogram of %s", reac$column))
  })
})

Calling a shiny JavaScript Callback from within a future

Here is a solution on how you could use the future package in a shiny app.
It is possible to have multiple sessions with no session blocking another session when running a computationally intensive task or waiting for a sql query to be finished. I suggest to open two sessions (just open http://127.0.0.1:14072/ in two tabs) and play with the buttons to test the functionality.

run_app.R:

library(shiny)
library(future)
library(shinyjs)

runApp(host = "127.0.0.1", port = 14072, launch.browser = TRUE)

ui.R:

ui <- fluidPage(
            useShinyjs(),
            textOutput("existsFutureData"),
            numericInput("duration", "Duration", value = 5, min = 0),
            actionButton("start_proc", h5("get data")),
            actionButton("start_proc_future", h5("get data using future")),
            checkboxInput("checkbox_syssleep", label = "Use Sys.sleep", value = FALSE),
            h5('Table data'),
            dataTableOutput('tableData'),
            h5('Table future data'),
            dataTableOutput('tableFutureData')
)

server.R:

plan(multiprocess) 

fakeDataProcessing <- function(duration, sys_sleep = FALSE) {
  if(sys_sleep) {
    Sys.sleep(duration)
    } else {
    current_time <- Sys.time()
    while (current_time + duration > Sys.time()) {  }
  }
  return(data.frame(test = Sys.time()))
}
#fakeDataProcessing(5)
############################ SERVER ############################ 
server <- function(input, output, session) { 
  values <- reactiveValues(runFutureData = FALSE, futureDataLoaded = 0L)
  future.env <- new.env()

  output$existsFutureData <- renderText({ paste0("exists(futureData): ", exists("futureData", envir = future.env)," | futureDataLoaded: ", values$futureDataLoaded) })

  get_data <- reactive({
  if (input$start_proc > 0) {
    shinyjs::disable("start_proc")
    isolate({ data <- fakeDataProcessing(input$duration) })
    shinyjs::enable("start_proc")
    data
  }
})

  observeEvent(input$start_proc_future, { 
      shinyjs::disable("start_proc_future")
      duration <- input$duration # This variable needs to be created for use in future object. When using fakeDataProcessing(input$duration) an error occurs: 'Warning: Error in : Operation not allowed without an active reactive context.'
      checkbox_syssleep <- input$checkbox_syssleep
      future.env$futureData %<-% fakeDataProcessing(duration, sys_sleep = checkbox_syssleep)
      future.env$futureDataObj <- futureOf(future.env$futureData)
      values$runFutureData <- TRUE
      check_if_future_data_is_loaded$resume()
      },
    ignoreNULL = TRUE, 
    ignoreInit = TRUE
  )

  check_if_future_data_is_loaded <- observe({
      invalidateLater(1000)
      if (resolved(future.env$futureDataObj)) {
          check_if_future_data_is_loaded$suspend()
          values$futureDataLoaded <- values$futureDataLoaded + 1L
          values$runFutureData <- FALSE
          shinyjs::enable("start_proc_future")
      }
  }, suspended = TRUE)

  get_futureData <- reactive({ if(values$futureDataLoaded > 0) future.env$futureData })

  output$tableData <- renderDataTable(get_data())

  output$tableFutureData <- renderDataTable(get_futureData())

  session$onSessionEnded(function() {
    check_if_future_data_is_loaded$suspend()
  })
}

Write table periodically at 20:00 each day

As an answer to your comment @Patrik, here is an example on how I generally deal with those things:

(Only providing the server side of the shiny application. UI needs no adjustments.)

server = function(input, output, session){

  YourData <- reactive({                   # Responds to changes. But in here, only the invalidation triggers change.
    invalidateLater(86400000, session)     # Invalidates YourData() after 86400000 millisecs = 24 hours.

    #-------- Some statements that gets Data from SQL Database, e.g. with library RODBC
    conn <- odbcDriverConnect("DNS=DB;UID=Usrname;PWD=12345")
    rawData <- sqlQuery(conn, "SELECT * FROM Table1")
    odbcClose(conn)

    #-------- Some statements that process your Data.
    rawData$value <- rawData$value * 2
    rawData$time <- strptime(rawData$time, format = "%Y-%m-%d %H:%M")

    #-------- Backup creation after data processing.
    write.csv2(rawData, paste0("filepath/Backup", sys.Date(), ".csv"))

    #-------- And finally call the Dataset you want to return to use in your Shiny-App
    rawData 
 })

  output$plot <- renderPlot({
    plot(YourData())
  })
}

With that, your Shiny App keeps on running, but fetches new Data and does all computations and backup creating once every 24 hours.

It might still be a bit abstract, but feel free to ask, if anything is unclear.

Reaction to Updated Question

Problem: MyData() is not just a chunk of code, but an Object with a normal R class, stored as a normal R variable. But in contrast to other variables, Shiny checks on its value permanently to detect changes and it tracks all dependencies to that variable.

Solution: My first approach would be to let the invalidation only affect your Query. And then this effects your other reactive environments in some sort of "cascade".

Here the Code:

server<-function(input,output, session){

  # First, return only your SQL results

  MyData <- reactive({   
    invalidateLater(86400000, session) 

    #connect to the Server 
    connection <- odbcConnect(dns, user, pass)
    SituationToday<-{cat("test");sqlQuery(connection, "SELECT ALL * FROM   Table;")}
    odbcClose(connection)

    SituationToday
  })

  # Second, manipulate you dataframes 1 and 2

  df1 <- reactive({
    SituationToday <- MyData()        # Reacts whenever MayData() changes

    #data manipulation of SituationToday dataset including cleaning, filtering, joins, re-coding, labelling
    # Resulting in your Set df1

    #backup
    write.csv2(df1, paste0("filepath/Backup1", sys.Date(), ".csv"))

    # Return the dataframe
    df1
  })

  # Same for df2

  df2 <- reactive({
    SituationToday <- MyData()        # Reacts whenever MayData() changes

    #data manipulation of SituationToday dataset including cleaning, filtering, joins, re-coding, labelling
    # Resulting in your Set df2

    #backup
    write.csv2(df2, paste0("filepath/Backup2", sys.Date(), ".csv"))

    # Return the dataframe
    df2
  })

  #reactive datasets that I need in order to visualise the data

  data.df <- reactive({
    VARIABLE<-input$variable              # Reacts to input
    df1()[df1()$variable %in% VARIABLE,]  # As well as change in df1()
  })

  data2.df<-reactive({
    VARIABLE2<-input$variable2              # Reacts to input
    df2()[df2()$variable2 %in% VARIABLE2,]  # As well as change in df2()
  })

  data3.df<-reactive({
    SELECT<-input$select
    GROUP<-input$group
    df1()[df1()$variable %in% SELECT & df1()$GROUP %in% GROUP,] # Again df1() dependant
  })

  #different outputs follow

  output$plot<-renderPlot({
    plot(data.df()) })
  output$plot<-renderPlot({
    plot(data.df2()) })
  output$plot<-renderPlot({
    plot(data.df3()) })
}

If you are really annoyed by having to split creating df1 and df2, you could also consider returning a list of your 2 data.frames.

R Shiny: Invalidate data periodically in reactive() yet not force DB call first time

One way to do it is to rely on a global variable. You can define a global variable outside the ui/server functions (for example, firstRun <- 1). Then in your reactive

mtcarsReactive <- reactive({
    invalidateLater(600)
    if (first == 1) {
        first <<- first + 1
        return(mtcars)
    } else {
        return(diamonds)
    }
})

Note the <<- assignment, which will assign the value to the global variable, instead of creating a new local variable (if you use normal <-).

I tested this under a newer version of Shiny than yours (because mine requires a session object in invalidateLater), but hopefully it works on your environment.

---

Related Topics