I have a problem with my Shinydashboard: I created a map and i would like to show it only in a menuSubItem (TTTest1) of MenuItem "Test3". As of now, the only content that will be shown is my map and the tabBox "Legend". I assume that the sidebar I have, does not have a real functionality because even if i click on any item of the sidebar, there is no blank page - only my map and a tabBox and nothing really changes, as if it were "static".
Can anyone tell me what went wrong and where i did this (big) mistake?
library(shiny) # for shiny apps
library(leaflet) # renderLeaflet function
library(readr)
library(geojsonio)
library(shinydashboard)
sidebar <- dashboardSidebar(
sidebarMenu(
menuItem("Test1", tabName = "dashboard", icon = icon("dashboard")),
menuItem("Test2",tabName = "charts", icon = icon("bar-chart-o"),
menuSubItem("TTest1", tabName = "subitem1"),
menuSubItem("TTest2", tabName = "subitem2"),
menuSubItem("TTest3", tabName = "subitem3"),
menuSubItem("TTest4", tabName = "subitem4")),
menuItem("Test3", tabName = "choice", icon = icon("dashboard"),
menuSubItem("TTTest1", tabName = "subitem1"),
menuSubItem("TTTest2", tabName = "subitem2"),
menuSubItem("TTTest3", tabName = "subitem3"),
menuSubItem("TTTest4", tabName = "subitem4")),
menuItem("Test4", tabName = "Prod", icon = icon("dashboard"),
menuSubItem("TTTTest1", tabName = "subitem1"),
menuSubItem("TTTTest2", tabName = "subitem2"),
menuSubItem("TTTTest3", tabName = "subitem3"),
menuSubItem("TTTTest4", tabName = "subitem4"))
)
)
body <- dashboardBody(
tabItems(
# Map Output
tabItem(tabName = "dashboard",
fluidRow(
leafletOutput("myMap"),
tabBox(
title = "Legend",
id = "tabset1", height = "150px", width = "500px",
tabPanel("Explaining", "If this then that"),
tabPanel("Source", "Here you can find my data")
),
)
),
tabItem(tabName = "charts",
fluidRow(
tabBox(
title = "Legend test2",
# The id lets us use input$tabset1 on the server to find the current tab
id = "tabset2", height = "500px", width = "500px",
tabPanel("Example", "Hello"),
tabPanel("Example2", "Hi again")
),
))
)
)
u <- dashboardPage(
dashboardHeader(title = "InfoHub"),
sidebar,
body
)
s <- function(input,output){
output$myMap <- renderLeaflet({
myMap <- leaflet(options = leafletOptions(minZoom = 1)) %>%
addProviderTiles("OpenStreetMap") %>%
setView( lng = -87.567215
, lat = 41.822582
, zoom = 11 ) %>%
setMaxBounds( lng1 = -87.94011
, lat1 = 41.64454
, lng2 = -87.52414
, lat2 = 42.02304 )
bins <- c(0, 10, 20, 30, 40, 50, 60, 70, 80, 90)
pal <- colorBin("BuGn", domain = completeCPM$OBS_VALUE, bins = bins)
labels <- sprintf(
"<strong>%s</strong><br/>%g Points on a scale**strong text**",
completeCPM$sovereignt, completeCPM$OBS_VALUE
) %>% lapply(htmltools::HTML)
m %>% addPolygons(
fillColor = ~pal(OBS_VALUE),
weight = 2,
opacity = 1,
color = "white",
dashArray = "3",
fillOpacity = 0.7,
highlightOptions = highlightOptions(
weight = 5,
color = "#666",
dashArray = "",
fillOpacity = 0.7,
bringToFront = TRUE),
label = labels,
labelOptions = labelOptions(
style = list("font-weight" = "normal", padding = "3px 8px"),
textsize = "15px",
direction = "auto")) %>%
addLegend(pal = pal, values = ~OBS_VALUE,na.label = "Keine Datenquelle vorhanden", opacity = 0.7, title = NULL,
position = "bottomright")
})
}
shinyApp(u,s)```
CodePudding user response：
You aren't using tabName correctly. First, you shouldn't reuse tab names in the sidebar. Those will be clashing. A lot of your menuSubItem tabs are have repeated values. That should be fixed to something like...
sidebar <- dashboardSidebar(
sidebarMenu(
menuItem("Test1", tabName = "dashboard", icon = icon("dashboard")),
menuItem("Test2",tabName = "charts", icon = icon("bar-chart-o"),
menuSubItem("TTest1", tabName = "subitem1"),
menuSubItem("TTest2", tabName = "subitem2"),
menuSubItem("TTest3", tabName = "subitem3"),
menuSubItem("TTest4", tabName = "subitem4")),
menuItem("Test3", tabName = "choice", icon = icon("dashboard"),
menuSubItem("TTTest1", tabName = "subitem4"),
menuSubItem("TTTest2", tabName = "subitem5"),
menuSubItem("TTTest3", tabName = "subitem6"),
menuSubItem("TTTest4", tabName = "subitem7")),
menuItem("Test4", tabName = "Prod", icon = icon("dashboard"),
menuSubItem("TTTTest1", tabName = "subitem8"),
menuSubItem("TTTTest2", tabName = "subitem9"),
menuSubItem("TTTTest3", tabName = "subitem10"),
menuSubItem("TTTTest4", tabName = "subitem11"))
)
)
Notice now there are no repeated tabNames. These are what you want to use in the dashBoardBody to associate the sidebar with the body of the app.
If you want your leaflet map to appear in Test3/TTTest1, you need to use that tabName specifically. In the code chunk above, tabName = "subitem4".
body <- dashboardBody(
tabItems(
# Map Output
tabItem(tabName = "subitem4",
fluidRow(
leafletOutput("myMap"),
tabBox(
title = "Legend",
id = "tabset1", height = "150px", width = "500px",
tabPanel("Explaining", "If this then that"),
tabPanel("Source", "Here you can find my data")
),
)
),
The connection between your sidebar menu and what appears on the body of those pages is the tabName.