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)
Related
I want to multiply two rasters in R with 'terra'. Raster1 has 457 bands with EVI values meanwhile raster2 is a one-layer raster -of almost same extent- with binary values (0 or 1). The result that I want to achieve is to get raster1 (with the 457 original bands) with values only in pixels that has a value = 1 in raster2. That's why I want to multiply them.
I have tried:
result <- raster1 * raster2
result <- overlay(raster1, raster2, fun = function(x,y){return(x*y)}, unstack=FALSE)
But it doesn't work. I appreciate some help.
Example data (please always include some):
library(terra)
f <- system.file("ex/logo.tif", package="terra")
r1 <- rast(c(f, f))
r2 <- rast(r1, nlyr=1)
set.seed(0)
values(r2) <- sample(c(0,1), ncell(r2), replace=TRUE)
Solution
x <- mask(r1, r2, maskvalue=0)
If you multiply (r1 * r2), all values that are zero in r2 become zero in the output, but you want them to become NA, and that is what mask will do for you.
Alternatively, you could first change the cells that are 0 to NA, and then multiply, but that is unnecessarily convoluted:
m <- subst(r2, 0, NA)
y <- r1 * m
I have converted a raster to a point matrix in R. The file has 3 columns, x (lon), y (lat) and v (pixel value) - I am now looking to delete every second column by x and every second row by y as shown in the upper left corner of the image but am at loss how to do this. The idea is to thin the data without any interpolation or resampling.
Sample data as shown can be accessed here: https://drive.google.com/file/d/1XGEPsPEyrVNLEcZy-C6ES5915kWIaqGz/view?usp=sharing
When asking an R question, please always include a minimal reproducible, self-contained example, that is show some code and do not rely on files that must be downloaded.
As you started out with raster data, it is probably easiest to manipulate the raster data before creating points.
With the raster package:
Example data
library(raster)
r <- raster(nrow=20, ncol=20, xmn=0, xmx=1, ymn=0, ymx=1, crs="+proj=utm +zone=1 +datum=WGS84")
values(r) <- 1:ncell(r)
p <- rasterToPoints(r)
plot(r)
points(p, cex=.5)
Solution
i <- seq(1, nrow(r), 2)
j <- seq(1, ncol(r), 2)
r[i,] <- NA
r[, j] <- NA
pp <- rasterToPoints(r)
points(pp, pch=20, cex=2)
Or with the terra package:
library(terra)
r <- rast(nrow=20, ncol=20, xmin=0, xmax=1, ymin=0, ymax=1, crs="+proj=utm +zone=1 +datum=WGS84")
values(r) <- 1:ncell(r)
p <- as.points(r)
plot(r)
points(p, cex=.5)
i <- seq(1, nrow(r), 2)
j <- seq(1, ncol(r), 2)
r[i,] <- NA
r[, j] <- NA
pp <- as.points(r)
points(pp, pch=20, cex=2)
Does this work? Hard to know what to manipulate without a reproducible example and desired output, but this should remove even rows and columns from your matrix.
library(dplyr)
matrix(1:100, nrow = 10) %>%
as.data.frame() %>%
filter(row_number() %% 2 != 0) %>%
select(seq(1, ncol(.), 2)) %>%
as.matrix()
Sorry, for my newb question. I'm still learning how to conduct spatial analyses in R. I realize this question has been previously asked (here).
Goal: I'm unable to run this code with simulated data within the parameters specifically for my longitude (X) values (see line: 24). I would like to plot home range with simulated data (below).
Error: "Error in getverticeshr.estUD(x[[i]], percent, ida = names(x)[i], unin, : The grid is too small to allow the estimation of home-range. You should rerun kernelUD with a larger extent parameter"
# 1. Packages
library(adehabitatHR) # Package for spatal analysis
# 2. Empty Dataframe
points <- data.frame(ID = double())
XY_cor <- data.frame(X = double(),
Y = double())
# 3. Assigning values (this will be our spatial coordinates)
set.seed(17)
for(i in c(1:100)){
if(i >= 50){points[i, 1] <- 1}
else {points[i, 1] <- 2}
XY_cor[i, 1] <- runif(1, -78.86887, -78.86440) ## error is here!
XY_cor[i, 2] <- runif(1, 0.958533, 0.960777)}
# 4. Transform to SpatialDataframe
coordinates(points) <- XY_cor[, c("X", "Y")]
class(points)
# 5. Domain
x <- seq(-80.0, -77.0, by=1.) # resolution is the pixel size you desire
y <- seq(-200, 200, by=1.)
xy <- expand.grid(x=x,y=y)
coordinates(xy) <- ~x+y
gridded(xy) <- TRUE
class(xy)
# 6. Kernel Density
kud_points <- kernelUD(points, h = "href", grid = xy)
image(kud_points)
# 7. Get the Volum
vud_points <- getvolumeUD(kud_points)
# 8. Get contour
levels <- c(50, 75, 95)
list <- vector(mode="list", length = 2)
list[[1]] <- as.image.SpatialGridDataFrame(vud_points[[1]])
list[[2]] <- as.image.SpatialGridDataFrame(vud_points[[2]])
# 9. Plot
par(mfrow = c(2, 1))
image(vud_points[[1]])
contour(list[[1]], add=TRUE, levels=levels)
image(vud_points[[2]])
contour(list[[2]], add=TRUE, levels=levels)
# 10. Get vertices
vkde_points <- getverticeshr(kud_points, percent = 50,
unin = 'm', unout='m2')
plot(vkde_points)
I was able to solve it with the following code. Hope this can help others with the same issue! I had to manually change the resolution of my bounding box.
5. Domain
x <- seq(737326.0, 737639.6, by=5)
y <-seq(106071.4, 106259.9, by=5)
xy <- expand.grid(x=x,y=y)
coordinates(xy) <- ~x+y
gridded(xy) <- TRUE
I have a raster map with 202 rows and 201 columns
there are some grids in this map which pixel values is 0
I want to write a function that return all the pixel values 0 grids' coordinate
how can I do it
I was trying to use if loop and while loop
but it always says TRUE/FALSE need
here is my sample code
library(raster)
library(rgdal)
library(maptools)
library(sp)
setwd("E:/Landsat-data-NASA atm-corrected/sample_day1")
restdir2 <- ("E:/Landsat-data-NASA atm-corrected/sample_day1")
n3 <- list.files(restdir2, pattern="*band4_clip_1.tif", full.names=TRUE)
n4 <- list.files(restdir2, pattern="*cloud_qa_clip_1.tif", full.names=TRUE)
n5 <- list.files(restdir2, pattern="*cloud.tif", full.names=TRUE)
create<- function(x,y)
{
layer <- raster(n4)
layer2 <- raster(n3)
for(c in 1:x)
{
for(r in 1:y)
{
nl<- layer2
if(layer[c,r]==0)
return layer[c,r]
}
}
}
create (10,10)
Here are two (very similar) approaches
library(raster)
# set up example data
r <- raster(nrow=18, ncol=36)
set.seed(0)
r[] <- round(runif(ncell(r)) * 10 - 5)
# approach 1, for a single layer
p <- rasterToPoints(r, fun=function(x){x == 0})
# approach 2, also works for multiple layers
# first remove all non zero cells
z <- subs(r, data.frame(0, 1))
p <- rasterToPoints(z)
# results
plot(r)
points(p[,1:2])
if you have multiple layers with the same spatial parameters (extent and resolution)
# create example data
x1 <- setValues(r, round(runif(ncell(r)) * 10 - 5))
x2 <- setValues(r, round(runif(ncell(r)) * 10 - 5))
x3 <- setValues(r, round(runif(ncell(r)) * 10 - 5))
# combine layers
s <- stack(x1, x2, x3)
z <- subs(r, data.frame(0, 1))
p <- rasterToPoints(z)
I have two raster layers that I wish to combine into one. Let's call them mask (with values 1 and NA), and vrs.
library(raster)
mask <- raster(ncol=10, nrow=10)
mask[] <- c(rep(0, 50), rep(1, 50))
mask[mask < 0.5] <- NA
vrs <-raster(ncol=10, nrow=10)
vrs[] <- rpois(100, 2)
vrs[vrs >= 4] <- NA
I wish to combine two big layers, but for the sake of understanding these small examples are ok. What I wish to do is to set the pixel values of my output layer to zero for those pixels where mask layer is 1 and vrs layer is NA. All other pixels should remain with the values of original vrs.
This is my only thought as to how:
zero.for.NA <- function(x, y, filename){
out <- raster(y)
if(canProcessInMemory(out, n = 4)) { #wild guess..
val <- getValues(y) #values
NA.pos <- which(is.na(val)) #positiones for all NA-values in values-layer
NA.t.noll.pos<-which(x[NA.pos]==1) #Positions where mask is 1 within the
#vector of positions of NA values in vrs
val[NA.pos[NA.t.noll.pos]] <- 0 #set values layer to 0 where condition met
out <- setValues(out, val)
return(out)
} else { #for large rasters the same thing by chunks
bs <- blockSize(out)
out <- writeStart(out, filename, overwrite=TRUE)
for (i in 1:bs$n) {
v <- getValues(y, row=bs$row[i], nrows=bs$nrows[i])
xv <- getValues(x, row=bs$row[i], nrows=bs$nrows[i])
NA.pos <- which(is.na(v))
NA.t.noll.pos <- which(xv[NA.pos]==1)
v[NA.pos[NA.t.noll.pos]] <- 0
out <- writeValues(out, v, bs$row[i])
}
out <- writeStop(out)
return(out)
}
}
This function did work on the small example and seems to work on the bigger ones. Is there a faster/better way of doing this? Some way that is better for larger files? I will have to use this on many sets of layers and I would appreciate any help in making the process safer and or quicker!
I'd use cover():
r <- cover(vrs, mask-1)
plot(r)
You can do this with overlay, as well:
r <- overlay(mask, vrs, fun=function(x, y) ifelse(x==1 & is.na(y), 0, y))