Adding two button_extra() to one cell in reactable table in a Shiny app

Question

Taking some inspiration from the answer to this questions: Add two links in the same cell of a reactable table?

I tried to put an example together of using two button_extra() from the reactable_extras package in one cell. Unfortunately, this doesn't produce any table output,, but also no error messages.

Thss is the code I am working with:

library(tidyverse)
library(reactable)
library(reactable.extras)

ui <- fluidPage(
  reactable_extras_ui("locations")
)

server <- function(input, output) {
  reactable_extras_server(
    "locations",
    data = mtcars %>% 
      add_column(action_edit = "Edit" , .before = "mpg") %>% 
      add_column(action_delete = "Delete" , .before = "mpg") %>% 
      add_column(actions = "Actions" , .before = "mpg"),
    columns = list(
      action_edit = colDef(
        cell = button_extra("button", class = "button-extra"),
        name = ""
      ),
      action_delete = colDef(
        cell = button_extra("button", class = "button-extra"),
        name = ""
      ),
      actions = colDef(
        cell = function(value, index){
          tagList(
            button_extra("button", key = 'edit', class = "button-extra"),
            button_extra("button", key = 'delete', class = "button-extra")
          )
        }
      )
      
    )
    
  )
}

# Run the application 
shinyApp(ui = ui, server = server)

When I hide:

,
      actions = colDef(
        cell = function(value, index){
          tagList(
            button_extra("button", key = 'edit', class = "button-extra"),
            button_extra("button", key = 'delete', class = "button-extra")
          )
        }
      )

it does show a valid table, but with that code add it doesn't.

Does anybody have an idea to get the desired solutions of having the two buttons in one cell working?

Answer 1

It's not exactly pretty, but if you add an index column beforehand, you can use it to create a column with html for your buttons and use the reactable::colDef(html = TRUE) option.

In essence, we have to render a separate group of action buttons for each row with different input id's. Once any of the buttons are clicked, we need a javascript function that will set an over-arching input value to the value of the clicked button (so we don't have to write observeEvent(input$edit_1, ) to observeEvent(input$edit_9999, ) separately. Instead we can just observeEvent(input$table_id, ) in the following code.

library(shiny)
library(tidyverse)
library(reactable)
library(reactable.extras)

ui <- fluidPage(
    shiny::tags$head(
        shiny::tags$script('function reactable_id(id, input) {Shiny.setInputValue(input, id, { priority: "event" });}')
    ),
    reactable_extras_ui("locations")
)

The following function takes a data.frame and provided an index column and the inputId of the over-arching input, will create grouped buttons as a character in an Action column. This is not pretty to look at, but in my limited testing using character based methods (paste0, sprintf, glue, etc.) are faster than applying the shiny::div() function and then piping as.character().

reactable_btn_group <- function(x, id_col, inputId) {
    f <- function(x) {
        paste0(
            '<div class = "btn-group">
                   <button class="btn btn-default action-button" id="edit_', x,
            '" onclick="reactable_id(this.id, \'', inputId, '\')"><i class="fas fa-edit"></i></button>
                   <button class="btn btn-default action-button" id="delete_', x,
            '" onclick="reactable_id(this.id, \'', inputId, '\')"><i class="fa fa-trash-alt"></i></button></div>'
        )
    }

    x <- x |>
        dplyr::mutate(Action = f(!!rlang::sym(id_col)))


    return(x)
}

Finally, in the server side, we add an index with dplyr::row_number(), use the above function, and render the table with the html = TRUE argument in the colDef(). I also added an observeEvent() that shows the results of a button press.

server <- function(input, output) {
    reactable_extras_server(
        "locations",
        data = mtcars |>
            dplyr::mutate(Index = dplyr::row_number()) |>
            reactable_btn_group("Index", "table_id") |>
            dplyr::select(mpg, Action, Index),
        columns = list(
            Index = colDef(
                show = FALSE
            ),
            Action = colDef(
                name = "",
                html = TRUE
            )
        )
    )

    activeId <- shiny::reactiveVal()

    shiny::observeEvent(input$table_id, {
        # get the input "edit_1", "delete_23"
        x <- input$table_id

        # extract the digit
        id <- stringr::str_extract_all(x, "[:digit:]+")
        id <- as.integer(id)

        # get the operation
        op <- stringr::str_remove_all(x, "[:punct:]|[:digit:]+")

        # place in reactiveVal
        activeId(
            list(
                id = id,
                op = op
            )
        )

        # toy notification
        x <- activeId()
        shiny::showNotification(
            glue::glue(
                "{x$op} {x$id}"
            )
        )
    })
}

# Run the application
shinyApp(ui = ui, server = server)

I'd be curious if there are more elegant solutions than this.