Question

我有一个全局数据框（将在Global.R中定义），该数据框是通过查询postgre数据库构建的。该数据框架需要在多个会话之间共享。

现在，在每个会话的UI中，我需要显示一个包含该数据框内容的数据表。我还有一个radioButton对象，以便用户可以更改字段的值，在给定行的数据帧中将其命名为decision，并且希望显示数据表中的相应行或不是（即，如果仅decision == 0，则在数据表中将数据帧行显示为一行）

问题： 我希望根据用户为decision提供的值来隐藏/显示数据表中的行，并且希望在多个会话中发生 >

因此，如果有2个用户，并且user_1将行decision的{{1}}的值从0（显示）更改为1（隐藏），我希望该行被反应性地隐藏在数据表中的用户_1和用户_2，而无需刷新或按下actionButton。

解决这个问题的最佳方法是什么？

这是一个最小的可重现示例：

Answer 1

这是一个有效的示例：

library(shiny)
library(dplyr)
library(RSQLite)

# global data-frame
df <- data.frame(id = letters[1:10], decision = 0, another_col = LETTERS[1:10])
con <- dbConnect(RSQLite::SQLite(), "my.db", overwrite = FALSE)

if (!"df" %in% dbListTables(con)) {
  dbWriteTable(con, "df", df)
}

# drop global data-frame
rm("df")

update_decision_value <- function (id, dec) {
  dbExecute(con, sprintf("UPDATE df SET decision = '%s' WHERE id = '%s';", dec, id))
}

ui <- fluidPage(textOutput("shiny_session"),
                uiOutput('select_id'),
                uiOutput('decision_value'),
                dataTableOutput('my_table'))

server <- function(input, output, session) {

  output$shiny_session <- renderText(paste("Shiny session:", session$token))

  session$onSessionEnded(function() {
    if (!is.null(con)) {
      dbDisconnect(con)
      con <<- NULL # avoid warning; sqlite uses single connection for multiple shiny sessions
    }
  })

  df_ini <- dbGetQuery(con, "SELECT id, decision FROM df;")
  all_ids <- df_ini$id

  df <- reactivePoll(
    intervalMillis = 100,
    session,
    checkFunc = function() {
      req(con)
      df_current <- dbGetQuery(con, "SELECT id, decision FROM df;")
      if (all(df_current == df_ini)) {
        return(TRUE)
      }
      else{
        df_ini <<- df_current
        return(FALSE)
      }
    },
    valueFunc = function() {
      dbReadTable(con, "df")
    }
  )

  filter.data <- reactive({
    df() %>%
      filter(decision == 0)
  })

  output$select_id <- renderUI({
    selectInput('selected_id', "ID:", choices = all_ids)
  })

  output$decision_value <- renderUI({
    radioButtons(
      'decision_value',
      "Decision Value:",
      choices = c("Display" = 0, "Hide" = 1),
      selected = df()[df()$id == input$selected_id, "decision"]
    )
  })

  output$my_table <- renderDataTable({
    filter.data()
  })

  observeEvent(input$decision_value, {
    update_decision_value(input$selected_id, input$decision_value)
  })
}

shinyApp(ui, server)

编辑------------------------------------

通过避免比较整个表来减少数据库负载的更新版本，而仅搜索闪亮的会话式未知更改（考虑到ms-timestamp，每次决策更改都会对其进行更新）：

library(shiny)
library(dplyr)
library(RSQLite)

# global data-frame
df <- data.frame(id = letters[1:10], decision = 0, last_mod=as.numeric(Sys.time())*1000, another_col = LETTERS[1:10])
con <- dbConnect(RSQLite::SQLite(), "my.db", overwrite = FALSE)

if (!"df" %in% dbListTables(con)) {
  dbWriteTable(con, "df", df)
}

# drop global data-frame
rm("df")

update_decision_value <- function (id, dec) {
  dbExecute(con, sprintf("UPDATE df SET decision = '%s', last_mod = '%s' WHERE id = '%s';", dec, as.numeric(Sys.time())*1000, id))
}

ui <- fluidPage(textOutput("shiny_session"),
                uiOutput('select_id'),
                uiOutput('decision_value'),
                dataTableOutput('my_table'))

server <- function(input, output, session) {

  output$shiny_session <- renderText(paste("Shiny session:", session$token))

  session$onSessionEnded(function() {
    if (!is.null(con)) {
      dbDisconnect(con)
      con <<- NULL # avoid warning; sqlite uses single connection for multiple shiny sessions
    }
  })

  df_session <- dbReadTable(con, "df")
  all_ids <- df_session$id
  last_known_mod <- max(df_session$last_mod)

  df <- reactivePoll(
    intervalMillis = 100,
    session,
    checkFunc = function() {
      req(con)
      df_changed_rows <- dbGetQuery(con, sprintf("SELECT * FROM df WHERE last_mod > '%s';", last_known_mod))
      if(!nrow(df_changed_rows) > 0){
        return(TRUE)
      }
      else{
        changed_ind <- match(df_changed_rows$id, df_session$id)
        df_session[changed_ind, ] <<- df_changed_rows
        last_known_mod <<- max(df_session$last_mod)
        return(FALSE)
      }
    },
    valueFunc = function() {
      return(df_session)
    }
  )

  filter.data <- reactive({
    df() %>%
      filter(decision == 0)
  })

  output$select_id <- renderUI({
    selectInput('selected_id', "ID:", choices = all_ids)
  })

  output$decision_value <- renderUI({
    radioButtons(
      'decision_value',
      "Decision Value:",
      choices = c("Display" = 0, "Hide" = 1),
      selected = df()[df()$id == input$selected_id, "decision"]
    )
  })

  output$my_table <- renderDataTable({
    filter.data()
  })

  observeEvent(input$decision_value, {
    update_decision_value(input$selected_id, input$decision_value)
  })
}

shinyApp(ui, server)

闪亮：全局反应性数据集

1 个答案: