I have a Landfire Existing Vegetation dataset (http://www.landfire.gov/), which I have projected and cropped to my study site. The raster has ~12,000,000 cells. The cell values represent a particular vegetation type, and the values range from 16:2200. All of those values are not represented in my study area (i.e. values jump from 20 to 1087).
As many of the pixels' values can be lumped together into one classification for my purposes (e.g. different shrub communities into one class), I wanted to reset the values of the raster to simpler values (1:11). This will facilitate easy extraction of data from other rasters by vegetation type and ease of plotting the classification map. I have a working code, but it requires a ton of typing to change all 61 of the values I need to change. Here's what I did:
#===============================
############Example#############
#===============================
library(raster)
r <- raster(nrows=30, ncols=10, xmn=0, xmx=10)
r[] <- rep(10:19, 30)
r.omance <- function(x){
x[x==10] <- 1; x[x==11] <- 1; x[x==12] <- 1
x[x==13] <- 1; x[x==14] <- 1; x[x==15] <- 1
x[x==16] <- 2; x[x==17] <- 2; x[x==18] <- 2
x[x==19] <- 2
return(x)}
reclass <- calc(r, fun = r.omance)
Does anyone know of an easier way to go about this? You can imagine the typing to change 61 values, especially since x[x==16:20] <- 1 was producing an error, so every value had to be typed out separately. As I said, my code works. But I just want to become a better R coder.
Thanks.
You could use %in%:
x %in% c(1,4,3:10)
This:
x[x==10] <- 1; x[x==11] <- 1; x[x==12] <- 1
x[x==13] <- 1; x[x==14] <- 1; x[x==15] <- 1
would reduce to:
x[x %in% 10:15]
I would use the reclassify function
library(raster)
r <- raster(nrows=30, ncols=10, xmn=0, xmx=10)
r[] <- rep(10:19, 30)
rc <- matrix(c(10,15,1,16,19,2), ncol=3, byrow=TRUE)
x <- reclassify(r, rc, right=NA)
You will save yourself a bit of typing using the & logical operator, e.g.
x[ x >= 10 & x <= 15 ] <- 1
x[ x >= 16 & x <= 19 ] <- 2
Related
I would like to remove the pixels that form a large cluster and keep only the small cluster to analyse (means get pixels number and locations). First I apply a filter to color in white all pixels that has a value lower to 0.66. Then I use the function clump() in R. The model works but I cannot remove only the large cluster. I do not understand how clump function works.
Initial image:
Results image: plot_r is the image where the pixels with value < 0.66 are changed to 0. plot_rc is the results after clump() function. As observed I cannot remove only the large cluster of pixels (on top of the image plot_r). I changed the value (700 in the code) but not better, how to do?
Here the code:
library(magick)
library(pixmap)
library(raster)
library(igraph)
f <- "https://i.stack.imgur.com/2CjCh.jpg"
x <- image_read(f)
x <- image_convert(x, format = "pgm", depth = 8)
# Save the PGM file
f <- tempfile(fileext = ".pgm")
image_write(x, path = f, format = "pgm")
# Read in the PGM file
picture <- read.pnm(file = f, cellres = 1)
str(picture)
picture#size
mat <- picture#grey
mat[mat<0.66] <- 0; x
##############################################################
##Remove clumps of pixels in R using package Raster and igraph
#Detect clumps (patches) of connected cells
r <-raster(mat)
rc <- clump(r)
#extract IDs of clumps according to some criteria
clump9 = data.frame(freq(rc))
#remove clump observations with frequency smaller/larger than N
clump9 = clump9[ ! clump9$count > 700, ]
# record IDs from clumps which met the criteria in previous step
clump9 = as.vector(clump9$value)
#replace cells with IDs which do not belong to the group of interest
rc[rc != clump9[1] & rc != clump9[2]] = NA
# converting rasterlayer to matrix
n <- as.matrix(r)
m <- as.matrix(rc)
Perhaps something like this
library(raster)
library(igraph)
Short-cutting your approach a bit
f <- "https://i.stack.imgur.com/2CjCh.jpg"
b <- brick(f)
x <- sum(b)
r <- x > 450
rc <- clump(r)
f <- freq(rc, useNA="no")
Replace the clumps with the number of cells they consist of and then set the larger one (here more than 100 cells) to NA, and use the result to mask the original raster
rs <- subs(rc, data.frame(f))
rsc <- reclassify(rs, cbind(100,Inf,NA))
m <- mask(b, rsc)
plotRGB(m)
I've been trying to calculate the number of pixels of three raster files that satisfy certain condition with R (in Windows 10 and R version 3.6.3). The idea is to use these three images (which are pre-processed) and count the amount of pixels that satisfy the condition in the if statement of the following code.
library(rgdal)
library(raster)
mydir<- file.path("D:/files")
setwd(mydir)
listado1 <- list.files(pattern="crNDVI*")
listado2 <- list.files(pattern="crNBR*")
listado3 <- list.files(pattern="dNBR*")
df <- data.frame(NULL)
for (i in 1:length(listado1)) {
r1 <- raster(listado1[i])
v1 <- values(r1)
for (j in 1:length(listado2)) {
r2 <- raster(listado2[j])
v2 <- values(r2)
for (k in 1:length(listado3)) {
r3 <- raster(listado3[k])
v3 <- values(r3)
if ((i==j) & (j==k)){
df2 <- data.frame(NULL)
df2 <- data.frame(v1, v2, v3)
burn <- subset(df2, df2$v1 >= 0.3 & df2$v1 <= 1.0 & df2$v2 >= 0.2 & df2$v2 <= 1.3 & df2$v3 > 0.1 & df2$v3 <= 1.3)
burned_area <- nrow(burn)*(xres(r1)*yres(r1))*10^(-4) # Hectares
name <- paste(substr(listado1[i], 8, 15), sep="")
df <- rbind(df, data.frame(name,burned_area))
print(paste("iteracion:",i,j,k," ok",sep = " "))
}
else {
print(paste("iteracion:",i,j,k," passed",sep = " "))
invisible()}
}
}
}
write.csv(df,file = "burned_area.csv")
As it is possible to observe, I have three types of pre-processed raster (*.tif) files that start with crNDVI, crNBR and dNBR, all those files are listed in each "listado" variables. The idea is to iterate over each type of files and obtain the values of each raster file per day. The code does what it should (I get the .csv file with the burned area (pixels that satisfy the condition), however, it takes forever to compute because each raster file corresponds to an specific day and thus the result in burned_area is a value per day. Therefore, the only possibility for that to happen is when i=j=k, but applying the latter code the iteration is over each possibility in the for loop. The code runs from i=1, then j=1 and then k=1,2,3... until the last file of listado3[k], and when the length of listado3[k] finishes, it passes to the following j+1 index and looping all over again in k to each (unnecesary) iteration.
Can anyone help me in order to do the same in a more efficient way? Is there any possibility to force an "only i=j=k" for the whole nested for loops? Id be very grateful for any advice. Thanks in advance, Jorge.
Note: all the raster files have the same extent, nrow, ncol and ncell.
What is the need for the nested loops? It appears if you use one loop then i=j=k will always be true.
Here is a minimal self-contained example.
library(raster)
set.seed(0)
r1 <- raster(nrow=10, ncol=10, vals=1:100) / 100
r2 <- raster(nrow=10, ncol=10, vals=c(1:50, 50:1)) / 100
r3 <- raster(nrow=10, ncol=10, vals=c(rep(1, 10), 11:100)) / 100
x <- ((r1==r2) & (r2==r3))
s <- stack(r1, r2, r3)
s <- mask(s, x, maskvalue=1)
I am using below code to list out Peaks and Valleys.
x_last <- as.numeric(series[1])
x <- as.numeric(series[2])
d_last <- (x-x_last)
series[1:2] <- NULL
output <- list()
for (x_next in series){
if (x_next == x){
next}
d_next <- (x_next - x)
if (d_last * d_next < 0){
output <- append(output, x)}
x_last <- x
x <- x_next
d_last <- d_next
}
Here Output(list) contains "continuous Peaks and Valleys".
Output <- c(41.49916, 37.92029, 39.86477, 39.86432, 39.95672, 39.95465, 39.96144, 39.83994, 40.43357, 40.11285, 40.82250, 39.37034, 58.82975, 42.19894)
so on...
the graph plotted using Output(list). My question is how to add threshold in this code? or how can i remove small Peaks and Valleys(values less than 1). I Need continuous Peaks and valleys.
Looking for answers. thank you in advance.
If you just want to plot your data:
You could plot this with ggplot2 and add a geom_smooth() layer. It defaults to method "loess" which is kind of a "do-the-right-thing" smoother for small datasets.
dat <- data.frame(y=c(41.49916, 37.92029, 39.86477, 39.86432, 39.95672, 39.95465, 39.96144, 39.83994, 40.43357, 40.11285, 40.82250, 39.37034, 58.82975, 42.19894))
dat$x <- 1:length(dat$y)
library(ggplot2)
ggplot(dat, aes(x, y)) +
geom_line() +
geom_smooth(method="loess", se=FALSE)
?
Or do you rather want to smoothen the data yourself? (Your data series is quite short for that.) Do you need an equation for the fit? It's easy to spend quite some time on that.
I don't fully understand this "peak/valley" stuff. In any case, take a look at the diff() function. Maybe this helps:
dat <- data.frame(y=c(41.49916, 37.92029, 39.86477, 39.86432, 39.95672, 39.95465, 39.96144, 39.83994, 40.43357, 40.11285, 40.82250, 39.37034, 58.82975, 42.19894))
dat[which(diff(dat$y) < 0.01)+1,"y"] <- NA
dat$y
[1] 41.50 NA 39.86 NA 39.96 NA NA NA 40.43 NA 40.82 NA
[13] 58.83 NA
Here I've used a threshold of 0.01.
I'm not sure if it's the right thing. But you can adapt this code for your needs.
At last I created a function to remove small cycles also to maintain Peak and valley. For me it is working perfectly.
hysteresis <- function(series, min_range){
#hysteresis function will remove cycles within the magnitude of min_range
#Series: list of values with continuous Peak & valley.
series <- unlist(series)
f <- series[1]
org <- f
series <- series[2:length(series)]
for(i in series){
val <- abs(i-f)
if(val > min_range){
org <- c(org,i)
f <- i
}
#else statement is used to maintain peak and valley
else{
org <- org[1:(length(org)-1)]
f <- org[length(org)]
}
}
return(org)
}
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)
I'm new to this site. I was wondering if anyone had experience with turning a list of grid coordinates (shown in example code below as df). I've written a function that can handle the job for very small data sets but the run time increases exponentially as the size of the data set increases (I think 800 pixels would take about 25 hours). It's because of the nested for loops but I don't know how to get around it.
## Dummy Data
x <- c(1,1,2,2,2,3,3)
y <- c(3,4,2,3,4,1,2)
df <- as.data.frame(cbind(x,y))
df
## Here's what it looks like as an image
a <- c(NA,NA,1,1)
b <- c(NA,1,1,1)
c <- c(1,1,NA,NA)
image <- cbind(a,b,c)
f <- function(m) t(m)[,nrow(m):1]
image(f(image))
## Here's my adjacency matrix function that's slowwwwww
adjacency.coordinates <- function(x,y) {
df <- as.data.frame(cbind(x,y))
colnames(df) = c("V1","V2")
df <- df[with(df,order(V1,V2)),]
adj.mat <- diag(1,dim(df)[1])
for (i in 1:dim(df)[1]) {
for (j in 1:dim(df)[1]) {
if((df[i,1]-df[j,1]==0)&(abs(df[i,2]-df[j,2])==1) | (df[i,2]-df[j,2]==0)&(abs(df[i,1]-df[j,1])==1)) {
adj.mat[i,j] = 1
}
}
}
return(adj.mat)
}
## Here's the adjacency matrix
adjacency.coordinates(x,y)
Does anyone know of a way to do this that will work well on a set of coordinates a couple thousand pixels long? I've tried conversion to SpatialGridDataFrame and went from there but it won't get the adjacency matrix correct. Thank you so much for your time.
While I thought igraph might be the way to go here, I think you can do it more simply like:
result <- apply(df, 1, function(pt)
(pt["x"] == df$x & abs(pt["y"] - df$y) == 1) |
(abs(pt["x"] - df$x) == 1 & pt["y"] == df$y)
)
diag(result) <- 1
And avoid the loopiness and get the same result:
> identical(adjacency.coordinates(x,y),result)
[1] TRUE