R Shiny with Leaflet - 单击后更改标记的颜色

Posted 2023-03-24

【中文标题】R Shiny with Leaflet - 单击后更改标记的颜色

【英文标题】：R Shiny with Leaflet - change color of marker after click

【发布时间】：2022-01-08 23:50:26

【问题描述】：

我正在开发一个闪亮的应用程序，它显示带有标记的传单地图。 标记是可点击的，我会收集点击标记的 ID。

但我也想更改点击标记的颜色。当标记为蓝色时，它应该变为红色标记，反之亦然。

到目前为止，我已经有了跟踪点击标记的代码，并且可以将 ID 存储在表格中。

output$mymap <- renderLeaflet(
            leaflet() %>%
                addProviderTiles("OpenStreetMap", group = "OSM",
                         options = providerTileOptions(minZoom = 4, maxZoom = 20)) %>%
                addMarkers(data = points, lng = ~X, lat = ~Y, layerId = ~id, popup = ~paste(id))
        )
        
        
        d <- c()
        values <- reactiveValues(df = data.frame(photo_ids=d))

        newEntry <- observeEvent(input$mymap_marker_click,
            clicked_id <- input$mymap_marker_click$id
            selected_photos <- values$df$photo_ids
            if( clicked_id %in% selected_photos )
                selected_photos <- selected_photos[!selected_photos %in% clicked_id]
             else 
                selected_photos <- c(selected_photos, clicked_id)
            
            #d_new <- c(values$df$photo_ids,as.numeric(clicked_id))
            values$df <- data.frame(photo_ids=selected_photos)
            updateTextInput(inputId = "selected_photos", value = paste(unlist(values$df), collapse = ",") )
        )

但是如何在点击事件中设置标记的样式呢？

编辑：

可重现的示例（点击的标记被跟踪，但它们的样式没有改变）：

    library("shiny")
    library("sf")
    library("leaflet")
    library("rgeos")
    
    
    selected_photos <- c()
    
    
  getData <- function()
    sf_poly <- "POLYGON ((7.207031 46.97463, 7.182312 46.89868, 7.267456 46.86864, 7.392426 46.85831, 7.529755 46.86864, 7.67807 46.90618, 7.683563 46.97557, 7.592926 47.03082, 7.371826 47.01584, 7.207031 46.97463))"
  
    sf_poly <- st_as_sf(readWKT(sf_poly))
  
    points <- st_as_sf(st_sample(sf_poly, 20))
    points$id <- 1:nrow(points)
    coords <- st_coordinates(points)
  
    df <- data.frame(st_drop_geometry(points), coords)
    return(df)
  
    
    
    
    ui <- fluidPage(
      
      titlePanel("Leaflet Map"),
      
      sidebarLayout(
        
        sidebarPanel(
          textInput(inputId="selected_photos", label="Selected images", value = "", placeholder = NULL)
        ),
        
        mainPanel(
          leafletOutput("mymap")
        )
      )
    )
    
    
    server <- function(input, output, session) 
      #https://groups.google.com/g/shiny-discuss/c/LWk4ZYNhsSc
      points <- getData()
      
      output$mymap <- renderLeaflet(
        leaflet() %>%
          addProviderTiles("OpenStreetMap", group = "OSM") %>%
          addMarkers(data = points, lng = ~X, lat = ~Y, layerId = ~id)
      )
      
      
      d <- c()
      values <- reactiveValues(df = data.frame(photo_ids=d))
      
      newEntry <- observeEvent(input$mymap_marker_click,
        clicked_id <- input$mymap_marker_click$id
        selected_photos <- values$df$photo_ids
        if( clicked_id %in% selected_photos )
          selected_photos <- selected_photos[!selected_photos %in% clicked_id]
         else 
          selected_photos <- c(selected_photos, clicked_id)
        
        values$df <- data.frame(photo_ids=selected_photos)
        updateTextInput(inputId = "selected_photos", session = session, value = paste(unlist(values$df), collapse = ",") )
      )
      
      
      
    
    
    
    shinyApp(ui, server)

【问题讨论】：

请提供一个可重现的例子。

@ismirsehregal 我添加了一个可重现的示例，该示例显示了如何单击点，但它们的样式不会改变

可能相关：***.com/questions/51991963/…

【参考方案1】：

我们可以使用addAwesomeMarkers 自定义图标颜色，如docs 中建议的那样，并使用leafletProxy 在点击时更改它：

library(shiny)
library(sf)
library(leaflet)
library(geojsonsf)

getData <- function()
  poly <- '"type":"FeatureCollection","features":["type":"Feature","properties":,"geometry":"type":"Polygon","coordinates":[[[7.207031249999999,46.97463048970666],[7.18231201171875,46.89867745059795],[7.267456054687499,46.86864162233212],[7.392425537109376,46.85831292242506],[7.529754638671874,46.86864162233212],[7.678070068359375,46.9061837801476],[7.683563232421874,46.97556750833867],[7.592926025390624,47.03082254778662],[7.371826171874999,47.01584377790821],[7.207031249999999,46.97463048970666]]]]'
  
  sf_poly <- geojson_sf(poly)
  points <- st_as_sf(st_sample(sf_poly, 20))
  points$id <- 1:nrow(points)
  coords <- st_coordinates(points)
  
  df <- data.frame(st_drop_geometry(points), coords)
  return(df)


ui <- fluidPage(
  titlePanel("Leaflet Map"),
  sidebarLayout(
    sidebarPanel(
      textInput(inputId="selected_photos", label="Selected images", value = "", placeholder = NULL)
    ),
    mainPanel(
      leafletOutput("mymap")
    )
  )
)

server <- function(input, output, session) 
  #https://groups.google.com/g/shiny-discuss/c/LWk4ZYNhsSc
  points <- getData()
  points$clicked <- FALSE
  RV <- reactiveValues(points = points)
  
  icons <- awesomeIcons(
    icon = 'ios-close',
    iconColor = 'white',
    library = 'ion',
    markerColor = "blue"
  )
  
  output$mymap <- renderLeaflet(
    leaflet() %>%
      #addTiles() %>%
      addProviderTiles("OpenStreetMap", group = "OSM") %>%
      addAwesomeMarkers(data = points, lng = ~X, lat = ~Y, layerId = ~id, icon = icons)
  )
  
  myLeafletProxy <- leafletProxy(mapId = "mymap", session)
  
  observeEvent(input$mymap_marker_click,
    clicked_point <- input$mymap_marker_click
    RV$points[points$id==clicked_point$id,]$clicked <- !(RV$points[points$id==clicked_point$id,]$clicked)
    
    updateTextInput(inputId = "selected_photos", value = paste(unlist(RV$points$id[which(RV$points$clicked)]), collapse = ", "))
    
    removeMarker(map = myLeafletProxy, layerId = clicked_point$id)
    addAwesomeMarkers(map = myLeafletProxy,
                      lng = clicked_point$lng,
                      lat = clicked_point$lat,
                      layerId = clicked_point$id,
                      icon = awesomeIcons(
                        icon = 'ios-close',
                        iconColor = 'white',
                        library = 'ion',
                        markerColor = ifelse(RV$points[clicked_point$id,]$clicked, yes = "red", no = "blue")
                      ))
  )


shinyApp(ui, server)

【讨论】：

太好了，非常感谢！如果点的ID不是连续的而是任意数字，可以通过如下方式访问点：RV$points[points$id==clicked_point$id,]$clicked <- !(RV$points[points$id==clicked_point$id,]$clicked)

好点，因为它概括了方法 - 我相应地更新了答案。在发布答案之前，我还考虑过以这种方式进行过滤，但第一行更具可读性 - 我还以相同的方式更新了 updateTextInput-call。就我个人而言，我会使用library(data.table) 这会大大减少代码。

非常好。在单击后（在 ifelse 语句中）添加新标记的地方也需要更新