Extract routes between stations from a rail network shapefile - r

Problem: I want to extract a route along the rail network between two stations from a shapefile and only plot this particular route, rather than the entire network.
This is what I have so far:
I have a shapefile with the entire rail network of the UK, plotted it looks like this:
library(maptools)
rail <- readShapeSpatial("railnetworkLine.shp")
I also have a list of stations with Eastings and Northings, for example:
1) ABDARE 300400 202800
2) DEIGHTN 416490 419140
I can add them to the map and it looks like this:
plot(rail)
plot(spdf.station, add=TRUE, col="red", pch=20)
So what I don't know, is how I can extract the route between them and just plot that route - the information is obviously in the shapefile and I have the coordinates of the station, but I don't understand how to extract it.
I managed to calculate the distance between them with this code:
SpacingInMetres <- 10000
require(secrlinear)
network <- read.linearmask(data=rail, spacing=SpacingInMetres)
distance <- (networkdistance (stations[1,], stations[2,], network))/1000
# Confirm distance:
distance
>311.7893
And I found that you can get the routes along roads with Google Maps with ggmaps (see here). But how can you do it when you have a shapefile as the network input rather than Google Maps?
I think maybe the packages 'shp2graph' + 'igraph' are useful, but I just can't figure it out. Any thoughts?

Shortest paths on route networks can be calculated using the stplanr package. I used a shapefile with the entire rail network for the Netherlands. This shapefile is available from:
https://mapcruzin.com/free-netherlands-arcgis-maps-shapefiles.htm
library(sf)
library(ggplot2)
library(stplanr)
# Read shapefile
nl_rails_sf <- sf::st_read("~/netherlands-railways-shape/railways.shp")
# Data frame with station locations
stations_df <- data.frame(station = c("Den Haag", "Den Bosch"),
lat = c(52.080276, 51.690556),
lon = c(4.325, 5.293611))
# Create sf object
stations_sf <- sf::st_as_sf(stations_df, coords = c("lon", "lat"), crs = 4326)
# Find shortest route
slnetwork <- SpatialLinesNetwork(nl_rails_sf)
find_nodes <- find_network_nodes(sln = slnetwork,
x = stations_df$lon,
y = stations_df$lat,
maxdist = 2e5)
route_dhdb_df <- data.frame(start = find_nodes[1], end = find_nodes[2])
route_dhdb_sf <- sum_network_links(sln = slnetwork, routedata = route_dhdb_df)
# Distance route in meters
distance_m <- sum(route_dhdb_sf$length) # 112189.5 [m]
# Plot results
ggplot(nl_rails_sf) +
geom_sf() +
theme_void() +
geom_sf(data = stations_sf, color = "red") +
geom_sf(data = route_dhdb_sf, color = "red")

Related

Plot an ellipse between two geographical foci in R

I am trying to find out the geographical area that is equidistant from two points, and to plot this as an ellipse.
I can produce plots for one point easily using st_buffer, and can find numerous R functions that will plot ellipse from a known centroid if I define the axis, but have not been able to find one that will plot an ellipse given two known foci and a defined distance.
The similar question here gets some way towards an answer, but is not readily applicable to geographic situations - Draw an ellipse based on its foci
My code is pretty simple at the moment, and given each coordinate with a 100km radius. However, I would like to find out all the positions that would be reachable by a 200km (or other defined distance) trip between both sites.
library(tidyverse)
library(sf)
#Give Coordinates
citylocations <- tibble::tribble(
~city, ~lon, ~lat,
"London", -0.1276, 51.5072,
"Birmingham", -1.8904, 52.4862,
)
citydflocations <- as.data.frame(citylocations)
#Convert to SF
citysflocations <- sf::st_as_sf(citydflocations, coords = c("lon","lat" ), crs = 4326)
#Convert location file to National Grid Planar
cityBNGsflocations <- citysflocations %>%
st_transform(citysflocations, crs = 27700)
#Produce circles with 100km buffer
dat_circles <- st_buffer(cityBNGsflocations, dist = 100000)
join_circles <- st_union(dat_circles) %>%
st_transform(4326)
plot(join_circles, col = 'lightblue')```
The function below should create buffers of varying distances for each of the two points it is given, finds the intersection the two buffers, unions the intersections, and finally returns a convex hull of those intersections. The output should be a near approximation of an ellipse with the two points as foci.
The straight-line(s) distance from one city to any edge of the polygon and then to the other city should equal the distance given in the function (200,000m in the example below).
It works on the data provided, but is fragile as there's no error checking or warning suppression. Make sure the dist argument is greater than the distance between the two points, and that the points have a crs that can use meters as a distance. (lat/lon might not work)
The example below only uses 20 points for the 'ellipse', but changing the function should be relatively straightforward.
library(sf)
#> Linking to GEOS 3.8.0, GDAL 3.0.4, PROJ 6.3.1; sf_use_s2() is TRUE
library(tidyverse)
#Give Coordinates
citylocations <- tibble::tribble(
~city, ~lon, ~lat,
"London", -0.1276, 51.5072,
"Birmingham", -1.8904, 52.4862,
)
citydflocations <- as.data.frame(citylocations)
#Convert to SF
citysflocations <- sf::st_as_sf(citydflocations, coords = c("lon","lat" ), crs = 4326)
#Convert location file to National Grid Planar
cityBNGsflocations <- citysflocations %>%
st_transform(citysflocations, crs = 27700)
#Produce circles with 100km buffer
dat_circles <- st_buffer(cityBNGsflocations, dist = 100000)
join_circles <- st_union(dat_circles) %>%
st_transform(4326)
#plot(join_circles, col = 'lightblue')
### the ellipse function using 20 buffers ####
ellipse_fn <- function(x_sf, y_sf, distance){
#set distance argument to meters, get sequence of distances for buffers
distance = units::set_units(distance, 'm')
dists_1 <- seq(units::set_units(0, 'm'), distance, length.out = 22)
# create empty sf object to place for loop objects in
# purrr would probably be better here
nrows <- 20
df <- st_sf(city = rep(NA, nrows), city.1 = rep(NA, nrows), geometry = st_sfc(lapply(1:nrows, function(x) st_geometrycollection())))
intersections <- for(i in 2:21){
buff_1 <- st_buffer(cityBNGsflocations[1,], dist = dists_1[i])
buff_2 <- st_buffer(cityBNGsflocations[2,], dist = distance - dists_1[i])
intersection <- st_intersection(buff_1, buff_2)
df[i-1,] <- intersection
}
df %>%
st_set_crs(st_crs(x_sf)) %>%
st_union() %>%
st_convex_hull()
}
### end ellipse function ###
# Using the ellipse function with 2 points & 200000m distance
ellipse_sf <- ellipse_fn(cityBNGsflocations[1,], cityBNGsflocations[2,], dist = 200000)
# You'll get lots of warnings here about spatial constance...
ggplot() +
geom_sf(data = ellipse_sf, fill = 'black', alpha = .2) +
geom_sf(data = cityBNGsflocations, color = 'red')
Created on 2022-06-03 by the reprex package (v2.0.1)
mapview plot of the cities & 'ellipse' on a map:

Looking for a polygon where a point is contained in R

I'm working with a dataframe containing longitude and latitude for each point. I have a shapefile containing mutually exclusive polygons. I would like to find the index of the polygon it where each point is contained. Is there a specific function that helps me achieve this? I've been trying with the sf package, but I'm open to doing it with another one. Any help is greatly appreciated.
I believe you may be looking for function sf::st_intersects() - in combination with sparse = TRUE setting it returns a list, which can be in this use case (points & a set of non-overlapping polygons) converted to a vector easily.
Consider this example, built on the North Carolina shapefile shipped with {sf}
library(sf)
# as shapefile included with sf package
shape <- st_read(system.file("shape/nc.shp", package="sf")) %>%
st_transform(4326) # WGS84 is a good default
# three semi random cities
cities <- data.frame(name = c("Raleigh", "Greensboro", "Wilmington"),
x = c(-78.633333, -79.819444, -77.912222),
y = c(35.766667, 36.08, 34.223333)) %>%
st_as_sf(coords = c("x", "y"), crs = 4326) # again, WGS84
# plot cities on full map
plot(st_geometry(shape))
plot(cities, add = T, pch = 4)
# this is your index
index_of_intersection <- st_intersects(cities, shape, sparse = T) %>%
as.numeric()
# plot on subsetted map to doublecheck
plot(st_geometry(shape[index_of_intersection, ]))
plot(cities, add = T, pch = 4)

Is there an R function to convert numerical values into coordinates?

I am working with a dataset that features chemical analyses from different locations within a cave, with each analysis ordered by a site number and that sites latitude and longitude. This first image is what I had done originally simply using ggplot.
Map of site data, colored by N concentration
But what I want to do is use the shapefile of the cave system from which the data is sourced from and do something similar by plotting the points over the system and then coloring them by concentration. This below is the shapefile that I uploaded Cave system shapefile
Cave system shapefile
So basically I want to be able to map the chemical data from my dataset used to map the first figure, but on the map of the shapefile. Initially it kept on saying that it could not plot on top of it. So I figured I had to convert the latitude and longitude into spatial coordinates that could then be mapped on the shapefile.
Master_Cave_data <- Master_cave_data %>%
st_as_sf(MastMaster_cave_data, agr = "identity", coord = Lat_DD)
This was what I had thought to use in order to convert the numerical Latitude cooridnates into spatial data.
I assume your coordinates are in WSG84 projection system (crs code 4326). You can create your sf object the following way:
Master_Cave_data <- st_as_sf(MastMaster_cave_data, coords = c('lon', 'lat'), crs = 4326)
Change lon and lat columns to relevent names. To plot your points with your shapefile, you need them both in the same projection system so reproject if needed:
Master_Cave_data <- Master_cave_data %>% st_transform(st_crs(shapefile))
Example
Borrowed from there
df <- data.frame(place = "London",
lat = 51.5074, lon = 0.1278,
population = 8500000) # just to add some value that is plotable
crs <- 4326
df <- st_as_sf(x = df,
coords = c("lon", "lat"),
crs = crs)
And you can have a look at the map:
library(tmap)
data("World")
tm_shape(World[World$iso_a3 == "GBR", ]) + tm_polygons("pop_est") +
tm_shape(df) + tm_bubbles("population")

Find Polygon Intercepts on a Map

I'm trying to find the Radii on this map that intercept state borders in R.
Here is my code so far. Thanks to user Gregoire Vincke for providing much of the solution.
library("maps")
library("mapproj")
library("RColorBrewer")
library("mapdata")
library("ggplot2")
library("rgeos")
library("dismo")
library("ggmap")
library("rgdal")
data("stateMapEnv") #US state map
dat <- read.csv("R/longlat.csv",header = T)
map('state',fill = T, col = brewer.pal(9,"Pastel2"))
#draws circles around a point, given lat, long and radius
plotCircle <- function(lonDec, latDec, mile) {
ER <- 3959
angdeg <- seq(1:360)
lat1rad <- latDec*(pi/180)
lon1rad <- lonDec*(pi/180)
angrad <- angdeg*(pi/180)
lat2rad <- asin(sin(lat1rad)*cos(mile/ER) + cos(lat1rad)*sin(mile/ER)*cos(angrad))
lon2rad <- lon1rad + atan2(sin(angrad)*sin(mile/ER)*cos(lat1rad),cos(mile/ER)-sin(lat1rad)*sin(lat2rad))
lat2deg <- lat2rad*(180/pi)
lon2deg <- lon2rad*(180/pi)
polygon(lon2deg,lat2deg,lty = 1 , col = alpha("blue",0.35))
}
point <- mapproject(dat$lng,dat$lat)
points(point, col = alpha("black",0.90), cex = 0.4, pch = 20) #plots points
plotCircle(-71.4868,42.990684,20)
plotCircle(-72.57085,41.707932,12)
...
#this goes on for every point
I want to store the points that intercept state borders in a new data frame, any help would be appreciated!
EDIT: Here's a broad overview of the workflow using the geospatial analyses packages in R (sp, rgdal, rgeos).
Instead of using the maps package and stateMapEnv, you want a polygon shapefile of state boundaries, like one that can be found here:
https://www.census.gov/geo/maps-data/data/cbf/cbf_state.html
You can then load that shapefile in R with readOGR from the rgdal package to get a SpatialPolygons (let's call it state_poly) with one Polygons object per state.
Create a SpatialPoints object from your long/lat coordinates:
pts <- SpatialPoints(dat[, c("lng", "lat")], proj4string = CRS("+proj=longlat"))
At this point your pts and state_poly should be in longitude/latitude coordinates, but to draw circles of a fixed radius around points, you need to convert them to projected coordinates (i.e. in meters). See this question for more details:
Buffer (geo)spatial points in R with gbuffer
Create a vector with the radii of your circles around each point, and use it with gBuffer (from rgeos) and your points layer:
circ <- gBuffer(pts, width = radii, byid = TRUE)
The byid argument means it does it separately for each point, using the different values in radii in the same order as the points.
Convert the state polygons to lines: state_lines <- as(state_poly, "SpatialLines")
Use gIntersects(circ, state_lines, byid = TRUE) .
Because of byid = TRUE, the return value is a matrix with one row per circle in your spgeom1 and one column per state boundaries in spgeom2. Note that if the circle intersect a boundary between two states, it should have two "TRUE" values in that row (one for each state). If it intersects with water or the external perimeter of the US it may have only one "TRUE" value in the row.
Here is the Final Code!
library("maps")
library("mapproj")
library("RColorBrewer")
library("mapdata")
library("ggplot2")
library("rgeos")
library("dismo")
library("ggmap")
library("rgdal")
#import shape file (.shp), make sure all the other files in the zip are included in
#your file location!
state_poly <- readOGR(dsn = 'C:/Users/chopp/Documents/R', layer='cb_2015_us_state_500k')
#data containing lng and lat coordinates with radii
data <- read.csv("R/longlat.csv", header = T)
#create spatial point objects out of your lng and lat data
pts <- SpatialPoints(data[,c("lng","lat")], proj4string = CRS("+proj=longlat"))
#convert spatial points to projected coordinates (points and map lines)
ptsproj <- spTransform(pts, CRS("+init=epsg:3347"))
state_poly_proj<- spTransform(state_poly, CRS("+init=epsg:3347"))
#convert radii units to meters, used in our gBuffer argument later on
radii <- data$rad*1609.344
#create circular polygons with. byid = TRUE will create a circle for each point
circ <- gBuffer(ptsproj, width = radii, byid = TRUE)
#convert state polygons to state lines
state_lines<- as(state_poly_proj, "SpatialLines")
#use gIntersects with byid = TRUE to return a matrix where "TRUE" represents
#crossing state boundaries or water
intdata <- gIntersects(circ, state_lines, byid = TRUE)
#write the matrix out into a csv file
write.csv(intdata,"R/Agents Intercepts 2.csv")

Maps doesn't register weird shapes

I'm working with one of my professors on some research aimed toward bettering the current methods of carbon accounting. We noticed that many of the locations for point sources were defaulted to the centroid of the county it was in (this is specific to the US at the moment, though it will be applied globally) if there was no data on the location.
So I'm using R to to address the uncertainty associated with these locations. My code takes the range of longitude and latitude for a county and plots 10,000 points. It then weeds out the points that are not in the county and take the average of the leftover points to locate the centroid. My goal is to ultimately take the difference between these points and the centroid to find the spacial uncertainty for point sources that were placed in the centroid.
However, I'm running into problems with coastal regions. My first problem is that the maps package ignores islands (the barrier islands for example) as well as other disjointed county shapes, so the centroid is not accurately reproduced when the points are averaged. My second problem is found specifically with Currituck county (North Carolina). Maps seems to recognize parts of the barrier islands contained in this county, but since it is not continuous, the entire function goes all wonky and produces a bunch of "NAs" and "Falses" that don't correspond with the actual border of the county at all.
(The data for the centroid is going to be used in other areas of the research which is why it's important we can accurately access all counties.)
Is there any way around the errors I'm running into? A different data set that could be read in, or anything of the sort? Your help would be greatly appreciated. Let me know if there are any questions about what I'm asking, and I'll be happy to clarify.
CODE:
ggplot2 helps
SOME TROUBLE COUNTIES: north carolina, currituck & massachusetts,dukes
library(ggplot2)
library(maps) # package has maps
library(mapproj) # projections
library(sp)
WC <- map_data('county','north carolina,currituck') #calling on county
p <- ggplot(data = WC, aes(x = long, y = lat)) #calling on latitude and longitude
p1 <- p + geom_polygon(fill = "lightgreen") + theme_bw() +
coord_map("polyconic") + coord_fixed() #+ labs(title = "Watauga County")
p1
### range for the long and lat
RLong <- range(WC$long)
RLong
RLat <- range(WC$lat)
RLat
### Add some random points
n <- 10000
RpointsLong <- sample(seq(RLong[1], RLong[2], length = 100), n, replace = TRUE)
RpointsLat <- sample(seq(RLat[1], RLat[2], length = 100), n, replace = TRUE)
DF <- data.frame(RpointsLong, RpointsLat)
head(DF)
p2<-p1 + geom_point(data = DF, aes(x = RpointsLong, y = RpointsLat))
p2
# Source:
# http://www.nceas.ucsb.edu/scicomp/usecases/GenerateConvexHullAndROIForPoints
inside <- map.where('county',RpointsLong,RpointsLat)=="north carolina,currituck"
inside[which(nchar(inside)==2)] <- FALSE
inside
g<-inside*DF
g1<-subset(g,g$RpointsLong!=0)
g1
CentLong<-mean(g1$RpointsLong)
CentLat<-mean(g1$RpointsLat)
Centroid<-data.frame(CentLong,CentLat)
Centroid
p1+geom_point(data=g1, aes(x=RpointsLong,y=RpointsLat)) #this maps all the points inside county
p1+geom_point(data=Centroid, aes(x=CentLong,y=CentLat))
First, given your description of the problem, I would probably invest a lot of effort to avoid this business of locations defaulting to the county centroids - that's the right way to solve this problem.
Second, if this is a research project, I would not use the built in maps in R. The USGS National Atlas website has excellent county maps of the US. Below is an example using Currituck County in NC.
library(ggplot2)
library(rgdal) # for readOGR(...)
library(rgeos) # for gIntersection(...)
setwd("< directory contining shapefiles >")
map <- readOGR(dsn=".",layer="countyp010")
NC <- map[map$COUNTY=="Currituck County" & !is.na(map$COUNTY),]
NC.df <- fortify(NC)
bbox <- bbox(NC)
x <- seq(bbox[1,1],bbox[1,2],length=50) # longitude
y <- seq(bbox[2,1],bbox[2,2],length=50) # latitude
all <- SpatialPoints(expand.grid(x,y),proj4string=CRS(proj4string(NC)))
pts <- gIntersection(NC,all) # points inside the polygons
pts <- data.frame(pts#coords) # ggplot wants a data.frame
centroid <- data.frame(x=mean(pts$x),y=mean(pts$y))
ggplot(NC.df)+
geom_path(aes(x=long,y=lat, group=group), colour="grey50")+
geom_polygon(aes(x=long,y=lat, group=group), fill="lightgreen")+
geom_point(data=pts, aes(x,y), colour="blue")+
geom_point(data=centroid, aes(x,y), colour="red", size=5)+
coord_fixed()
Finally, another way to do this (which I'd recommend, actually), is to just calculate the area weighted centroid. This is equivalent to what you are approximating, is more accurate, and much faster.
polys <- do.call(rbind,lapply(NC#polygons[[1]]#Polygons,
function(x)c(x#labpt,x#area)))
polys <- data.frame(polys)
colnames(polys) <- c("long","lat","area")
polys$area <- with(polys,area/sum(area))
centr <- with(polys,c(x=sum(long*area),y=sum(lat*area)))
centr # area weighted centroid
# x y
# -76.01378 36.40105
centroid # point weighted centroid (start= 50 X 50 points)
# x y
# 1 -76.01056 36.39671
You'll find that as you increase the number of points in the points-weighted centroid the result gets closer to the area-weighted centroid.

Resources