从 dashboardBody 链接到选项卡答案

【问题标题】：Link to a tab from dashboardBody从 dashboardBody 链接到选项卡
【发布时间】：2020-10-04 16:44:01
【问题描述】：

我正在尝试将选项卡正文中的操作按钮（在代码中称为“小部件”）链接到不同的选项卡（在代码中称为“data_table”）。如果我要连接的选项卡“data_table”是出现在 sidebarMenu 上的菜单项之一，我知道该怎么做。但是，我不希望“data_table”选项卡的链接出现在侧边栏中。我被困住了。我原以为我需要一个“observeEvent”类型的命令，它将操作按钮链接到“data_table”选项卡。但我不知道那是什么。欢迎咨询。该代码显示了事物的 UI 方面。

ui <- dashboardPage(
  dashboardHeader(title = "My query"),

  dashboardSidebar(
    sidebarMenu(
      menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
      menuItem("Widgets", tabName = "widgets", icon = icon("th"))
  )
  ),
  dashboardBody(
    tabItems( 
      tabItem(tabName = "dashboard",
        h2("Dashboard tab content")),
      tabItem(tabName = "widgets",
        h2("Widgets"),
        actionButton(inputId="seedata", label = "See data")),
      tabItem(tabName = "data_table",
      h2("Table with the data"))
      )
    )
)
server <- function(input, output, session) { }

shinyApp(ui, server)

【问题讨论】：

标签： r shiny shinydashboard action-button

【解决方案1】：

也许你正在寻找这样的东西。

ui <- dashboardPage(
  dashboardHeader(title = "My query"),
  
  dashboardSidebar(
    sidebarMenu(# Setting id makes input$tabs give the tabName of currently-selected tab
      id = "tabs",
      menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
      menuItem("Widgets", tabName = "widgets", icon = icon("th"))
    )
  ),
  dashboardBody(
    tabItems( 
      tabItem(tabName = "dashboard",
              h2("Dashboard tab content")),
      tabItem(tabName = "widgets", h2("Widgets"),
              fluidRow(
                tabBox(id = "tabset1", height = "850px", width=12, title = "My Data",
                       ###  The id lets us use input$tabset1 on the server to find the current tab
                       tabPanel("Table with the data", value="tab1", " ",
                                actionButton(inputId="seedata", label = "See data"),
                                uiOutput("dataTable")
                       ),
                       tabPanel("Display Data Table", value="tab2", " ",
                                #uiOutput("someoutput")
                                DT::dataTableOutput("testtable")
                       )
                )
              )
    ))
  )
)
server <- function(input, output, session) { 
  
  output$dataTable <-  renderUI({
    tagList( 
      div(style="display: block; height: 350px; width: 5px;",HTML("<br>")),
      actionBttn(inputId="datatable", 
                 label="Data Table",
                 style = "simple",
                 color = "success",
                 size = "md",
                 block = FALSE,
                 no_outline = TRUE
      ))
  
  })
  
  observeEvent(input$datatable, {
    updateTabItems(session, "tabs", "widgets")
    if (input$datatable == 0){
      return()
    }else{
      ## perform other tasks if necessary
      output$testtable <- DT::renderDataTable(
        mtcars, 
        class = "display nowrap compact", # style
        filter = "top", # location of column filters
        options = list(  # options
          scrollX = TRUE # allow user to scroll wide tables horizontally
        )
      )
    }
    
  })
  observeEvent(input$datatable, {
    updateTabsetPanel(session, "tabset1",
                      selected = "tab2")
  })

}
shinyApp(ui, server)

【讨论】：