rshinyshinydashboard
R Shiny renderMenu unexpected behavior
I'm coming back to R after a more than two years break, and it's not easy.
I've created an interface thanks to shinydashboard package, including two different menus in the sidebar: one short and one extended. The extended menu should display when you click on the "Country" tab, but it opens very fast and then returns to short menu, and I don't understand why. The menus are rendered from the server side. Thank you very much for any help.
This is the ui code :
library(dplyr)
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(
title = "2019 CENSUS",
titleWidth = 500), # f. de dashboardHeader
dashboardSidebar(#Sidebar contents
sidebarMenu(id = "Menu1",
sidebarMenuOutput("Menu"))
), # closes dashboardSidebar
#### BODY CONTENTS #####
dashboardBody(
# Title
tags$head(tags$style(HTML('
.main-header .logo {
font-family: "Georgia", Times, "Times New Roman", serif;
font-weight: bold;
font-size: 16px;
}
'))), # closes tags$head(tags$style(HTML('
tabItems(
# Geo levels tab contents
tabItem(tabName = "levels",
fluidRow(
box(width = 12, background = "light-blue",title = "Welcome", "Please choose a geo level from the three available then click on the 'Home datas' tab") # closes box
) # closes fluidRow
), # closes tabItem
# Country level tab contents
tabItem(tabName = "country",
fluidRow(
box(title = "Country level : please, click on the 'Home datas' tab to view datas", width = 12, background = "olive") # closes box
) # closes fluidRow
), # closes tabItem
# Counties tab contents
tabItem(tabName = "counties",
fluidRow(
box(title = "Counties level", width = 3, solidHeader = TRUE, status = "primary",
checkboxGroupInput("dynamic_provinces", label = "", c("North","South","Islands"))) # closes box
), # closes fluidRow
fluidRow(
box(title = "North county", width = 9, background = "light-blue"), # closes box
br()
), # closes fluidRow
fluidRow(
box(title = "South county", width = 9, background = "orange"), # closes box
br()
), # closes fluidRow
fluidRow(
box(title = "Islands county", width = 9, background = "olive"), # closes box
) # closes fluidRow
) # closes tabItem
) # closes tabItems
) # closes dashboardBody
) # closes dashboardPage
And the server code :
shinyServer(function(input, output, session) {
# Initialize reactive values
rv10 <- reactiveValues(selection = numeric())
rv10$selection <- 0 # extended/short menu reactive value : extended menu if = 1/ short menu if = 0
#### FOCUS ON THE WELCOME TAB ####
updateTabItems(session, "Menu1", "welcome")
############## SETTING MENU DEPENDING ON THE VALUE OF rv10$selection ################
output$Menu <- renderMenu({
if (rv10$selection == 1) { # extended/short menu reactive value : extended menu if = 1/ short menu if = 0
sidebarMenu(# Short menu
menuItem(strong("Geo levels"), tabName = "levels", icon = icon("arrow-down"),selected = TRUE),
menuSubItem("Country", tabName = "country", icon = icon("globe-americas")),
menuSubItem("Counties", tabName = "counties", icon = icon("parking")),
menuItem(strong("Home datas"), tabName = "home_datas", icon = icon("home"),
menuSubItem("Home data 1", tabName = "home_1", icon = icon("home")),
menuSubItem("Home data 2", tabName = "home_2", icon = icon("home"))),
menuItem(strong("Quit"), tabName = "quit", icon = icon("remove"))
) # closes sidebarMenu
} # closes if
else {
sidebarMenu(# Extended menu
menuItem(strong("Geo levels"), tabName = "levels", icon = icon("arrow-down"),selected = TRUE),
menuSubItem("Country", tabName = "country", icon = icon("globe-americas")),
menuSubItem("Counties", tabName = "counties", icon = icon("parking")),
menuItem(strong("Quit"), tabName = "quit", icon = icon("remove"))
) # closes sidebarMenu
} # closes else
}) # closes output$Menu <- renderMenu({
#### OBSERVEEVENT #####
observeEvent(input$Menu1, {
# If click on the "Geo levels" tab -> short menu
if (input$Menu1 == "levels"){
rv10$selection <- 0 # rv10$selection = 0 -> displaying the short menu
print(paste("rv10$selection value =", rv10$selection)) # displaying the value of rv10$selection
}
# If click on the "Country" tab -> extended menu
if(input$Menu1 == "country"){
rv10$selection <- 1 # rv10$selection = 1 -> displaying the extended menu
print(paste("rv10$selection value =", rv10$selection))
}
# If click on the "counties" tab -> short menu
if(input$Menu1 == "counties"){
rv10$selection <- 0 # rv10$selection = 0 -> displaying the short menu
print(paste("rv10$selection value =", rv10$selection))
}
#### CLOSING THE APP ####
if (input$Menu1 == "quit"){
print("Quit")
stopApp()}
}) # closes ObserveEvent(input$Menu1
}) # closes shinyServer(function(input, output, session) {
Thank you very much for your help.
Solution
Be careful with your closing brackets. menuSubItem() is placed inside a menuItem().
Incorrect:
sidebarMenu(# Short menu
menuItem(strong("Geo levels"), tabName = "levels", icon = icon("arrow-down"),selected = TRUE),
menuSubItem("Country", tabName = "country", icon = icon("globe-americas")),
menuSubItem("Counties", tabName = "counties", icon = icon("parking")),
menuItem(strong("Home datas"), tabName = "home_datas", icon = icon("home"),
menuSubItem("Home data 1", tabName = "home_1", icon = icon("home")),
menuSubItem("Home data 2", tabName = "home_2", icon = icon("home"))),
menuItem(strong("Quit"), tabName = "quit", icon = icon("remove"))
) # closes sidebarMenu
Correct version:
sidebarMenu(# Short menu
menuItem(strong("Geo levels"), tabName = "levels", icon = icon("arrow-down"),selected = TRUE,
menuSubItem("Country", tabName = "country", icon = icon("globe-americas")),
menuSubItem("Counties", tabName = "counties", icon = icon("parking"))),
menuItem(strong("Home datas"), tabName = "home_datas", icon = icon("home"),
menuSubItem("Home data 1", tabName = "home_1", icon = icon("home")),
menuSubItem("Home data 2", tabName = "home_2", icon = icon("home"))),
menuItem(strong("Quit"), tabName = "quit", icon = icon("remove"))
All I've done is remove the closing bracket at the end of the first menuItem() and placed it at the end of the second menuSubItem()
Full server code:
server <- function(input, output, session) {
# Initialize reactive values
rv10 <- reactiveValues(selection = numeric())
rv10$selection <- 0 # extended/short menu reactive value : extended menu if = 1/ short menu if = 0
#### FOCUS ON THE WELCOME TAB ####
updateTabItems(session, "Menu1", "welcome")
############## SETTING MENU DEPENDING ON THE VALUE OF rv10$selection ################
output$Menu <- renderMenu({
if (rv10$selection == 1) { # extended/short menu reactive value : extended menu if = 1/ short menu if = 0
sidebarMenu(# Short menu
menuItem(strong("Geo levels"), tabName = "levels", icon = icon("arrow-down"),selected = TRUE,
menuSubItem("Country", tabName = "country", icon = icon("globe-americas")),
menuSubItem("Counties", tabName = "counties", icon = icon("parking")),
startExpanded = TRUE
),
menuItem(strong("Home datas"), tabName = "home_datas", icon = icon("home"),
menuSubItem("Home data 1", tabName = "home_1", icon = icon("home")),
menuSubItem("Home data 2", tabName = "home_2", icon = icon("home")),
startExpanded = TRUE
),
menuItem(strong("Quit"), tabName = "quit", icon = icon("remove"))
) # closes sidebarMenu
} # closes if
else {
sidebarMenu(# Extended menu
menuItem(strong("Geo levels"), tabName = "levels", icon = icon("arrow-down"),selected = TRUE),
menuSubItem("Country", tabName = "country", icon = icon("globe-americas")),
menuSubItem("Counties", tabName = "counties", icon = icon("parking")),
menuItem(strong("Quit"), tabName = "quit", icon = icon("remove"))
) # closes sidebarMenu
} # closes else
}) # closes output$Menu <- renderMenu({
#### OBSERVEEVENT #####
observeEvent(input$Menu1, {
# If click on the "Geo levels" tab -> short menu
if (input$Menu1 == "levels"){
rv10$selection <- 0 # rv10$selection = 0 -> displaying the short menu
print(paste("rv10$selection value =", rv10$selection)) # displaying the value of rv10$selection
}
# If click on the "Country" tab -> extended menu
if(input$Menu1 == "country"){
rv10$selection <- 1 # rv10$selection = 1 -> displaying the extended menu
print(paste("rv10$selection value =", rv10$selection))
}
# If click on the "counties" tab -> short menu
if(input$Menu1 == "counties"){
rv10$selection <- 0 # rv10$selection = 0 -> displaying the short menu
print(paste("rv10$selection value =", rv10$selection))
}
#### CLOSING THE APP ####
if (input$Menu1 == "quit"){
print("Quit")
stopApp()}
}) # closes ObserveEvent(input$Menu1
} # closes shinyServer(function(input, output, session) {
Then run with:
shinyApp(ui, server)
- Determining as to whether the function call is stored in a variable
- How to increase resolution of ggplots without using ggsave in officer?
- How to apply a function within a for loop for a set of existing variables of a predifined structure in R?
- How to change the number of decimal places of the mean in a data frame
- Forestplot in R superscript in tabletext matrix
- Converting colnames from character to numeric when extracting them from a dataframe
- With different seeds can Random States repeat in R
- How to Stack Painted Phylogenetic Trees in R Like ggdensitree but with Colored Regimes
- How to import/rbind multiple files with different indexed columns?
- Pivot wider in R return list instead of data frame
- R workspace doesn't load anything in Visual Studio Code
- Search for multiple occurrences of substring within string
- Looking for faster way to implement logSumExp across multidimensional array
- How to get \bm{} to work in an R markdown (to HTML) file?
- Leaving a space in geom_bar with stat='bin', position='dodge' and zeroes
- Where are the 1st stage F statistics located in a "fixest" object?
- Collapsing data per family
- How to set default template for new ".R" files in rstudio
- Adding two-way fixed effects for zero inflated Poisson model
- How to Move R Code and Output to the Right in a Quarto PDF Document?
- What does runif() mean when used inside if_else()?
- Remove columns from dataframe where ALL values are NA
- How to pass unquoted argument to filter() within user defined function
- Optimizing the distribution of random integers across data frame rows
- R dplyr conditional join with "join_by" not working
- How to hide a reappearing hover label for a trace in R-Plotly within Shiny?
- Estimating non-monotonic bi-exponential curve fit
- Problem minimising a function using L-BFGS-B method in R?
- trying to obtain TRUE/FALSE response to the question "is argument name x valid for function y?"
- Retrieve whole lyrics from URL