选项卡中带有传单的闪亮应用程序 - 偶尔出现渲染问题

Question

我创建了一个带有 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 和侧边栏的情况下重写示例）

我的代码有很大不同，特别是我有地图高度的 css，我使用 leafletProxy 和 fitBounds，除了 addMarkers 之外，我还使用 addCircleMarkers 和 addLegend。我在实际代码中注意到的另一件事可能是相关的：当发生渲染问题时，传单地图始终保留图例和标记，但圆圈标记始终消失。

我更像是一个修补匠/黑客而不是编码员，这是一个志愿者项目。我尝试以多种方式重写它，这篇文章是我尝试过的所有内容的最简单版本。我尝试的主要事情是当它检测到选项卡上的点击时，调用我的 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

为了给这篇文章提供一些背景/色彩，我正在积极重写的网站的实时开发版本位于

https://insightful.kiwi/wkt-dev/

Answer 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)

选项卡中带有传单的闪亮应用程序 - 偶尔出现渲染问题

问题描述投票：0回答：1

1个回答

最新问题

选项卡中带有传单的闪亮应用程序 - 偶尔出现渲染问题

问题描述 投票：0回答：1

1个回答

最新问题

问题描述投票：0回答：1