R 从另一列导出的闪亮导出按钮

Question

我有一个表，某些列中有 NA 值。在闪亮的应用程序中，我希望每列下方的导出按钮报告与所选列中的 NA 相对应的另一列的值。

简单数据框代码：

data <- data.frame(
  ID = c(1, 2, 3, 4, 5),
  Name = c("John", "Jane", "Alice", NA, "Bob"), 
  Age = c(25, NA, 30, 35, NA), 
  Score = c(80, 90, NA, 75, 85))

我想显示此表，并在每列（ID 除外）下方，我想要一个按钮来导出 CSV，其中包含与所选列中的 NA 相对应的所有 ID。

我尝试了多次JS代码和一些DT代码的迭代，但都无济于事。我无法使用按钮转到底部或仅导出与 NA 对应的 ID

observe({ 
     buttons <- lapply(names(data), 
          function(col_name) { 
               if (col_name %in% c("Name", "Age")) { 
                    actionButton( 
                         inputId = paste0("export_", col_name), 
                                   label = paste("Export IDs where NA in", col_name) 
                 ) 
              } else { 
                  actionButton( 
                         inputId = paste0("export_", col_name), 
                                   label = paste("Export", col_name) 
                         ) 
                   } 
              }) 
     insertUI( 
        selector = "#table_wrapper .dataTables_wrapper .dataTables_scrollFoot .dataTables_scrollFootInner table tfoot", 
        where = "afterEnd", 
        ui = tags$tr( 
            lapply(buttons, function(btn) tags$td(btn)) 
        ) 
     ) 
}) 
observeEvent(input$table_cell_clicked, { 
     info <- input$table_cell_clicked 
     if (info$value == "Export") { 
           col_name <- gsub("export_", "", info$target) 
           selected_data <- data[[col_name]] filename <- paste("export_", col_name, ".txt", sep="")          
           write.table(selected_data, file = filename, row.names = FALSE, na = "") 
} 

Answer 1

试试这个应用程序。当您单击表页脚中的按钮时，会在 R 控制台中打印 ID。如果您想将它们保存到文件中，您只需调整此应用程序即可。

library(shiny)
library(DT)

dat <- data.frame(
  ID = c(1, 2, 3, 4, 5),
  Name = c("John", "Jane", "Alice", NA, "Bob"), 
  Age = c(25, NA, 30, 35, NA), 
  Score = c(80, 90, NA, 75, 85)
)

ui <- fluidPage(
  br(),
  DTOutput("table")
)

server <- function(input, output, session){
  
  buttons <- lapply(2:ncol(dat), function(i){
    actionButton(
      paste0("this_id_is_not_used_", i),
      "export",
      class = "btn-primary btn-sm",
      style = "border-radius: 50%;", 
      onclick = sprintf(
        "Shiny.setInputValue('button', '%s', {priority:'event'});", 
        names(dat)[i]
      )
    )
  })
  
  output[["table"]] <- renderDT({
    sketch <- tags$table(
      class = "row-border stripe hover compact",
      tableHeader(names(dat)),
      tableFooter(c("", buttons))
    )
    datatable(
      dat, rownames = FALSE, container = sketch, 
      options = 
        list(
          columnDefs = list(
            list(
              className = "dt-center",
              targets = "_all"
            )
          )
        )
    )
  })
  
  observeEvent(input[["button"]], {
    ids <- dat$ID[is.na(dat[[input$button]])]
    print(ids)
  })
  
}

shinyApp(ui, server)