R - convert SpatialLines into raster - r

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.

Related

R function to convert polygon (sf, wkt) into mask (matrix, array)

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)

Coordinate values in R

I'm new to R and trying to learn how it's done for some species distribution modeling. I'm trying to create a mask of Italy using the wrld_simpl map included with the maptools package. When I run the code, I get "Error in .local(obj, ...) : NA values in coordinates" when I'm trying to create spxy. I suspect that this issue might be rooted in the rasterization step but I'm not sure... What am I doing wrong?
Apologies for the code dump
# Create library
library(raster)
library(dismo)
library(sf)
library(maptools)
library(rgdal)
library(sp)
library(rgeos)
# Call the cleaned nivale csv
nivale <- read.table('C:/Users/David/Documents/nival_1980_GeoDat.csv', header=T, sep = ',')
nivale <- nivale[,2:3]
# Create a simple map of Italy, plot nivale data points
data(wrld_simpl)
plot(wrld_simpl, xlim=c(0,20), ylim=c(40,50), axes=TRUE, col="light yellow")
box()
points(nivale$lon, nivale$lat, col='orange', pch=20, cex=0.75)
points(nivale$lon, nivale$lat, col='black', cex=0.75)
# set CRS of nivale equal to wrld_simpl
coordinates(nivale) <- ~lon+lat
crs(nivale) <- crs(wrld_simpl)
projection(nivale) <- CRS('+proj=longlat +datum=WGS84')
class(nivale)
class(wrld_simpl)
# Sampling Bias Assessment
r <- raster(nivale)
res(r) <- 1
r <- extend(r, extent(r)+1)
nisel <- gridSample(nivale, r, n=1)
p <- rasterToPolygons(r)
plot(p, border='blue')
points(nivale)
points(nisel, cex=1, col='red', pch='x')
# Pseudo-Absences
# Create shapefile from wrld_simpl
italy <- wrld_simpl[is.element(wrld_simpl$NAME, 'Italy'),]
set.seed(1963)
crsi = crs('+proj=longlat +datum=WGS84')
exti = extent(italy)
# Create template for rasterization
rst_temp <- raster(ncols = 1000, nrows = 1000,
crs = crsi,
ext = exti)
# Rasterize italy
rst_italy <- rasterize(italy, rst_temp)
# Random point generation
rand_point <- randomPoints(rst_italy, 250)
#Pseudo-Absence Points
x <- circles(nivale, d=50000, lonlat=TRUE)
pol <- polygons(x)
samp1 <- spsample(pol, 250, type='random', iter=25)
cells <- cellFromXY(rst_italy, samp1)
xy <- xyFromCell(rst_italy, cells)
plot(pol, axes=TRUE)
points(xy, cex=0.75, pch=20, col='blue')
#
# Error - NA values in coordinates
spxy <- SpatialPoints(xy, proj4string=CRS('+proj=longlat +datum=WGS84'))
o <- over(spxy, geometry(x))
xyInside <- xy[!is.na(o), ]
v <- extract(mask, x#polygons, cellnumbers=T)
v <- do.call(rbind, v)
v <- unique(v[,1])
head(v)
m <- italy
m[] <- NA
m[v] <- 1
plot(m, ext=extent(x#polygons)+1)
plot(x#polygons, add=T)
I don't have your nivale dataset, so I am not 100% sure, but I think the error arises after you are sampling points within polygons (spsample(pol, 250, type='random', iter=25)) created using circle() and not because of the rasterization, which looks fine to me. My guess is that, after this, you sample random points in these polygons, which may fall outside the raster of Italy (samp1 <- spsample(pol, 250, type='random', iter=25)). Possibly, you can just remove such points by excluding NAs values in xy:
xy <- xy[!is.na(xy[, 1]) & !is.na(xy[, 2])]
Try this and see if it works. If you need a certain number of points (e.g. xy needs to have 250 lines), you can put a while loop until you have what you want; this may take (a lot of) time, though.
/Emilio

lapply to unionSpatialPolygons in a list

I have a big list of SpatialPolygonsDataFrame objects I created using lapply and gdal_polygonizeR (code here: https://johnbaumgartner.wordpress.com/2012/07/26/getting-rasters-into-shape-from-r/) on a list of RasterLayer objects. I now want to union the boundaries of the polygon parts that touch within each SpatialPolygonsDataFrame using unionSpatialPolygons (maptools). I have tested this by calling an individual SpatialPolygonsDataFrame object, and it seems to work. But, when I try to do it for the list of all SpatialPolygonsDataFrame using lapply, I get an error. See code below (very sorry my example is not reproducible) and please provide a solution using lapply or alternative. Thanks
#convert RasterLayers to SpatialPolygonsDataFrame objects
polyl <- lapply(rastl, gdal_polygonizeR)
#test union of polygon parts within individual SpatialPolygonsDataFrame
tmp = unionSpatialPolygons(polyl[[10]], polyl[[10]]$DN)
polyl[[10]] #n = 360 features
tmp #n = 8 features
#run union on all SpatialPolygonsDataFrame in list
polyl_union <- lapply(polyl, unionSpatialPolygons, SpP =
polyl, IDs = polyl$DN)
#Error in FUN(X[[i]], ...) : not a SpatialPolygons object
I do not know what causes the error. An alternative path you could try is
library(raster)
x <- bind(poly)
y <- aggregate(x, "DN")
With example data:
set.seed(0)
r <- raster(ncol=5, nrow=5, xmn=0, xmx=1, ymn=0, ymx=1)
values(r) = sample(5, ncell(r), replace=TRUE)
rr <- list()
rr[[1]] <- crop(r, extent(0,0.5,0,0.5))
rr[[2]] <- crop(r, extent(0.5,1,0.5,1))
rr[[3]] <- crop(r, extent(0,0.5,0.5,1))
rr[[4]] <- crop(r, extent(0.5,1,0,0.5))
x <- list(r1, r2, r3, r4)
y <- lapply(x, rasterToPolygons)
b <- bind(y)
a <- aggregate(b, 'layer')
plot(r)
plot(a, add=TRUE)

Counting spatialpoints in gridcells

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?

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)

Resources