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