R 传单突出显示选项

Question

我使用以下命令突出显示 R 传单上的一行

library(leaflet)
m = leaflet() %>% addTiles(group = "OpenStreetMap")

x <- c(1,5,4,8)
y <- c(1,3,4,7)
data = sp::SpatialLines(list(sp::Lines(sp::Line(cbind(x,y)), ID="a")))

addPolylines(smoothFactor = 0.4, map = m, data=data, opacity = 0.3, weight = 2, color = "black", label = "text", popup = "text1", highlightOptions = highlightOptions(bringToFront = TRUE, opacity = 1, weight = 5, sendToBack = FALSE, color = "white"))

有没有办法确保线条保持白色，直到我点击其他地方(在另一条线上或 map 上的其他地方)？

Answer 1

以下示例显示了类似的行为。您可以单击线条并突出显示它们，当您再次单击它们时，您可以取消选择它们。

实际上，当您将鼠标悬停在线条上时，您会看到单击/未单击时高亮颜色会发生变化，因为我实际上复制了原始行并在第二次单击时再次删除了该重复项。

也许它对您的任务有帮助。您还可以使用 input$MAPID_click 在传单中包含一个用于一般 map 点击的监听器，但它也会在单击图层时触发。

.

library(shiny)
library(leaflet)

## DATA
x <- c(1,5,4,8)
y <- c(1,3,4,7)
data = sp::SpatialLines(list(
  sp::Lines(sp::Line(cbind(x,y)), ID="a"),
  sp::Lines(sp::Line(cbind(rev(x)*1.1,y)), ID="b")), 
  CRS("+proj=longlat +ellps=WGS84 +datum=WGS84 +no_defs"))

data = SpatialLinesDataFrame(data, data = data.frame(
  id = 1:length(data)), match.ID = F)

data$id_2 <- c("a","b")


## UI
ui = fluidPage(
  leafletOutput("map")
)

## SERVER
server <- shinyServer(function(input, output, session) {

  polylines <- reactiveValues(geom = data)
  clicklist <- reactiveValues(ids = vector())

  output$map <- renderLeaflet({

    mapl <- leaflet(options = leafletOptions(doubleClickZoom= FALSE)) %>% 
      addTiles() %>% 
      addPolylines(data = polylines$geom, smoothFactor = 10, opacity = 1,
                   layerId = as.character(polylines$geom$id_2),
                   color = "blue",
                   highlightOptions = highlightOptions(color = "white",
                                      weight = 5, bringToFront = F, opacity = 1)
                   )
    mapl
  })

  observeEvent(input$map_shape_click, {

    # Leaflet Proxy
    proxy <- leafletProxy("map")

    # Get Shape Input Click
    click <- input$map_shape_click

    # Store click IDS in reactiveValue
    clicklist$ids <- c(clicklist$ids, click$id)

    # Filter Lines based on ID_2 in Stored Clicks
    sel_lines <- polylines$geom[as.character(polylines$geom$id_2) %in% clicklist$ids, ]

    # If Clicked-ID is already known
    if (click$id %in% sel_lines$id) {

      # Get ID_2 of clicked line
      nameMatch <- as.character(sel_lines@data$id_2)[as.character(sel_lines@data$id) == click$id]

      ## Filter Stored clicks for matching ID_2 in actual click
      clicklist$ids <- clicklist$ids[!clicklist$ids %in% click$id]

      ## Remove ID_2 from Stored Clicks
      clicklist$ids <- clicklist$ids[!clicklist$ids %in% nameMatch]

      # Remove layer based on clicked-ID
      proxy %>% removeShape(layerId = click$id)

    } else { 

      # Add Filtered Lines
      proxy %>% addPolylines(data = sel_lines, smoothFactor = 10,
                             layerId = as.character(sel_lines@data$id),
                             color="red", weight=5,opacity=1, 
                             highlightOptions = highlightOptions(color = "green",
                                                                 weight = 5, bringToFront = F, opacity = 1))
    }

  })
})

shinyApp(ui, server)