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 中找到示例。

Answer 2

您可以根據需要直接使用 DT 包禁用某些列或行：

例子：

editable = list(target = "cell", disable = list(columns =c(0:5)))