Перемещайтесь по различным панелям вкладок с помощью кнопок действий в блестящем приложении.

У меня есть блестящее приложение с 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"
                   )
                 })

r shiny action-button
person firmo23    schedule 28.08.2019    source источник

Ответы (1)


arrow_upward
1
arrow_downward

Есть ли причина, по которой вы используете два разных actionButton вместо RadioButton? Если нет, я бы предложил использовать последний, который упрощает динамическую визуализацию ваших tabsetPanels.

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)
person thmschk    schedule 28.08.2019
comment
нет, мне нужны кнопки действий. У меня было такое раньше. - person firmo23; 28.08.2019
comment
Я скорректировал ваш отредактированный ответ до 5 кнопок, но у него странное поведение - person firmo23; 28.08.2019