R Shiny export buttons that export from another column

47 views Asked by At

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

There are 1 answers

3
Stéphane Laurent On BEST ANSWER

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)