javascriptrshinydtshinyapps

R Shiny export buttons that export from another column


I have a table that has NA values in certain columns. In a Shiny app, I would like export buttons below each column that report values from another column that correspond to NA in the selected column.

Code for simple data frame:

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))

I would like to show this table, and below each column (except ID), I would like a button to export a CSV that contains all ID that correspond to NA in the selected column.

I have tried multiple iterations of JS code to no avail as well as some DT code. I can't the buttons to go to the bottom or to export ONLY the IDs corresponding to NA

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 = "") 
} 

Solution

  • Try this app. When you click a button in the table footer, this prints the IDs in the R console. You'll just have to adapt this app if you want to save them to a file.

    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)