convert a Kmeans to a Raster Layer - r

I have a problem .
I have a tiff image and I have made a Kmeans on it, the resulting file is a large Kmeans and I need to transform it back to RasterLayer in order to load it into a GIS. Any solution?
Biomasaencina<-raster("C:/Users/34600/Documents/dehesa.tif")
bio <-stack(Biomasaencina)
v <- getValues(bio)
k <- which(!is.na(v))
v <- na.omit(v)
#Kmeans
kmncluster<-kmeans(v,
centers= 2,
iter.max= 10,
nstart=2,
algorithm="Lloyd",
trace = FALSE)
#Convert to raster
kmeans_raster1 <- raster(Biomasaencina)
kmeans_raster1 <- setValues(Biomasaencina,kmncluster$cluster)
Error in setValues(Biomasaencina, kmncluster$cluster):length(values) is not equal to ncell(x), or to 1
writeRaster(kmeans_raster,filename = "k_means_dehesas",
format("GTiff"),
overwrite=TRUE)

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)

Compile multiple raster extractions to one table

I have 3 rasters in which I have extracted data from using a polyline from a shapefile. Currently, I have the extraction as 3 separate lists. Is there A way I can do an extraction from all three rasters and compile them to one table with different columns for the data from each raster?
This is the current code I am using
Harney_Transects <- readOGR(dsn = ".", layer = "Transect_HN")
MeanTreeHeightHarneyBefore=raster('HN_TrMean_B_Clip.tif')
ScanAngleHarneyBefore= raster('HNScanAngle_B_Clip.tif')
MeanShrubHeightHarneyBefore= raster('HN_MeanShrub_B_Clip.tif')
Extraction_Shrub_Harney= extract(MeanShrubHeightHarneyBefore,Harney_Transects)
Extraction_Tree_Harney= extract(MeanTreeHeightHarneyBefore,Harney_Transects)
Extraction_ScanAngle_Harney= extract(ScanAngleHarneyBefore,Harney_Transects)

In short, you can stack() all the rasters you want to extract data from, and extract from the stack.
Here's a fully reproducible example using two rasters and a SpatialLines object, like you have in your question. Skip to the last code chunk for a direct answer to your question.
library(sp)
library(raster)
# function to generate random rasters
gen_raster <- function(){
r <- raster(nrows = 10, ncols = 10, res = 1,
xmn = 0, xmx = 10, ymn = 0, ymx = 10,
vals = rnorm(100, 5, 1))
return(r)
}
# generate 2 random rasters
r1 <- gen_raster()
r2 <- gen_raster()
# view
par(mfrow = c(1,2))
plot(r1, main = "raster 1"); plot(r2, main = "raster 2")
dev.off()
# generate transect (`SpatialLines` object)
m <- as.matrix(data.frame(x = 5.5, y = seq(0, 10, 1)))
l <- list(Lines(Line(m), "m"))
l <- SpatialLines(l)
# view the transect
plot(r1, main = "raster 1 with transect"); lines(l)
Running extract on the stacked rasters returns a list with a matrix in it. The last thing you'll want is to pull this out as a data.frame, which is a bit tricky.
rs <- stack(r1, r2) # stack any amount of rasters to extract from
re <- extract(rs, l) # extract at locations `l`
do.call(rbind.data.frame, re) # convert to data.frame
layer.1 layer.2
1 4.586890 5.115136
2 4.780503 5.093281
3 6.877302 3.337345
4 5.913230 3.755099
5 4.907834 4.887160
6 5.576908 5.386136
7 3.572350 5.225392
8 4.778727 5.391765
9 6.600041 4.205841
10 6.946321 5.544172
The names of the columns are the names of the raster layers in the stack. You can access these names with names(rs), and modify them with names(rs) <- c("new_name_1", "new_name_2").

Removing the third dimension in SpatialPointsDataFrame

I have a SpatialPoints object with 3 dimensions :
x <- c(1,1,1,2,2,2,3,3,3)
y <- c(1,2,3,1,2,3,1,2,3)
z <- c(1,3,5,2,1,2,1,2,3)
xyz <- cbind(x,y,z)
ss <- SpatialPoints(xyz)
dimensions(ss)
And a raster object:
rr <- raster(matrix(round(runif(49,0,10)),7,7), xmn=0, xmx=4, ymn=0, ymx=4, crs=NA, template=NULL)
I want to extract the raster values using the SpatialPoints object:
extract(rr,ss)
#Error in .xyValues(x, coordinates(y), ..., df = df) :
# xy should have 2 columns only.
#Found these dimensions: 9, 3
You can visualize the data if you want:
plot(rr)
plot(ss, add=T)
So the problem is that the extract function of the raster package require a 2 dimension SpatialPoints object. Mine (in my real data) in 3 dimensional. Is there a way to drop the 3rd dimension of my point shape? I've tried:
coordinates(ss) <- coordinates(ss)[,-3]
#Error in `coordinates<-`(`*tmp*`, value = c(1, 1, 1, 2, 2, 2, 3, 3, 3, :
# setting coordinates cannot be done on Spatial objects, where they have #already been set
I don't want to have to rebuild my shape from scratch.

Just overwrite the coords slot of the S4 object:
ss#coords <- ss#coords[, 1:2]
I don't know how your SpatialPoints object is created, but if you use rgdal::readOGR there is a pointDropZ argument (default FALSE)

#rcs answer is better, but this works as well:
ss <- SpatialPoints(coordinates(ss)[,-3])
and if you have a SpatialPointsDataFrame:
ss <- SpatialPointsDataFrame(coordinates(ss)[,-3], ss#data,proj4string=CRS(proj4string(ss)))

R Crop no-data of a raster

I would like to crop the no-data part of some rasters (example of the image in 1 where no-data is in black) without defining the extent manually.
Any idea?

You can use trim to remove exterior rows and columns that only have NA values:
library(raster)
r <- raster(ncols=18,nrows=18)
r[39:49] <- 1
r[205] <- 6
s <- trim(r)
To change other values to or from NA you can use reclassify. For example, to change NA to 0:
x <- reclassify(r, cbind(NA, 0))

[ subsetting and [<- replacement methods are defined for raster objects so you can simply do r[ r[] == 1 ] <- NA to get rid of the values where 1 is your nodata value (use NAvalue(r) to find out what R considers your nodata value is supposed to be if you aren't sure).
Note you have to use r[] inside the [ subsetting command to access the values. Here is a worked example...
Example
# Make a raster from system file
logo1 <- raster(system.file("external/rlogo.grd", package="raster"))
# Copy to see difference
logo2 <- logo1
# Set all values in logo2 that are > 230 to be NA
logo2[ logo2[] > 230 ] <- NA
# Observe difference
par( mfrow = c( 1,2 ) )
plot(logo1)
plot(logo2)

I have 2 slightly different solutions. The first requires to manually identify the extent but uses predefined functions. The second is more automatic, but a bit more handmade.
Create a reproducible raster for which the first 2 rows are NA
library(raster)
# Create a reproducible example
r1 <- raster(ncol=10, nrow=10)
# The first 2 rows are filled with NAs (no value)
r1[] <- c(rep(NA,20),21:100)
Solution #1
Manually get the extent from the plotted figure using drawExtent()
plot(r1)
r1CropExtent <- drawExtent()
Crop the raster using the extent selected from the figure
r2 <- crop(r1, r1CropExtent)
Plot for comparison
layout(matrix(1:2, nrow=1))
plot(r1)
plot(r2)
Solution #2
It identifies the rows and columns of the raster that only have NA values and remove the ones that are on the margin of the raster. It then calculate the extent using extent().
Transform the raster into a matrix that identifies whether the values are NA or not.
r1NaM <- is.na(as.matrix(r1))
Find the columns and rows that are not completely filled by NAs
colNotNA <- which(colSums(r1NaM) != nrow(r1))
rowNotNA <- which(rowSums(r1NaM) != ncol(r1))
Find the extent of the new raster by using the first ans last columns and rows that are not completely filled by NAs. Use crop() to crop the new raster.
r3Extent <- extent(r1, rowNotNA[1], rowNotNA[length(rowNotNA)],
colNotNA[1], colNotNA[length(colNotNA)])
r3 <- crop(r1, r3Extent)
Plot the rasters for comparison.
layout(matrix(1:2, nrow=1))
plot(r1)
plot(r3)

I have written a small function based on Marie's answer to quickly plot cropped rasters. However, there may be a memory issue if the raster is extremely large, because the computer may not have enough RAM to load the raster as a matrix.
I therefore wrote a memory safe function which will use Marie's method if the computer has enough RAM (because it is the fastest way), or a method based on raster functions if the computer does not have enough RAM (it is slower but memory-safe).
Here is the function:
plotCroppedRaster <- function(x, na.value = NA)
{
if(!is.na(na.value))
{
x[x == na.value] <- NA
}
if(canProcessInMemory(x, n = 2))
{
x.matrix <- is.na(as.matrix(x))
colNotNA <- which(colSums(x.matrix) != nrow(x))
rowNotNA <- which(rowSums(x.matrix) != ncol(x))
croppedExtent <- extent(x,
r1 = rowNotNA[1],
r2 = rowNotNA[length(rowNotNA)],
c1 = colNotNA[1],
c2 = colNotNA[length(colNotNA)])
plot(crop(x, croppedExtent))
} else
{
xNA <- is.na(x)
colNotNA <- which(colSums(xNA) != nrow(x))
rowNotNA <- which(rowSums(xNA) != ncol(x))
croppedExtent <- extent(x,
r1 = rowNotNA[1],
r2 = rowNotNA[length(rowNotNA)],
c1 = colNotNA[1],
c2 = colNotNA[length(colNotNA)])
plot(crop(x, croppedExtent))
}
}
Examples :
library(raster)
r1 <- raster(ncol=10, nrow=10)
r1[] <- c(rep(NA,20),21:100)
# Uncropped
plot(r1)
# Cropped
plotCroppedRaster(r1)
# If the no-data value is different, for example 0
r2 <- raster(ncol=10, nrow=10)
r2[] <- c(rep(0,20),21:100)
# Uncropped
plot(r2)
# Cropped
plotCroppedRaster(r2, na.value = 0)

If you use the rasterVis package (any version after Jun 25, 2021), it will automatically crop the NA values out for terra's SpatRaster
Install rasterVis development version from GitHub
if (!require("librarian")) install.packages("librarian")
librarian::shelf(raster, terra, oscarperpinan/rastervis)
# Create a reproducible example
r1 <- raster(ncol = 10, nrow = 10)
# The first 2 rows are filled with NAs (no value)
r1[] <- c(rep(NA, 20), 21:100)
levelplot() for r1
rasterVis::levelplot(r1,
margin = list(axis = TRUE))
Convert to terra's SpatRaster then plot again using levelplot()
r2 <- rast(r1)
rasterVis::levelplot(r2,
margin = list(axis = TRUE))
Created on 2021-06-26 by the reprex package (v2.0.0)

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