I have a data set of whale sightings with some coordinate gaps but associated with areas of reference, of which I have coordinate limits. I've used these limits to create a polygon restricted to the marine environment (using library ‘sf’) for each of the areas. Now I would like to fill the coordinate gaps by randomly selecting latitudes and longitudes from the polygons.
My piece of code (example for the area 'Angola'):
#Creating a ocean-only polygon for the Southern Hemisphere (my study area)
x_coord = c(180, 180, -180, -180)
y_coord = c(0, -90, -90, 0)
polygonSH = cbind(x_coord, y_coord) %>%
st_linestring() %>%
st_cast("POLYGON") %>%
st_sfc(crs = 4326, check_ring_dir = TRUE) %>%
st_sf()
land = rnaturalearth::ne_countries(returnclass = "sf") %>%
st_union()
ocean = st_difference(polygonSH, land)
plot(st_geometry(land))
plot(st_geometry(polygonSH), add = TRUE)
plot(st_geometry(ocean), add = TRUE, col = "blue")
#Creating ocean-only polygons for each of the different areas to then use them in the arguments to run ramdon coords
#Angola
x_angola = c(11.72,11.72,13.58,13.58) #longitude limits of Angola area
y_angola = c(-12.34,-16.6,-16.6,-12.34) #latitude limits of Angola area
polygon_angola = cbind(x_angola, y_angola) %>%
st_linestring() %>%
st_cast("POLYGON") %>%
st_sfc(crs = 4326, check_ring_dir = TRUE) %>%
st_sf()
plot(st_geometry(land))
plot(st_geometry(polygon_angola), add = TRUE)
angola_ocean = st_difference (polygon_angola, land)
plot(st_geometry(angola_ocean), add = TRUE, col = "pink")
...
Before having the polygons restricted to the marine environment, I've used the code below to randonmly generate the coordinates, and ideally I would like to use something similar, but adjusted to working with spatial data:
for(i in 1:dim(x)[1]) {
x[i,"lat"] <- ifelse(is.na(x[i,"lat"]) && x[i,"area"]=="Angola", runif(1,-16.6,-12.34), x[i,"lat"])
x[i,"long"] <- ifelse(is.na(x[i,"long"]) && x[i,"area"]=="Angola", runif(1, 11.72,13.58), x[i,"long"])
}
I would really appreciate having folk's input on this issue.
I can't get your code to work due to issues (invalid spherical geometry) not directly related to the subject of the question.
So please allow me to illustrate a possible approach using the well known & much loved North Carolina shapefile that ships with the {sf}.
library(sf)
library(dplyr)
# included with sf package
shape <- st_read(system.file("shape/nc.shp", package="sf")) %>%
summarise() # a single polygon
# now the action! 50 random points over North Carolina
random_points <- shape %>%
st_sample(50)
# check results...
plot(shape)
plot(random_points, col = "red", pch = 4, add = T)
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 have a shapefile of local government regions. I use sf_read() to import it into R as an SF object. I want to compute the distance between the local government regions. st_centroid() gives me polygon centroids and I can compute distance using st_distance().
regions <- st_read("~/Downloads/regions.shp")
regions_with_centroids <- st_centroid(regions)
extract_centroids <- regions_with_centroids %>%
st_drop_geometry() %>%
as_tibble() %>%
select(region_name, centroid)
# create edge list
edge_list <- extract_centroids %>%
select(region_name) %>%
expand(from = region_name, to = region_name) %>%
filter(from < to) %>%
left_join(extract-centroids, by = c("from" = "region_name) %>%
rename(from_centroid = centroid) %>%
left_join(extract-centroids, by = c("to" = "region_name) %>%
rename(to_centroid = centroid) %>%
mutate(distance = st_distance(from_centroid, to_centroid)
However, I really want to analyze the commuting distance between major urban areas in each government region. I need to shift the centroids to the population "centre of gravity".
I can use a shapefile of census enumerator areas to help me with this. The enumerator areas are sized by population. Using st_intersection() I can intersect the enumerator areas with the government regions. This gives me sub-regions within each government region. I can compute centroids for all the sub-regions. Grouping by region, I can compute the mean centroid for all the sub-regions in a region. The mean centroid = "centre of gravity", which gives a more realistic commute distance between regions.
regions <- st_read("~/Downloads/regions.shp")
ea <- st_read("~/Downloads/enumerator_areas.shp")
intersected <- st_intersection(regions, ea)
sub_region_centroids <- st_centroids(intersected)
Where I run into difficulty is how to find the mean centroid. Grouping by region is not working.
mean_centroid <- sub_region_centroids %>%
group_by(region_name) %>%
summarise(mean_centroid = mean(geometry))
Warning messages:
1: In mean.default(geometry) :
the argument is not numeric or logical: returning NA
Where am I going wrong?
I also do not know how to add the mean centroid back to the original region's object.
I hope someone can assist me.
Computing a population weighted average of multiple centroids is an interesting problem.
You can consider approach like this - where I calculate the weighted centroid of three cities in North Carolina (to make use of the well known & much loved nc.shp file that ships with {sf}).
The workflow uses tidyr::uncount() to first multiply the city points per population, the (many) multiplied points are then united to a single multipoint feature. And multipoint features have defined sf::st_centroid() operation (QED). The final sf::st_as_sf() is just a polish.
library(sf)
library(dplyr)
library(ggplot2)
# included with sf package
shape <- st_read(system.file("shape/nc.shp", package="sf"))
# dramatis personae; population as per Wikipedia
cities <- data.frame(name = c("Raleigh", "Greensboro", "Wilmington"),
x = c(-78.633333, -79.819444, -77.912222),
y = c(35.766667, 36.08, 34.223333),
population = c(467665, 299035, 115451)) %>%
st_as_sf(coords = c("x", "y"), crs = 4326)
# a quick overview of facts on ground
ggplot() +
geom_sf(data = shape) + # polygon of North Carolina
geom_sf(data = cities, color = "red") # 3 cities
# unweighted centroid / a baseline
plain_center <- cities %>%
st_geometry() %>% # pull just geometry
st_combine() %>% # from many points to a single multipoint
st_centroid() %>% # compute centroid of the multipoint
st_as_sf() # make it a sf object again
# the fun is here!!
center_of_centers <- cities %>%
tidyr::uncount(population) %>% # multiply rows according to population
st_geometry() %>% # pull just geometry
st_combine() %>% # from many points to a single multipoint
st_centroid() %>% # compute centroid of the multipoint
st_as_sf() # make it a sf object again
# finished result
ggplot() +
geom_sf(data = shape, color = "gray75") + # polygon of North Carolina
geom_sf(data = cities, color = "red") + # 3 cities
geom_sf(data = plain_center, color = "green") + # unweighted center
geom_sf(data = center_of_centers, color = "blue", pch = 4) # population weighted center
Following #Jindra Lacko's nice example, here is how it can be done taking the weighted mean of the lat and long.
library(sf)
library(dplyr)
library(ggplot2)
# weighted mean of lat and long
center_weighted <- cities %>%
mutate(lon = sf::st_coordinates(.)[,1],
lat = sf::st_coordinates(.)[,2]) %>%
st_drop_geometry() %>%
summarize(across(c(lon, lat), weighted.mean, w = population)) %>%
st_as_sf(coords = c("lon", "lat"), crs = 4326)
# plot it
ggplot() +
geom_sf(data = shape, color = "gray75") +
geom_sf(data = cities, color = "red") +
geom_sf(data = center_weighted, color = "blue", pch = 4)
Data
# set up example data
shape <- st_read(system.file("shape/nc.shp", package="sf"))
cities <- data.frame(name = c("Raleigh", "Greensboro", "Wilmington"),
x = c(-78.633333, -79.819444, -77.912222),
y = c(35.766667, 36.08, 34.223333),
population = c(467665, 299035, 115451)) %>%
st_as_sf(coords = c("x", "y"), crs = 4326)
I'm hoping to create a series of quartered circles (i.e. circles split into 4 equal quadrants), each with a 50km radius, that I can map onto various longitudes and latitudes throughout the United States. I'd also like the option to rotate these quartered circles as desired.
Using the code below (and guidance from here), I've been able to make the following start:
New York State Map
I have two questions:
How can I meaningfully set the radius of these circles? Is there a way to draw shapes a certain distance (in km) from a coordinate in a projected CRS? So far I'm defining the radius in terms of degrees of longitude and latitude, but distance would be more useful.
My circles appear to be turning into ellipses after projecting them and mapping them in WGS84. Is there any way to prevent this from happening?
I would be happy to consider alternative approaches. Thanks!
library(sf)
library(ggplot2)
library(maps)
#Two functions to create coordinate quartered circle polygons
#x = long, y = lay, r = radius, theta_rotate = rotation
st_wedge <- function(x,y,r,start,width, theta_rotate){
n <- 20
theta = seq(start+theta_rotate, start+width+theta_rotate, length=n)
xarc = x + r*sin(theta)
yarc = y + r*cos(theta)
xc = c(x, xarc, x)
yc = c(y, yarc, y)
st_polygon(list(cbind(xc,yc)))
}
st_wedges <- function(x, y, r, nsegs, theta_rotatex){
width = (2*pi)/nsegs
starts = (1:nsegs)*width
polys = lapply(starts, function(s){st_wedge(x,y,r,s,width, theta_rotatex)})
#Cast to crs 4326, WGS84
mpoly = st_cast((st_sfc(polys, crs = 4326)), "MULTIPOLYGON")
mpoly
}
#Create quartered sf circle polygon
custom_circle_sf <- st_wedges(x = -76, y = 43, r = .3, nsegs = 4, theta_rotatex = 200) %>%
st_sf() %>%
mutate(group = row_number()) %>% dplyr::select(group, geometry)
#Create New York State sf polygon
ny_map_sf <- map_data("state", region="new york") %>%
st_as_sf(coords = c("long", "lat"), crs = 4326) %>%
group_by(group) %>%
summarise(geometry = st_combine(geometry)) %>%
st_cast("POLYGON")
#Plot results
ggplot() +
geom_sf(data=ny_map_sf,
size = 1,
colour = "blue",
fill = "white") +
geom_sf(data=custom_circle_sf,
size = .1,
aes(fill=group),
colour = "white")
For anyone who is curious about splitting polygons in sf using R, this was how I went about solving this:
#Function to create circle with quadrants. Save desired projection as projected_crs
create_circle <- function(lat_x, long_y, theta_x, buffer_m){
#Create circle with radius buffer_m centered at (lat_x, long_y)
circle_buffer <- st_point(c(lat_x, long_y)) %>% st_sfc(crs = 4326) %>%
st_cast("POINT") %>%
st_transform(projected_crs) %>%
st_buffer(buffer_m)
#Create two orthogonal lines at origin
p1 <- rbind(c(lat_x,long_y - 1), c(lat_x,long_y + 1))
p2 <- rbind(c(lat_x+1,long_y), c(lat_x-1,long_y))
mls <- st_multilinestring(list(p1,p2)) %>% st_sfc(crs = 4326) %>%
st_transform(projected_crs)
#Use orthogonal lines to split circle into 4 quadrants
x1 <- st_split(circle_buffer, mls)
#Convert origin into projected CRS
center_in_crs <- st_point(c(lat_x, long_y)) %>%
st_sfc(crs = 4326) %>%
st_transform(projected_crs)
sp_obj <- x1 %>% st_collection_extract(type="POLYGON") %>%
#Convert to spatial to use sp functions
as_Spatial() %>%
#rotate x degrees
elide(rotate = theta_x + 45, center = center_in_crs[[1]]) %>%
#return to sf
st_as_sf()
Regarding your question 2: "circles appear to be turning into ellipses". If you add to your ggplot the coord_equal() function then the grid will be square, and the ellipses will be shown as circles.
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)
In his article Kyle Walker showed a method to make Voronoi Polygons in Leaflet. He drew Voronoi polygons around each starbucks coffeehouse in Fort Worth by means of the following code:
library(leaflet); library(rgeos)
library(rgdal); library(spatstat)
library(maptools)
starbucks <- read.csv('starbucks.csv')
fw <- subset(starbucks, City == 'Fort Worth')
coords <- cbind(fw$Longitude, fw$Latitude)
## Spatial points w/the WGS84 datum
sp_fw <- SpatialPointsDataFrame(coords = coords, data = fw,
proj4string = CRS("+proj=longlat +datum=WGS84"))
sp_fw_proj <- spTransform(sp_fw, CRS("+init=epsg:26914"))
fw_coords <- sp_fw_proj#coords
## Create the window for the polygons
window <- owin(range(fw_coords[,1]), range(fw_coords[,2]))
## Create the polygons
d <- dirichlet(as.ppp(fw_coords, window))
## Convert to a SpatialPolygonsDataFrame and calculate an "area" field.
dsp <- as(d, "SpatialPolygons")
dsp_df <- SpatialPolygonsDataFrame(dsp,
data = data.frame(id = 1:length(dsp#polygons)))
proj4string(dsp_df) <- CRS("+init=epsg:26914")
dsp_df$area <- round((gArea(dsp_df, byid = TRUE) / 1000000), 1)
dsp_xy <- spTransform(dsp_df, CRS("+proj=longlat +datum=WGS84"))
## Map it!
leaflet() %>%
addMarkers(data = fw,
lat = ~ Latitude,
lng = ~ Longitude,
popup = fw$Name) %>%
addPolygons(data = dsp_xy,
color = "green",
fill = "green",
popup = paste0("Area: ",
as.character(dsp_xy$area),
" square km")) %>%
addTiles()
I want to add an extra feature to his map: I want to assign a specific color to a polygon. This color depends on the characteristics of the nearest marker (the centroid).
for example, color every polygon with a starbucks centroid "green", and with a Dunkin' Donuts centroid "purple". (assuming that the starbucks.csv also includes coordinates of Dunkin' Donuts)
In other words, I want to merge the data of a centroid ("fw") with that of the polygon it belongs to ("dsp_xy").
Can someone help me out in this one?
The voronoi function from the dismo package is what you need. I'll also use this post to demo the new sf package for R.
Let's generate a reproducible fake dataset of Starbucks and Dunkin Donuts locations:
library(leaflet)
library(sf)
library(dismo)
library(sp)
set.seed(1983)
# Get some sample data
long <- sample(seq(-118.4, -118.2, 0.001), 50, replace = TRUE)
lat <- sample(seq(33.9, 34.1, 0.001), 50, replace = TRUE)
type <- sample(c("Starbucks", "Dunkin"), 50, replace = TRUE)
Next, let's create an sf data frame from our data, and take a look:
points <- data.frame(long = long, lat = lat, type = type) %>%
st_as_sf(crs = 4326, coords = c("long", "lat"))
plot(points)
Next, we create the Voronoi polygons with the voronoi function from the dismo package, which is very straightforward, then give it the same coordinate system as our points. In a real-world workflow, you should use a projected coordinate system, but I'll just use WGS84 (which the operations will assume to be planar) for illustration. Also notice I'm going back and forth between sf and sp classes; the R world will fully support sf in time, but coercion is straightforward in the interim.
polys <- points %>%
as("Spatial") %>%
voronoi() %>%
st_as_sf() %>%
st_set_crs(., 4326)
plot(polys)
Now, visualize it with Leaflet using your desired colors:
pal <- colorFactor(c("purple", "green"), polys$type)
polys %>%
leaflet() %>%
addProviderTiles(providers$CartoDB.Positron) %>%
addPolygons(fillColor = ~pal(type), weight = 0.5, color = "grey") %>%
addCircleMarkers(data = points, label = ~type, color = ~pal(type))
We didn't need it here, but a function in sf that you'll want to know about as well is st_join, which handles spatial joins seamlessly and would work for the type of overlay you originally proposed.