Javascript action for button clicked embedded in a data table

Hi all,

I am trying to figure out how to trigger an event on a button embedded in a data table. This is inspired by this app, https://github.com/Tychobra/shiny_crud/tree/master/traditional/shiny_app which uses modules.

Any suggestions on how I can trigger an event when one of the buttons in the table are clicked? I can get the action button to work, but the potential issue is the ids in the table will change. Is it possible to de-couple this trigger from modules used in the inpsiration app?

Any tips greatly appreciated!

Thanks

Iain

Original inspiration Javascript file

 function cars_table_module_js(ns_prefix) {
    $("#" + ns_prefix + "car_table").on("click", ".delete_btn", function() {
    Shiny.setInputValue(ns_prefix + "car_id_to_delete", this.id, { priority: "event"});
    $(this).tooltip('hide');
});

  $("#" + ns_prefix + "car_table").on("click", ".edit_btn", function() {
Shiny.setInputValue(ns_prefix + "car_id_to_edit", this.id, { priority: "event"});
$(this).tooltip('hide');
 });
}

Javascript file in sample app www/my_js.js

document.getElementById("my_button").onclick = function() {myFunction()};
function myFunction() {
alert("My button was clicked.");
}

Shiny app

library(shiny)
library(DT)
library(purrr)
library(shinyjs)
library(dplyr)

my_data<-tibble(report_id=seq(1:5),letter=letters[1:5])

ui <- fluidPage(
 shinyjs::useShinyjs(),
 DTOutput('tbl'),
 actionButton('my_button','mybutton'),
 tags$script(src = "my_js.js"),
)

server <- function(input, output, session) {

output$tbl = renderDT({
data<-my_data
ids<-data$report_id
actions <- purrr::map_chr(ids, function(id_) {
  paste0(
    '<div class="btn-group" style="width: 75px;" role="group" aria-label="Basic example">
      <button class="btn btn-primary btn-sm edit_btn" data-toggle="tooltip" data-placement="top" title="Edit" id = ', id_, ' style="margin: 0"><i class="glyphicon glyphicon-pencil"></i></button>
    </div>'
  )
})

data_to_display<- data%>%mutate(actions=actions)%>%select(actions,everything())

DT::datatable(
  data_to_display,
  selection = 'none',
  filter = 'top',
  rownames = FALSE,
  escape = FALSE,
  class = "compact stripe row-border nowrap",
  options = list(
    dom = 't',
    columnDefs = list(list(width = '75px', targets = c(0))),
    order = list(list(1, 'desc')),
    scrollX = TRUE)
)
 },server=TRUE)

}

shinyApp(ui, server)

Hi Iain,

Taking some inspiration from this post:

I have modified the code slightly to try to improve readability and extensibility, as well as avoid having to parse values out of the inputId's.

Demo App

library(shiny)
library(DT)
library(dplyr)
library(magrittr)
library(purrr)
library(glue)

dummy_data <- data.frame(
  id = 1:3,
  name = c("Item 1", "Item 2", "Item 3")
)

ui <- fluidPage(
  DTOutput("dt_data")
)

server <- function(input, output, session) {
  
  output$dt_data <- renderDT({
    

    # Add actionbutton via map function
    # Instantiate Shiny Input Value 'btn_open'
    # Convert all to character, to be rendered as HTML via DT
    df <- dummy_data %>%
      mutate(
        open = pmap_chr(list(row_id = .$id, name = .$name), function(row_id, name) {
          as.character(
            actionButton(
              inputId = paste0("btn_", row_id), label = "Open",
              onclick = glue('Shiny.setInputValue(\"btn_open\",  { dom_id: this.id, row_id: {% row_id %} , name: \"{% name %}\" }, {priority: \"event\"})', 
                             .open = "{%", .close = "%}")))  # priority: event ensures onclick will fire even for repeated button presses
        }))  
    
    df %>% 
      DT::datatable(
        data = .,
        options = list(
          dom = "t"  # Remove extra DT elements for demo
        ),
        escape = FALSE  # Render HTML in "open" column as HTML
      )
  })
  
  # Set up observer for button clicks - all watch the same Shiny InputValue: btn_open
  observeEvent(input$btn_open, {
    
    print(input$btn_open)  # JavaScript object has been converted to R List
    
    # Elements from within returned list can be accessed easily: input$btn_open$name

    showNotification(
      tagList(
        "Table button was clicked",
        br(),
        paste0("Input value: ", input$btn_open$dom_id),
        br(),
        paste0("ID: ", input$btn_open$row_id),
        br(),
        paste0("Name: ", input$btn_open$name)
      )  # Tag List
    )  # Notification
    
    # Do something else with this value (e.g., save to reactiveValues, trigger update, etc.)
    
  })
  
}

shinyApp(ui, server)

The pmap_chr function can of course be extended to grab values from other columns in the data frame as well, including those potentially de-selected from the final view in the app.

The second argument inside the Shiny.setInputValue function being assigned to the onclick event of the button is an object returned to the observer on click. I am using glue here to pass in values from the same row in the data frame, such as "id" or "name". Since JS uses curly braces in object syntax, I have to modify the open and close of glue to {% and %} to differentiate. Paste or any other function could be used to create that string as well.

Hope this helps.

Cheers,
Sean

1 Like

Love the solution, thanks. It is a very clear and understandable approach

This topic was automatically closed 7 days after the last reply. New replies are no longer allowed.