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

Question

我正在开发一个 Shiny 的应用程序，它显示带有标记的传单 map 。 标记是可点击的，我收集被点击标记的 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)

Answer 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)