R Shiny：编辑带有锁定列的DT

Question

我试图拥有一个DT可由用户编辑的列，但我只希望某些列可编辑。由于这还不是 中的功能DT，因此我试图通过在编辑我想要“锁定”的列时将表刷新回原始值来将其组合在一起。

下面是我的代码：

library (shiny)
library (shinydashboard)
library (DT)
library (dplyr)
library (data.table)

rm(list=ls())

###########################/ui.R/##################################

#Header----
header <- dashboardHeaderPlus()

#Left Sidebar----
sidebar <- dashboardSidebar()

#Body----
body <- dashboardBody(
  useShinyjs(),

  box(
    title = "Editable Table",
    DT::dataTableOutput("TB")
  ),
  box(
    title = "Backend Table",
    DT::dataTableOutput("Test")
  ),
  box(
    title = "Choice Selection",
    DT::dataTableOutput("Test2")
  ),
  box(
    verbatimTextOutput("text1"),
    verbatimTextOutput("text2"),
    verbatimTextOutput("text3")
  )
)



#Builds Dashboard Page----
ui <- dashboardPage(header, sidebar, body)


###########################/server.R/###############################
server <- function(input, output, session) {


  Hierarchy <- data.frame(Lvl0 = c("US","US","US","US","US"), Lvl1 = c("West","West","East","South","North"), Lvl2 = c("San Fran","Phoenix","Charlotte","Houston","Chicago"), stringsAsFactors = FALSE)

  ###########

  rvs <- reactiveValues(
    data = NA, #dynamic data object
    dbdata = NA, #what's in database
    editedInfo = NA #edited cell information
  )

  observe({
    rvs$data <- Hierarchy
    rvs$dbdata <- Hierarchy
  })

  output$TB <- DT::renderDataTable({

    DT::datatable(
      rvs$data,
      rownames = FALSE,
      editable = TRUE,
      extensions = c('Buttons','Responsive'),
      options = list(
        dom = 't',
        buttons = list(list(
          extend = 'collection',
          buttons = list(list(extend='copy'),
                         list(extend='excel',
                              filename = "Site Specifics Export"),
                         list(extend='print')
          ),
          text = 'Download'
        ))
      )
    ) %>% # Style cells with max_val vector
      formatStyle(
        columns = c("Lvl0","Lvl1"),
        color = "#999999"
      )
  })

  observeEvent(input$TB_cell_edit, {
    info = input$TB_cell_edit

    i = info$row
    j = info$col + 1
    v = info$value

    #Editing only the columns picked
    if(j == 3){
      rvs$data[i, j] <<- DT::coerceValue(v, rvs$data[i, j]) #GOOD

      #Table to determine what has changed
      if (all(is.na(rvs$editedInfo))) { #GOOD
        rvs$editedInfo <- data.frame(row = i, col = j, value = v) #GOOD
      } else { #GOOD
        rvs$editedInfo <- dplyr::bind_rows(rvs$editedInfo, data.frame(row = i, col = j, value = v)) #GOOD
        rvs$editedInfo <- rvs$editedInfo[!(duplicated(rvs$editedInfo[c("row","col")], fromLast = TRUE)), ] #FOOD
      }
    } else {
      if (all(is.na(rvs$editedInfo))) {
        v <-  Hierarchy[i, j]
        rvs$data[i, j] <<- DT::coerceValue(v, rvs$data[i, j])
      } else {
        rvs$data[as.matrix(rvs$editedInfo[1:2])] <- rvs$editedInfo$value
      }
    }
  })

  output$Test <- DT::renderDataTable({
    rvs$data
  }, server = FALSE,
  rownames = FALSE,
  extensions = c('Buttons','Responsive'),
  options = list(
    dom = 't',
    buttons = list(list(
      extend = 'collection',
      buttons = list(list(extend='copy'),
                     list(extend='excel',
                          filename = "Site Specifics Export"),
                     list(extend='print')
      ),
      text = 'Download'
    ))
  )
  )

  output$Test2 <- DT::renderDataTable({
    rvs$editedInfo
  }, server = FALSE,
  rownames = FALSE,
  extensions = c('Buttons','Responsive'),
  options = list(
    dom = 't',
    buttons = list(list(
      extend = 'collection',
      buttons = list(list(extend='copy'),
                     list(extend='excel',
                          filename = "Site Specifics Export"),
                     list(extend='print')
      ),
      text = 'Download'
    ))
  )
  )

  output$text1 <- renderText({input$TB_cell_edit$row})
  output$text2 <- renderText({input$TB_cell_edit$col + 1})
  output$text3 <- renderText({input$TB_cell_edit$value})


}

#Combines Dasboard and Data together----
shinyApp(ui, server)

一切都按预期工作，除了在observeEvent我尝试刷新 DT 的地方（如果他们编辑了错误的列）：

      if (all(is.na(rvs$editedInfo))) {
        v <-  Hierarchy[i, j]
        rvs$data[i, j] <<- DT::coerceValue(v, rvs$data[i, j])
      } else {
        rvs$data[as.matrix(rvs$editedInfo[1:2])] <- rvs$editedInfo$value
      }

我似乎无法强制DT恢复到原始值（if）。此外，当用户更改了正确列中的值并更改了错误列中的某些内容时，它不会重置原始值（错误列），同时保持更改的值（更正列）（else）

编辑

我已经尝试了以下操作，它按预期强制执行"TEST"。我研究了两者的类别v = info$value，v <- Hierarchy[i,j]它们都很有特色，并且产生了我期望的价值。无法弄清楚为什么它不会强制执行v <- Hierarchy[i,j]。

  if (all(is.na(rvs$editedInfo))) {
    v <-  Hierarchy[i, j]
    v <- "TEST"
    rvs$data[i, j] <<- DT::coerceValue(v, rvs$data[i, j])
  } 

Answer 1

我已将这个功能添加到DT的开发版本中。

remotes::install_github('rstudio/DT')

您可以在https://yihui.shinyapps.io/DT-edit/的 Shiny 应用程序的表 10 中找到示例。