I am trying to use conditions to show or hide selectinputs in a R shiny app based if the tab is available in the UI or not. So on tabpanel with title product use then all the drop downs under product category should be seen else only the first dropdown under product category should be visible.
Below is what I am doing but not getting the condition to work:
# This is the server logic for a Shiny web application.
# You can find out more about building applications with Shiny here:
#
# http://shiny.rstudio.com
#
library(shiny)
library(shinydashboard)
library(shinyBS)
library(knitr)
library(kableExtra)
library(shiny)
library(shinythemes)
ui <- dashboardPage(
dashboardHeader(disable = F, title = "PATH Study"),
dashboardSidebar(
selectInput(
"wave",
h4("Wave"),
choices = list(
"Wave 1" = 1
),
selected = 1
),
sidebarMenu(
menuItem(
"Population Filter",
selectInput(
"ethnicity",
h4("Ethnicity"),
choices = list(
"Hispanic" = 1,
"Asian" = 2,
"White" = 3,
"African American" = 4
),
selected = 1
),
selectInput(
"age",
h4("Age Group"),
choices = list(
"Total" = 1,
"Youth(12-17)" = 2,
"Young Adult (18-24)" = 3,
"Adult (25+)" = 4
),
selected = 1
),
selectInput(
"category",
h4("Gender"),
choices = list(
"Total" = 1,
"Male" = 2,
"Female" = 3
),
selected = 1
)
)
),
conditionalPanel(
condition = "dashboardBody(tabPanel(title == 'product_use'))",
sidebarMenu(menuItem(
"Product Category",
selectInput(
"category",
h4("Category"),
choices = list(
"Total Cigars" = 1,
"Cigarillo" = 2,
"Cigarette" = 3,
"E-Vapor" = 4
),
selected = 1
),
selectInput(
"flavor",
h4("Flavor"),
choices = list(
"Total" = 1,
"Flavored" = 2,
"Non-Flavored" = 3
),
selected = 1
),
selectInput(
"use_level",
h4("User Level"),
choices = list(
"Total" = 1,
"Experimental" = 2,
"Established" = 3,
"No Tobacco Use" = 4
),
selected = 1
)
))
)
),
#S dashboardPage(header = dashboardHeader(), sidebar = dashboardSidebar(),body,title = NUll, skin = "yellow"),
dashboardBody(box(
width = 12,
tabBox(
width = 12,
id = "tabBox_next_previous",
tabPanel("Initiation",
fluidRow(
box(
title = "Wave 1 Ever Tried and % 1st Product Flavored",
width = 5,
solidHeader = TRUE,
status = "primary",
tableOutput("smoke"),
collapsible = F,
bsTooltip(
"bins",
"The wait times will be broken into this many equally spaced bins",
"right",
options = list(container = "body")
)
)
)),
tabPanel("Cessation", p("This is tab 3")),
tabPanel("product_use", p("This is tab 4")),
tags$script(
"
$('body').mouseover(function() {
list_tabs=[];
$('#tabBox_next_previous li a').each(function(){
list_tabs.push($(this).html())
});
Shiny.onInputChange('List_of_tab', list_tabs);})
"
)
),
uiOutput("Next_Previous")
))
)
server <- function(input, output, session) {
output$Next_Previous = renderUI({
tab_list = input$List_of_tab[-length(input$List_of_tab)]
nb_tab = length(tab_list)
if (which(tab_list == input$tabBox_next_previous) == nb_tab)
column(1, offset = 1, Previous_Button)
else if (which(tab_list == input$tabBox_next_previous) == 1)
column(1, offset = 10, Next_Button)
else
div(column(1, offset = 1, Previous_Button),
column(1, offset = 8, Next_Button))
})
output$smoke <-
# renderTable({
# pct_ever_user(data_selector(wave = 1, youth = FALSE), type = "SM")
# })
function() {
pct_ever_user(data_selector(wave = 1, youth = FALSE), type = "SM")[, c("variable", "mean", "sum_wts", "se")] %>%
# rename(pct_ever_user(data_selector(wave = 1, youth = FALSE), type = "SM"), c("mean"="N", "sum_wts"="Weighted N"))%>%
knitr::kable("html") %>%
kable_styling("striped", full_width = F)
}
output$table2 <- function() {
# req(input$mpg)
table2 %>%
knitr::kable("html") %>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed", "responsive"))
}
output$consumption <- function() {
# req(input$mpg)
consumption %>%
knitr::kable("html") %>%
kable_styling("striped", full_width = F)
}
output$consumption_flav <- function() {
# req(input$mpg)
consumption_flav %>%
knitr::kable("html") %>%
kable_styling("striped", full_width = F)
}
}
shinyApp(ui = ui, server = server)