redlistr::getAreaEOO from degree minute data input - r

I have been trying to calculate the EOO area for a species using the redlistr package. In the example, the authors used raster data. However, I have observation points of the species in the degree minute format.
I created a subset of data for reference:
dt <- data.frame(lon_x = c(168.36085, 151.228745, 144.984577, 144.984287, 144.984201),
lat_y = c(-46.59179, -34.005291, -37.926258, -37.919514, -37.923407),
species = "seahorse_spp1")
coords <- cbind(dt$lon_x, dt$lat_y)
dt_spdf <- SpatialPointsDataFrame(coords, dt)
# now add a coordinate reference system to the sp dataframe
prj4string <- "+proj=longlat +ellps=WGS84 +datum=WGS84 +units=km +no_defs"
crs(dt_spdf) <- prj4string
# unit is in meter like required
# now create EOO polygon
dt.polygon <- redlistr::makeEOO(dt_spdf)
# now visually check the points and polygon to make sure they look correct
leaflet() %>%
addTiles() %>%
addCircles(data = dt_spdf, ~ lon_x, ~ lat_y, color = "red") %>%
addPolygons(data = dt.polygon)
# calculate EOO
redlistr::getAreaEOO(dt.polygon)
#> [1] 0.0003264353
And it keeps giving this very small, unrealistic value.
Does anyone have any idea where I did wrong?
Thank you!

Related

Plotting latitude and longitude points in r

I am really struggling plotting these spatial data points in r. I have tried using ggmap, sf, and sp but I can't get it to cooperate with me.
I have a table, tbl, that has the following makeup:
tbl
| lat | long | alive| species|
where lat and long are the latitude and longitude respectively. "alive" is boolean so is "TRUE" or "FALSE" and "species" is a species code for one of the three species in the data set.
I am trying to get a graph that has points where all of the animals were found, with the color of the point denoting if the animal was found alive or dead and the shape of the point denoting the species. So I could include a key.
I am more familiar with python, and I understand how I could do this in python. But I am really struggling with doing this in r. Could all of these options be passed in the 'aes' parameter? How ould I do that?
Most success doing:
mapplot(longitude=table_1$lon,latitude=table_1$lat,type="p")
mapplot <- get_map(center= c(lon=mean(tbl$lon),lat=mean(tbl$lat)),zoom=2,maptype="satellite",scale=2)
ggmap(mapplot) + geom_point(data=tbl, aes(x=lon,y=lat))
Yo, you didn't give us much to go on... so I've taken the liberty of making up some data.
First a table, as you described with lat/lon and alive, species.
Then turn it into an sf object for plotting.
Finally, get some border data to show it on a map.
library(tidyverse)
library(sf)
#> Linking to GEOS 3.8.0, GDAL 3.0.4, PROJ 6.3.1; sf_use_s2() is TRUE
set.seed(3) # for reproducibility
# making up data
lat <- rnorm(10, mean = 36, sd = 4)
long <- rnorm(10, mean = -119, sd = 2)
alive <- sample(c(T, F), 10, replace = T)
species <- sample(c('frog', 'bird', 'rat'), 10, replace = T)
# crate a tibble with the made up data
my_table <- tibble(lat = lat, long = long, alive = alive, species = species)
# turn it into an sf object, for spatial plotting
my_sf <- my_table %>%
st_as_sf(coords = c('long', 'lat')) %>%
st_set_crs(4326) # using 4326 for lat/lon decimal
# ggplot2 of the data
ggplot() +
geom_sf(data = my_sf, aes(color = alive, shape = species), size = 3)
# Getting a little fancier with it by adding the state borders
ca_nv_map <- rnaturalearth::ne_states(country = 'United States of America', returnclass = 'sf') %>%
filter(name %in% c("California", "Nevada"))
ggplot() +
geom_sf(data = my_sf, aes(color = alive, shape = species), size = 3) +
geom_sf(data = ca_nv_map, fill = NA)
Created on 2022-11-09 by the reprex package (v2.0.1)
Here's a super simple example to get you started, using the sf package for spatial data and ggplot2 for plotting:
require('tidyverse')
require('sf')
# generate some sample data
sampleDF <- data.frame(
lat=c(-17.4, -17.1, -17.8),
lon=c(158.2, 158.9, 157.9),
alive=c(T, F, T),
species=c('sp1', 'sp2', 'sp3')
) %>%
dplyr::mutate(species = as.factor(species)) %>%
st_as_sf(coords=c('lon', 'lat'), crs=4326)
# We converted the species column to a factor
# and converted the dataframe to an sf object,
# specifying the X and Y columns and the
# coordinate reference system (4326 is WGS84)
# Have a look at the sample data
sampleDF
> Simple feature collection with 3 features and 2 fields
> Geometry type: POINT
> Dimension: XY
> Bounding box: xmin: 157.9 ymin: -17.8 xmax: 158.9 ymax: -17.1
> Geodetic CRS: WGS 84
> alive species geometry
> 1 TRUE sp1 POINT (158.2 -17.4)
> 2 FALSE sp2 POINT (158.9 -17.1)
> 3 TRUE sp3 POINT (157.9 -17.8)
# Now we plot it
# (Note that alive and species are within the aes() function,
# because we want those drawn from the data itself.
# size is outside aes() because we're using a constant of 4.)
ggplot() +
geom_sf(data=sampleDF, aes(col=alive, shape=species), size=4) +
theme_classic(base_size=14)
Result:
(You can make it prettier by removing the axes, adding a basemap, etc.)
You can also view it interactively with a useful basemap using the mapview package. This will open up a page in your default web browser and let you zoom in/out and change the basemap.
mapview::mapviewOptions(viewer.suppress = TRUE, fgb=FALSE)
mapview::mapview(sampleDF, zcol='alive')
(Note: my random points are in the middle of the Pacific Ocean, so this is not the most useful map.)

Problem joining different SpatialPolygonsDataFrame objects in R

I have a shape file of towns in the north of Spain that I have to join into groups (municipalities or comarcas in Spanish). I've used st_union from the sf package to join them successfully (and each one is their own SpatialPolygonsDataFrame object with a single polygon). I plot each of the municipalities individually and they look fine.
However, once I want to combine the municipalities into a single SpatialPolygonsDataFrame object with multiple polygons, I can't for the life of me manage to do it. I've tried three approaches mostly based on this answer: https://gis.stackexchange.com/questions/155328/merging-multiple-spatialpolygondataframes-into-1-spdf-in-r and this one https://gis.stackexchange.com/questions/141469/how-to-convert-a-spatialpolygon-to-a-spatialpolygonsdataframe-and-add-a-column-t
– If I use raster::union it throws out the error
Error in .rowNamesDF<-(x, value = value) : invalid 'row.names' length
– If I use a simple rbind it throws out the error
Error in SpatialPolygonsDataFrame(pl, df, match.ID = FALSE) :
Object length mismatch:
pl has 7 Polygons objects, but df has 4 rows
Or something similar for 6/11 of the municipalities.
– If I try a lapply approach (more convoluted) it seems to work but one I plot it using leaflet the municipalities that gave the error when trying to raster::union or rbind don't look as they should/don't look as they do when I plot them individually.
** Municipalities 1 and 2 work fine. 3 and 4 for example do not. **
Here's a link to the two files needed to reproduce my code below:
– Link to shape files: https://www.dropbox.com/sh/z9632hworbbchn5/AAAiyq3f_52azB4oFeU46D5Qa?dl=0
– Link to xls file that contains the mapping from towns to municipalities: https://www.dropbox.com/s/4w3fx6neo4t1l3d/listado-comarcas-gipuzkoa.xls?dl=0
And my code:
library(tidyverse)
library(magrittr)
library(sf)
library(ggplot2)
library(lwgeom)
library(readxl)
library(raster)
#Read shapefile
mapa_municip <- readOGR(dsn = "UDALERRIAK_MUNICIPIOS/UDALERRIAK_MUNICIPIOS.shp")
mapa_municip <- spTransform(mapa_municip, CRS('+proj=longlat +datum=WGS84 +no_defs +ellps=WGS84 +towgs84=0,0,0'))
mapa_municip <- st_as_sf(mapa_municip)
#Read excel that contains mapping from town to municioalities
muni2com <- read_excel("listado-comarcas-gipuzkoa.xls",
sheet=1,
range="A1:C91",
col_names = T)
comarcas <- list()
count <- 0
for (i in unique(muni2com$Comarca)[1:4]){
count <- count + 1
for (k in unique(muni2com$Municipios[muni2com$Comarca==i])){
if (k == unique(muni2com$Municipios[muni2com$Comarca==i])[1]){ # if 1st case, keep this town
temp <- mapa_municip[mapa_municip$MUNICIPIO==k,]
}
if (k != unique(muni2com$Municipios[muni2com$Comarca==i])[1]){ # otherwise, join w previous ones
temp <- sf::st_union(temp, mapa_municip[mapa_municip$MUNICIPIO==k,])
}
}
comarcas[[count]] <- spTransform(as(temp, "Spatial"), CRS('+proj=longlat +datum=WGS84 +no_defs +ellps=WGS84 +towgs84=0,0,0'))
comarcas[[count]]#data <- data.frame(comarca = i)
}
IDs <- sapply(comarcas, function(x)
slot(slot(x, "polygons")[[1]], "ID"))
#Checking
length(unique(IDs)) == length(comarcas)
dfIDs <- data.frame(comarca = IDs)
#Making SpatialPolygons from list of polygons
comarcas2 <- SpatialPolygons(lapply(comarcas,
function(x) slot(x, "polygons")[[1]]))
# Try to coerce to SpatialPolygonsDataFrame (will throw error)
p.df <- data.frame( comarca = unique(muni2com$Comarca)[1:4])
p <- SpatialPolygonsDataFrame(comarcas2, p.df)
# Extract polygon ID's
( pid <- sapply(slot(comarcas2, "polygons"), function(x) slot(x, "ID")) )
# Create dataframe with correct rownames
( p.df <- data.frame( comarca = unique(muni2com$Comarca)[1:4], row.names = pid) )
# Try coertion again and check class
comarcas3 <- SpatialPolygonsDataFrame(comarcas2, p.df)
class(comarcas3)
#Leaflet map
leaflet( options = leafletOptions(zoomControl = F,
zoomSnap = 0.1 ,
zoomDelta = 1
),
data = comarcas3,
) %>%
addProviderTiles(provider="CartoDB.Positron") %>%
htmlwidgets::onRender("function(el, x) {
L.control.zoom({ position: 'topright' }).addTo(this)
}") %>%
clearShapes() %>%
addPolygons(fillColor = "gray",
opacity = 0.8,
weight = 0.3,
color = "white",
fillOpacity = 0.95,
smoothFactor = 0.5,
label = ~comarca,
highlight = highlightOptions(
weight = 1.5,
color = "#333333",
bringToFront = T),
layerId = ~comarca
)
** Note how if you plot comarcas[[3]] or comarcas[[4]] above instead of comarcas3 the shape of those municipalities is completely different.**
I'd really appreciate any tips you can give me, I've been at it for days and I can't solve it. I assume the problem is due to the error given by the rbind, which seems to be the most informative one, but I don't know what it means. Thank you very much in advance.
Are you absolutely positively required to use the older {sp} package workflow?
If not it may be easier to dissolve the municipalities into comarcas using a pure {sf} based workflow - grouping by a comarca column, and then summarising will do the trick.
Consider this code:
library(tidyverse)
library(sf)
library(readxl)
library(leaflet)
#Read shapefile
mapa_municip <- st_read("UDALERRIAK_MUNICIPIOS.shp") %>%
st_transform(4326)
#Read excel that contains mapping from town to municioalities
muni2com <- read_excel("listado-comarcas-gipuzkoa.xls",
sheet=1,
range="A1:C91",
col_names = T)
# dissolving comarcas using sf / dplyr based workflow
comarcas <- mapa_municip %>%
inner_join(muni2com, by = c("MUNICIPIO" = "Municipios")) %>%
group_by(Comarca) %>%
summarise() %>% # magic! :)))
ungroup()
leaflet(comarcas) %>%
addProviderTiles("CartoDB.Positron") %>%
addPolygons(color = "red",
label = ~ Comarca)

Using a shape file to download MODIS product data for country in R

Is there any way that can be used to parse a shapefile of a country and download MODIS product data within that country using R?
I tried different approaches using the MODIStsp package (https://docs.ropensci.org/MODIStsp/) as well as the MODISTools package (https://docs.ropensci.org/MODISTools/articles/modistools-vignette.html) and they both only allow me to download MODIS product data for a defined site, but not a country.
Here's an example of how you might achieve this.
Firstly, download the MODIS data that you require, in this example I'm using MCD12Q1.006
begin_year and end_year are in the format: Year.Month.Days.
shape_file is the shapefile you're using, presumably the extent of the shapefile is the country you're after. Though, I'm only going off by the minimal information you have provided.
library(MODIS)
tifs <- runGdal(product = "MCD12Q1", collection = "006", SDSstring = "01",
extent = shape_file %>% st_buffer(dist = 10000),
begin = begin_year, end = end_year,
outDirPath = "data", job = "modis",
MODISserverOrder = "LPDAAC") %>%
pluck("MCD12Q1.006") %>%
unlist()
# rename tifs to have more descriptive names
new_names <- format(as.Date(names(tifs)), "%Y") %>%
sprintf("modis_mcd12q1_umd_%s.tif", .) %>%
file.path(dirname(tifs), .)
file.rename(tifs, new_names)
landcover <- list.files("data/modis", "^modis_mcd12q1_umd",
full.names = TRUE) %>%
stack()
# label layers with year
landcover <- names(landcover) %>%
str_extract("(?<=modis_mcd12q1_umd_)[0-9]{4}") %>%
paste0("y", .) %>%
setNames(landcover, .)
Also, if you require a particular cell size, then you could follow this procedure to get a 5x5 modis cell size.
neighborhood_radius <- 5 * ceiling(max(res(landcover))) / 2
agg_factor <- round(2 * neighborhood_radius / res(landcover))
r <- raster(landcover) %>%
aggregate(agg_factor)
r <- shape_file %>%
st_transform(crs = projection(r)) %>%
rasterize(r, field = 1) %>%
# remove any empty cells at edges
trim()
Here's an example using MODISTools to automate downloading the correct tiles for the country.
First let's generate a polygon of a country to demonstrate (using Luxembourg as an example):
library(maptools)
library(sf)
data(wrld_simpl)
world = st_as_sf(wrld_simpl)
lux = world[world$NAME=='Luxembourg',]
Now we find the location (centroid) and size of the country:
#find centroid of polygon in long-lat decimal degrees
lux.cent = st_centroid(lux)
#find width and height of country in km
lux.proj = st_transform(lux,
"+proj=moll +lon_0=0 +x_0=0 +y_0=0 +ellps=WGS84 +units=km +no_defs")
lux.km_lr = diff(st_bbox(lux.proj)[c(1,3)])
lux.km_ab = diff(st_bbox(lux.proj)[c(2,4)])
Using this info, we can download the correct Modis data (using leaf-area index, lai, as an example):
#download the MODIS tiles for the area we defined
library(MODISTools)
lux_lai <- mt_subset(product = "MOD15A2H",
lat = lux.cent$LAT, lon = lux.cent$LON,
band = "Lai_500m",
start = "2004-01-01", end = "2004-01-01",
km_lr = lux.km_lr, km_ab = lux.km_ab,
site_name = "Luxembourg",
internal = TRUE, progress = TRUE)
# convert to a spatial raster
lux.rast = mt_to_raster(df = lux_lai, reproject = TRUE)
lux.rast = raster::mask(lux.rast, lux)
plot(lux.rast)
plot(st_geometry(lux),add=T)

In R Overlap spatial polygons dataframe (spdf) and summarise number of features of 1st spdf overlapped by 2nd spdf

I have tried several sources but no luck. Please see my codes below and I state the problem at the end of codes. I have created random hexagonal grids over large areas and wanted to summarize how many of them fall under features of 2nd spatial polygon data frame.
library (sf)
library(dplyr)
library(raster)
# load 2nd spdf
Read ibra polygons as sf object. To download paste 'Interim Biogeographic Regionalisation for Australia (IBRA)' in the search item then click on 'Interim Biogeographic Regionalisation for Australia (IBRA), Version 7 (Regions)'
ibra <- st_read("ibra7_subregions.shp")
ibra <- st_transform(ibra, crs = 4326)
# ibra has >2000 features (i.e., rows) for 89 regions of same name, group them together
ibraGrid <- ibra %>%
group_by(REG_NAME_7) %>%
st_sf() %>%
mutate(cellid = row_number()) %>%
summarise()
colnames(ibraGrid)[1] <- "id"
# crop ibra to specific boundary
box <- extent(112,155,-45,-10)
ibraGrid <- st_crop(ibraGrid, box)
# make dataframe of spatial grid (1st spdf)
ran.p <- st_sample(au, size = 1040)
Load shp of au from here then click on "nsaasr9nnd_02211a04es_geo___.zip".
au <- st_read("aust_cd66states.shp")
au <- st_transform(au, crs = 4326)
# create grid around multipoints
rand_sampl_Grid <- ran.p %>%
st_make_grid(cellsize = 0.1, square = F) %>%
st_intersection(au) %>%
st_cast("MULTIPOLYGON") %>%
st_sf() %>%
mutate(cellid = row_number())
# sampled grid per ibra region
density_per_ib_grid <- ibraGrid %>%
st_join(rand_sampl_Grid) %>%
mutate(overlap = ifelse(!is.na(id), 1, 0)) %>%
group_by(cellid) %>%
summarize(num_sGrid = sum(overlap))
Everything worked well. But, I expected that the length of View(density_per_ib_grid$num_sGrid) would be equal to the number of features in ibraGrid (i.e., 89). Currently, View(density_per_ib_grid$num_sGrid) has length of features equal to rand_sample_Grid (i.e., ~1040). In addition, I want to repeat the process for 100 times so that num_sGrid would be the mean of 100 iterations.
The above codes worked desirably using larger spdf (which is ibraGrid in this casae) created from coordinates. Any suggestions/feedback will be highly appreciated.
I have figured out the solution. The last codes section in the above question should be as:
richness_per_ib_grid <- st_intersection(ibraGrid, rand_sampl_Grid) %>%
group_by(id) %>%
count()
out <- as.data.frame(int.result)[,-3] # print output as data frame.
Therefore the complete answer for the question above should be:
library (sf)
library(dplyr)
library(raster)
# load 2nd spdf
Read ibra polygons as sf object. To download paste 'Interim Biogeographic Regionalisation for Australia (IBRA)' in the search item then click on 'Interim Biogeographic Regionalisation for Australia (IBRA), Version 7 (Regions)'
ibra <- st_read("ibra7_subregions.shp")
ibra <- st_transform(ibra, crs = 4326)
# ibra has >2000 features (i.e., rows) for 89 regions of same name, group them together
ibraGrid <- ibra %>%
group_by(REG_NAME_7) %>%
st_sf() %>%
summarise()
colnames(ibraGrid)[1] <- "id"
# crop ibra to specific boundary
box <- extent(112,155,-45,-10)
ibraGrid <- st_crop(ibraGrid, box)
# make dataframe of spatial grid (1st spdf)
ran.p <- st_sample(au, size = 1040)
Load shp of au from here then click on "nsaasr9nnd_02211a04es_geo___.zip".
au <- st_read("aust_cd66states.shp")
au <- st_transform(au, crs = 4326)
# create grid around multipoints
rand_sampl_Grid <- ran.p %>%
st_make_grid(cellsize = 0.1, square = F) %>%
st_intersection(au) %>%
st_cast("MULTIPOLYGON") %>%
st_sf()
# sampled grid per ibra region
density_per_ib_grid <- <- st_intersection(ibraGrid, rand_sampl_Grid) %>%
group_by(id) %>%
count()
out <- as.data.frame(int.result)[,-3] # print output as data frame.

Snap points to line in order in R

I have a set of GPS points and a linestring (representing a bus line) where the GPS points should belong to (both are ordered). So I used a function to snap the points to the linestring:
library(dplyr)
library(sf)
library(readr)
# Function to snap points to the closest line
snap_points_to_line <- function(points, line) {
# alinhar as pradas gps com a linha
points_align <- st_nearest_points(points, line) %>%
st_cast("POINT")
# pegar so os pontos pares
points_new_geometry <- points_align[c(seq(2, length(points_align), by = 2))]
points_align_end <- points %>%
st_set_geometry(points_new_geometry)
}
# GPS Points
gps <- structure(list(id = 1:11,
lon = c(-38.477035, -38.477143, -38.478701,
-38.479795, -38.480923, -38.481078,
-38.481885, -38.484545, -38.486156,
-38.486813, -38.486506),
lat = c(-3.743078, -3.743019, -3.742566,
-3.742246, -3.741844, -3.741853,
-3.741596, -3.740711, -3.740076,
-3.739399, -3.73886)),
class = "data.frame",
row.names = c(NA,-11L))
gps
id lon lat
1 1 -38.47704 -3.743078
2 2 -38.47714 -3.743019
3 3 -38.47870 -3.742566
4 4 -38.47980 -3.742246
5 5 -38.48092 -3.741844
6 6 -38.48108 -3.741853
7 7 -38.48188 -3.741596
8 8 -38.48454 -3.740711
9 9 -38.48616 -3.740076
10 10 -38.48681 -3.739399
11 11 -38.48651 -3.738860
# Download line
line <- read_rds(gzcon(url("https://github.com/kauebraga/dissertacao/raw/master/junk/line_so.rds")))
# Make snap
gps_snap <- snap_points_to_line(gps %>% st_as_sf(coords = c("lon", "lat"), crs = 4326), line)
The snap works fine most of the time. But there are some cases where the bus line makes a U turn and some points are snapped to the wrong side of the road because GPS position may have an error. In the figure below, the three points on the south side of the road should be on the north side:
How can I guarantee that the GPS points are snapped to the correct side of the road? Both the GPS points and linestring are in the same order (if you st_cast(line, "POINT) it will give points that grow together with the GPS) , so I hope there should be a way to address that (I don't know how!).
Any help using sf or other spatial tools in R would be much appreciated. Thanks!
Set up the data
library(sf)
library(dplyr)
library(readr)
library(rgeos)
# GPS Points
gps <- structure(list(id = 1:11,
lon = c(-38.477035, -38.477143, -38.478701,
-38.479795, -38.480923, -38.481078,
-38.481885, -38.484545, -38.486156,
-38.486813, -38.486506),
lat = c(-3.743078, -3.743019, -3.742566,
-3.742246, -3.741844, -3.741853,
-3.741596, -3.740711, -3.740076,
-3.739399, -3.73886)),
class = "data.frame",
row.names = c(NA,-11L))
# convert to sf
gps <- gps %>% st_as_sf(coords = c("lon", "lat"), crs = 4326, remove =F)
line <- read_rds(gzcon(url("https://github.com/kauebraga/dissertacao/raw/master/junk/line_so.rds")))
Define Custom Snapping Function
This function works on the logic that the correct road segment to snap to is the one which requires the shortest distance to travel to along the linestring (network distance) from the previous point.
It does the following:
Each point is buffered by a given tolerance (in metres so we have converted to a metre CRS for your area)
The line is then intersected with our buffer. This will leave two sections of road where the traffic goes both ways, and one otherwise. This is illustrated below:
We now have two options to snap to in some cases, so we initially snap to both:
We chose one of the unambiguous points (only one snap option) as the reference point and calculate the distance along the network to the snap options for the next id.
For each point id, the one with the lowest network distance from the previous id will be the one we want.
Having found the correct point id, we then set this as the new reference point and repeat from step 4.
custom_snap <- function(line, points, tolerance, crs = 29194) {
points <- st_transform(points, crs)
line <- st_transform(line, crs)
# buffer the points by the tolerance
points_buf <- st_buffer(points, 15)
# intersect the line with the buffer
line_intersect <- st_intersection(line, points_buf)
# convert mutlinestrings (more than one road segment) into linestrings
line_intersect <- do.call(rbind,lapply(1:nrow(line_intersect),function(x){st_cast(line_intersect[x,],"LINESTRING")}))
# for each line intersection, calculate the nearest point on that line to our gps point
nearest_pt <- do.call(rbind,lapply(seq_along(points$id), function(i){
points[points$id==i,] %>% st_nearest_points(line_intersect[line_intersect$id==i,]) %>% st_sf %>%
st_cast('POINT') %>% mutate(id = i)
}))
nearest_pt<- nearest_pt[seq(2, nrow(nearest_pt), by = 2),] %>%
mutate(option = 1:nrow(.))
# find an unambiguous reference point with only one snap option
unambiguous_pt <- nearest_pt %>%
group_by(id) %>%
mutate(count = n()) %>%
ungroup() %>%
filter(count == 1) %>%
slice(1)
# calculate network distance along our line to each snapped point
dists <- rgeos::gProject(as(line,'Spatial'), as(nearest_pt,'Spatial'))
# join back to nearest points data
dists <- nearest_pt %>% cbind(dists)
# we want to recursively do the following:
# 1. calculate the network distance from our unambiguous reference point to the next id point in the data
# 2. keep the snapped point for that id that was closest *along the network* to the previous id
# 3. set the newly snapped point as our reference point
# 4. repeat
# get distances from our reference point to the next point id
for(i in unambiguous_pt$id:(max(dists$id)-1)){
next_dist <- which.min(abs(dists[dists$id== i +1,]$dists - dists[dists$id== unambiguous_pt$id,]$dists ))
next_option <- dists[dists$id== i +1,][next_dist,]$option
nearest_pt <- nearest_pt %>% filter(id != i+1 | option == next_option)
unambiguous_pt <- nearest_pt %>% filter(id ==i+1 & option == next_option)
dists <- nearest_pt %>% cbind(dists = rgeos::gProject(as(line,'Spatial'), as(nearest_pt,'Spatial')))
}
# and in the reverse direction
for(i in unambiguous_pt$id:(min(dists$id)+1)){
next_dist <- which.min(abs(dists[dists$id== i -1,]$dists - dists[dists$id== unambiguous_pt$id,]$dists ))
next_option <- dists[dists$id== i -1,][next_dist,]$option
nearest_pt <- nearest_pt %>% filter(id != i-1 | option == next_option)
unambiguous_pt <- nearest_pt %>% filter(id ==i-1 & option == next_option)
dists <- nearest_pt %>% cbind(dists = rgeos::gProject(as(line,'Spatial'), as(nearest_pt,'Spatial')))
}
# transform back into lat/lng
snapped_points <- nearest_pt %>%
st_transform(4326)
return(snapped_points)
}
Calculate which line to snap to
gps_snap <- custom_snap(line, gps, 15) %>%
cbind(st_coordinates(.))
Plot results in leaflet
library(leaflet)
# get line coords
line_coords <- line %>%
st_coordinates(.)
# plot in leaflet
leaflet() %>%
leaflet::setView(lng = -38.4798, lat = -3.741829, zoom = 18) %>%
addProviderTiles('CartoDB.Positron') %>%
addPolylines(lng = line_coords[,'X'], lat = line_coords[,'Y']) %>%
addCircles(lng = gps$lon, lat = gps$lat, radius = 3, color ='red') %>%
addCircles(lng = gps_snap$X, lat = gps_snap$Y, col ='green', radius = 4)
Green represents the snapped points, red represents the original GPS points. They are now snapped to the correct side of the road.

Resources