在两个闪亮的仪表板选项卡中带有actionButton的renderDataTable

Question

我碰到这个问题，而试图用户shiny::renderUI产生通过数据表输出renderDataTable在点击一个actionButton 。 在我尝试在单独的选项卡中实现同一事物的两个实例之前，这种情况一直很好。 在这种情况下，无论单击哪个按钮（在选项卡1或选项卡2中），都可以正常工作。 但是其他选项卡的按钮不会产生数据表。 有没有办法在单独的shinydashboard选项卡中获得两个按钮来独立呈现数据表？

下面显示了可再现的代码来演示此问题。 一个小的数据帧填充有随机值。 单击操作按钮将为数据表计算新数字-但仅为呈现的第一个数据表计算新数字。

library(shiny)
library(shinydashboard)

ui <- dashboardPage(
  dashboardHeader(title = "Test example"),
  dashboardSidebar(
    sidebarMenu(
      menuItem("Tab 1", tabName = "tab_1"),
      menuItem("Tab 2", tabName = "tab_2")
    )
  ),
  dashboardBody(
    tabItems(
      tabItem("tab_1",
        h2("Tab 1"),     
        fluidRow(
          actionButton("do_refresh_tab_1", "Refresh data")
        ),
        fluidRow(
            uiOutput("tab1")
        )
      ),
      tabItem("tab_2",
        h2("Tab 2"),    
        fluidRow(
          actionButton("do_refresh_tab_2", "Refresh data")
        ),
        fluidRow(
            uiOutput("tab2")
        )
      )
    )  
  )
)

server <- function(input, output, session) {

  observeEvent(input$do_refresh_tab_1, {

    df <- data.frame(value = rnorm(3),
                          Measurement = rnorm(3),
                          stringsAsFactors = FALSE)

    output$tab1 <- renderUI({
      output$temp <- renderDataTable(df)
      dataTableOutput("temp")
    })
  })

  observeEvent(input$do_refresh_tab_2, {

    df <- data.frame(value = rnorm(3),
                          Measurement = rnorm(3),
                          stringsAsFactors = FALSE)

    output$tab2 <- renderUI({
      output$temp <- renderDataTable(df)
      dataTableOutput("temp")
    })
  })
}

shinyApp(ui, server)

Answer 1

在我们寻求解决方案之前，有一些一般的经验法则。

1. 实际上，请避免将渲染调用放在另一个渲染调用中。
2. 切勿将渲染调用放入观察调用中
3. 切勿将渲染调用放入响应调用中

每个观察，响应和渲染调用都应该是独立的，并且必须执行1个任务/功能。

之所以只有第一次单击有效，而在另一个选项卡上第二次单击却无效，是因为您试图创建具有相同id（ temp ）的多个输出绑定。

每个输出元素必须具有自己的唯一ID。

同样，在此用例中使用uiOutput和dataTableOutput在这里有点多余。

这是简化的代码，

library(shiny)
library(shinydashboard)

ui <- dashboardPage(
  dashboardHeader(title = "Test example"),
  dashboardSidebar(
    sidebarMenu(
      menuItem("Tab 1", tabName = "tab_1"),
      menuItem("Tab 2", tabName = "tab_2")
    )
  ),
  dashboardBody(
    tabItems(
      tabItem("tab_1",
              h2("Tab 1"),     
              fluidRow(
                actionButton("do_refresh_tab_1", "Refresh data")
              ),
              fluidRow(
                dataTableOutput("table1")
              )
      ),
      tabItem("tab_2",
              h2("Tab 2"),    
              fluidRow(
                actionButton("do_refresh_tab_2", "Refresh data")
              ),
              fluidRow(
                dataTableOutput("table2")
              )
      )
    )  
  )
)

server <- function(input, output, session) {




    output$table1 <- renderDataTable({
      req(input$do_refresh_tab_1)
      df <- data.frame(value = rnorm(3),
                       Measurement = rnorm(3),
                       stringsAsFactors = FALSE)
      return(df)
    })

    output$table2 <- renderDataTable({
      req(input$do_refresh_tab_2)
      df <- data.frame(value = rnorm(3),
                       Measurement = rnorm(3),
                       stringsAsFactors = FALSE)
      return(df)
    })
}

shinyApp(ui, server)