Reputation: 37
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)```
Upvotes: 1
Views: 320
Reputation: 1928
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 tabName
s. 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
.
Upvotes: 1