Блог

Я пытаюсь написать блестящее приложение, которое позволит пользователю;

1. Загрузите некоторые данные в,
2. Выберите конкретную строку на основе идентификатора,
3. Отредактируйте данные в таблице данных и
4. Экспортируйте отредактированные данные

Как бы то ни было, приложение выполняет все эти действия, но не позволяет пользователю изменять идентификатор и выбирать новую строку без перезапуска приложения. Данные в таблице остаются неизменными и не обновляются при изменении ввода идентификатора или при нажатии кнопки действия.

Я думаю, проблема в том, что мне где-то не хватает реактивной зависимости, но я не уверен, где она находится.

 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)
  

Я думаю, что проблема возникает там, где вы передаете a 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 качестве super assigns ( <<- ) в приложениях 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) из своего модуля.

Надеюсь, это было полезно.