时间戳

首页 > 解决方案 > 呈现不同页面的两个 actionButton(s)

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

问题描述

我有一个闪亮的应用程序（提前道歉，但想提供一个代表）：

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)

我想在“加载”旁边添加一个名为“加载数据表”的第二个按钮，它将用户带到第二个选项卡。有没有办法做到这一点？

谢谢！

标签： rshiny

解决方案

您可以使用updateNavbarPage来选择tabPanel要显示的内容。为此，您必须id在navbarPage. 我还更改了您的car反应式，以便在您单击“加载数据表”按钮时它也会更新：

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)

编辑 我已添加ignoreInit = TRUE到，eventReactive以便它不会在启动时创建 data.frame。

推荐阅读