ShinyApp实现数据库变更时自动更新图表（无需重渲染）

需求说明 #

我正在使用ShinyApp，希望实现当数据库发生变更时，图表能自动更新且无需重新渲染应用。已找到一段可实现表格自动更新的代码，但不知道如何适配该代码来绘制自动更新的图表，寻求可行的实现方案。

原表格自动更新代码 #

con <- dbConnect(RSQLite::SQLite(), "iris_db.sqlite")
row_count <- 0L
previous_row_count <- 0L
display_data <- reactiveVal(NULL)

ui <- fluidPage(DTOutput("my_db_data"))

db_data_chunk <- reactivePoll(
  intervalMillis = 1000L, # 每秒检查一次数据库更新
  session = NULL,
  checkFunc = function() {
    print(paste("Running checkFunc:", Sys.time()))
    if(DBI::dbIsValid(con) && dbExistsTable(con, "iris")){
      row_count <<- dbGetQuery(con, "select count(*) from iris")[[1]]
    } else {
      0L
    }
  },
  valueFunc = function() {
    if(DBI::dbIsValid(con) && dbExistsTable(con, "iris")){
      print(paste("Running valueFunc: Updating display_data | Current row count:", row_count))
      DT <- setDT(dbGetQuery(con, sprintf("select * from iris LIMIT %s OFFSET %s", row_count-previous_row_count, previous_row_count)))
      previous_row_count <<- row_count
      DT
    } else {
      NULL
    }
  }
)

server <- function(input, output, session) {
  observeEvent(db_data_chunk(), {
    if(is.null(display_data())){
      display_data(db_data_chunk())
    } else {
      display_data(rbindlist(list(display_data(), db_data_chunk())))
    }
  })
  # 参考 ?dataTableProxy() 和 ?replaceData() 避免重新渲染表格
  output$my_db_data <- renderDT({req(display_data())}, server = FALSE)
}

shinyApp(ui, server, onStart = function() {
  onStop(function() {
    dbDisconnect(con)
  })
})

适配图表自动更新的方案 #

方案1：基于ggplot的基础自动更新 #

保留原有的reactivePoll检测逻辑，将响应式数据display_data作为图表的数据源，Shiny会自动在数据更新时重绘图表（仅更新图表区域，不刷新整个应用）。

修改后的完整代码：

library(shiny)
library(DT)
library(data.table)
library(DBI)
library(RSQLite)
library(ggplot2)

con <- dbConnect(RSQLite::SQLite(), "iris_db.sqlite")
row_count <- 0L
previous_row_count <- 0L
display_data <- reactiveVal(NULL)

ui <- fluidPage(
  # 保留原表格（可选）
  DTOutput("my_db_data"),
  # 添加图表输出
  plotOutput("iris_plot")
)

db_data_chunk <- reactivePoll(
  intervalMillis = 1000L, # 每秒检查一次数据库更新
  session = NULL,
  checkFunc = function() {
    if(DBI::dbIsValid(con) && dbExistsTable(con, "iris")){
      row_count <<- dbGetQuery(con, "select count(*) from iris")[[1]]
    } else {
      0L
    }
  },
  valueFunc = function() {
    if(DBI::dbIsValid(con) && dbExistsTable(con, "iris")){
      DT <- setDT(dbGetQuery(con, sprintf("select * from iris LIMIT %s OFFSET %s", row_count-previous_row_count, previous_row_count)))
      previous_row_count <<- row_count
      DT
    } else {
      NULL
    }
  }
)

server <- function(input, output, session) {
  # 更新全局展示数据
  observeEvent(db_data_chunk(), {
    if(is.null(display_data())){
      display_data(db_data_chunk())
    } else {
      display_data(rbindlist(list(display_data(), db_data_chunk())))
    }
  })
  
  # 渲染表格（保留原功能）
  output$my_db_data <- renderDT({req(display_data())}, server = FALSE)
  
  # 渲染自动更新的图表
  output$iris_plot <- renderPlot({
    req(display_data())
    ggplot(display_data(), aes(x = Sepal.Length, y = Sepal.Width, color = Species)) +
      geom_point() +
      theme_minimal()
  })
}

shinyApp(ui, server, onStart = function() {
  onStop(function() {
    dbDisconnect(con)
  })
})

方案2：基于plotly的局部更新（更流畅） #

如果需要更流畅的交互体验，避免图表完全重绘，可以使用plotlyProxy实现局部数据更新，类似表格的dataTableProxy逻辑。

修改后的核心代码部分：

library(plotly)

ui <- fluidPage(
  DTOutput("my_db_data"),
  plotlyOutput("iris_plot")
)

server <- function(input, output, session) {
  # 数据更新逻辑同前
  observeEvent(db_data_chunk(), {
    if(is.null(display_data())){
      display_data(db_data_chunk())
    } else {
      display_data(rbindlist(list(display_data(), db_data_chunk())))
    }
  })
  
  output$my_db_data <- renderDT({req(display_data())}, server = FALSE)
  
  # 初始渲染图表
  output$iris_plot <- renderPlotly({
    req(display_data())
    plot_ly(display_data(), x = ~Sepal.Length, y = ~Sepal.Width, color = ~Species, type = "scatter", mode = "markers") %>%
      layout(theme = theme_minimal())
  })
  
  # 使用plotlyProxy更新数据，避免重绘整个图表
  observeEvent(display_data(), {
    plotlyProxy("iris_plot", session) %>%
      plotlyProxyInvoke("restyle", list(
        x = list(display_data()$Sepal.Length),
        y = list(display_data()$Sepal.Width),
        marker = list(color = ~Species)
      ))
  })
}

关键说明 #

• reactivePoll是核心：通过checkFunc每秒检测数据库行数变化，当行数改变时触发valueFunc获取新增数据，保证只在数据库变更时更新数据。
• 响应式数据驱动：图表渲染依赖display_data()这个响应式值，数据更新时Shiny会自动触发图表更新，无需手动刷新应用。
• 局部更新优化：对于plotly这类交互式图表，使用plotlyProxy可以只更新数据部分，不重新渲染整个图表容器，提升体验。

内容的提问来源于stack exchange，提问作者Noussaiba