我有DT,我添加了复选框作为第一列。他们的想法是为用户提供删除所选行并将其放在文件中的选项。按下冷键"删除"后,数据被发送到文件,但我不知道如何更新DT,以获取没有删除行的数据。 代码:
library(shiny)
library(DT)
library(dplyr)
shinyApp(
ui <- fluidPage(DT::dataTableOutput("ruless"),
fluidRow(column(4, offset = 1, actionButton("delete", "Delete", width = 200)))),
server <- function(input, output) {
values <- reactiveValues(data = NULL)
values$data <- as.data.frame(
cbind(c("a", "d", "b", "c", "e", "f"),
c(1463, 159, 54, 52, 52, 220),
c(0.7315, 0.0795, 0.027, 0.026, 0.026, 0.11)
)
)
shinyInput = function(FUN, len, id, ...) {
#validate(need(character(len)>0,message=paste("")))
inputs = character(len)
for (i in seq_len(len)) {
inputs[i] = as.character(FUN(paste0(id, i), label = NULL, ...))
}
inputs
}
output$ruless <- DT::renderDataTable({
datatable(
data.frame(delete=shinyInput(checkboxInput,nrow(values$data),"cbox_"), values$data),
selection="multiple",
escape = FALSE,
filter = list(position = 'top', clear = FALSE),
extensions = list("ColReorder" = NULL, "Buttons" = NULL),
options = list(
dom = 'BRrltpi',
autoWidth=TRUE,
lengthMenu = list(c(10, 50, -1), c('10', '50', 'All')),
ColReorder = TRUE,
preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } '),
buttons = list(
'copy',
'print',
list(
extend = 'collection',
buttons = c('csv', 'excel', 'pdf'),
text = 'Download',
selected = TRUE
)
)
)
)
})
shinyValue = function(id, len) {
unlist(lapply(seq_len(len), function(i) {
value = input[[paste0(id, i)]]
if (is.null(value)) NA else value
}))
}
observeEvent(input$delete, {
checkbox_rules <- data.frame(selected=shinyValue("cbox_",nrow(values$data)))
marked_rules <- as.data.frame(values$data[(which(checkbox_rules == TRUE)),])
if (file.exists("delete_file.csv")){
delete_file <- as.data.frame(read_csv2("delete_file.csv", col_names = TRUE))
delete_file <- as.data.frame(rbind(delete_file, marked_rules))
delete_file <- delete_file[!duplicated(delete_file), ]
write.csv2(delete_file, file = "delete_file.csv", sep=";", row.names = FALSE)
}
else{
write.csv2(marked_rules, file = "delete_file.csv", sep=";", row.names = FALSE)
}
})
}
)
我还想替换删除按钮并重命名DT上方的其余按钮。我在想这样的事情:
我有可能做到吗?预先感谢! 可能吗?
答案 0 :(得分:0)
您可以像这样更新观察者中的data.frame
values$data <- values$data[!checkbox_rules,]
最后看起来应该是这样的
observeEvent(input$delete, {
checkbox_rules <- data.frame(selected=shinyValue("cbox_",nrow(values$data)))
marked_rules <- as.data.frame(values$data[(which(checkbox_rules == TRUE)),])
values$data <- values$data[!checkbox_rules,]
if (file.exists("delete_file.csv")){
delete_file <- as.data.frame(read_csv2("delete_file.csv", col_names = TRUE))
delete_file <- as.data.frame(rbind(delete_file, marked_rules))
delete_file <- delete_file[!duplicated(delete_file), ]
write.csv2(delete_file, file = "delete_file.csv", sep=";", row.names = FALSE)
}
else{
write.csv2(marked_rules, file = "delete_file.csv", sep=";", row.names = FALSE)
}
})
希望这有帮助!