R Brillant : Supprimer un bouton de ligne dans un tableau de données

Question

Je travaille sur une application R Shiny où un utilisateur a le contrôle d'un tableau de données. Il peut ajouter de nouvelles lignes au tableau ou supprimer des lignes existantes. Je souhaite avoir un bouton Remove intégré dans le tableau où l'utilisateur peut cliquer sur ce bouton et cette ligne sera supprimée.

Voici l'état actuel de ma solution, mais elle ne fonctionne pas de manière cohérente. Le bouton d'ajout fonctionne systématiquement, mais il arrive que le bouton de suppression ne soit pas reconnu.

Exemple de défaillance.

• Charger l'application
• Supprimer la ligne 2
  • Travaux
• Supprimer la ligne 1
  • Travaux
• Retirer 3
  • Ne reconnaît pas que le bouton est enfoncé.

```

library(DT)

getRemoveButtons <- function(n, idS = "", lab = "Pit") {
  if (stringr::str_length(idS) > 0) idS <- paste0(idS, "-")
  ret <- shinyInput(actionButton, n,
                    'button_', label = "Remove",
                    onclick = sprintf('Shiny.onInputChange(\"%sremove_button_%s\",  this.id)' ,idS, lab))
  return (ret)
}
shinyInput <- function(FUN, len, id, ses, ...) {
  inputs <- character(len)
  for (i in seq_len(len)) {
    inputs[i] <- as.character(FUN(paste0(id, i), ...))
  }
  inputs
}

ui = shinyUI(fluidPage(
  fluidRow(DT::dataTableOutput("myTable")),
  fluidRow(actionButton("addRow", label = "Add Row",
                        icon = icon("plus"))))
)

server = function(input, output) {

  values <- reactiveValues()
  values$tab <- tibble(
    Row = 1:3L,
    Remove = getRemoveButtons(3, idS = "", lab = "Tab1"))

  proxyTable <- DT::dataTableProxy("tab")

  output$myTable <- DT::renderDataTable({
    DT::datatable(values$tab,
                  options = list(pageLength = 25,
                                 dom        = "rt"),
                  rownames = FALSE,
                  escape   = FALSE,
                  editable = TRUE)
  })

  observeEvent(input$remove_button_Tab1, {
    myTable <- values$tab
    s <- as.numeric(strsplit(input$remove_button_Tab1, "_")[[1]][2])
    myTable <- filter(myTable, row_number() != s)
    myTable <-
      mutate(myTable,
             Remove = getRemoveButtons(nrow(myTable), idS = "", lab = "Tab1"))
    replaceData(proxyTable, myTable, resetPaging = FALSE)
    values$tab <- myTable
  })
  observeEvent(input$addRow, {
    myTable <- isolate(values$tab)
    myTable <- select(myTable, Row)
    myTable <- bind_rows(
      myTable,
      tibble(Row = nrow(myTable) + 1))
    myTable <- mutate(myTable,
                      Remove = getRemoveButtons(nrow(myTable), idS = "", lab = "Tab1"))
    replaceData(proxyTable, myTable, resetPaging = FALSE)
    values$tab <- myTable
  })
}

shinyApp(ui = ui, server = server)

Answer 1

Ok, ça marche maintenant. Le problème était d'essayer de réutiliser les identifiants des boutons. En créant un compteur et en attribuant à chaque nouveau bouton un identifiant qui n'a jamais été utilisé auparavant, cela fonctionne parfaitement. Code modifié ci-dessous.

```

library(DT)
library(dplyr)

getRemoveButton <- function(n, idS = "", lab = "Pit") {
  if (stringr::str_length(idS) > 0) idS <- paste0(idS, "-")
  ret <- shinyInput(actionButton, n,
                    'button_', label = "Remove",
                    onclick = sprintf('Shiny.onInputChange(\"%sremove_button_%s\",  this.id)' ,idS, lab))
  return (ret)
}

shinyInput <- function(FUN, n, id, ses, ...) {
  as.character(FUN(paste0(id, n), ...))
}

ui = shinyUI(fluidPage(
  fluidRow(DT::dataTableOutput("myTable")),
  fluidRow(actionButton("addRow", label = "Add Row",
                        icon = icon("plus"))))
)

server = function(input, output) {

  buttonCounter <- 3L

  values <- reactiveValues()
  values$tab <- tibble(
    Row = 1:3L,
    id = 1:3L) %>%
    rowwise() %>%
    mutate(Remove = getRemoveButton(id, idS = "", lab = "Tab1"))

  proxyTable <- DT::dataTableProxy("tab")

  output$myTable <- DT::renderDataTable({
    DT::datatable(values$tab,
                  options = list(pageLength = 25,
                                 dom        = "rt"),
                  rownames = FALSE,
                  escape   = FALSE,
                  editable = TRUE)
  })

  observeEvent(input$remove_button_Tab1, {
    myTable <- values$tab
    s <- as.numeric(strsplit(input$remove_button_Tab1, "_")[[1]][2])
    myTable <- filter(myTable, id != s)
    replaceData(proxyTable, myTable, resetPaging = FALSE)
    values$tab <- myTable
  })
  observeEvent(input$addRow, {
    buttonCounter <<- buttonCounter + 1L
    myTable <- isolate(values$tab)
    myTable <- bind_rows(
      myTable,
      tibble(Row = nrow(myTable) + 1) %>%
        mutate(id = buttonCounter,
               Remove = getRemoveButton(buttonCounter, idS = "", lab = "Tab1")))
    replaceData(proxyTable, myTable, resetPaging = FALSE)
    values$tab <- myTable
  })
}

shinyApp(ui = ui, server = server)