R function to convert polygon (sf, wkt) into mask (matrix, array) - r
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)
Related
R - convert SpatialLines into raster
In R, we can take a raster and turn it into a SpatialLinesDataFrame with the function rasterToCountour: library(raster) f <- system.file("external/test.grd", package="raster") r <- raster(f) x <- rasterToContour(r) class(x) [1] "SpatialLinesDataFrame" attr(,"package") [1] "sp" spplot(x) Within R, is there a way to do the opposite? Something like contourToRaster? We can simply grab the field values associated with each point along the line, but I'm looking for something more general that interpolates between the lines and produces a full raster over a defined domain.
library(raster) f <- system.file("external/test.grd", package="raster") r <- raster(f) x <- rasterToContour(r) You can rasterize the values. In this case after extracting them from the factor labels first. x$value <- as.numeric(as.character(x$level)) rr <- rasterize(x, r, "value") And then extract the cell values and interpolate these xyz <- rasterToPoints(rr) (if you want to skip rasterize and rasterToPoints (as mikoontz suggests) you could instead do #g <- geom(x) #xyz = cbind(g[, c("x", "y")], x$value[g[,1]]) at the expense of a more complex model) Now interpolate, for example with Tps library(fields) tps <- Tps(xyz[,1:2], xyz[,3]) p <- raster(r) p <- interpolate(p, tps) m <- mask(p, r) plot(m)
Do you only have access to the object created by rasterToContour()? If you still have access to the original raster, you can create the contours as complete polygons first (instead of creating them as lines). Then the "contourToRaster"-like function is just rasterize() (or fasterize()). Some code borrowed from here: How does one turn contour lines into filled contours? library(fasterize) rc <- cut(r, breaks= 10) cut_vals <- cut(r[], breaks = 10, dig.lab = 5) pols <- rasterToPolygons(rc, dissolve=T) %>% st_as_sf() r_template <- raster(pols, res = res(r)) back_to_raster <- fasterize(pols, r_template, field = "layer") par(oma = c(0, 0, 0, 5)) plot(back_to_raster, legend = FALSE) plot(back_to_raster, legend.only=TRUE, legend.width = 1, axis.args=list(at=1:nlevels(cut_vals), labels=levels(cut_vals))) Produces: EDIT: I like Robert's approach to this if you want to interpolate. I'd skip the rasterize() step, which can be pretty slow, in favor of casting the multilinestrings to points directly: library(tidyverse) library(sf) library(raster) library(fields) f <- system.file("external/test.grd", package="raster") r <- raster(f) x <- rasterToContour(r) class(x) x_sf <- x %>% st_as_sf() %>% st_cast("LINESTRING") %>% st_cast("MULTIPOINT") %>% st_cast("POINT") tps <- Tps(x = st_coordinates(x_sf), Y = as.numeric(as.character(x_sf$level))) p <- interpolate(r, tps) %>% mask(r) plot(p) Note that both of these methods rely access to the original raster object.
Extracting random points from a raster within a grid cell
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
Extraction of pixel values in lines to each number of pixels
In my example I create a raster: require(raster); require(sp) ## Raster Raster creation r <- raster(nc=10, nr=10) r <- setValues(r, round(runif(ncell(r))* 255)) After, I make pixels values extraction by selection of coordinates: x <- c(-150) y <- c(-80) p <- data.frame(x,y) pontos <- SpatialPoints(p) p$cel <- cellFromXY(r, pontos) p$col <- colFromCell(r, p$cel) p$row <- rowFromCell(r, p$cel) p plot(r) text(r) points(pontos, pch = 4, col = 2) But, I'd like to find a way to extract the value of the pixels in which I would select a coordinate and the function would perform the extraction of the pixels of entire horizontal lines of the raster to every two pixels from the given coordinate. For example, I choose xy(-150,-80) coordinates but my function below returns values only for the first line and need lines 4, 7 and 10 too. require(plyr) vals2cols <- ldply(1:nrow(p), function(ir){ getValuesBlock(r, col = p$col[ir], ncols = 10, row = p$row[ir], nrows = 1) }# end fun ) df <- data.frame(p, vals2cols) df This is possible?
Generate regularly spaced points in polygon
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)
get coordinates of a patch in a raster map (raster package in R)
I have a raster map with many patches (clumps of continguous cells with the same value). What I need to do is to obtain the coordinates of the center (or close to the center) of each patch. I am very unexperienced with raster package but it seems I can get coordinates only if I know the position of the cells in the map. Is there any way to get coordinates giving a value of the cells instead? Thank you
If by patch you mean clumps, Raster package allows you to find , and isolate, clumps. Taking the clump() raster package example, and extending it: library(raster) library(igraph) detach("package:coin", unload=TRUE) r <- raster(ncols=12, nrows=12) set.seed(0) r[] <- round(runif(ncell(r))*0.7 ) rc <- clump(r) clump_id <- getValues(rc) xy <- xyFromCell(rc,1:ncell(rc)) df <- data.frame(xy, clump_id, is_clump = rc[] %in% freq(rc, useNA = 'no')[,1]) df[df$is_clump == T, ] plot(r) plot(rc) text(df[df$is_clump == T, 1:2], labels = df[df$is_clump == T, 3]) May not be as interesting as you could expect. You do it all over with directions = 4 rc <- clump(r, directions = 4) clump_id <- getValues(rc) xy <- xyFromCell(rc,1:ncell(rc)) df <- data.frame(xy, clump_id, is_clump = rc[] %in% freq(rc, useNA = 'no')[,1]) df[df$is_clump == T, ] to get and maybe clump 'centroids' dfm <- ddply(df[df$is_clump == T, ], .(clump_id), summarise, xm = mean(x), ym = mean(y)) plot(rc) text(dfm[, 2:3], labels = dfm$clump_id) Notes: There will be an error if you try to use clump() without first detach modeltools library. modeltools is called by coin and maybe other statistical libraries.
You could take the mean of the coordinates of each patch: # some dummy data m <- matrix(c( 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,1,1,1,0,0,0,0,0,0,0,4,4,0, 0,0,0,0,0,0,0,0,1,1,1,1,1,0,0,0,0,0,0,4,4,0, 0,0,0,0,0,0,0,1,1,1,1,1,1,1,0,0,0,0,0,4,4,0, 0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0, 0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,0,0, 0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,0, 0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0, 0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0, 0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0, 0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0, 0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,0,0, 0,0,0,0,0,0,0,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,1,1,1,1,1,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,1,1,1,0,0,0,0,0,0,0,0,0,0, 0,0,2,3,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0, 0,0,2,3,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0), nrow=20, byrow=T) # create a raster r <- raster(m) # convert raster to points p <- data.frame(rasterToPoints(r)) # filter out packground p <- p[p$layer > 0,] # for each patch calc mean coordinates sapply(split(p[, c("x", "y")], p$layer), colMeans)