How to add checkboxgroups and buttons into a datatable in shiny

Question

I want to include a checkboxgroup with one button into a datatable in R. Thanks to https://github.com/rstudio/DT/issues/93#issuecomment-111001538 I found how to use bind and unbind in shiny in order to tell shiny that I created some elements on the fly. So now shiny knows that my elements exist. However the callbacks are either not working or firing twice...

Let me give you a MWE:

library(shiny)

ui <- fluidPage(
  shinyjs::useShinyjs(),
  actionButton("browser", "browser"),
  DT::dataTableOutput(
    outputId = "dtout"
  ),
  shinyjs::hidden(numericInput(
    inputId = "computeSumOfRow",
    label = NULL,
    value = 0
  ))
)

server <- function(input, output, session) {
  observeEvent(input$browser, browser())
  observeEvent(input$computeSumOfRow,{
    i <- input$computeSumOfRow
    cat("Start computing sum for row", i, "\n")
    str(i)
    allNumbers <- input[[paste0("checkboxId", i)]]
    allNumbers <- as.integer(allNumbers)
    print(sum(allNumbers))
  }, ignoreInit = TRUE)
  list_of_events <- lapply(1:5, function(i){
    observeEvent(input[[paste0("buttonId",i)]],{
      cat("Button ", i, "pressed and triggered external event\n")
      str(input[[paste0("buttonId",i)]])
    })
  })
  output$dtout <- DT::renderDT({
    checkboxes <- sapply(1:5, function(i){
      as.character(div(
        checkboxGroupInput(
          inputId = paste0("checkboxId", i),
          label = "Select the number you want to compute the sum",
          choices = 1:7 + 10*i
        ),
        actionButton(
          inputId = paste0("buttonId",i),
          label = "compute the sum",
          onclick = sprintf("Shiny.setInputValue(id=\"computeSumOfRow\", %i, {priority: \"event\"});", i)
        )
      ))
    })
    dt <- data.frame(
      checkboxes = checkboxes
    )
    DT::datatable(
      dt,
      escape = FALSE,
      selection = "none",
      options = list(
        preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
        drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } ')
      )
    )
  })
}

shinyApp(ui, server)

To reproduce what I got please select buttons 24, 25 and 26 and click the second button.

When you look into the console, you see that the computeSumOfRow was triggered twice: The first time correctly (like I specified in my onclick-event) and the second time with the number of times the button has been clicked. If you do not unbind+bind while creating the datatabe, then only the first (correct) event is triggered. However, then shiny does not of the existence of the checkboxgroups (you can see that e.g. by going into the browser and typing input$ and you do not get the autocomplete-options checkboxId1 and so on).

My custom events (the ones created using lapply) however did not work even with the unbind+bind trick.

What should I change so that my code works as expected?

See the following link, as I believe it may be of some use to you: https://stackoverflow.com/a/75924343/15481857 — Jacob Bumgarner, Apr 05 '23 at 18:38

score 0 · Accepted Answer · answered Apr 13 '23 at 12:04

You should decide whether you want to let shiny set up your reactiveness (via bindAll) or whether you want to trigger it yourself (via setInputValue). Now you are doing it both at the same time and this creates the mess.

The following example illustrates the 2 options:

library(DT)
library(shiny)
library(htmlwidgets)

ui <- fluidPage(
   DTOutput("dt"),
   verbatimTextOutput("dbg")
)

server <- function(input, output, session) {
   output$dt <- renderDT({
      dat <- data.frame(
         "Button By Hand" = 
            tags$button(type = "button",
                        class = "btn btn-default",
                        "Button By Hand",
                        onclick = "Shiny.setInputValue('button_by_hand', Math.random())") %>% 
            as.character(),
         "Shiny Button" = 
            actionButton("button_from_shiny",
                         "Button From Shiny") %>% 
            as.character())
      datatable(dat, 
                escape = FALSE,
                options = list(
                   preDrawCallback = JS('function() {Shiny.unbindAll(this.api().table().node());}'),
                   drawCallback = JS('function() {Shiny.bindAll(this.api().table().node());}')))
      
   })
   
   output$dbg <- renderPrint(list(by_hand = input$button_by_hand, 
                                  from_shiny = input$button_from_shiny))
}

shinyApp(ui, server)

Either you are creating a "normal" button using pure HTML and use setInputValue in the onClick event to trigger the reactivity

-- or --
You let shiny create all the necessary reactivity by using the string representation of the actionButton. In this case you must not use an onClick event.

For your current implementation it means that you should remove the onClick and you will see that your input[[paste0("buttonId",i)]] will fire.

If you redraw the table (because it reacts to some input) then the approach using shiny does not work: Only the first created button works, once the table is recalculated it has no effect anymore. `onclick` on the other hand works fine. I guess there is no way keeping the button working even with redrawing the table? — Noskario, May 31 '23 at 12:05

How to add checkboxgroups and buttons into a datatable in shiny

1 Answers1