Update shiny input based on datatable settings - r

Question

I have a leaflet map & datatable in a shiny app and have various input boxes to select what is being mapped.
Currently the data is processed on the server based on a set of shiny inputs, and that data is passed to both leaflet and datatable.
I'd also like to have a button on the datatable (or read double clicks on the datatable) and update a shiny input (i.e., call shiny::updateSelectizeInput) based on the users interaction with the datatable.
minimal code example:
if (interactive()) {
library(shiny)
library(DT)
shinyApp(
ui = fluidPage(
selectInput("species_selection", "Select species",
choices = c("all", as.character(iris$Species)))
, dataTableOutput("dt")
)
, server = function(input, output) {
output$dt <- renderDataTable({
if ( input$species_selection != "all" ) {
for_table <- iris %>%
filter(Species == input$species_selection)
} else {
for_table <- iris
}
for_table
# but also you can click a button or double-click a row on this datatable
# to update input$species_selection above
})
}
)
}
I'm aware there's no reason for this in this minimal example but I do want to do so for in the context of my larger app.
I've seen examples (for example, superzip) where buttons on the datatable are linked to html, and I know the datatable shiny tutorials tell you how to catch selected rows with an observer. Catching the selected rows is my backup plan but I would prefer a button on the row or a double-click.

Answer 1

Sure, but its a bit fiddly. I used mtcars as it has more variety:
library(shiny)
library(DT)
shinyApp(
#UI
ui <- fluidPage(
selectInput('carb_selection', 'Select carb', choices = c('all', as.character(mtcars$carb))),
DT::dataTableOutput('dt'),
),
#Server
server <- function(input, output, session) {
#Function to create buttons
shinyInput <- function(FUN, len, id, ...) {
inputs <- character(len)
for (i in seq_len(len)) {
inputs[i] <- as.character(FUN(paste0(id, i), ...))
}
inputs
}
#Add buttons to the mtcars dataframe
mtcars_btn <- reactiveValues(
data = data.frame(
mtcars,
carb_selector = shinyInput(actionButton, nrow(mtcars), 'button_', label = "Select", onclick = 'Shiny.onInputChange(\"select_button\", this.id)'),
stringsAsFactors = FALSE
)
)
#Output datatable
output$dt <- DT::renderDataTable(
if (input$carb_selection == 'all'){
DT::datatable(mtcars_btn$data, escape = FALSE, selection = 'none', options = list(searching = FALSE, ordering = FALSE))
} else {
DT::datatable(mtcars_btn$data[mtcars_btn$data$carb == input$carb_selection, ], escape = FALSE, selection = 'none', options = list(searching = FALSE, ordering = FALSE))
}
)
#Observe a button being clicked
observeEvent(input$select_button, {
carb_selected <- mtcars_btn$data[as.numeric(strsplit(input$select_button, "_")[[1]][2]),]$carb
print(paste0('clicked on ', carb_selected))
updateSelectInput(session, 'carb_selection', selected = carb_selected)
})
}
)
Note that you may wish to switch between local and server processing when using large dataframes.