R Shiny: Удалить кнопку Row в таблице данных

Question

Я работаю над приложением R Shiny, где пользователь может управлять таблицей данных.Они могут добавлять новые строки в таблицу или удалять любые существующие строки.Я хочу, чтобы кнопка «Удалить» была встроена в таблицу, где пользователь может нажать эту кнопку, и эта строка будет удалена.

Ниже приведено текущее состояние моего решения, однако оно не работает согласованно.Кнопка добавления работает последовательно, однако иногда кнопка удаления не распознается.

Пример сбоя.

• Загрузить приложение
• Удалить строку 2
  • Работает
• Удалить строку1
  • Работает
• Удалить 3
  • Не распознает, что кнопка нажата.

`` `

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

Хорошо, у меня сейчас работает.Проблема пыталась повторно использовать идентификаторы для кнопок.Создав счетчик и назначив каждой новой кнопке идентификатор, который никогда не использовался, прежде чем он теперь работает отлично.Измененный код ниже.

`` `

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)