How to have html select input widget in DT datatable rows? R

Question

I have the following shiny app.

# GLOBAL ----
library(shiny)
library(DT)
library(readr)
library(dplyr)

SELECT = '<select year="" id="year-select">
    <option value="">--Please choose an option--</option>
    <option value="2014">2014</option>
    <option value="2015">2015</option>
    <option value="2016">2016</option>
</select>'



test_cars <- data.frame("Num" = c(1:5),
                        "Make" = c("Toyota","","","",""),
                        "Model" = c("Camry","","","",""))

test_cars$Year <- SELECT

# UI ----
ui <- navbarPage(
  title = 'Cars Editor',
  tabPanel("Cars Entry",DTOutput("table1")),
  tabPanel("About")
)

# SERVER ----
server <- function(input, output) {
  output$table1 <- renderDT({
    datatable(test_cars %>% select(!Num), editable = "all", escape = FALSE, extensions = 'Buttons',
              options = list(
                dom = 'Bfrtip',
                buttons =
                  list('copy', 'print', list(
                    extend = 'collection',
                    buttons = c('csv', 'excel', 'pdf'),
                    text = 'Download'
                  ))

              )
    )
  })

}
# Run app ----
shinyApp(ui = ui, server = server)

And this gives me the following: My goal is for the users to select an input from the "Year" column and have it be saved to the data.

But when I click download, I get all the options that were in the html select input and not the user's selection. Any thoughts on how I should approach this?

Answer 1

This can be done with some custom exporting options.

library(shiny)
library(DT)
library(readr)
library(dplyr)

SELECT = '<select year="" id="year-select">
    <option value="">--Please choose an option--</option>
    <option value="2014">2014</option>
    <option value="2015">2015</option>
    <option value="2016">2016</option>
</select>'



test_cars <- data.frame("Num" = c(1:5),
                        "Make" = c("Toyota","","","",""),
                        "Model" = c("Camry","","","",""))

test_cars$Year <- SELECT

# UI ----
ui <- navbarPage(
    title = 'Cars Editor',
    tabPanel("Cars Entry",DTOutput("table1")),
    tabPanel("About")
)

# SERVER ----
server <- function(input, output) {
    output$table1 <- renderDT({
        datatable(test_cars %>% select(!Num), editable = "all", escape = FALSE, extensions = 'Buttons',
                  options = list(
                      dom = 'Bfrtip',
                      buttons =
                          list('copy', 'print', list(
                              extend = 'collection',
                              text = 'Download',
                              buttons = list('csv', 'excel', list(
                                  extend = "pdf",
                                  exportOptions = list(
                                      format = list(
                                          body = JS(
                                            "
                                              function(data, row, col, node) {
                                                  return $(node).has('select').length ?
                                                    $(node).find(':selected').text(): data
                                              }
                                            "
                                          )
                                      )
                                  )
                              ))
                          ))
                      
                  )
        )
    })
    
}

# Run app ----
shinyApp(ui = ui, server = server)

1. This post uses the pdf exporting option as example, you can do the same for other exporting options.
2. When it comes to export the data, we add a custom JS function to tell datatable how to render the body.
3. It checks if the cell has select tag inside, if so, get the selected value from the dropdown, otherwise return raw value.

Read buttons.exportData for details.