闪亮的应用程序中缺少反应性依赖项，阻止数据通过输入进行更新

Question

我正在尝试编写一个闪亮的应用程序，让用户；

1. 加载一些数据，
2. 根据 ID 选择特定行，
3. 编辑数据表中的数据，并
4. 导出编辑后的数据

实际上，应用程序会执行所有这些操作，但不允许用户在不重新启动应用程序的情况下更改 ID 并选择新行。表中的数据保持不变，不会更新 ID 输入更改或按下操作按钮时。

我认为问题在于我在某处缺少反应性依赖项，但我不确定它在哪里。

library(shiny)
library(DT)
library(dplyr)

editTableUI <- function(id, width = NULL) {
  ns <- NS(id)
  tagList(fluidRow(DT::dataTableOutput(ns('data_table'), width = width)))
}

editTableServer <-
  function(input, output, session, data) {
    
    output$data_table = DT::renderDataTable(
      data,
      selection = 'none',
      editable = TRUE,
      options = list(dom = 't',
                     pageLength = nrow(data)))
    
    proxy = DT::dataTableProxy('data_table')
    
    observeEvent(input$data_table_cell_edit, {
      info = input$data_table_cell_edit
      str(info)
      i = info$row
      j = info$col
      v = info$value
      
      data[i, j] <<- coerceValue(v, data[i, j])
      replaceData(proxy, data, resetPaging = FALSE)
      }
    )
    return({reactive(data)})
  }


#  ------------------------------------------------------------------------

ui <- fluidPage(
  uiOutput("id"),
  conditionalPanel(condition = "input.id",
                   actionButton(inputId = "go_id", label = "Load ID Data")),
  editTableUI("table"),
  downloadButton('download_CSV', 'Download CSV')
)


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

# Load data ---------------------------------------------------------------

  df <- reactive({iris %>% mutate(id = rownames(iris))})
  
  # create list of IDs
  output$id <- renderUI({
    id_list <- df() %>% pull(id)
    selectInput("id", "Select an ID", choices = id_list, multiple = F)})
  
  # filter total data to data for selected ID
  id_df <- eventReactive(input$go_id, {df() %>% filter(id == input$id)})
  
  # select variables and gather
  display_df <- eventReactive(input$go_id,{
    id_df() %>% 
      select(-Species) %>% 
      tidyr::gather(key = "Variable Label", value = "Original") %>%
      dplyr::mutate(Update = as.numeric(Original))})
  
  
  editdata <- callModule(editTableServer, "table", data = display_df())
  
  
  output$download_CSV <- downloadHandler(
    filename = function() {paste("dataset-", Sys.Date(), ".csv", sep = "")},
    content = function(file) {write.csv(editdata(), file, row.names = F)})
             
}

shinyApp(ui, server)

Answer 1

我认为问题在于您将reactive 传递给callModule。

如果您将服务器中的callModule 更改为：

editdata <- callModule(editTableServer, "table", data = display_df)

并将模块中的渲染器更改为：

output$data_table = DT::renderDataTable(
      data(),
      selection = 'none',
      editable = TRUE,
      options = list(dom = 't',
                     pageLength = nrow(data)))

（即在data 后面加上括号来执行反应）那么你应该得到你想要的行为。

在您的初始实现中发生的情况是您正在执行 callModule 中的反应式，因此 data 只是一个静态数据框。在您的模块中的任何内容与应用程序其余部分的输入之间没有建立反应性依赖关系，因此该表没有更新。通常（可能并非总是如此，但大多数时候），您应该将反应式传递给模块，就像它们不带括号一样，并用括号调用它们以在模块代码的相关反应式上下文中获取它们的值。

我建议您也检查一下您在 observeEvent 中的数据更新实现，因为 Shiny 应用程序中的超级分配 (<<-) 通常不是一个好主意，而且无论如何这都会因为 data 而中断现在已作为响应式传递给模块。

我并不完全清楚你的意图是什么，但如果你只是想让模块返回编辑后的数据，那么这样的东西可能比现有的observeEvent 更合适：

edit_data <- eventReactive(input$data_table_cell_edit, {
      info = input$data_table_cell_edit
      str(info)
      i = info$row
      j = info$col
      v = info$value
      data <- data()
      data[i, j] <- coerceValue(v, data[i, j])
      replaceData(proxy, data, resetPaging = FALSE)
      data
    })

然后你会return(edit_data)out of your module.

希望对您有所帮助。