Counting number of points on a raster layer in R - r

I've got a map with certain number of points on it. I want to (1) calculate the number of points that fall within the raster layer, and (2) extract these points to a data frame.
This is what I've done:
# Packages
library(raster)
library(ggplot2)
library(maptools)
library(tidyverse)
library(dplyr)
library(sp)
# Transform tree ring kml to dataframe
zz<-getKMLcoordinates('treering.kml', ignoreAltitude=TRUE)
l<-as.data.frame(zz)
l<-t(l)
tree <-SpatialPointsDataFrame(l, l,
proj4string = CRS(" +proj=longlat +ellps=WGS84 +datum=WGS84
+no_defs +towgs84=0,0,0"))
# Get world map
data(wrld_simpl)
# Transform World to raster
r <- raster(wrld_simpl, res = 1)
wrld_r <- rasterize(wrld_simpl, r)
# Import permafrost layer to raster
dist1<-raster("PZI.flt")
# Set CRS
dist1 <- projectRaster(from = dist1, crs = CRS("+proj=longlat +ellps=WGS84 +datum=WGS84 +no_defs
+towgs84=0,0,0"))
# Change colours
micolor <- rev(rainbow(12, alpha = 0.35))
transp <- rainbow(12, alpha = 0)
micolor[1:3] <- transp[1]
# Plot all
plot(wrld_r, col = "lightgrey")
plot(dist1, add=TRUE, legend = F, col = micolor)
plot(tree, add=T, pch = 20, col='black', cex=0.2)
I want to calculate and extract black points located on the colorful parts of this map

First raster::projectRaster does not "set" the projection but, rather reprojects the raster given a transformation and resampling. Given the computational requirements of this it is much faster to reproject the point data using sp::spTransform. Once your data is in the same projection space, you can use raster::extract to extract the raster values. Values out side the raster or in nodata (NA) areas will be assigned NA values. You can drop these observations using a simple NA index with which.
It looks like your data may have a constant value outside of the permafrost. Once you identify what this value is (eg., 0) you can remove these points as well. Here is a worked example. First we add packages and create some example data that is similar to yours.
library(sp)
library(raster)
dist1 <- raster(nrow=20, ncol=20)
dist1[] <- sample(1:10, ncell(dist1), replace=TRUE)
dist1[200:400] <- 0
trees <- sampleRandom(dist1, 100, sp=TRUE)
plot(dist1)
plot(trees,pch=20,col="red",add=TRUE)
Now, we extract the raster values and look at the dimensions of the point object (please note that I do not have to use the sp=TRUE argument in the raster::extract function).
trees#data <- data.frame(trees#data, dist1 = extract(dist1, trees))
dim(trees)
Now we create a row index indicating which rows contain zeros, make sure that we have identified rows (using an if statement) and then remove them. Looking at the object dimensions again, we can see how many points were removed from the original point data.
( idx <- which(trees$dist1 %in% 0) )
if(length(idx) > 0) trees <- trees[-idx,]
dim(trees)

Related

Convert a spatial point to raster in R

How to convert a single spatial point to a raster object.
I want to create a raster of 0.1 resolution within the domain xmin = 150 xmx=180,ymin=25,ymax=35 and put the values of a datapoint dt point in the raster.
Here is the data and code.
dt<-data.frame(lon=71.85,lat =31.12,val=3)
dt
ras_dom<-raster(xmn=150, xmx=180, ymn=25, ymx=35,
crs="+proj=longlat +datum=WGS84 +no_defs ",
resolution=c(0.1,0.1), vals=NA)
ras_dom
I want to put the value (or values) from dt in the ras_dom so that I have a raster with values for given grids and NA for others.
library(raster)
coordinates(dt) <- ~ lon + lat # Convert data frame to spatial object
result <- rasterize(dt, ras_dom, "val", update = TRUE) # put point in raster
result # The resulting raster with the point added
Because dt in the example is outside the raster, result does not contain it.

Dealing with NA values using extract function in R

I am trying to calculate average annual temperatures for grid cells of 11x11km (except if the cell is coastal, the size is smaller) using the CRU database. The CRS of both vector and raster are the same. However, 332 out of 1363 cells show NA values after the extraction. I want to fill in the NA values before using the dataset for further analysis. Any idea of how I could deal with these missing values? I have looked at several possible solutions on this forum (and others). Unfortunately, none of them don’t seem to apply to my case.
Below are the details of my workflow:
# load the temperature dataset
temp <- brick("/CRU/cru_ts4.02.1901.2017.tmp.dat.nc", varname="tmp")
# set CRS for temp
utm = "+proj=utm +zone=49 +datum=WGS84 +towgs84=0,0,0"
tempro = projectRaster(temp, crs = utm, method = "bilinear")
# load the grid cells (in polygons) & set its CRS
fish <- st_read("/CRU/fish11.shp")
fishpro <- st_transform(fish, "+proj=utm +zone=49 +datum=WGS84 +towgs84=0,0,0")
# extract the temperature dataset
tempgrid <- extract(tempro, fishpro, fun='mean', na.rm=TRUE, df=TRUE, weights = TRUE, small = TRUE,
method='bilinear')
write.csv(tempgrid, file="temp.csv")
whereas the map is:
temperature
I do not think there is a simple answer to your question. Apparently the polygons are not over land; but we cannot tell as we do not have your data. It could also be that the UTM zone chosen is not appropriate.
I can say that what you are doing is wrong. If you need to transform the data; you should transform the vector data, not the raster data (even if that should not affect the NA problem much, if at all).
library(raster)
temp <- brick("/CRU/cru_ts4.02.1901.2017.tmp.dat.nc", varname="tmp")
fish <- st_read("/CRU/fish11.shp")
fishpro <- st_transform(fish, "+proj=longlat +datum=WGS84")
tempgrid <- extract(temp, fishpro, fun='mean', na.rm=TRUE, df=TRUE, small = TRUE)
You could also make a map to see what is going on (and perhaps include that as an image in your quesiton.
x <- crop(temp[[1]], extent(fishpro)+1)
plot(x)
lines(fishpro)

Insert points into a grid in R

I have a grid of the map of Porto, I would like to be able to insert in the grid the points to discretize them. In this way to see how many points are in each cell depending on the time.
This is the code of the grid:
#latitudS and longitudS are coordinates x Y
x = longitudS
y = latitudS
df = data.frame(x, y)
# Converting to a Spatial Points Data Frame so you can keep the value that you will change within the Grid
points = SpatialPointsDataFrame(coords = df[, 1:2], df)
# load some spatial data. Administrative Boundary
porto <- getData('GADM', country = 'Portugal', level = 2)
porto$NAME_1
porto <- porto[porto$NAME_2 == "Porto",]
# check the CRS to know which map units are used
proj4string(porto)
# "+proj=longlat +datum=WGS84 +no_defs +ellps=WGS84 +towgs84=0,0,0"
# Create a grid of points within the bbox of the SpatialPolygonsDataFrame
# colorado with decimal degrees as map units
grid <- makegrid(porto, cellsize = 0.003) # cellsize in map units!
# grid is a data.frame. To change it to a spatial data set we have to
grid <- SpatialPoints(grid, proj4string = CRS(proj4string(porto)))
portoWithin <-
SpatialPixels(grid, proj4string = CRS(proj4string(porto)))
#### Converting the GRID to a Raster
ras_portoWithin <- raster(portoWithin)
## Assigning temporary values to the raster
values(ras_portoWithin) <- 0
## Using the Spatial point file created above to replace the values of the raster
r1 <- ras_portoWithin
plot(porto)
plot(portoWithin, add = T)
The idea is that for each cell the number of points will be output depending on the time in which the points have been recorded.
Also ask if there would be any way to transfer that grid to a leaflet, so you can see it on a map.
Thanks!

Is there a speedy and memory efficient way to calculate the proportion of overlay between a polygon and high resolutiong raster in R?

I need to calculate the proportion of each raster cell in a high resolution grid (raster stack with 8 layers) covered by a polygon using R.
My standard approach would be to use raster::rasterize(..., getCover = TRUE), however, this approach takes a very long time, particularly when the size of the polygon increases.
As an alternative, I tried cropping the raster stack to the extent of the polygon, transforming the raster stack to polygons and calculating the proportion from the intersection of the resulting shapes with the original polygon. This works well for small polygons but breaks down as the polygon increases, because R runs out of memory (I am limited to 16GB) or because the calculation of the intersection takes too long.
Here a reproducible example using my current solution with a very small shape file.
library(raster)
library(spex)
library(dplyr)
library(sf)
library(data.table)
# setup a dummy example
r <- raster(nrow = 21600, ncol = 43200)
r[] <- 1:933120000
r_stack <- stack(r,r,r,r,r,r,r,r)
# get a small dummy shapefile
shp_small <- raster::getData(name = "GADM", country = "CHE", level = 2, download = TRUE)
shp_small <- st_as_sf(shp_small)[1, ]
# for comparison, use a big dummy shapefile
# shp_big <- raster::getData(name = "GADM", country = "BRA", level = 0, download = TRUE)
## Approach for a small shape file
stack_small <- raster::crop(r_stack, shp_small, snap = "out")
## transform to polygon
stack_small_poly <- spex::polygonize(stack_small)
stack_small_poly$ID <- 1:nrow(stack_small_poly)
## I can then perform the necessary calculations on the polygons to obtain
## the proportional overlay
# transform to mollweide for area calculation
mollw <- "+proj=moll +lon_0=0 +x_0=0 +y_0=0 +datum=WGS84 +units=m +no_defs"
stack_small_crs <- st_crs(stack_small_poly)
stack_small <- st_transform(stack_small_poly, mollw)
stack_small_poly <- st_transform(stack_small_poly, mollw)
# calculate area for each cell
stack_small_poly$area_org <- st_area(stack_small_poly)
# transform to world equidistant cylindrical
stack_small_poly<- st_transform(stack_small_poly, 4087)
shp_small <- st_transform(shp_small, 4087)
# get call the cells that intersect with the shape (this might take a while)
i <- st_intersects(stack_small_poly, shp_small, sparse = FALSE)
stack_small_poly <- dplyr::filter(stack_small_poly, i)
# now calculate the extact intersection (this might take a while)
st_agr(stack_small_poly) <- "constant"
stack_small_poly <- st_intersection(stack_small_poly, st_geometry(shp_small))
# calculate the new areas and backtransform
stack_small_poly <- st_transform(stack_small_poly, mollw)
stack_small_poly$new_area <- st_area(stack_small_poly)
stack_small_poly <- st_transform(stack_small_poly, stack_small_crs)
# calculate proportion
stack_small_poly$proportion <- as.numeric(stack_small_poly$new_area/stack_small_poly$area_org)
# finally transform to data.table for subsequent analysis
st_geometry(stack_small_poly) <- NULL
setDT(stack_small_poly)
I am looking for a solution in R that is able to perform the task in 10-15 minutes (preferably faster) with a memory limit of 16 GB RAM for the shapefile representing Brazil (see shp_big in code above).
I am well aware that this optimum might not be achievable and every suggestion leading to a reduction in execution time and/or memory usage is more than wellcome.

Draw polygon from raster after occurrence modeling

I want to draw polygons for species occurrence using the same methods BIEN uses, so I can use both my polygons and theirs. They use Maxent to model species occurrence when they have more then occurrence points.
So, this is, for example, a BIEN polygon:
library(BIEN)
Mormolyca_ringens<- BIEN_ranges_load_species(species = "Mormolyca ringens")
#And this is a polygon, yes. A SpatialPolygonsDataFrame.
plot(wrld_simpl, xlim=c(-100,-40), ylim=c(-30,30), axes=TRUE,col="light yellow", bg="light blue")
plot(Mormolyca_ringens, col="green", add=TRUE)
Mormolyca ringens polygon
Ok, then I'm trying to draw my polygons because BIEN lacks some for species I need.
# first, you need to download the Maxent software here: http://biodiversityinformatics.amnh.org/open_source/maxent/
#and paste the "maxent.jar" file in the ’java’ folder of the ’dismo’ package, which is here:
system.file("java", package="dismo")
#You have to do this **before** loading the libraries
#install.packages("rJava")
library(rJava)
#If you get the message that cannot load this library, it's possible that your version of java is not 64bit.
#Go to Oracle and install Java for windows 64bit.
#If library still doesn't load: Look in your computer for the path where the java's jre file is and paste in the code below
Sys.setenv(JAVA_HOME="your\\path\\for\\jre") #mine is "C:\\Program Files\\Java\\jre1.8.0_144", for example
library(rJava)
library(dismo)
library(maptools)
#Giving credits: I wrote the following code based on this tutorial: https://cran.r-project.org/web/packages/dismo/vignettes/sdm.pdf
#Preparing the example data - the map
data(wrld_simpl)
ext = extent(-90, -32, -33, 23)
#Preparing the example data - presence data for Bradypus variegatus
file <- paste(system.file(package="dismo"), "/ex/bradypus.csv", sep="")
bradypus <- read.table(file, header=TRUE, sep=',')
bradypus <- bradypus[,-1] #don't need th first col
#Getting the predictors (the variables)
files <- list.files(path=paste(system.file(package="dismo"),
'/ex', sep=''), pattern='grd', full.names=TRUE )
predictors <- stack(files)
#making a training and a testing set.
group <- kfold(bradypus, 5)
pres_train <- bradypus[group != 1, ]
pres_test <- bradypus[group == 1, ]
#Creating the background
backg <- randomPoints(predictors, n=1000, ext=ext, extf = 1.25)
colnames(backg) = c('lon', 'lat')
group <- kfold(backg, 5)
backg_train <- backg[group != 1, ]
backg_test <- backg[group == 1, ]
# Running maxent
xm <- maxent(predictors, pres_train, factors='biome')
plot(xm)
#A response plot:
response(xm)
# Evaluating and predicting
e <- evaluate(pres_test, backg_test, xm, predictors)
px <- predict(predictors, xm, ext=ext, progress='text', overwrite=TRUE)
#Checking result of the prediction
par(mfrow=c(1,2))
plot(px, main='Maxent, raw values')
plot(wrld_simpl, add=TRUE, border='dark grey')
tr <- threshold(e, 'spec_sens')
plot(px > tr, main='presence/absence')
plot(wrld_simpl, add=TRUE, border='dark grey')
points(pres_train, pch='+')
At this point, I have the following image:
Prediction for example's occurrence
And I'm trying to make a polygon from this raster with this code:
predic_pol<-rasterToPolygons(px )
And also:
px_rec<-reclassify(px, rcl=0.5, include.lowest=FALSE)
px_pol<-rasterToPolygons(px_rec)
But i keep getting a pixels version of my extent
Can you please give me a hint so I can extract a polygon out of this raster, like the BIEN's one? (Also I'm new to modeling and to R... any tips are welcome)
EDIT: this is the px console output:
> px
class : RasterLayer
dimensions : 172, 176, 30272 (nrow, ncol, ncell)
resolution : 0.5, 0.5 (x, y)
extent : -120, -32, -56, 30 (xmin, xmax, ymin, ymax)
coord. ref. : +proj=longlat +datum=WGS84 +ellps=WGS84 +towgs84=0,0,0
data source : C:\Users\thai\Documents\ORCHIDACEAE\Ecologicos\w2\predictions\Trigonidiumobtusum_prediction.grd
names : layer
values : 6.705387e-06, 0.9999983 (min, max)
Thank you in advance
Edit 2: Solution
Thanks to #Val I got to this:
#Getting only the values>tr to make the polygon
#"tr" is what gives me the green raster instear of the multicolour one
pol <- rasterToPolygons(px>tr,function(x) x == 1,dissolve=T)
#Ploting
plot(wrld_simpl, xlim=c(-120,-20), ylim=c(-60,10), axes=TRUE,col="light yellow", bg="light blue")
plot(pol, add=T, col="green")
And now I have what I wanted! Thank you!
(The polygon is not the same in the figures only because I used a different data set I had at my environment at the moment I got #Val 's answer)
Bonus question:
Do you know how to smooth the edges so I get a non pixelized polygon?
I don't know BIEN, so I din't really look at this part of your example. I just generalized your problem/question down to the following:
You have a binary raster (with 0 for absence and 1 for presence) and you want to convert all areas with 1 to a polygon.
As for your px raster, it's a bit odd that your values are not 0 and 1 but more basically 0 and basically 1. But if that's a problem, that can be an easy fix.
So I tried to recreate your example with just the area of Brasil:
library(raster)
library(rgeos)
# get Brasil borders
shp <- getData(country = 'BRA',level=0)
#create binary raster
r <- raster(extent(shp),resolution=c(0.5,0.5))
r[] <- NA # values have to be NA for the buffering
# take centroid of Brasil as center of species presence
cent <- gCentroid(shp)
# set to 1
r[cellFromXY(r,cent)] <- 1
# buffer presence
r <- buffer(r,width=1000000)
# set rest 0
r[is.na(r)] <- 0
# mask by borders
r <- mask(r,shp)
This is close enough to your raster I guess:
So now to the conversion to the polygon:
pol <- rasterToPolygons(r,function(x) x == 1,dissolve=T)
I use a function to only get pixels with value 1. Also I dissolve the polygons to not have single pixel polygons but rather an area. See rasterToPolygons for other options.
And now plot the borders and the new polygon together:
plot(shp)
plot(pol,col='red',add=T)
And there you have it, a polygon of the distribution. This is the console output:
> pol
class : SpatialPolygonsDataFrame
features : 1
extent : -62.98971, -43.48971, -20.23512, -1.735122 (xmin, xmax, ymin, ymax)
coord. ref. : NA
variables : 1
names : layer
min values : 1
max values : 1
Hope that helps!
Edit: Bonus answer
You have to be clear, that the pixelized boundaries of your polygon(s) represent an accurate representation of your data. So any change to that means a loss of precision. Now, depending on your purpose, that might not matter.
There's multiple ways to achieve it, either at the raster side with disaggregating and smoothing/filtering etc. or at the polygon side, where you can apply specific filters to the polygons like this.
If it's purely aesthetic, you can try gSimplify from the rgeos package:
# adjust tol for smoothness
pol_sm <- gSimplify(pol,tol=0.5)
plot(pol)
lines(pol_sm,col='red',lwd=2)

Resources