4

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

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)
1
  • might be better to use addDrawToolbar() to do this. I'll try to spin up an example. Commented Jan 10, 2017 at 14:34

1 Answer 1

6

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.

Example

    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)
5
  • Is there a way to access the deleting of a marker similar to input$<map_id>_draw_edited_features ? I want to delete the corresponding rows from a data.frame if a marker is deleted in the DrawToolbar?
    – needRhelp
    Commented Jan 16, 2017 at 15:00
  • sure, I have adjusted for both add and edit here github.com/timelyportfolio/leaflet/blob/master/inst/examples/…. I'll also finish up with a delete handler soon. Commented Jan 16, 2017 at 20:53
  • 1
    did a quick simple delete example github.com/timelyportfolio/leaflet/blob/master/inst/examples/… Commented Jan 17, 2017 at 20:15
  • @timelyportfolio, hi, me again. curiously, at least to me, and painfully (same), this doesnt work when lf is created in server with the regular renderLeaflet and when displayed in the ui with leafletOutput. Any idea why ? Commented Dec 8, 2017 at 18:00
  • do you have an quick code example? Most of this predates mapedit which has "solved" some of these problems. Commented Dec 9, 2017 at 13:48

Not the answer you're looking for? Browse other questions tagged or ask your own question.