CODEWITHSUNDEEP
rshinyreactable
Soebomb
Soebomb

Reputation: 31

Multiple OnClick Events Reactable R Shiny

I'm working on an R Shiny App where the user can click a copy button to copy a predefined row value from a table and select the row so it's highlighted. I've got a working repo in the below using DT and rclipboard.

I would like to apply the same idea to a reactable object instead of DT but I can't seem to make it happen.

library(shiny)
library(DT)
library(rclipboard)
library(tidyverse)
library(shinyWidgets)

ui <- fluidPage(
  rclipboardSetup(),
  br(),
  fluidRow(
    column(
      width = 9,
      DTOutput("dtable")
    ),
    column(
      width = 3,
      tags$h2("Try to paste here:"),
      tags$textarea()
    )
  )
)

server <- function(input, output, session) {
  
  my_data_table <- mtcars
  my_data_table[["Action"]] <- map(1:nrow(my_data_table), .f = function(i){
    as.character(
      rclipButton(
        paste0("clipbtn_", i), 
        label = "Copy", 
        clipText = my_data_table[i, "disp"], 
        icon = icon("copy", lib = "glyphicon"),
        class = "btn-primary btn-sm"
      )
    )
  })

  output[["dtable"]] <- renderDT({
    datatable(
      my_data_table,
      escape = FALSE,
      selection = "multiple",
      options = list(
        columnDefs = list(
          list(targets = ncol(my_data_table), orderable = FALSE)
        )
      )
    )
  })
  
}

shinyApp(ui, server)

The below repo is sort of the furthest I've gotten using reactable and clipr for the clipboard, obvious issues are the one button for copying, only being able to copy the selected rows, and not highlighting when selected.

library(shiny)
library(reactable)
library(htmltools)
library(clipr)

ui <- fluidPage(
  actionButton("copy_btn", "Copy Row"),
  reactableOutput("table"),
)

server <- function(input, output) {
  output$table <- renderReactable({
    reactable(
      MASS::Cars93[, 1:5],
      showPageSizeOptions = TRUE,
      selection = "multiple",
      onClick = "select"
    )
  })

  output$table_state <- renderPrint({
    state <- req(getReactableState("table"))
    print(state)
  })

observeEvent(input$copy_btn, {
  selected <- getReactableState("table", "selected")
    req(selected)
    details <- MASS::Cars93[selected, 1]
    write_clip(details)
})
  

}

shinyApp(ui, server)

I've tried defining HTML buttons to get the row-wise display and assigning an onClick function to the buttons, but I'm stuck on the JS necessary to access the row information. It seems like for the desired effect I need a JS function to both still have the row-wise copy buttons and have the ability to select the rows to highlight them.

as.character(htmltools::tags$div(htmltools::tags$button(
    paste(label, "button"),
    onClick = JS()

Upvotes: 2

Views: 323

Answers (1)

St&#233;phane Laurent
St&#233;phane Laurent

Reputation: 84659

With rowStyle:

library(shiny)
library(reactable)
library(htmltools)
library(clipr)

ui <- fluidPage(
  actionButton("copy_btn", "Copy Row"),
  reactableOutput("table"),
)

server <- function(input, output) {
  output$table <- renderReactable({
    reactable(
      MASS::Cars93[, 1:5],
      showPageSizeOptions = TRUE,
      selection = "multiple",
      onClick = "select",
      rowStyle = function(index) {
        if(isTRUE(index == Selected())) {
          list(backgroundColor = "yellow")
        }
      }
    )
  })
  
  output$table_state <- renderPrint({
    state <- req(getReactableState("table"))
    print(state)
  })
  
  Selected <- reactiveVal(NULL)
  
  observeEvent(input$copy_btn, {
    selected <- getReactableState("table", "selected")
    Selected(selected)
    req(selected)
    details <- MASS::Cars93[selected, 1]
    write_clip(details)
  })
  
}

shinyApp(ui, server)

enter image description here

Upvotes: 1

Related Questions