在兩個閃亮的儀表板選項卡中帶有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)