通过闪亮应用程序中的操作按钮浏览不同的 tabsetPanel

Question

我有一个闪亮的应用程序，边栏中有 5 actionButton()。我希望每次用户按下按钮时都会显示相应的tabsetPanel()。重要的是默认 tabsetPanel() 应该是 "Home" 之一。这就是我使用isolate()的原因。

#ui.r
library(shiny)
library(shinythemes)
library(plotly)
ui <- fluidPage(
  theme=shinytheme("slate") ,
  # App title ----
  titlePanel("Tabsets"),

  # Sidebar layout with input and output definitions ----
  sidebarLayout(

    # Sidebar panel for inputs ----
    sidebarPanel(
      actionButton("ho", "Home"),
      actionButton("sea", "SectionA"),
      actionButton("seb", "SectionB"),
      actionButton("sec", "SectionC"),
      actionButton("sed", "SectionD"),

    ),

    # Main panel for displaying outputs ----
    mainPanel(
      uiOutput("tabers")

    )
  )
)
#server.r
library(shiny)
library(shinythemes)
library(plotly)
server = function(input, output) {
  observeEvent(input$ho, {
    isolate(tabsetPanel(
      id="tabC",
      type = "tabs",
      tabPanel("Global"),
      tabPanel("Two Bars only here",
               plotlyOutput('bars'),
               plotlyOutput('bars2')
      )
    ))
  })
  observeEvent(input$sea, {
    tabsetPanel(
      id="tabB",
      type = "tabs",
      tabPanel("Constituents Table Iris only here",
               output$table <- DT::renderDataTable({
                 datatable(
                   iris)
               })),
      tabPanel("Bare only here",
               plotlyOutput("bar3")
      )
    )
  })
observeEvent(input$seb, {
        tabsetPanel(
          id="tabB",
          type = "tabs",
          tabPanel("Constituents Table Iris only here",
                   output$table <- DT::renderDataTable({
                     datatable(
                       iris)
                   })),
          tabPanel("Bare only here",
                   plotlyOutput("bar3")
          )
        )
      })
      observeEvent(input$sec, {
        tabsetPanel(
          id="tabB",
          type = "tabs",
          tabPanel("Constituents Table Iris only here",
                   output$table <- DT::renderDataTable({
                     datatable(
                       iris)
                   })),
          tabPanel("Bare only here",
                   plotlyOutput("bar3")
          )
        )
      })
      observeEvent(input$sed, {
        tabsetPanel(
          id="tabB",
          type = "tabs",
          tabPanel("Constituents Table Iris only here",
                   output$table <- DT::renderDataTable({
                     datatable(
                       iris)
                   })),
          tabPanel("Bare only here",
                   plotlyOutput("bar3")
          )
        )
      })



                 output$bars<-renderPlotly({
                   p <- plot_ly(
                     x = c("giraffes", "orangutans", "monkeys"),
                     y = c(20, 14, 23),
                     name = "SF Zoo",
                     type = "bar"
                   )
                 })
                 output$bars2<-renderPlotly({
                   p <- plot_ly(
                     x = c("gir", "ora", "mon"),
                     y = c(20, 14, 23),
                     name = "SF Zoo",
                     type = "bar"
                   )
                 })
                 output$bar3<-renderPlotly({
                   p <- plot_ly(
                     x = c("gir", "ora", "mon"),
                     y = c(20, 14, 23),
                     name = "SF Zoo",
                     type = "bar"
                   )
                 })

Answer 1

您有什么理由使用两个不同的操作按钮而不是单选按钮？如果不是，我建议使用后者，这样可以更轻松地动态呈现您的 tabsetPanel。

library(shiny)
library(shinythemes)
library(plotly)
library(DT)

ui <- fluidPage(
  theme=shinytheme("slate") ,

  # App title ----

  titlePanel("Tabsets"),

  # Sidebar layout with input and output definitions ----
  sidebarLayout(

    # Sidebar panel for inputs ----
    sidebarPanel(

                 radioButtons(inputId="hose", label = "Choices",choices = c("Home"="ho","Section"="se"), selected = "ho")

    ),

    # Main panel for displaying outputs ----
    mainPanel(
      uiOutput("tabs")

    )
  )
)

#server.r

server = function(input, output) {

  observe({

    output$tabs <- renderUI(

      if (input$hose=="ho") {
    tabsetPanel(
      id="tabC",
      type = "tabs",
      tabPanel("Global"),
      tabPanel("Two Bars only here",
               plotlyOutput('bars'),
               plotlyOutput('bars2')
      )
    )

      } else {

      tabsetPanel(
        id="tabB",
        type = "tabs",
        tabPanel("Constituents Table Iris only here",
                 output$table <- DT::renderDataTable({
                   datatable(
                     iris)
                 })),
        tabPanel("Bare only here",
                 plotlyOutput("bar3")
        )
      )

      }

    )



  })

  output$bars<-renderPlotly({
    p <- plot_ly(
      x = c("giraffes", "orangutans", "monkeys"),
      y = c(20, 14, 23),
      name = "SF Zoo",
      type = "bar"
    )
  })
  output$bars2<-renderPlotly({
    p <- plot_ly(
      x = c("gir", "ora", "mon"),
      y = c(20, 14, 23),
      name = "SF Zoo",
      type = "bar"
    )
  })
  output$bar3<-renderPlotly({
    p <- plot_ly(
      x = c("gir", "ora", "mon"),
      y = c(20, 14, 23),
      name = "SF Zoo",
      type = "bar"
    )
  })

}

# Run the application 
shinyApp(ui = ui, server = server)

编辑

如果您需要两个操作按钮，您可以使用以下。请注意，您必须使用shinyjs 禁用按钮，该按钮处于活动状态，否则计数器不起作用。

library(shiny)
library(shinythemes)
library(plotly)
library(DT)
library(shinyjs)

ui <- fluidPage(
  theme=shinytheme("slate") ,

  shinyjs::useShinyjs(), # get shinyjs

  # App title ----

  titlePanel("Tabsets"),

  # Sidebar layout with input and output definitions ----
  sidebarLayout(

    # Sidebar panel for inputs ----
    sidebarPanel(

      actionButton("ho", "Home"),
      actionButton("se", "Section")

                 # radioButtons(inputId="hose", label = "Choices",choices = c("Home"="ho","Section"="se"), selected = "ho")

    ),

    # Main panel for displaying outputs ----
    mainPanel(
      uiOutput("tabs")

    )
  )
)

#server.r

server = function(input, output) {

  observe({

  if(input$ho==input$se) {

  shinyjs::disable("ho")  
    shinyjs::enable("se")  

  }  else {

    shinyjs::disable("se")  
    shinyjs::enable("ho")  


  }


  })


  observe({

    print(input$ho)

    print(input$se)

    output$tabs <- renderUI(

      if (input$ho==input$se) {
    tabsetPanel(
      id="tabC",
      type = "tabs",
      tabPanel("Global"),
      tabPanel("Two Bars only here",
               plotlyOutput('bars'),
               plotlyOutput('bars2')
      )
    )

      } else {

      tabsetPanel(
        id="tabB",
        type = "tabs",
        tabPanel("Constituents Table Iris only here",
                 output$table <- DT::renderDataTable({
                   datatable(
                     iris)
                 })),
        tabPanel("Bare only here",
                 plotlyOutput("bar3")
        )
      )

      }

    )



  })

  output$bars<-renderPlotly({
    p <- plot_ly(
      x = c("giraffes", "orangutans", "monkeys"),
      y = c(20, 14, 23),
      name = "SF Zoo",
      type = "bar"
    )
  })
  output$bars2<-renderPlotly({
    p <- plot_ly(
      x = c("gir", "ora", "mon"),
      y = c(20, 14, 23),
      name = "SF Zoo",
      type = "bar"
    )
  })
  output$bar3<-renderPlotly({
    p <- plot_ly(
      x = c("gir", "ora", "mon"),
      y = c(20, 14, 23),
      name = "SF Zoo",
      type = "bar"
    )
  })

}

# Run the application 
shinyApp(ui = ui, server = server)

更新

是的，上面的示例是为两个操作按钮设置的 - 根据要求 - 它不会与两个以上的按钮一起使用。对于两个以上的操作按钮，我选择了不同的方法。见下文。这次我使用了reactiveValues，MWE 可以扩展到任意数量的操作按钮。

library(shiny)
library(shinythemes)
library(plotly)
library(DT)
library(shinyjs)

ui <- fluidPage(

  shinyjs::useShinyjs(), # get shinyjs

  sidebarLayout(


    sidebarPanel(

      actionButton("ho", "Home"),
      actionButton("sea", "Section A"),
      actionButton("seb", "Section B")


    ),

    # Main panel for displaying outputs ----
    mainPanel(
      uiOutput("tabs")

    )
  )
)

#server.r

server = function(input, output) {


  active.button <- reactiveValues(list=c(0,0,0)) 


  check <- eventReactive(c(input$ho,input$sea,input$seb),{

    active.button$listold <- active.button$list 
    active.button$list <- c(input$ho,input$sea,input$seb)

    check <- active.button$list - active.button$listold

  })


  observe({

    print(check())

    output$tabs <- renderUI(

  if (check()[[1]]==1) {

        tabsetPanel(
          id="tabHome",
          tabPanel("Home")
          )


      } else if (check()[[2]]==1) {

        tabsetPanel(
          id="tabA",
          tabPanel("Section A")
        )
      } else if (check()[[3]]==1) {

        tabsetPanel(
          id="tabB",
          tabPanel("Section B")
        )

      } else {

        tabsetPanel(
          id="tabHome",
          tabPanel("Home")
        )


      }

    )

  }

  )

}

# Run the application 
shinyApp(ui = ui, server = server)