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）< / p>

编辑

我尝试了以下操作，并且强制执行"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

I have added this feature到 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)))

R Shiny：使用锁定的列编辑DT

2 个答案: