Блог

Я пытаюсь создать файл, доступный для 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 принудительно вернуться к исходным значениям (the if ). Кроме того, когда пользователь изменил значения в правильном столбце и что-то меняет в неправильном столбце, он не сбрасывает исходное значение (неправильный столбец), сохраняя измененные значения (исправленный столбец) (the 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])
  } 
 

Я добавил эту функцию в версию DT для разработки.

 remotes::install_github('rstudio/DT')
 

Пример можно найти в таблице 10 приложения Shiny по адресу https://yihui .shinyapps.io/DT-edit /.

Вы можете использовать пакет DT напрямую, чтобы отключить определенные столбцы или строки по мере необходимости:

Пример:

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