在 Shiny 中编辑数据：`Warning: E​​rror in [：不正确的维数`

Question

我的目标是构建一个闪亮的应用程序，我可以在其中上传两个数据框，该应用程序将：

• 自动突出显示两个数据框之间的差异
• 允许直接编辑数据框
• 请允许我下载新编辑的数据框

编辑 2022 年 6 月 1 日

我已经使用数据表创建了一个工作表示，它将突出显示datatable的单元格并且几乎允许编辑功能，但是一旦我进行任何编辑，下面的代码就会生成一条错误消息： Warning: Error in [: incorrect number of dimensions 。 感谢您提供有关解决此错误的任何建议。

我之前尝试过用gt解决这个问题，但我认为gt不适合编辑功能。 来自预编辑问题的文本。

代表

library(shiny)
library(shinythemes)
library(data.table)
library(DT)
library(tidyverse)

dat1 <- data.frame(
  emp_id = c(1:5),
  emp_name = c("Rick","Dan","Michelle","Ryan","Gary"),
  salary = c(623.3,515.2,611.0,735.0,844.25))

dat2 <- data.frame(
  emp_id = c(1:5),
  emp_name = c("Rick","Dan","Michelle","Ryan","Gary"),
  salary = c(623.3,515.2,611.0,729.0,843.25))

ui <- navbarPage("This is my Shiny app.", 
                  theme = shinytheme("flatly"), 
                  tabPanel("Upload", 
                           titlePanel("Upload your datafiles"),
                           sidebarLayout(
                             sidebarPanel(
                               
                               ## File 1
                               fileInput('file1', 'Data Entry #1',
                                         accept=c('text/csv', 
                                                  'text/comma-separated-values,text/plain', 
                                                  '.csv')),
                               tags$hr(),
                               
                               ## File 2
                               fileInput('file2', 'Data Entry #2',
                                         accept=c('text/csv', 
                                                  'text/comma-separated-values,text/plain', 
                                                  '.csv')),
                               tags$hr(),
                               downloadButton("download")
                               
                             ),
                             
                             mainPanel(
                               DT::dataTableOutput("contents"),
                               verbatimTextOutput("print"))
                           )
                  ),
)

server <- function(input, output, session) {
  
  df1 <- reactive({ dat1
  # inFile <- input$file1
  #  if (is.null(input$file1))
  #    return(NULL)
  #  read.csv(inFile$datapath)
  })
  
  df2 <- reactive({ dat2
  # inFile <- input$file2
  #  if (is.null(input$file2)) 
  #    return(NULL) 
  #  read.csv(inFile$datapath)
  })

  vals <- reactiveValues(x = NULL)
  
  observe({

    req(df1())
    req(df2())
    
    tbl_diffs <- which(df1() != df2(), arr.ind = TRUE)
    tbl_compare <- df2() %>% DT::datatable(selection = 'none', rownames = FALSE, edit = TRUE)
    for (i in seq_len(nrow(tbl_diffs))) {
      tbl_compare <- tbl_compare %>%
        formatStyle(
          columns = tbl_diffs[[i, "col"]], 
          backgroundColor = styleRow(tbl_diffs[[i, "row"]], c('yellow')))
    } 
    vals$x <- tbl_compare
  })
  
  output$print <- renderPrint({ vals$x })
  output$contents <- DT::renderDataTable(vals$x)

  proxy <- dataTableProxy("contents")
  
  observeEvent(input$contents_cell_edit, {
    info = input$contents_cell_edit
    str(info)
    i = info$row
    j = info$col + 1
    v = info$value
    vals$x[i, j] <<- DT:::coerceValue(v, vals$x[i, j])
    replaceData(proxy, vals$x, resetPaging = FALSE, rownames = FALSE)
  })
  
  output$download <- downloadHandler("example.csv", 
                                     content = function(file){
                                       write.csv(vals$x, file, row.names = F)
                                     },
                                     contentType = "text/csv")
  
}

shinyApp(ui = ui, server = server)

Answer 1

我解决了我的问题，并在下面有一个正常运行的表示，允许编辑、突出显示和下载。 我相信核心问题是确保突出显示的数据表对象正在显示，但数据表的数据框元素（ val$x$x$data ）是专门编辑和下载的（而不是整个数据表本身）。

library(shiny)
library(shinythemes)
library(data.table)
library(DT)
library(tidyverse)

dat1 <- data.frame(
  emp_id = c(1:5),
  emp_name = c("Rick","Dan","Michelle","Ryan","Gary"),
  salary = c(623.3,515.2,611.0,735.0,844.25))

dat2 <- data.frame(
  emp_id = c(1:5),
  emp_name = c("Rick","Dan","Michelle","Ryan","Gary"),
  salary = c(623.3,515.2,611.0,729.0,843.25))

ui <- navbarPage("This is my Shiny app.", 
                 theme = shinytheme("flatly"), 
                 tabPanel("Upload", 
                          titlePanel("Upload your datafiles"),
                          sidebarLayout(
                            sidebarPanel(
                              
                              ## File 1
                              fileInput('file1', 'Data Entry #1',
                                        accept=c('text/csv', 
                                                 'text/comma-separated-values,text/plain', 
                                                 '.csv')),
                              tags$hr(),
                              
                              ## File 2
                              fileInput('file2', 'Data Entry #2',
                                        accept=c('text/csv', 
                                                 'text/comma-separated-values,text/plain', 
                                                 '.csv')),
                              tags$hr(),
                              downloadButton("download")
                              
                            ),
                            
                            mainPanel(
                              DT::DTOutput("print"))
                          )
                 ),
)

server <- function(input, output, session) {
  
  df1 <- reactive({ dat1
   # inFile <- input$file1
  #  if (is.null(input$file1))
  #    return(NULL)
  #  readxl::read_excel(inFile$datapath)
  })
  
  df2 <- reactive({ dat2
   # inFile <- input$file2
   # if (is.null(input$file2)) 
  #    return(NULL) 
  #  readxl::read_excel(inFile$datapath)
  })
  
  vals <- reactiveValues(x = NULL)
  
  observe({
    
    req(df1())
    req(df2())
    
    tbl_diffs <- which(df1() != df2(), arr.ind = TRUE)
    tbl_compare <- df2() %>% DT::datatable(selection = 'none', rownames = FALSE, edit = TRUE)
    for (i in seq_len(nrow(tbl_diffs))) {
      tbl_compare <- tbl_compare %>%
        formatStyle(
          columns = tbl_diffs[[i, "col"]], 
          backgroundColor = styleRow(tbl_diffs[[i, "row"]], c('yellow')))
    } 
    vals$x <- tbl_compare
  })
  
  output$print <- DT::renderDT({ vals$x })
  output$contents <- DT::renderDataTable(vals$x)
  
  proxy <- dataTableProxy("contents")
  
  observeEvent(input$print_cell_edit, {
    info = input$print_cell_edit
    str(info)
    i = info$row
    j = info$col + 1
    v = info$value
    vals$x$x$data[i, j] <<- DT:::coerceValue(v, vals$x$x$data[i, j])
    replaceData(proxy, vals$x$x$data, resetPaging = FALSE, rownames = FALSE)
  })
  
  output$download <- downloadHandler("example.csv", 
                                     content = function(file){
                                       write.csv(vals$x$x$data, file, row.names = F)
                                     },
                                     contentType = "text/csv")
  
}

shinyApp(ui = ui, server = server)