Mouse Events in Leaflet map

[Samantha Sifleet]

Hi,

I have the same question as this person

http://stackoverflow.com/questions/28938642/marker-mouse-click-event-in-r-leaflet-for-shiny

"How can I receive a mouse click event on a marker in a leaflet map in R? I'm using the rstudio/leaflet version https://github.com/rstudio/leaflet and running through shiny.

I'd like to get the value of a marker (e.g., ID) and use that to update a sidebarPanel.

Thanks!"

I'd prefer a solution using the html widget version of the leaflet package (i.e. http://rstudio.github.io/leaflet/)

Yes, I've seen the leaflet-shiny package on github which looks like it can handle mouse events - it also looks older (2013) and less likely to be supported in the future.

If there isn't a solution, within the current html widget version of leaflet, can I just insert some javascript into my app to deal with this?

Many Thanks! 

Sam

[Martin Lavoie]

Sam,

have you look at https://github.com/jcheng5/leaflet-shiny ?

Martin

[Samantha Sifleet]

Hi Martin,

Yes, I have looked at leaflet-shiny.  My concern is that it seems a bit unstable - note the documentation (especially on events) is incomplete.  

The html widgets version seems much better supported.

The app I'm working on will be delivered to some code-phobic people. So, I'd like to deliver the most stable version I can.

With that said, I did try to play with the leaflet-shiny version and even getting simple CircleMarkers to display doesn't seem straight forward (see code below).

I'd prefer to stick with the html widget version of leaflet and just add in the js needed for the mouse events - it seems like this may cause fewer issues down the road and make for happier users.

My js skills are basic at this point, but I think this may be the best way to go.

Thanks,

Sam

Code - Markers not displaying:

library(shiny)

library(DT)

remove.packages("leaflet")   

devtools::install_github("jcheng5/leaflet-shiny")

library(leaflet)

shinyApp(

  ui = fluidPage(leafletMap("myMap", "100%", 400, 

                            initialTileLayer = "//{s}.tiles.mapbox.com/v3/jcheng.map-5ebohr46/{z}/{x}/{y}.png", 

                            initialTileLayerAttribution = HTML('© OpenStreetMap contributors, CC-BY-SA'), 

                            options=list( center = c(37.45, -93.85),

                                          zoom = 4, 

                                          maxBounds = list(list(17, -180), list(59, 180))

                                          ))),

  server = function(input, output, session){

    map<-createLeafletMap(session, "myMap")

    map$addCircleMarker(lat = data$LatitudeMeasure, lng = data$LongitudeMeasure, radius = data$radius, 

                        layerId=row.names(data))

  }

)

# data

# MonitoringLocationIdentifier LatitudeMeasure LongitudeMeasure radius

# 1            21NC02WQ-J1890000        35.94077        -78.58010     15

# 2            21NC02WQ-J2850000        35.83770        -78.78084     12

# 3            21NC02WQ-J3000000        35.84545        -78.72444     12

# 4            21NC02WQ-J3251000        35.81584        -78.62568     12

# 5            21NC02WQ-J3300000        35.79387        -78.64262     12

# 6             21NC03WQ-NEU019C        36.05600        -78.67600     15

[mbh]

Try this :

# session$onFlushed is necessary to delay the drawing of the circles until after the map is created
session$onFlushed(once=T, function(){

      map$addCircleMarker(lat = data$LatitudeMeasure, lng = data$LongitudeMeasure, radius = data$radius,
                          layerId=row.names(data))
})

[Samantha Sifleet]

Thank you - the session$onFlushed worked.  I have the mouse events working.  

http://stackoverflow.com/questions/28938642/marker-mouse-click-event-in-r-leaflet-for-shiny/30076981#30076981

I'm now having issues getting the the circles to draw when I pass reactive lat/longs to the addCircleMarker.  Any tips?  Thanks again

[Joe Cheng]

Can you post a reproducible example?

By the way, last week we brought the new leaflet htmlwidget to parity and beyond compared to the old jcheng5/leaflet-shiny package. If you post your code I can show you how to adapt it to the new library (the docs for the new library aren't done yet).

Sent from Outlook

--
You received this message because you are subscribed to the Google Groups "Shiny - Web Framework for R" group.
To unsubscribe from this group and stop receiving emails from it, send an email to shiny-discus...@googlegroups.com.
To view this discussion on the web visit https://groups.google.com/d/msgid/shiny-discuss/63fff601-07ea-4962-adb0-b364cfd792c0%40googlegroups.com.
For more options, visit https://groups.google.com/d/optout.

[Samantha Sifleet]

Here is an example

The markers are drawing but not removing based on different selections.

I would love to use the html widget version of leaflet for this - Thank you for your help

library(shiny)

library(leaflet)

latitude<-c(35.94077, 35.83770, 35.84545, 35.81584, 35.79387, 36.05600, 36.02220, 36.00507, 35.97838, 35.95591)

longitude<-c(-78.58010, -78.78084, -78.72444, -78.62568, -78.64262, -78.67600, -78.68529, -78.64668, -78.63248, -78.58444)

radius<-c(15, 12, 20, 12, 12, 25, 10, 18, 25, 5)

ids<-c("a", "b", "c", "d", "e", "f", "g", "h", "i", "j")

DATA<-as.data.frame(cbind(latitude, longitude, radius, ids))

A<-DATA[c(1:5),]

B<-DATA[c(6:10),]

shinyApp(

  ui = fluidPage(

    fluidRow(column(3),

             column(3, selectInput("data_set", label=p("Choose a data set"), 

                            choices = c("No Data" = "no_data", "Data Set A" = "data_A", "Data Set B" = "data_B") , multiple = FALSE))),

    fluidRow(

      leafletMap(

        "map", "100%", 400,

        initialTileLayer = "//{s}.tiles.mapbox.com/v3/jcheng.map-5ebohr46/{z}/{x}/{y}.png",

        initialTileLayerAttribution = HTML('Maps by <a href="http://www.mapbox.com/">Mapbox</a>'),

        options=list(

          center = c(37.45, -93.85),

          zoom = 4,

          maxBounds = list(list(17, -180), list(59, 180))))),

    fluidRow(verbatimTextOutput("Click_text"))),

  server = function(input, output, session){

        map = createLeafletMap(session, 'map')

        mapDATA<-reactive({

          if(input$data_set == "data_A"){

             map$clearMarkers()

            return(A)

          } else if(input$data_set == "data_B"){

#             map$clearMarkers()

            return(B)

          } else {

#             map$clearMarkers()

            return()

          }   

        })

        session$onFlushed(once=T, function(){

          observe({ 

            map$addCircleMarker(lat = mapDATA()$latitude, lng = mapDATA()$longitude, radius = mapDATA()$radius, 

                              layerId= mapDATA()$ids)

          }) 

        })

        observe({

          click<-input$map_marker_click

            if(is.null(click))

              return()

            text<-paste("Lattitude ", click$lat, "Longtitude ", click$lng)

            text2<-paste("Would you like to summarize station ", click$id, " ?")

            map$clearPopups()

            map$showPopup( click$lat, click$lng, text)

            output$Click_text<-renderText({

              text2

            })

        })

  })

[Dawg]

Hello -

after trying for three hours (I know -- that's not much) I thought it's easier to ask for help. Has anybody figured out how to click on locations and get lat and lon back in the new leaflet?

Thanks,

D.

[Joe Cheng]

Samantha, I'm so sorry, I must've missed this message. I hope you figured it out, if not, here is your code ported to the new leaflet library.

library(shiny)

library(leaflet)

latitude<-c(35.94077, 35.83770, 35.84545, 35.81584, 35.79387, 36.05600, 36.02220, 36.00507, 35.97838, 35.95591)

longitude<-c(-78.58010, -78.78084, -78.72444, -78.62568, -78.64262, -78.67600, -78.68529, -78.64668, -78.63248, -78.58444)

radius<-c(15, 12, 20, 12, 12, 25, 10, 18, 25, 5)

ids<-c("a", "b", "c", "d", "e", "f", "g", "h", "i", "j")

DATA<-as.data.frame(cbind(latitude, longitude, radius, ids))

A<-DATA[c(1:5),]

B<-DATA[c(6:10),]

shinyApp(

  ui = fluidPage(

    fluidRow(column(3),

      column(3, selectInput("data_set", label=p("Choose a data set"), 

        choices = c("No Data" = "no_data", "Data Set A" = "data_A", "Data Set B" = "data_B") , multiple = FALSE))),

    fluidRow(

      leafletOutput("map", "100%", 400)),

    fluidRow(verbatimTextOutput("Click_text"))),

  server = function(input, output, session){

    mapDATA<-reactive({

      if(input$data_set == "data_A"){

        return(A)

      } else if(input$data_set == "data_B"){

        return(B)

      } else {

        return()

      }   

    })

    

    output$map <- renderLeaflet({

      leaflet() %>%

        addTiles("//{s}.tiles.mapbox.com/v3/jcheng.map-5ebohr46/{z}/{x}/{y}.png",

          HTML('Maps by <a href="http://www.mapbox.com/">Mapbox</a>')) %>%

        setView(-93.85, 37.45, 4) %>%

        setMaxBounds(-180, 17, 180, 59)

    })

    

    # Render circle markers

    observe({ 

      map <- leafletProxy("map", data = mapDATA())

      map %>% clearMarkers()

      if (!is.null(mapDATA())) {

        map %>% addCircleMarkers(lat = ~latitude, lng = ~longitude, radius = ~radius, layerId = ~ids)

      }

    })

    

    output$Click_text<-renderText({

      click <- input$map_marker_click

      if (!is.null(click))

        paste0("Would you like to summarize station ", click$id, " ?")

    })

    # Show popup on click

    observeEvent(input$map_marker_click, {

      click <- input$map_marker_click

      text<-paste("Lattitude ", click$lat, "Longtitude ", click$lng)

      map <- leafletProxy("map")

      map %>% clearPopups() %>%

        addPopups(click$lng, click$lat, text)

    })

  })

To view this discussion on the web visit https://groups.google.com/d/msgid/shiny-discuss/761f13f9-301d-49c6-b6c2-47d48de99ad8%40googlegroups.com.

[Joe Cheng]

input$mapid_click should do it. Example:

library(shiny)

library(leaflet)

ui <- fluidPage(

  leafletOutput("map"),

  br(),

  verbatimTextOutput("out")

)

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

  output$map <- renderLeaflet({

    leaflet() %>% addTiles()

  })

  

  output$out <- renderPrint({

    validate(need(input$map_click, FALSE))

    

    str(input$map_click)

  })

}

shinyApp(ui, server)

To view this discussion on the web visit https://groups.google.com/d/msgid/shiny-discuss/2ec343dd-d62d-4610-b1cc-822fcf8c2431%40googlegroups.com.

[Dawg]

Thanks, Joe. Any idea why your code gives me these funny values when I click over the US? 

List of 3

 $ lat   : num 31.8

 $ lng   : num -459

 $ .nonce: num 0.273

[Joe Cheng]

It's a horizontally repeating map, this is how you can distinguish between different copies of the world. You can disable that if you want by calling addTiles() with the right argument passed to options=tileOptions().

To view this discussion on the web visit https://groups.google.com/d/msgid/shiny-discuss/dda8b79d-5ccc-4aa8-95c2-a7ce4248eaef%40googlegroups.com.

[Dawg]

Thanks Joe - what a great resource you are! Works with noWrap = TRUE, code below.

ui <- fluidPage(

  leafletOutput("map"),

  br(),

  verbatimTextOutput("out")

)

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

  output$map <- renderLeaflet({

    leaflet() %>% addTiles(options = providerTileOptions(noWrap = TRUE))

  })

  

  output$out <- renderPrint({

    validate(need(input$map_click, FALSE))

    

    str(input$map_click)

  })

}

shinyApp(ui, server)