How can i get a new raster r90 that has only those values which are greater than 90th percentile of its values in each grid cell.
For example i tried the follwoing but i am not sure if r90 is giving me the right thin.
library(raster)
r1 <- raster(nrow=10, ncol=7)
r <- stack(setValues(r1, runif(ncell(r1))),
setValues(r1, runif(70 ,0.6,0.9)),
setValues(r1, runif(70 ,0.2,0.4)),
setValues(r1, runif(70 ,1,2)))
r
#calcaulte 90th percentile of each grid cells
q90fun <- function(x){quantile(x, probs = .90, na.rm=TRUE)}
q90<-calc(r,fun=q90fun)
#sort raster r with values greater than or equal to its 90th percentile
fun90gt <- function(x,y){x[x >= y]}
r90<-overlay(r,q90,fun=fun90gt)
r90
I think it works with the example data, but that it may not be OK in general because it is not guaranteed that fun90gt will always return the same number of values (consider ties, NA)
Instead of r90 <- overlay(r, q90, fun=fun90gt) you could do
r90 <- overlay(r, q90, fun=function(x,y) { x[x <= y] <- NA; x })
or the equivalent
rr <- r > q90
r90 <- mask(r, rr, maskvalue=0)
and then perhaps
# r90n <- sum(rr)
r90n <- calc(r90, function(x) sum(!is.na(x)) )
r90mx <- max(r90, na.rm=TRUE)
r90mn <- min(r90, na.rm=TRUE)
Related
I am trying to run corLocal on 2 stacks (average temperatures, day of the year for spring- over a 17 year period. I.e. 17 tiff files for temp and 17 tiff files for day of the year). I've used the following line
p<-corLocal(stack1,stack2,method="kendall") ##or pearson
I would like to get the p value and sens slope value as 2 separate rasters but I am not sure what my output is - it ranges between -0.5 and 0.5. Thank you,
p<-corLocal(stack1,stack2,method="kendall")
p value and slope value 2 separate rasters files
Example data
library(terra)
set.seed(0)
s <- r <- rast(ncol=10, nrow=10, nlyr=17)
values(r) <- runif(size(r))
values(s) <- runif(size(s))
sr <- sds(r,s)
To get the Kendall correlation coefficient for each cell (across the 17 layers).
ken <- lapp(sr, \(x,y) {
out <- rep(NA, nrow(x))
for (i in 1:nrow(x)) {
out[i] <- cor(x[i,], y[i,], "kendall", use="complete.obs")
}
out
})
And to get the p-value
pken <- lapp(sr, \(x,y) {
out <- rep(NA, nrow(x))
for (i in 1:nrow(x)) {
out[i] <- cor(x[i,], y[i,], "kendall", use="complete.obs")
out[i] <- cor.test(x[i,], y[i,], method="kendall", use="complete.obs")$p.value)
}
out
})
For completeness: the corLocal method (called focalPairs in "terra") can be usd to compute the focal correlation between layers.
library(terra)
r <- rast(system.file("ex/logo.tif", package="terra"))
set.seed(0)
r[[1]] <- flip(r[[1]], "horizontal")
r[[2]] <- flip(r[[2]], "vertical") + init(rast(r,1), runif)
r[[3]] <- init(rast(r,1), runif)
Kendall correlation coefficient and p-value
x <- focalPairs(r, w=5, \(x, y) cor(x, y, "kendall", use="complete.obs"))
y <- focalPairs(r, w=5, \(x, y) cor.test(x, y, method="kendall", use="complete.obs")$p.value)
library(raster)
library(rnaturalearth)
library(terra)
r <- raster::getData('CMIP5', var='tmin', res=10, rcp=45, model='HE', year=70)
r <- r[[1]]
shp <- rnaturalearth::ne_countries()
newcrs <- "+proj=robin +datum=WGS84"
r <- rast(r)
shp <- vect(shp)
r_pr <- terra::project(r, newcrs)
shp_pr <- terra::project(shp, newcrs)
For every country in shp_pr, I want to normalise the underlying raster
on a scale of 0-1. This means dividing a cell by the sum of all the cells within a country boundary and repeating it for all the countries. I am doing this as follows:
country_vec <- shp$sovereignt
temp_ls <- list()
for(c in seq_along(country_vec)){
country_ref <- country_vec[c]
if(country_ref == "Antarctica") { next }
shp_ct <- shp[shp$sovereignt == country_ref]
r_country <- terra::crop(r, shp_ct) # crops to the extent of boundary
r_country <- terra::extract(r_country, shp_ct, xy=T)
r_country$score_norm <- r_country$he45tn701/sum(na.omit(r_country$he45tn701))
r_country_norm_rast <- rasterFromXYZ(r_country[ , c("x","y","score_norm")])
temp_ls[[c]] <- r_country_norm_rast
rm(shp_ct, r_country, r_country_norm_rast)
}
m <- do.call(merge, temp_ls)
I wondered if this is the most efficient/right way to do this i.e. without any for loop and anyone has any suggestions?
Somewhat updated and simplified example data (there is no need for projection the data)
library(terra)
library(geodata)
r <- geodata::cmip6_world("HadGEM3-GC31-LL", "585", "2061-2080", "tmin", 10, ".")[[1]]
v <- world(path=".")
v$ID <- 1:nrow(v)
Solution
z <- rasterize(v, r, "ID", touches=TRUE)
zmin <- zonal(r, z, min, na.rm=TRUE, as.raster=TRUE)
zmax <- zonal(r, z, max, na.rm=TRUE, as.raster=TRUE)
x <- (r - zmin) / (zmax - zmin)
Note that the above normalizes the cell values for each country between 0 and 1.
To transform the data such that the values add up to 1 (by country), you can do:
z <- rasterize(v, r, "ID", touches=TRUE)
zsum <- zonal(r, z, sum, na.rm=TRUE, as.raster=TRUE)
x <- r / zsum
I have raster files that have the same resolution and extent but differ in the number of NA. I want to unify the number of NA between all of them. Is it possible to do it by considering a cell as non-NA if it's not NA in all the raster files?
Here an example :
library(raster)
library(terra)
f <- system.file("external/test.grd", package="raster")
r1 <- raster(f)
r2 <- calc(r1, fun=function(x){ x[x < 500] <- NA; return(x)} )
r1 <- calc(r1, fun=function(x){ x[x > 1200] <- NA; return(x)} )
raste <- rast(r1)
rNA <- terra:: global(!(is.na(raste)), sum, na.rm=TRUE)
print(paste0("Non-NA of r1", rNA))
raste <- rast(r2)
rNA <- terra:: global(!(is.na(raste)), sum, na.rm=TRUE)
print(paste0("Non-NA of r2", rNA))
I want both r1 and r2 to have the same number of non-NA cells. I have more than two rasters, so I wonder if I can do it for a large number of files.
It can be a bit confusing to use raster and terra together, so I will just use terra (but you can do the same with raster, using stack in stead of c and cellStats in stead of global.
Your example data
library(terra)
f <- system.file("external/test.grd", package="raster")
r <- rast(f)
r1 <- clamp(r, upper=1200, values=FALSE)
r2 <- clamp(r, lower=500, values=FALSE)
global(!(is.na(r1)), sum)
# sum
#lyr.1 3145
global(!(is.na(r2)), sum)
# sum
#lyr.1 802
Solution:
r <- c(r1, r2)
names(r) <- c("r1", "r2")
m <- any(is.na(r))
x <- mask(r, m, maskvalue=1)
global(!(is.na(x)), sum, na.rm=TRUE)
# sum
#r1 769
#r2 769
I like the use of any(is.na()) because it makes clear what the intent is.
But you could combine the layers in one of many other ways. As long as you do not use na.rm=TRUE the cells with an NA in one of the layers will be NA in the output. For example with sum, diff, prod, mean or app.
m <- sum(r)
x <- mask(r, m)
global(!(is.na(x)), sum, na.rm=TRUE)
I am trying to replace NAs by truncated normal distribution values.
First I used sample as follows and the function worked:
v.new <- replace(vector,v, sample(8,length(v),replace =FALSE))
However when I try to use rtnorm it seems not to work. I got any error messages and it takes ages to replace the NAs by the desired interval. Any suggestion to make this work?
library(msm)
# Some data
data("airquality")
airquality$Ozone
# My function
add.trunc.to.NAvector <- function(vector){
v <- NULL
for(i in 1:length(vector)){
if(is.na(vector[i])==TRUE)
v <- append(v, i)
}
mean.val <- mean(vector)
sd.val <- sd(vector)
min.val <- mean.val - 4 * sd.val
max.val <- mean.val + 4 * sd.val
v.new <- replace(vector,v, rtnorm(length(v), lower = min.val, upper = max.val))
return(v.new)
}
Should not this work?
v <- airquality$Ozone
v.new <- v
indices <- which(is.na(v))
m <- mean(v[-indices])
s <- sd(v[-indices])
v.new[indices] <- rtnorm(length(indices), lower = m-4*s, upper = m+4*s)
I am trying to mosaic 42 remote sensing rasterstacks (with 250 bands) based on the criterion that in overlapping areas, the pixel should be taken that has the most nadir viewing angle
Beside my rasterstacks I also have 42 rasters (so one for each stack) with the corresponding viewing angle for each pixel.
Any idea how to solve this?
I tried to include the viewing angle raster in the stack, and use something similar to
mosaic(a,b,fun=function(x)(min(x[[251]]))
but that didn't work...
Any advice?
Thanks in advance,
R.
When asking an R question like this, you should set up a simple example with code to better illustrate your problem and to make it easier to answer.
Here is the problem
library(raster)
r <- raster(ncol=100, nrow=100)
r1 <- crop(r, extent(-10, 11, -10, 11))
r2 <- crop(r, extent(0, 20, 0, 20))
r3 <- crop(r, extent(9, 30, 9, 30))
# reflectance values
r1[] <- 1:ncell(r1)
r2[] <- 1:ncell(r2)
r3[] <- 1:ncell(r3)
set.seed(0)
# nadir values
n1 <- setValues(r1, runif(ncell(r1)))
n2 <- setValues(r2, runif(ncell(r2)))
n3 <- setValues(r3, runif(ncell(r3)))
Your question is how to merge/mosaic r based on values in n (when there are overlapping cells with values, use the value of r(i) that that has the highest corresponding value of n(i) ).
Here is a general approach to solve it:
r <- list(r1, r2, r3)
n <- list(n1, n2, n3)
whichmax <- function(x, ...) {
ifelse(all(is.na(x)), NA, which.max(x))
}
n$fun <- whichmax
# which layer has the highest nadir value?
m <- do.call(mosaic, n)
q <- list()
for (i in 1:length(r)) {
y <- r[[i]]
x <- crop(m, y)
y[x != i] <- NA
q[i] <- y
}
M <- do.call(merge, q)