Выделите границы, когда область заливки мыши - листок-R

Следуя указаниям @TimSalabim, я разделил границы и заполнил мои соседние многоугольники, чтобы я мог упорядочить их соответствующим образом с помощью zIndex.

Если я addPolygons(neighbourhood fill) функцию highlightOptions() функцию addPolygons(neighbourhood fill), я не знаю, как увеличить границу полигона при addPolygons(neighbourhood fill) мыши.

Если я addPolylines(neighbourhood border) функцию highlightOptions() функцию addPolylines(neighbourhood border) я могу addPolylines(neighbourhood border) мышь только по границам, а ширина увеличивается. Это поведение, которое я хочу, когда я курсирую над любой частью района.

Теперь, когда я разделял заливку и границы полигонов, как увеличить ширину границы при наведении мыши на область заполнения?

Принимая то, что рекомендовал SeGa, я изменил код. См. Здесь. Границы соседства не затенены, и граница расширяется при наведении. Однако граница не возвращается к исходной ширине с помощью мыши. Это почему?

Ответы

Ответ 1

Я не уверен, правильно ли я понимаю вашу проблему, но если вы хотите увеличить границы многоугольника с помощью листовки, вы можете выбрать нужный вариант, но вы не должны размещать его внутри pathOptions.

Следующий пример использует addPolygons для neighboorhoods с highlightOption. Внутри них вы определяете поведение соседей при наведении мыши. С аргументом weight вы определяете размер границы.
Парки также addPolygons в 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)