Dynamic TabPanel

shiny
#1

I have a similar question to the one that I recently asked regarding dynamic bullet points: ShinyDashboard Dynamic Bullet Points

But this time is in regards to dynamic tabpanels. Basically I want to generate dynamic tabpanels regarding data that meet certain criteria. Here is a simplified example of what I am trying to solve:

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))

With this dummy data I want to create two tabpanels based upon data for the Western conference teams. Then, to display the date that they were formed and if they have a player that is over 30: display a font awesome icon and reference the data to their team page.

If I was to hard code it I could do it by the following code:

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)
 })

But as data in the table changes the code will also have to be constantly updated to reflect changes which won't be able to maintained.

I started to go down this road for the UI portion of the code, but am stuck on how to be able to reference a UI output when they won't be needed on every observation and even with that removed it doesn't fully render the date information:

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

      fluidRow(
        tabBox(
          title = "Western Conference Details",
          id = "tabset2", height = "200px", width = 12,
          lapply(1:nrow(Model_List), 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])))})))))

Any thoughts on how to make this work? Thanks!

0 Likes