Related
I'm trying to create a polygon that has longitudinal limits as 150, -170, i.e. crosses the 180 meridian dateline.
I've tried:
x = c(-170, -170, 150, 150) #long limits
y = c(-25,-57,-57,-25) #lat limits
polygon = cbind(x, y) %>%
st_linestring() %>%
st_cast("POLYGON") %>%
st_wrap_dateline(options = c("WRAPDATELINE=YES")) %>% #thought this line could solve it
st_sfc(crs = 4326, check_ring_dir = TRUE) %>%
st_sf()
That is not solving the problem, even if I delete the 'st_cast' cast line or use 'MULTIPOLYGONS' instead of 'POLYGONS' in there. I've also created one polygon with positive longitudes and another for the negative ones, and then combined them, but that's not working well (R runs it, but I get nothing when plotting the object with combined polygons).
I would greatly appreciate it if you could provide your ideas on this :)
I think you can do it simply passing the coordinates, but this should be combined also with the right coordinate reference system:
You can create a POLYGON from a bounding box quickly, as far as you assign it the class of a bounding box box and after that use st_as_sfc().
Use sf_use_s2(TRUE), available on sf >= 1.0.0.
See here how to do it:
library(sf)
sf_use_s2(TRUE)
# From bounding box
box <- c(xmin=-170, ymin=-57, xmax=150, ymax=-25)
class(box) <- "bbox"
box_end <- box |>
st_as_sfc() |>
st_as_sf(crs=4326)
box_end
#> Simple feature collection with 1 feature and 0 fields
#> Geometry type: POLYGON
#> Dimension: XY
#> Bounding box: xmin: -170 ymin: -57 xmax: 150 ymax: -25
#> Geodetic CRS: WGS 84
#> x
#> 1 POLYGON ((-170 -57, 150 -57...
# Check if point in polygon
# This point should not be on your polygon
ptest1 <- st_as_sfc("POINT(130 -40)", crs=4326)
st_contains(box_end, ptest1)
#> Sparse geometry binary predicate list of length 1, where the predicate
#> was `contains'
#> 1: (empty)
# This should be on the polygon
ptest2 <- st_as_sfc("POINT(-176 -40)", crs=4326)
st_contains(box_end, ptest2)
#> Sparse geometry binary predicate list of length 1, where the predicate
#> was `contains'
#> 1: 1
If you want to plot it you must use a suitable projection for your coordinates. In this case I use an Ortographic projection centered in c(-160, -40):
# Just for example: Using Pacific centered crs
library(ggplot2)
library(giscoR)
data("gisco_countries")
ggplot(gisco_countries) +
geom_sf()+
geom_sf(data=box_end, fill="red") +
geom_sf(data=ptest1, col="green", size=2) +
geom_sf(data=ptest2, col="blue", size=2) +
coord_sf(crs = "+proj=ortho +x_0=0 +y_0=0 +lat_0=-40 +lon_0=160")
If you want to have a MULTIPOLYGON instead a POLYGON
Use st_shift_longitude() + st_wrap_dateline().
library(sf)
sf_use_s2(TRUE)
# From bounding box
box <- c(xmin=-170, ymin=-57, xmax=150, ymax=-25)
class(box) <- "bbox"
box_end <- box |>
st_as_sfc() |>
st_as_sf(crs=4326) |>
# This splits the POLYGON and creates a MULTIPOLYGON
# Note that the bounding box is also affected
st_shift_longitude() |>
st_wrap_dateline()
box_end
#> Simple feature collection with 1 feature and 0 fields
#> Geometry type: MULTIPOLYGON
#> Dimension: XY
#> Bounding box: xmin: -180 ymin: -57 xmax: 180 ymax: -25
#> Geodetic CRS: WGS 84
#> x
#> 1 MULTIPOLYGON (((150 -57, 15...
# Check if point in polygon
# This point should not be on your polygon
ptest1 <- st_as_sfc("POINT(130 -40)", crs=4326)
st_contains(box_end, ptest1)
#> Sparse geometry binary predicate list of length 1, where the predicate
#> was `contains'
#> 1: (empty)
# This should be on the polygon
ptest2 <- st_as_sfc("POINT(-176 -40)", crs=4326)
st_contains(box_end, ptest2)
#> Sparse geometry binary predicate list of length 1, where the predicate
#> was `contains'
#> 1: 1
# Just for example: Using Robinson
library(ggplot2)
library(giscoR)
data("gisco_countries")
ggplot(gisco_countries) +
geom_sf()+
geom_sf(data=box_end, fill="red") +
geom_sf(data=ptest1, col="green", size=2) +
geom_sf(data=ptest2, col="blue", size=2) +
coord_sf(crs = "+proj=robin")
I am trying to extract contour lines from a raster object using the raster package in R.
rasterToContour appears to work well and plots nicely, but when investigated it appears the contour lines are broken up into irregular segments. Example data from ?rasterToContour
library(raster)
f <- system.file("external/test.grd", package="raster")
r <- raster(f)
x <- rasterToContour(r)
class(x)
plot(r)
plot(x, add=TRUE)
I am trying to extract the contour line of a sample site in the raster. So, we choose a random site, extract its elevation, and run rasterToContour() again, specifying the elevation for the contour line level.
# our sample site - a random cell chosen on the raster
xyFromCell(r, 5000) %>%
SpatialPoints(proj4string = crs(r)) %>%
{. ->> site_sp} %>%
st_as_sf %>%
{. ->> site_sf}
# find elevation of sample site, and extract contour lines
extract(r, site_sf) %>%
{. ->> site_elevation}
# extract contour lines
r %>%
rasterToContour(levels = site_elevation) %>%
{. ->> contours_sp} %>%
st_as_sf %>%
{. ->> contours_sf}
# plot the site and new contour lines (approx elevation 326)
plot(r)
plot(contours_sf, add = TRUE)
plot(site_sf, add = TRUE)
# plot the contour lines and sample site - using sf and ggplot
ggplot()+
geom_sf(data = contours_sf)+
geom_sf(data = site_sf, color = 'red')
Then we use st_intersects to find the lines that intersect the site (with a buffer width of 100 to ensure it touches the line). But, this returns all of the contour lines.
contours_sf %>%
filter(
st_intersects(., site_sf %>% st_buffer(100), sparse = FALSE)[1,]
) %>%
ggplot()+
geom_sf()
I assume all lines are returned because they appear to be a single MULTILINESTRING sf object.
contours_sf
# Simple feature collection with 1 feature and 1 field
# geometry type: MULTILINESTRING
# dimension: XY
# bbox: xmin: 178923.1 ymin: 329720 xmax: 181460 ymax: 333412.3
# CRS: +proj=sterea +lat_0=52.1561605555556 +lon_0=5.38763888888889 +k=0.9999079 +x_0=155000 +y_0=463000 +datum=WGS84 +units=m +no_defs
# level geometry
# C_1 326.849822998047 MULTILINESTRING ((179619.3 ...
So, I have split the contours_sf MULTILINESTRING into individual lines using ngeo::st_segments() (I couldn't find any sf way to do this, but am open to using alternative methods, especially if this is the problem).
Unexpectedly this returns 394 features; from looking at the figure I would expect approximately 15 separate lines.
contours_sf %>%
nngeo::st_segments()
# Simple feature collection with 394 features and 1 field
# geometry type: LINESTRING
# dimension: XY
# bbox: xmin: 178923.1 ymin: 329720 xmax: 181460 ymax: 333412.3
# CRS: +proj=sterea +lat_0=52.1561605555556 +lon_0=5.38763888888889 +k=0.9999079 +x_0=155000 +y_0=463000 +datum=WGS84 +units=m +no_defs
# First 10 features:
# level result
# 1 326.849822998047 LINESTRING (179619.3 329739...
# 2 326.849822998047 LINESTRING (179580 329720.4...
# 3 326.849822998047 LINESTRING (179540 329720, ...
# 4 326.849822998047 LINESTRING (179500 329735.8...
# 5 326.849822998047 LINESTRING (179495.3 329740...
# 6 326.849822998047 LINESTRING (179460 329764, ...
# 7 326.849822998047 LINESTRING (179442.6 329780...
# 8 326.849822998047 LINESTRING (179420 329810, ...
# 9 326.849822998047 LINESTRING (179410.2 329820...
# 10 326.849822998047 LINESTRING (179380 329847.3...
Then, when we filter to keep only the lines which intersect the site (with a buffer width of 100), only a small section of the expected contour line is returned (red section of line, I assume reflective of the 100 buffer width).
contours_sf %>%
nngeo::st_segments() %>%
filter(
# this syntax used as recommended by this answer https://stackoverflow.com/a/57025700/13478749
st_intersects(., site_sf %>% st_buffer(100), sparse = FALSE)
) %>%
ggplot()+
geom_sf(colour = 'red', size = 3)+
geom_sf(data = contours_sf)+
geom_sf(data = site_sf, colour = 'cyan')+
geom_sf(data = site_sf %>% st_buffer(100), colour = 'cyan', fill = NA)
Anyone got ideas for the following points:
Explain why the contour lines are 'broken'
Provide an efficient method for 'joining' the broken pieces together
An alternative to nngeo::st_segments(), if this is in fact the source of the 394 lines not ~15
Converting the MULTILINESTRING to a LINESTRING seems to do what you need:
contours_sf %>% st_cast("LINESTRING") %>%
filter(st_intersects(., st_buffer(site_sf, 100), sparse=FALSE)[,1]) %>%
ggplot()+
geom_sf(data = contours_sf)+
geom_sf(data = site_sf, color = 'red') +
geom_sf(color = 'pink')
Perhaps it works better if you start by disaggregating the lines
library(raster)
f <- system.file("external/test.grd", package="raster")
r <- raster(f)
x <- rasterToContour(r)
x <- disaggregate(x)
Or with terra
library(terra)
r <- rast(f)
x <- as.contour(r)
x
# class : SpatVector
# geometry : lines
# dimensions : 8, 1 (geometries, attributes)
x <- disaggregate(x)
x
# class : SpatVector
# geometry : lines
# dimensions : 56, 1 (geometries, attributes)
And you can continue like this
y <- st_as_sf(x)
Or like this
r <- rast(system.file("ex/meuse.tif", package="terra"))
site <- vect(xyFromCell(r, 5000), crs=crs(r))
elevation <- extract(r, site)
v <- disaggregate(as.contour(r, levels=elevation))
i <- which.min(distance(site, v))
vv <- v[i]
plot(r)
lines(v)
lines(vv, col="red", lwd=2)
points(site, col="blue", cex=2)
I am new to the sf package in r attempting to create an object from a set of points gives to me in UTM by a collaborator. I've seen how people can use similar methods with lat/long coordinates but have not been able to achieve the same results because of the zone portion of point definitions
can.df <- data.frame(
rbind(
c("NW", "9V", 586518, 7077103),
c("NE", "13W", 645544, 7118728),
c("SW", "11T", 680262, 4865141),
c("SE", "14T", 314095, 497555)),
stringsAsFactors = F)
colnames(can.df) <- c("Corner", "Zone", "Northing", "Easting")
## make xy numeric
num.cols <- c("Northing", "Easting")
can.df[num.cols] <- sapply(can.df[num.cols], as.numeric)
can.df["Zone"] <- as.character(can.df["Zone"])
test <- st_as_sf(can.df,
coords = c("Easting", "Northing", "Zone"),
epsg = 2955)
This will give me the error:
Error in points_cpp(pts, gdim): Not compatible with requested type:
[type=character; target=double].
and if I strip the letters from the zone definition, and use it as numeric. Then I receive:
Error in st_sf(x, ..., agr = agr, sf_column_name = sf_column_name): no
simple features geometry column present
Can anyone shed some light as to what I'm missing?
Try removing "Zone" form coords and change epsg to crs. epsg is not a parameter accepted by st_sf.
library(sf)
#> Linking to GEOS 3.8.0, GDAL 3.0.1, PROJ 6.2.0
can.df <- data.frame(
rbind(
c("NW", "9V", 586518, 7077103),
c("NE", "13W", 645544, 7118728),
c("SW", "11T", 680262, 4865141),
c("SE", "14T", 314095, 497555)),
stringsAsFactors = F)
colnames(can.df) <- c("Corner", "Zone", "Northing", "Easting")
## make xy numeric
num.cols <- c("Northing", "Easting")
can.df[num.cols] <- sapply(can.df[num.cols], as.numeric)
can.df["Zone"] <- as.character(can.df["Zone"])
test <- st_as_sf(can.df,
coords = c("Easting", "Northing", "Zone"),
crs = 2955)
#> Warning in lapply(x[coords], as.numeric): NAs introduced by coercion
#> Error in st_as_sf.data.frame(can.df, coords = c("Easting", "Northing", : missing values in coordinates not allowed
test <- st_as_sf(can.df,
coords = c("Easting", "Northing"),
crs = 2955)
test
#> Simple feature collection with 4 features and 2 fields
#> geometry type: POINT
#> dimension: XY
#> bbox: xmin: 497555 ymin: 314095 xmax: 7118728 ymax: 680262
#> epsg (SRID): 2955
#> proj4string: +proj=utm +zone=11 +ellps=GRS80 +towgs84=0,0,0,0,0,0,0 +units=m +no_defs
#> Corner Zone geometry
#> 1 NW c("9V", "13W", "11T", "14T") POINT (7077103 586518)
#> 2 NE c("9V", "13W", "11T", "14T") POINT (7118728 645544)
#> 3 SW c("9V", "13W", "11T", "14T") POINT (4865141 680262)
#> 4 SE c("9V", "13W", "11T", "14T") POINT (497555 314095)
Created on 2019-10-15 by the reprex package (v0.3.0)
I have trouble getting the intersection between two large SpatialPolygonsDataFrame on R. My polygons data represent buildings and administrative boundaries, and I am trying to get the intersection polygons between them.
I understand that the intersect function from the raster package and gIntersection from the rgeos package can do this job (with a few differences) but they cannot handle all my polygons at once (about 50.000 polygons/entity).
For this reason, I have to split my calculation within a loop, saving the result for each step. The problem is: these functions keep filling my physical memory, and I cannot clean it. I tried using rm() and gc(), but it does not change a thing. The memory issue crashes my R session, and I cannot do my calculation.
Is there a way to free the RAM during simulation, within loops ? Or to avoid this memory issue ?
Here comes a reproducible example, for random polygons.
library(raster)
library(sp)
library(rgeos)
#Generating 50000 points (for smaller polygons) and 150000 (for larger polygons) in a square of side 100000
size=100000
Nb_points1=50000
Nb_points2=150000
start_point=matrix(c(sample(x = 1:size,size = Nb_points1,replace = T),sample(x = 1:size,size = Nb_points1,replace = T)),ncol=2)
start_point2=matrix(c(sample(x = 1:size,size = Nb_points2,replace = T),sample(x = 1:size,size = Nb_points2,replace = T)),ncol=2)
#Defining different sides length
radius=sample(x = 1:50,size = Nb_points1,replace = T)
radius2=sample(x = 1:150,size = Nb_points2,replace = T)
#Generating list of polygons coordinates
coords=list()
for(y in 1:Nb_points1){
xmin=max(0,start_point[y,1]-radius[y])
xmax=min(size,start_point[y,1]+radius[y])
ymin=max(0,start_point[y,2]-radius[y])
ymax=min(size,start_point[y,2]+radius[y])
coords[[y]]=matrix(c(xmin,xmin,xmax,xmax,ymin,ymax,ymax,ymin),ncol=2)
}
coords2=list()
for(y in 1:Nb_points2){
xmin=max(0,start_point2[y,1]-radius2[y])
xmax=min(size,start_point2[y,1]+radius2[y])
ymin=max(0,start_point2[y,2]-radius2[y])
ymax=min(size,start_point2[y,2]+radius2[y])
coords2[[y]]=matrix(c(xmin,xmin,xmax,xmax,ymin,ymax,ymax,ymin),ncol=2)
}
#Generating 75000 polygons
Poly=SpatialPolygons(Srl = lapply(1:Nb_points1,function(y) Polygons(srl = list(Polygon(coords=coords[y],hole = F)),ID = y)),proj4string = CRS('+init=epsg:2154'))
Poly2=SpatialPolygons(Srl = lapply(1:Nb_points2,function(y)Polygons(srl = list(Polygon(coords=coords2[y],hole = F)),ID = y)),proj4string = CRS('+init=epsg:2154'))
#Union of overlapping polygons
aaa=gUnionCascaded(Poly)
bbb=gUnionCascaded(Poly2)
aaa=disaggregate(aaa)
bbb=disaggregate(bbb)
intersection=gIntersects(spgeom1 = aaa,bbb,byid = T,returnDense = F)
#Loop on the intersect function
pb <- txtProgressBar(min = 0, max = ceiling(length(aaa)/1000), style = 3)
for(j in 1:ceiling(length(aaa)/1000)){
tmp_aaa=aaa[((j-1)*1000+1):(j*1000),]
tmp_bbb=bbb[unique(unlist(intersection[((j-1)*1000+1):(j*1000)])),]
List_inter=intersect(tmp_aaa,tmp_bbb)
gc()
gc()
gc()
setTxtProgressBar(pb, j)
}
Thank you !
You can consider using the st_intersects and st_intersection functions of package sf. For example:
aaa2 <- sf::st_as_sf(aaa)
bbb2 <- sf::st_as_sf(bbb)
intersections_mat <- sf::st_intersects(aaa2, bbb2)
intersections <- list()
for (int in seq_along(intersections_mat)){
if (length(intersections_mat[[int]]) != 0){
intersections[[int]] <- sf::st_intersection(aaa2[int,],
bbb2[intersections_mat[[int]],])
}
}
will give you an intersection_mat of length equal to aaa, and containing , for each feature of aaa, the "indexes" of bbb elements with which it intersects ("empty" if no intersection found):
> intersections_mat
Sparse geometry binary predicate list of length 48503, where the predicate was `intersects'
first 10 elements:
1: 562
2: (empty)
3: 571
4: 731
5: (empty)
6: (empty)
7: (empty)
8: 589
9: 715
10: (empty)
, and an intersection list containing the list of intersecting polygons:
>head(intersections)
[[1]]
Simple feature collection with 1 feature and 0 fields
geometry type: POLYGON
dimension: XY
bbox: xmin: 98873 ymin: 33 xmax: 98946 ymax: 98
epsg (SRID): 2154
proj4string: +proj=lcc +lat_1=49 +lat_2=44 +lat_0=46.5 +lon_0=3 +x_0=700000 +y_0=6600000 +ellps=GRS80 +towgs84=0,0,0,0,0,0,0 +units=m +no_defs
geometry
1 POLYGON ((98873 33, 98873 9...
[[2]]
NULL
[[3]]
Simple feature collection with 1 feature and 0 fields
geometry type: POLYGON
dimension: XY
bbox: xmin: 11792 ymin: 3 xmax: 11806 ymax: 17
epsg (SRID): 2154
proj4string: +proj=lcc +lat_1=49 +lat_2=44 +lat_0=46.5 +lon_0=3 +x_0=700000 +y_0=6600000 +ellps=GRS80 +towgs84=0,0,0,0,0,0,0 +units=m +no_defs
geometry
1 POLYGON ((11792 3, 11792 17...
(i.e., intersections[[1]] is the intersection between polygon 1 of aaa and polygon 571 of bbb)
HTH.
The example works fine for me (8 GB RAM), after a few changes to the loop. See below. Tese changes are not related to memory use --- you were not storing the results.
List_inter <- list()
for(j in 1:ceiling(length(aaa)/1000)){
begin <- (j-1) * 1000 + 1
end <- min((j*1000), length(aaa))
tmp_aaa <- aaa[begin:end,]
tmp_bbb <- bbb[unique(unlist(intersection[begin:end])),]
List_inter[[j]] <- intersect(tmp_aaa,tmp_bbb)
cat(j, "\n"); flush.console()
}
x <- do.call(bind, List_inter)
Alternatively, you could write the intermediate results to disk, and deal with them later:
inters <- intersect(tmp_aaa,tmp_bbb)
saveRDS(inters, paste0(j, '.rds'))
Or
shapefile(inters, paste0(j, '.shp'))
I'm not sure if I completely understood the help page to create voronoi polygons.
library(sf)
# function to get polygon from boundary box
bbox_polygon <- function(x) {
bb <- sf::st_bbox(x)
p <- matrix(
c(bb["xmin"], bb["ymin"],
bb["xmin"], bb["ymax"],
bb["xmax"], bb["ymax"],
bb["xmax"], bb["ymin"],
bb["xmin"], bb["ymin"]),
ncol = 2, byrow = T
)
sf::st_polygon(list(p))
}
nc <- st_centroid(st_read(system.file("shape/nc.shp", package="sf")))["BIR79"]
box <- st_sfc(bbox_polygon(nc))
v <- st_voronoi(nc, box)
plot(v)
output
Any idea to fix it?
Using the st_voronoi() example from the sf doc pages as a starting point, it seems that st_voronoi() doesn't work with an sf object consisting of points.
library(sf)
# function to get polygon from boundary box
bbox_polygon <- function(x) {
bb <- sf::st_bbox(x)
p <- matrix(
c(bb["xmin"], bb["ymin"],
bb["xmin"], bb["ymax"],
bb["xmax"], bb["ymax"],
bb["xmax"], bb["ymin"],
bb["xmin"], bb["ymin"]),
ncol = 2, byrow = T
)
sf::st_polygon(list(p))
}
nc <- st_read(system.file("shape/nc.shp", package="sf"))["BIR79"]
nc_centroids <- st_centroid(nc)
box <- st_sfc(bbox_polygon(nc_centroids))
head(nc_centroids)
Each point has a separate geometry entry.
Simple feature collection with 6 features and 1 field
geometry type: POINT
dimension: XY
bbox: xmin: -81.49826 ymin: 36.36145 xmax: -76.0275 ymax: 36.49101
epsg (SRID): 4267
proj4string: +proj=longlat +datum=NAD27 +no_defs
BIR79 geometry
1 1364 POINT(-81.4982613405682 36....
2 542 POINT(-81.125145134236 36.4...
3 3616 POINT(-80.6857465738484 36....
4 830 POINT(-76.0275025784544 36....
5 1606 POINT(-77.4105635619488 36....
6 1838 POINT(-76.9947769754215 36....
This combines the points into a multipoint geometry:
head(st_union(nc_centroids))
Output:
Geometry set for 1 feature
geometry type: MULTIPOINT
dimension: XY
bbox: xmin: -84.05976 ymin: 34.07663 xmax: -75.80982 ymax: 36.49101
epsg (SRID): 4267
proj4string: +proj=longlat +datum=NAD27 +no_defs
MULTIPOINT(-84.0597597853139 35.131067104959, -...
Using the union of points instead of the original sf object works:
v <- st_voronoi(st_union(nc_centroids), box)
plot(v, col = 0)
And here's how to get the correct state boundary instead of the original bounding box.
plot(st_intersection(st_cast(v), st_union(nc)), col = 0) # clip to smaller box
plot(nc_centroids, add = TRUE)
I'm trying to do something similar with marked points and I need to preserve the attributes of the points for the resulting tiles. Haven't figured that out yet.