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)
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 am trying to produce a map by connecting random points on continents. I managed to get close to the desired outcome, but I don't want the points in North America to connect to those in Siberia. But I can't do this using max distance as the points are close, across the North Pole. View the attached plot, to see what I mean.
This is the code I used for connecting points. pts are simply coordinates of the points
neighbors <- 5
nearest <- st_nn(pts, pts, k = neighbors+1, maxdist = 3500000)
connect <- st_connect(pts, pts, nearest) %>% st_as_sf
I then plot the map with
geom_sf(data = connect, color = 'white') +
geom_sf(data = pts, color = 'white', shape = 1, size = 3)
I tried making separate files for North America, Europe, and Asia, but then the points are not consistent in distance. Unless I should use a different tool to get the points, perhaps generate them directly in R? So far I've used QGIS to generate random points in polygons.
How would you go about solving this?
Cheers!
Perhaps this can be solved by just removing those lines which are above a certain "distance" in degrees? Please see below:
library(sf)
library(nngeo)
library(ggplot2)
# Points
pts = read.csv("https://raw.githubusercontent.com/jankomag/delaunay_map/main/points2.csv", sep = ";")
pts = st_as_sf(pts, coords = c("X", "Y"), crs = 4326)
# Lines
neighbors = 5
nearest = st_nn(pts, pts, k = neighbors+1, maxdist = 3500000)
connect = st_connect(pts, pts, nearest) %>% st_as_sf
# Remove very long lines
l = st_length(st_set_crs(connect, NA))
connect = connect[l < 100, ]
# Plot
ggplot() +
geom_sf(data = connect) +
geom_sf(data = pts, shape = 1, size = 3)
I have a data set of latitude/longitude points that seek to convert to a simple feature (sf) in R.
My goal is to plot these locations on a US map with polygons retrieved from the urbnmapr library.
Plotting with our a geographic reference, as shown in the code, results in all points being displayed.
When the points are plotted using geom_sf() they end up in South Dakota. It seems the latitude/longitude points are not being converted into the correct coordinate reference system, despite what I think is the correct use of the st_as_sf() function.
What correction needs to be made to this code to show the distribution of wind turbine locations properly on the US map?
# Map the locations of US Wind Turbines
library(urbnmapr)
library(ggplot2)
library(readr)
library(dplyr)
library(sf)
# This file is available from https://eerscmap.usgs.gov/uswtdb/assets/data/uswtdbCSV.zip
turbine <- read_csv("C:\\mydir\\uswtdb_v3_1_20200717.csv")
# Convert lat/long to a sf
turbine_sf <- turbine %>%
st_as_sf(coords = c("xlong", "ylat"), crs=2163)
# obtain state geometries
states_sf <- get_urbn_map(map = "states", sf = TRUE)
# Remove AK, HI from state and PR and GU from turbines as well
states_sf <- states_sf[!(states_sf$state_abbv %in% c("HI","AK")),]
turbine <- turbine [!(turbine$t_state %in% c('HI','AK','PR','GU')),]
# simple plot shows all locations
ggplot(turbine, aes(x=xlong, y=ylat)) + geom_point()
#plot locations over map
ggplot() +
geom_sf(data = turbine_sf) +
geom_sf(data = states_sf, fill = NA, color = "black", size = 0.15, alpha = 0) +
coord_sf(datum = st_crs(2163)) +
labs(fill = "",
title = "",
caption='') +
theme_bw()
Your turbine dataset contains "xlong" and "ylat" in degrees i.e. geographic coordinate system with WGS84 datum (EPSG code: 4326). So, first, make it as crs = 4326 and then use st_transform(turbine_sf, crs=2163) to make same coordinate system with states_sf. You can use the following code
# Map the locations of US Wind Turbines
library(urbnmapr)
library(ggplot2)
library(readr)
library(dplyr)
library(sf)
# This file is available from https://eerscmap.usgs.gov/uswtdb/assets/data/uswtdbCSV.zip
turbine <- read_csv("uswtdb_v3_1_20200717.csv")
# Convert lat/long to a sf
turbine_sf <- turbine %>%
st_as_sf(coords = c("xlong", "ylat"), crs=4326)
turbine_sf_t <- st_transform(turbine_sf, crs=2163)
# obtain state geometries
states_sf <- get_urbn_map(map = "states", sf = TRUE)
st_crs(states_sf)
# Remove AK, HI from state and PR and GU from turbines as well
states_sf <- states_sf[!(states_sf$state_abbv %in% c("HI","AK")),]
turbine <- turbine [!(turbine$t_state %in% c('HI','AK','PR','GU')),]
# simple plot shows all locations
ggplot(turbine, aes(x=xlong, y=ylat)) + geom_point()
#plot locations over map
ggplot() +
geom_sf(data = turbine_sf_t) +
geom_sf(data = states_sf, fill = NA, color = "black", size = 0.15, alpha = 0) +
coord_sf(datum = st_crs(2163)) +
labs(fill = "",
title = "",
caption='') +
theme_bw()
By doing st_as_sf(coords = c("xlong", "ylat"), crs=2163) you're saying that the original long, lat from your turbine table are based on CRS of 2163. I think you want to set them as 4326 which is the long lat under WGS84.
After setting the initial CRS, use st_transform() to transform the CRS of your shape to new CRS, e.g. turbine_sf <- st_transform(turbine_sf, crs=2163)
I'm trying to create a map with two variables where one is represented by polygon colors (choropleth fill) and the other is represented by bubble size at the centroid of each polygon. To make it concrete, let's consider nc data's two variables AREA and BIR74 where AREA fills the polygon and BIR74 is represented by size. To make it as similar as my actual case, I created a few NA values for BIR74 variable.
library(tidyverse)
library(sf)
nc <- sf::st_read(system.file("shape/nc.shp", package="sf"))
nc_centroids <- data.frame(nc %>% st_centroid() %>% st_coordinates())
nc <- nc %>% bind_cols(nc, nc_centroids) %>% mutate(BIR74 = replace(BIR74, AREA < 0.08, NA))
Now, I hope to create a custom break for BIR74 so that the bubble size is either "big" or "small", but even after supplying scale_size_continuous(breaks = c(1000, 20000)), the bubble size on the map seems to be continuous. For instance, see the red circle area in the map, which show at least three different circle sizes.
Here's what I've tried.
ggplot(nc) + geom_sf(aes(fill = AREA), colour = "white") +
geom_point(aes( x = X, y = Y, size = BIR74)) +
scale_size_continuous(breaks = c(1000, 20000))
I could potentially translate the BIR74 variable to character/factor but in this case I couldn't prevent the NA values show up on the map, which I don't want. Any comments would be appreciated!
Scale breaks do not change how your data is displayed. Also setting the limits has not resulted in a change.
Therefore, transform your data first, and then plot the different sizes.
library(tidyverse)
library(sf)
nc <- sf::st_read(system.file("shape/nc.shp", package="sf"))
nc_centroids <- data.frame(nc %>% st_centroid() %>% st_coordinates())
nc2 <-
nc %>%
bind_cols(nc, nc_centroids) %>%
mutate(BIR74 = replace(BIR74, AREA < 0.08, NA),
BIR74 = if_else(BIR74 < 10000, 1, 2)) %>%
drop_na("BIR74") # this is not necessary, but it makes it visually clearer where you have missing values
ggplot(nc2) +
geom_sf(aes(fill = AREA), colour = "white") +
geom_point(aes( x = X, y = Y, size = BIR74)) +
scale_size_continuous(breaks = 1:2)
Created on 2020-04-26 by the reprex package (v0.3.0)
I need to create heat map with 3 digit zip boundary.
I have 3 digit zip and count data like this
zip <- c(790, 791, 792, 793)
count <- c(0, 100, 20, 30)
TX <- data.frame(zip, count)
Also, I draw TX map.
library(ggplot2)
library(ggmap)
library(maps)
library(mapdata)
states <- map_data("state")
texas<- subset(states, region =="texas")
ggplot(data = texas) +
geom_polygon(aes(x = long, y = lat), fill = "gray", color = "black")
What I want to achieve is to (1) draw boundary with 3 digit zip code and (2) create the heat map using count column. The outcome will looks like this with heat map coloring.
This question does not contain reproducible sample data. Hence, I needed some good amount of time to deliver the following. Please provide minimum reproducible data and codes you tried from next time. (I doubt if you really invested time to seriously write your codes.)
Anyway, I think getting a good polygon data for US zip codes is difficult without paying some money. This question provides good information. I obtained data from this link since the data was accessible. You gotta find whatever suitable polygon data for yourself.
I also obtained data for the zip codes in Texas from here and saved it as "zip_code_database.csv."
I added explanation for each code below. So I do not write a thourough explanation here. Basically, you need to merge polygon data by subtracting the first three numbers in the zip codes. You also need to create an aggregated data for whatever the value you have in your data using the 3-digit zip code. The other thing is to find center points of the polygons to add the zip codes as labels.
library(tidyverse)
library(rgdal)
library(rgeos)
library(maptools)
library(ggalt)
library(ggthemes)
library(ggrepel)
library(RColorBrewer)
# Prepare the zip poly data for US
mydata <- readOGR(dsn = ".", layer = "cb_2016_us_zcta510_500k")
# Texas zip code data
zip <- read_csv("zip_code_database.csv")
tx <- filter(zip, state == "TX")
# Get polygon data for TX only
mypoly <- subset(mydata, ZCTA5CE10 %in% tx$zip)
# Create a new group with the first three digit.
# Drop unnecessary factor levels.
# Add a fake numeric variable, which is used for coloring polygons later.
mypoly$group <- substr(mypoly$ZCTA5CE10, 1,3)
mypoly$ZCTA5CE10 <- droplevels(mypoly$ZCTA5CE10)
set.seed(111)
mypoly$value <- sample.int(n = 10000, size = nrow(mypoly), replace = TRUE)
# Merge polygons using the group variable
# Create a data frame for ggplot.
mypoly.union <- unionSpatialPolygons(mypoly, mypoly$group)
mymap <- fortify(mypoly.union)
# Check how polygons are like
plot(mypoly)
plot(mypoly.union, add = T, border = "red", lwd = 1)
# Convert SpatialPolygons to data frame and aggregate the fake values
mypoly.df <- as(mypoly, "data.frame") %>%
group_by(group) %>%
summarise(value = sum(value))
# Find a center point for each zip code area
centers <- data.frame(gCentroid(spgeom = mypoly.union, byid = TRUE))
centers$zip <- rownames(centers)
# Finally, drawing a graphic
ggplot() +
geom_cartogram(data = mymap, aes(x = long, y = lat, map_id = id), map = mymap) +
geom_cartogram(data = mypoly.df, aes(fill = value, map_id = group), map = mymap) +
geom_text_repel(data = centers, aes(label = zip, x = x, y = y), size = 3) +
scale_fill_gradientn(colours = rev(brewer.pal(10, "Spectral"))) +
coord_map() +
theme_map()