R Shiny with Leaflet - 单击后更改标记的颜色
R Shiny with Leaflet - change color of marker after click
我正在开发一个闪亮的应用程序,它显示带有标记的传单地图。
标记是可点击的,我收集点击标记的 ID。
但我还想更改点击标记的颜色。当标记为蓝色时,它应该变为红色标记,反之亦然。
到目前为止,我有跟踪点击标记的代码,我可以将 ID 存储在 table。
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 = ",") )
})
但是如何在点击事件中设置marker的样式呢?
编辑:
可重现的示例(跟踪点击的标记但它们的样式没有改变):
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)
我们可以使用 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。
但我还想更改点击标记的颜色。当标记为蓝色时,它应该变为红色标记,反之亦然。
到目前为止,我有跟踪点击标记的代码,我可以将 ID 存储在 table。
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 = ",") )
})
但是如何在点击事件中设置marker的样式呢?
编辑:
可重现的示例(跟踪点击的标记但它们的样式没有改变):
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)
我们可以使用 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)