简体   繁体   English

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

[英]renderDataTable with actionButton in two shinydashboard tabs

I came across this issue while trying to user shiny::renderUI to generate a data table output via renderDataTable upon clicking an actionButton . 我碰到这个问题,而试图用户shiny::renderUI产生通过数据表输出renderDataTable在点击一个actionButton This situation works fine until I try to implement two instances of the same thing in separate tabs. 在我尝试在单独的选项卡中实现同一事物的两个实例之前,这种情况一直很好。 In this case, whichever button is clicked first (be it in tab 1 or tab 2) works correctly; 在这种情况下,无论单击哪个按钮(在选项卡1或选项卡2中),都可以正常工作。 but then the other tab's button doesn't produce the data table. 但是其他选项卡的按钮不会产生数据表。 Is there a way to get two buttons, in separate shinydashboard tabs, to render data tables independently? 有没有办法在单独的shinydashboard选项卡中获得两个按钮来独立呈现数据表?

The following shows reproducible code to demonstrate the issue. 下面显示了可再现的代码来演示此问题。 A small data frame is populated with random values. 一个小的数据帧填充有随机值。 Clicking the action button calculates new numbers for the data table--but only for the first data table that is rendered. 单击操作按钮将为数据表计算新数字-但仅为呈现的第一个数据表计算新数字。

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)

Before we go to the solution, a couple of general rules of thumb. 在我们寻求解决方案之前,有一些一般的经验法则。

  1. Avoid, in fact, never put a render call inside another render call. 实际上,请避免将渲染调用放在另一个渲染调用中。
  2. Never put a render call inside an observe call 切勿将渲染调用放入观察调用中
  3. Never put a render call inside a reactive call 切勿将渲染调用放入响应调用中

Each observe, reactive and render call should be standalone and must perform 1 task/function. 每个观察,响应和渲染调用都应该是独立的,并且必须执行1个任务/功能。

The reason why only the first click was working and the second click on the other tab was not, was because you were attempting to create multiple output bindings with the same id ( temp ). 之所以只有第一次单击有效,而在另一个选项卡上第二次单击却无效,是因为您试图创建具有相同id( temp )的多个输出绑定。

Every output element must have its own unique id. 每个输出元素必须具有自己的唯一ID。

Also, using uiOutput and dataTableOutput for this use case is kinda redundant here. 同样,在此用例中使用uiOutput和dataTableOutput在这里有点多余。

Here is the simplified code, 这是简化的代码,

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)

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM