r-连续删除Shiny DT表中的行

Question

我有一个闪亮的应用程序，用户可以在其中上传自己的数据。我的目标是用DT显示一个交互式表，它允许用户控制显示哪些列和哪些行。最终，用户应该能够下载他们上传的所有数据(在实际应用程序中有一些处理步骤(，或者只下载他们在当前选择中看到的数据。因此，我需要制作上传数据帧的副本，而不是在适当的位置编辑它。

我的问题是，我可以选择列，也可以删除选定的行，但我找不到在两者之间保存选定行的方法。例如：当用户第一次选择行1、2和3并点击"；排除行"；，行消失，但当它们点击行4和5并点击"0"时；排除行"；，第4行和第5行消失，但第1行、第2行和第3行弹出。

以下是我迄今为止尝试的内容：

# Reproducible example
# Define UI
ui <- fluidPage(
navbarPage("Navbar",
tabPanel("Upload Data",
fileInput(inputId = "file", label = "Upload your .csv file",
accept = "text/csv"),
actionButton("submit","Use this dataset")
),
tabPanel("Check Table",
sidebarPanel("Settings",
checkboxGroupInput("show_vars", "Select Columns to display:",
choices = c("type",
"mpg",
"cyl",
"disp",
"hp",
"drat",
"wt",
"qsec",
"vs",
"am",
"gear",
"carb"
),
selected = c("type",
"mpg",
"cyl",
"disp",
"hp",
"drat",
"wt",
"qsec",
"vs",
"am",
"gear",
"carb"
)),
tags$br(),
tags$br(),
actionButton("excludeRows", "Exlcude selected Rows")),
mainPanel(DTOutput("frame"))),
tabPanel("Show Selection",
textOutput("selection"))
)
)
# Define server logic
server <- function(input, output, session) {
# Parsing the uploaded Dataframe according to the right input
data <- eventReactive(input$submit, {read.csv(input$file$datapath)})
# Render the whole dataframe when a new one is uploaded
observeEvent(input$submit, {output$frame <- renderDT(datatable(data()[,c(input$show_vars)]))})
# Making an internal copy for selection purposes
CopyFrame <- eventReactive(data(),{data()})
# excluding selected rows
observeEvent(input$excludeRows,{
if (exists("SelectFrame()")) {
# Updating SelectFrame from SelectFrame
SelectFrame <- eventReactive(input$excludeRows,{SelectFrame()[-c(input$frame_rows_selected),c(input$show_vars)]})
} else {
# creating SelectFrame for the first time from CopyFrame
SelectFrame <- eventReactive(input$excludeRows,{CopyFrame()[-c(input$frame_rows_selected),c(input$show_vars)]})
}
# updating plot
output$frame <- renderDT(datatable(SelectFrame()))
})
# show Selection
output$selection <- renderText(input$frame_rows_selected)
}
# Run the application
shinyApp(ui = ui, server = server)

你可以很容易地为这个可复制的例子创建一个示例文件：

names(mtcars)[1] <- "type"
write.csv(mtcars, file = "testfile.csv")

Answer 1

也许您可以使用reactiveValues来存储编辑后的数据帧。加载新的csv文件时，请存储在rv$data中。然后，当您排除行时，您可以每次修改数据帧，并用结果替换rv$data。您的output$frame只能显示此修改后的rv$data，并且只能显示通过input$show_vars选择的列。这对你有用吗？

server <- function(input, output, session) {

rv <- reactiveValues(data = NULL)

observeEvent(input$submit, {
rv$data <- read.csv(input$file$datapath)
})

observeEvent(input$excludeRows,{
rv$data <- rv$data[-c(input$frame_rows_selected),c(input$show_vars)]
})

output$frame <- renderDT({
datatable(rv$data[c(input$show_vars)])
})

}

Answer 2

这里有一个处理原始数据帧行号的解决方案：

library(shiny)
library(DT)
# Define UI
ui <- fluidPage(

navbarPage("Navbar",
tabPanel("Upload Data",
fileInput(inputId = "file", label = "Upload your .csv file",
accept = "text/csv"),
actionButton("submit","Use this dataset")
),

tabPanel("Check Table",

sidebarPanel("Settings",

checkboxGroupInput("show_vars", "Select Columns to display:",

choices = c("type",
"cyl",
"disp",
"hp",
"drat",
"wt",
"qsec",
"vs",
"am",
"gear",
"carb"
),

selected = c("type",
"cyl",
"disp",
"hp",
"drat",
"wt",
"qsec",
"vs",
"am",
"gear",
"carb"
)),

tags$br(),
tags$br(),

actionButton("excludeRows", "Exlcude selected Rows")),

mainPanel(DTOutput("frame"))),

tabPanel("Show Selection",
textOutput("selection"))

)

)
# Define server logic
server <- function(input, output, session) {

# initialise index which rows are shown
rows_shown <- reactiveVal()

# Parsing the uploaded Dataframe according to the right input
data <- eventReactive(input$submit, {
data <- read.csv(input$file$datapath)
data <- cbind(data, data.frame(row_number = seq_len(nrow(data))))
data
})

# Making an internal copy for selection purposes
CopyFrame <- eventReactive(input$submit, {data()})

observeEvent(input$submit, {
# set up row index
rows_shown(seq_len(nrow(data())))
})

# excluding selected rows
observeEvent(input$excludeRows,{
# use an extra column for the row numbers to refer to the row number of the
# original dataframe and not the subsetted one
actual_row_numbers <- CopyFrame()[rows_shown(), "row_number"][input$frame_rows_selected]
row_index <- !rows_shown() %in% actual_row_numbers
new_rows <- rows_shown()[row_index]
rows_shown(new_rows)
})

# show Selection
output$selection <- renderText(input$frame_rows_selected)

# show dataframe
output$frame <- renderDT({
datatable(CopyFrame()[rows_shown(), input$show_vars])
})

}
# Run the application
shinyApp(ui = ui, server = server)