Leaflet: Mixing continuous and discrete colors - r

I have created a map using leaflet in R. It is a map of the United States with polygons being zip code level. I want to color the zip codes using a continuous color palette based on some value. I have followed the example here and have successfully mapped each zip code with a continuous color using the colorNumeric function like this:
# Create a continuous palette function
library(leaflet)
library(rgdal)
library(dplyr)
# From https://raw.githubusercontent.com/datasets/geo-boundaries-world-110m/master/countries.geojson
countries <- readOGR("json/countries.geojson", "OGRGeoJSON")
map <- leaflet(countries)
pal <- colorNumeric(palette = colorRamp(c('#4575B4', '#D73027', '#FFFFBF'), interpolate="linear"),
domain = countries$gdp_md_est)
map %>%
addPolygons(stroke = FALSE, smoothFactor = 0.2, fillOpacity = 1,
color = ~pal(gdp_md_est))
What makes this complicated is that now I want to separately color zip codes (basically replacing the previous color) using a discrete color palette. As a simple example, I want to use the colorNumeric function above to color each zip code based on average weight. Then I would use another zip code level field in my data to make all zip codes' polygons black if I wanted to exclude it for some reason, otherwise it would leave the colors as they already are.
I have found it difficult to use leaflet and colorNumeric to achieve both continuous and discrete coloring of my map. Any help would be greatly appreciated!

Since the sample above is not enough to have a demonstration, I decided to use one of the dummy data that I used for other leaflet related questions. I hope you do not mind that. Given what you said, you need to create two layers in your map. One for a continuous variable, and the other for a discrete variable. This means that you need to create two sets of colors. As you used, you want to use colorNumeric() for the continuous variable. You want to use colorFactor() for the discrete variable. In my sample code, I create a new discrete variable called group. Once you finish creating the color palettes, you want to draw a map. You need to use addPolygons() twice. Make sure that you use group. This is going to appear in the layer control button on the right upper corner. As far as I know, we cannot display one legend only at the moment. I came across this issue before and concluded that we have no choice at the moment. I hope this demonstration is enough for you to make a progress in your task.
library(raster)
library(dplyr)
library(leaflet)
# Get UK polygon data
UK <- getData("GADM", country = "GB", level = 2)
### Create dummy data
set.seed(111)
mydf <- data.frame(place = unique(UK$NAME_2),
value = sample.int(n = 1000, size = n_distinct(UK$NAME_2), replace = TRUE))
### Create a new dummy column for a discrete variable.
mydf <- mutate(mydf, group = cut(value, breaks = c(0, 200, 400, 600, 800, 1000),
labels = c("a", "b", "c", "d", "e"),
include.lowest = TRUE))
### Create colors for the continuous variable (i.e., value) and the discrete variable.
conpal <- colorNumeric(palette = "Blues", domain = mydf$value, na.color = "black")
dispal <- colorFactor("Spectral", domain = mydf$group, na.color = "black")
leaflet() %>%
addProviderTiles("OpenStreetMap.Mapnik") %>%
setView(lat = 55, lng = -3, zoom = 6) %>%
addPolygons(data = UK, group = "continuous",
stroke = FALSE, smoothFactor = 0.2, fillOpacity = 0.3,
fillColor = ~conpal(mydf$value),
popup = paste("Region: ", UK$NAME_2, "<br>",
"Value: ", mydf$value, "<br>")) %>%
addPolygons(data = UK, group = "discrete",
stroke = FALSE, smoothFactor = 0.2, fillOpacity = 0.3,
fillColor = ~dispal(mydf$group),
popup = paste("Region: ", UK$NAME_2, "<br>",
"Value: ", mydf$group, "<br>")) %>%
addLayersControl(overlayGroups = c("continuous", "discrete")) %>%
addLegend(position = "bottomright", pal = conpal, values = mydf$value,
title = "UK value",
opacity = 0.3) %>%
addLegend(position = "bottomleft", pal = dispal, values = mydf$group,
title = "UK group",
opacity = 0.3)
If you choose the continuous-variable layer, you will see the following map.
If you choose the discrete-variable layer, you will see the following map.
Update
If you want to show both a continuous group and a continuous group together, you need to subset your data beforehand so that there is no overlapping in polygons. Using UK and mydf above, you can try something like this.
### Subset data and create two groups. This is something you gotta do
### in your own way given I have no idea of your own data.
con.group <- mydf[1:96, ]
dis.group <- mydf[97:192, ]
### Create colors for the continuous variable (i.e., value) and the discrete variable.
conpal <- colorNumeric(palette = "Blues", domain = c(min(mydf$value), max(mydf$value)), na.color = "black")
dispal <- colorFactor(palette = "Reds", "Spectral", levels = unique(mydf$group), na.color = "black")
### Subset the polygon data as well
con.poly <- subset(UK, NAME_2 %in% con.group$place)
dis.poly <- subset(UK, NAME_2 %in% dis.group$place)
leaflet() %>%
addProviderTiles("OpenStreetMap.Mapnik") %>%
setView(lat = 55, lng = -3, zoom = 6) %>%
addPolygons(data = con.poly, group = "continuous",
stroke = FALSE, smoothFactor = 0.2, fillOpacity = 0.3,
fillColor = ~conpal(con.group$value),
popup = paste("Region: ", UK$NAME_2, "<br>",
"Value: ", con.group$value, "<br>")) %>%
addPolygons(data = dis.poly, group = "discrete",
stroke = FALSE, smoothFactor = 0.2, fillOpacity = 0.3,
fillColor = ~dispal(dis.group$group),
popup = paste("Region: ", UK$NAME_2, "<br>",
"Group: ", dis.group$group, "<br>")) %>%
addLayersControl(overlayGroups = c("continuous", "discrete")) %>%
addLegend(position = "bottomright", pal = conpal, values = con.group$value,
title = "UK value",
opacity = 0.3) %>%
addLegend(position = "bottomleft", pal = dispal, values = dis.group$group,
title = "UK group",
opacity = 0.3)

Related

How to distinguish Categorical Variables by Color using leaflet in R

I'm making an interactive map of squirrels chasing behavior in New York central Park and I'm using "leaflet" in R.I want to use different colors to distinguish the different times (PM,AM) so that we can see how chasing behavour varies across.
pal <- colorNumeric(palette = "RdYlBu",domain = d$chasingInt)
d %>%
filter(!is.na(chasingInt)) %>%
leaflet() %>%
addTiles() %>%
addCircleMarkers(lng = ~x,
lat = ~y, radius = 3, stroke = FALSE, fillOpacity = 0.5) %>%
addLegend(position ="bottomright", pal = pal, values = ~ chasingInt)%>%
addCircleMarkers(~x,
~y,
radius = ~chasingInt/10,
color ="red",
stroke = FALSE,
fillOpacity = 0.4,
group = "shift",
popup = ~as.character(shift))
All PM and AM are colored as red so there is no difference on the plot

Getting error while adding legend in leaflet object in R

I am trying to create a map in ggplot using leaflet library in R, I am pretty new to R programing. My dataset is per capita carbon emission of different countries in the world. For this, I first merge the shp file with my dataset, then created lables, bins and palette and then added polygons. But when I am trying to add legend using addlegend(), its throwing the following error:
Error in as.character(x) :
cannot coerce type 'closure' to vector of type 'character'.
I have checked code in stages and codes works until I add legend, so suspecting either some issue in pal or value in addlegend().
library(leaflet)
library(ggplot2)
library(dplyr)
library(rgeos)
library(maptools)
library(ggmap)
library(broom)
library(readr)
library(lubridate)
library(dplyr)
library(tidyr)
library(scales)
library(RColorBrewer)
theme_set(theme_minimal())
# Read data into per_capita_emission object
per_capita_emission <- read.csv('co-emissions-per-capita.csv')
# Filter dataframe for year 2017
per_capita_emission_2017 <- per_capita_emission %>% filter(Year == "2017")
# read shape file into R
Countries_shp<-readShapeSpatial("World_Countries/World_Countries.shp",delete_null_obj=TRUE)
# leaflet
p1 <- leaflet(Countries_shp) %>%
setView(lng = 145.5, lat = -36.5, zoom = 2)
p1 %>% addPolygons()
per_capita_emission_2017$COUNTRY <- per_capita_emission_2017$Entity
per_capita_emission_2017<-select (per_capita_emission_2017,-c(Entity))
merge.per_capita_emission_2017_shp<-sp::merge(Countries_shp, per_capita_emission_2017,
by="COUNTRY", duplicateGeoms = TRUE)
bins <- quantile(
merge.per_capita_emission_2017_shp$Per_capita_emissions_in_tonnes,
probs = seq(0,1,.2), names = FALSE, na.rm = TRUE)
pal <- colorBin(
"YlOrRd",
domain = merge.per_capita_emission_2017_shp$Per_capita_emissions_in_tonnes,
bins = 4,
pretty = FALSE
)
p1 <- leaflet(merge.per_capita_emission_2017_shp) %>%
setView(lng = 147, lat = -36.5, zoom = 2)
p1 %>% addPolygons(
fillColor = ~pal(Per_capita_emissions_in_tonnes),
weight = 2,
opacity = 1,
color = "white",
dashArray = "3",
fillOpacity = 0.7,
highlight = highlightOptions(
weight = 3,
color = "#666",
dashArray = "",
fillOpacity = 0.7,
bringToFront = TRUE))
labels <- sprintf(
"<strong>%s</strong><br/>%g Per_capita_emissions_in_tonnes",
merge.per_capita_emission_2017_shp$COUNTRY,
merge.per_capita_emission_2017_shp$Per_capita_emissions_in_tonnes
) %>% lapply(htmltools::HTML)
p1 %>% addPolygons(
data = merge.per_capita_emission_2017_shp,
fillColor = ~pal(merge.per_capita_emission_2017_shp$Per_capita_emissions_in_tonnes),
weight = 2,
opacity = 1,
color = "white",
dashArray = "3",
fillOpacity = 0.7,
highlight = highlightOptions(
weight = 5,
color = "#666",
dashArray = "3",
fillOpacity = 0.7,
bringToFront = TRUE),
label = labels,
labelOptions = labelOptions(
style = list("font-weight" = "normal", padding = "3px 8px"),
textsize = "15px",
direction = "auto"))%>%
addLegend(pal = pal,
values = merge.per_capita_emission_2017_shp$Per_capita_emissions_in_tonnes,
opacity = 0.7,
title = "Per_capita_emissions_in_tonnes",
position = "bottomright"
) %>%
addControl(title, position = "topright")
Following is the link to get the dataset, please include blob: to download data:
blob:https://ourworldindata.org/27f19210-ac40-4909-9826-c7a72dc64a23
Following is the link to get the shp file for country's cordinates:
https://tapiquen-sig.jimdofree.com/app/download/5496966159/World_Countries.rar?t=1589254856
Sorry this is going to be more of a clarification, but I cant comment (not enough reputation).
I think what may be happening is the addLegend is seeing your values as a character or its not recognizing it because it could be seeing it as a shapefile database, so maybe something like merge.per_capita_emission_2017_shp#data$Per_capita_emissions_in_tonnes.
When you merge that data to the shapefile you produce both the shapes and data together in a list like vector, so be sure to call the data portion of that from where you merged it.
For example in my leaflet if have (values = dataM#data[,6]) with data being the sub-spreadsheet i want to call from within the shapefile list.
I dont know the structure of the dataset (the link is 404ing), so this is purely guesswork.
Sorry I cant be more specific
I think you should change like that:
addLegend(pal = pal, <br>
values = per_capita_emission_2017_shp$Per_capita_emissions_in_tonnes,<br>
opacity = 0.7, <br>
title = "Per_capita_emissions_in_tonnes",<br>
position = "bottomright"<br>
)

How to use a non-default colorscale in R plotly chloropleth maps?

I'm creating a chloropleth map in R using plotly, and the only trouble I'm having is setting a different colorscale. I would like to use the magma colorscale from the viridis package, but I can't seem to figure out the correct way to do it. I've tried googling and searching, but no answers are quite working. Anyone have any advice?
The error I'm getting is: "unique() only applies to vectors."
I've tried setting "discrete = TRUE" but that does not work.
Let me know if you need more information.
create_cw_map <- function(data, color_var) {
if (is.null(data))
return(NULL)
g <- list(scope = "usa",
projection = list(type = "albers usa"),
showlakes = FALSE)
cw_map <- plot_geo(data,
locationmode = "USA-states") %>%
add_trace(z = ~ get(color_var),
locations = ~ state,
color = ~ get(color_var),
colorscale = scale_fill_viridis(option = "magma")) %>%
colorbar(title = color_var) %>%
layout(geo = g)
print(cw_map)
}
I do not have access to your data. So I decided to use the tutorial data from the plotly package to demonstrate how to use viridis colors.
Continuous veariable
If you read the help page for plot_ly(), you see that colors is specified as either a colorbrewer2.org palette name (e.g. "YlOrRd" or "Blues"), or a vector of colors to interpolate in hexadecimal "#RRGGBB" format, or a color interpolation function like colorRamp(). What you can do is to create a vector of colors using magma() in the viridisLite package. Here I specified colors = magma(50, alpha = 1, begin = 0, end = 1, direction = 1). n = 50 indicates that I want 50 colors in the color vector. You want to play around with this number for your own case.
library(dplyr)
library(viridis)
library(plotly)
df <- read.csv("https://raw.githubusercontent.com/plotly/datasets/master/2011_us_ag_exports.csv")
df$hover <- with(df, paste(state, '<br>', "Beef", beef, "Dairy", dairy, "<br>",
"Fruits", total.fruits, "Veggies", total.veggies,
"<br>", "Wheat", wheat, "Corn", corn))
# give state boundaries a white border
l <- list(color = toRGB("white"), width = 2)
# specify some map projection/options
g <- list(scope = 'usa',
projection = list(type = 'albers usa'),
showlakes = TRUE,
lakecolor = toRGB('white'))
p <- plot_geo(df, locationmode = 'USA-states') %>%
add_trace(z = ~total.exports,
text = ~hover,
locations = ~code,
color = ~total.exports,
colors = magma(50, alpha = 1, begin = 0, end = 1, direction = 1)) %>%
colorbar(title = "Millions USD") %>%
layout(title = '2011 US Agriculture Exports by State<br>(Hover for breakdown)',
geo = g)
Categorical variable
After posting my answer, I thought you were using a categorical variable. I played around the example and think that it is tricky to create a chloropleth map with such a variable in plotly. At least, I can assign colors to polygons based on a categorical variable, but a color bar appears in a funny way. So I removed it. (If anybody can improve this part, please do so.)
Using the same data, I did the following. I created a categorical variable using ntile() in the dplyr package. I randomly created 9 levels in total.exports. Then, I created nine colors using magma(). When I drew the map below, I used colors = foo[df$export_nth]. This is basically creating 50 colors using foo. export_nth is used as index numbers. I hope this will help you to think how you can solve your situation.
mutate(df, export_nth = ntile(x = total.exports, n = 9)) -> df
# Create a magma color vector
foo <- magma(n = 9, alpha = 1, begin = 0, end = 1, direction = 1)
p <- plot_geo(df, locationmode = 'USA-states') %>%
add_trace(z = ~export_nth,
text = ~hover,
locations = ~code,
colors = foo[df$export_nth],
color = ~export_nth,
showscale = FALSE) %>%
layout(title = '2011 US Agriculture Exports by State<br>(Hover for breakdown)',
geo = g)

Merge and plot multiple isochrones

What I like to do
I like to plot isochrones from multiple locations on a map so I can visually find the travel time from an arbitrary town to the closest location. It should look like a kernel density 2D plot:
library(purrr)
library(ggmap)
locations <- tibble::tribble(
~city, ~lon, ~lat,
"Hamburg", 9.992246, 53.550354,
"Berlin", 13.408163, 52.518527,
"Rostock", 12.140776, 54.088581
)
data <- map2_dfr(locations$lon, locations$lat, ~ data.frame(lon = rnorm(10000, .x, 0.8),
lat = rnorm(10000, .y, 0.7)))
ger <- c(left = min(locations$lon) - 1, bottom = min(locations$lat) - 1,
right = max(locations$lon) + 1, top = max(locations$lat) + 1)
get_stamenmap(ger, zoom = 7, maptype = "toner-lite") %>%
ggmap() +
stat_density_2d(data = data, aes(x= lon, y = lat, fill = ..level.., alpha = ..level..),
geom = "polygon") +
scale_fill_distiller(palette = "Blues", direction = 1, guide = FALSE) +
scale_alpha_continuous(range = c(0.1,0.3), guide = FALSE)
What I tried
You can easily get isochrones via osrm and plot them with leaflet. However, these isochrones are independent from each other. When I plot them they overlap each other.
library(osrm)
library(leaflet)
library(purrr)
library(ggmap)
locations <- tibble::tribble(
~city, ~lon, ~lat,
"Hamburg", 9.992246, 53.550354,
"Berlin", 13.408163, 52.518527,
"Rostock", 12.140776, 54.088581
)
isochrone <- map2(locations$lon, locations$lat,
~ osrmIsochrone(loc = c(.x, .y),
breaks = seq(0, 120, 30))) %>%
do.call(what = rbind)
isochrone#data$drive_times <- factor(paste(isochrone#data$min, "bis",
isochrone#data$max, "Minuten"))
factpal <- colorFactor("Blues", isochrone#data$drive_times, reverse = TRUE)
leaflet() %>%
setView(mean(locations$lon), mean(locations$lat), zoom = 7) %>%
addProviderTiles("Stamen.TonerLite") %>%
addPolygons(fill = TRUE, stroke = TRUE, color = "black",
fillColor = ~factpal(isochrone#data$drive_times),
weight = 0.5, fillOpacity = 0.6,
data = isochrone, popup = isochrone#data$drive_times,
group = "Drive Time") %>%
addLegend("bottomright", pal = factpal, values = isochrone#data$drive_time,
title = "Fahrtzeit")
How can I merge these isochrone so that they don't overlap?
Really cool question. What you want to do is merge the shapes by ID, so all the 0-30 minute areas are one shape, all the 30-60 minute areas are another, and so on. There are ways to do this with other spatial packages, but it seems well-suited to sf, which uses dplyr-style functions.
After you create isochrone, you can convert it to a sf object, make the same type of distance label, group by ID, and call summarise. The default when you summarize sf objects is just a spatial union, so you don't need to supply a function there.
library(sf)
library(dplyr)
iso_sf <- st_as_sf(isochrone)
iso_union <- iso_sf %>%
mutate(label = paste(min, max, sep = "-")) %>%
group_by(id, label) %>%
summarise()
I didn't have leaflet handy, so here's just the default print method:
plot(iso_union["label"], pal = RColorBrewer::brewer.pal(4, "Blues"))
I'm not sure what's up with the areas that have abrupt vertical edges, but those are in your plot as well.
I had a hard time using the map2 method you used because it does both a union as well as, I think, another set theory like function to create specific intervals. Instead, I would recommend creating a raster layer of the layers you create and apply one opacity to that one raster, like the ggmap example does. There's an excellent blog post that I stole alot of code from here (along with from user:camille).
It uses a different API that requires mapbox but it is free. Another limitation is that it won't return isocrones that are the size you like but I recreated it in another location where three points are closer together to prove the method.
I also didn't bother vectorizing the process of creating the isocrone web request so I leave that to someone smarter.
# First be sure to get your mapbox token
library(fasterize)
library(sf)
library(mapboxapi)
library(leaflet)
#mapboxapi::mb_access_token("Go get the token and put it here",
# install = TRUE, overwrite = TRUE)
isos1 <- mb_isochrone(
location = c("-149.883234, 61.185765"),
profile = "driving",
time = c(5,10,15),
)
isos2 <- mb_isochrone(
location = c("-149.928200, 61.191227"),
profile = "driving",
time = c(5,10,15),
)
isos3 <- mb_isochrone(
location = c("-149.939484, 61.160192"),
profile = "driving",
time = c(5,10,15),
)
library(sf)
library(dplyr)
isocrones <- rbind(isos1,isos2,isos3)
iso_sf <- st_as_sf(isocrones)
iso_union <- iso_sf %>%
group_by(time) %>%
summarise()
isos_proj <- st_transform(iso_sf, 32615)
template <- raster(isos_proj, resolution = 100)
iso_surface <- fasterize(isos_proj, template, field = "time", fun = "min")
pal <- colorNumeric("viridis", isos_proj$time, na.color = "transparent")
leaflet() %>%
addTiles() %>%
addRasterImage(iso_surface, colors = pal, opacity = 0.5) %>%
addLegend(values = isos_proj$time, pal = pal,
title = "Minutes of Travel") %>%
addMarkers(lat = c(61.185765, 61.191227, 61.160192), lng = c(-149.883234, -149.928200, -149.939484))

Distinguish Categorical Variables by Color using leaflet in R

I'm making an interactive map of a population in the D.C. area using "leaflet" in R, and I want to use different colors to distinguish the 7 different communities. My variables are: address, community, gender, and name(for the pop-ups). I used some of the code from TrendCt and Ripples.
How would I tweak my code to show the different colors for different communities, and maybe even how could I have change the shades to distinguish by gender in the communities?
Here is my code:
###########################################################################
#################### D.C. Community Map in R ##############################
###########################################################################
## Retrieve Data and Download Package
# Use import data set dropdown menu to import data correctly
# Community Map.csv
# Load packages
library(dplyr)
library(ggmap)
library(leaflet)
# Define new data set
ysa <- Community.Map
## Generate dataset with coordinate variables
## Averages 10 minutes to render on my i5 processor
ysa %>%
mutate(address=paste(gender, sep=", ", ward)) %>%
select(address) %>%
lapply(function(x){geocode(x, output="latlon")}) %>%
as.data.frame %>%
cbind(ysa) -> ysa1
ysa %>%
mutate(popup_info=paste(sep = "<br/>", paste0("<b>","<i>", ward,"<i>", "
</b>"), name)) %>%
mutate(lon=ifelse(is.na(longitude), address.lon, longitude),
lat=ifelse(is.na(latitude), address.lat, latitude)) %>%
filter(!is.na(lon) & !grepl("CLOSED", ward)) -> ysa2
# Plot the map
leaflet(ysa2) %>%
addProviderTiles("CartoDB.Positron") %>%
addCircleMarkers(lng = ~longitude,
lat = ~latitude,
radius = 1.5,
color = "red",
stroke=FALSE,
fillOpacity = 0.8,
popup = ~popup_info) %>%
addLegend("bottomright", colors= "red", labels="Community ", title="YSA
Bounderies by Community")
I have been attempting to divide by colors using the following code:
# color <- colorFactor(c("blue", "red", "green", "yellow", "brown", "gold", "purple"),
domain = c("Braddock", "Shenandoah", "Langley", "DC 2nd", "Colonial 1st",
"Colonial 2nd", "Glenn Dale"))
Essentially, I want to assign a different color per community, like attempted in the above text, but I'm missing something. Please share if you have ideas.
It looks like you haven't connected the colour palette you created to the data and the legend. Try something along the lines of:
library(viridis) # My favorite palette for maps
wardpal <- colorFactor(viridis(7), ysa2$ward) # I'm assuming the variable ward contains the names of the communities.
leaflet(ysa2) %>%
addProviderTiles("CartoDB.Positron") %>%
addCircleMarkers(lng = ~longitude,
lat = ~latitude,
radius = 1.5,
fillColor = ~wardpal(ward),
stroke=FALSE,
fillOpacity = 0.8,
popup = ~popup_info) %>%
addLegend("bottomright", pal = wardpal, values = ~ward, labels = "Community ", title = "YSA Bounderies by Community")
You also want to encode gender in the colour shading. Have you tried mapping fillOpacity to a variable describing gender distribution (e.g., fillOpacity = ~ percent_female). Alternatively, you could add a separate layer for each community, setting the palette for each layer based on gender prevalence. You can tie all the layers together using the 'group' parameter within each addCirlayer call.

Resources