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时，我希望弹出一个模式以提供该行的更多详细信息。我能够根据以上文章中的代码创建按钮，但是我无法让它们正确触发...

我首先为每个按钮创建一个observeEvent。但是，它们都将在创建表时触发（而不是等待按钮被单击），并且之后仅激活最后一行的模式。然后，在取消该模式后，所有按钮均不起作用。当我尝试使用eventReactive而不是observeEvent时，即使单击，它们也从未触发。

这是我正在尝试的简单版本：

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已添加新输入
需要在for循环中使用local，否则在循环中的所有实例中i的值都将相同（它将是最后一个i）< / li>

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)

R Shiny-动态创建的actionButtons要么全部触发一次（observeEvent），要么根本不触发（eventReactive）

1 个答案: