呈现不同页面的两个 actionButton(s)

Question

I have a shiny app (apologies in advance for the length but wanted to provide a reprex):

library(shiny)
library(dplyr)
library(ggplot2)
library(DT)
data('mtcars')

ui <- navbarPage("Test App",
                 tabPanel("Scatter Plot",
                          fluidPage(
                            ## Side Panel
                            fluidRow(
                              column(width = 3,
                                     selectInput(inputId = "cyl", 
                                                 label = "cylender", 
                                                 choices = c(4, 6, 8), 
                                                 selected = 4), 
                                     actionButton(inputId = "load", 
                                                  label =  "Load", 
                                                  width = "100%")
                              ),
                              column(width = 8,
                                     tabPanel("Scatter Plot",
                                              plotOutput("plot1", height = "90%", width = "90%"))
                              )))),
                 tabPanel("Data Table",
                          fluidRow(column(width = 12, div(dataTableOutput("plot2"))))))

server <- function(input, output, session) {
  cars = eventReactive(eventExpr = input$load, valueExpr = {
    res =  mtcars %>% filter(cyl == input$cyl)
    return(res)  
  })
  
  getGraph = function() {
      dat = cars()
      p = ggplot(dat, aes(x = disp, y = mpg)) +
        geom_point()
      return(p)
    }
    
    getDataTable = function(input) {
      dat = cars()
      return(dat)
    }
  
  output$plot1 = renderPlot({
    getGraph()
  }, height = function(){
    session$clientData$output_plot1_width })

  output$plot2 = renderDT(
    getDataTable()
    ,
    class = "display nowrap compact", 
    filter = "top", 
    options = list(scrollX = TRUE))}


shinyApp(ui = ui, server = server)

I want to add a second button next to 'Load' called 'Load Data Table' that would take the user right to the second tab. Is there any way to do this?

Thanks!

Answer 1

You can use updateNavbarPage to select the tabPanel you want to display. For this, you have to include an id in your navbarPage . I also changed your car reactive so that it also updates if you click on the "Load Data Table" button:

library(shiny)
library(dplyr)
library(ggplot2)
library(DT)
data('mtcars')

ui <- navbarPage("Test App",
                 id = "main_navbar",
                 tabPanel("Scatter Plot",
                          fluidPage(
                            ## Side Panel
                            fluidRow(
                              column(width = 3,
                                     selectInput(inputId = "cyl", 
                                                 label = "cylender", 
                                                 choices = c(4, 6, 8), 
                                                 selected = 4), 
                                     actionButton(inputId = "load", 
                                                  label =  "Load", 
                                                  width = "100%"),
                                     actionButton(inputId = "table",
                                                  label = "Load Data Table",
                                                  width = "100%")
                              ),
                              column(width = 8,
                                     tabPanel("Scatter Plot",
                                              plotOutput("plot1", height = "90%", width = "90%"))
                              )))),
                 tabPanel("Data Table",
                          fluidRow(column(width = 12, div(dataTableOutput("plot2"))))))

server <- function(input, output, session) {
  cars = eventReactive(eventExpr = c(input$load, input$table), valueExpr = {
    res =  mtcars %>% filter(cyl == input$cyl)
    return(res)  
  },
  ignoreInit = TRUE)
  
  getGraph = function() {
    dat = cars()
    p = ggplot(dat, aes(x = disp, y = mpg)) +
      geom_point()
    return(p)
  }
  
  getDataTable = function(input) {
    dat = cars()
    return(dat)
  }
  
  output$plot1 = renderPlot({
    getGraph()
  }, height = function(){
    session$clientData$output_plot1_width })
  
  output$plot2 = renderDT(
    getDataTable()
    ,
    class = "display nowrap compact", 
    filter = "top", 
    options = list(scrollX = TRUE))
  
  observeEvent(input$table, {
    updateNavbarPage(
      session,
      inputId = "main_navbar",
      selected = "Data Table"
    )
  })
  
  }


shinyApp(ui = ui, server = server)

Edit I've added ignoreInit = TRUE to the eventReactive so that it doesn't create the data.frame on startup.