Shinydashboard 动态 TabPanel

Question

我有一个与我最近提出的关于动态项目符号点的问题类似的问题： ShinyDashboard Dynamic Bullet Points

但这次是关于动态标签面板。 基本上我想生成关于满足某些标准的数据的动态 tabpanels。 这是我要解决的问题的简化示例：

nba_teams <- data.frame(team = c("Bulls", "Nuggets", "Celtics", "Lakers"),
                    conference = c("Eastern", "Western", "Eastern", 
                                   "Western"),
                    player_over_30 = c("Y","N","N","Y"),
                    date_team_formed = c(1966-01-01,1967-01-01,1946-06- 
                                         06,1947-01-01))

有了这个虚拟数据，我想根据西方会议团队的数据创建两个标签面板。 然后，显示他们成立的日期以及他们是否有超过 30 岁的球员：显示一个字体真棒图标并将数据引用到他们的团队页面。

如果我要硬编码，我可以通过以下代码来完成：

library(shinydashboard)
UI <- dashboardPage(
      dashboardHeader(),
      dashboardSidebar(),
      dashboardBody(

fluidRow(
 tabBox(
 title = "Western Conference Details",
 id = "tabset2", height = "200px", width = 12,
 tabPanel("Nuggets", "Nuggets Details", 
     dateInput("date1_val", label = h3("Formation Date"), value = "1967-01- 
      01")),
 tabPanel("Lakers", "Lakers Details", uiOutput("Lakers"),icon = 
 icon("sticky-note"),
     dateInput("date1_val", label = h3("Formation Date"), value = "1947-10- 
  01"))
  ))))

server <- function(input,output,session) {

 Lakers_URL <- a("Lakers Player Detail",
              href = "https://www.nba.com/lakers")
 output$Lakers <- renderUI({
   tagList("Lakers",Lakers_URL)
 })
}
shinyApp(UI, server)

但是随着表中数据的变化，代码也必须不断更新以反映无法维护的变化。

我开始为代码的 UI 部分沿着这条路走下去，但我坚持在每次观察时都不需要它们时如何能够引用 UI 输出，即使删除了它也不会完全呈现日期信息：

UI <- dashboardPage(
    dashboardHeader(),
    dashboardSidebar(),
    dashboardBody(

      fluidRow(
        tabBox(
          title = "Western Conference Details",
          id = "tabset2", height = "200px", width = 12,
          lapply(1:nrow(nba_teams), function(x){
            if(nba_teams$conference[x]=="Western"){


return(tabPanel(nba_teams$team[x],paste(nba_teams$team[x],"Formation Date"),
                          dateInput("date1_val", label = 
h3("Formation_Date"),
                                    value = 
nba_teams$date_team_formed[x])))}})))))

关于如何进行的任何想法？ 谢谢！

Answer 1

如果您可以将 data.frame 转换为嵌套列表结构，则可以使用lapply和do.call动态生成tabPanels 。 也许这可以帮助你：

nba_teams <- list(list(Title = "Bulls", Content = list("Eastern",
                                                       dateInput("date1_val",
                                                                 label = h3("Formation Date"), 
                                                                 value = "1967-01-01"))),
                  list(Title = "Nuggets", Content = "Western"),
                  list(Title = "Celtics", Content = "Eastern"),
                  list(Title = "Lakers", Content = list("Western", 
                                                        dateInput("date1_val1", 
                                                                  label = h3("Formation Date"), 
                                                                  value = "1947-10-01"),
                                                        icon = icon("sticky-note")))
)

library(shinydashboard)
library(shiny)

UI <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(),
  dashboardBody(
    uiOutput("panels")
  )
)

server <- function(input,output,session) {

  output$panels <- renderUI({
    pan = lapply(1:length(nba_teams), function(i) 
        tabPanel(nba_teams[[i]]$Title, nba_teams[[i]]$Content))
    do.call(tabBox,pan)
  })

}
shinyApp(UI, server)