I have run Maxent for multiple species under present conditions and also under future climate change scenarios. I was quantifying changes between present and future suitable habitat using the nicheOverlap function and Schoener's D statistic. Quite a few of the organisms in my study are just moving farther up mountains so there is a lot of overlap as the future distribution is inside the present distribution (just occupying less area at higher elevations). By looking at the ascii files in QGIS I can see that there is less suitable habitat in terms of area in the future, so I want to quantify this. I have scoured the internet for a good way to calculate area for rasters and never found anything that perfectly suited my fancy. I therefore wrote up something that is an amalgamation of bits and pieces of various scripts. It is pasted below.
Two questions:
1) do you all agree this is doing what I think it is doing (calculating area in square kilometers)?
2) is there a way to simplify this? Specifically you'll see I go from a raster to a dataframe back to raster? Maybe I could stay in rasters?
Thanks for any input!
Rebecca
####
library(raster)
#load rasters
m <- raster("SpeciesA_avg.asc")
mf <- raster("SpeciesA_future_layers_avg.asc")
#change to dataframe
m.df <- as.data.frame(m, xy=TRUE)
#get rid of NAs
m.df1 <- na.omit(m.df)
#keep only cells that that have a suitability score above 0.5 (scores range from 0 to 1)
m.df2 <- m.df1[m.df1$SpeciesA_avg> 0.5,]
#re-rasterize just the suitable area
m.raster <- rasterFromXYZ(m.df2)
##same as above but for future projection
mf.df <- as.data.frame(mf, xy=TRUE)
mf.df1 <- na.omit(mf.df)
mf.df2 <- mf.df1[mf.df1$SpeciesA_future_layers_avg>0.5,]
mf.raster <-rasterFromXYZ(mf.df2)
#get sizes of all cells in current distribution raster
#note my original layers were 30 seconds or 1 km2.
cell_size<-area(m.raster, na.rm=TRUE, weights=FALSE)
#delete NAs from all raster cells. It looks like these come back when switching from dataframe to raster
cell_size1<-cell_size[!is.na(cell_size)]
#compute area [km2] of all cells in raster
raster_area_present<-length(cell_size1)*median(cell_size1)
raster_area_present
#get sizes of all cells in future raster [km2]
cell_size<-area(mf.raster, na.rm=TRUE, weights=FALSE)
#delete NAs from vector of all raster cells
cell_size1<-cell_size[!is.na(cell_size)]
#compute area [km2] of all cells in geo_raster
raster_area_future<-length(cell_size1)*median(cell_size1)
raster_area_future
##calculate change in area
dif_area <- raster_area_present - raster_area_future
dif_area
When you ask a question, you should provide a simple self-contained example. Not just dump your script that points to files we do not have. Writing a simple example teaches your R, and often helps you solve the problem by yourself. Anyway, I here is some example data and solution to your problem, I think:
library(raster)
#example data
m <- mf <- raster(ncol=10, nrow=10, vals=0)
m[,1] <- NA
m[,3:7] <- 1
mf[,6:9] <- 1
# get rid of NAs (the example has none); should not be needed
m <- reclassify(m, cbind(NA, NA, 0))
mf <- reclassify(mf, cbind(NA, NA, 0))
# keep cells > 0.5 (scores range from 0 to 1)
m <- round(m)
mf <- round(mf)
# now combine the two layers, for example:
x <- m + mf * 10
# area of each cell
a <- area(x)
# sum area by class
z <- zonal(a, x, sum)
# zone value
#[1,] 0 152327547
#[2,] 1 152327547
#[3,] 10 101551698
#[4,] 11 101551698
zone 0 is "not current, nor future", 1 is "current only", 10 is "future only" and 11 is "current and future"
The areas are in m^2.
You may want to check out this tutorial on maxent and other spatial distribution models: http://rspatial.org/sdm/
Related
Suppose I have two datasets: (1) a data frame: coordinates of localities, each with ID; and (2) a linguistic distance matrix which reflects the linguistic distance between these localities.
# My data are similar to this structure
# dataframe
id <- c("A","B","C","D","E")
x_coor <- c(0.5,1,1,1.5,2)
y_coor <- c(5.5,3,7,6.5,5)
my.data <- data.frame(id = id, x_coor = x_coor, y_coor = y_coor)
# linguistic distance matrix
A B C D
B 308.298557
C 592.555483 284.256926
D 141.421356 449.719913 733.976839
E 591.141269 282.842712 1.414214 732.562625
Now, I want to visualize the linguistic distance between every two sites onto a map by the thickness or color of the line connect the adjacent localities in R.
Just like this:
enter image description here
My idea is to generate the delaunay triangulation by deldir or tripack package in R.
# generate delaunay triangulation
library(deldir)
de=deldir(my.data$x_coor,my.data$y_coor)
plot.deldir(de,wlines="triang",col='blue',wpoints = "real",cex = 0.1)
text(my.data$x_coor,my.data$y_coor,my.data$id)
this is the plot:
enter image description here
My question is how to reflect the linguistic distance by the thickness or color of the edges of triangles? Is there any other better method?
Thank you very much!
What you want to do in respect of the line widths can be done "fairly
easily" by the deldir package. You simply call plot.deldir() with the
appropriate value of "lw" (line width).
At the bottom of this answer is a demonstration script "demo.txt" which shows how to do this in the case of your example. In particular this script shows
how to obtain the appropriate value of lw from the "linguistic distance
matrix". I had to make some adjustments in the way this matrix was
presented. I.e. I had to convert it into a proper matrix.
I have rescaled the distances to lie between 0 and 10 to obtain the
corresponding values of the line widths. You might wish to rescale in a different manner.
In respect of colours, there are two issues:
(1) It is not at all clear how you would like to map the "linguistic
distances" to colours.
(2) Unfortunately the code for plot.deldir() is written in a very
kludgy way, whence the "col" argument to segments() cannot be
appropriately passed on in the same manner that the "lw" argument can.
(I wrote the plot.deldir() code a long while ago, when I knew far less about
R programming than I know now! :-))
I will adjust this code and submit a new version of deldir to CRAN
fairly soon.
#
# Demo script
#
# Present the linguistic distances in a useable way.
vldm <- c(308.298557,592.555483,284.256926,141.421356,449.719913,
733.976839,591.141269,282.842712,1.414214,732.562625)
ldm <- matrix(nrow=5,ncol=5)
ldm[row(ldm) > col(ldm)] <- vldm
ldm[row(ldm) <= col(ldm)] <- 0
ldm <- (ldm + t(ldm))/2
rownames(ldm) <- LETTERS[1:5]
colnames(ldm) <- LETTERS[1:5]
# Set up the example data. It makes life much simpler if
# you denote the "x" and "y" coordinates by "x" and "y"!!!
id <- c("A","B","C","D","E")
x_coor <- c(0.5,1,1,1.5,2)
y_coor <- c(5.5,3,7,6.5,5)
# Eschew nomenclature like "my.data". Such nomenclature
# is Micro$oft-ese and is an abomination!!!
demoDat <- data.frame(id = id, x = x_coor, y = y_coor)
# Form the triangulation/tessellation.
library(deldir)
dxy <- deldir(demoDat)
# Plot the triangulation with line widths proportional
# to "linguistic distances". Note that plot.deldir() is
# a *method* for plot, so you do not have to (and shouldn't)
# type the ".deldir" in the plotting command.
plot(dxy,col=0) # This, and plotting with "add=TRUE" below, is
# a kludge to dodge around spurious warnings.
ind <- as.matrix(dxy$delsgs[,c("ind1","ind2")])
lwv <- ldm[ind]
lwv <- 10*lwv/max(lwv)
plot(dxy,wlines="triang",col='grey',wpoints="none",
lw=10*lwv/max(lwv),add=TRUE)
with(demoDat,text(x,y,id,col="red",cex=1.5))
I have two rasters that are of same size and contains data from the same location, but different types of data (one raster has slope data and the other has aspect data). I want to be able to look at slope data for one aspect at a time, so I was trying to create a setup (maybe an if/else statement?) where I said "if (aspect condition) was satisfied in one raster, the slope data would get pulled from that same pixel in the other raster.
#I have a slope and an aspect raster that i pulled
library(raster)
library(rgdal)
library(sp)
aspect <- raster("geotiff name here")
slope <- raster("geotiff name here")
#Looking at the north aspect (between 0-22.5 degrees or 337.5-360 degrees)
#First I am setting the pixels in the aspect raster that correspond to north
#equal to 1, and the values that don't = 0
aspect[aspect >= 0 & aspect <= 22.5] <- 1
aspect[aspect >= 337.5 & aspect <= 360] <- 1
aspect[aspect > 22.5 & aspect < 337.5] <- 0
#Here i am saving the indices of the raster that face north to a new one
north <- which(aspect == 1, cells = true)
Then I want to only read the data from the pixels of the slope raster that got assigned a TRUE value from the aspect raster, but this is where I've gotten stumped! I've started using R very recently so there is probably an easy way to do this I'm missing, and any help is appreciated. Thank you very much!
Always include example data (see the help files for inspiration, here from ?raster::terrain)
library(raster)
x <- getData('alt', country='CHE')
aspect <- terrain(x, 'aspect', unit='degrees')
slope <- terrain(x, 'slope', unit='degrees')
This is a better way to reclassify:
m <- matrix(c(0,22.5,1,22.5,337.50,0,337.5,360,1), ncol=3, byrow=TRUE)
aspectcls <- reclassify(aspect, m)
Get the slope data where aspectcls != 0
nslope <- mask(slope, aspectcls, maskvalue=0)
Get the values
v <- values(nslope)
boxplot(v)
You could also do
crosstab(aspectcls, slope)
I would not recommend the path you took, but if you took it, you could do
cells <- Which(aspectcls, cells=T)
vv <- slope[cells]
boxplot(vv)
You don't need to convert 1 to TRUE, as R does this automatically. Try this code:
#create a data frame
data <- data.frame(aspect=aspect, slope=slope)
#create a 'north' column and populate with 1
data$north <- 1
#those that don't meet the north criteria are converted to 0
data$north[data$aspect > 22.5 & data$aspect < 337.5] <- 0
#report the 'slope' values where north=1
data$slope[data$north == 1]
I apologise in advance for the very basic nature of this question, but I'm confused about how the mask() function works in the raster package in R.
Reading the documentation for the function it sounds like cells in raster x are set to NA (the default) if these cells match a maskvalue in a mask object (the default maskvalue being NA). However, the description of the mask() function in the book Geocomputation with R by Lovelace et al. (https://geocompr.robinlovelace.net/spatial-operations.html#spatial-ras) (section 4.3.1) makes it sound as if cells in raster x are KEPT if they match a maskvalue in a mask object, and set to NA if they don't. They give this example:
mask(elev, rmask, maskvalue = TRUE)
"we only want to keep those values of elev which are TRUE in rmask"
Hence my confusion. I would be grateful if someone could clarify which interpretation is correct.
The reason I'd like to know is that I'd like to mask a raster containing MODIS data on percentage tree cover with a raster from the same MODIS product that contains data quality codes. I'd like to retain only those values in the "tree cover" raster that have "good quality" quality codes in the "quality" raster. Clarifying how the mask() function works will help me to determine whether I need to use code [1] or code [2] to achieve what I want:
[1]
good <- c(0,1,2,3,4,5...etc.) # The codes in the quality raster that represent good quality data
tree_cover_masked <- mask(tree_cover, quality, maskvalue = good, inverse = TRUE)
# i.e. set cells in tree_cover to NA if they match any value OTHER THAN the "good" values in the quality raster.
# This is the code I would use based on my interpretation of the function documentation.
[2]
tree_cover_masked <- mask(tree_cover, quality, maskvalue = good)
# i.e. keep values in tree_cover that match "good" values in the quality raster, and set all others to NA
# This is the code I would use based on my interpretation of Lovelace et al.
Apologies again if this question is very simplistic, but I'd be grateful for your help!
What stops you from making a small example and test which approach works? In your case, neither [1] nor [2] will work, as maskvalue is a single value (the first value if you provide a longer vector). You probably want to use reclassify first
Example data
library(raster)
qual <- trees <- raster(nrow=4, ncol=4, xmn=0, xmx=1, ymn=0, ymx=1, crs='+proj=utm +zone=1')
values(trees) <- rep(1:4, 4)
values(qual) <- rep(1:8, 2)
Create a RasterLayer with good (4 - 8) and bad (1 - 8) values and then use mask
good <- reclassify(qual, rbind(c(0, 4, NA), c(4, 9, 1)))
# this would also work
# good <- reclassify(qual, cbind(0, 4, NA))
x <- mask(trees, good)
Or:
good <- subs(qual, data.frame(from=c(5,6,7,8,9), 1))
x <- mask(trees, good)
I would like to obtain the extent of raster layer conditional on certain cell values. Consider the following example:
raster1 is a large raster object, filled with values between 1 and 1000. However, I only want to obtain the extent for pixels with value 100. Since this subset of cells should crowd in a small region, the extent should be rather narrow. Once I know the coordinates of that box, I can crop this minor area.
My approach so far is to replace all values != 100 with NA - as suggested in related questions. Considering the raster object's overall size, this step takes an enormous amount of time and invests a lot of computational capacity in regions that I would like to crop anyways.
Does anyone know how to obtain the extent conditional on a certain pixel value which does not require to reclassify the entire object beforehand?
Here is an alternative way to do that
Example data:
library(raster)
r <- raster(ncol=18,nrow=18)
values(r) <- 1
r[39:45] <- 100
r[113:115] <- 100
r[200] <- 100
"Standard" way:
x <- r == 100
s <- trim(x, values=FALSE)
Alternate route by creating an extent:
xy <- rasterToPoints(r, function(x){ x ==100 })
e <- extent(xy[,1:2])
e <- alignExtent(e, r, snap='out')
v <- crop(r, e)
Either way, all cells need to be looked at, but at least you do not need to create another large raster.
I've been trying to extract values from a single attribute raster (area, in m2) that overlaps with lines (that is, a .shp SpatialLines).
The problem is that, along these lines, my raster sometimes goes from one to several contiguous cells in all directions. Using the extract function only values from cells that are touched by the lines are extracted. Thus, when I add up the extracted values from all lines a significant amount of area (m2) is lost due to cells that were not touched by the line and therefore values were not extracted.
I tried to work it around by:
Step 1 - first aggregating my raster to a lower resolution (i.e. increasing the fact argument) and then
Step 2 - rasterizing the lines using this aggregated raster (created in step 1) as a mold to make sure the rasterized lines would get thick enough to cover the horizontal spread of cells in my original resolution raster.
Step 3 - Then I resample the rasterized lines (created in step 2) back to the original resolution I started with.
Step 4 - Finally, extracted the values from the resampled rasterized lines (created in step 3).
However, it didn't quite work as now the total area (m2) varies according to the fact="" value I use when first aggregating the raster (in step 1).
I really appreciate if anyone has already dealt with a similar problem and can help me out here. Here are the codes I've been running to try to get it to work:
# input raster file
g.025 <- raster("ras.asc")
g.1 <- aggregate(g.025, fact=2, fun=sum)
# input SpatialLines
Spline1 <- readOGR("/Users/xxxxx.shp")
Spline2 <- readOGR("/Users/xxxxx.shp")
Spline3 <- readOGR("/Users/xxxxx.shp")
# rasterizing using low resolution raster (aggregated)
c1 <- rasterize(Spline1, g.1, field=Spline1$type, fun=sum)
c2 <- rasterize(Spline2, g.1, field=Spline2$type, fun=sum)
c3 <- rasterize(Spline3, g.1, field=Spline3$type, fun=sum)
# resampling back to higher resolution
c1 <- resample(c1, g.025)
c2 <- resample(c2, g.025)
c3 <- resample(c3, g.025)
# preparing to extract area (m2) values from raster “g.025”
c1tab <- as.data.frame(c1, xy=T)
c2tab <- as.data.frame(c2, xy=T)
c3tab <- as.data.frame(c3, xy=T)
c1tab <- c1tab[which(is.na(c1tab$layer)!=T),]
c2tab <- c2tab[which(is.na(c2tab$layer)!=T),]
c3tab <- c3tab[which(is.na(c3tab$layer)!=T),]
# extracting area (m2) values from raster “g.025”
c1tab[,4] <- extract(g.025, c1tab[,1:2])
c2tab[,4] <- extract(g.025, c2tab[,1:2])
c3tab[,4] <- extract(g.025, c3tab[,1:2])
names(c1tab)[4] <- "area_m2"
names(c2tab)[4] <- "area_m2"
names(c3tab)[4] <- "area_m2"
# sum total area (m2)
c1_area <- sum(c1tab$area_m2)
c2_area <- sum(c2tab$area_m2)
c3_area <- sum(c3tab$area_m2)
tot_area <- sum(c1_area, c2_area, c3_area)
Thanks!
Andre