Related
I have an image stored as matrix with grayscale for each pixel.
On this image I use SLIC algorithm to divide it into areas.
So I get a simple feature (sf) with polygons, I am able to extract in well-known-text (wkt).
But what I really need is a matrix/mask (same dimension as my pixel-image-matrix) storing the id of the polygon each pixel belongs to. For example the pixel image[1,2] belongs to polygon 5, then mask[1,2] <- 5.
I add some code to give example of my porblem (for a random "image"):
mat <- array(runif(10000, min=0, max=500), dim=c(100,100))
# SLIC
library(supercells);
library(sf);
library(terra);
# make spatial raster from matrix
raster <- rast(mat);
rasterSLIC <- supercells(raster, k = 50, compactness = 1, dist_fun = "euclidean", avg_fun = "mean");
plot(raster);
plot(st_geometry(rasterSLIC), add = TRUE, lwd = 0.2);
point <- st_cast(rasterSLIC$geometry[2], to="POINT");
coord <- st_coordinates(point);
# what I want:
goal <- array(c(1,1,1,2,2,1,2,3,3), dim=c(3,3));
image(goal);
goal;
I would like to have something that helps me turning coords into such a mask/matrix I gave a small example for in goal.
You can use terra::rasterize
Example data
library(terra)
# polygons
f <- system.file("ex/lux.shp", package="terra")
v <- vect(f)
# arbitrary raster
r <- rast(v, res=.01)
Solution:
rid <- rasterize(v, r, 1:nrow(r))
#or
v$ID <- 1:nrow(v)
rid <- rasterize(v, r, "ID")
Illustration
plot(rid, type="classes")
text(v)
lines(v)
To get the a matrix of the raster values you can do
m <- as.matrix(rid, wide=TRUE)
With your more specific example, you could do
library(supercells);
library(terra)
set.seed(1)
mat <- array(runif(10000, min=0, max=500), dim=c(100,100))
r <- rast(mat)
SLIC <- supercells(r, k = 50, compactness = 1, dist_fun = "euclidean", avg_fun = "mean");
x <- rasterize(SLIC, r, "supercells")
xm <- as.matrix(x, wide=TRUE)
plot(x);
s <- vect(SLIC)
lines(s)
I want to select raster cells that are within a certain distance (for e.g. 1 km or 5 km) from the boundary of a polygon. I ultimately want to take an average of only those raster cells that are within the specified distance from the boundary of shapefile inwards.
The way I thought I would approach is to create a negative buffer inwards, and subtract the original polygon and the buffer. Then mask and crop the raster using the new polygon and take the average.
Here's sample data demonstrating what I want to do.
library(raster)
# raster
r <- raster(xmn=1035792, xmx= 1116792, ymn=825303.6, ymx=937803.6, resolution = 12.5,crs = "+init=epsg:3174")
r <- setValues(r, 0)
# polygon
x <- c(1199999, 1080000, 1093067, 1090190, 1087977, 1070419, 1180419)
y <- c(957803.6,937803.6, 894366.9, 872153.9, 853703.0, 825353.6, 805353.6)
poly.lake <- SpatialPolygons(list(Polygons(list(Polygon(data.frame(x,y))), ID = 1)))
r <- mask(r, poly.lake)
r <- crop(r, poly.lake)
plot(poly.lake)
plot(r, add = T)
Instead of taking average of the resulting raster r, I only want to average raster cells which are within a certain specified distance from the boundary.
The example data but using "terra"
library(terra)
r <- rast(xmin=1035792, xmax= 1116792, ymin=825303.6, ymax=937803.6, resolution = 125, crs = "epsg:3174")
values(r) <- 1:ncell(r)
# polygon
x <- c(1199999, 1080000, 1093067, 1090190, 1087977, 1070419, 1180419)
y <- c(957803.6,937803.6, 894366.9, 872153.9, 853703.0, 825353.6, 805353.6)
p <- vect(cbind(x, y), "polygons", crs = "epsg:3174")
r <- mask(r, p)
r <- crop(r, p)
You can now take the internal buffer of p
b <- buffer(p, -10000)
x <- mask(r, b, inverse=TRUE)
global(x, mean,na.rm=T)
# mean
#lyr.1 296549.9
Or you can take both sides like this
bb <- buffer(as.lines(p), 10000)
y <- mask(r, bb)
global(y, mean,na.rm=T)
# mean
#lyr.1 296751.3
So there is a slight difference between these two approaches; I think because the first uses inverse=TRUE; I would go with the second approach.
Your drawing (and Chris' answer) suggests that you only want the distance to the western border. In that case, you can first find the start and end nodes you need (from 2 to 6)
plot(p)
points(p)
text(as.points(p), pos=2)
Select the segments in between these nodes and create a line type SpatVector.
g <- geom(p)
k <- vect(g[2:6,], "lines", crs=crs(p))
lines(k, col="red", lwd=2)
And now do as above.
bk <- buffer(k, 10000)
z <- mask(r, bk)
global(z, mean,na.rm=T)
# mean
#lyr.1 297747
If you wanted to get the part of buffer bk that is inside the original polygon p you can do
bki <- intersect(bk, p)
To complete the plot
polys(bk, lty=3, border=NA, col=adjustcolor("light blue", alpha.f = 0.4))
lines(bki, lty=3)
Finding which segments of a polygon to buffer was what puzzled me, and this seems a decent approach cast_poly_to_subsegments. Taking your poly.lake as poly_sf:
geom <- lapply(
1:(length(st_coordinates(poly_sf)[, 1]) - 1),
function(i) {
rbind(
as.numeric(st_coordinates(poly_sf)[i, 1:2]),
as.numeric(st_coordinates(poly_sf)[i + 1, 1:2])
)
}
+ ) |>
st_multilinestring() |>
st_sfc(crs=st_crs(rt)) |>
st_cast('LINESTRING')
gives us
which is a little surprising, the 'green and red', that I assumed would be 'green'. It is wound clockwise so the desired segments to buffer are 4 & 5.
lns_buf4 <- st_buffer(st_geometry(geom)[4], 1000, singleSide = TRUE)
lns_buf5 <- st_buffer(st_geometry(geom)[5], 1000, singleSide= TRUE)
lns_buf5_neg <- st_buffer(st_geometry(geom)[5], -1000, singleSide= TRUE)
plot(st_geometry(geom), col = c('red', 'yellow', 'blue', 'green'))
plot(lns_buf4, col = 'black', add = TRUE)
plot(lns_buf5, col = 'green', add = TRUE)
plot(lns_buf5_neg, col = 'blue', add = TRUE)
Whether +/-1000 is sufficient is a further intersection test between the buffer poly(s) and the other boundary. If the desired sampling area is not rectangular, steps can be taken to construct a sampling polygon from the buffer and intersection.
#library(lwgeom)
# on poly_sf
new_line <- draw(x = 'line', col ='blue', lwd = 2, n = 10)
lns_buf5_10k_neg <- st_buffer(st_geometry(geom)[5], -10000, singleSide= TRUE)
new_line_sf <- st_as_sf(new_line, crs = st_crs(lns_buf5_10k_neg))
buf5_nline_split <- lwgeom::st_split(lns_buf5_10k_neg, new_line_sf$geometry)
irreg_smp_area <- st_collection_extract(buf5_nline_split)[1]
Though I'm happy to see it all done in terra.
I would like to get non-NA values extracted from random coordinates of a raster within each grid cell.
An example of a raster
library(raster)
r <- raster(ncol = 10, nrow = 10, xmx = -80, xmn = -150, ymn = 20, ymx = 60)
values(r) <- runif(ncell(r))
An example of a grid
grid <- raster(extent(r))
res(grid) <- 15
proj4string(grid)<- proj4string(r)
gridpolygon <- rasterToPolygons(grid)
plot(r)
plot(gridpolygon, add = T)
How can I extract a value with random coordinates for each raster portions inside each grid cells?
I am really new at this kind of stuff so any suggestions will be very welcome.
Thanks.
You didn't specify all the condition for sampling, so I'm going by some assumptions here.
One can sample a point per grid polygon and extract the value. Here's how you can do it in one go and hope for the best:
# pick random points per each grid cell and plot
set.seed(357)
pickpts <- sapply(gridpolygon#polygons, spsample, n = 1, type = "random")
sapply(pickpts, plot, add = TRUE)
# extract values of raster cells at specified points
sapply(pickpts, FUN = extract, x = r)
Or you can do it in a loop and sample until you get a non-NA value.
N <- length(gridpolygon#polygons)
result <- rep(NA, times = N)
for (i in 1:N) {
message(sprintf("Trying polygon %d", i))
pl <- gridpolygon#polygons[[i]]
candval <- result[i] # start with NA
# sample until you get a non-NA hit
while (is.na(candval)) {
pickpoint <- spsample(pl, n = 1, type = "random")
candval <- extract(x = r, y = pickpoint)
}
result[i] <- candval
}
result
[1] 0.4235214 0.6081435 0.9126583 0.1710365 0.7788590 0.9413206 0.8589753
[8] 0.0376722 0.9662231 0.1421353 0.0804440 0.1969363 0.1519467 0.1398272
[15] 0.4783207
SO-gurues!
I am trying to count the densities of surviving units in different gridcells.
I have two shapefiles with points from the two survey periods in question (one before and one after the mortality event). What I intend is to see whether there is a difference in survival rates and link the proportion of survival to any climatic variable obtained from the raster value of the desired grid. In the code snippet below I have created some random raster and shapefiles.
packs = c('raster', 'rgdal', 'spatstat', 'sp' ,'dplyr')
sapply(packs, FUN = 'require', character.only = TRUE)
xy <- matrix(rnorm(1024),32,32) #Creating the desired raster
image(xy)
rast <- raster(xy)
extent(rast) <- c(36,37,-3,-2)
projection(rast) <- CRS("+proj=longlat +datum=WGS84")
points <- runifpoint(n =4000, c(36,37,-3,-2)) # Creating the points
x <- points$x
y <- points$y
values <- c(rep(1, 900), rep(0, 3100))
xy <- cbind(x, y)
points <- cbind(x, y, values)
points <- data.frame(points)
shp <- SpatialPointsDataFrame(coords = xy, data = data.frame(values) ) # creating shpfiles
projection(shp) <- CRS("+proj=longlat +datum=WGS84")
subs <- filter(points, values == 1)
suxy <- select(subs, x,y)
shpsub <- SpatialPointsDataFrame(coords = suxy, data = data.frame(subs$values)) # creating shpfiles
projection(shpsub) <- CRS("+proj=longlat +datum=WGS84")
When I attempt to extract the points I use the following lines of code
shp <- spTransform(shp, projection(rast)) # make sure they have same transformation
shpsub <- spTransform(shpsub, projection(rast))
XY <- xyFromCell(rast, cell = 1:ncell(rast))
v <- as.data.frame(rast) #Extract values from raster
XY <- data.frame(XY, v) # Creating a data frame containing coord., cellno and value
XY$cell <- c(1:ncell(rast))
cells <- cellFromXY(rast,shp) # find which cells the points are in
cells <- rle(cells) # returns a value and a length, fast for counting
cellsfound <- cellFromXY(rast,shpsub)
cellsfound <- rle(cellsfound)
Proportion <- data.frame(cell = cells$values, shp = cells$lengths)
test <- data.frame(cell = rep(NA,NROW(Proportion)), shpsub = rep(NA, NROW(Proportion)))
test$cell <- c(cellsfound$values, rep(NA, nrow(test) - length(cellsfound$values)))
test$shpsub <- c(cellsfound$lengths, rep(NA, NROW(test) - length(cellsfound$lengths)))
Proportion <- full_join(Proportion, test, by = "cell")
test.Proportion <- mutate(Proportion, Proportion = shpsub/shp) #Calculating Proportion
XY <- left_join(XY, test.Proportion, by = "cell") # Adding Proportion to coord and cell no.
XY.m <- summarise(XY, )
XY <- na.omit(XY) ; XY <- XY[,-4]
As I see it. Using rle() returns the same cells multiple times instead of counting the no of points within each individual cell as was my intention. Can anyone please explain me how to do this in a way that retrieves the information on the number of occurrences in the individual cells?
Is there a way to generate regularly spaced (e.g., 500 meters apart) points within a polygon using R? I have been trying to use the sp package but can't seem to define a set of points that are spaced a certain distance apart from one another. My aim is to generate the points, then extract their lat/long coordinates into a new dataframe. Any help would be much appreciated! Thanks
Quite straight forward and almost out-of-the-box.
As OP did not share data, buckle up, put your seats in a vertical position and let us fly to Paris. There, we will adapt a geosphere function, and with its help we will divide up Paris' shape into lon / lat coordinates that are 500 meters apart each (vertically and horizontally).
# Load necessary libraries.
library(raster)
library(geosphere)
library(tidyverse)
library(sp)
# This is an adapted version of geosphere's destPoint() function that works with
# changing d (distance).
destPoint_v <- function (x, y, b, d, a = 6378137, f = 1/298.257223563, ...)
{
r <- list(...)$r
if (!is.null(r)) {
return(.old_destPoint(x, y, b, d, r = r))
}
b <- as.vector(b)
d <- as.vector(d)
x <- as.vector(x)
y <- as.vector(y)
p <- cbind(x, y, b, d)
r <- .Call("_geodesic", as.double(p[, 1]), as.double(p[, 2]),
as.double(p[, 3]), as.double(p[, 4]),
as.double(a), as.double(f),
PACKAGE = "geosphere")
r <- matrix(r, ncol = 3, byrow = TRUE)
colnames(r) <- c("lon", "lat", "finalbearing")
return(r[, 1:2, drop = FALSE])
}
# Data can be downloaded from
# http://osm13.openstreetmap.fr/~cquest/openfla/export/communes-20190101-shp.zip
# or
# https://www.data.gouv.fr/en/datasets/decoupage-administratif-communal-francais-issu-d-openstreetmap/
# ("Export simple de janvier 2019 (225Mo)")
# Load shapefile.
# shp <- raster::shapefile("Dropbox/work/crema/communes-20190101-shp/communes-20190101.shp")
# Extract Paris.
paris <- shp[shp$nom == "Paris", ]
# Set distance of points in meters.
dist <- 500
# Extract bounding box from Paris' SpatialPolygonDataFrame.
bbox <- raster::extent(paris)
# Calculate number of points on the vertical axis.
ny <- ceiling(geosphere::distGeo(p1 = c(bbox#xmin, bbox#ymin),
p2 = c(bbox#xmin, bbox#ymax)) / dist)
# Calculate maximum number of points on the horizontal axis.
# This needs to be calculated for the lowermost and uppermost horizontal lines
# as the distance between latitudinal lines varies when the longitude changes.
nx <- ceiling(max(geosphere::distGeo(p1 = c(bbox#xmin, bbox#ymin),
p2 = c(bbox#xmax, bbox#ymin)) / dist,
geosphere::distGeo(p1 = c(bbox#xmin, bbox#ymax),
p2 = c(bbox#xmax, bbox#ymax)) / dist))
# Create result data frame with number of points on vertical axis.
df <- data.frame(ny = 1:ny)
# Calculate coordinates along the vertical axis.
pts <- geosphere::destPoint(p = c(bbox#xmin, bbox#ymin),
b = 0, d = dist * (1:ny - 1))
df$x <- pts[, 1]
df$y <- pts[, 2]
# Add points on horizontal axis.
df <- tidyr::crossing(nx = 1:nx, df)
# Calculate coordinates.
pts <- destPoint_v(df$x, df$y, b = 90, 500 * (df$nx - 1))
# Turn coordinates into SpatialPoints.
pts <- SpatialPoints(cbind(pts[, 1], pts[, 2]), proj4string = CRS(proj4string(paris)))
# Cut to boundaries of Paris.
result <- raster::intersect(pts, paris)
# Plot result.
plot(result)
title("Paris in Points")
Kind of looks like a fish, doesn't it?
Here is a way to do assuming you have a lonlat polygon by first transforming it to a planar crs (not as nifty as Roman's solution with destPoint).
Packages and example data
library(raster)
library(rgdal)
p <- shapefile(system.file("external/lux.shp", package="raster"))[1,]
Transform to planar crs (pick one that matches your data!)
putm <- spTransform(p, "+proj=utm +zone=32 +datum=WGS84")
Create a raster with 500 m resolution, rasterize the polygon and transform to points
r <- raster(putm, res=500)
r <- rasterize(putm, r)
pts <- rasterToPoints(r, spatial=TRUE)
Transform the points to lon/lat and plot the results
pts_lonlat <- spTransform(pts, "+proj=longlat +datum=WGS84")
result <- coordinates(pts_lonlat)
plot(p)
points(result, pch="+", cex=.5)
(looks like an elephant)