R Shiny - объединить реактивныйPoll для получения последних данных из БД с принудительным триггером при изменении диапазона дат ввода

Question

Примечание. Следующий пример не является «воспроизводимым» примером, поскольку он опирается на серверную часть БД, но, надеюсь, его хватит для того, чтобы предоставить работоспособные решения.

Я хочу обновить свои данные, если таблица базы данных изменится,Я использую реактивныйPoll () для этого, к счастью.Тем не менее, я хочу, чтобы реактивныйPoll () принудительно включался при изменении входного диапазона дат (или любого другого входного значения) и не ждал истечения интервала опроса.Как я могу сделать и то и другое?

Вот общее представление о коде, который у меня есть, но его необходимо улучшить, чтобы достичь вышеуказанного результата.

getTableData <- function(session, startDate, endDate) {
  tableData <- reactivePoll(
    60000, session,
    checkFunc = function() {
      dbconn <- dbConnect(MySQL(), group = 'mysql')
      query <- dbSendQuery(
        dbconn,
        paste0('SELECT MAX(CREATED_AT) as lastCreated FROM MYDBTABLE;')
      )
      lastFeedback <- dbFetch(query, -1)
      dbClearResult(query)
      dbDisconnect(dbconn)

      lastFeedback$lastCreated
    },
    valueFunc = function() {
      query <- paste0(
        "SELECT * FROM MYDBTABLE ",
        "WHERE MY_DATE BETWEEN '",
        startDate, "' AND '", endDate, "';"
      )
      dbconn <- dbConnect(MySQL(), group = 'mysql')
      query <- dbSendQuery(dbconn, query)

      refreshedData <- dbFetch(query, -1)
      dbClearResult(query)
      dbDisconnect(dbconn)

      refreshedData
    }
  )

  return(tableData())
}

server <- function(session, input, output) {
  output$mydata <- renderDataTable({
    datatable(mydbdata(session, input$mydates[1], input$mydates[2]))
  })  
}

ui <- fluidPage(
  dateRangeInput(
    'mydates', 'Select Dates:', start = Sys.Date() - 90, end = Sys.Date()
    ),
  dataTableOutput('mydata')
)

shinyApp(ui = ui, server = server)

Answer 1

В продолжение моего комментария, вот возможная альтернатива. Обратите внимание, что output$test обновляется при каждом изменении ползунка или при срабатывании invalidateLater() -

library(shiny)

ui <- fluidPage(align = "center",
  sliderInput("s", "slider", 1, 10, 1, step = 1),
  verbatimTextOutput("test")
)

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

  x <- reactiveValues(x = NULL)

  observeEvent(input$s, {
    x$x <- "updated via slider" # simulates date changes
  })

  observe({
    invalidateLater(5000, session) # simulates reactivePoll
    x$x <- "updated via Poll"
  })

  output$test <- renderPrint({
    x$x
  })

})

shinyApp(ui, server)