0
votes

I am trying to have an action button within the Body of a tab (called "Widgets" in code) link to a different tab (called "data_table" in code). I know how to do this if the tab that I want to connect to, "data_table", is one of the menuItems that appears on the sidebarMenu. However, I do not wish for a link to the "data_table" tab to appear in the sidebar. I am stuck. I would have thought I need an "observeEvent"-type command which links the action button to the "data_table" tab. But I don't know what that is. Advice welcome. The code shows the UI side of things.

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)
1

1 Answers

0
votes

Perhaps you are looking for something like this.

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)