我想让用户可以编辑
以下是我的代码：
除了在
我似乎无法让
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])
}