I'm trying to create a map of Europe with grid cells coloured based on the number of records within a cell. Here I attach an image as illustrative of the desired output (see Fig 1 of https://doi.org/10.3897/phytokeys.74.9723).
In order to produce this image I have developed a minimal reproducible example with random points distributed across Europe. I have been able to produce a similar figure with levelplot but I'm particulary interested in doing this with ggplot as it will allow further customising. Is it possible to do produce a similar figure with ggplot? And if so, any advice of what path should I follow?
Note: The size of the grids/cells is irrelevant at the moment but I'll adjust it depending on point density. All of them have to be the same size as in the first example and they only will differ on the pattern of colour.
#Load libraries
library(rgdal) #v1.5-28
library(rgeos) #v.0.5-9
library(ggplot2) # 3.3.5
library(rworldmap) #plot worldmap v.1.3-6
library(dplyr) #v.1.0.7
#Create dataframe of coordinates that fall in Europe
coord <- data.frame(cbind(runif(1000,-15,45),runif(1000,30,75)))
colnames(coord) <- c("long","lat")
#Exlude ocean points following this post
URL <- "http://www.naturalearthdata.com/http//www.naturalearthdata.com/download/110m/physical/ne_110m_ocean.zip"
fil <- basename(URL)
if (!file.exists(fil)) download.file(URL, fil)
fils <- unzip(fil)
oceans <- readOGR(grep("shp$", fils, value=TRUE), "ne_110m_ocean",
stringsAsFactors=FALSE, verbose=FALSE)
europe_coord <- data.frame(long = coord$long,
lat = coord$lat)
coordinates(europe_coord) <- ~long+lat
proj4string(europe_coord) <- CRS(proj4string(oceans))
ocean_points <- over(europe_coord, oceans)
#Add ocean points to dataset
coord$ocean <- ocean_points$featurecla
#Exlude ocean points
europe_land <- coord %>% filter(is.na(ocean))
#Load worldmap
world <- map_data("world")
#Plot europe spatial data
ggplot() + geom_map(data = world, map = world,
aes(long, lat, map_id = region), color = "white",
fill = "lightgray", size = 0.1) +
geom_point(data = europe_land,aes(long, lat),
alpha = 0.7, size = 0.05) + ylim(0,70) +
coord_sf(xlim = c(-15, 45), ylim = c(30, 75), expand = FALSE)
Related
I have the below code which is intended to
a) Draw a base outline layer of all Middle Super Output Areas in the East of England
b) Generate 2,500 buffer boundaries around each plotted point from an imported dataset
c) Plot the buffer boundary layer over the base outline layer.
#Call necessary packages
library(tidyverse)
library (readxl)
library (openxlsx)
library(maptools)
library(classInt)
library(RColorBrewer)
library(sf)
library(tmap)
library(tmaptools)
library(geodata)
#Read in shape file for mapping
shp_name <- C:/Users/JWP/East of England/MSOA/Middle_Layer_Super_Output_Areas_December_2011_Generalised_Clipped_Boundaries_in_England_and_Wales.shp"
EofEMSOAsFinalList <- st_read(shp_name)%>%
st_as_sf
# Create union shape of polygons
union <- st_union(EofEMSOAsFinalList)
#Read in point location data
LocationData <- read_excel("C:/Users/JWP/LocationData.xlsx",
sheet = "Location Data")
#Geocode the address list with 2,500m boundaries around each point
LocationDataPlotted <- st_as_sf(LocationData, coords = c('Latitude', 'Longitude'), crs = 4326)
#Remove geometry
LocationDataPlotted2 <- LocationDataPlotted %>%
as.data.frame() %>%
# calculate around each point a buffer zone of 2,500m
mutate(buffer = st_buffer(geometry, dist = 2500)) %>%
select(-geometry) %>%
st_as_sf()
#Generate bounding box
mask_union <- union %>% as_tibble() %>%
mutate(bbox = st_as_sfc(st_bbox(c(xmin = -5.5, xmax = 9, ymax = 51.5, ymin = 42), crs = st_crs(4326)))) %>%
st_as_sf()
# compute difference between bounding box and union polygon to
# use as mask in the final layer
diff <- st_difference(mask_union$bbox, mask_union$geometry)
# Build map
OutputMap <-
# plot only shapes filled red
tm_shape(EofEMSOAsFinalList) +
tm_fill(col = "red") +
# plot only buffer zones of each point in green
tm_shape(LocationDataPlotted2)+
tm_fill(col = "forestgreen") +
# add mask
tm_shape(diff) +
tm_fill(col = "white") +
# plot borders of shape
tm_shape(EofEMSOAsFinalList) +
tm_borders(col = "white",
lwd = 1,
lty = "solid") +
# add custom legend
tm_add_legend(type = "symbol",
labels = c("Not Within 2500m", "Within 2500m"),
col = c("red", "forestgreen"),
title = "Access type",
size = 1.5,
shape = 21)
The correct output should therefore look similar to the above:
However I am now getting output like the below:
Can anyone please amend the above so it works correctly?
Many thanks
I'm looking to create some proximity maps using R, which show how far areas are from certain points. I can't find any examples in R code, but I've found an output which is the sort of thing I want:
It doesn't necessarily have to have all the labelling/internal boundaries wizardry, but I'd like it to stop at the sea border (thinking of using the rgeos function gintersection - see here).
I've tried doing a density plot as 'heatmaps' (this would be a pretty good solution/alternative) and putting a shapefile over the top (following this suggestion, but they're not lining up and I can't do a gintersection, probably because there's not a coordinate system attached to the density plot.
I used your question to play a little with new libraries...
Get a UK map and define random points
library(raster)
library(sf)
library(ggplot2)
library(dplyr)
library(tidyr)
library(forcats)
library(purrr)
# Get UK map
GBR <- getData(name = "GADM", country = "GBR", level = 1)
GBR_sf <- st_as_sf(GBR)
# Define 3 points on the UK map
pts <- matrix(c(-0.4966766, -2.0772529, -3.8437793,
51.91829, 52.86147, 56.73899), ncol = 2)
# Project in mercator to allow buffer with distances
pts_sf <- st_sfc(st_multipoint(pts), crs = 4326) %>%
st_sf() %>%
st_transform(27700)
ggplot() +
geom_sf(data = GBR_sf) +
geom_sf(data = pts_sf, colour = "red")
Calculate buffer areas
We create a list of multipolygons for each buffer distance. The point dataset must be in projected coordinates (here mercator) as buffer distance is in the scale of the coordinates system.
# Define distances to buffer
dists <- seq(5000, 150000, length.out = 5)
# Create buffer areas with each distances
pts_buf <- purrr::map(dists, ~st_buffer(pts_sf, .)) %>%
do.call("rbind", .) %>%
st_cast() %>%
mutate(
distmax = dists,
dist = glue::glue("<{dists/1000} km"))
# Plot: alpha allows to see overlapping polygons
ggplot() +
geom_sf(data = GBR_sf) +
geom_sf(data = pts_buf, fill = "red",
colour = NA, alpha = 0.1)
Remove overlapping
Buffer areas are overlapping. On the figure above, the more intense red color is due to multiple overlapping layers of transparent red. Let's remove the overlapping. We need to remove from larger areas, the buffer with the lower size. I then need to add again the smallest area to the list.
# Remove part of polygons overlapping smaller buffer
pts_holes <- purrr::map2(tail(1:nrow(pts_buf),-1),
head(1:nrow(pts_buf),-1),
~st_difference(pts_buf[.x,], pts_buf[.y,])) %>%
do.call("rbind", .) %>%
st_cast() %>%
select(-distmax.1, -dist.1)
# Add smallest polygon
pts_holes_tot <- pts_holes %>%
rbind(filter(pts_buf, distmax == min(dists))) %>%
arrange(distmax) %>%
mutate(dist = forcats::fct_reorder(dist, distmax))
# Plot and define color according to dist
ggplot() +
geom_sf(data = GBR_sf) +
geom_sf(data = pts_holes_tot,
aes(fill = dist),
colour = NA) +
scale_fill_brewer(direction = 2)
Remove areas in the sea
If you want to find proximity area on terrestrial parts only, we need to remove buffer areas that are in the sea. Intersection is computed between multipolygons with the same projection. I previously realize an union of the UK map.
# Remove part of polygons in the sea
# Union and projection of UK map
GBR_sf_merc <- st_transform(st_union(GBR_sf), 27700)
pts_holes_uk <- st_intersection(pts_holes_tot,
GBR_sf_merc)
ggplot() +
geom_sf(data = GBR_sf) +
geom_sf(data = pts_holes_uk,
aes(fill = dist),
colour = NA) +
scale_fill_brewer(direction = 2)
And here is the final proximity map using sf, ggplot2 and a few other libraries...
Based on Sébastien's example, a more old-fashioned approach:
library(raster)
GBR <- getData(name = "GADM", country = "GBR", level = 1)
pts <- matrix(c(-0.4966766, -2.0772529, -3.8437793, 51.91829, 52.86147, 56.73899), ncol = 2)
r <- raster(GBR, res=1/12)
d <- distanceFromPoints(r, pts)
m <- mask(d, GBR)
plot(m)
Is it possible to have a layer in ggplot that acts as a mask for a ggmap layer? Here they added a country polygon on top of a ggmap.
What I am looking for is that the country would be a "hole" in a layer (with alpha) covering everything but the country. In a way the inverse of the example above. The code from that answer (with transparency added and updated to use geom_cartogram).
library(mapdata)
library(ggmap)
library(ggplot2)
library(ggalt)
# Get Peru map
Peru <- get_map(location = "Peru", zoom = 5, maptype="satellite")
# This is the layer I wish to put over the top
coast_map <- fortify(map("worldHires", fill = TRUE, plot = FALSE))
# Subset data for Peru
peru.coast <- subset(coast_map, region == "Peru")
# Draw a graphic
ggmap(Peru) +
geom_cartogram(data = peru.coast, map = peru.coast, aes(x = long, y = lat, map_id = region),
fill="white", color="grey", alpha=.1) +
xlim(-86, -68) +
ylim(-20, 0) +
labs(x = "Longitude", y = "Latitude") +
coord_map() +
theme_classic()
Is there a way to fill everything but a polygon in ggplot2?
Is there a way to fill everything but a polygon in ggplot2?
This method may be a bit unorthodox, but anyway:
library(mapdata)
library(ggmap)
library(ggplot2)
library(raster)
ggmap_rast <- function(map){
map_bbox <- attr(map, 'bb')
.extent <- extent(as.numeric(map_bbox[c(2,4,1,3)]))
my_map <- raster(.extent, nrow= nrow(map), ncol = ncol(map))
rgb_cols <- setNames(as.data.frame(t(col2rgb(map))), c('red','green','blue'))
red <- my_map
values(red) <- rgb_cols[['red']]
green <- my_map
values(green) <- rgb_cols[['green']]
blue <- my_map
values(blue) <- rgb_cols[['blue']]
stack(red,green,blue)
}
Peru <- get_map(location = "Peru", zoom = 5, maptype="satellite")
data(wrld_simpl, package = "maptools")
polygonMask <- subset(wrld_simpl, NAME=="Peru")
peru <- ggmap_rast(Peru)
peru_masked <- mask(peru, polygonMask, inverse=T)
peru_masked_df <- data.frame(rasterToPoints(peru_masked))
ggplot(peru_masked_df) +
geom_point(aes(x=x, y=y, col=rgb(layer.1/255, layer.2/255, layer.3/255))) +
scale_color_identity() +
coord_quickmap()
Via this, this, and this questions/answers.
What I am looking for is the surroundings with a transparent fill
layer and Peru with alpha=1
If first thought this is easy. However, then I saw and remembered that geom_polygon does not like polygons with holes very much. Luckily, geom_polypath from the package ggpolypath does. However, it will throw an "Error in grid.Call.graphics(L_path, x$x, x$y, index, switch(x$rule, winding = 1L..." error with ggmaps default panel extend.
So you could do
library(mapdata)
library(ggmap)
library(ggplot2)
library(raster)
library(ggpolypath) ## plot polygons with holes
Peru <- get_map(location = "Peru", zoom = 5, maptype="satellite")
data(wrld_simpl, package = "maptools")
polygonMask <- subset(wrld_simpl, NAME=="Peru")
bb <- unlist(attr(Peru, "bb"))
coords <- cbind(
bb[c(2,2,4,4)],
bb[c(1,3,3,1)])
sp <- SpatialPolygons(
list(Polygons(list(Polygon(coords)), "id")),
proj4string = CRS(proj4string(polygonMask)))
sp_diff <- erase(sp, polygonMask)
sp_diff_df <- fortify(sp_diff)
ggmap(Peru,extent="normal") +
geom_polypath(
aes(long,lat,group=group),
sp_diff_df,
fill="white",
alpha=.7
)
I am trying to plot few points on map. But I get a blank map with just the points marked in red. The map is missing
Below code is reporducible
library(maps)
library(mapdata)
library(ggplot2)
library(ggmap)
lon <- c(-122.1817252,-119.4179324,-95.7128910,-71.0588801,-81.0348144)
lat <- c(37.452960,36.778261,37.090240,42.360082,34.000710)
all_places_geocoded <- data.frame(lon,lat)
gc <- geocode('australia')
center <- as.numeric(gc)
map <- get_googlemap(location = center,maptype = "roadmap", zoom=1)
ggmap(map) +
geom_point(data = all_places_geocoded, color = "red3", size = 1)
I am attempting to make a map with three layers using ggmap. The layers are as follows:
A map of the US (toner-lite)
a set of geometries that color the states on some value (simulated data below)
labels for the state names, as annotations in the center of each state.
To do this I have created a map of US states with states colored by a randomized value (rnorm) and this part is successful. From here I am attempting to print the abbreviations of each state at the longitude and latitude coordinates of each state's center, using geom_text. The part that fails is the 'geom_text' overlay, with the following error:
Error: 'x' and 'units' must have length > 0 In addition: Warning
messages: 1: In gpclibPermit() : support for gpclib will be
withdrawn from maptools at the next major release 2: Removed 855070
rows containing missing values (geom_text).
Here is the script, which I have worked hard to run as on its own. It will download the shapefile and center of state data, as well as to simulate data to fill the states. I've tested it and it works up to what I have commented out (geom_text layer).
I have searched for answers to this already, so please let me know if you have any advice on how to do what I am attempting. If there is a better strategy for placing labels on top of the polygon fills, I am all ears (or eyes in this case).
###Combining Census data with a tract poly shapefile
library(maptools)
library(ggplot2)
library(gpclib)
library(ggmap)
library(rgdal)
library(dplyr)
#Set working directory to where you want your files to exist (or where they already exist)
setwd('~/Documents/GIS/USCensus/')
#Read and translate coord data for shape file of US States
if(!file.exists('tl_2014_us_state.shp')){
download.file('ftp://ftp2.census.gov/geo/tiger/TIGER2014/STATE/tl_2014_us_state.zip',
'tl_2014_us_state.zip')
files <- unzip('tl_2014_us_state.zip')
tract <- readOGR(".","tl_2014_us_state") %>% spTransform(CRS("+proj=longlat +datum=WGS84"))
} else {
tract <- readOGR(".","tl_2014_us_state") %>% spTransform(CRS("+proj=longlat +datum=WGS84"))
}
#two column dataset of state abbreviations and center of state
#Downloadable from: https://dev.maxmind.com/static/csv/codes/state_latlon.csv
if(!file.exists('state_latlon.csv')){
download.file('http://dev.maxmind.com/static/csv/codes/state_latlon.csv','state_latlon.csv')
}
centers <- read.csv('state_latlon.csv')
#Change values of longitude and latitude from state center data so as not to interfere with shapefile at merge
names(centers)[2:3] <- c('long_c','lat_c')
#simulated data for plotting values
mydata<- data.frame(rnorm(55, 0, 1)) #55 "states" in the coord dataset for state centers
names(mydata)[1] <- 'value'
#hold names in tract dataset and for simulated data
ntract<-names(tract)
ndata<-names(mydata)
#Turn geo data into R dataframe
gpclibPermit()
tract_geom<-fortify(tract,region="STUSPS")
#Merge state geo data with simulated data
state_data <- cbind(centers,mydata)
#merge state center and value data with shapefile data
tract_poly <- merge(state_data,tract_geom,by.x="state",by.y="id", all = F)
tract_poly<-tract_poly[order(tract_poly$order),]
#Create map of US
mymap <- get_stamenmap(bbox = c(left = -124.848974,
bottom = 24.396308,
right = -66.885444,
top = 49.384358),zoom=5,
maptype="toner-lite")
#This plots a map of the US with just the state names as labels (and a few other landmarks). Used for reference
USMap <- ggmap(mymap,extent='device') +
geom_polygon(aes(x = long, y = lat, group = group, fill = value),
data = tract_poly,
alpha = 1,
color = "black",
size = 0.2) #+
# geom_text(aes(x = long_c, y = lat_c, group = group, label = state),
# data= tract_poly,
# alpha = 1,
# color = "black")
USMap
That's a strange error message for what ended up being the problem. Somewhere along the way you have flipped the latitude and longitude for centers. (I also took into account elpi's advice above and didn't plot the Initials repeatedly by using your centers dataset directly). The code below works, but I'd recommend fixing your centers dataset.
centers$new_long <- centers$lat_c
centers$new_lat <- centers$long_c
USMap <- ggmap(mymap,extent='device') +
geom_polygon(aes(x = long, y = lat, group = group, fill = value),
data = tract_poly,
alpha = 1,
color = "black",
size = 0.2) +
geom_text(aes(x = new_long, y = new_lat, label = state),
data= centers,
alpha = 1,
color = "black")
Try this
centroids <- setNames(do.call("rbind.data.frame", by(tract_poly, tract_poly$group, function(x) {Polygon(x[c('long', 'lat')])#labpt})), c('long', 'lat'))
centroids$label <- tract_poly$state[match(rownames(centroids), tract_poly$group)]
USMap + with(centroids, annotate(geom="text", x = long, y=lat, label = label, size = 2.5))
(via)