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)
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)
I have a shiny application in which a dataTable is displayed when the user selects Sector A from the radioButtons menu in the sidebar. The problem is that it is displayed twice. I checked it in browser mode too. Why does this happen I display the whole app here since it may be caused by the if logic of the app. renderTable() works fine so I guess there is an issue with DT
#ui.r
library(shiny)
library(shinythemes)
library(DT)
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"),
DT::dataTableOutput("table")
)
)
)
#server.r
library(shiny)
library(DT)
server = function(input, output) {
output$rad<-renderUI({
radioButtons("radio", label = "",
choices = list("Home"=1,"About" = 2, "Sector A" = 3, "Sector B" = 4,"Sector C" = 5),
selected = 1)
#selected = character(0))
})
output$tabers<-renderUI({
if(is.null(input$radio)) {
tabsetPanel(
id="tabF",
type = "tabs",
tabPanel("Global"),
tabPanel("Performance")
)
}
else if(input$radio==3){
tabsetPanel(
id="tabC",
type = "tabs",
tabPanel("Constituents",
output$table <- renderDataTable({
mtcars
})
),
tabPanel("Clusters" ),
tabPanel("Index")
)
}
else if(input$radio==4){
tabsetPanel(
id="tabD",
type = "tabs",
tabPanel("Constituents"
),
tabPanel("Clusters" ),
tabPanel("Index")
)
}
else if(input$radio==5){
tabsetPanel(
id="tabE",
type = "tabs",
tabPanel("Constituents"
),
tabPanel("Clusters" ),
tabPanel("Index")
)
}
else if(input$radio==2){
}
# Left last else in here but should not get called as is
else if(input$radio==1){
tabsetPanel(
id="tabA",
type = "tabs",
tabPanel("Global"),
tabPanel("Performance" )
)
}
})
}
It looks like renderTable does the same thing. For some reason, the output of renderDataTable({mtcars}) gets displayed twice, first through uiOutput, second through dataTableOutput() (both are in mainPanel). Commenting the line dataTableOutput("table") fixes the behavior in that it shows the table only once. Interestingly, removing the assignment like so:
else if(input$radio==3){
tabsetPanel(
id="tabC",
type = "tabs",
tabPanel("Constituents",
renderDataTable({
mtcars
})
),
tabPanel("Clusters" ),
tabPanel("Index")
)
}
also renders the table once. So it looks like when inside renderUI, renderDataTable just creates the output without requiring a dataTableOutput in the UI.
This seems to allow (for better or worse) to easily render different tables in different tabs without corresponding output entries in the UI.
else if(input$radio==3){
tabsetPanel(
id="tabC",
type = "tabs",
tabPanel("Constituents",
renderDataTable({
mtcars
})
),
tabPanel("Clusters" ),
tabPanel("Index")
)
}
else if(input$radio==4){
tabsetPanel(
id="tabD",
type = "tabs",
tabPanel("Constituents",
renderDataTable({
iris
})
),
tabPanel("Clusters" ),
tabPanel("Index")
)
}
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)
I have a tabsetPanel() and I try to hide one tabPanel() if choice is two and checkbox is on. I tried the following code to do that, however it does not work.
ui
shinyUI(
fluidPage(
titlePanel("Hello Shiny!"),
sidebarLayout(
sidebarPanel(
fluidRow(
column(5,
radioButtons("radio", label = h5("Data uploaded"),
choices = list("Aff" = 1, "Cod" = 2,
"Ill" = 3),selected = 1)
)),
checkboxInput("checkbox", "cheb", value = F)
),
mainPanel(
tabsetPanel(
tabPanel("Plot", "plot1"),
conditionalPanel(
condition = "input.radio !=2 && input.checkbox == false",
tabPanel("Summary", "summary1")
),
tabPanel("Table", "table1")
)
)
)
)
)
server
shinyServer(function(input,output,session){
})
How can I hide a tabPanel()?
You could do it with renderUI():
Create the tabpanels() in a list within the renderUI()
and conditionally add the third one:
if(input$radio == 2 & !input$checkbox)
and then return the whole tabsetPanel() with do.call(tabsetPanel, panels).
ui <- shinyUI(
fluidPage(
titlePanel("Hello Shiny!"),
sidebarLayout(
sidebarPanel(
fluidRow(
column(5,
radioButtons("radio", label = h5("Data uploaded"),
choices = list("Aff" = 1, "Cod" = 2,
"Ill" = 3),selected = 1)
)),
checkboxInput("checkbox", "cheb", value = F)
),
mainPanel(
uiOutput("summary")
)
)
)
)
server <- shinyServer(function(input,output,session){
output$summary <- renderUI({
panels <- list(
tabPanel("Plot", "plot1"),
tabPanel("Table", "table1")
)
if(input$radio == 2 & !input$checkbox) panels[[3]] <- tabPanel("Summary", "summary1")
do.call(tabsetPanel, panels)
})
})
shinyApp(ui, server)