r-在闪亮的服务器中从reactivePoll更新UI选项

Question

我搜索了一整天，似乎找不到这个。我将尽我所能创建一个与我正在使用的示例类似的示例，尽管这很有挑战性，因为它是在SQL数据库中进行的。

我有一个shiny应用程序，它正在从SQL数据库中读取数据，我在服务器内使用reactivePoll()每10分钟检查一次数据库中是否有任何新的销售数据。问题是reactivePoll()在server中，虽然我可以让它每10分钟更新一次(我可以看到它发生了(，它不会获得新的数据，因为UI不受服务器的影响，因为数据是从数据库中提取的。

这里有一个例子：

在PostgreSQL数据库中模拟数据

library(tidyverse)
library(shiny)
library(DT)
start <- as.POSIXct("2010-07-15")
interval <- 120
end <- start + as.difftime(3, units="days")
time_seq <- seq(from=start, to=end, by = 10000)
store <- rep(LETTERS[1:13], each = length(time_seq))
sales_date <- rep(time_seq, times = 13)
sales <- round(runif(n = length(store), min = 10000, max = 30000), 2)
df <- data.frame(store, sales_date, sales)
df %>% head()
store          sales_date    sales
1     A 2010-07-15 00:00:00 21026.10
2     A 2010-07-15 02:46:40 24478.58
3     A 2010-07-15 05:33:20 21636.65
4     A 2010-07-15 08:20:00 26098.41
5     A 2010-07-15 11:06:40 22325.20
6     A 2010-07-15 13:53:20 15024.09

查询数据库以获取闪亮应用程序的数据

drv <- dbDriver("PostgreSQL")
conn <- dbConnect(drv,  
host = "things",
port = 666,
user = "username",
password = "password",
dbname = "prod")
df <- dbGetQuery(conn,
"SELECT store
sales_date,
sales
FROM sql_df")

使用初始查询创建用户界面

ui <- fluidPage(

selectizeInput(inputId = "store",
label = "Choose Stores:",
choices = unique(df$store),
multiple = T),

sliderInput(inputId = "sales_date",
label = "Choose Date Range:",
min = min(df$sales_date),
max = max(df$sales_date),
value = c(min(df$sales_date), max(df$sales_date))),

DTOutput(outputId = "sales_tbl")
)

使用reactivePoll((创建服务器以检查新数据

server <- function(input, output, session){
## check server for new data every 10min
sqlData <- reactivePoll(intervalMillis = 600000,
session,

checkFunc = function(){
Sys.time()
},
## re-pull data every 10min
valueFunc = function(){
drv <- dbDriver("PostgreSQL")
conn <- dbConnect(drv,  
host = "things",
port = 666,
user = "username",
password = "password",
dbname = "prod")

sql_dat <- dbGetQuery(conn,
"SELECT store
sales_date,
sales
FROM sql_df")

dbDisconnect(conn)

sql_dat

}
)
## get required data from the UI
dat <- reactive({
d <- sqlData() %>%
filter(store %in% input$store,
sales_date %in% input$sales_date)

d
})
## write data table
output$sales_tbl <- renderDataTable({
dat() %>%
datatable()
})
}

shinyApp(ui, server)

我所问的可能吗？我能谈谈UI如何依赖于服务器中的反应数据吗？

Answer 1

当sqlData()发生变化时，可以将updateXX函数与observeEvent结合使用：

将其包含在您的server:中

observeEvent(sqlData(), {
updateSelectizeInput(session,
"store",
choices = unique(sqlData()$store))

updateSliderInput(session,
"sales_date",
min = min(sqlData()$sales_date),
max = max(sqlData()$sales_date),
value = c(min(sqlData()$sales_date), max(sqlData()$sales_date)))
})