Implement real time and cancel button in Shiny app

Question

I have this app that have selectinput() with two options Manual and Tiempo Real.

Options Manual: when you choose Manual, you will choose Fecha Inicio and Fecha Fin and you could make two options: Lanzar Consulta or Cancelar Consulta. The first will build a dataframe with two column fecha and valor, the second button will be use when you want cancell the first button (for example, you have mistake with the dates).

Options Tiempo Real: when you choose it, you have a materialSwitch() that refresh the query each five seconds when you make click the first buton (Lanzar Consulta) while Cancelar Consulta button will be used to stop the real time and desactive the options refresh of materialSwithch().

And, I would like when change the options manual to tiempo real or vice versa, the result of tablaResult is clean.

So, I would like accomplish this conditions but the code of shiny app not get it. I have to problem to change the selections and implement the cancel button.

library(shiny)
library(shinyjs)
library(shinyWidgets)
library(lubridate)

ui <- fluidPage(
  
  useShinyjs(),
  sidebarPanel(
    selectInput("fecha", "Fecha", choices = c("Manual", "Tiempo Real")),
    
    conditionalPanel("input.fecha == 'Manual'",
                     airDatepickerInput("ini_manual", label = "Fecha Inicio", value = Sys.time() - 3 * (60 * 60), 
                                        addon = 'none',  timepicker = TRUE,  firstDay = 1,
                                        width = "200px", autoClose = TRUE,  timepickerOpts = timepickerOptions(timeFormat = "hh:ii")),
                     airDatepickerInput("fin_manual", label = "Fecha Fin", value = Sys.time(), 
                                        addon = 'none', timepicker = TRUE, firstDay = 1, 
                                        width = "200px", autoClose = TRUE, maxDate = NULL,  timepickerOpts = timepickerOptions(timeFormat = "hh:ii"))
    ),
    
    conditionalPanel("input.fecha == 'Tiempo Real'",
                     materialSwitch(inputId = "refresh", label = "Tiempo Real", value = TRUE, status = "success")
                     
    ),
    actionButton("btnConsulta", "Lanzar Consulta"),
    actionButton("btnCancelarConsulta", "Cancelar Consulta")
  ),
  
  mainPanel(
    tableOutput("tablaResultado")
    
  )
)


server <- function(input, output, session) {
  
  # Reactive variable to store the last update time in real time
  last_refresh_time <- reactiveVal(NULL)
  
  # Reactive event for query button and real time
  consulta_evento <- eventReactive(input$btnConsulta,
                                   {
                                     if (input$fecha == "Manual") {
                                       # Get fecha_ini and fecha_fin
                                       fecha_ini <- input$ini_manual
                                       fecha_fin <- input$fin_manual
                                       
                                       # Make data frame 
                                       resultado <- data.frame(
                                         fecha = as.character(seq.POSIXt(from = fecha_ini, to = fecha_fin, by = "hour")),
                                         Valor = rnorm(length(seq.POSIXt(from = fecha_ini, to = fecha_fin, by = "hour")))
                                       )
                                       
                                       resultado
                                       
                                     } else {
                                       
                                       last_refresh_time(Sys.time())
                                       # Realizar la lógica de la consulta para tiempo real aquí
                                       consulta_tiempo_real <- data.frame(
                                         fecha = as.character(seq.POSIXt(from = Sys.time(), by = "hour", length.out = 5)),
                                         Valor = rnorm(5)
                                       )
                                       
                                       consulta_tiempo_real
                                       
                                       
                                     }
                                   }
  )
  
  
  
  # Update real time with JS
  observe({
    if (input$fecha == "Tiempo Real" && input$refresh == TRUE) {
      shinyjs::runjs(
        'consultaInterval = setInterval(function() { Shiny.setInputValue("btnConsulta", Math.random(), {priority: "event"}); }, 5000);'
      )
    }
    
    else if (input$fecha == "Tiempo Real" && input$refresh == FALSE){
      shinyjs::runjs('clearInterval(consultaInterval);')
      output$tablaResultado <- renderTable({
        data.frame(NULL)
      })
    }
    else{
      consulta_evento()
    }
    
    
  })
  
  
  output$tablaResultado <- renderTable({
    req(input$btnConsulta)
    
    consulta_evento()
  })
  
  
  
}

shinyApp(ui, server) 

I would like to receive guidance on how to deal with this problem.

Answer 1

I don't fully understand your question and your app so it's quite possible that my answer is incomplete and/or not the one you expect. In this case, please leave a comment to tell me what I'm doing wrong and I'll update my answer.

First, a couple of remarks. This cannot work:

      shinyjs::runjs(
        'consultaInterval = setInterval(function() { Shiny.setInputValue("btnConsulta", Math.random(), {priority: "event"}); }, 5000);'
      )
    }
......
      shinyjs::runjs('clearInterval(consultaInterval);')

because the JavaScript commands in two different shinyjs::runjs do not communicate to each other.

In addition, btnConsulta is the id of a Shiny action button, whose value is incremented at each click, so I have no idea of the behavior of input$btnConsulta if you mix the action button value and Shiny.setInputValue("btnConsulta".

At the end of your observer, you have:

    else{
      consulta_evento()
    }

but consulta_evento() returns the value of consulta_evento so this code does nothing. My guess is that you wanted to do consulta_evento(data.frame(NULL)) instead.

Now, here is my solution. Save the JavaScript code below in the file refresh.js located in the www subfolder in the app:

$(document).ready(function() {
  let intervalId;
  let $switch = $("#refresh");
  let $select = $("#fecha");
  let $cancel = $("#btnCancelarConsulta");
  function refresh() {
    intervalId = setInterval(function() {
      Shiny.setInputValue("observe", true, {priority: "event"});
    }, 5000);
  }
  function stopRefresh() {
    if(intervalId) {
      clearInterval(intervalId);
      intervalId = null;
      Shiny.setInputValue("clear", true, {priority: "event"});
      $switch.prop("checked", false);
    }
  }
  if($select.val === "Tiempo Real") {
    if($switch.prop("checked")) {
      refresh();
    } else {
      stopRefresh();
    }
  } else {
    stopRefresh();
  }
  $cancel.on("click", function() {
    stopRefresh();
  });
  $switch.on("change", function() {
    if($select.val() === "Tiempo Real") {
      if($switch.prop("checked")) {
        refresh();
      } else {
        stopRefresh();
      }
    }
  });
  $select.on("change", function() {
    if($select.val() === "Manual") {
      stopRefresh();
    }
  });
});

And here is the Shiny app:

library(shiny)
library(shinyWidgets)
library(lubridate)

ui <- fluidPage(
  tags$head(tags$script(src = "refresh.js")),
  
  sidebarPanel(
    selectInput("fecha", "Fecha", choices = c("Manual", "Tiempo Real")),
    
    conditionalPanel(
      "input.fecha == 'Manual'",
      airDatepickerInput("ini_manual", label = "Fecha Inicio", value = Sys.time() - 3 * (60 * 60), 
                         addon = 'none',  timepicker = TRUE,  firstDay = 1,
                         width = "200px", autoClose = TRUE,  timepickerOpts = timepickerOptions(timeFormat = "hh:ii")),
      airDatepickerInput("fin_manual", label = "Fecha Fin", value = Sys.time(), 
                         addon = 'none', timepicker = TRUE, firstDay = 1, 
                         width = "200px", autoClose = TRUE, maxDate = NULL,  timepickerOpts = timepickerOptions(timeFormat = "hh:ii"))
    ),
    
    conditionalPanel(
      "input.fecha == 'Tiempo Real'",
      materialSwitch(
        inputId = "refresh", label = "Tiempo Real", value = TRUE, status = "success"
      )
    ),
    
    actionButton("btnConsulta", "Lanzar Consulta"),
    actionButton("btnCancelarConsulta", "Cancelar Consulta")
  ),
  
  mainPanel(
    tableOutput("tablaResultado")
  )
)


server <- function(input, output, session) {
  
  # Reactive variable to store the last update time in real time
  last_refresh_time <- reactiveVal(NULL)
  
  consulta_evento <- reactiveVal(data.frame(NULL))
  
  # Reactive event for query button and real time
  observeEvent(
    list(input$btnConsulta, input$observe),
    {
      if(input$fecha == "Manual") {
        # Get fecha_ini and fecha_fin
        fecha_ini <- input$ini_manual
        fecha_fin <- input$fin_manual
        # Make data frame 
        resultado <- data.frame(
          fecha = as.character(seq.POSIXt(from = fecha_ini, to = fecha_fin, by = "hour")),
          Valor = rnorm(length(seq.POSIXt(from = fecha_ini, to = fecha_fin, by = "hour")))
        )
        
        consulta_evento(resultado)
        
      } else {
        
        last_refresh_time(Sys.time())
        # Realizar la lógica de la consulta para tiempo real aquí
        consulta_tiempo_real <- data.frame(
          fecha = as.character(seq.POSIXt(from = Sys.time(), by = "hour", length.out = 5)),
          Valor = rnorm(5)
        )
        
        consulta_evento(consulta_tiempo_real)
        
      }
    }
  )
  
  observeEvent(input$clear, {
    consulta_evento(data.frame(NULL))
  })

  
  output$tablaResultado <- renderTable({
    consulta_evento()
  })
  
}

shinyApp(ui, server)