闪亮的应用程序中缺少反应依赖性,阻止数据随输入更新

Missing reactive dependency in shiny app stopping data from updating with input

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

  1. 加载一些数据,
  2. Select 基于 ID 的特定行,
  3. 编辑数据table中的数据,并且
  4. 导出编辑后的数据

实际上,该应用会执行所有这些操作,但不允许用户在不重新启动应用的情况下更改 ID 和 select 新行。 table 中的数据保持不变,不会更新 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)

我认为问题出在您将 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 只是一个静态数据框。在您的模块中的任何内容与应用程序其余部分的输入之间没有建立反应依赖性,因此 table 没有更新。通常(也许不总是,但大多数时候),你应该将反应式传递给模块,就像它们没有括号一样,并用括号调用它们以在模块代码中的相关反应式上下文中获取它们的值。

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

我不完全清楚你的意图是什么,但如果你只是想让模块 return 编辑的数据,那么这样的东西可能比现有的 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)离开你的模块。

希望对您有所帮助。