I am trying to accomplish the equivalent of Ghybs Leaflet example found here, where selecting/deselecting an overlay group shows/hides the markers for a group and updates the clustering accordingly using R's leaflet package.
There is a partial solution with R here:
quakes <- quakes %>%
dplyr::mutate(mag.level = cut(mag,c(3,4,5,6),
labels = c('>3 & <=4', '>4 & <=5', '>5 & <=6')))
quakes.df <- split(quakes, quakes$mag.level)
l <- leaflet() %>% addTiles()
names(quakes.df) %>%
purrr::walk( function(df) {
l <<- l %>%
addMarkers(data=quakes.df[[df]],
lng=~long, lat=~lat,
label=~as.character(mag),
popup=~as.character(mag),
group = df,
clusterOptions = markerClusterOptions(removeOutsideVisibleBounds = F),
labelOptions = labelOptions(noHide = F,
direction = 'auto'))
})
l %>%
addLayersControl(
overlayGroups = names(quakes.df),
options = layersControlOptions(collapsed = FALSE)
)
This solution does not cluster markers across groups, even though they are proximate points. A heads up for anyone trying to recreate this solution: you need to remove label=~as.character(mag), and labelOptions = labelOptions(noHide = F, direction = 'auto') in order for the code to run.
How can I accomplish cross-group clustering while maintaining layer control ?
Related
Anybody know how to set a default layer to show just one Overlay group first rather than all at once? For example, in the following if I just wanted to show 'Mex' initially and then let the viewer swap to 'GTM'?
library(raster)
library(leaflet)
#load in shapefiles
gtm <- getData('GADM', country = 'GTM', level = 0)
mex <- getData('GADM', country = 'MEX', level = 0)
leaflet() %>%
addTiles() %>%
addPolygons(data = gtm,
fillColor = 'red',
group = "gtm") %>%
addLegend(color = "red",
labels = gtm#data$GID_0,
group = "gtm") %>%
addPolygons(data = mex,
fillColor = 'blue',
group = "mex") %>%
addLegend(color = "blue",
labels = mex#data$GID_0,
group = "mex") %>%
addLayersControl(overlayGroups = c("gtm", "mex"),
options = layersControlOptions(collapsed = F),
)
Use function hideGroup to hide groups from code
addLayersControl(overlayGroups = c("gtm", "mex"),
options = layersControlOptions(collapsed = F)) %>%
hideGroup("mex")
See the official leaflet vignette under section Show/Hide Layers
I am trying to create a high-quality map of a small part of the UK, without any distortions caused by the use of projections, and with the addition of markers consisting of text and symbols. Ultimately the goal is to write out a png or pdf file. An earlier, related question can be found here.
Having not used R in anger for several years, I have been wading through a morass of packages trying to find something suitable. Leaflet for R is promising, but although I can create a decent-looking map, add markers, and vary the colour of markers and so on using columns from a data frame, I have not been able to vary the size, colour, and text offsets used in the labelOptions argument.
The following reproducible example shows what I can achieve, and also where I am not succeeding. I would like the size of text label to vary according to the df.data$textsizes column. Given that the style argument takes a list of value pairs, that would seem difficult, and nothing has worked so far.
If am hoping that somebody can either suggest either a way to bend the wily labelOptions to my will, or a completely different approach to try.
require(leaflet)
require(magrittr)
df.entrynames <- c("Entry 1: Some text","Entry 2: More text")
df.lat <- c(51.509898,51.510736)
df.lon <- c(-0.1345093,-0.135190)
df.colors <-c("Blue","Red")
df.sizes <-c(36,12)
df.data <- data.frame(entrynames=df.entrynames,lat=df.lat,lon=df.lon,colors=df.colors,textsizes=df.sizes)
df.data$entrynames <- as.character(df.data$entrynames)
df.data$colors <- as.character(df.data$colors)
df.data$textsizes <- paste(df.data$textsizes,"px",sep="")
leaflet() %>% setView(lng = -0.134509, lat = 51.509898, zoom = 17) %>% addTiles() %>%
addCircleMarkers(data = df.data,
lat = ~lat, lng = ~lon,
label = df.data$entrynames,
color = df.data$colors,
labelOptions = labelOptions(noHide = TRUE,
style = list(
"color" = "gray30",
"font-family" = "serif",
"font-style" = "italic",
"box-shadow" = "3px 3px rgba(0,0,0,0.25)",
"font-size" = "14px",
"border-color" = "rgba(0,0,0,0.5)"
),
textOnly = FALSE,
offset=c(0,0)))
df.entrynames <- c("Entry 1: Some text","Entry 2: More text")
df.lat <- c(51.509898,51.510736)
df.lon <- c(-0.1345093,-0.135190)
df.colors <-c("Blue","Red")
df.sizes <-c(36,2)
df.data <- data.frame(entrynames=df.entrynames,lat=df.lat,lon=df.lon,colors=df.colors,textsizes=df.sizes)
df.data$entrynames <- as.character(df.data$entrynames)
df.data$colors <- as.character(df.data$colors)
df.data$textsizes <- paste(df.data$textsizes,"px",sep="")
#Add a vector to split the data by
df.data$place<-seq(1:nrow(df.data))
library(purrr)
#split the data
ob_place <- df.data %>%
split(., .$place)
#make a map
m <- leaflet() %>%
addTiles()
#Add layers
names(ob_place) %>%
purrr::walk(function(df.data) {
m<<-m %>% #seems like there's supposed to be two carrots here, i had problems without one
addCircleMarkers(data=ob_place[[df.data]],fillColor=~colors,
fillOpacity = 0.6,
weight=1,
radius=13,
color="white",
opacity = .6,
lng=~lon, lat=~lat,
group = "Show All",
label = ~entrynames,
labelOptions = labelOptions(noHide = T,
#direction = ~MyDirection, #https://rstudio.github.io/leaflet/popups.html
textsize = ~textsizes,
#opacity=~opacity,
style = list(
"color"="black",
"font-family" ="sans-serif",
"box-shadow" = "3px 3px rgba(0,0,0,0.25)",
#"font-size" = "12px",
"border-color" = "rgba(0,0,0,0.5)"
)))
})
m
Similar to setting the direction of labels
I'd like to link a leaflet map and a data table created by DT library by using crosstalk instead of shiny. So when I click any record on table side, the circle in the map will be highlighted. I know the lat and long are required to generate the leaflet map, but is there a way that the table side only have Name and Area columns there (not show lat and long)?
Here are my example code:
library(leaflet)
library(DT)
library(crosstalk)
df <- read.csv(textConnection(
"Name,Lat,Long, area
Samurai Noodle,47.597131,-122.327298,40
Kukai Ramen,47.6154,-122.327157,30
Tsukushinbo,47.59987,-122.326726,10"
))
df$Name <- as.character(df$Name)
sdf <- SharedData$new(df, ~df$Name)
pal <- colorNumeric("RdYlBu", df$area)
labels <- paste(sep = "<br/>",
paste('Name: ', df$Name),
paste('Area: ', df$area))
d1 <- leaflet(sdf) %>%
addTiles() %>%
addCircleMarkers(~Long,
~Lat,
radius = df$area,
color = ~pal(df$area),
fillColor = ~pal(df$area),
popup = labels,
fillOpacity = 1) %>%
addLegend("topright",
title = "AREA",
pal = pal,
values = df$area,
opacity = 1)
d2 <- datatable(sdf, width = "100%")
bscols(d1, d2)
You don't need another SharedData.
A quick solution is in datatable's options.
datatable(sdf, options=list(columnDefs = list(list(visible=FALSE,
targets=c(2,3))))) #positions
I figured out this question today.
What I need to do is create df_2 (remove log and lat), and create another SharedData object by using df_2, and adding group.
sdf_2 <- SharedData$new(df_2, ~df$Name, group = "data_subset")
Use sdf and sdf_2 to create leaflet map and datatable separately:
d1 <- leaflet(sdf) %>% addTiles() %>% addCircleMarkers(~Long,
~Lat,
radius = df$area,
color = ~pal(df$area),
fillColor = ~pal(df$area),
popup = labels,
fillOpacity = 1) %>% addLegend("topright",
title = "AREA",
pal = pal,
values = df$area,
opacity = 1)
d2 <- datatable(sdf_2, width = "100%")
bscols(d1, d2)
I would like to create a map where I can interactively measure the distance between 2 points. Luckily, leaflet.extras has exactly what I need, however, I'm struggling to get it to produce the outputs in metres (or kilometres) as opposed to feet.
Consider the below piece of code:
library(leaflet)
library(leaflet.extras)
leaflet() %>%
addTiles() %>%
addDrawToolbar(
editOptions=editToolbarOptions(selectedPathOptions=selectedPathOptions())
)
It creates the following map:
However, this example (chunk 3) effectively the same code to create the same measuring tool (polyline), except it works in KM, whereas my example works in feet.
If you have any tips that can help me switch to metres as opposed to feet, I would really appreciate it.
The drawPolylineOptions function does not allow to set the option feet=FALSE.
Hence, I suggest to modify drawPolylineOptions as follows:
library(leaflet)
library(leaflet.extras)
mydrawPolylineOptions <- function (allowIntersection = TRUE,
drawError = list(color = "#b00b00", timeout = 2500),
guidelineDistance = 20, metric = TRUE, feet = FALSE, zIndexOffset = 2000,
shapeOptions = drawShapeOptions(fill = FALSE), repeatMode = FALSE) {
leaflet::filterNULL(list(allowIntersection = allowIntersection,
drawError = drawError, guidelineDistance = guidelineDistance,
metric = metric, feet = feet, zIndexOffset = zIndexOffset,
shapeOptions = shapeOptions, repeatMode = repeatMode)) }
leaflet() %>% setView(10.975342,45.421588,9) %>%
addTiles() %>%
addProviderTiles(providers$OpenStreetMap.Mapnik) %>%
addDrawToolbar(
polylineOptions = mydrawPolylineOptions(metric=TRUE, feet=FALSE),
editOptions=editToolbarOptions(selectedPathOptions=selectedPathOptions())
)
Otherwise, using addMeasures you can add to your map a useful tool to measure distances (see the icon at the top right corner of the map).
It is possibile to specify units used to display length results by the primaryLengthUnit option.
leaflet() %>% setView(10.975342,45.421588,9) %>%
addTiles() %>%
addProviderTiles(providers$CartoDB.Positron) %>%
addDrawToolbar(
editOptions=editToolbarOptions(selectedPathOptions=selectedPathOptions())
) %>%
addMeasure(primaryLengthUnit="kilometers", secondaryLengthUnit="kilometers")
How do you set the layer order in R's leaflet package so that tiles show up on top of polygons filled with color?
Here's what I've got so far:
require(leaflet)
require(acs)
require(tigris)
require(rgdal)
census.income.end.year = 2015
county = 17
nd.counties=acs.fetch(geography=geo.make(state="ND", county=county),
table.number="B01003", endyear = 2015)
tracts <- tigris::tracts(state = 'ND', county = county, cb=FALSE, year = 2015)
# create a geographic set to grab tabular data (acs)
geo<-geo.make(state=c("ND"),
county = county,
tract="*")
# add in median income
median.income <- acs.fetch(endyear = census.income.end.year,
geography = geo,
variable = c("B19013_001"))
income_df <- data.frame(paste0(as.character(median.income#geography$state),
str_pad(as.character(median.income#geography$county), 3, 'left', '0'),
str_pad(as.character(median.income#geography$tract), 5, 'left', '0')),
median.income#estimate)
rownames(income_df)<-1:nrow(income_df)
names(income_df)<-c("GEOID", "hhincome")
income_merged <- geo_join(tracts, income_df, "GEOID", "GEOID")
income_merged <- spTransform(income_merged, CRS("+init=epsg:4326"))
qpal <- colorQuantile("plasma", income_df$hhincome, n = 4)
leaflet() %>%
setView( -96.7898, 46.8772, zoom=11) %>%
addPolygons(data = income_merged,
fillColor = qpal(income_merged$hhincome),
fillOpacity = 1,
weight = 0.3) %>%
addProviderTiles(providers$Hydda.RoadsAndLabels)
Ultimately, I'ld like to do this with addTiles (instead of addProviderTiles as in the above code) using a custom MapBox, but I can't figure out how to make that reproducible for this example... given that you need a key to access custom MapBox tiles (BTW, I've created a custom MapBox tile that should be transparent except for roads and labels, so the underlying polygons should "show thru.")
Here is one way to do add a tile on top of a circle with the non-R version of leaflet: http://jsfiddle.net/dcu9pz2w/, but I don't see how to make that work in my context. I think adding "panes" may be the way to go, but I don't see that functionality in R leaflet. Also, I explored z-index values, but that seemed to be a dead end.
Any help is much appreciated!
R leaflet now includes addMapPane function. The solution to this problem is to first set up pane order and then add tiles/polygons. Reproducible example:
library(leaflet)
library(geojsonio)
# get polygon data
# https://github.com/simonepri/geo-maps/blob/master/info/countries-land.md
world <- geojson_read(
"https://github.com/simonepri/geo-maps/releases/download/v0.6.0/countries-land-10km.geo.json",
what = "sp"
)
# generate random values
world#data$value <- runif(nrow(world#data))
# get color palette
color_pal <- colorNumeric(palette = "YlOrRd", domain = NULL)
# get leaflet map
leaflet() %>%
setView(lat = 50, lng = 15, zoom = 4) %>%
addMapPane("background_map", zIndex = 410) %>% # Level 1: bottom
addMapPane("polygons", zIndex = 420) %>% # Level 2: middle
addMapPane("labels", zIndex = 430) %>% # Level 3: top
addProviderTiles(
providers$Esri.WorldTerrain,
options = pathOptions(pane = "background_map")
) %>%
addPolygons(
data = world, stroke = FALSE, smoothFactor = 0.2,
fillOpacity = 0.6, fillColor = ~color_pal(value),
options = pathOptions(pane = "polygons")
) %>%
addProviderTiles(
providers$Stamen.TonerLabels,
options = pathOptions(pane = "labels")
)