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!