鼠标悬停填充区域时突出显示边框 - Leaflet-R

Question

在@TimSalabim的指导下,我将边界和填充的邻域多边形分开,以便我可以使用zIndex对它们进行适当的排序.

https://lawsblog.netlify.com/post/leaflet-map/

如果我将highlightOptions()函数放在addPolygons(neighbourhood fill)函数中,我不知道如何在鼠标悬停时增加多边形的边框.

如果我将highlightOptions()函数放在addPolylines(neighbourhood border)函数中,我可以小心地将鼠标悬停在边框上,并且宽度会增加.这是我想要的行为,当我鼠标移动到邻近区域的任何部分时.

现在我已经分离了多边形的填充和边框,当我将鼠标悬停在填充区域上时,如何增加边框宽度？

# Add hood borders
  addPolylines(data = borders, 
               color = "white",
               opacity = 1, 
               weight = 2,
               options = pathOptions(pane = "hood_borders")) %>% 

 # Add hood fill
  addPolygons(data = hood_shp,
              fillColor = ~pal(be_per_cap),
              fillOpacity = 1.0,
              color = NA,
              options = pathOptions(pane = "hoods",

              # Highlight neighbourhoods upon mouseover - NOT CORRECT
              highlight = highlightOptions(
                          stroke = 4),

              # Add label info when mouseover
              label = labels,
              labelOptions = labelOptions(
                style = list("font-weight" = "normal", padding = "3px 8px"),
                textsize = "15px",
                direction = "auto")))

---

根据SeGa的建议,我修改了代码.看到这里.邻居边界不会被遮挡,边界会在悬停时扩大.但是,鼠标移开时边框不会恢复到原始宽度.这是为什么？

leaflet(options = leafletOptions(minZoom = 11, maxZoom = 16), width = "100%") %>% 
  addTiles() %>% 

  # Raster image surrounding Toronto
  addProviderTiles(providers$OpenStreetMap.BlackAndWhite) %>% 

#  Center map north of Toronto City Hall slightly zoomed in
  setView(map,
          lng = -79.384293,
          lat = 43.685, #43.653908,
          zoom = 12) %>%

  # Vector neighbourhoods
  addPolygons(data = hood_shp, 
              fillColor = ~pal(be_per_cap),
              color = NA,
              fillOpacity = 1,

              # Highlight neighbourhoods upon mouseover
              highlight = highlightOptions(
                weight = 3,
                fillOpacity = 0,
                color = "black",
                opacity = 1.0,
                bringToFront = TRUE,
                sendToBack = TRUE),  

              # # Add label info when mouseover
              label = labels,
              labelOptions = labelOptions(
              style = list("font-weight" = "normal", padding = "3px 8px"),
              textsize = "15px",
              direction = "auto")) %>%

  # Add highways
  addPolygons(data = xway,
              color = "sienna",
              weight = 1.0,
              opacity = 1.0,
              fillOpacity = 0.7) %>%

  # Add major arterial
  addPolygons(data = mart,
              color = "#737373",
              weight = 1.0,
              opacity = 1.0,
              fillOpacity = 1.0) %>%

  # Add parks
  addPolygons(data = parks,
              color = "green",
              weight = 1.0,
              opacity = 1.0,
              fillOpacity = 1.0,
              options = pathOptions(clickable = FALSE)) %>%

  # Add border
  addPolylines(data = hood_shp,
               color = "black",
               stroke = TRUE,
               opacity = 1, 
               weight = 1) %>% 

  # Add legend
  addLegend(data = hood_shp, 
            colors =c("#AA122E", "#F4AE7E", "#FEFDB7"),
            labels= c("More", "", "Less"),
            opacity = 1.0, 
            title = "B&Es",
            position = "bottomright") 

Answer 1

我不确定我是否正确理解您的问题，但如果您只想增加带有传单的多边形的边界，highlightoption 是正确的选择，但您不应该将它放在 pathOptions 中。

• 以下示例addPolygons用于带有 highlightOption的社区。在这些中，您可以定义鼠标悬停时邻居的行为。使用weight参数定义边框大小。
• 该公园还去了addPolygons但options = pathOptions(clickable = FALSE)你让他们无法点击，所以他们与鼠标事件交互不。
• 和边界走了addPolylines没有任何进一步的选项。

以下示例是您要查找的内容吗？

library(sp)

Sr1 = Polygon(cbind(c(2,4,4,1,2),c(2,3,5,4,2)))
Sr2 = Polygon(cbind(c(5,4,2,5),c(2,3,2,2)))
Srs1 = Polygons(list(Sr1), "s1")
Srs2 = Polygons(list(Sr2), "s2")
hood_shp = SpatialPolygons(list(Srs1,Srs2), 1:2)
hood_shp <- SpatialPolygonsDataFrame(hood_shp, data=data.frame(be_per_cap = 1:length(hood_shp)), match.ID = F)

parks = Polygon(cbind(c(2,3,3,1,2),c(1,2,4,3,1)))
parks = SpatialPolygons(list(Polygons(list(parks), "parks")))

xway = Polygon(cbind(c(1,5,5,1,3),c(3,5,5,3,1)))
xway = SpatialPolygons(list(Polygons(list(xway), "xway")))

library(shiny)
library(leaflet)
library(htmlwidgets)

ui <- fluidPage(
  leafletOutput("map")
)

server <- function(input, output) {
    output$map <- renderLeaflet({

      pal = colorBin("Blues", hood_shp$be_per_cap)

      leaflet(width = "100%") %>% 
      addTiles() %>% 

        # Raster image surrounding Toronto
        addProviderTiles(providers$OpenStreetMap.BlackAndWhite) %>% 

        # Vector neighbourhoods
        addPolygons(data = hood_shp, 
                    fillColor = ~pal(be_per_cap),
                    color = "transparent",
                    fillOpacity = 1,

                    # Highlight neighbourhoods upon mouseover
                    highlight = highlightOptions(
                      weight = 3,
                      fillOpacity = 0,
                      color = "black",
                      opacity = 1.0,
                      bringToFront = TRUE,
                      sendToBack = TRUE),  

                    # # Add label info when mouseover
                    label = "labels",
                    labelOptions = labelOptions(
                      style = list("font-weight" = "normal", padding = "3px 8px"),
                      textsize = "15px",
                      direction = "auto")) %>%

        # Add parks
        addPolygons(data = parks,
                    color = "green",
                    weight = 1.0,
                    opacity = 1.0,
                    fillOpacity = 1.0,
                    options = pathOptions(clickable = FALSE)) %>%

        # Add highways
        addPolygons(data = xway,
                    color = "sienna",
                    weight = 1.0,
                    opacity = 1.0,
                    fillOpacity = 0.7) %>%

        # Add border
        addPolylines(data = hood_shp,
                     color = "black",
                     stroke = TRUE,
                     opacity = 1, 
                     weight = 1) %>% 

        # Add legend
        addLegend(data = hood_shp, 
                  colors =c("#AA122E", "#F4AE7E", "#FEFDB7"),
                  labels= c("More", "", "Less"),
                  opacity = 1.0, 
                  title = "B&Es",
                  position = "bottomright")
    })
}

shinyApp(ui, server)