How to access polygon information from shapefile leaflet R - r

I made a map of London using https://data.london.gov.uk/dataset/statistical-gis-boundary-files-london and shiny and R and leaflet. I added an attribute to the shapefile, and now want to be able to highlight the shapefile and print information when the user clicks on a specific polygon.
I looked at shiny leaflet ploygon click event, Marker mouse click event in R leaflet for shiny, and How to implement input$map_marker_click correctly?, and know I need to use ObserveEvent, but have not been able to implement it correctly.
My code is:
library(shiny)
library("rgdal")
library(leaflet)
shapeData <- readOGR('statistical-gis-boundaries-london/ESRI/LSOA_2004_London_Low_Resolution.shp')
shapeData <- spTransform(shapeData, CRS("+proj=longlat +ellps=GRS80"))
shapeData$col=sample(c('red','yellow','green'),nrow(shapeData),1) #add some value you want to map
borough=read.csv('BoroughCentres.csv')
ui=fluidPage(
fluidPage(
leafletOutput('LSOAMap'),
p(),
selectInput('LANAME','Borough',
choices = unique(shapeData$LA_NAME))
)
)
server=function(input, output) {
output$LSOAMap <- renderLeaflet({
llong=borough[borough$Borough==input$LANAME,3]
llat=borough[borough$Borough==input$LANAME,4]
bor=subset(shapeData,shapeData$LA_NAME %in% input$LANAME)
leaflet() %>% addTiles() %>%
setView(lng = llong, lat=llat,zoom=13) %>%
addPolygons(data=bor,weight=2,col = 'black',fillOpacity = 0.2,fillColor = bor$col,
highlightOptions = highlightOptions(color='white',weight=1,
bringToFront = TRUE)) %>%
addMarkers(lng = llong,lat=llat,popup=input$LANAME)
})
}
shinyApp(ui, server)
I tried adding, along with session as an argument:
observe({
click <- input$map_marker_click
if (is.null(click))
return()
print(click)
text <-
paste("Lattitude ",
click$lat,
"Longtitude ",
click$lng)
leafletProxy(mapId = "LSOAMap") %>%
clearPopups() %>%
addPopups(dat = click, lat = ~lat, lng = ~lng, popup = text)
# map$clearPopups()
# map$showPopup(click$latitude, click$longtitude, text)
})
to no avail.
What I want is that when a user highlights a specific shape, text pops up and shows the corresponding STWARDNAME from the shapefile.
the first few lines of borough are:
> head(borough)
Borough LA_CODE long lat
1 City of London E09000001 -0.09194991 51.51814
2 Barking and Dagenham E09000002 0.13064556 51.54764
3 Barnet E09000003 -0.20416711 51.61086
4 Bexley E09000004 0.13459320 51.45981
5 Brent E09000005 -0.26187070 51.55697
6 Bromley E09000006 0.03734663 51.38836

You are pretty close but have a few syntax issues which I think are tripping you up.
First you are not properly selecting what STWARDNAME you want from your SPDF so there is no way for R to know which one to show. I added this line
popup = subset(shapeData, LA_NAME == input$LANAME )$STWARDNAME
Also you were passing highlightOptions as an option when it should just be highlight
Finally since you were more interested in mouseover for a polygon, I removed the popup marker and changed to highlight so that the name is shown when you mouseover the polygon:
leaflet() %>% addTiles() %>%
setView(lng = llong, lat=llat,zoom=13) %>%
addPolygons(data=bor,weight=2,col = 'black',fillOpacity = 0.2,fillColor = bor$col,
highlight = highlightOptions(color='white',weight=1,
bringToFront = TRUE), label= popup)
Which yields:

#Stedy answer was brilliant, and better, I just went a different way. I added in a layer id vector, and a popup decision to find the STWARDNAME
lid=as.vector(row.names(bor#data))
pu=bor#data[row.names(bor#data)==lid,'STWARDNAME']
, then added in two arguments while making the map layerId = lid,popup = pu,. The pop up showed when the user clicked on an area
bor=subset(shapeData,shapeData$LA_NAME %in% input$LANAME)
lid=as.vector(row.names(bor#data))
pu=bor#data[row.names(bor#data)==lid,'STWARDNAME']
leaflet() %>% addTiles() %>%
setView(lng = llong, lat=llat,zoom=13) %>%
addPolygons(data=bor,weight=2,col = 'black',fillOpacity = 0.2,fillColor = bor$col,
layerId = lid,popup = pu,
highlightOptions = highlightOptions(color='white',weight=1,
bringToFront = TRUE)) %>%
addMarkers(lng = llong,lat=llat,popup=input$LANAME)

Related

Creating a Leaflet map in code workbook in Foundry

Anyone created a leaflet map in Code Workbook using r-Leaflet? I have a functioning script that runs (also double checked in R) but how do I get it to visualise and then use in a Report etc. I have tried various tweaks on what may get it to run but no success - any ideas
leaflet_map <- function(map_data) {
library(leaflet)
data<-map_data
# first cut the continuous variable into bins
# these bins are now factors
data$Fill_rateLvl <- cut(data$Fill_rate,
c(0,.5,0.6,0.7,0.8,0.9,1), include.lowest = T,
labels = c('<50%', '50-60%', '60-70%', '70-80%', '80-90%','90-100%'))
# then assign a palette to this using colorFactor
# in this case it goes from red for the smaller values to yellow and green
# standard stoplight for bad, good, and best
FillCol <- colorFactor(palette = 'RdYlGn', data$Fill_rateLvl)
m<-leaflet() %>%
addTiles() %>%
addProviderTiles(providers$CartoDB.Positron)%>%
setView(lng = -0, lat = 50, zoom = 8) %>%
addCircleMarkers(data = data, lat = ~lat, lng = ~long,
color = ~FillCol(Fill_rateLvl), popup = data$Lead_employer,
radius = ~sqrt(Fill_rate*50), group = 'Fill rate') %>%
addLegend('bottomright', pal = FillCol, values = data$Fill_rateLvl,
title = 'Fill rate for next two weeks',
opacity = 1)
return(NULL)
}
I am not familiar with R in code workbook, but it sounds to me that you need to materialize your leaflet map as a dataset and then consume it in some sort of map compatible UI.
For example slate has a map widget which is backed by leaflets. You can find documentation and examples for it in https://www.palantir.com/docs/foundry/slate/widgets-map/

Replicating shiny tmap with leaflet?

I've built the following app https://iseak.shinyapps.io/Mapa/
and I would like to switch from tmap to leaflet for the map portion of the app because I've run into some limitations (I'd like fancier popups and some other stuff).
Currently the map is working with tmap using the following code:
output$map = renderLeaflet({
tm <- tm_shape(subsetData()) +
tm_fill(selvar(), palette=colores(),
alpha=0.95,
breaks=breaks(),
id="Zona",
popup.vars=c(" "="popover"),
popup.format=list(digits=2),
legend.show = F,
labels=c(" "=selvar())
) +
tm_borders() +
tmap_options(basemaps = "CartoDB.Positron"
)
tmap_leaflet(tm) %>%
removeLayersControl()
})
My starting point when trying to use leaflet directly is:
output$map = renderLeaflet({
leaflet(data=subsetData()) %>%
addProviderTiles("CartoDB.Positron") %>%
clearShapes() %>%
clearControls() %>%
addPolygons(data = subsetData(),
fillColor = ~colores()(selvar()),
fillOpacity = 0.9,
weight = 2)
})
But I keep getting errors. I would appreciate some pointers on how to easily switch from tmap to leaflet and how to use reactive values inside the leaflet call. Thanks!
This question is quite open. I think the leaflet website has quite good example code (https://rstudio.github.io/leaflet/). Browse through the left menu.
When it come to reactivity you don't need brackets to use variable created by reactiveValues; in case of reactive() you need some.
Looking at your code I'm not sure what is behind color() and selvar(). Assuming selvar() is the number for the color scale my approach would have been something like this:
selvar <- reactiveValues(n=c(1:10)
output$map = renderLeaflet({
pal <- leaflet::colorBin(brewer.pal(9,"Blues"), domain = selvar, bins = 7, na.color = "gray")
leaflet() %>%
addProviderTiles("CartoDB.Positron") %>%
addPolygons(data=shp,
fillColor = ~pal(selvar),
fillOpacity = 0.9,
weight = 2)
You can specify your shape data in leaflet() or in addPolygons(). Using the latter allows to use different shape file tables. Finally, another useful pointer is leafletProxy('map') which would work well with the year buttons underneath the map for fast updates.

How do I return the position of a Leaflet map in shiny once it's been moved by the user?

The background to the question is as follows:
I have a shiny app that presents data on a leaflet map. That data can be filtered and presented in different ways. However, when the user zooms in and/or moves the map, and THEN filters the data, the map will revert back to the initial map view:
output$mymap <- renderLeaflet({
leaflet() %>%
setView(lng = 0, lat = 30, zoom = 4) %>% #setting the view over ~ center of North America
addTiles(options = providerTileOptions(noWrap = TRUE))
})
What I am looking for is some way of returning the position of the map such that when the data is updated in a proxy leaflet function I can set the view as well. The following is what I'm trying to achieve (I've made up a move equivalent of input$mymap_click).
observeEvent(input$mymap_move, {
move <- input$mymap_move
mlat <- move$lat
mlon <- move$lon
mzoom <- move$zoom
leafletProxy('mymap') %>%
setView(lng = mlng, lat = mlat, zoom = mzoom) %>%
addMarkers(data = data.join,
lat = data.join$a.lat,
lng = data.join$a.lon,
icon = icon.func[data.join$SYMBOL_CODE],
popup = data.join$ANCHOR)
})
Once your map is initialised, you can access the current state of your map via input$mymap_center and input$mymap_zoom (and if you wish you can access input$mymap_bounds)
There are just 2 things you need to pay attention to:
You have to check whether initialisation is complete yet, and if not give manual parameters (or Shiny won't know what starting position to use)
Unless you isolate the lookup, your map will re-render every time you change the view, which is probably not what you want (it makes your app really slow, and unworkable to the user)
So putting it all together, I think this code should do what you wish:
output$mymap <- renderLeaflet({
isolate({
if ("mymap_center" %in% names(input)) {
mapparams <- list(center = input$mymap_center,
zoom = input$mymap_zoom)
} else {
mapparams <- list(center = list(lng=0, lat=30),
zoom = 4) #setting the view over ~ center of North America
}
})
leaflet() %>%
setView(lng = mapparams$center$lng, lat = mapparams$center$lat, zoom = mapparams$zoom) %>%
addTiles(options = providerTileOptions(noWrap = TRUE))
})

how to set zoom level/view of leaflet map

I have a map in leaflet in RShiny which have markers plotted and once I click a marker it adds circles to map showing all the related points to the marker.
What I want to do is to set zoom/view of the map in such a way that all the related circles are visible.
The number of circles varies as per markers i.e. some marker have 1 or 2 circles while some have more. Also, the location of circles varies across the USA so they can be placed in one city or another state.
Following is the code I am using to add circles to existing map
proxy <-leafletProxy("map",data = df)%>%
clearMarkers()%>%
addCircleMarkers(lat = ~lat,lng = ~lng,layerId = ~circle_pt,fillColor =
'green',opacity = 0.5,color = 'red',fillOpacity = 1)%>% clearPopups()%>%
addPopups(lat=~lat,lng=~lng,~as.character(circle_pt))
map=original map with markers
df=lat lng of circles with associated properties of selected marker in map
I want to set zoom level as shown in figure 2.
Kindly help me to identify how to calculate optimal zoom level in leaflet in shiny.
Regards,
If you want to set your initial view, you can use:
setView(lng, lat, zoom = zoom_level)
which is straight from the documentation.
Unless you provide more information, nobody will be able to understand the part where you're saying "in such a way that all the related circles are visible."
I'm not sure how you're app works and whats in the original call to leaflet. But maybe the following example might help you.
I store the click on the markers, filter the data according to the clicked layerId, get the min/max lat/long of the resulting data and then use fitBounds() to set the "zoom" level. (You could also use flyToBounds with the same arguments, which should make a smoother transition to the selected markers, but its still too buggy for me at least)
library(shiny)
library(shinyjs)
library(leaflet)
cords <- data.frame(
lng = runif(100, 14, 18),
lat = runif(100, 54, 58),
circle_pt = sample(1:20, size = 100, replace = T)
)
ui <- fluidPage(
leafletOutput("map", height = "700px")
)
server <- function(input, output, session) {
output$map <- renderLeaflet({
leaflet(data = cords) %>%
addTiles() %>%
addCircleMarkers(lat = ~lat,lng = ~lng, layerId = ~circle_pt, fillColor = 'green',
opacity = 0.5,color = 'red',fillOpacity = 1)
})
observeEvent(input$map_marker_click, {
clickid = input$map_marker_click$id
cordsNew = cords[cords$circle_pt==clickid,]
maxLong = max(cordsNew$lng)
maxLat = max(cordsNew$lat)
minLong = min(cordsNew$lng)
minLat = min(cordsNew$lat)
proxy <-leafletProxy("map", data = cordsNew)
proxy %>%
addCircleMarkers(lat = ~lat,lng = ~lng, layerId = ~circle_pt, fillColor = 'green',
opacity = 0.5,color = 'red',fillOpacity = 1) %>%
fitBounds(minLong,minLat,maxLong,maxLat) %>%
clearPopups() %>%
addPopups(lat=~lat,lng=~lng,~as.character(circle_pt))
})
}
shinyApp(ui = ui, server = server)
may be you can define an interval varint <- findInterval() and that pass to setView
varint <- findInterval()
setView(lng= lng,lat = lat, zoom = varint)
in findInterval, try to put some range of data with the distance between all points
EDIT:
try to calculate the distance between the farthest points that appear.
proxy <-leafletProxy("map",data = df) %>%
setView(
lng = click$lng,
lat=click$lat,
zoom=findInterval(someaverageofyourpoints, c(25,75,100,250,400,750,1000))
)
you can sum other values to findinterval, findinterval()+ 1 .. 2.. 4 ...5 for setting zoom level if findintervalset a tiny value

radius of circles in leaflet app to be driven by the selectInput

I am trying to make the radius of my circle markers in this Shiny leaflet app be driven by the selectInput variable.
The dropdown has three values, "Week.1", "Week.2" and "Week.3", which are all numeric vectors (of large dollar revenue values in millions) in the d at the bottom of this question.
selectInput("weekView", "Week's Revenue:",
c("1" = "Week.1",
"2" = "Week.2",
"3" = "Week.3")),
I am currently loading Week.1 and get thr result. I wNt the input to change the weeks and react with the corresponding $ on the map.
When I try and use input$weekView instead of the static ~(Week.1), I get errors as it is "Week.1". I've tried using quote = False in place to remove them before the radius is calculated but I'm failing to find the right place to do so...
leaflet(data = P) %>%
addTiles() %>% # Add default OpenStreetMap map tiles
addCircleMarkers(~Long, ~Lat, popup = ~Week.1,
radius = ~(Week.1)/40000,
stroke = FALSE,
fillOpacity = 0.5)
Can any one advise on how best to go about this? What I want to say is
radius = input$weekView/40000
All the script:
library(shiny)
library(leaflet)
ui <- fluidPage(
selectInput("weekView", "Week's Revenue:",
c("1" = "Week.1",
"2" = "Week.2",
"3" = "Week.3")),
leafletOutput("mymap"),
p()
)
server <- function(input, output, session) {
output$mymap <- renderLeaflet({
x <- input$weekView
P<- read.csv("Lebara_weeks_rev4.csv")
as.numeric(P$Long)
as.numeric(P$Lat)
as.character(P$Week.1)
P$Week.1 <- as.numeric(gsub(",","",P$Week.1))
P$Week.2 <- as.numeric(gsub(",","",P$Week.2))
P$Week.3 <- as.numeric(gsub(",","",P$Week.3))
long <- P$Long
Lat <- P$Lat
leaflet(data = P) %>%
addTiles() %>% # Add default OpenStreetMap map tiles
addCircleMarkers(~Long, ~Lat, popup = ~Week.1,
radius = ~(Week.1)/40000,
stroke = FALSE,
fillOpacity = 0.5)
})
}
shinyApp(ui, server)
Head of the df = P
> head(P)
group Lat Long Country Week.1 Week.2 Week.3 Week.4
1 178.100 55.37805 -3.435973 United Kingdom 649,613 665,147 640,732 649,642
2 174.890 51.16569 10.451526 Germany 117,766 120,402 104,167 91,157
3 144.100 46.22764 2.213749 France 135,784 117,759 109,337 101,873
4 174.211 52.13263 5.291266 Netherlands 403,950 397,438 377,855 389,345
5 174.990 40.46367 -3.749220 Spain 94,472 95,742 88,313 86,400
6 178.600 56.26392 9.501785 Denmark 70,094 72,487 67,597 66,769
Thanks!
Pete
I used tidyr and subsetWeek1 <- P[1:7,] then made variables for the subsetWeek1$value/40000 to make them small enough for the radius values) of those subsets. I tried to make the selectInput 1 = subsetWeek1$value, 2 = subsetWeek2$value and 3 = subsetWeek3$value...
library(tidyr)
P <- tidyr::gather(P, week, value, Week.1:Week.3)
subsetWeek1 <- P[1:7,]
subsetWeek2 <- P[8:14,]
subsetWeek3 <- P[15:21,]
Week1val <- subsetWeek1$value
Week2val <- subsetWeek2$value
Week3val <- subsetWeek3$value
This doesn't seem to pick up the selectInput value and change the map. There are no markers on the map and no errors provided. Could it be the scale of the circles makes them invisible? In the non-app version they are OK.
You're close, you just need to update variable names and clean up a bit. Generally, if you're repeating the same line with a slightly different parameter, there's a better way. An option, using tidyr for gather and extract_numeric:
library(shiny)
library(tidyr)
library(leaflet)
P <- read.csv("Lebara_weeks_rev4.csv")
# do munging that won't change based on input here
P2 <- gather(P, week, value, Week.1:Week.4) # gather to long form
P2$value <- extract_numeric(P2$value) # convert to numeric
ui <- fluidPage(
selectInput("weekView", "Week's Revenue:",
c("1" = "Week.1",
"2" = "Week.2",
"3" = "Week.3",
"4" = "Week.4")),
leafletOutput("mymap")
)
server <- function(input, output, session) {
output$mymap <- renderLeaflet({
# do munging dependent on input here
P3 <- P2[P2$week == input$weekView, ] # subset based on input
leaflet(data = P3) %>%
addTiles() %>% # Add default OpenStreetMap map tiles
addCircleMarkers(lng = ~Long, lat = ~Lat,
popup = ~format(value, big.mark = ','), # reinsert commas
radius = ~value/40000,
stroke = FALSE,
fillOpacity = 0.5)
})
}
shinyApp(ui, server)

Resources