闪亮的应用程序缺少反应性相关性,导致无法通过输入更新数据

时间:2020-10-05 15:44:54

标签: r shiny shiny-reactivity

我正在尝试编写一个让人眼前一亮的应用程序;

  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)

1 个答案:

答案 0 :(得分: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中数据更新的实现,因为“闪亮”应用中的超级分配(<<-)通常不是一个好主意,无论如何这都会中断因为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)从模块中退出。

希望是有帮助的。