连续删除 Shiny DT 表中的行

Question

我有一个闪亮的应用程序，用户可以在其中上传自己的数据。我的目标是显示一个带有 DT 的交互式表格，允许用户控制显示哪些列和哪些行。最终，用户应该能够下载他们上传的所有数据（在实际应用程序中完成了一些处理步骤）或仅下载他们在当前选择中看到的数据。因此，我需要复制上传的数据框，而不是就地编辑它。

我的问题是我可以使列可选，也可以删除选定的行，但我找不到在两者之间保存选定行的方法。例如：当用户首先选择第 1,2 和 3 行并点击“排除行”时，这些行会消失，但是当他们随后点击第 4 和 5 行并点击“排除行”时，第 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)