Добавляйте динамические вкладки на блестящую панель инструментов с помощью условной панели

Я хотел бы иметь динамические вкладки для моего блестящего приложения. Я попробовал приведенный ниже код

## app.R ##
library(shiny)
library(shinydashboard)

ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(
    checkboxGroupInput("Tabs", 
                       label = h4("tabpanel"), 
                       choices = list("tabs" = "tabs"),
                       selected = NULL),
    checkboxGroupInput("moreTabs", 
                       label = h4("moretabpanel"), 
                       choices = list("moretabs" = "moretabs"),
                       selected = NULL)
  ),
  dashboardBody(
    conditionalPanel(
      condition = "input.Tabs == 'tabs'",
      tabBox(
        title = "intro",
        id= "ttabs", width = 8, height = "420px",
        tabPanel("Files", dataTableOutput("Files")),
        conditionalPanel(
          condition = "input.moreTabs == 'moretabs'",
          tabPanel("Files1", dataTableOutput("Files1"))
        )
  )
)
)
)
server <- function(input, output) { }

shinyApp(ui, server)

Однако мне не удается использовать панель вкладок динамически. Он показывает только одну вкладку, а при проверке должен показывать вторую вкладку.


r shiny shinydashboard
person Agaz Wani    schedule 13.08.2016    source источник

Ответы (1)


arrow_upward
10
arrow_downward

Вы можете динамически создать ui, как показано в примере ниже.

Пример 1. Использование RenderUI

rm(list = ls())
library(shiny)
library(shinydashboard)

ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(
    checkboxGroupInput("Tabs", label = h4("tabpanel"), choices = list("tabs" = "tabs"),selected = NULL),
    checkboxGroupInput("MoreTabs", label = h4("moretabpanel"), choices = list("moretabs" = "moretabs"),selected = NULL)
  ),
  dashboardBody(
    uiOutput("ui")
  )
)
server <- function(input, output) { 

  output$ui <- renderUI({

    check1 <- input$Tabs == "tabs"
    check2 <- input$MoreTabs == "moretabs"

    if(length(check1)==0){check1 <- F}
    if(length(check2)==0){check2 <- F}

    if(check1 && check2){
      tabBox(title = "intro",id= "ttabs", width = 8, height = "420px",
             tabPanel("Files", dataTableOutput("Files")),
             tabPanel("Files1", dataTableOutput("Files1"))
      )
    }
    else if(check1){
      tabBox(title = "intro",id= "ttabs", width = 8, height = "420px",tabPanel("Files", dataTableOutput("Files")))
    }
    else{return(NULL)}
  })
}

shinyApp(ui, server)

введите описание изображения здесь

Пример 2: использование conditionalPanel

rm(list = ls())
library(shiny)
library(shinydashboard)

ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(
    checkboxGroupInput("Tabs", label = h4("tabpanel"), choices = list("tabs" = "tabs"),selected = NULL),
    checkboxGroupInput("MoreTabs", label = h4("moretabpanel"), choices = list("moretabs" = "moretabs"),selected = NULL)
  ),
  dashboardBody(

    conditionalPanel(
      condition = "input.MoreTabs == 'moretabs' && input.Tabs == 'tabs'",
      tabBox(
        title = "intro",
        id= "ttabs", width = 8, height = "420px",
        tabPanel("Files",value=1, dataTableOutput("Filesa")),
        tabPanel("Files1",value=2, dataTableOutput("Files1a"))
      )
    ),

    conditionalPanel(
      condition = "input.Tabs == 'tabs' && input.MoreTabs != 'moretabs'",
      tabBox(
        title = "intro",
        id= "ttabs", width = 8, height = "420px",
        tabPanel("Files",value=3, dataTableOutput("Files"))
      ))  
))
server <- function(input, output) { }
shinyApp(ui, server)
person Pork Chop    schedule 13.08.2016
comment
Спасибо за ответ, но мне не интересно использовать renderUI - person Agaz Wani; 13.08.2016
comment
renderUI - способ сделать это. - person jdharrison; 13.08.2016
comment
@AaghazHussain, я определенно предпочитаю вариант renderUI, однако он может работать и с conditionalPanel, но нужно изменить value из tabPanel - person Pork Chop; 13.08.2016