Shiny Leaflet Ploygon Click Event

Click polygon and will updateselectinput() - (using leaflet R)

Here you go. As per my comment, you need to specify the layerId as the ~Name. This will then be returned in the id field of the click event.

You also had an error in your observe() event. You weren't referencing the correct map name. I've fixed this for you (see my comment in the observe() function)

I've also included a print(event) statement so you can see the data that gets returned when you click on the layer

library(leaflet)
library(leaflet.extras)
library(rgdal)
library(shiny)
library(shinydashboard)

sgmap55 <- readOGR("https://raw.githubusercontent.com/aeiyuni/regioncount/master/55_MP14_PLNG_AREA_WEB_PL.kml")
wfmap <- read.csv("https://raw.githubusercontent.com/aeiyuni/regioncount/master/wfmap.csv")

bins <-c(1,50,100,150,200,250,300,350,400,450,500)
pal <- colorBin("YlGnBu", domain = wfmap$count, bins = bins, na.color = "#808080")

labels <- sprintf(
"<strong>%s</strong><br/>%g respondents </sup>",
wfmap$planarea, wfmap$count
) %>% lapply(htmltools::HTML)

ui<- fluidPage(
sidebarPanel(
selectInput("region", "Planning Area:",
choices = wfmap$planarea)
),
mainPanel(
leafletOutput("sgmap2", height= "1000px"))

)

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

output$sgmap2 <- renderLeaflet({
leaflet() %>%
addTiles() %>%
addSearchOSM()%>%
addResetMapButton()%>%
clearMarkers()%>%
addProviderTiles("OpenStreetMap") %>%
setView(103.8198,1.3521,12) %>%
addPolygons(data = sgmap55,
weight = 1,
color = "white",
smoothFactor = 0.5,
fillOpacity = 0.8,
fillColor = pal(wfmap$count),
highlight = highlightOptions(
weight = 5,
color = "#666666",
fillOpacity = 0.7,
bringToFront = TRUE),
label = labels,
labelOptions = labelOptions(
style = list("font-weight" = "normal",
padding = "3px 8px"),
textsize = "15px",
direction = "auto"),
group = "By region",
layerId = ~Name
) %>%
addLegend(pal = pal,
values = wfmap$count,
opacity = 0.7,
position = "topright")

})

observe({

## the sgmap2 needs to match the name of the map you're outputting above
event <- input$sgmap2_shape_click
print( event )
updateSelectInput(session, inputId = "region", selected = event$id
)

})
}

shinyApp(ui, server)

Can I use in r the leaflet map_shape_click event to populate a box() with a datatable?

let see if I got it right..

You can get the desired result by capturing the info related to hte clicked polygon and then using the id to subset your table

library(raster)
library(shiny)
library(leaflet)
library(RColorBrewer)
library(DT)

#species per region
mydata<-data.frame(myID=c("Iburengerazuba", "Iburasirazuba","Umujyi wa
Kigali","Umujyi wa Kigali", "Amajyaruguru", "Iburengerazuba",
"Amajyaruguru", "Amajyaruguru"),
myspec=c("virginiana", "setosa", "barbosa", "pelosa",
"pudica","pudica","pudica","pudica"))

#load in shapefiles for state
states <- getData("GADM", country = "rwa", level = 1)

#define color palettes for states
statePal <- colorFactor("Dark2", states@data$NAME_1)

shinyApp(

ui = fluidPage(
leafletOutput('myMap', width = "100%"),
br(),
DT::dataTableOutput("mytable", width = "100%")
),

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

output$myMap <- renderLeaflet({
leaflet() %>%
addTiles() %>%
addPolygons(data = states,
fillColor = ~statePal(states@data$NAME_1),
fillOpacity = 1,
color = "white",
stroke = T,
weight = 1,
layerId = states@data$NAME_1)
})

observeEvent(input$myMap_shape_click, {

#capture the info of the clicked polygon
click <- input$myMap_shape_click

#subset your table with the id of the clicked polygon
selected <- mydata[mydata$myID == click$id,]

#if click id isn't null render the table
if(!is.null(click$id)){
output$mytable = DT::renderDataTable({
selected
})
}
})
})

Adding a 'click' event to leaflet polygons via R

We can use htmlwidgets::onRender to pass custom JS code to the leaflet htmlwidget.

With the help of the eachLayer method we can add an on-click function to each polygon layer:

---
title: "leaflet polygons clicks"
output: html_document
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = FALSE)

library(tidyverse)
library(htmltools)
library(leaflet)
library(sf)
library(htmlwidgets)

```

```{r cars, echo=FALSE}

url <- 'https://opendata.arcgis.com/api/v3/datasets/bf9d32b1aa9941af84e6c2bf0c54b1bb_0/downloads/data?format=geojson&spatialRefId=4326'
wardShapes <- sf::st_read(url) %>%
filter(WD21CD >= "E05011175" & WD21CD <= "E05011181")

leaflet(wardShapes,elementId = "bhamMap",
height = 550,# width = 10,
options = leafletOptions(minZoom = 10, maxZoom = 14)) %>%
addTiles() %>%
setView(lng = -1.810, lat = 52.555, zoom = 12) %>%
addPolygons(
weight = 0.5, smoothFactor = 0.5,
opacity = 1.0, fillOpacity = 0.2,
highlightOptions = highlightOptions(color = "white", weight = 2, bringToFront = TRUE),
label = ~ as.character(WD21NM),
labelOptions = (interactive = TRUE),
options = pathOptions(title = ~ WD21CD, customdata = ~ WD21NM)
) %>% htmlwidgets::onRender("
function(el, x) {
var map = this;
map.eachLayer(function(layer) {
if(layer instanceof L.Polygon){
layer.on('click', function(e){
alert('You clicked on layer._leaflet_id: ' + layer._leaflet_id + '\\nWD21CD: ' + layer.options.title + '\\ncustomdata: ' + layer.options.customdata);
})
.addTo(map)
}
});
}
")

```

result

How to save click events in Leaflet Shiny map

You can do this using reactiveValues to store the clicks.

Right at the top of your server function add

RV<-reactiveValues(Clicks=list())

and then change your observeEvent to:

observeEvent(input$map_shape_click, {

#create object for clicked polygon
click <- input$map_shape_click
RV$Clicks<-c(RV$Clicks,click$id)
print(RV$Clicks)

}) #END OBSERVE EVENT

What happens is every time you click, the id is appended to the list of clicks stored in RV$Clicks. This does not have to be a list you could make it a vector if that is better for you.

R & Leaflet: how to bind a client-side event to a polygon

As mentioned in the comments we can use htmlwidgets::onRender to pass custom JS code.

With the help of the eachLayer method we can add an on-click function to each polygon layer (also see this related answer):

library(shiny)
library(leaflet)
nc = sf::st_read(system.file("shape/nc.shp", package="sf"))

ui <- function(request){
tagList(
selectInput("color", "color", c("blue", "red", "green")),
leafletOutput("map")
)
}

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

output$map <- renderLeaflet({
leaflet(nc) %>%
addPolygons(color = input$color) %>%
htmlwidgets::onRender("
function(el, x) {
var map = this;
map.eachLayer(function(layer) {
if(layer instanceof L.Polygon && !(layer instanceof L.Rectangle) ){
layer.on('click', function(e){
alert('hey - you clicked on layer._leaflet_id: ' + layer._leaflet_id);
})
.addTo(map)
}
});
}
")
})
}

shinyApp(ui, server)

result



Related Topics



Leave a reply



Submit