【发布时间】:2021-12-28 12:28:18
【问题描述】:
我的 Shinydashboard 有问题:我创建了一个地图,我只想在 MenuItem“Test3”的 menuSubItem (TTTest1) 中显示它。 到目前为止,唯一会显示的内容是我的地图和 tabBox “Legend”。 我假设我拥有的侧边栏没有真正的功能,因为即使我点击侧边栏的任何项目,也没有空白页 - 只有我的地图和 tabBox,没有任何真正的变化,就好像它是“静态的” .
谁能告诉我出了什么问题以及我在哪里犯了这个(大)错误?
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)```
【问题讨论】:
标签: r shiny shinydashboard