I am relatively new to using R and working with GIS data.
I am trying to create a function to overlay two Raster layers, only when one of the rasters (in this case raster1) is at a certain value (in this case 0). I have tried numerous options in doing this but they don't seem to work. My last attempt is provided below, and it runs but the output just says NULL and it does not plot.
library(raster)
raster1 <- raster(ncols=10,nrows=10)
raster2 <- raster(ncols=10,nrows=10)
values(raster1) <- round(runif(ncell(raster1)))
values(raster2) <- round(runif(ncell(raster2)))
plot(raster1)
plot(raster2)
overlay_zero <- function (x, y) {
if (isTRUE(x == 0)) {
overlay(x, y, fun=function(x,y) {return(x+y)})}
}
z <- overlay_zero(raster1, raster2)
z
plot(z)
overlay_ras <- function(ras1,ras2,value=0){
result <- ras1
result[ras1==value] <- ras1[ras1==value] + ras2[ras1==value]
return(result)
}
overlaid <- overlay_ras(raster1,raster2,0)
This will do the trick. The function takes two rasters and a value which will be used to determine the cells affected by the overlay (addition).
Related
I have a function to extract values of timeseries raster for path of points. That was working perfectly up to now; however, I am constantly receiving error trying to use it today. The error I am receiving says:
Error in UseMethod("extract_") : no applicable method for
'extract_' applied to an object of class "c('RasterLayer', 'Raster',
'BasicRaster')"
Can you please help. I have tried a lot but I am not able to resolve this issue.
library(raster)
#--------------------------------------start myfunction-----------------------------
# extract raster values for each single point in each path and put it a dataframe
lst <- function (rstack.lst, points, df.name, IDstr){
df.name <- list()
ii <- 1
#number of layers in a list of raster stacks
n = Reduce(`+`, lapply(rstack.lst, nlayers))
for (j in 1:length(rstack.lst)){
df.name[[j]] <- as.data.frame(matrix(0, ncol = nlayers(rstack.lst[[j]])+3, nrow = nrow(points)))
names(df.name[[j]]) <- append(c("coords.x","coords.y","ID"), substr(names(rstack.lst[[j]]),5,14), after = 3)
#calculating x and y coordinates
df.name[[j]][1:2] <- coordinates(points)
# setting up unique IDs
df.name[[j]]$ID <- paste0(IDstr, ".",seq(1:(nrow(df.name[[j]]))))
for (i in 1:nlayers(rstack.lst[[j]])){
df.name[[j]][i+3] <- extract(rstack.lst[[j]][[i]], points)
colnames(df.name[[j]][i+3]) <- substr(names(rstack.lst[[j]][[i]]),5,14)
cat(paste0(round((ii/(n))*100), '% completed'))
ii <- ii+1
Sys.sleep(.05)
if (ii == n) cat(': Done')
else cat('\014')
}
}
return(df.name)
}
#--------------------------------------end start myfunction-----------------------------
lsdata[[1]] <- lst(rstack.lst=r.lst, points=Pnt.shp, IDstr="P1")
I may be wrong but I think the extract function is not malfunctioning but you are probably loading some other packages with exactly the same function (I meant with the same name). There are many packages that may have a function with a same name. For instance, extract is also a function in tidyr. To avoid these kinds of issues, I suggest you to also add the package name while specifying the function. Here you can do: raster::extract.
To make sure, simply execute extract and doublecheck what it contains. Whatever it contains, probably it is not be as below:
function (x, y, ...)
standardGeneric("extract")
<bytecode: 0x000000001873c4d0>
<environment: 0x000000001855db68>
Methods may be defined for arguments: x, y
Use showMethods("extract") for currently available ones.
I have stack raster dataset with several layers, however, I want to calculate the sum of each cell with for different layer selection, and finally generate a new layer, anyone has some good suggestion by using calc or overlay or some other raster calculation in R?
I can do by loops and make the calculation, but it will consume many times when I have many layers, and also use many of the storage, my script as follows,
## library(raster)
make_calc <- function(rr, start, end) {
rr <- as.array(rr)
start <- as.array(start)
end <- as.array(end)
dms <- dim(raster)
tmp <- array(NA, dim = dms[1:2])
for (i in 1:dms[1]) {
for (j in 1:dms[2]) {
tmp[i,j] <- sum(raster[i,j,start[i,j,1]:end[i,j,1]], na.rm = TRUE)
}
}
return(tmp)
}
rr <- raster(res = 10)
rr[] <- 1
rr <- stack(rr, rr, rr, rr)
start <- raster(res = 10)
start[] <- sample(1:2, ncell(start), replace = TRUE)
end <- raster(res = 10)
end[] <- sample(3:4, ncell(end), replace = TRUE)
result <- make_calc(rr, start, end)
Why are you coercing into arrays? You can easily collapse a raster into a vector but, that does not even seem necessary here. In the future, please try to be more clear on what your expected outcome is.
Based on your code, I really don't know what you are getting at. I am going to take a few guesses on summing specified rasters in the stack, drawing a random sample, across rasters to be summed and finally, drawing a random sample of cells to be summed.
For a sum on specified rasters in a stack, you can just index what you are after in the stack using a double bracket. In this case, rasters 1 and 3 in the stack would be the only ones summed.
library(raster)
rr <- raster(res = 10)
rr[] <- 1
rr <- stack(rr, rr, rr, rr)
( sum_1_3 <- calc(rr[[c(1,3)]], sum) )
If you are wanting a random sample of the values across rasters, for every cell, you could write a function that is passed to calc. Here is an example that grabs a random sample of n size, across the raster layers values and sums them.
rs.sum <- function(x, n=2) {sum( x[sample(1:length(x),n)], na.rm=TRUE)}
rs.sum.raster <- calc(rr, rs.sum)
If you are wanting to apply a function to a limited random selection of cells, you could create a random sample of the raster that would be used as an index. Here we create a random sample of cells, create an empty raster and pipe the sum of rasters 1 and 2 (in the stack) based on the random sample cell index. A raster in the stack is indexed using the double bracket and the raster values are indexed using a single bracket so, for raster 1 in the stack with limiting to the values in the random sample you would use: rr[[1]][rs]
rs <- sample(1:ncell(rr[[1]]), 300)
r.sum <- rr[[1]]
r.sum[] <- NA
r.sum[rs] <- rr[[1]][rs] + rr[[2]][rs]
plot(r.sum)
So far I used the following statement in the Raster Calculator of ArcGIS:
Con(("Land_use.rst" == -20), "Export.rst")
This calculates a new Raster which only contains the Data from Export where Land_use equals -20. That is exactly what I want. But I want to automatise this in R, as I have to do it a lot of times.
So far I got something like this:
for (catch_dir in Dir_List) {
r1 <- raster(paste0(catch_dir, '/Export.rst'))
r2 <- raster(paste0(catch_dir,'/LAND_use.rst'))
### statement that output export_streams.rst contains the data of export.rst where LAND_use.rst equals -20.
x <- overlay(r2, r1, fun=function(x,y){ y[x!=-20] <- 0; y})
writeRaster(x, filename = paste0(catch_dir, "/export_streams.rst"), format="IDRISI", NAflag = 0, datatype = "FLT4S",
overwrite=TRUE)
}
That code does the following:
It produces a raster which contains the values of r1 where r2 = -20. So that is good, but there are also leftovers at the border of the raster which do not equal -20 in r2. The extent of the two rasters are the same though. So the overlay probably doesnt work for my task. Any other ideas than overlay? Maybe some if(r2 == -20){ } command?
I don't habe your data, so I cant reproduce your error. However this is how I would do it with dummy data:
#create dummy matrix
a <- matrix(c(10,10,10,10,10,10,10,10,10),nrow=3)
b <- matrix(c(-20,-20,-20,3,3,3,4,4,4),nrow=3)
#create raster from matrix
r1 <- raster(a)
r2 <- raster(b)
#Create raster with same extent and nrows/ncols as original rasters
x <- raster(r1)
#produce raster x which contains the values of r1 where r2 = -20
x[r2[]==-20] <- r1[r2[]==-20]
You can do this:
m <- subs(r2, cbind(-20, 1))
x <- mask(r1, m)
I was wondering if any of you could help me with the following task dealing with the focal() function in the R raster package.
By default, the focal() function will run through each cell of a given raster ('background' raster hereafter) and apply a given function to the neighboring values as defined by a user-defined moving window. In order to optimize and speed up my computation on large rasters/study areas, I would like to apply this function (filter) only when the 'background' raster has some values (e.g. greater than zero) within the extent covered by the 'moving window' and skip all the other focal cells. This way, the filter would not spend time computing any focal value where there is no need to.
Below a reproducible small example and in-line comments:
library(raster)
x <- matrix(1:25, ncol=5)
x[c(1,2,3,6,7,8,11,12,13)] <- 0
r <- raster(x)
#Apply filter to focal cells and return values using a 3x3 moving window...ONLY IF
#ALL values found within the window are > 0. Skip focal cell otherwise.
r3 <- focal(r, w=matrix(1/9,nrow=3,ncol=3), FUN=sum)
How should I change this function to have the desired outcome?
The windows slide operates # all focal pixels locations. Skipping/Jumping locations is not possible. However, you can check, whether all the elements/matrix cells satisfy your threshold condition as below:
myfunc = function (x){
if(all(x > threshold)){
print(x)
x = sum(x)
}else{
x = 0}
}
r3 <- focal(x=r>1, w=matrix(1/9,nrow=3,ncol=3), fun=sum)
I'm not sure it would be any faster, but you could also check if the center cell adheres to some criteria (e.g. is NA or >0). This way the focal calculation will only run when it meets those criteria.
w=matrix(1,5,5)
skipNA_avgFunc <- function(x) {
# general definition of center cell for weight matrices with odd dims
center <- x[ceiling(length(x)/2)]
if (is.na(center)) { # handle NA values
return(center)
}
else if (center >= 0) { # calculate mean
mean(x, na.rm=TRUE)
}
}
r3 <- focal(r, w=w, fun=skipNA_avgFunc, pad=TRUE, padValue=NA)
I have a set of random segments drawing a kind of tessellation (of triangles, rectangles ...) in a window (in spatstat R). I need to convert it into a set of polygons (SpatialPolygons) to calculate some indices (like area, shape indices ...).
This is apparently simple but I couldn't find how to do it ...
Here is a bit of code from Carl Witthoft that generate a random pattern of self-intercepting segments :
ranpoly <- function(numsegs=10,plotit=TRUE) {
require(spatstat)
# temp fix: put the first seg into segset. Later make it a constrained random.
segset<-psp(c(0,1,1,0,.25),c(0,0,1,1,0),c(1,1,0,0,1),c(0,1,1,0,.75),owin(c(0,1),c(0,1)) ) #frame the frame
for (jj in 1: numsegs) {
# randomly select a segment to start from, a point on the seg, the slope,and direction
# later... watch for slopes that immediately exit the frame
endx <-sample(c(-0.2,1.2),1) #force 'x1' outside the frame
# watch that sample() gotcha
if(segset$n<=5) sampset <- c(5,5) else sampset<-5:segset$n
startseg<-sample(sampset,1) #don't select a frame segment
# this is slope of segment to be constructed
slope <- tan(runif(1)*2*pi-pi) # range +/- Inf
# get length of selected segment
seglen<-lengths.psp(segset)[startseg]
startcut <- runif(1)
# grab the coords of starting point (similar triangles)
startx<- segset$ends$x0[startseg] + (segset$ends$x1[startseg]-segset$ends$x0[startseg])*startcut #seglen
starty<- segset$ends$y0[startseg] + (segset$ends$y1[startseg]-segset$ends$y0[startseg])*startcut #seglen
# make a psp object with that startpoint and slope; will adjust it after finding intersections
endy <- starty + slope*(endx-startx)
newpsp<-psp(startx,starty,endx,endy,segset$window,check=FALSE)
# don't calc crossing for current element of segset
hits <- crossing.psp(segset[-startseg],newpsp)
segdist <- dist(cbind(c(startx,hits$x),c(starty,hits$y)))
# dig back to get the crosspoint desired -- have to get matrixlike object out of class "dist" object
# And, as.matrix puts a zero in location 1,1 kill that row.
cutx <- hits$x[ which.min( as.matrix(segdist)[-1,1] )]
cuty <- hits$y[which.min(as.matrix(segdist)[-1,1] )]
segset <- superimpose(segset,psp(startx,starty,cutx,cuty,segset$window))
} #end jj loop
if(plotit) plot(segset,col=rainbow(numsegs))
return(invisible(segset))
}
segset=ranpoly()
segset is the psp object from wich I need to create a SpatialPolygons object.
Googling for spatstat as spatialPolygons lead me to this first hit, which is the vignette in spatstat dedicated to handeling shapefiles. It spends a lot of time on how to convert sp-classes into spatstat objects. You might be most interested in section 3.2.5: Objects of class SpatialPolygons and section 3.2.6: Objects of class SpatialPolygonsDataFrame.
Assuming that you have a set of spatstat objects, you can try something like (untested):
require(sp)
# VECTOR OF spatstat OBJECT NAMES
segs <- (seg1,seg2,seg3)
segPolys <- as(segs[1], "SpatialPolygons")
for( i in 2:length(segs)) {
y <- as(segs[i], "SpatialPolygons")
slot(y[[i]], "ID") <- paste(i)
segPolys <- c(slot(y, "polygons"),segPolys)
}