R Shiny Value Function 未在 reactivePoll 中觸發

Question

我正在使用 reactivePoll 來更新我閃亮的儀表板。 我第一次運行該應用程序時，它運行良好。 我給刷新數據的時間間隔是 1 分鍾。 1 分鍾后，數據按預期刷新。 從下一分鍾開始，每 1 分鍾觸發一次檢查功能，但未觸發價值功能，我沒有獲得最新數據。

應用程序R

 library(shiny)
 library(shinythemes)
 library(shinyWidgets)
 library(shinydashboard)
 library(shinycssloaders)
 library(RPostgreSQL)
 library(pool)
 library(config)
 library(plotly)
 library(data.table)

Sys.setenv(R_CONFIG_ACTIVE = "xyz")
config <- config::get()

pool <- dbPool(
drv = dbDriver("PostgreSQL"),
host = config$host,
dbname = config$dbname,
port = config$port,
user = config$user,
password = config$password
)

onStop(function() {
poolClose(pool)
})

get_data <- function(pool) {
abc <- dbGetQuery(pool,"SELECT * FROM tablename") #Query to pull data
return(abc)
}
abc <- get_data(pool = pool)

ui <- dashboardPage(
dashboardHeader(
title = 'Dashboard'
),
dashboardSidebar(
sidebarMenu(
  menuItem("pqr", tabName = "pqrs")
)
),
dashboardBody(
tabItems(
  tabItem(
    tabName = 'pqrs',
    hemaTab("pqr",abc = abc)
)
)
)
)

server <- function(input, output, session) {
pollData <- reactivePoll(60000, session,
                         checkFunc = function() {
                           print("Entered Check")
                           Sys.time()
                           print(Sys.time())
                         },
                         valueFunc = function() {
                           print("Entered value")
                           get_data(pool)
                         }
 )
 order(input, output, session, data = pollData())
 }

 shinyApp(ui = ui, server = server)

pqrs.R

pqrs <- function(id, label = "pqr",pqrs) {
ns <- NS(id)
tabPanel('pqr',
       tabsetPanel(
       tabPanel('Downloads',
                fluidPage(
                fluidRow(
                  column(12,
                         DT::dataTableOutput("table")
                  )
                )
                )
       )
       )
  )
  }

order <- function(input, output, session, data) {
downloaddata <- reactive({
setDT(data) 
})
output$table <- DT::renderDataTable( DT::datatable({
downloaddata()
})
)
}

I get the following result after running the app
"Entered Check"
[1] "2018-12-20 09:53:06 EST"
[1] "Entered Check"
[1] "2018-12-20 09:53:07 EST"
[1] "entered value"
After 1 minute the dashboard gets refreshed and I get the following 
result
[1] "Entered Check"
[1] "2018-12-20 09:54:07 EST"

從下一分鍾開始，儀表板不會刷新，但會觸發檢查功能並顯示時間。

Answer 1

tl;dr：嘗試將調用poolData()的order()函數放在observe()函數中

我認為問題是由於reactivePoll與它看起來的工作方式相反，需要在反應環境中實際調用才能正常運行。

當我運行下面的程序時，我遇到了和你一樣的問題：

library(shiny)
ui <- fluidPage(
    mainPanel(
        verbatimTextOutput('text')
    )
)

server <- function(input, output, session) {
    pollData <- reactivePoll(600,session,
                             checkFunc = function() {
                                 print("Entered Check")
                                 Sys.time()
                                 print(Sys.time())
                             },
                             valueFunc = function() {
                                 print("entered value")
                                 return('x')
                             }
    )
    ord <- function(data) {
        print(data)
    }

    ord(isolate(pollData()))    # 1: Only triggers once
    # observe(ord(pollData()))  # 2: Triggers every time
}
shinyApp(ui = ui, server = server)

[1] "Entered Check"
[1] "2018-12-20 09:39:35 PST"
[1] "entered value"
[1] "x"
[1] "Entered Check"
[1] "2018-12-20 09:39:35 PST"
[1] "Entered Check"
[1] "2018-12-20 09:39:36 PST"
...

但是如果我環繞使用上面的第二種方式（將ord調用包裝在一個observe函數中），那么它會按預期工作：

[1] "Entered Check"
[1] "2018-12-20 09:41:50 PST"
[1] "Entered Check"
[1] "2018-12-20 09:41:50 PST"
[1] "entered value"
[1] "x"
[1] "Entered Check"
[1] "2018-12-20 09:41:50 PST"
[1] "entered value"
[1] "x"

---

我的猜測是，正在發生的事情是reactivePoll像任何其他reactive*表達式一樣工作：當它被調用時，它會檢查它是否無效。 如果不是，則返回保存的值； 如果是，則它再次運行並返回更新后的值。

我認為正在發生的事情是，當checkFunc檢測到變化時，它不會告訴valueFunc直接運行，它只是使reactive*無效。 一旦它失效， valueFunc在它被調用時運行。 如果您從不調用它（因為您只對副作用感興趣），則valueFunc不會運行。

---

在你的情況下，我認為（無論出於何種原因）由shinydashboard創建的反應環境像第一個選項一樣起作用：它足夠像一個反應環境，它可以訪問reactivePoll函數的值，但它不會觸發valueFunc 。 通過將order函數包圍在observe*函數中，您將不斷檢查和調用該函數。

Answer 2

當 postgres 數據庫中的基礎數據發生變化時，這對我來說很有效：

library(shiny)

# Define UI for application that draws a histogram
ui <- fluidPage(

 # Application title
 titlePanel("Auto Update DB Table Viewer"),

 # Table Viewer
 DT::dataTableOutput("my_drugs_dt")
)

# Define server logic
server <- function(input, output) {
 library(magrittr)
 library(dplyr)

 # Get DB auth token
 rdshost <- "db.xxxxx.us-xxxx-x.rds.amazonaws.com"
 username <- "my_user_name"
 region <- "us-xxxx-x"
 token <- reactiveValues(rds_token = system(paste0("aws rds generate-db-auth-token --hostname ", rdshost, " --port 5432 --username ", username, " --region ", region), intern = TRUE))

 # Establish DB connection
 myPool <- pool::dbPool(drv = RPostgres::Postgres(),
                      dbname="sengine-data",
                      host=rdshost,
                      user= username,
                      password = isolate(token$rds_token),
                      bigint = "numeric")
onStop(function() { pool::poolClose(myPool) })

# Pull the data from DB
# Note: using the changelog timestamp from the database would be the best way to do checkFunc.  
#helpful: https://www.postgresql.org/docs/11/functions-info.html
#or this one: SELECT * FROM pg_last_committed_xact() https://www.tutorialdba.com/2017/11/postgresql-commit-timestamp-tracking.html
#This is how to modify the parameter in rds: https://aws.amazon.com/premiumsupport/knowledge-center/rds-postgresql-query-logging/
mysource_drugs <- reactivePoll(intervalMillis = 1000, 
                               session = NULL,
                               checkFunc = function(){
                                   conn <- pool::poolCheckout(myPool)
                                   mod_stamp <- RPostgres::dbGetQuery(conn, "SELECT timestamp FROM pg_last_committed_xact()")
                                   pool::poolReturn(conn)
                                   return(mod_stamp)
                               }, 
                               valueFunc = function(){
                                   myPool %>%
                                       dplyr::tbl("drugs") %>%
                                       dplyr::collect()
                               }
)
output$my_drugs_dt <- DT::renderDataTable({
    mysource_drugs()
})
}

# Run the application 
shinyApp(ui = ui, server = server)