我试图让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])
}