R Shiny - динамически создаваемые actionButtons либо все запускаются одновременно (наблюдайте за событием), либо не запускаются вообще (eventReactive)

Question

Я создаю приложение Shiny и моделирую его часть из этой статьи: [https://antoineguillot.wordpress.com/2017/03/01/three-r-shiny-tricks-to-make-your-shiny-app-shines-33-buttons-to-delete-edit-and-compare-datatable-rows/]...

Я динамически создаю actionButtons в именах строк таблицы данных (которая создается после ввода и вывода пользователем данныхна новую вкладку после нажатия «Выполнить»).Когда щелкают по этим кнопкам actionButtons, я хочу, чтобы появилось модальное окно, чтобы дать более подробную информацию для этой строки.Мне удалось создать кнопки на основе кода, приведенного в статье выше, однако у меня возникли проблемы с их корректным срабатыванием ...

Я начал с создания наблюдающего события для каждой кнопки.Тем не менее, они все запускаются при создании таблицы (вместо ожидания нажатия кнопки), и впоследствии активным является только модальное значение последней строки.Тогда ни одна из кнопок не работала после закрытия этого модального режима.Когда я пробовал eventReactive вместо наблюдающего события, они вообще никогда не запускались, даже при нажатии.

Вот простая версия того, что я пытаюсь сделать:

ui<-navbarPage(title="Title", theme=shinytheme("cosmo"), id="navbar",
           tabPanel("Main",
                    selectInput(inputId="rows", label="# of Rows", choices=c(5,10,25)),
                    actionButton(inputId="run", "Run"))
           )

server<-function(input, output, session) {
  observeEvent(input$run, {
    iris_data<-iris[1:input$rows,]
    row.names(iris_data)<-paste0("<button id='details_", 1:nrow(iris_data),"' type='button' class='btn btn-default action-button shiny-bound-input'", ">Details</button>")
    output$iris<-renderDT({
      datatable(iris_data, selection="single", escape=FALSE,
      )
    })
    for (i in 1:nrow(iris_data)) {
      eventReactive(paste0("input$details_",i), {
        showModal(
          modalDialog(
            fluidPage(
              fluidRow(h3(strong("Details"), align="center")), hr(),
              fluidRow(splitLayout(strong("Sepal Length: "), iris_data[i,1])),
              fluidRow(splitLayout(strong("Sepal Width: "), iris_data[i,2])),
              fluidRow(splitLayout(strong("Petal Length: "), iris_data[i,3])),
              fluidRow(splitLayout(strong("Petal Width: "), iris_data[i,4])),
              fluidRow(splitLayout(strong("Species: "), iris_data[i,5])),
          size="l"))
        )}
      )}
    appendTab(inputId="navbar", tabPanel("Data", dataTableOutput("iris")))
  })
}

shinyApp(ui=ui, server=server)

Что я могу изменить вкод выше, чтобы убедиться, что эти кнопки срабатывают, если (и только если) они нажаты?Спасибо!

Answer 1

Это работает с кодом ниже.

• опция drawCallback запускает Shiny.bindAll для таблицы;он сообщает Shiny, что добавляются новые входные данные
• необходимо использовать local в цикле for, в противном случае значение i будет одинаковым во всех экземплярах цикла (это будет последнийi)

---

server <- function(input, output, session) {
  observeEvent(input$run, {
    iris_data <- iris[1:input$rows,]
    row.names(iris_data) <- paste0("<button id='details_", 1:nrow(iris_data),"' type='button' class='btn btn-default action-button'", ">Details</button>")
    output$iris <- renderDT({
      datatable(iris_data, selection="single", escape=FALSE, 
                options = list(
                  drawCallback = JS(
                    "function(){",
                    "  Shiny.bindAll(this.api().table().node());",
                    "}"
                  )
                )
      )
    })
    appendTab(inputId="navbar", tabPanel("Data", DTOutput("iris")))
  })

  observeEvent(input$rows, {
    for(j in 1:input$rows){
      local({
        i <- j
        observeEvent(input[[paste0("details_",i)]], {
          showModal(
            modalDialog(
              fluidPage(
                fluidRow(h3(strong("Details"), align="center")), hr(),
                fluidRow(splitLayout(strong("Sepal Length: "), iris[i,1])),
                fluidRow(splitLayout(strong("Sepal Width: "), iris[i,2])),
                fluidRow(splitLayout(strong("Petal Length: "), iris[i,3])),
                fluidRow(splitLayout(strong("Petal Width: "), iris[i,4])),
                fluidRow(splitLayout(strong("Species: "), iris[i,5])),
                size="l"))
          )
        })
      })
    }
  })

}

---

Вот альтернативный способ:

library(shiny)
library(shinyBS)
library(DT)

ui<-navbarPage(
  title="Title", id="navbar",
  tabPanel("Main",
           selectInput(inputId="rows", label="# of Rows", choices=c(5,10,25)),
           actionButton(inputId="run", "Run")),
  tabPanel("Data", 
           DTOutput("iris"),
           uiOutput("modals"))
)

server <- function(input, output, session) {
  output$iris <- renderDT({
    if(input$run > 0){
      iris_data <- iris[1:input$rows,]
      row.names(iris_data) <- sapply(1:input$rows, function(i){
        paste0("<button type='button' class='btn btn-default action-button'",
               " onclick = \"", sprintf("$('#modal%d').modal('show');\"", i),
               ">Details</button>")
      }) 
      datatable(iris_data, selection="single", escape=FALSE)
    }
  })

  output$modals <- renderUI({
    modals <- lapply(1:input$rows, function(i){
      bsModal(
        id = paste0("modal",i), 
        title = paste0("Details of row ", i),
        trigger = "",
        fluidPage(
          fluidRow(splitLayout(strong("Sepal Length: "), iris[i,1])),
          fluidRow(splitLayout(strong("Sepal Width: "), iris[i,2])),
          fluidRow(splitLayout(strong("Petal Length: "), iris[i,3])),
          fluidRow(splitLayout(strong("Petal Width: "), iris[i,4])),
          fluidRow(splitLayout(strong("Species: "), iris[i,5]))
        )
      )
    })
    do.call(tagList, modals)
  })

}

shinyApp(ui=ui, server=server)