I am currently working with some data from Switzerland with 100x100 m resolution. I would like to aggregate the data to 1x1km from km-squares based on the national grid (with coordinates f.i. x = 500000, y = 130000), differing from the original extent of my RasterLayer object. I have provided some code for a RasterLayer based on the original extent (=r) and a RasterLayer with a new extent based on national grid cells in Switzerland (=r.agg) and plotted r.agg over r (the latter of, which I coloured in red to make the borders more obvious).
library(raster)
ncol <- 3677 # same as original RasterLayer
nrow <- 2261 # same as original RasterLayer
## create raster (with original extent)
r <- raster(ncol = ncol, nrow = nrow) # dimensions of raster
mat <- matrix(runif(ncol*nrow, 0,2), ncol = ncol, nrow = nrow) # write data
# create simplified country-borders / buffer
mat [0:100, 0:ncol] <- NA
mat [0:nrow, 0:100] <- NA
mat [(nrow - 100):nrow, 0:ncol] <- NA
mat [0:nrow, (ncol -100):ncol] <- NA
r[] <- mat #write data to raster
extent(r) <- matrix(c(479950, 73950, 847650, 300050), nrow = 2) # define extent
proj4string(r) <- "+proj=somerc +lat_0=46.95240555555556
+lon_0=7.439583333333333
+k_0=1 +x_0=600000 +y_0=200000
+ellps=bessel +towgs84=674.374,15.056,405.346,0,0,0,0
+units=m +no_defs"
## create raster (with customised extent)
r.agg <- r # prepare aggregatable RasterLayer
extent(r.agg) <- matrix(c(480000, 74000, 847700, 300100), nrow = 2)
r.agg <- aggregate(r.agg, fact = 10, fun = mean)
par(bg = 'darkgrey')
plot(r, col = "red", legend = FALSE)
plot(r.agg, add = TRUE)
However, I am not entirely sure to interpret the results correctly:
The plotted "r.agg" over "r" shows a red line which I don't quite understand.
Option A (desired outcome): extent() allows me to aggregate over the national grid and aggregate over the spatially correct 100x100m information
Option B (which I hope does not happen): extent() will let me aggregate over the national grid, but using the data from the original grid and thus not the one from the correct 100x100 squares.
I didn't find the help page for extent() particularly helpful and would be glad to receive some clarification. If Option B is the case (or I misunderstood something completely), I would be really happy if someone could help me to figure this out. Thanks a lot in advance and sorry for my weird phrasing, I am new to analyzing spatial data.
The two rasters do not align, so you cannot rely on aggregate alone.
You can do
library(raster)
r <- raster(ncol = 3677, nrow = 2261, ext=extent(479950, 847650, 73950, 300050))
crs(r) <- "+proj=somerc +lat_0=46.95240555555556 +lon_0=7.439583333333333 +k_0=1 +x_0=600000 +y_0=200000
+ellps=bessel +towgs84=674.374,15.056,405.346,0,0,0,0 +units=m +no_defs"
r.agg <- raster(nrow=227, ncol=368, ext=extent(480000, 848000, 73100, 300100))
x <- resample(r, r.agg)
Or, to have more control
r.low <- disaggregate(r.agg, 10)
r.low <- resample(r, r.low)
ra <- aggregate(r.low, 10, mean)
Related
I am processing netCDF data for multiple years. The netCDF is for air pollutant data, and the latitude and longitude are provided as separate variables, not as part of the original grid.
LINK TO DATE: Sample Netcdf
These netCDF files provide Level 2 Nitrogen Dioxide data and they are downloaded from NASA Earthdata portal. The satellite is Sentinel-5P and the instrument is TROPOMI.
So when processing this data, you have to create variables for NO2, latitude and longitude. I am trying to create raster layers, and then save them as GeoTIFF files for my research.
The problem here is related to the fact that I don't know how best to create these rasters. The latitude and longitude is not equally spaced throughout the dataset, and I haven't figured out a way to accurately create these images. I created a model grid using the number of rows and columns provided by the netCDF files. In the list of variables this is called the scanline and ground_pixel, but when I plot it the cells in the final image don't look right.
This is how I upload the data:
## Open the netcdf
ncname <- no2files$filename[m]
ncfname <- paste(ncname, sep = "")
nc <- nc_open(ncfname)
## Get the necessary variables.
no2tc <-ncvar_get(nc, "PRODUCT/nitrogendioxide_tropospheric_column")
lat <- ncvar_get(nc, "PRODUCT/latitude")
lon <- ncvar_get(nc, "PRODUCT/longitude")
qa <- ncvar_get(nc, "PRODUCT/qa_value")
fillvalue = ncatt_get(nc, "DETAILED_RESULTS/nitrogendioxide_total_column",
"_FillValue")
mfactor <- ncatt_get(nc, "DETAILED_RESULTS/nitrogendioxide_total_column",
"multiplication_factor_to_convert_to_molecules_percm2")
fillvalue_qa = ncatt_get(nc,"PRODUCT/qa_value",
"_FillValue")
no2tc[no2tc == fillvalue$value] <- NA
no2tc <- no2tc * mfactor$value
qa[qa == fillvalue_qa$value] <- NA
nc_close(nc)
# rm(ncfname)
no2vec <- as.vector(no2tc)
latvec <- as.vector(lat)
lonvec <- as.vector(lon)
qavec <- as.vector(qa)
dfsat <- data.frame(no2vec, lonvec, latvec)
dfqa <- data.frame(qavec,lonvec,latvec)
colnames(dfsat) <- c('z', 'x', 'y')
colnames(dfqa) <- c('z', 'x', 'y')
df <- rbind(df, dfsat)
dfqa <- rbind(df,dfqa)
rm(lat,lon,no2tc,qa,latvec,lonvec,no2vec,qavec)
This is how I currently create the raster:
## Create the raster. The ncol = 3245 and now = 450 are from the scanline and ground_pixel variables.
e <- extent(-180,180,-90,90)
r <- raster(e, ncol = 3245, nrow = 450)
xx <- rasterize(df[, 2:3], r, df[, 1], fun = mean)
qa_raster <- rasterize(dfqa[, 2:3], r, df[, 1], fun = mean)
crs(xx) <- "+proj=longlat +datum=WGS84 +no_defs +ellps=WGS84 +towgs84=0,0,0"
crs(qa_raster) <- "+proj=longlat +datum=WGS84 +no_defs +ellps=WGS84 +towgs84=0,0,0"
## Crop and plot the raster
## change shapefile coordinate system
# border <- spTransform(ontario, crs(xx))
aoi <- spTransform(ontario_buffer, crs(xx))
## Mask values with qa < 0.5 (this is the recommended value)
xx[qa_raster < 0.5 & xx < 0] <- NA
## This is the final plot
plot_tif <- crop(xx, extent(aoi))
### Use this if you want to view the plot.
mask_tif <- mask(plot_tif,aoi)
# plot(mask_tif)
# final <- plot(border,add=TRUE)
## Plot the raster
filename <- paste(i,".tif",sep="")
writeRaster(mask_tif,filename = filename,"GTiff", overwrite=TRUE)
The end results looks something like this:
Then I tried another method I found online, but you have to set a resolution. I COULD do this, but I just want to plot the cells AS THEY ARE, without any modification.
ncfname <- "S5P_OFFL_L2__NO2____20200107T173517_20200107T191647_11582_01_010302_20200109T103930.nc"
nc <- ncdf4::nc_open(ncfname)
mfactor = ncdf4::ncatt_get(nc, "PRODUCT/nitrogendioxide_tropospheric_column","multiplication_factor_to_convert_to_molecules_percm2")
fillvalue = ncdf4::ncatt_get(nc, "PRODUCT/nitrogendioxide_tropospheric_column","_FillValue")
my_unit = ncdf4::ncatt_get(nc, "PRODUCT/nitrogendioxide_tropospheric_column","units")
my_product_name = ncdf4::ncatt_get(nc, "PRODUCT/nitrogendioxide_tropospheric_column", "long_name")
mfactor <- mfactor$value
fillvalue <- fillvalue$value
vals <- ncdf4::ncvar_get(nc, "PRODUCT/nitrogendioxide_tropospheric_column")
lat <- ncdf4::ncvar_get(nc, "PRODUCT/latitude")
lon <- ncdf4::ncvar_get(nc, "PRODUCT/longitude")
vals[vals == fillvalue] <- NA
vals_df = NULL
vals_df <- rbind(vals_df, data.frame(lat = as.vector(lat), lon = as.vector(lon), vals = as.vector(vals)))
pts <- vals_df
sp::coordinates(pts) <- ~lon + lat
my_projection <- "+proj=longlat +datum=WGS84 +no_defs +ellps=WGS84 +towgs84=0,0,0"
sp::proj4string(pts) <- sp::CRS(my_projection)
my_aoi <- ontario
crs_test <- raster::compareCRS(pts, my_aoi)
my_aoi <- sp::spTransform(my_aoi, CRS = as.character(raster::crs(pts)))
p <- methods::as(raster::extent(my_aoi), "SpatialPolygons")
sp::proj4string(p) <- sp::CRS(my_projection)
pts <- raster::crop(pts, p)
extent_distance_vertical <- geosphere::distm(c(raster::extent(pts)[1], raster::extent(pts)[3]), c(raster::extent(pts)[1], raster::extent(pts)[4]),
fun = geosphere::distHaversine)
vertical_mid_distance <- (raster::extent(pts)[4] - raster::extent(pts)[3])/2
lat_mid <- raster::extent(pts)[3] + vertical_mid_distance
horizontal_distance <- raster::extent(pts)[2] - raster::extent(pts)[1]
if (horizontal_distance > 180) {
one_degree_horizontal_distance <- geosphere::distm(c(1,
lat_mid), c(2, lat_mid), fun = geosphere::distHaversine)
extent_distance_horizontal <- one_degree_horizontal_distance *
horizontal_distance
} else {
extent_distance_horizontal <-
geosphere::distm(c(raster::extent(pts)[1],
lat_mid),
c(raster::extent(pts)[2], lat_mid),
fun = geosphere::distHaversine)
}
my_res <- 20000
ncol_rast <- as.integer(extent_distance_horizontal/my_res)
nrow_rast <- as.integer(extent_distance_vertical/my_res)
print(paste0("Create raster file from points"))
rast <- raster::raster(nrows = nrow_rast, ncols = ncol_rast,
crs = as.character(raster::crs(pts)), ext = raster::extent(pts),
vals = NULL)
final <- raster::rasterize(pts, rast, pts$vals, fun = mean)
final <- raster::mask(final, my_aoi)
sp::plot(final)
How can I create these raster layers accurately? Thanks!
With the example file
f <- "S5P_OFFL_L2__NO2____20200107T173517_20200107T191647_11582_01_010302_20200109T103930.nc"
You can do
library(terra)
r <- rast(f, paste0("/PRODUCT/", c("longitude", "latitude", "nitrogendioxide_tropospheric_column")))
r
#class : SpatRaster
#dimensions : 4172, 450, 3 (nrow, ncol, nlyr)
#resolution : 1, 1 (x, y)
#extent : -0.5, 449.5, -0.5, 4171.5 (xmin, xmax, ymin, ymax)
#coord. ref. :
#sources : longitude
# latitude
# nitrogendioxide_tropospheric_column
#varnames : longitude (pixel center longitude)
# latitude (pixel center latitude)
# nitrogendioxide_tropospheric_column (Tropospheric vertical column of nitrogen dioxide)
#names : longitude, latitude, nitrogendi~ric_column
#unit : degrees_east, degrees_north, mol m-2
#time : 2020-01-07
plot(r, nr=1)
The plot illustrates that the data are not organized as regular raster data (it they were, there would be a N-S gradient for latitude, and a E-W gradient for longitude). Also see plot(r$longitude, r$latitude). You can treat them as points in stead:
dp <- as.data.frame(r)
p <- vect(dp, geom=c("longitude", "latitude"))
Plotting takes a while, as there are > 1.5 million points, so I take a sample
plot(p[sample(nrow(p), 10000)], "nitrogendioxide_tropospheric_column")
If you want your data organized as a regular raster, you can use rasterize
x <- rast(res=1/6)
x <- rasterize(p, x, "nitrogendioxide_tropospheric_column", fun=mean)
plot(x > 0)
And you can get Ontario like this
can <- vect(raster::getData("GADM", country="CAN", level=1))
ontario <- can[can$NAME_1=="Ontario", ]
x <- crop(x, ontario)
x <- mask(x, ontario)
plot(x)
I am trying to extract grassland values from a historical land use and land cover database created by USGS. I have some issues with the Raster package and getValues option. The tiff file is too large to add with this post, but it is available online.
The data is available under Land-use and Land-cover Backcasting.
This is my code:
install.packages("raster")
install.packages("rastervis")
install.packages("RCurl")
install.packages("R.utils")
install.packages("rgdal")
install.packages("sp")
install.packages("maptools")
install.packages("tibble")
install.packages("ggplot2")
install.packages("gridExtra")
library(R.utils)
library(rgdal)
library(sp)
library(maptools)
library(raster)
library(rasterVis)
library(RCurl)
library(R.utils)
library(rgdal)
library('rgdal')
library('raster')
library("tibble")
library('ggplot2')
Landcover file in tiff format:
Landcover1 <- raster ("CONUS_Backcasting_y1938.tif")
USA counties file:
USA_county <- readOGR("UScounties",layer="UScounties")
These two files are not in the same projection, so projection:
newprojection <- "+proj=longlat +datum=WGS84 +no_defs +ellps=WGS84
+towgs84=0,0,0"
projected_raster_landcover1 <- projectRaster(Landcover1, crs =
newprojection)
Now, I want to extract the land cover data only for the grassland (there are total 17 land classes, and grassland is coded as '11')
Landcover1_values <- extract(x = projected_raster_landcover1,
y = USA_county)
But when I use getValues to extract the grassland,
Landcover1_values_count<- lapply(Landcover1_values, FUN = function(x) {
length(which(getValues(x) == 11)) })
it shows error:
**Error in (function (classes, fdef, mtable) :
unable to find an inherited method for function ‘getValues’ for signature ‘"numeric", "missing", "missing"’**
I thought it is for NA, but I could not get how to solve the problem.
extract returns a vector or a matrix while getValues needs a raster as input. It's why you have this error.
Therefore, this should work in your case:
Landcover1_values_count <- sum(Landcover1_values == 11, na.rm = T)
Having said that, I am not sure about the use of extract in your workflow. I think what you are looking for is to mask your raster. So I suggest you use:
Landcover1_values <- mask(projected_raster_landcover1, USA_county)
Landcover1_values_count <- sum(Landcover1_values[,] == 11, na.rm = T)
EDIT
According to your comment, what you really want is to perform a zonal statistics (the number of pixels labeled as grasslands (11) in each county). Here are some steps on how to do it:
library(raster)
library(plyr)
# Function for efficient zonal stats using data.table, source: https://stat.ethz.ch/pipermail/r-sig-geo/2013-February/017475.html
myZonal <- function (x, z, stat, digits = 0, na.rm = TRUE,
...) {
library(data.table)
fun <- match.fun(stat)
vals <- getValues(x)
zones <- round(getValues(z), digits = digits)
rDT <- data.table(vals, z=zones)
setkey(rDT, z)
rDT[, lapply(.SD, fun, na.rm = TRUE), by=z]
}
# Add an ID field to the shapefile
USA_county#data$ID <- c(1:length(USA_county#data[,1]))
# Crop raster to 'zone' shapefile extent
r <- crop(projected_raster_landcover1, extent(USA_county))
# Reclassify raster in binary raster with 1 for grasslands and 0 for all others values
r[r != 11] <- 0
r[r == 11] <- 1
# Rasterize shapefile using ID field
zone <- rasterize(USA_county, r, field="ID", dataType = "INT1U") # Change dataType if nrow(USA_county) > 255 to INT2U or INT4U
# Zonal stats
Zstat <- data.frame(myZonal(r, zone, "sum"))
colnames(Zstat) <- c("ID", "Grassland")
# Merge data
USA_county#data <- plyr::join(USA_county#data, Zstat, by="ID")
# Show results
USA_county#data
I'm trying to calculate the SPI from CHIRPS monthly mean precipitation data, because it's too large I cut it down to my area of interest and here it is: https://www.dropbox.com/s/jpwcg8j5bdc5gq6/chirps_mensual_v1.nc?dl=0
I did this to open it:
require(utils)
require(colorRamps)
require(RNetCDF)
require(rasterVis)
require(rgdal)
library(ncdf4)
library(raster)
datos2 <- nc_open("Datos/chirps_mensual_v1.nc")
ppt_array <- ncvar_get(datos2, "precip")
#I'm only taking complete years so I took out two months from 2018
ppt_mes <- ppt_array[ , ,1:444]
I know there is a SPI library but I don't know how should I format the data in order to use it. So I tried to do it without the function by fitting the gamma distribution but I dont' know how to do it for this data base.
Does anyone know how to calculate SPI either with the function or by fitting the distribution?
I don't think the SPI package is doing what you (or anyone) thinks it is doing. If you use debug(spi) and step through the code, you'll see that in one step it fits a empirical cumulative distribution function (with ecdf()) to the first two and last rows of data. Why the first two and last rows? I have no clue, but whoever wrote this package also used a for loop to do t() to a matrix. Not to mention that I think it should use a Gamma distribution or Pearson III distribution not ecdf() (according to Guttman, N.B. (1999) Accepting the standardized precipitation index: a calculation algorithm. JAWRA Journal of the American Water Resources Association, 35, 311–322.).
At the end I made it by using the SPI library, the result will be a value for each month in each grid point, if you want to calculate the value over a specific area I made that too but I can share it if you want it too:
Also, this one I made it using CRU data but you can adjust it:
#spei cru 1x1
rm(list=ls(all=TRUE)); dev.off()
require(utils)
require(RNetCDF)
require(rasterVis)
require(rgdal)
library(ncdf4)
require(SPEI)
########################################################################################################
prec <- open.nc("pre_mensual.nc")
lon <- length(var.get.nc(prec, "lon"))
lat <- length(var.get.nc(prec, "lat"))
lon1 <- var.get.nc(prec, "lon")
lat1 <- var.get.nc(prec, "lat")
ppt <- var.get.nc(prec, "pre")
ppt <- ppt[ , ,109:564] #31 18 456 (1980-2017)
anio = 456/12
###########################################################################################################
#Reshape data
precip <- sapply(1:dim(ppt)[3], function(x)t(ppt[,,x]))
############################################################################################################
#This is for SPI-6, you can use either of them
spi_6 <- array(list(),(lon*lat))
for (i in 1:(lon*lat)) {
spi_6[[i]] <- spi(precip[i,], scale=6, na.rm=TRUE)
}
#############################################################################################################
#Go back to an array form
sapply(spi_6, '[[',2 )->matriz_ppt
ppt_6 <- array(aperm(matriz_ppt, c(2,1),c(37,63,456)));spi_c <- array(t(ppt_6), dim=c(37,63,456))
#############################################################################################################
#Save to netcdf
for(i in 1:456) {
nam <- paste("SPI", i, sep = "")
assign(nam,raster((spi_c[ , ,i]), xmn=min(lon1), xmx=max(lon1), ymn=min(lat1), ymx=max(lat1), crs=CRS("+proj=longlat +ellps=WGS84 +datum=WGS84 +no_defs+ towgs84=0,0,0")) )
}
gpcc_spi <- stack(mget(paste0("SPI", 1:456)))
outfile <- "spi6_cru_1980_2017.nc"
crs(gpcc_spi) <- "+proj=longlat +datum=WGS84 +no_defs +ellps=WGS84 +towgs84=0,0,0"
writeRaster(gpcc_spi, outfile, overwrite=TRUE, format="CDF", varname="SPEI", varunit="units",longname="SPEI CRU", xname="lon", yname="lat")
It's not the most stylish way to calculate it but it does work. :)
EDIT: If you want to calculate the SPI/SPEI over an area this is what I did:
library(SPEI)
library(ncdf4)
library(raster)
#
pre_nc <- nc_open("pre_1971_2017_Vts4.nc")
pre <- ncvar_get(pre_nc, "pre")
pre <- pre[, , 109:564] #This is for the time I'm interested in
lats <- ncvar_get(pre_nc, "lat")
lons <- ncvar_get(pre_nc, "lon")
times <- 0:467
# Read mask
#This is a mask you need to create that adjusts to your region of interest
#It consist of a matrix of 0's and 1's, the 1's are placed in the area
#you are interested in
mask1 <- nc_open("cuenca_IV_CDO_05_final.nc")
m1 <- ncvar_get(mask1, "Band1")
m1[m1 == 0] <- NA
#
# Apply mask to data
#
pre1 <- array(NA, dim=dim(pre))
#
for(lon in 1:length(lons)){
for(lat in 1:length(lats)){
pre1[lon,lat,] <- pre[lon,lat,]*m1[lon,lat]
}
}
#
# Mean over the area of interest
#
mean_pre1 <- apply(pre1,c(3),mean, na.rm=TRUE)
# Calculate SPI/SPEI
spi1 <- matrix(data= NA, nrow = 456, ncol = 48)
for (i in 1:48) {
spi1[,i] <- spi(data=ts(mean_pre1,freq=12),scale= i)$fitted
}
#This calculates SPI/SPEI-1 to SPI/SPEI-48, you can change it
# Save
#
write.table(spi1,'spi_1980_2017.csv',sep=';',row.names=FALSE)
I have three SpatialPointsDataFrame objects that are actually just one point each. My intention is to make a raster for each of them with an extent that includes the point, in such a way that all cells but the point are "NA", so then I can use the distance() function in the package raster to generate a raster layer where the z value is the distance to the only cell in which z is not "NA".
My code works without problem with the first of the three objects, but the following error appears for the other two:
error in seq.default(zrng[1], zrng[2], length.out = cuts + 2) :
'from' cannot be NA, NaN or infinite
In addition: Warning messages:
1: In asMethod(object) :
complete map seems to be NA's -- no selection was made
2: In min(x) : no non-missing arguments to min; returning Inf
3: In max(x) : no non-missing arguments to max; returning -Inf
I have double and triple checked that my points are contained in the extent of the raster, and I really can't pinpoint the problem
Here's my code:
library(raster)
TIM <- data.frame()
TIM[1,1] <- -13.8309
TIM[1,2] <- 28.9942
VEN <- data.frame()
VEN[1,1] <- -15.7886
VEN[1,2] <- 27.8444
MCL <- data.frame()
MCL[1,1] <- -13.5325
MCL[1,2] <- 29.2914
coordinates(TIM) <- ~V1+V2
coordinates(VEN) <- ~V1+V2
coordinates(MCL) <- ~V1+V2
bb2 <- matrix(c(-20, -9.5, 20.5, 31.5), nrow = 2, ncol = 2, byrow = T)
bb2 <- extent(bb2)
r <- raster(nrows = 1217, ncols = 1047)
r <- setExtent(r, bb2, keepres=F)
rMCL <- rasterize(MCL, r)
spplot(rMCL)
#so far so good, but from now on it doesn't work
rVEN <- rasterize(VEN, r)
spplot(rVEN)
rTIM <- rasterize(TIM, r)
spplot(rTIM)
Edit: I have tried turning it to a SpatialGridDataFrame and I get to plot it but my point is not in the extent of the raster, i.e. the plot is empty. Code:
rr <- as(rTIM, "SpatialGridDataFrame")
spplot(rr)
#this produces an empty plot
I have also tried plotting it in a raster without a predetermined number of columns and rows, and it works:
r <- raster()
r <- setExtent(r, bb2, keepres=F)
rTIM <- rasterize(TIM, r)
spplot(rTIM)
# this produces a raster containing my point
The problem is, I really would need to set the resolution of the plot so each cell of the raster represents approx 1 squared km, which is what I get with the number of rows and columns I had previously used. Any ideas?
I can get it to work by adding all three sets of coordinates to the same dataframe and then using the count function when creating the raster:
library(raster)
# Add all 3 sets of coordinates to the same dataframe
df <- data.frame()
df[1,1] <- -13.8309
df[1,2] <- 28.9942
df[2,1] <- -15.7886
df[2,2] <- 27.8444
df[3,1] <- -13.5325
df[3,2] <- 29.2914
# Create new column in dataframe (we will use this for the count function)
df$x <- c(1,1,1)
# Convert to spatial points dataframe
df.sp <- df
coordinates(df.sp) <- ~ V1+V2
# Make raster
bb2 <- matrix(c(-20, -9.5, 20.5, 31.5), nrow = 2, ncol = 2, byrow = T)
bb2 <- extent(bb2)
r <- raster(nrows = 1217, ncols = 1047)
r <- setExtent(r, bb2, keepres=F)
# Rasterise using the count function
raster <- rasterize(df.sp, r, field= "x", fun="count")
# The table shows there are 3 cells with a value of 1 so it seems to have worked
table(values(raster))
1
3
spplot(raster)
raster
class : RasterLayer
dimensions : 1217, 1047, 1274199 (nrow, ncol, ncell)
resolution : 0.01002865, 0.00903862 (x, y)
extent : -20, -9.5, 20.5, 31.5 (xmin, xmax, ymin, ymax)
coord. ref. : +proj=longlat +datum=WGS84 +ellps=WGS84 +towgs84=0,0,0
data source : in memory
names : layer
values : 1, 1 (min, max)
The plot doesn't make a whole lot of sense to me but I think that's because you have a lot of cells in your raster so you can't really see anything. The values in the raster are definitely 3 cells with a value of 1 and all the rest are NA so I think this what you want.
I have a raster stack with 27 rasters in it. I have 27 corresponding polygons in a spatial polygon data frame. I want to take polygon[i] overlay it on raster[i], extract and sum the values from raster [i], get a count of the number of cells within the polygon[i] and then divide the sum value by the # of cells. In other words, the raster is a utilization distribution or a kernel density of use. I want to know much use is occurring in the area of the polygon where it is overlapping the raster. I want to divide by the number of cells in the polygon to take into account the size of the polygon.
I have a script that was given to me that does this, only it was written with the intention of extracting data from 1 raster only by any number of spatial polygons in the data frame. It works, its ugly, and I now would like to convert it to something more stream line. I only wish I had someone around me who could help because this might take a while?
This is code Ive been given and my summary of what I think is going on:
msum99Kern07 = SpatialPolygonDataFrame (many polygons)
KERNWolfPIX07m = Raster (this is a single raster, I have 27 rasters I put into a stack
)
#Extracting value from raster to many polygons
sRISK_Moose07m<- extract(KERNWolfPIX07m, msum99Kern07,df=FALSE,method='bilinear')
#Calculate THE SUM FOR EACH polygon#
sRISK_Moose07m<-unlist(lapply(sRISK_Moose07m, function(x) if (!is.null(x)) sum(x, na.rm=TRUE) else NA ))
sRISK_Moose07m<-as.data.frame(sRISK_Moose07m)
#Im not sure why these next commands are needed Im only guessing
#data.frame(levels) as there are many polygons creating a dataframe to put the info into
ID_SUM_07<-as.data.frame(levels(as.factor(msum07locs$ID2)))
#ADD ID TO THE risk data frame
sRISK_Moose07m$ID<-ID_SUM_07[,1]
#NUMBER OF CELLS WITHIN POLYGON EXTRACT CELLS/ POLYGON
NB_SUM2007m<-cellFromPolygon(KERNWolfPIX07m, msum99Kern07)
NB_SUM07m<-unlist(lapply(NB_SUM2007m, function(x) if (!is.null(x)) length(x) else NA ))
#####CONVERT TO DATA FRAME
NB_SUM07m<-as.data.frame(NB_SUM07m)
###ADD THE NB OF CELLS TO THE RISK_SUM FILE###
sRISK_Moose07m$NB_CELLS<-NB_SUM07m[,1]
###DIVIDING VALUE by NB CELLS##
sRISK_Moose07m$DIVID<-sRISK_Moose07m$sRISK_Moose07m/sRISK_Moose07m$NB_CELLS
Now, I have my spatial polygon data frame with 27 polygons and my raster stack with 27 rasters. I want to select the raster[i] and polygon[i] and extract, sum, and calculate the kernel density of the overlapping area. One side thing to keep in mind, I may get an error because it is possible that the polygon and raster do not overlap...I don't know how to check for this in R at all.
My script I have started:
moose99kern = spatial polygon data frame 27 moose
Rastwtrial = stack of 27 rasters having the same unique name as the ID in moose99kern
mkernID=unique(moose99kern$id)
for (i in length(mkernID)){
r = Rastwtrial[Rastwtrial[[i]]== mkernID[i]] #pick frm Rasterstack the raster that has the same name
mp = moose99kern[moose99kern$id == mkernID[i]] #pick from spatialpolygondataframe the polygon that has the same name
RISK_MooseTrial<- extract(r, mp, df=T, method'bilinear')
risksum = (RISK_MooseTrial, function(x) if (!is.null(x)) sum(x, na.rm=TRUE) else NA )#sum all the values that were extracted from the raster
My script doesn't even start to work because I don't know how to index a raster stack. But even still, going through 1 raster/1polygon at a time, Im not sure what to do next in the code. If this is too much for StackOverflow I apologize. Im just seriously stuck and have no where to turn.
Here is test data with 2 individuals for polygons
dput(mtestpoly)
new("SpatialPolygonsDataFrame"
, data = structure(list(id = structure(1:2, .Label = c("F01001_1", "F07002_1"
), class = "factor"), area = c(1259.93082578125, 966.364499511719
)), .Names = c("id", "area"), row.names = c("F01001_1", "F07002_1"
), class = "data.frame")
, polygons = list(<S4 object of class structure("Polygons", package = "sp")>,
<S4 object of class structure("Polygons", package = "sp")>)
, plotOrder = 1:2
, bbox = structure(c(6619693.77161797, 1480549.31292137, 6625570.48348294,
1485861.5586371), .Dim = c(2L, 2L), .Dimnames = list(c("x", "y"
), c("min", "max")))
, proj4string = new("CRS"
, projargs = NA_character_
dput(Rastwtest)
new("RasterStack"
, filename = ""
, layers = list(<S4 object of class structure("RasterLayer", package = "raster")>,
<S4 object of class structure("RasterLayer", package = "raster")>)
, title = character(0)
, extent = new("Extent"
, xmin = 1452505.6959799
, xmax = 1515444.7110552
, ymin = 6575235.1959799
, ymax = 6646756.8040201
)
, rotated = FALSE
, rotation = new(".Rotation"
, geotrans = numeric(0)
, transfun = function ()
NULL
)
, ncols = 176L
, nrows = 200L
, crs = new("CRS"
, projargs = NA_character_
)
, z = list()
, layernames = "Do not use the layernames slot (it is obsolete and will be removed)\nUse function 'names'"
)
Maybe I miss something , but I think you over complicated the problem. For me you have :
stack of raster : a list of raster : ss
a list of polygons of the same size as ss : polys
You need to apply extract for each pair(layer,poly) from (ss,polys)
sapply(1:nlayers(ss), function(i) {
m <- extract(ss[[i]],polys[i], method='bilinear', na.rm= T)[[1]]
d <- ifelse (!is.null(m) , sum(m)/length(m), NA)
d
})
Here an example of 2 legnths since you don't give a reproducible example :
## generate some data
library(raster)
cds1 <- rbind(c(-180,-20), c(-160,5), c(-60, 0), c(-160,-60), c(-180,-20))
cds2 <- rbind(c(80,0), c(100,60), c(120,0), c(120,-55), c(80,0))
## In your case you need something like SpatialPolygons(moose99kern)
polys <- SpatialPolygons(list(Polygons(list(Polygon(cds1)), 1),
Polygons(list(Polygon(cds2)), 2)))
r <- raster(ncol=36, nrow=18)
r[] <- 1:ncell(r)
r1 <- raster(ncol=36, nrow=18)
r1[] <- seq(-1,-2,length.out=ncell(r1))
ss <- stack(r,r1)
## density compute
sapply(1:nlayers(ss), function(i) {
## sum of values of the cells of a Raster ss[[i]] covered by the poly polys[i]
m <- extract(ss[[i]],polys[i], method='bilinear', na.rm= T)[[1]]
d <- ifelse (!is.null(m) , sum(m)/length(m), NA)
})
[1] 387.815789 -1.494714
When you are asking questions about R, always use simple reproducible examples, not your own data; unless perhaps what you want to do works for such an example, but not for your data, but then still show the example that works and the error message you are getting. You can typically start with the examples in the help files, as in below from ?extract
r <- raster(ncol=36, nrow=18)
r[] <- 1:ncell(r)
s <- stack(r, r*2)
cds1 <- rbind(c(-180,-20), c(-160,5), c(-60, 0), c(-160,-60), c(-180,-20))
cds2 <- rbind(c(80,0), c(100,60), c(120,0), c(120,-55), c(80,0))
polys <- SpatialPolygons(list(Polygons(list(Polygon(cds1)), 1),
Polygons(list(Polygon(cds2)), 2)))
v <- extract(s, polys, small=TRUE)
#cellnumbers for each polygon
sapply(v, NROW)
# mean for each polygon
sapply(v, function(x) apply(x, 2, mean, na.rm=T))
the functions in sapply need to be refined if some of your polgyons our outside of the raster (i.e. returning NULL, but the "small=TRUE" option should avoid problems with very small polygons inside the raster. Also note that there is no "method" argument when extracting with SpatialPolygon* objects.
Do not use a loop, unless to prevent memory problems if you have very many cells for each polygon.