library(terra)
y <- rast(ncol=10, nrow=10, nlyr=1, vals=rep(1, each=100))
I would like to randomly assign half of the values to NA?
Is there a way to do this?
To set exactly 50% of the cells to NA you could do
library(terra)
x <- rast(ncol=10, nrow=10, nlyr=1)
x <- init(x, "cell")
x <- spatSample(x, ncell(x), "random", as.raster=TRUE)
x <- ifel(x >= ncell(x)/2, 1, NA)
With small rasters you can also do
y <- rast(ncol=10, nrow=10, nlyr=1, vals=1)
i <- sample(ncell(y), 0.5*ncell(y))
y[i] <- NA
If you just wanted random values you could do
z <- rast(ncol=10, nrow=10, nlyr=1)
z <- init(x, runif)
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 am trying to estimate a SAR spatial model without row-normalizing the matrix. For some reason, when I do not row-normalize, the command does not return the correct estimates. Am I missing something on the command options?
Here is an example of what I mean.
If I run the following code, simulating a data with a row-normalized matrix, lagsarlm returns the correct estimates:
set.seed(20100817)
rho <- .5
B <- c(2, 5)
e <- as.matrix(rnorm(100, sd=2))
X0 <- matrix(1, ncol=1, nrow=100) # create Intercept
X1 <- matrix(runif(100, min = -10, max = 10), nrow=100) # generate covariate
Xbe <- X0*B[1]+X1*B[2]+e
I <- diag(100)
W <- rgraph(100, m=1, tprob=0.1, mode="graph", diag=FALSE) #assume I need to start with a matrix of relationships
spatialList <- mat2listw(W)
nb7rt <- spatialList$neighbours
listw <- nb2listw(nb7rt)
W <- nb2mat(nb7rt)
y <- solve(I - rho*W) %*% Xbe
model <- lagsarlm(y ~ X1, listw=listw)
summary(model)
However, if I try to do exactly the same but without row-normalizing, the results are incorrect:
set.seed(20100817)
rho <- .5
B <- c(2, 5)
e <- as.matrix(rnorm(100, sd=2))
X0 <- matrix(1, ncol=1, nrow=100) # create Intercept
X1 <- matrix(runif(100, min = -10, max = 10), nrow=100) # generate covariate
Xbe <- X0*B[1]+X1*B[2]+e
I <- diag(100)
W <- rgraph(100, m=1, tprob=0.1, mode="graph", diag=FALSE) #assume I need to start with a matrix of relationships
spatialList <- mat2listw(W, style ="B")
nb7rt <- spatialList$neighbours
listw <- nb2listw(nb7rt, style="B")
W <- nb2mat(nb7rt, style="B")
y <- solve(I - rho*W) %*% Xbe
model <- lagsarlm(y ~ X1, listw=listw)
summary(model)
The base for this code can be found here https://stat.ethz.ch/pipermail/r-sig-geo/2010-August/009023.html.
Labeling data points in a plot can get unwieldy:
Randomly sampling few labels may disappoint:
What would be a nice way to pick a small set of nicely-spaced data labels? That is, to randomly pick representatives whose labels are not overlapping.
# demo data
set.seed(123)
N <- 50
x <- runif(N)
y <- x + rnorm(N, 0, x)
data <- data.frame(x, y, labels=state.name)
# plot with labels
plot(x,y)
text(x,y,labels)
# plot a few labels
frame()
few_labels <- data[sample(N, 10), ]
plot(x,y)
with(few_labels, text(x,y,labels))
One way to do is through clustering. Here is a solution with stats::hclust. We agglomerate the data points in cluster and then pick one random observation from each cluster.
few_labels <- function(df, coord=1:ncol(df),grp=5){
require(dplyr)
df$cl <- cutree(hclust(dist(df[,coord])),grp)
few_labels <- df %>% group_by(cl) %>%
do(sample_n(.,1))
return(few_labels)
}
# demo data
set.seed(123)
N <- 50
x <- runif(N)
y <- x + rnorm(N, 0, x)
data <- data.frame(x, y, labels=state.name)
# plot a few labels
frame()
few_labels <- few_labels(data,coord=1:2,grp=12)
plot(x,y)
with(few_labels, text(x,y,labels))
For all labels:
xlims=c(-1,2)
plot(x,y,xlim=xlims)
#text(x,y,data$labels,pos = 2,cex=0.7)
library(plotrix)
spread.labels(x,y,data$labels,cex=0.7,ony=NA)
Another way is to pick randomly a point, throw all proximate ones, and so on, until no point is left:
radius <- .1 # of a ball containing the largest label
d <- as.matrix(dist(data[, c("x","y")], upper=TRUE, diag=TRUE))
remaining <- 1:N
spaced <- numeric()
i <- 1
while(length(remaining)>0) {
p <- ifelse(length(remaining)>1, sample(remaining, 1), remaining)
spaced <- c(spaced, p) # ...
remaining <- setdiff(remaining, which(d[p, ] < 2*radius))
i <- i + 1
}
frame()
plot(x,y)
spaced_labels <- data[spaced, ]
with(spaced_labels, text(x,y,labels))
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)