Question

对于最近的动态项目要点，我有一个与我最近问过的问题类似的问题：ShinyDashboard Dynamic Bullet Points

但这一次是关于动态选项卡的。基本上，我想针对符合特定条件的数据生成动态的选项卡。这是我要解决的问题的简化示例：

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输出，即使删除了它也不需要完全呈现日期信息：

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转换为嵌套列表结构，则可以使用tabPanels和lapply动态生成do.call。也许这可以帮助您：

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)

Shinydashboard动态TabPanel

1 个答案: