r - 鼠标悬停填充区域时突出显示边框 - 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 的建议，我修改了代码。见 here .邻域边界不会被遮挡，并且边界会在悬停时扩展。但是，鼠标移开时边框不会恢复到其原始宽度。这是为什么？

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)