Add new node to SpatialLinesNetwork in stplanr - r

How can one add a new node to a SpatialLinesNetwork?
context of my problem: I have a shapefile of a bus route and another shapefile of bus stops. I want to calculate the distance between stops along the bus route. Ideally, each stop would be a node and I would use stplanr::sum_network_routes() to calculate the distance between them. The problem is that when I convert the bus route into a SpatialLinesNetwork the network only has a few nodes that are far from each other and unrelated to bus stops locations.
reproducible dataset:
# load library and data
library(stplanr)
library(sf)
# get road data
data(routes_fast)
rnet <- overline(routes_fast, attrib = "length")
# convert to sf obj
rnet <- st_as_sf(rnet)
# convert SpatialLinesDataFrame into SpatialLinesNetwork
sln <- SpatialLinesNetwork(rnet)
# identify nodes
sln_nodes = sln2points(sln)
# Here is a bus stop which should be added as a node
new_point_coordinates = c(-1.535, 53.809)
p = sf::st_sf(geometry = sf::st_sfc(sf::st_point(new_point_coordinates)), crs = st_crs(rnet))
# plot
plot(sln, col = "gray") # network
plot(sln_nodes, col="red", add = TRUE) # nodes
plot(p, add=T, col="blue") # stop to be added as a new node

This doesn't answer your question at the outset, but I believe it does resolve your "Context" by showing how your desired network distances can be calculated. This can be done with dodgr (latest dev version) like this:
library (dodgr)
library (stplanr)
library (sf)
library (sp)
dat <- st_as_sf (routes_fast)
net <- weight_streetnet (dat, wt_profile = 1)
The net object is a simple data.frame containing all edges and vertices of the network. Then adapt your code above to get the routing points as a simple matrix
rnet rnet <- overline(routes_fast, attrib = "length")
SLN <- SpatialLinesNetwork(rnet)
sln_nodes = sln2points(SLN)
xy <- coordinates (sln_nodes)
colnames (xy) <- c ("x", "y")
Node that sln2points simply returns "nodes" (in stplanr terminology), which are junction points. You can instead replace with coordinates of bus stops, or simply add those to this matrix. The following three lines convert those coordinates to unique (nearest) vertex IDs of the dodgr net object:
v <- dodgr_vertices (net)
pts <- match_pts_to_graph (v, xy)
pts <- v$id [pts]
To calculate distances between those pts on the network, just
d <- dodgr_dists (net, from = pts, to = pts)

Thanks for the question, thanks to this question and subsequent collaboration with Andrea Gilardi, I'm happy to announce that it is now possible to add new nodes to sfNetwork objects with a new function, sln_add_node().
See below and please try to test reproducible code that demonstrates how it works:
devtools::install_github("ropensci/stplanr")
#> Skipping install of 'stplanr' from a github remote, the SHA1 (33158a5b) has not changed since last install.
#> Use `force = TRUE` to force installation
library(stplanr)
#> Registered S3 method overwritten by 'R.oo':
#> method from
#> throw.default R.methodsS3
#> Warning in fun(libname, pkgname): rgeos: versions of GEOS runtime 3.7.1-CAPI-1.11.1
#> and GEOS at installation 3.7.0-CAPI-1.11.0differ
sample_routes <- routes_fast_sf[2:6, NULL]
sample_routes$value <- rep(1:3, length.out = 5)
rnet <- overline2(sample_routes, attrib = "value")
#> 2019-09-26 16:06:18 constructing segments
#> 2019-09-26 16:06:18 building geometry
#> 2019-09-26 16:06:18 simplifying geometry
#> 2019-09-26 16:06:18 aggregating flows
#> 2019-09-26 16:06:18 rejoining segments into linestrings
plot(sample_routes["value"], lwd = sample_routes$value, main = "Routes")
plot(rnet["value"], lwd = rnet$value, main = "Route network")
sln <- SpatialLinesNetwork(rnet)
#> Linking to GEOS 3.7.1, GDAL 2.4.0, PROJ 5.2.0
new_point_coordinates <- c(-1.540, 53.826)
crs <- sf::st_crs(rnet)
p <- sf::st_sf(geometry = sf::st_sfc(sf::st_point(new_point_coordinates)), crs = crs)
p_dest <- sln2points(sln)[9, ]
# We can identify the nearest point on the network at this point
# and use that to split the associated linestring:
sln_new <- sln_add_node(sln = sln, p = p)
#> although coordinates are longitude/latitude, st_nearest_feature assumes that they are planar
route_new <- route_local(sln = sln_new, from = p, to = p_dest)
plot(sln_new)
plot(p, add = TRUE)
plot(route_new, lwd = 5, add = TRUE)
#> Warning in plot.sf(route_new, lwd = 5, add = TRUE): ignoring all but the
#> first attribute
Created on 2019-09-26 by the reprex package (v0.3.0)
In case it's of use/interest, see the source code of the new small family of functions that support this new functionality here: https://github.com/ropensci/stplanr/blob/master/R/node-funs.R

Related

"CRS object has comment, which is lost in output" in krige

I am trying to krige for water quality dataset with Latitude, longitude which using CRS("+init=epsg:4326").
GGT <- read.csv("C:/Users/user/Data/newdata2019.csv")
coordinates(GGT) = ~Lon+Lat
GGT <- st_as_sf(GGT)
st_crs(GGT) <- 4326
GGTgrid <- readOGR('C:/Users/user/Desktop/FisheryScience/Data/Maps/GGTgrid.shp')
GGTgrid1 <- st_as_stars(GGTgrid, crs = 4326)
st_crs(GGTgrid1) <- 4326
-This is what GGT dataset looks like
vario <- variogram(log(DO_S)~1, GGT)
model_GGT <- fit.variogram(vario, model=vgm(psill = 1, model= 'Sph', range= 200, nugget =1))
plot(vario, model = model_GGT)
-It seems to work fine by here
Then it shows error when I run the code block below
krige_result <- krige(formula = log(DO_S)~1, GGT, GGTgrid1, model = model_GGT)
with long lines of error
Warning message in proj4string(obj):
"CRS object has comment, which is lost in output"Warning message in proj4string(obj):
"CRS object has comment, which is lost in output"Warning message in proj4string(obj):
The warnings you get are indicating that your work may be affected by the change introduced with PROJ 6 (and GDAL 3), adopted by R-spatial and rspatial. You can get all the details using this two links:
https://rgdal.r-forge.r-project.org/articles/CRS_projections_transformations.html
https://r-spatial.org/r/2020/03/17/wkt.html
To make these warning messages disappear, you just have to use objects of type sf and stars (by installing/loading the packages of the same names) which take into account these recent changes. So, I suggest you use the following few lines of code at the beginning of your script to replace your first six lines of code. This will give you two objects (i.e. GGT of type sf and GGTgrid1 of type stars) :
GGT <- read.csv("C:/Users/user/Data/newdata2019.csv")
coordinates(GGT) = ~Lon+Lat
GGT <- st_as_sf(GGT)
st_crs(GGT) <- 4326
GGTgrid <- readOGR('C:/Users/user/Desktop/maps/GGTgrid.shp')
coordinates(GGTgrid) <- ~x+y
GGTgrid1 <- st_as_stars(GGTgrid1, crs = 4326)
st_crs(GGTgrid1) <- 4326
It is easier for me to work on real data than to work "virtually" with the name of your objects as I don't have your original files. So I prefer to show you how to proceed for your analysis with the "meuse" data contained in the sp package.
By analogy with the reprex I give you, I think you should be able to manage with your own files. And you will see, no more warning message will appear :-)
Please, find below my reprex.
Reprex
Loading the library and the data
library(sp)
library(sf)
library(stars)
library(gstat)
data(meuse) # loading the data (equivalent of your csv file)
coordinates(meuse) = ~x+y # you already know this step ;-)
# Just a look to the class of original data
class(meuse)
#> [1] "SpatialPointsDataFrame"
#> attr(,"package")
#> [1] "sp" # "meuse" is an object of class 'sp'
data(meuse.grid) # loading the data (equivalent of your shp file)
gridded(meuse.grid) = ~x+y
# Just a look to the class of original data
class(meuse.grid)
#> [1] "SpatialPixelsDataFrame"
#> attr(,"package")
#> [1] "sp" # "meuse" is an object of class 'sp'
Converting the meuse data into sf object and the meuse.grid data into stars object
# Convert 'sp' object 'meuse' (i.e. SpatialPointsDataFrame) into 'sf' object
meuse <- st_as_sf(meuse)
class(meuse)
#> [1] "sf" "data.frame" # meuse is indeed of class 'sf'
# Convert 'sp' object 'meuse.grid' (i.e. SpatialPixelDataFrame) into 'stars' object
meuse.grid <- st_as_stars(meuse.grid)
class(meuse.grid)
#> [1] "stars" # meuse.grid is indeed of class 'stars'
Compute and plot the variogram
vario <- variogram(log(zinc)~1, meuse)
model_meuse <- fit.variogram(vario, model = vgm(psill = 1, model = "Sph", range = 200, nugget = 1))
plot(vario, model = model_meuse)
Krige and plot predictions and variances
krige_result <- krige(formula = log(zinc)~1, meuse, meuse.grid, model = model_meuse)
#> [using ordinary kriging]
class(krige_result)
#> [1] "stars"
krige_result
#> stars object with 2 dimensions and 2 attributes
#> attribute(s):
#> Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
#> var1.pred 4.77655207 5.2376428 5.5728908 5.7072284 6.1717618 7.4399908 5009
#> var1.var 0.08549102 0.1372838 0.1621815 0.1853301 0.2116141 0.5002793 5009
#> dimension(s):
#> from to offset delta refsys point values x/y
#> x 1 78 178440 40 NA NA NULL [x]
#> y 1 104 333760 -40 NA NA NULL [y]
plot(krige_result[1]) # plot predictions
plot(krige_result[2]) # plot variances
Created on 2021-10-19 by the reprex package (v2.0.1)

Reading large shapefile in R using using sf package

I have a shapefile of points with 32M observations. I want to load it in R and I have tried read_sf and st_read but my R session keeps getting crashed. One other way that came to my mind was to write a for loop, subsetting columns that I want and maybe going a specific number of rows at a time and then rbinding them, but cannot figure out how to make R understand the query. Here's what I have so far which is not working:
for (i in 1:10) {
j = i-1
jj = i+1
print(i)
print(j)
print(jj)
A <- read_sf("C:\\Users\\...parcels-20210802T125336Z-001\\parcels\\join_L3_Mad_Addresses.shp", query = "SELECT FID, CENTROID_I, LOC_ID FROM join_L3_Mad_Addresses WHERE FID < "jj" AND FID > "j"")
}
I think you can readapt the following code.
Load packages
library(sf)
#> Linking to GEOS 3.9.0, GDAL 3.2.1, PROJ 7.2.1
Define path to a shapefile
dsn <- system.file("shape/nc.shp", package="sf")
Count the number of features in dsn
st_layers(dsn, do_count = TRUE)
#> Driver: ESRI Shapefile
#> Available layers:
#> layer_name geometry_type features fields
#> 1 nc Polygon 100 14
Start a for loop to read 10 features at a time. Add the data to a list
shp_data_list <- list()
i <- 1
for (offset in seq(10, 100, by = 10)) {
query <- paste0("SELECT * FROM nc LIMIT ", 10, " OFFSET ", offset - 10)
shp_data_list[[i]] <- st_read(dsn, query = query, quiet = TRUE)
gc(verbose = FALSE)
i <- i + 1
}
Rbind the objects
shp_data <- do.call(rbind, shp_data_list)
Add an ID column (just for plotting)
shp_data$ID <- as.character(rep(1:10, each = 10))
plot(shp_data["ID"])
The only problem is that this process may not preserve the geometry type. For
example,
unique(st_geometry_type(shp_data))
#> [1] MULTIPOLYGON POLYGON
#> 18 Levels: GEOMETRY POINT LINESTRING POLYGON MULTIPOINT ... TRIANGLE
while
unique(st_geometry_type(st_read(dsn, quiet = TRUE)))
#> [1] MULTIPOLYGON
#> 18 Levels: GEOMETRY POINT LINESTRING POLYGON MULTIPOINT ... TRIANGLE
You can change the geometry type with st_cast()
Created on 2021-08-03 by the reprex package (v2.0.0)

Creating a route from a list of points and Overlaying the route (list of points) on the road segment/ road network in R

I have a road network shapefile and list of points. I have to create a route from the list of points and then overlay/ spatially join (integrate the attributes of points that are overlaying the road segments)
The sample road network shape file can be found here https://drive.google.com/drive/folders/103Orz6NuiWOaFoEkM18SlzFTjGYi1rju?usp=sharing
The following is the code for points with lat (x) and long (y) information. The "order" column means, the order of destinations in the route .
points <-tribble (
~x,~y, ~order,
78.14358, 9.921388,1,
78.14519, 9.921123,2,
78.14889, 9.916954,3,
78.14932, 9.912807,4,
78.14346, 9.913828,5,
78.13490, 9.916551,6,
78.12904, 9.918782,7
)
What I want as an output is a layer of the route joining all the points in the order as mentioned. And I also want to integrate/ do a spatial join of the route to the road segments.
Thanks in advance
The following answer is based on the R package sfnetworks which can be installed as follows:
install.packages("remotes")
remotes::install_github("luukvdmeer/sfnetworks")
First of all, load packages
library(sf)
#> Linking to GEOS 3.8.0, GDAL 3.0.4, PROJ 6.3.1
library(sfnetworks)
library(tidygraph)
and data. The points object is converted to sf format.
roads <- st_read("C:/Users/Utente/Desktop/Temp/roads_test.shp") %>% st_cast("LINESTRING")
#> Reading layer `roads_test' from data source `C:\Users\Utente\Desktop\Temp\roads_test.shp' using driver `ESRI Shapefile'
#> Simple feature collection with 785 features and 0 fields
#> geometry type: MULTILINESTRING
#> dimension: XY
#> bbox: xmin: 78.12703 ymin: 9.911192 xmax: 78.15389 ymax: 9.943905
#> geographic CRS: WGS 84
points <- tibble::tribble (
~x,~y, ~order,
78.14358, 9.921388,1,
78.14519, 9.921123,2,
78.14889, 9.916954,3,
78.14932, 9.912807,4,
78.14346, 9.913828,5,
78.13490, 9.916551,6,
78.12904, 9.918782,7
)
points <- st_as_sf(points, coords = c("x", "y"), crs = 4326)
Plot network and points (just to understand the problem a little bit better)
par(mar = rep(0, 4))
plot(roads, reset = FALSE)
plot(points, add = TRUE, cex = (1:7)/1.5, col = sf.colors(7), lwd = 4)
Convert roads to sfnetwork object
network <- as_sfnetwork(roads, directed = FALSE)
Subdivide edges and select the main component. Check https://luukvdmeer.github.io/sfnetworks/articles/preprocess_and_clean.html for more details.
network <- network %>%
convert(to_spatial_subdivision, .clean = TRUE) %>%
convert(to_components, .select = 1, .clean = TRUE) %E>%
mutate(weight = edge_length())
Now I want to estimate the shortest paths between each pair of consecutive points. sfnetwork does not support many-to-many routing, so we need to define a for-loop. If you need to repeat this operation for several points, I think you should check the R package dodgr.
routes <- list()
for (i in 1:6) {
path <- st_network_paths(
network,
from = st_geometry(points)[i],
to = st_geometry(points)[i + 1]
)
routes[[i]] <- path
}
Extract the id of the edges that compose all shortest paths
idx <- unlist(pull(do.call("rbind", routes), edge_paths))
Hence, if you want to extract the edges from the original network
network_shortest_path <- network %E>% slice(idx)
roads_shortest_path <- network_shortest_path %E>% st_as_sf()
Plot network and points
par(mar = rep(0, 4))
plot(roads, reset = FALSE)
plot(st_geometry(roads_shortest_path), add = TRUE, col = "darkgreen", lwd = 4)
plot(points, add = TRUE, cex = (1:7)/1.5, col = sf.colors(7), lwd = 4)
Created on 2021-03-07 by the reprex package (v0.3.0)

How to select points that are outside a buffer in R?

I am using a point dataset of class sf and a road network of class sf. I created a buffer with the road network using the st_buffer() function and I can successfully select the points that are within the roads by using the following:
points_within_roads <- st_intersection(points_shp, roads_buffer)
I need to do the opposite. I want to select the points that are outside the roads. Is there a function that allows me to do that? Thank you in advance.
You may want to check the sf::st_disjoint function. For example:
# packages
library(sf)
#> Linking to GEOS 3.6.1, GDAL 2.2.3, PROJ 4.9.3
# create some fake data
set.seed(1234)
my_line <- st_linestring(rbind(c(-1, -1), c(1, 1)))
my_points <- st_cast(st_sfc(st_multipoint(matrix(runif(100, -1, 1), ncol = 2))), "POINT")
my_buffer <- st_buffer(my_line, 0.1)
# plot
par(mar = rep(0, 4))
plot(st_boundary(my_buffer), col = "darkgrey")
plot(my_line, add = TRUE)
plot(my_points[my_buffer, op = st_intersects], add = TRUE, col = "darkred")
plot(my_points[my_buffer, op = st_disjoint], add = TRUE, col = "darkblue")
Created on 2020-04-29 by the reprex package (v0.3.0)
Moreover, I think you misspelt sf::st_intersection where it should be sf::st_intersects.
Could use of ! answer this question? Below is assuming you have an unique identifier column of some sort (ID).
points_outside_buffer <- filter(points_shp, !points_within_roads$ID %in% points_shp$ID)
I just did the below with some data I am working on and it worked fine
too_far <- filter(stations_sf_r, !stations_sf_r$StationCode %in% repeats$StationCode)

Using R to process google earth engine data

I want to download the daily tmax from the NASA for a given lat lon (https://developers.google.com/earth-engine/datasets/catalog/NASA_NEX-DCP30_ENSEMBLE_STATS)
using the following tutorial https://jesjehle.github.io/earthEngineGrabR/index.html
library(devtools)
install_github('JesJehle/earthEngineGrabR')
library(earthEngineGrabR)
ee_grab_install() # had to install Anaconda before doing this step.
test_data <- ee_grab(data = ee_data_collection(datasetID = "NASA/NEX-DCP30_ENSEMBLE_STATS",
timeStart = "1980-01-01",
timeEnd = '1980-01-02',
bandSelection = 'tasmax'),
targetArea = system.file("data/territories.shp", package = "earthEngineGrabR")
)
Error: With the given product argument no valid data could be requested.
In addition: Warning message:
Error on Earth Engine servers for data product: NASA-NEX-DCP30_ENSEMBLE_STATS_s-mean_t-mean_1980-01-01to2005-12-31
Error in py_call_impl(callable, dots$args, dots$keywords): EEException: Collection.first: Error in map(ID=historical_195001):
Image.select: Pattern 'tasmax' did not match any bands.
I would like to know how to specify the bandwidth so that I do get this error and instead of using a shapefile as target area, I do I download tmax data for a single lat lon 9.55, 78.59?
You might use rgee to accomplish this. Currently, rgee has a function called rgee::ee_extract that works similar to raster::extract().
library(rgee)
library(sf)
# 1. Load a geometry
y <- st_read(system.file("shape/nc.shp", package = "sf"), quiet = TRUE) %>%
st_transform(4326)
## Move that geometry from local to earth engine
ee_y <- sf_as_ee(y)
# 2. Load your ImageCollection
x <- ee$ImageCollection("NASA/NEX-DCP30_ENSEMBLE_STATS")$
filterDate("1980-01-01","1980-01-02")$
map(function(img) img$select("tasmax_mean"))
## calculate the nominal scale
scale <- x$first()$projection()$nominalScale()$getInfo()
# 3. Extract values
tasmax_mean_data <- ee_extract(x = x,
y = y,
fun = ee$Reducer$mean(),
scale = scale,
id = "FIPS")
# 4. Merge results with the sf object
ee_nc_tasmax <- merge(y, tasmax_mean_data, by = "FIPS")
plot(ee_nc_rain['historical_198001'])

Resources