Question

注意：由于它依赖于数据库后端，因此以下示例不是“可重现”的示例，但希望有足够的能力提供可行的解决方案。

如果数据库表更改，我想刷新我的数据。我很高兴为此使用了reactPoll（）。但是，我希望当输入日期范围（或任何输入）更改时，reactivePoll（）强制启动，而不要等待轮询间隔到期。我该怎么办？

这是我拥有的代码的一般概念，但需要进行改进以实现上述结果。

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)

R Shiny-结合使用reactPoll从DB获取最新数据，并在输入日期范围更改时强制触发

1 个答案: