I am using a conditionalPanel option to choose the tabs to show based on a selectInput.
When I select "Four" I should have four tabs including tab2 which should not be visible on the selection of "Three".
The issue is that with the selection of "Four" option the tab2 is not visible in line with others.
Is there a way to use conditionalPanel and make tab2 appear between tab1 and tab3 at the selection of "Four" and not "Three"?
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
sidebarMenu(
selectInput(
inputId="selectTabs",
label=" Choose Number of TABS", selected = NULL,
choices=c( "Four", "Three" )),
menuItem("TABS Number", tabName = "Tabs", icon = icon("object-ungroup"))
)
),
dashboardBody(
tabItem(tabName = "Tabs",
fluidRow(
column(width=3,
box(
title="Search ",
solidHeader=TRUE,
collapsible=TRUE,
width=NULL,
textInput("textSearch", " Search ", '', placeholder = "Type keyword/statement"),
submitButton("Search")
)
),
column( width=9,
tabBox(
width="100%",
tabPanel("tab1",
htmlOutput("search1")
),
conditionalPanel("input.selectTabs === 'Four'",
tabPanel("tab2",
htmlOutput("search2")
)),
tabPanel("tab3",
htmlOutput("search3")
),
tabPanel("tab4",
htmlOutput("search4")
)
)
)
)
)
)
)
server <- function(input, output) {}
shinyApp(ui, server)
As an update from the suggestion by #annhan concerning the possible duplication, here is my update code which gives me undesirable output in that I have two rows of tabapanels instead of one dynamic one.
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
sidebarMenu(
selectInput(
inputId="selectTabs",
label=" Choose Number of TABS", selected = NULL,
choices=c( "Four", "Three" )),
menuItem("TABS Number", tabName = "Tabs", icon = icon("object-ungroup"))
)
),
dashboardBody(
tabItem(tabName = "Tabs",
fluidRow(
column(width=3,
box(
title="Search ",
solidHeader=TRUE,
collapsible=TRUE,
width=NULL,
textInput("textSearch", " Search ", '', placeholder = "Type keyword/statement"),
submitButton("Search")
)
),
column( width=9,
conditionalPanel("input.selectTabs == 'Four'",
tabBox(
width="100%",
tabPanel("tab1", value=1,
htmlOutput("search1")
),
tabPanel("tab2", value=2,
htmlOutput("search2")
),
tabPanel("tab3", value=3,
htmlOutput("search3")
),
tabPanel("tab4", value=4,
htmlOutput("search4")
)
)),
conditionalPanel("input.selectTabs == 'Three' && input.selectTabs != 'Four'",
tabBox(
width="100%",
tabPanel("tab1", value=5,
htmlOutput("search1")
),
tabPanel("tab3", value=7,
htmlOutput("search3")
),
tabPanel("tab4", value=8,
htmlOutput("search4")
)
))
)))))
server <- function(input, output) {}
shinyApp(ui, server)
Related
I'm working on a shiny app with dynamic rendering. When the user uncheck the box, he must have an output with 8 wellPanel and when the box is checked, he must have two wellPanel. I used the function renderUI to generate output but when the box is unchecked, I only have 4 wellPanel instead of 8. This is what I did :
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
body <- dashboardBody(
tabItems(
tabItem(tabName = "menutab1",
checkboxInput(inputId = "my_id", "check the box", value = TRUE),
####### renderUI #####
uiOutput("results")
)
)
)
ui <- dashboardPage(
title = "test",
options = list(sidebarExpandOnHover = TRUE),
header = dashboardHeader(disable = FALSE),
sidebar = dashboardSidebar(
minified = TRUE, collapsed = TRUE,
sidebarMenu(id="mymenu",
menuItem("first", tabName = "tab1", icon = icon("fas fa-acorn"),
menuSubItem('menu 1',
tabName = 'menutab1',
icon = icon('fas fa-hand-point-right'))
)
)
),
body
)
############# SERVER ############
server <- function(input, output) {
output$results <- renderUI({
if(input$my_id){
# object 1
fluidRow(
column(6,
wellPanel(
h1("A")
),
br(),
wellPanel(
h1("B")
)
)
)
} else {
# object 2 : doesnt show, why ?
fluidRow(
column(6,
wellPanel(
h1("C")
),
br(),
wellPanel(
h1("D")
)
),
column(6,
wellPanel(
h1("E")
),
br(),
wellPanel(
h1("F")
)
)
)
# object 3 : I only got this
fluidRow(
column(6,
wellPanel(
h1("H")
),
br(),
wellPanel(
h1("I")
)
),
column(6,
wellPanel(
h1("J")
),
br(),
wellPanel(
h1("K")
)
)
)
}
})
}
############# RUN #############
shinyApp(ui = ui, server = server)
How can we fix that ?
Some help would be appreciated
The problem with your above code is, that only the last object of the else statement is returned. You can wrap both fluidRows in a tagList to get the desired output.
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
body <- dashboardBody(tabItems(tabItem(
tabName = "menutab1",
checkboxInput(inputId = "my_id", "check the box", value = TRUE),
uiOutput("results")
)))
ui <- dashboardPage(
title = "test",
options = list(sidebarExpandOnHover = TRUE),
header = dashboardHeader(disable = FALSE),
sidebar = dashboardSidebar(
minified = TRUE,
collapsed = TRUE,
sidebarMenu(
id = "mymenu",
menuItem(
"first",
tabName = "tab1",
icon = icon("fas fa-acorn"),
menuSubItem(
'menu 1',
tabName = 'menutab1',
icon = icon('fas fa-hand-point-right')
)
)
)
),
body
)
server <- function(input, output) {
output$results <- renderUI({
if (input$my_id) {
fluidRow(column(6,
wellPanel(h1("A")),
br(),
wellPanel(h1("B"))
)
)
} else {
tagList(
fluidRow(
column(6,
wellPanel(h1("C")),
br(),
wellPanel(h1("D"))),
column(6,
wellPanel(h1("E")),
br(),
wellPanel(h1("F")))
),
fluidRow(
column(6,
wellPanel(h1("H")),
br(),
wellPanel(h1("I"))),
column(6,
wellPanel(h1("J")),
br(),
wellPanel(h1("K")))
)
)
}
})
}
shinyApp(ui = ui, server = server)
I have at least 2 individual apps that I want to join in one single app. Although I was using shinyDashboard, I think that it could be a good idea to try with navbarPage.
However, I don't know if it is possible to do what I want with this new approach.
To put you in a context, this is an example of my shinyDashboard. Each tab has a sidebarPanel and mainPanel. I replicated the info in all the tabs, but the idea is that each tab has different things.
However, I was thinking to have this using navbarPage. Do you know if it is possible?
Here I attach you the code that I used for the shinyDashboard:
library(shiny)
library(shinydashboard)
library(shinyWidgets)
ui <- dashboardPage(
dashboardHeader(title = "Basic dashboard"),
## Sidebar content
dashboardSidebar(
sidebarMenu(
menuItem("Tab1", tabName = "Tab1", icon = icon("th")),
menuItem("Tab2", tabName = "Tab2", icon = icon("th")),
menuItem("Tab3", tabName = "Tab3", icon = icon("th"))
)
),
dashboardBody(
fluidRow(
tabItems(
tabItem(tabName = "Tab1",
sidebarPanel(
numericInput("num",
"Select a number",
min = 1,
value = 10),
checkboxInput("remove", "Remove...", value = FALSE),
sliderInput("slider", "slider", min = 1, max = 30, value=22)
),
mainPanel(
plotOutput("plot1")
)
),
tabItem(tabName = "Tab2",
sidebarPanel(
numericInput("num2",
"Select a number",
min = 1,
value = 10),
checkboxInput("remove2", "Remove...", value = FALSE),
sliderInput("slider2", "slider", min = 1, max = 30, value=22)
),
mainPanel(
plotOutput("plot2")
)
),
tabItem(tabName = "Tab3",
sidebarPanel(
numericInput("num3",
"Select a number",
min = 1,
value = 10),
checkboxInput("remove3", "Remove...", value = FALSE),
sliderInput("slider3", "slider", min = 1, max = 30, value=22)
),
mainPanel(
plotOutput("plot3")
)
)
)
)
)
)
server <- function(input, output, session) {
output$plot1 <- renderPlot({
plot(x=c(1,2,3,4,5,6), y=c(14,3,6,4,56,2))
})
output$plot2 <- renderPlot({
plot(x=c(1,2,3,4,5,6), y=c(14,3,6,4,56,2))
})
output$plot3 <- renderPlot({
plot(x=c(1,2,3,4,5,6), y=c(14,3,6,4,56,2))
})
}
shinyApp(ui, server)
And the code for the navbarPage approach:
library(shinythemes)
library(shiny)
ui <- fluidPage(theme = shinytheme("flatly"),
navbarPage(
collapsible = T,
fluid = T,
"",
tabPanel("Tab 1", "one"),
tabPanel("Tab 2", "two"),
tabPanel("Tab 3", "three"),
)
)
server <- function(input, output, session) {
}
shinyApp(ui, server)
Thanks very much in advance
You can do that with sidebarLayout. Here I've done it for the first tabPanel:
library(shinythemes)
library(shiny)
ui <- fluidPage(
theme = shinytheme("flatly"),
navbarPage(
title = "Your App Title",
collapsible = TRUE,
fluid = TRUE,
tabPanel(
title = "Tab 1",
sidebarLayout(
sidebarPanel = sidebarPanel(
tags$h3(
"Sidebar Content Here!"
)
),
mainPanel = mainPanel(
tags$h3(
"Main Panel Content Here!"
)
)
)
),
tabPanel(
title = "Tab 2",
"three"
),
)
)
server <- function(input, output, session) {
}
shinyApp(ui, server)
In the code below, I am creating a dynamic sidebarMenu based on the selected tab. During the initial load of this application, the sidebarMenu for both tabs is rendered even though only tab 1 is selected. In my original application, this is causing a delay in loading time as I have a lot of controls on each tab.
While application loads, is there a way to load only the sidebar controls of the active tab instead of loading sidebar controls of both the tabs?
library(shiny)
library(shinydashboard)
sidebar <- dashboardSidebar(
collapsed = FALSE,
sidebarMenu(
id = "menu_sidebar",
conditionalPanel(
condition = "input.main_tab == 'tab 1'",
selectizeInput(inputId = "t1", label = "Select by:", choices = c(as.character(30:40))),
print("Hello Tab 1")
),
conditionalPanel(
condition = "input.main_tab == 'tab 2'",
selectizeInput(inputId = "t2", label = "Select by:", choices = c(as.character(40:50))),
print("Hello Tab 2")
)
)
)
body <- dashboardBody(
fluidRow(
tabsetPanel(
id = "main_tab",
selected = "tab 1",
tabPanel(title = "tab 1", "Tab content 1"),
tabPanel(title = "tab 2", "Tab content 2")
)
)
)
shinyApp(
ui = dashboardPage(
dashboardHeader(title = "tabBoxes"),
sidebar,
body
),
server = function(input, output) {
}
)
We can use insertUI along with an observeEvent which is called only once to achive this:
library(shiny)
library(shinydashboard)
sidebar <- dashboardSidebar(
collapsed = FALSE,
sidebarMenu(
id = "menu_sidebar",
conditionalPanel(
condition = "input.main_tab == 'tab 1'",
selectizeInput(inputId = "t1", label = "Select by:", choices = c(as.character(30:40))),
div("Hello Tab 1")
))
)
body <- dashboardBody(
fluidRow(
tabsetPanel(
id = "main_tab",
selected = "tab 1",
tabPanel(title = "tab 1", "Tab content 1"),
tabPanel(title = "tab 2", "Tab content 2")
)
)
)
shinyApp(
ui = dashboardPage(
dashboardHeader(title = "tabBoxes"),
sidebar,
body
),
server = function(input, output, session) {
observeEvent(input$main_tab == 'tab 2', {
insertUI(
selector = "#menu_sidebar",
where = "afterEnd",
ui = conditionalPanel(
condition = "input.main_tab == 'tab 2'",
selectizeInput(inputId = "t2", label = "Select by:", choices = c(as.character(40:50))),
div("Hello Tab 2")
),
immediate = TRUE,
session = getDefaultReactiveDomain()
)
}, ignoreInit = TRUE, once = TRUE)
}
)
Another answer by ismirsehregal helped me solve this problem more elegantly.
The idea is taken from a previous post here.
library(shiny)
library(shinydashboard)
sidebar <- dashboardSidebar(
collapsed = FALSE,
sidebarMenu(
id = "menu_sidebar",
conditionalPanel(
condition = "input.main_tab == 'tab 1'",
selectizeInput(inputId = "t1", label = "Select by:", choices = c(as.character(30:40))),
print("Hello Tab 1"),
style = "display: none;"
),
conditionalPanel(
condition = "input.main_tab == 'tab 2'",
selectizeInput(inputId = "t2", label = "Select by:", choices = c(as.character(40:50))),
print("Hello Tab 2"),
style = "display: none;"
)
)
)
body <- dashboardBody(
fluidRow(
tabsetPanel(
id = "main_tab",
selected = "tab 1",
tabPanel(title = "tab 1", "Tab content 1"),
tabPanel(title = "tab 2", "Tab content 2")
)
)
)
shinyApp(
ui = dashboardPage(
dashboardHeader(title = "tabBoxes"),
sidebar,
body
),
server = function(input, output) {
}
)
I got a dashboard where the tabItem that shows in the dashboardBody is dependant on the menuItem selected on the dashboardMenu, like this:
library(shiny)
library(shinydashboard)
ui <- dashboardPage(dashboardHeader(title = "This works"),
dashboardSidebar(
sidebarMenu(
menuItem("item 1", tabName = "item1", icon = icon("th-list")),
menuItem("item 2", tabName = "item2", icon = icon("list-alt"))
)
),
dashboardBody(
tabItems(
tabItem(tabName = "item1",
tabsetPanel(id = "tabs1",
tabPanel("Tab1", plotOutput("1")),
tabPanel("Tab2", plotOutput("2"))
)),
tabItem(tabName = "item2",
tabsetPanel(id = "tabs2",
tabPanel("Tab3", plotOutput("3")),
tabPanel("Tab4", plotOutput("4"))
)
)
)
)
)
server <- function(input, output) {}
shinyApp(ui, server)
However, as soon as I include an input in menuItem, this response is lost:
ui <- dashboardPage(dashboardHeader(title = "This doesn't work"),
dashboardSidebar(
sidebarMenu(
menuItem("item 1", tabName = "item1", icon = icon("th-list"),
checkboxInput("check", label = "check")),
menuItem("item 2", tabName = "item2", icon = icon("list-alt"))
)
),
dashboardBody(
tabItems(
tabItem(tabName = "item1",
tabsetPanel(id = "tabs1",
tabPanel("Tab1", plotOutput("1")),
tabPanel("Tab2", plotOutput("2"))
)),
tabItem(tabName = "item2",
tabsetPanel(id = "tabs2",
tabPanel("Tab3", plotOutput("3")),
tabPanel("Tab4", plotOutput("4"))
)
)
)
)
)
server <- function(input, output) {}
shinyApp(ui, server)
Applying this answer to your example works. Here's the solution:
convertMenuItem <- function(mi,tabName) {
mi$children[[1]]$attribs['data-toggle']="tab"
mi$children[[1]]$attribs['data-value'] = tabName
mi
}
ui <- dashboardPage(dashboardHeader(title = "This works now"),
dashboardSidebar(
sidebarMenu(
convertMenuItem(menuItem("item 1", tabName = "item1", icon = icon("th-list"),
checkboxInput("check", label = "check")), tabName = "item1"),
menuItem("item 2", tabName = "item2", icon = icon("list-alt"))
)
),
dashboardBody(
tabItems(
tabItem(tabName = "item1",
tabsetPanel(id = "tabs1",
tabPanel("Tab1", plotOutput("1")),
tabPanel("Tab2", plotOutput("2"))
)),
tabItem(tabName = "item2",
tabsetPanel(id = "tabs2",
tabPanel("Tab3", plotOutput("3")),
tabPanel("Tab4", plotOutput("4"))
)
)
)
)
)
server <- function(input, output) {}
shinyApp(ui, server)
I have a shiny app in which I have a radioButtons widget with four buttons. When none of them is clicked I want the tabsetPanel "tabC" to be displayed. If "About" is selected I do not want tabsetPanel at all and if "Section A,B or C" is selected I want the tabsetPanel "tabA" to be displayed.
#ui.r
ui <- fluidPage(
theme=shinytheme("slate") ,
# App title ----
titlePanel("Tabsets"),
# Sidebar layout with input and output definitions ----
sidebarLayout(
# Sidebar panel for inputs ----
sidebarPanel(
uiOutput("rad")
),
# Main panel for displaying outputs ----
mainPanel(
uiOutput("tabers")
)
)
)
#server.r
library(shiny)
server = function(input, output) {
output$rad<-renderUI({
radioButtons("radio", label = "",
choices = list("About" = 1, "Sector A" = 2, "Sector B" = 3,"Sector C" = 4),
selected = character(0))
})
output$tabers<-renderUI({
if(input$radio=="Sector A"){
tabsetPanel(
id="tabA",
type = "tabs",
tabPanel("Constituents"),
tabPanel("Clusters" ),
tabPanel("Index")
)
}
else if(input$radio=="Sector B"){
tabsetPanel(
id="tabA",
type = "tabs",
tabPanel("Constituents"),
tabPanel("Clusters" ),
tabPanel("Index")
)
}
else if(input$radio=="Sector C"){
tabsetPanel(
id="tabA",
type = "tabs",
tabPanel("Constituents"),
tabPanel("Clusters" ),
tabPanel("Index")
)
}
else if(input$radio=="About"){
}
else{
tabsetPanel(
id="tabC",
type = "tabs",
tabPanel("Global"),
tabPanel("Performance" )
)
}
})
}
I believe since your choices have numeric values, you need to compare input$radio with a numeric value, for example: if (input$radio == 2) for Sector A.
In addition, when no radio buttons are selected, input$radio should be NULL. You could check for that at the beginning, and if NULL, show your tabC.
Please let me know if this has the desired behavior.
library(shiny)
library(shinythemes)
#ui.r
ui <- fluidPage(
theme=shinytheme("slate") ,
# App title ----
titlePanel("Tabsets"),
# Sidebar layout with input and output definitions ----
sidebarLayout(
# Sidebar panel for inputs ----
sidebarPanel(
uiOutput("rad")
),
# Main panel for displaying outputs ----
mainPanel(
uiOutput("tabers")
)
)
)
#server.r
server = function(input, output) {
output$rad<-renderUI({
radioButtons("radio", label = "",
choices = list("About" = 1, "Sector A" = 2, "Sector B" = 3,"Sector C" = 4),
selected = character(0))
})
output$tabers<-renderUI({
if(is.null(input$radio)) {
tabsetPanel(
id="tabC",
type = "tabs",
tabPanel("Global"),
tabPanel("Performance")
)
}
else if(input$radio==2){
tabsetPanel(
id="tabA",
type = "tabs",
tabPanel("Constituents"),
tabPanel("Clusters" ),
tabPanel("Index")
)
}
else if(input$radio==3){
tabsetPanel(
id="tabA",
type = "tabs",
tabPanel("Constituents"),
tabPanel("Clusters" ),
tabPanel("Index")
)
}
else if(input$radio==4){
tabsetPanel(
id="tabA",
type = "tabs",
tabPanel("Constituents"),
tabPanel("Clusters" ),
tabPanel("Index")
)
}
else if(input$radio==1){
}
# Left last else in here but should not get called as is
else{
tabsetPanel(
id="tabC",
type = "tabs",
tabPanel("Global"),
tabPanel("Performance" )
)
}
})
}
shinyApp(ui, server)
Thinking a little about your app, look at this option using some fuctions from shinydashboar package.
library(shiny)
library(shinydashboard)
library(shinythemes)
#ui.r
ui <- fluidPage(
theme=shinytheme("slate") ,
# App title ----
titlePanel("Tabsets"),
# Sidebar layout with input and output definitions ----
sidebarLayout(
# Sidebar panel for inputs ----
sidebarPanel(
sidebarMenu( id = "tab",
menuItem("Home", tabName = "home"),
menuItem("Sector A", tabName = "sect_a"),
menuItem("Sector b", tabName = "sect_b"),
menuItem("Sector c", tabName = "sect_c"),
menuItem("About", tabName = "about")
)
),
# Main panel for displaying outputs ----
mainPanel(
tabItems(
# Home tab
tabItem(
tabName = "home",
tabsetPanel(
id="tabC",
type = "tabs",
tabPanel("Global"),
tabPanel("Performance" ))
),
tabItem(
tabName = "sect_a",
tabsetPanel(
id="tabA",
type = "tabs",
tabPanel("Constituents"),
tabPanel("Clusters" ),
tabPanel("Index"))
),
tabItem(
tabName = "sect_b",
tabsetPanel(
id="tabA",
type = "tabs",
tabPanel("Constituents"),
tabPanel("Clusters" ),
tabPanel("Index"))
),
tabItem(
tabName = "sect_c",
tabsetPanel(
id="tabA",
type = "tabs",
tabPanel("Constituents"),
tabPanel("Clusters" ),
tabPanel("Index"))),
tabItem(tabName = "about")
)
)
)
)
#server.r
server = function(input, output) {
}
shinyApp(ui, server)