R Shinny-结合reactivePoll从DB获取最新数据,并在输入日期范围更改时强制触发

R Shinny-结合reactivePoll从DB获取最新数据,并在输入日期范围更改时强制触发,r,shiny,R,Shiny,注意:以下不是一个“可复制”的示例,因为它依赖于DB后端,但希望有足够的资源提供可行的解决方案想法 如果数据库表发生更改,我希望刷新数据。我很高兴地使用了一个反应性民意测验。但是,我希望在输入日期范围或任何输入更改时,reactivePoll强制启动,而不是等待轮询间隔过期。我怎么能两者兼得呢 以下是我的代码的总体思路,但需要改进以实现上述结果 getTableData <- function(session, startDate, endDate) { tableData <-

注意:以下不是一个“可复制”的示例,因为它依赖于DB后端,但希望有足够的资源提供可行的解决方案想法

如果数据库表发生更改,我希望刷新数据。我很高兴地使用了一个反应性民意测验。但是,我希望在输入日期范围或任何输入更改时,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)

根据我的评论,这里有一个可能的替代方案。请注意,无论何时更改滑块或触发invalidateLater,输出$test都会更新-

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)

我不知道是否有一种手动方式来启动反应性投票。这里有一个替代方案-您可以使用存储数据的reactiveValues设置一个反应变量,并在输出$mydata中使用该变量。现在设置此变量,以便可以通过观察输入$mydates的观察者以及您的reactivePoll对其进行更新。这样,每当轮询触发或日期更改时,都会更新被动变量。缺点是读取数据的代码会有一定程度的重复。创建读取数据的函数可能会缓解这种情况,但这应该是可行的。对于将来遇到这种情况的任何人:您可以通过创建到:memory:的连接并向其中写入示例数据来为reprex伪造DB后端。