R Shiny Value Function 未在 reactivePoll 中触发

Question

我正在使用 reactivePoll 来更新我闪亮的仪表板。我第一次运行该应用程序时，它运行良好。我给刷新数据的时间间隔是 1 分钟。第 1 分钟后，数据按预期刷新。从下一分钟开始，每1分钟触发一次检查功能，但没有触发价值功能，我没有得到最新的数据。

app.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"
...

但是，如果我使用上面的 Second Way（将 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)