RShiny Leaflet- Getting data from measure tool

user_6150511 0
Viewed 571

I'm trying to get the results (area specifically) of when a user uses the measure tool on an RShiny Leaflet map. According to the leaflet-measure documentation, you can subscribe to 2 events on the leaflet map named measurestart and measurefinish. I need to subscribe to these events and get the result data that the events give but I don't know how.

I have tried many different ways to subscribe to the event, but none of them are getting triggered by the map.

Here is some code that feels like it's the closest to working:

observeEvent(input$map1_measurefinish, {
    print("user finished measurement")
})

or

observeEvent(input$measurefinish, {
    print("user finished measurement")
})

The code for the leaflet in my server section looks like this:

output$map1 <-renderLeaflet({
      m<-leaflet() %>%
      addProviderTiles('Esri.WorldImagery') %>%...
# there's more code here but I don't think its relevant for the issue

What do I need to do to 1. Properly subscribe to the event to detect when a measurement is finished and 2. receive the output data to do things with in the observer method?

Edit: Solution (as given by @NicE)

The changes I made to my code to make it work:

Inside the leaflet added the marked code:

output$map1 <-renderLeaflet({
     m<-leaflet() %>%
     addMeasure() %>%
     # Start
     htmlwidgets::onRender("
        function(el, x) {
          var myMap = this;
          myMap.on('measurefinish',
          function (e) {
            Shiny.onInputChange('selectedArea', e.area);
            Shiny.onInputChange('inputtedCoordinates', e.lastCoord);
          })
        }")
     # End

And additionally added an observer (will do more exciting things than printing):

observeEvent(input$selectedArea, {
    print(paste0("area received:", input$selectedArea))
})
leaflet shiny r
2 Answers

You can leverage the onRender function to add listeners to plugin events. For example you could try:

leaflet() %>% addTiles() %>%
      fitBounds(-73.9, 40.75, -73.95,40.8) %>%
      addMeasure() %>%
      htmlwidgets::onRender("
        function(el, x) {
          var myMap = this;
          myMap.on('measurefinish',
            function (e) {
              Shiny.onInputChange('selectedArea', e.area);
            })
        }")

This adds a listener on measurefinish, and passes the area to the selectedArea shiny input. You can change e.area to any fields mentionned here.

Here is a MWE:

library(leaflet)
library(shiny)


ui <- fluidPage(
  leafletOutput("mymap"),
  br(),
  textOutput("areaText")
)

server <- function(input, output, session) {

  output$mymap <- renderLeaflet({
    leaflet() %>% addTiles() %>%
      fitBounds(-73.9, 40.75, -73.95,40.8) %>%
      addMeasure() %>%
      htmlwidgets::onRender("
        function(el, x) {
          var myMap = this;
          myMap.on('measurefinish',
            function (e) {
              Shiny.onInputChange('selectedArea', e.area);
            })
        }")
    })

  output$areaText <- renderText({
    paste("Area",input$selectedArea)
  })
}

shinyApp(ui, server)
user_44741570

Here is a method of doing it with the addMeasure() function from leaflet and some JavaScript.

The JavaScript part could certainly be optimized with some event delegation, as the buttons are rendered dynamically. Therefore I am using a setTimeout function which re-evaluates every second. I'm sure this could be done in a smoother way, but I'm no JS expert. ;)

The JavaScript code waits for a click on the Finish measurement Button and gets the result from this HTML part $('.js-results').children()[2].innerText. This is then passed to measurefinish with Shiny.onInputChange so that you can access this value in your server code with input$measurefinish.

One possible solution:

library(shiny)

library(leaflet)

js <- HTML("
$(document).on('shiny:connected', function(event) {
   setTimeout(function(){
    var fin = document.getElementsByClassName('js-finish');
    fin[0].addEventListener('click', function eventHandler(event) {
      var area = $('.js-results').children()[2].innerText;
      Shiny.onInputChange('measurefinish', area);
    });
  }, 1000);
});
")

ui <- fluidPage(
  tags$head(tags$script(js)),
  leafletOutput("map1"),
  verbatimTextOutput("area")
)

server <- function(input, output, session) {
  output$map1 <-renderLeaflet({
    m<-leaflet() %>%
      addMeasure() %>%
      addProviderTiles('Esri.WorldImagery')
    m
  })


  output$area <- renderText({
    req(input$measurefinish)
    area <- input$measurefinish
    area <- gsub(pattern = "\n", "", x = area, fixed = T)
    ## Convert to numeric value 
    # area <- regmatches(area, regexpr("\\(?[0-9,.]+", area))
    # area <- as.numeric(gsub(pattern = ",", "", area, fixed=T))
    area
  })
}

shinyApp(ui, server)

Based on your comment on @NicE's answer, I edited his code to sum up all area measurements. I am using a reactiveValues object where the area is summed up. To reset the total area back to 0 I use an actionButton with an observeEvent part.

library(leaflet)
library(shiny)

ui <- fluidPage(
  leafletOutput("mymap"),
  br(),
  actionButton("resetArea", label = "Reset total area to 0"),
  textOutput("areaText"),
  textOutput("areaSumText")
)

server <- function(input, output, session) {

  output$mymap <- renderLeaflet({
    leaflet() %>% addTiles() %>%
      fitBounds(-73.9, 40.75, -73.95,40.8) %>%
      addMeasure() %>%
      htmlwidgets::onRender("
        function(el, x) {
          var myMap = this;
          myMap.on('measurefinish',
            function (e) {
              Shiny.onInputChange('selectedArea', e.area);
            })
        }")
  })

  totalArea <- reactiveValues(sum = NULL)

  observe({
    req(input$selectedArea)
    isolate({
      if (is.null(totalArea$sum)) {
        totalArea$sum = input$selectedArea
      } else {
        totalArea$sum = totalArea$sum + input$selectedArea
      }
    })
  })
  observeEvent(input$resetArea, {
    totalArea$sum = NULL
  })

  output$areaText <- renderText({
    paste("Area",input$selectedArea)
  })
  output$areaSumText <- renderText({
    req(totalArea$sum)
    paste("Sum of Area",totalArea$sum)
  })

}

shinyApp(ui, server)
user_36827940
Related