I have a raster layer that has values as factors, and an attribute table. I would like to convert this to a SpatialPixelsDataFrame however when I try:
library(sp)
library(sf)
library(rgdal)
library(raster)
library(FedData)
library(rasterVis)
create_factor_rast <- function(base_rast,Spatial_polygon,fieldname) {
nam <- unique(Spatial_polygon[[fieldname]])
nam_df <- data.frame(ID = 1:length(nam), nam = nam)
idfieldname = paste0(fieldname,"ID")
Spatial_polygon[[idfieldname]] <- nam_df$ID[match(Spatial_polygon[[fieldname]],nam_df$nam)]
new_raster <- rasterize(x=Spatial_polygon, y=base_rast, field = idfieldname)
new_raster <- ratify(new_raster)
# # Create levels
rat <- levels(new_raster)[[1]]
rat$names <- nam_df$nam
rat$IDs <- nam_df$ID
levels(new_raster) <- rat
new_raster
}
spft <- "+proj=lcc +lat_1=40 +lat_2=43 +lat_0=39.83333333333334 +lon_0=-100 +x_0=500000.0000000002 +y_0=0 +datum=NAD83 +units=us-ft +no_defs"
SSURGO.dl <- FedData::get_ssurgo(template=c('NE043'), label = "Tau",raw.dir = "./SSURGO_r/RAW/SSURGO",
extraction.dir = paste0("./SSURGO_R/EXTRACTIONS/", "soils","/SSURGO"))
SSURGO.dl_shp<-SSURGO.dl$spatial
unlink('SSURGO_r',recursive=TRUE)
# extract the muaggatt table
muaggatt<-SSURGO.dl[["tabular"]][["muaggatt"]]
# get only the fields needed, must have mukey to do the join
muaggatt <- muaggatt[c("mukey","hydgrpdcd","drclassdcd")]
SSURGO_merge <- merge(SSURGO.dl_shp,muaggatt,by.x = "MUKEY", by.y="mukey")
# Convert merged SSURGO polygon to Stateplane feet
SSURGO_merge <- sf::st_transform(SSURGO_merge,crs(spft))
SSURGO_merge <- as(SSURGO_merge,"Spatial")
grid_cell_size <- 100 # ~30 meters
shp_extent <- extent(SSURGO_merge)
r <- raster(SSURGO_merge,resolution = grid_cell_size,crs=crs(SSURGO_merge))
r.drclassdcd <- create_factor_rast(r, SSURGO_merge,'drclassdcd')
rasterVis::levelplot(r.drclassdcd)
r.drclassdcd_sp <- as(r.drclassdcd,"SpatialPixelsDataFrame")
The last line gives the following error:
Error in h(simpleError(msg, call)) :
error in evaluating the argument 'x' in selecting a method for function 'as.factor': undefined columns selected
Is there a way to get a pixel dataframe from the raster layer with factors converted back to the characters in the attribute field?
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 have this dataframe in R:
library(raster)
# create a random dataframe with yearly values for each column
df <- data.frame(year = seq(1981,2012), a = runif(32,1,33), b = rnorm(32, 6, 18), c = rnorm(32, 3, 12),
d = rnorm(32, 0, 18))
and then this multilayer raster:
rs <- stack()
for (i in 1:1:32){
xy <- matrix(rnorm(400),20,20)
# Turn the matrix into a raster
rast <- raster(xy)
# Give it lat/lon coords for 20-30°E, 43-49°N
extent(rast) <- c(20,30,43,49)
rs <- addLayer(rs, rast)
}
# create a Z field for raster just created
years <- seq(as.Date("1981-01-01"), as.Date("2012-12-31"), by = "years")
aa <- setZ(rs, years)
names(rs) <- years
My question is: how would it be possible to obtain five rasters representing the correlation (let's say Spearman) between each column in dataframe df and the raster stack rs?
Thank you all for your help!
I am not sure what exactly you want to do. There are 32 values in each column of df, and 32 layers with 400 values in the RasterStack,
Perhaps you are looking for the correlation of the columns in df and the mean value of the layers? That you can do like this:
Your data
set.seed(0)
df <- data.frame(year = seq(1981,2012), a=runif(32,1,33), b=rnorm(32, 6, 18), c=rnorm(32, 3, 12), d=rnorm(32, 0, 18))
r <- raster(nrow=20, ncol=20, ext=extent(20,30,43,49))
rs <- stack(lapply(1:32, function(i) setValues(r, rnorm(400,20,20))))
years <- seq(as.Date("1981-01-01"), as.Date("2012-12-31"), by = "years")
names(rs) <- years
Solution
x <- cellStats(rs, mean)
sapply(2:5, function(i) cor(x, df[,i]))
#[1] 0.123391584 -0.007801092 -0.124336155 0.060774465
Well, I figured out a solution; don't know if is the best but I think is working.
Here is the example for column a from df; I created a dummy raster layer for each row in column a; after that, I used corLocal to have the correlation:
### create a raster layer for each row (year) for column 'a' in df
rs.r <- stack()
library(data.table)
### extract x and y coordinates for raster rs to create a raster stack
cord <- rasterToPoints(rs[[1]], spatial = F)
cord<- cord[,1:2]
head(cord)
### create a raster where each layer is the value in column a from df
year.s <- unique(df$year)
for (i in 1:length(df$year)){
print(df$year[i])
re <- df$a[df$year==year.s[i]]
c <- data.table(x = cord[,1], y = cord[,2], tt = re)
m <- rasterFromXYZ(c)
crs(m) <- "+proj=longlat +datum=WGS84 +ellps=WGS84 +towgs84=0,0,0 "
rs.r <- addLayer(rs.r, m)
crs(rs.r) <-" +proj=longlat +datum=WGS84 +ellps=WGS84 +towgs84=0,0,0"
}
names(rs.r) <- df$year ### set the names for the layers
ext <- extent(rs)
rs.r <- setExtent(rs.r, ext)
rs.r<- projectRaster(rs.r, rs,method = 'ngb')
spplot(corLocal(rs.r, rs, 'spearman'))
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 am currently trying to extract rainfall data from Mexico from the CHIRPS database. The goal is to get a comprehensive database of monthly rainfall over a period of 15 years. This involves merging a lot of columns after extracting the data from .tif-files which contain the information on weather conditions in a specific months.
CVE_ENT and CVE_MUN are the two variables that later on help me to identify individual municipalities.
Running my code in R and looking at the resulting data frame everything looks fine. However, as soon as I try to extract it to become a .dta or .csv file, I get the following error message:
fwrite(vextractall, file="rainfall55.csv")
Error in fwrite(vextractall, file = "rainfall55.csv") :
Column 4's length (1) is not the same as column 1's length (2456)
The error occurs for multiple other scenarios e.g. if using write.dta.
Anyone who possibly knows on what I am missing out on?
Thanks a lot in advance.
#Data get methods#
tif.raster1 <- raster('chirps-v2.0.1999.01.tif')
crs.LL <- "+proj=longlat +datum=WGS84 +no_defs +ellps=WGS84"
tif.raster1 <- projectRaster(tif.raster1, crs = crs.LL)
mexico2shp <- readOGR(dsn='GIS Mexican Municipalities', layer='Mexican Municipalities')
tif.raster1 <- crop(tif.raster1, extent(mexico2shp))
vras.tif1 <- velox(tif.raster1)
iters <- nrow(mexico2shp)
#mapping function#
vextractall <- vras.tif1$extract(mexico2shp, fun=mean)
mexicomm <- as.data.frame(mexico2shp)
vextractall <- as.data.frame(vextractall)
iters <- nrow(mexico2shp)
x <- foreach(a=1:iters) %do% {
if(is.na(vextractall[a,1])) {
ext <- raster::extract(tif.raster1, mexico2shp[a,], fun=mean)
vextractall[a,1] <- ext[1,1]
}
}
vextractall<-as.data.frame(vextractall)
vextractall$CVE_ENT <- mexicomm[,c("CVE_ENT")]
vextractall$CVE_MUN <- mexicomm[,c("CVE_MUN")]
vextractall<-vextractall[,c(ncol(vextractall), 1:(ncol(vextractall)-1))]
vextractall<-vextractall[,c(ncol(vextractall), 1:(ncol(vextractall)-1))]
vextractall <- plyr::rename(vextractall, c("V1"="Milimeters011999"))
tif.raster1 <- raster('chirps-v2.0.1999.02.tif')
tif.raster1 <- crop(tif.raster1, extent(mexico2shp))
vras.tif1 <- velox(tif.raster1)
crs.LL <- "+proj=longlat +datum=WGS84 +no_defs +ellps=WGS84"
tif.raster1 <- projectRaster(tif.raster1, crs = crs.LL)
vextract2 <- vras.tif1$extract(mexico2shp, fun=mean)
vextract2 <- as.data.frame(vextract2)
iters <- nrow(mexico2shp)
foreach(a=1:iters) %do% {
if(is.na(vextract2[a,1])) {
ext <- raster::extract(tif.raster1, mexico2shp[a,], fun=mean)
vextract2[a,1] <- ext[1,1]
}
}
vextractall<-as.data.frame(vextractall)
vextract2<-as.data.frame(vextract2)
vextractall$Milimeters021999 <- vextract2
SO-gurues!
I am trying to count the densities of surviving units in different gridcells.
I have two shapefiles with points from the two survey periods in question (one before and one after the mortality event). What I intend is to see whether there is a difference in survival rates and link the proportion of survival to any climatic variable obtained from the raster value of the desired grid. In the code snippet below I have created some random raster and shapefiles.
packs = c('raster', 'rgdal', 'spatstat', 'sp' ,'dplyr')
sapply(packs, FUN = 'require', character.only = TRUE)
xy <- matrix(rnorm(1024),32,32) #Creating the desired raster
image(xy)
rast <- raster(xy)
extent(rast) <- c(36,37,-3,-2)
projection(rast) <- CRS("+proj=longlat +datum=WGS84")
points <- runifpoint(n =4000, c(36,37,-3,-2)) # Creating the points
x <- points$x
y <- points$y
values <- c(rep(1, 900), rep(0, 3100))
xy <- cbind(x, y)
points <- cbind(x, y, values)
points <- data.frame(points)
shp <- SpatialPointsDataFrame(coords = xy, data = data.frame(values) ) # creating shpfiles
projection(shp) <- CRS("+proj=longlat +datum=WGS84")
subs <- filter(points, values == 1)
suxy <- select(subs, x,y)
shpsub <- SpatialPointsDataFrame(coords = suxy, data = data.frame(subs$values)) # creating shpfiles
projection(shpsub) <- CRS("+proj=longlat +datum=WGS84")
When I attempt to extract the points I use the following lines of code
shp <- spTransform(shp, projection(rast)) # make sure they have same transformation
shpsub <- spTransform(shpsub, projection(rast))
XY <- xyFromCell(rast, cell = 1:ncell(rast))
v <- as.data.frame(rast) #Extract values from raster
XY <- data.frame(XY, v) # Creating a data frame containing coord., cellno and value
XY$cell <- c(1:ncell(rast))
cells <- cellFromXY(rast,shp) # find which cells the points are in
cells <- rle(cells) # returns a value and a length, fast for counting
cellsfound <- cellFromXY(rast,shpsub)
cellsfound <- rle(cellsfound)
Proportion <- data.frame(cell = cells$values, shp = cells$lengths)
test <- data.frame(cell = rep(NA,NROW(Proportion)), shpsub = rep(NA, NROW(Proportion)))
test$cell <- c(cellsfound$values, rep(NA, nrow(test) - length(cellsfound$values)))
test$shpsub <- c(cellsfound$lengths, rep(NA, NROW(test) - length(cellsfound$lengths)))
Proportion <- full_join(Proportion, test, by = "cell")
test.Proportion <- mutate(Proportion, Proportion = shpsub/shp) #Calculating Proportion
XY <- left_join(XY, test.Proportion, by = "cell") # Adding Proportion to coord and cell no.
XY.m <- summarise(XY, )
XY <- na.omit(XY) ; XY <- XY[,-4]
As I see it. Using rle() returns the same cells multiple times instead of counting the no of points within each individual cell as was my intention. Can anyone please explain me how to do this in a way that retrieves the information on the number of occurrences in the individual cells?