我创建了一个带有 page_navbar 和多个菜单选项的闪亮应用程序。一种选择是“密度图”,基本上是带有 addCircleMarkers 的传单。我想比较不同时间段的密度图,因此我创建了一个包含两个选项卡的选项卡集,每个选项卡都有一个传单,显示相同物种、不同时间段的数据。
当您单击“密度图”菜单选项并使用该功能时,它会按预期工作。但是,如果您随后单击离开到另一个主菜单选项,然后单击返回密度图 - 当您单击 单击离开时隐藏的选项卡时,传单地图将无法正确显示。至少,这看起来像是某种程度的灰色区域,地图未居中。
此代码允许您重现与我所描述的类似的内容。
library(shiny)
library(leaflet)
library(bslib)
ui <- tagList(
page_navbar(
id = "nav",
title = "Leaflet Maps in Tabs",
sidebar = sidebar(
id = "global_sidebar",
nav_panel("Placeholder")
),
# Home tab
nav_panel("Home",
p("Welcome to the Home Page!")
),
# Maps tab with tabset
nav_panel("Maps",
tabsetPanel(
id = "map_tabs",
tabPanel("Current",
leafletOutput("current_map")
),
tabPanel("Previous",
leafletOutput("previous_map")
)
)
)
)
)
server <- function(input, output, session) {
output$current_map <- renderLeaflet({
current_markers <- data.frame(
lat = c(37.7749, 34.0522),
lng = c(-122.4194, -118.2437)
)
leaflet() %>%
addTiles() %>%
addMarkers(
data = current_markers,
lng = ~lng,
lat = ~lat,
popup = ~paste("Location:", lat, lng)
)
})
output$previous_map <- renderLeaflet({
previous_markers <- data.frame(
lat = c(40.7128, 42.3601),
lng = c(-74.0060, -71.0589)
)
leaflet() %>%
addTiles() %>%
addMarkers(
data = previous_markers,
lng = ~lng,
lat = ~lat,
popup = ~paste("Location:", lat, lng)
)
})
}
shinyApp(ui = ui, server = server)
如果运行此代码,则:
您可以在不使用侧边栏切换的情况下进行复制(并在没有 bslib 和侧边栏的情况下重写示例)
我更像是一个修补匠/黑客而不是编码员,这是一个志愿者项目。我尝试以多种方式重写它,这篇文章是我尝试过的所有内容的最简单版本。我尝试的主要事情是当它检测到选项卡上的点击时,调用我的 udpate_密度_map() 函数,该函数调用 leafletProxy 来更新地图。
我是否应该重新考虑尝试制作传单标签,或者是否可以解决我遇到的问题?
使用 Chrome 版本 130.0.6723.70(官方版本)(64 位)和 Edge 版本 130.0.2849.52(官方版本)(64 位)在 Windows 11 23H2 上进行测试。 R 4.4.1,传单2.2.2,闪亮1.9.1
为了给这篇文章提供一些背景/色彩,我正在积极重写的网站的实时开发版本位于
传单标记在闪亮的 tabsetPanel 中消失(在移动设备上时),以在选项卡开关上呈现输出。选项卡开关上的渲染有点不和谐,但可靠性胜过美观差异。
很高兴那些有更多经验的人插话或提供替代方案。
library(shiny)
library(leaflet)
library(bslib)
ui <- tagList(
page_navbar(
id = "nav",
title = "Leaflet Maps in Tabs",
sidebar = sidebar(
id = "global_sidebar",
nav_panel("Placeholder")
),
# Home tab
nav_panel("Home",
p("Welcome to the Home Page!")
),
# Maps tab with tabset
nav_panel("Maps",
tabsetPanel(
id = "map_tabs",
tabPanel(
value = "current",
"Current",
leafletOutput("current_map")
),
tabPanel(
value = "previous",
"Previous",
leafletOutput("previous_map")
)
)
)
)
)
server <- function(input, output, session) {
current_markers <- data.frame(
lat = c(37.7749, 34.0522),
lng = c(-122.4194, -118.2437)
)
previous_markers <- data.frame(
lat = c(40.7128, 42.3601),
lng = c(-74.0060, -71.0589)
)
observeEvent(input$map_tabs, {
message("observeEvent detected change in tabs")
selected_tab <- input$map_tabs
if (selected_tab == "current") {
message("observeEvent rendering output$current_map")
output$current_map <- renderLeaflet({
leaflet() %>%
addTiles() %>%
addMarkers(
data = current_markers,
lng = ~lng,
lat = ~lat,
popup = ~paste("Location:", lat, lng)
)
})
}
if (selected_tab == "previous") {
message("observeEvent rendering output$previous_map")
output$previous_map <- renderLeaflet({
leaflet() %>%
addTiles() %>%
addMarkers(
data = previous_markers,
lng = ~lng,
lat = ~lat,
popup = ~paste("Location:", lat, lng)
)
})
}
})
}
shinyApp(ui = ui, server = server)