R Shiny: Bouton Supprimer Ligne dans Table de Données

Question

Je travaille sur une application R Shiny où un utilisateur a le contrôle d'un tableau de données. Ils peuvent ajouter de nouvelles lignes au tableau ou supprimer l'une des lignes existantes. Mon souhait est d'avoir un bouton Supprimer 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, cependant elle ne fonctionne pas de manière fiable. Le bouton d'ajout fonctionne de manière cohérente, cependant parfois le bouton de suppression n'est pas reconnu.

Exemple d'échec.

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

```

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 = "Ajouter une ligne",
                        icon = icon("plus"))))
)

server = function(input, output) {

  values <- reactiveValues()
  values$tab <- tibble(
    Ligne = 1:3L,
    Supprimer = 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,
             Supprimer = getRemoveButtons(nrow(myTable), idS = "", lab = "Tab1"))
    replaceData(proxyTable, myTable, resetPaging = FALSE)
    values$tab <- myTable
  })
  observeEvent(input$addRow, {
    myTable <- isolate(values$tab)
    myTable <- select(myTable, Ligne)
    myTable <- bind_rows(
      myTable,
      tibble(Ligne = nrow(myTable) + 1))
    myTable <- mutate(myTable,
                      Supprimer = getRemoveButtons(nrow(myTable), idS = "", lab = "Tab1"))
    replaceData(proxyTable, myTable, resetPaging = FALSE)
    values$tab <- myTable
  })
}

shinyApp(ui = ui, server = server)

Answer 1

D'accord, j'ai réussi à le faire fonctionner 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 maintenant. 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 = "Supprimer",
                    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 = "Ajouter une ligne",
                        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)