Chloropleth graph colours in the wrong countries - r

Bit of a strange problem using the leaflet package on R. I'm trying to colour in certain countries depending on how many users are in those countries. Everything goes well, except the countries are being coloured in with the wrong data. So for example, Morocco is being coloured in as if it were Jordan, etc.
I'm working with this free world map shapefile: http://thematicmapping.org/downloads/world_borders.php
When I draw a map with only the data included with the shapefile (data$POP2005), everything is fine. So perhaps there is a problem with my join?
user_data table:
NAME USERS
Morocco 250
Jordan 1000
Canada 5007
Code used:
world <- readOGR(dsn=path.expand("~/TM_WORLD_BORDERS_SIMPL-0.3"),
layer="TM_WORLD_BORDERS_SIMPL-0.3")
world#data <- merge(world#data, user_data, by="NAME", all.x = TRUE)
pal <- colorBin("YlOrRd", domain = world#data$USERS, bins = 5)
m <- leaflet(world) %>%
addTiles() %>%
addPolygons(
fillColor = ~pal(world#data$USERS),
weight = 2,
opacity = 1,
color = "white",
dashArray = "3",
fillOpacity = 0.7)
m
When I try the code above, Morocco is showing as 1000 users (the result Jordan should have). Other countries are similarly incorrect. What am I doing wrong?
Many thanks!

I think that by merging world#data with itself is causing some strange interactions that are hard to track down (for example, in my first attempt Morocco was fine but Cuba was red). Instead I used sp::merge from the sp package which allowed me to simplify my code a bit:
library(rgdal)
library(leaflet)
user_data <- data.frame(NAME = c("Morocco", "Jordan", "Canada"),
USERS = c(250, 1000, 5007))
world <- readOGR(dsn="TM_WORLD_BORDERS_SIMPL-0.3.shp",
layer="TM_WORLD_BORDERS_SIMPL-0.3")
world_merged <- sp::merge(world, user_data)
pal <- colorBin("YlOrRd", domain = world_merged$USERS, bins = 5)
m <- leaflet(world) %>%
addTiles() %>%
addPolygons(
fillColor = ~pal(world_merged$USERS),
weight = 2,
opacity = 1,
color = "white",
dashArray = "3",
fillOpacity = 0.7)
m
And yielded this leaflet map (zoomed in here):

Related

Loop through dataframe and produce individual location maps

I want to loop through a dataframe that contains different monitoring sites and produce an individual leaflet map for each site.
See the minimal example below. I realize the loop, as written, will just overwrite each map. In my actual file, each site will have its own individual .html file with some ancillary information specific to each site produced at the end of the loop.
Is it possible to create leaflet maps in this way while retaining the for-loop? Do I need to add in a step that filters the larger dataframe based on the current site in the loop, and use that? Thanks in advance!
library(leaflet)
library(dataRetrieval)
# Create dataframe with 3 example sites
site1 <- readNWISsite(372322081241501)
site2 <- readNWISsite(380252079472801)
site3 <- readNWISsite(372223080234801)
df <- rbind(site1, site2)
df <- rbind(df, site3)
# Create a location map for each individual site in df
map <- leaflet()
q <- length(df$site_no)
for (j in 1:q) {
map %>%
addCircleMarkers(
lng = df[j]$dec_long_va,
lat = df[j]$dec_lat_va,
radius = 9.0,
color = "black",
weight = 1,
fillColor = "gray",
stroke = T,
fillOpacity = 1.0
)
}
# Error in validateCoords(lng, lat, funcName) :
# addCircleMarkers requires non-NULL longitude/latitude values
First, the issue with your code is that you have use df[j, ] instead of df[j] to get the first row of your data. But IMHO you could achieve your result much easier by using a list and to use lapply to read your data and to create your maps. Not sure what's the next step in your workflow. As you say that you want to add the maps to a HTML document per site you could for example loop over the list of maps to add them to create your documents.
library(leaflet)
library(dataRetrieval)
siteNumbers <- c(372322081241501, 380252079472801, 372223080234801)
names(siteNumbers) <- paste0("site", seq_along(siteNumbers))
sites <- lapply(siteNumbers, readNWISsite)
lapply(sites, function(x) {
leaflet() %>%
addCircleMarkers(
data = x,
lng = ~dec_long_va,
lat = ~dec_lat_va,
radius = 9.0,
color = "black",
weight = 1,
fillColor = "gray",
stroke = T,
fillOpacity = 1.0
)
})
#> $site1
#>
#> $site2
#>
#> $site3
But just in case. If you want to stick with the for loop you could achieve the same result like so:
library(leaflet)
library(dataRetrieval)
# Create dataframe with 3 example sites
site1 <- readNWISsite(372322081241501)
site2 <- readNWISsite(380252079472801)
site3 <- readNWISsite(372223080234801)
df <- rbind(site1, site2)
df <- rbind(df, site3)
map <- leaflet()
maps <- list()
for (j in seq(nrow(df))) {
maps[[j]] <- map %>%
addCircleMarkers(
lng = df[j, "dec_long_va"],
lat = df[j, "dec_lat_va"],
radius = 9.0,
color = "black",
weight = 1,
fillColor = "gray",
stroke = T,
fillOpacity = 1.0
)
}
maps
#> [[1]]
#>
#> [[2]]
#>
#> [[3]]

Repeating values on map:leaflet map

I am trying to make a map using leaflet. I uploaded a shapefile of 216 districts. I also have a dataset with information from 7 out the 216 districts.
I was hoping for the map to have districts that don't have values or 0% in grey saying not enough information". While having districts with actual values (>0%) showing up as colour following their corresponding bins.
When I tried to do upload my dataset and shapfile, I got a map with coloured districts everywhere. Based on my dataset, there are suppose to be 4 districts (>0%) in colour. But this is not what I see on my map.
How do I make sure that only the districts in my dataset light up where it is suppose to light up, without repeating all over the map? (while maintaining the backdrop of all the other districts in grey)
So far this is the code I used to achieved the map:
districtsg <-readOGR("sample/copyfile/Districts/Map_of_Districts_.shp")
districtsg <- sp::spTransform(districtsg, CRS("+proj=longlat +datum=WGS84"))
wpnew <- wpnew [order(match(wpnew$District,districtsg$NAME)),]
bins <- c(0.1,2.0,5.0,10.0,25.0,40.0,50.0)
pal<- colorBin("YlOrRd",domain=wpnew$per.content,bins=bins)
m<- leaflet() %>%
setView(lng = -1.0232,lat=7.9465,zoom = 6) %>%
addProviderTiles(providers$Stamen.Toner) %>%
addPolygons(data =districtsg,
weight = 1,
smoothFactor = 0.5,
color = "White",
fillOpacity = 0.8,
fillColor= ~pal(wpnew$per.content),
highlight = highlightOptions(
weight = 5,
color = "#666666",
dashArray = "",
fillOpacity = 0.7,
bringToFront = TRUE
))
m
labels <- paste( "<p>","District:", districtsg$NAME,"</p>",
"<p>", "% of reports that are content:",round(wpnew$per.content,digits = 3),"</p>",
"<p>", "Total reports labelled as a content:",round(wpnew$totalcontent,digits = 3),"</p>",
"<p>", "Total reports from this district:",round(wpnew$totalreports,digits = 3),"</p>",sep = "" )
m<- leaflet() %>%
setView(lng = -1.0232,lat=7.9465,zoom = 6) %>%
addProviderTiles(providers$Stamen.Toner) %>%
addPolygons(data =districtsg,
weight = 1,
smoothFactor = 0.5,
color = "White",
fillOpacity = 0.8,
fillColor= pal(wpnew$per.content),
label = lapply(labels,HTML)) %>%
addLegend(pal=pal,
values = wpnew$per.content,
opacity = 0.7,
"topright")
m
districts totalreports totalcontent per.content
1 Jomoro 4 2 50.00000
2 Ellembelle 2 1 50.00000
3 Tarkwa Nsuaem 1 0 0.00000
4 Bia West 1 0 0.00000
5 Bodi 2 0 0.00000
6 Accra Metropolis 3 1 33.33333
7 Adenta 3 1 33.33333
shapefile can be downloaded here:
https://data.gov.gh/dataset/shapefiles-all-districts-ghana-2012-216-districts
I handling the joining of shape file and the data file differently and I create my base map using tmap. but perhaps this will be helpful.
library(rgdal)
library(tmap)
library(leaflet)
####Access shape map
elem <- readOGR(dsn = "Data/P3Map", layer = "Boundary___ES")
####Preschool Status for Elementary Schools####
schoolAdresses_PK_2021 <- read_excel("Data/P3Map/schoolAdresses_PK_2021.xlsx") %>%
mutate(PreK= factor(PreK)) %>%
clean_names("lower_camel") %>%
mutate(programType = factor(programType))
##### Merge shape with PreK info######
map <- merge(elem, by.x = "ES_Name", schoolAdresses_PK_2021, by.y = "esName" )
#### Render Map####
MyColors <- c('#e2a331', '#d3d3d3','#3688c8') #yellow, #grey, #blue
PKMap <- tm_shape(map)+
tm_fill(col="preK",
title = " ",
palette = MyColors)+
tm_shape(JeffcoMap)+
tm_borders(col = "white")+
tm_layout("Jeffco PreK Expansion 2019-2020", legend.text.size = -0.5)+
tm_text(text = "ES_ShortNa", size = 0.5, group = "Site Names")
PKMap %>% tmap_leaflet() %>%
setView(lng = -105.10033, lat = 39.6, zoom =9) %>% #lat and long of my district
addProviderTiles('Esri.WorldGrayCanvas', group='Grayscale Map') %>%
addProviderTiles('OpenStreetMap', group='Street Map') %>%
addMarkers(lng = -105.155927, #add marker for PK detached from elementary
lat = 39.746347,
icon = YellowIcon,
label = "Litz",
popup = "<b>Program type:</b><br>Ext. Day",
popupOptions = labelOptions(direction = "bottom",
textsize = "8px"),
group = "Stand alone PreK")
from here you can add leaflet layers
It's tough without your data, but I hope this is helpful. In my case, I am mapping 95 elementary schools in one district.
Your 'districtsg' = My 'elem'
Your 'wpnew' = My 'map'
Example map
Here is my attempt while using your datasets:
library(rgdal)
library(tmap)
library(leaflet)
library(sp)
districtsg <-readOGR('data/Map_of_Districts_216.shp')
wpnew <- read.csv('data/dataFromStack.csv')
map <- sp::merge(x = districtsg, y = wpnew, by = "NAME")
MyColors <- c('#e2a331', '#d3d3d3','#3688c8') #yellow, #grey, #blue
tm_shape(map)+
tm_fill(col="totalcontent",
title = " ",
palette = MyColors)+
tm_shape(districtsg)+
tm_borders(col = "white")
Here is the result that I get.. It does take a moment to render in the R Studio Viewer

How do I map county-level data as a heatmap using FIPS codes (interactively?) in R

I am hoping to create an interactive map that will allow me to create a plot where users can change the year and variable plotted. I've seen the package tmap be used, so I'm imagining something like that, but I'd also take advice for a static map, or another approach to an interactive one. My data is much, much, richer than this, but looks something like:
example <- data.frame(fips = rep(as.numeric(c("37001", "37003", "37005", "37007", "37009", "37011", "37013", "37015", "37017", "37019"), 4)),
year = c(rep(1990, 10), rep(1991, 10), rep(1992, 10), rep(1993, 10)),
life = sample(1:100, 40, replace=TRUE),
income = sample(8000:1000000, 40, replace=TRUE),
pop = sample(80000:1000000, 40, replace=TRUE))
I'd like my output to be a map of ONLY the counties contained in my dataset (in my case, I have all the counties in North Carolina, so I don't want a map of the whole USA), that would show a heatmap of selected variables of interest (in this sample data, year, life, income, and pop. Ideally I'd like one plot with two dropdown-type menus that allow you to select what year you want to view, and which variable you want to see. A static map where I (rather than the user) defines year and variable would be helpful if you don't know how to do the interactive thing.
I've tried the following (taken from here), but it's static, which is not my ideal, and also appears to be trying to map the whole USA, so the part that's actually contained in my data (North Carolina) is very small.
library(maps)
library(ggmap)
library(mapproj)
data(county.fips)
colors = c("#F1EEF6", "#D4B9DA", "#C994C7", "#DF65B0", "#DD1C77",
"#980043")
example$colorBuckets <- as.numeric(cut(example$life, c(0, 20, 40, 60, 80,
90, 100)))
colorsmatched <- example$colorBuckets[match(county.fips$fips, example$fips)]
map("county", col = colors[colorsmatched], fill = TRUE, resolution = 0,
lty = 0, projection = "polyconic")
Here's almost the whole solution. I had hoped some package would allow mapping to be done by fips code alone, but haven't found one yet. You have to download shapefiles and merge them by fips code. This code does everything I wanted above except allow you to also filter by year. I've asking that question here, so hopefully someone will answer there.
# get shapefiles (download shapefiles [here][1] : http://www2.census.gov/geo/tiger/GENZ2014/shp/cb_2014_us_county_5m.zip )
usgeo <- st_read("~/cb_2014_us_county_5m/cb_2014_us_county_5m.shp") %>%
mutate(fips = as.numeric(paste0(STATEFP, COUNTYFP)))
### alternatively, this code *should* allow you download data ###
### directly, but somethings slightly wrong. I'd love to know what. ####
# temp <- tempfile()
# download.file("http://www2.census.gov/geo/tiger/GENZ2014/shp/cb_2014_us_county_5m.zip",temp)
# data <- st_read(unz(temp, "cb_2014_us_county_5m.shp"))
# unlink(temp)
########################################################
# create fake data
example <- data.frame(fips = rep(as.numeric(c("37001", "37003", "37005", "37007", "37009", "37011", "37013", "37015", "37017", "37019"), 4)),
year = c(rep(1990, 10), rep(1991, 10), rep(1992, 10), rep(1993, 10)),
life = sample(1:100, 40, replace=TRUE),
income = sample(8000:1000000, 40, replace=TRUE),
pop = sample(80000:1000000, 40, replace=TRUE))
# join fake data with shapefiles
example <- st_as_sf(example %>%
left_join(usgeo))
# drop layers (not sure why, but won't work without this)
example$geometry <- st_zm(example$geometry, drop = T, what = "ZM")
# filter for a single year (which I don't want to have to do)
example <- example %>% filter(year == 1993)
# change projection
example <- sf::st_transform(example, "+proj=longlat +datum=WGS84")
# create popups
incomepopup <- paste0("County: ", example$NAME, ", avg income = $", example$income)
poppopup <- paste0("County: ", example$NAME, ", avg pop = ", example$pop)
yearpopup <- paste0("County: ", example$NAME, ", avg year = ", example$year)
lifepopup <- paste0("County: ", example$NAME, ", avg life expectancy = ", example$life)
# create color palettes
yearPalette <- colorNumeric(palette = "Blues", domain=example$year)
lifePalette <- colorNumeric(palette = "Purples", domain=example$life)
incomePalette <- colorNumeric(palette = "Reds", domain=example$income)
popPalette <- colorNumeric(palette = "Oranges", domain=example$pop)
# create map
leaflet(example) %>%
addProviderTiles("CartoDB.Positron") %>%
addPolygons(stroke=FALSE,
smoothFactor = 0.2,
fillOpacity = .8,
popup = poppopup,
color = ~popPalette(example$pop),
group = "pop"
) %>%
addPolygons(stroke=FALSE,
smoothFactor = 0.2,
fillOpacity = .8,
popup = yearpopup,
color = ~yearPalette(example$year),
group = "year"
) %>%
addPolygons(stroke=FALSE,
smoothFactor = 0.2,
fillOpacity = .8,
popup = lifepopup,
color = ~lifePalette(example$life),
group = "life"
) %>%
addPolygons(stroke=FALSE,
smoothFactor = 0.2,
fillOpacity = .8,
popup = incomepopup,
color = ~incomePalette(example$income),
group = "income"
) %>%
addLayersControl(
baseGroups=c("income", "year", "life", "pop"),
position = "bottomleft",
options = layersControlOptions(collapsed = FALSE)
)
I'm still looking for a way to add a "year" filter that would be another interactive radio-button box to filter the data by different years.

label for overlapping polygons in R leaflet

I need to label several overlapping polygons, but only the label of the biggest one is shown. However when I tested with some simulated data the labels were shown correctly. I compared the data in two cases carefully but cannot find the difference caused the problem.
Here is a minimal example of simulated overlapping polygons:
library(leaflet)
library(sp)
poly_a <- data.frame(lng = c(0, 0.5, 2, 3),
lat = c(0, 4, 4, 0))
poly_b <- data.frame(lng = c(1, 1.5, 1.8),
lat = c(2, 3, 2))
pgons = list(
Polygons(list(Polygon(poly_a)), ID="1"),
Polygons(list(Polygon(poly_b)), ID="2")
)
poly_dat <- data.frame(name = as.factor(c("a", "b")))
rownames(poly_dat) <- c("1", "2")
spgons = SpatialPolygons(pgons)
spgonsdf = SpatialPolygonsDataFrame(spgons, poly_dat, TRUE)
leaflet() %>% addPolygons(data = spgonsdf, label = ~name
# ,
# highlightOptions = highlightOptions(
# color = "red", weight = 2,bringToFront = TRUE)
)
It's working properly:
However it didn't work with my data.
https://github.com/rstudio/leaflet/files/1430888/Gabs.zip
You can drag the zip into this site and use the i button to see it's correctly labeled
library(rgdal)
# download Gabs.zip and extract files to Gabs folder
hr_shape_gabs <- readOGR(dsn = 'Gabs', layer = 'Gabs - OU anisotropic')
hr_shape_gabs_pro <- spTransform(hr_shape_gabs,
CRS("+proj=longlat +datum=WGS84 +no_defs"))
leaflet(hr_shape_gabs_pro) %>%
addTiles() %>%
addPolygons(weight = 1, label = ~name)
Only the biggest polygon label is shown:
The data in both case are SpatialPolygonsDataFrame, the data slot have proper polygon names.
Change the order of polygons in hr_shape_gabs: polygon in position 3 should be the smaller one.
library(leaflet)
library(sp)
library(rgdal)
hr_shape_gabs <- readOGR(dsn = 'Gabs - OU anisotropic.shp',
layer = 'Gabs - OU anisotropic')
# Change the position of the smaller and wider polygons
# Position 1 = wider polygon, position 3 = smaller polygon
pol3 <- hr_shape_gabs#polygons[[3]]
hr_shape_gabs#polygons[[3]] <- hr_shape_gabs#polygons[[1]]
hr_shape_gabs#polygons[[1]] <- pol3
hr_shape_gabs$name <- rev(hr_shape_gabs$name)
hr_shape_gabs_pro <- spTransform(hr_shape_gabs,
CRS("+proj=longlat +datum=WGS84 +no_defs"))
leaflet() %>%
addTiles() %>%
addPolygons(data= hr_shape_gabs_pro, weight = 1, label = ~name)
Here's a scalable solution in sf for many layers, based on this answer.
The idea is to order the polygons by decreasing size, such that the smallest polygons plot last.
library(sf)
library(dplyr)
# calculate area of spatial polygons sf object
poly_df$area <- st_area(poly_df)
poly_df <- arrange(poly_df, -area)
# view with labels in leaflet to see that small polygons plot on top
leaflet(poly_df) %>% addTiles() %>% addPolygons(label = ~id)
Apologies for the lack of reproducibility. This is more of a concept answer.

R Leaflet choroplete map with timeslider?

I got time related data (7 years) displayed in a choropleth map, using R and Leaflet-for-R-package. Therefore use a kmz-file for geometry and csv data for attributes. So far I tried it with data for 2 years, using this tutorial:
http://journocode.com/2016/01/28/your-first-choropleth-map/
Following the example, I used my data instead of the given one in the tutorial. Everything worked fine. But longterm, I want to add all my
7 years data, therefore it would be useful to replace the radio button-based layer control by a (time)slider - changing the overlays according to the year.
In a comparable case here on stackoverflow, someone worked with geojson-files as geometry in order to use the timeslider plugin for Leaflet:
Leaflet slider group by year
So do I need to change my geom data into geojson as well?
And do so, how I link my csv-data to geojson and will R be able to cover all?
I hope you might have some suggestions...
https://github.com/Pippo87/R-leaflet-choropleth
Here is my R-script:
library(rgdal)
berlin <- readOGR("LOR-Planungsraeume.kml","LOR_Planungsraum", encoding="utf-8")
plot(berlin)
Auslaender2007 <- read.csv("LOR_Auslaender_2007.csv", encoding="latin1", sep=",", dec=".")
Auslaender2008 <- read.csv("LOR_Auslaender_2008.csv", encoding="latin1", sep=",", dec=".")
library(leaflet)
palette <- colorBin(c('#fef0d9',
'#fdd49e',
'#fdbb84',
'#fc8d59',
'#e34a33',
'#b30000'),
Auslaender2008$ANTEIL, bins = 6, pretty=TRUE, alpha = TRUE)
popup2007 <- paste0("<strong>Auslaender 2007</strong></span>",
"<br><strong>LOR </strong></span>",
Auslaender2007$LORNAME,
"<br><strong> Relativer Auslaenderanteil </strong></span>",
Auslaender2007$ANTEIL
,"<br><strong>Absoluter Auslaenderanteil</strong></span>",
Auslaender2007$AUSLAENDER)
popup2008 <- paste0("<strong>Auslaender 2007</strong></span>",
"<br><strong>LOR </strong></span>",
Auslaender2008$LORNAME,
"<br><strong> Relativer Auslaenderanteil </strong></span>",
Auslaender2008$ANTEIL
,"<br><strong>Absoluter Auslaenderanteil</strong></span>",
Auslaender2008$AUSLAENDER)
mymap <- leaflet() %>%
addProviderTiles("Esri.WorldGrayCanvas", options = tileOptions(minZoom=10, maxZoom=16)) %>%
addPolygons(data = berlin,
fillColor = ~palette(Auslaender2007$ANTEIL),
fillOpacity = 1,
color = "darkgrey",
weight = 1.5,
group="<span style='font-size: 11pt'><strong>2007</strong></span>")%>%
addPolygons(data = berlin,
fillColor = ~palette(Auslaender2008$ANTEIL),
fillOpacity = 1,
color = "darkgrey",
weight = 1.5,
popup = popup2008,
group="<span style='font-size: 11pt'><strong>2008</strong></span>")%>%
addLayersControl(
baseGroups = c("<span style='font-size: 11pt'><strong>2007</strong></span>", "<span style='font-size: 11pt'><strong>2008</strong></span>"),
options = layersControlOptions(collapsed = FALSE))%>%
addLegend(position = 'topleft', pal = palette, values = Auslaender2008$ANTEIL, opacity = 1, title = "Relativer<br>Auslaenderanteil")
print(mymap)

Resources