action button in table does not respond if i click twice in a row on the same one

Viewed 418

So I've created a table that contains an action button for each row, the problem is when i click twice in a row in the same button, the second time, the button doesn't respond. I have to click on the button below and then click again on the previous button to make it works. And i find that it's not really convenient for the final users.
Here is my code :
library(shiny)
library(data.table)
library(DT)

ui = fluidPage(
  mainPanel(
    DT::dataTableOutput("datatable")
  )
)

server = function(session, input, output) {
  
  shinyInput <- function(FUN, len, id, ...) {
    inputs <- character(len)
    for (i in seq_len(len)) {
      inputs[i] <- as.character(FUN(paste0(id, i), ...))
    }
    inputs
  }
  
  employee <- c('John Doe','Peter Gynn','Jolie Hope')
  salary <- c(21000, 23400, 26800)
  startdate <- as.Date(c('2010-11-1','2008-3-25','2007-3-14'))
  dt <- setDT(data.frame(employee, salary, startdate))
  
  dt <- dt[, action := shinyInput(actionButton, 
                                  dim(dt)[1], 
                                  'button_', 
                                  label = "Delete", 
                                  onclick = 'Shiny.onInputChange(\"select_button\",  this.id)')]
  
  output$datatable <- DT::renderDataTable(DT::datatable({dt},
                                                        rownames = FALSE, escape = FALSE))
  
  observeEvent(input$select_button, {
    showModal(modalDialog(
      title="TEST",
      h3(paste("Hello world")),
      footer = tagList(actionButton("confirmDelete", "Delete"),
                       modalButton("Cancel")
      )
    ))
  })

  observeEvent(input$confirmDelete, {
    removeModal()
  })
}

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

does somebody have an idea to fix this bug ?

1 Answers

The pattern you use here is that a click on a button changes the value of input$select_button via Shiny.onInputChange. The value set for this input is the button id, e.g. button_1. This stays the same when you click on the same button repeatedly. My solution is to additionally add a random number to the value for input$select_button, so it always changes and the observeEvent is triggered. Please note that it is recommended to use Shiny.setInputValue instead of Shiny.onInputChange.

library(shiny)
library(data.table)
library(DT)

ui = fluidPage(
  mainPanel(
    DT::dataTableOutput("datatable")
  )
)

server = function(session, input, output) {
  
  shinyInput <- function(FUN, len, id, ...) {
    inputs <- character(len)
    for (i in seq_len(len)) {
      inputs[i] <- as.character(FUN(paste0(id, i), ...))
    }
    inputs
  }
  
  employee <- c('John Doe','Peter Gynn','Jolie Hope')
  salary <- c(21000, 23400, 26800)
  startdate <- as.Date(c('2010-11-1','2008-3-25','2007-3-14'))
  dt <- setDT(data.frame(employee, salary, startdate))
  
  dt <- dt[, action := shinyInput(actionButton, 
                                  dim(dt)[1], 
                                  'button_', 
                                  label = "Delete", 
                                  onclick = 'Shiny.setInputValue(\"select_button\",  this.id.concat(\"_\", Math.random()))')]
  
  output$datatable <- DT::renderDataTable(DT::datatable({dt},
                                                        rownames = FALSE, escape = FALSE))
  
  observeEvent(input$select_button, {
    rowid <- as.numeric(strsplit(input$select_button, "_")[[1]][2])
    showModal(modalDialog(
      title="TEST",
      h3(paste("Hello world")),
      footer = tagList(actionButton("confirmDelete", "Delete"),
                       modalButton("Cancel")
      )
    ))
  })
  
  observeEvent(input$confirmDelete, {
    removeModal()
  })
}

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