Embedded inputs in R Shiny Datatable - javascript issue

Question

I have an R/Shiny app containing a datatable from the DT package.

Following this thread render dropdown for single column in DT shiny, I've been able to embed action buttons into a column in my datatable, which trigger a set of corresponding observers.

However, when the datatable is paginated, my action buttons will only function correctly for those buttons on the first page. Buttons on subsequent pages don't work. This remains the case even if I reorder the data using column sorting, as any buttons which were on page 2+ as of the initial render will not work even if they are reordered onto page 1.

I expect the problem is in how the callback argument is using javascript (which is unfortunately over my head) to render the action buttons correctly. Can anyone advise how to get the action buttons working on subsequent pages?

Here is my minimal reprex, using mtcars data:

library(shiny)
library(DT)

ui <- fluidPage(
    titlePanel("reprex1")
    ,fluidRow(
        dataTableOutput("dt1")
    )
)

server <- function(input, output) {
    output$dt1 <- renderDataTable({
        mtlocal <- mtcars
        for(n in 1:nrow(mtlocal)){
            mtlocal$actionbutton[[n]] <- as.character(
                actionButton(
                    paste0("buttonpress",n), label = paste0("buttonpress",n)
                )
            )
        }
        datatable(
            mtlocal
            ,escape = FALSE
            ,selection = "none"
            ,callback = JS("table.rows().every(function(i, tab, row) {
        var $this = $(this.node());
        $this.attr('id', this.data()[0]);
        $this.addClass('shiny-input-container');
      });
      Shiny.unbindAll(table.table().node());
      Shiny.bindAll(table.table().node());")
        )
    }, server = FALSE)

    lapply(
        1:nrow(mtcars),function(x){
            observeEvent(
                input[[paste0("buttonpress",x)]],{
                    showModal(
                        modalDialog(
                            h2(paste0("You clicked on button ",x,"!"))
                        )
                    )
                }
            )       
        }
    )
}

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

score 1 · Accepted Answer · answered Sep 29 '20 at 15:07

The callback is executed only once, and then Shiny.bind/unbind is lost when the table is redrawn. You have to use the options preDrawCallback and drawCallback:

datatable(
  mtlocal
  , escape = FALSE
  , selection = "none"
  , options = list(
    preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
    drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } ')
  )
)

Embedded inputs in R Shiny Datatable - javascript issue

1 Answers1