在传单闪亮中拖动标记后如何更新坐标? [英] How to update coordinates after dragging a marker in leaflet shiny?
问题描述
我想要一个应用程序,它会在点击时生成新点,类似于这里:R传单如何点击地图并添加一个圈子
I want to have an app, which generates new points on click, similar to here: R leaflet how to click on map and add a circle
但是标记应该是可拖动的,并且当拖动时,坐标应该会更新,显示在数据表中.我通过 mouseout 事件实现了这一点.我找到了这个解决方案,但是如果我设置两个点,两个点都将具有相同的坐标(从第二个点开始),并且只有在触发 mouseout 时才会刷新.
But the markers should be draggable and when dragged, the coordinates should be updated, shown in the dataTable. I have achieved this with a mouseout event. I found this solution, but if I set two points both will have the same coordinates (from the second point) and only will be refreshed, when mouseout is triggered.
library(shiny)
library(leaflet)
df <- data.frame(longitude = 10.5, latitude = 48)
ui <- fluidPage(
navbarPage("Title",
tabPanel("Map",
mainPanel(leafletOutput("map", width = "100%", height = "700")
)),
tabPanel("Data", dataTableOutput("table"))
)
)
server <- function(input, output) {
output$map <- renderLeaflet({
leaflet() %>% addTiles()
})
df_r <- reactiveValues(new_data = df)
# reactive list with id of added markers
clicked_markers <- reactiveValues(clickedMarker = NULL)
observeEvent(input$map_click, {
click <- input$map_click
click_lat <- click$lat
click_long <- click$lng
clicked_markers$clickedMarker <- c(clicked_markers$clickedMarker, 1)
id <- length(clicked_markers$clickedMarker)
# Add the marker to the map
leafletProxy('map') %>%
addMarkers(lng = click_long, lat = click_lat, group = 'new_circles',
options = markerOptions(draggable = TRUE), layerId = id)
# add new point to dataframe
df_r$new_data <- rbind(rep(NA, ncol(df)), df_r$new_data)
df_r$new_data$longitude[1] <- click_long
df_r$new_data$latitude[1] <- click_lat
})
# update coordinates of marker on mouseout
# how do I select the right row in the dataframe? layerId?
observeEvent(input$map_marker_mouseout,{
click_marker <- input$map_marker_mouseout
id <- input$map_marker_mouseout$id
if(click_marker$lng != df_r$new_data$longitude[id] | click_marker$lat != df_r$new_data$latitude[id]){ # why is this always true??
df_r$new_data$longitude[id] <- click_marker$lng
df_r$new_data$latitude[id] <- click_marker$lat
}
})
output$table <- renderDataTable({df_r$new_data})
}
shinyApp(ui = ui, server = server)
推荐答案
我找到了一些时间来组装我在评论中建议的方法的示例.我试图内联评论.如果有任何需要进一步澄清的地方,请告诉我.我通常会使用 purrr
,但我避免删除额外的依赖项和额外的必需知识.
I found some time to assemble an example of the approach I suggested in my comment. I tried to comment inline. Please let me know if anything requires additional clarification. I normally would use purrr
, but I avoided to remove extra dependencies and extra required knowledge.
library(leaflet)
library(leaflet.extras)
library(shiny)
lf <- leaflet() %>%
addTiles() %>%
addDrawToolbar(editOptions = editToolbarOptions(edit=TRUE))
# kind of ugly but do in global for now so we can see
# what is happening
drawn <- list()
shinyApp(
lf,
function(input, output, session) {
observeEvent(input$undefined_draw_new_feature, {
# we can clean this up
drawn <<- c(drawn, list(input$undefined_draw_new_feature))
})
observeEvent(input$undefined_draw_edited_features, {
edited <<- input$undefined_draw_edited_features
# find the edited features and update drawn
# start by getting the leaflet ids to do the match
ids <- unlist(lapply(drawn, function(x){x$properties$`_leaflet_id`}))
# now modify drawn to match edited
map(edited$features, function(x){
loc <- match(x$properties$`_leaflet_id`, ids)
drawn[loc] <<- list(x)
})
})
}
)
# after you close the Shiny app
# you should have a drawn with all features drawn and modified
# we should also have an edited to confirm actions
str(drawn, max.level=2)
str(edited, max.level=3)
这篇关于在传单闪亮中拖动标记后如何更新坐标?的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!