0

我正在构建一个闪亮的应用程序并根据这篇文章对它的一部分进行建模：[ 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（在用户输入后创建并在单击“运行”后输出到新选项卡）。单击这些操作按钮时，我希望弹出一个模式以提供该行的更多详细信息。我能够根据上面文章中的代码创建按钮，但是我无法让它们正确触发......

我首先为每个按钮创建了一个 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)

我可以在上面的代码中更改什么以确保这些按钮在（且仅当）它们被点击时触发？谢谢！

4

1 回答 1

0

这适用于下面的代码。

  • 该drawCallback选项Shiny.bindAll在桌子上运行；它告诉 Shiny 添加了新的输入
  • 需要在 for 循环中使用local，否则循环中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)
于 2019-02-20T20:04:32.560 回答