带内容的动态标签创建

时间:2019-06-18 12:04:27

标签: r shiny

我正在尝试构建一个闪亮的应用,用户可以决定要显示多少个标签。这是我到目前为止的内容:

library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(glue)

ui <- dashboardPage(
  dashboardHeader(),

  dashboardSidebar(
    sliderInput(inputId = "slider", label = NULL, min = 1, max = 5, value = 3, step = 1)
  ),

  dashboardBody(
    fluidRow(
      box(width = 12,
          p(
            mainPanel(width = 12,
                      column(6,
                             uiOutput("reference")
                      ),
                      column(6,
                             uiOutput("comparison")
                      )
            )
            )
      )
    )
  )
)

server <- function(input, output) {

  output$reference <- renderUI({
    tabsetPanel(
    tabPanel(
      "Reference",
      h3("Reference Content"))
    )


  })

  output$comparison <- renderUI({

    req(input$slider)


    tabsetPanel(

      lapply(1:input$slider, function(i) {

      tabPanel(title = glue("Tab {i}"),
               value = h3(glue("Content {i}"))
               )

      })
    )

  })

}

shinyApp(ui = ui, server = server)

由于比较选项卡显示不正确,因此无法产生理想的结果。 我已经检查了以下两个线程: R Shiny - add tabPanel to tabsetPanel dynamically (with the use of renderUI) R Shiny dynamic tab number and input generation 但他们似乎并不能解决我的问题。是的,它们使用滑块动态创建标签,但是就我所知,它们不允许用内容填充标签。

1 个答案:

答案 0 :(得分:1)

对我有用的是lapplydo.call的组合

library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(glue)

ui <- dashboardPage(
    dashboardHeader(),

    dashboardSidebar(
        sliderInput(inputId = "slider", label = NULL, min = 1, max = 5, value = 3, step = 1)
    ),

    dashboardBody(
        fluidRow(
            box(width = 12,
                p(
                    mainPanel(width = 12,
                              column(6,
                                     uiOutput("reference")
                              ),
                              column(6,
                                     uiOutput("comparison")
                              )
                    )
                )
            )
        )
    )
)

server <- function(input, output) {

    output$reference <- renderUI({
        tabsetPanel(
            tabPanel(
                "Reference",
                h3("Reference Content"))
        )


    })


    output$comparison <- renderUI({
        req(input$slider)

            myTabs = lapply(1:input$slider, function(i) {

                tabPanel(title = glue("Tab {i}"),
                         h3(glue("Content {i}"))
                )
            })

            do.call(tabsetPanel, myTabs)

    })

}

shinyApp(ui = ui, server = server)