I'm trying to plot rainfall data from weather radar. Data file is 900x900 points matrix (900x900km). Projection informations from original cappi file:
<projection lat_lr="48.133400" lat_ul="56.186500" type="aeqd" lon_lr="25.157600" size_x="900" size_y="900" lon_ul="11.812900">
<lon_0>19.092600</lon_0>
<lat_0>52.346800</lat_0>
<ellps>+ellps=sphere</ellps>
</projection>
I'm reading data file (example: https://meteomodel.pl/examples/out.txt ) to matrix, and convert to raster:
a1 = as.matrix(read.table("/home/user/out.txt", header=F, as.is=TRUE))
a1[a1==0] <- NA
maxDBz <- 95.5
minDBz <- -31.5
step <- (maxDBz - minDBz) / 254
a1 <- minDBz + (a1 * step)
r <- raster(a1)
Then I'm trying to set extent and CRS:
e <- extent(11.812900, 25.157600, 48.133400, 56.186500)
r <- setExtent(r, e)
crs(r) <- "+proj=aeqd +lat_0=52.346800 +lon_0=19.092600 +x_0=900 +y_0=900 +ellps=sphere +datum=WGS84 +units=km +no_defs"
Data are plotted, however projection is incorrect:
https://meteomodel.pl/examples/Rplot01.png
Correct image from Polish Institute of Meteorology and Water Management:
https://meteomodel.pl/examples/cappi.png
What am I doing wrong?
What you are doing wrong is setting the extent using lon/lat crs, whereas the data have "+proj=aeqd. These need to match.
I do not know what the correct extent is, but you can approximate it like this:
p <- "+proj=aeqd +lat_0=52.346800 +lon_0=19.092600 +x_0=900 +y_0=900 +ellps=sphere +datum=WGS84 +units=km +no_defs"
e <- extent(11.812900, 25.157600, 48.133400, 56.186500)
r <- raster()
extent(r) <- e
rr <- projectExtent(r, p)
extent(rr)
#class : Extent
#xmin : -541.0182
#xmax : 452.2122
#ymin : -488.8849
#ymax : 431.1854
The txt file provided sugests that the extent you want is
e <- extent(-449997.470, 451000.522, -451003.637, 449998.274)
And that suggests that the units in your crs should be m, not km
p <- "+proj=aeqd +lat_0=52.346800 +lon_0=19.092600 +x_0=900 +y_0=900 +ellps=sphere +units=m "
Related
I want to plot the utilization distributions of two animals on a spatial map background and calculate area overlap. However, for some reason, although both layers have the same projection, one is off (plotted too far to the east). Consequently, any overlap I calculate then is incorrect.
So my question is what causes this issue and how can I fix this?
Below are my two rasters, transformed to SpatialPolygons so that I could use gIntersection() to calculate overlap. Note that while p1 plots just fine, p2 does not.
p1 <- class : SpatialPolygons
features : 549
extent : 667950.6, 672950.6, 2840181, 2853981 (xmin, xmax, ymin, ymax)
coord. ref. : +proj=utm +zone=17 +datum=WGS84 +units=m +no_defs
p2 <- class : SpatialPolygons
features : 257
extent : 670158.7, 673958.7, 2839623, 2851623 (xmin, xmax, ymin, ymax)
coord. ref. : +proj=utm +zone=17 +datum=WGS84 +units=m +no_defs
Below pic shows how the polygons are currently plotted. p1 is depicted in green, and p2 is in red.
Desired plotting location for p2 should look like this (this plot is created in ggplot2 from the same raster file):
I thought maybe it was because the extents are so different. So I extended the areas of both rasters to the same extent, after which I converted them to polygons and plotted. But this does not solve anything.
EDIT: rasters r1 and r2 that can be converted to SpatialPolygons using as(x, 'SpatialPolygons') can be downloaded here and here.
EDIT 2: The crs for both rasters should be:
"+proj=utm +zone=17 +datum=WGS84 +units=m +no_defs"
EDIT 3: If it helps, the two rasters in question were generated by combining 2 sub-region rasters (central and north) after first extending the spatial extents of each raster to the spatial extent shared by both rasters and then rescaling to range from 0 to 1. However, some other rasters (not included here) are made up from 3 sub-region rasters. I don't know why this could matter, as the projections of the rasters are the same, so therefore should lead to correct spatial plots?
EDIT 4: Region rasters that were used to create r1 can be downloaded here and here. Similarly, region rasters for r2 are here and here.
EDIT 5: Below the code that i used to generate the output. Sorry for not introducing this earlier. r1 and r2 provided in the links are identical to r1.recl and r2.recl where the 0's have been replaced by NA.
library(magrittr)
aeqd.crs <- "+proj=aeqd +lat_0=25.6871 +lon_0=-79.29336 +x_0=0 +y_0=0 +datum=WGS84 +units=m +no_defs" #aeqd is original CRS
UTMstring <- "+proj=utm +zone=17 +datum=WGS84 +units=m +no_defs" # crs of study site shapefile
r1 = raster("r1")
proj4string(r1) <- CRS(aeqd.crs)
r1 %<>% raster::setMinMax()
r1 <- projectRaster(r1, crs = UTMstring)
r1[is.na(r1)] <- 0
r1 <- r1 / max(r1#data#values)
recl <- matrix(data = c(0, 0.05, 0,
0.05, 1, 1), ncol = 3, byrow = T)
r1.recl <- reclassify(r1, recl)
r1.recl[r1.recl == 0] <- NA
r2 = raster("r2")
proj4string(r2) <- CRS(aeqd.crs)
r2 %<>% raster::setMinMax()
r2 <- projectRaster(r2, crs = UTMstring)
r2[is.na(r2)] <- 0
r2 <- r2 / max(r2#data#values)
r2.recl <- reclassify(r2, recl)
r2.recl[r2.recl == 0] <- NA
# convert rasters to spatial polygons; vector shapes give access to spatial tools in the {rgeos} package
p1 <- as(r1.recl, 'SpatialPolygons')
p2 <- as(r2.recl, 'SpatialPolygons')
overlap <- gIntersection(p1, p2) # Creates raster
# Calculate common area
plot(p1, col = "green")
plot(p2, col = "red", add = TRUE)
plot(overlap, col = "orange", add = TRUE)
# calculate area of overlap (in m2)
common.area <- gArea(overlap) / (1000^2)
common.area
[1] 92716.54
Here are two approaches to compute overlap with your data.
Your data
library(terra)
prj <- "+proj=utm +zone=17 +datum=WGS84 +units=m +no_defs"
r1 <- rast("r1.asc")
crs(r1) <- prj
r2 <- rast("r2.asc")
crs(r2) <- prj
The "raster" approach
e <- union(ext(r1), ext(r2))
x1 <- extend(r1, e)
x2 <- resample(r2, x1) + 1
y <- sum(c(x1, x2), na.rm=TRUE)
a <- cellSize(y)
zonal(a, y, "sum")
# sum area
#1 1 21881870.89
#2 2 10200711.13
#3 3 80006.73
Where "1" is the area covered by species r1, "2" by r2 and "3" by both.
You can also assume a fixed nominal resolution. In this case that is only a little less precise (but that is not always the case)
f <- freq(y)
f$area <- f$count * prod(res(y))
f[,-1]
# value count area
#1 1 547 21880000
#2 2 255 10200000
#3 3 2 80000
The "vector" approach
p1 <- as.polygons(r1)
p2 <- as.polygons(r2)
p <- union(p1, p2)
p$area <- expanse(p)
data.frame(p)
# r1 r2 area
#1 1 1 92724.32
#2 1 NA 21869156.44
#3 NA 1 10187993.21
You could also do
intersect(p1, p2) |> expanse()
#[1] 92724.32
The results are similar for the raster and vector approach, but not the same. This is because the raster data are not aligned, which suggests that you could improve how these were created.
Plotting the two species shows the same pattern you have
p1$sp <- "1"
p2$sp <- "2"
p <- rbind(p1, p2)
plot(p, "sp")
And I can more-or-less reproduce r1 and r2 (but I need to guess things, in the future please describe your procedures with code, not with natural language) :
bn = rast("bull_North.asc")
bs = rast("bull_South.asc")
rn = rast("reef_North.asc")
rs = rast("reef_South.asc")
b2 = bn + bs
r2 = rn + rs
e <- intersect(ext(b2), ext(r2))
b <- crop(b2, e)
r <- crop(r2, e)
b <- ifel(b>0.05, 1, NA)
r <- ifel(r>0.05, 1, NA)
plot(b, col="blue")
plot(r, col="red", add=TRUE)
So, clearly the problem is already present in the original data.
Hi am trying to extract values for xy point from a sample raster stack ras_dt. The ras_dt is EQUATES data with gridded coordinates within the domain of -115.00,38.00,-110.05,45.00. How can I change the projection and the lat lon coordinates of this raster stack so that I can extract data for point xy as in the code below.
library(raster)
dturl<- "https://www.dropbox.com/s/ztxqpszjfjhpavz/EQUATES_ACONC_O3_SAM.nc?dl=1"
download.file(dturl, "EQUATES_ACONC_O3_SAM.nc")
ras_dt <- raster::stack("EQUATES_ACONC_O3_SAM.nc",varname = "O3")
ras_dt
# the data domain is -115.00,38.00,-110.05,45.00
plot(ras_dt)
xy <- data.frame(lon=-113.0,lat=40.0)
coordinates(xy) <- ~lon + lat
extr_dt <- raster::extract(ras_dt, xy) # how to get O3 values for xy here?
extr_dt
The ras_dt is in "lambertConformalProjection" with following info:
char LambertConformalProjection;
:grid_mapping_name = "lambert_conformal_conic";
:latitude_of_projection_origin = 40.0; // double
:longitude_of_central_meridian = -97.0; // double
:standard_parallel = 33.0, 45.0; // double
:earth_radius = 6370000.0; // double
:_CoordinateTransformType = "Projection";
:_CoordinateAxes = "x y";
You need to set the extent and the coordinate reference system (CRS). Then transform your lon/lat points to that CRS and use extract. From your edited question we now have the CRS.
You specify the "domain", but you need to coordinates in the actual CRS. I do not know what these are, so I will guestimate it, but it will not be correct.
The data
library(terra)
dturl<- "https://www.dropbox.com/s/ztxqpszjfjhpavz/EQUATES_ACONC_O3_SAM.nc?dl=1"
download.file(dturl, "EQUATES_ACONC_O3_SAM.nc", mode="wb")
ras_dt <- rast("EQUATES_ACONC_O3_SAM.nc", "O3")
pcrs <- "+proj=lcc +lon_0=-97 +lat_0=40 +lat_1=33 +lat_2=45 +r =6370000.0"
Rough estimate of the extent:
v <- vect(rbind(c(-115, 38), c(-115, 45), c(-110.05, 38), c(-110.05, 45)), crs="+proj=longlat")
p <- project(v, pcrs)
e <- crds(p) |> apply(2, range) |> as.vector()
e
#[1] -1562368.5 -1025418.3 -139104.3 693662.9
Set the extent and the crs
ext(ras_dt) <- e
crs(ras_dt) <- pcrs
Transform the points to the crs of the raster
xy <- vect(cbind(lon=-113.0,lat=40.0), crs="+proj=longlat")
pxy <- project(xy, pcrs)
And extract
extract(ras_dt, pxy)
# ID O3_LAY=1_TSTEP=1 O3_LAY=1_TSTEP=2
#1 1 41.88482 40.99662
So our raster now looks like this. The spatial resolution should probably be a round number (12,000?)
ras_dt
#class : SpatRaster
#dimensions : 70, 45, 2 (nrow, ncol, nlyr)
#resolution : 11932.23, 11896.67 (x, y)
#extent : -1562369, -1025418, -139104.3, 693662.9 (xmin, xmax, ymin, ymax)
#coord. ref. : +proj=lcc +lat_0=40 +lon_0=-97 +lat_1=33 +lat_2=45 +x_0=0 +y_0=0 +datum=WGS84 +units=m +no_defs
#source : EQUATES_ACONC_O3_SAM.nc:O3
#varname : O3 (O3 )
#names : O3_LAY=1_TSTEP=1, O3_LAY=1_TSTEP=2
#unit : ppbV , ppbV
Can you find and provide the correct extent somewhere in the documentation? And perhaps ask the data providers to follow the NetCDF conventions such that all the metadata required to use the data is stored in the files.
Goal: Extract the area in km2 of pixels that have values > 2 within a polygon. Values are not reflecting real country areas.
library(sf)
library(raster)
library(exactextractr)
# Generate raster
r <- raster::raster(matrix(0:7, ncol=10), xmn=0, ymn=0, xmx=10, ymx=10)
poly <- sf::st_as_sfc('POLYGON ((2 2, 7 6, 4 9, 2 2))')
#In my case I need a CRS that is valid for multiple countries in the Americas and allows me to estimate area in km2- epsg:3857
crs(r) <- "+proj=merc +a=6378137 +b=6378137 +lat_ts=0.0 +lon_0=0.0 +x_0=0.0 +y_0=0 +k=1.0 +units=m +nadgrids=#null +wktext +no_defs"
poly<-st_set_crs(poly,"+proj=merc +a=6378137 +b=6378137 +lat_ts=0.0 +lon_0=0.0 +x_0=0.0 +y_0=0 +k=1.0 +units=m +nadgrids=#null +wktext +no_defs")
#Extract area of pixels that have values > 2. This is in particular what I'm interested in, is my function argument doing what I say it does.
ext<-exact_extract(r,poly,function(values, coverage_fraction)
length(values > 2)) #6 values
#Determine pixel size
res(r) #1 10
res.m2<-10
res.km2<-res.m2/1000000
#Determine area in km2:multiply number of pixels >2 by the pixel area
tot.area<-res.km2*ext
Your statement that you
need a CRS that is valid for multiple countries in the
Americas and allows me to estimate area in km2- epsg:3857
seems based on the common misconception that you cannot use longitude/latitude data to determine area sizes (here is some discussion).
In fact, longitude/latitude is a great coordinate reference system to measure area. You can use some projections (planar coordinate reference systems), but most projections distort area. So if you were to use one, you would need to use an equal-area projection (e.g. cylindrical equal-area).
Do not use the Mercator projection ("+proj=merc +a=6378137 +b=6378137, epsg:3857). Mercator conserves shape, and that is why it is used in web-mapping. It also makes Greenland larger than Africa; and you cannot use it to compute area. More discussion here
It is generally best to not project raster data (there is quality loss). So here are some very similar work-flows that avoid that. First with terra and then with raster and exactextractr that compute what you are after.
Example data
library(terra)
p <- vect('POLYGON ((2 2, 7 6, 4 9, 2 2))')
r <- rast(nrows=10, ncols=10, xmin=0, ymin=0, xmax=10, ymax=10)
r <- init(r, -2:7)
Compute area of each cell and combine with the values used
a <- cellSize(r, unit="km")
ra <- c(r, a)
names(ra) <- c("values", "area")
Extract, subset, and computed sum
e <- extract(ra, p, exact=TRUE)
e <- e[e$values>2, ]
sum(e$area * e$fraction)
# [1] 44069.83
Alternatively
x <- ifel(r>2, r, NA)
a <- cellSize(r, unit="km")
ax <- mask(a, x)
ee <- extract(ax, p, exact=TRUE)
sum(ee$area * ee$fraction, na.rm=TRUE)
#[1] 44069.83
With raster you can do something similar
library(raster)
rr <- raster(nrows=10, ncols=10, xmn=0, ymn=0, xmx=10, ymx=10)
values(rr) <- rep(-2:7, 10)
ps <- sf::st_as_sfc('POLYGON ((2 2, 7 6, 4 9, 2 2))')
ps <- as(ps, "Spatial")
crs(ps) <- crs(rr)
aa <- area(rr)
s <- stack(aa, rr)
names(s) <- c("area", "values")
v <- extract(s, ps, exact=TRUE, weights=TRUE, normalizeWeights=FALSE)
v <- as.data.frame(v[[1]])
v <- v[v$values > 2, ]
sum(v$area * v$weight)
# [1] 44056.61
Explicitly calling exactextractr
ext <- exactextractr::exact_extract(s, ps)
ext <- ext[[1]]
ext <- ext[ext$values > 2, ]
sum(ext$area * ext$coverage_fraction)
#[1] 44056.61
Here is a nice way in which you can use exactextractr
w <- rr > 2
ext <- exactextractr::exact_extract(aa, ps, weights=w, fun="weighted_sum")
ext
# [1] 44056.61
I'm tring to extract pixels values from raster by intersct with SPDF (SpatialPolygonsDataFrame), but gives an error:
library(rgeos)
library(raster)
I have to do the same with some other rasters and SPDF similar to those in the summaries below:
My SPDF:
rings<-readOGR("SPDF.shp")
sumarry(SPDF)
Object of class SpatialPolygonsDataFrame
Coordinates:
min max
x -73.99045 -44.241589
y -18.04159 5.271841
Is projected: FALSE
proj4string : [ +proj=longlat +ellps=GRS80 +towgs84=0,0,0,0,0,0,0 +no_defs]
Data attributes:
Hectares
Min. : 52
1st Qu.: 31110
Median : 141736
Mean : 442267
3rd Qu.: 531011
Max. :4203563
My raster data :
ras_PI<-raster("ras_PI.tif")
ras_PI
class : RasterLayer
dimensions : 86662, 111765, 9685778430 (nrow, ncol, ncell)
resolution : 0.0002689995, 0.0002690002 (x, y)
extent : -73.97832, -43.91358, -18.04061, 5.271491 (xmin, xmax, ymin, ymax)
crs : +proj=longlat +ellps=GRS80 +towgs84=0,0,0,0,0,0,0 +no_defs
source : C:/Users/kleds/OneDrive/Documentos/mestrado/PRODES_APs/pAP_PI.tif
names : pAP_PI
values : 0, 1 (min, max)
Here begins my code:
dirs<-"~/prodes/PRODES_APs"
work_dirs<-"~/prodes/PRODES_APs"
#Create a for to define the rasters directory, and to be used in the subsequent for
for (m in 1:length(dirs)) {
files<-file.path(dirs[m],list.files(path = dirs[m], pattern = ".tif"))
nomes <- list.files(path = dirs[m], pattern = ".tif")
nomes <- substr(nomes,1,nchar(nomes)-4)
}
#create a for to call simultaneously raster layer of interest, and each SPDF (initial polygons, rings and control)
#vectors to use in the for
AP<-c("PI","TI","UN","US")
AW <- c("arc","wood")
km<-c("min","1km_","2km_","3km_","4km_","5km_","6km_","7km_","8km_","9km_",10km_,"10km","20km","30km","40km","50km","60km","70km", "controle")
#empty Data Frame to save my results
results<-data.frame()
for (a in 1:(min(length(files), length(AP)))){
setwd(work_dirs)
r<-files[a]
i<- AP[a]
map<- raster(r)
for(k in AW){
for(j in km){
# deffine the directory
setwd(paste0("~/prodes/buff_",k,"/AP_rings"))
getwd()
# Call each SPDF
SPDF<- readOGR(".", paste0("ring",k,j, i))
names(SPDF)[names(rings) == "X__i__"] <- "TIPO"
# reproject the SPDF to ALbers
rings <- spTransform(rings, CRSobj = "+proj=longlat +ellps=GRS80
+towgs84=0,0,0,0,0,0,0 +no_defs ")
#Extract the pixels values
( extrc <- extract(map, SPDF, na.rm=T) )
#proportion calculation for each class
(class.prop = lapply(extrc, function(x)
{prop.table(table(factor(x,levels=c(0,1))))}))
p.prop = setNames(
do.call(
rbind.data.frame,
class.prop),
c("Desmatado","natural"))
p.prop$ID<-seq_along(p.prop[,1])
rings$ID<- 1:length(SPDF)
freq <- merge(SPDF, p.prop) #add to polygons
frequenc<-as.data.frame(freq)
View(frequenc)
results <- rbind(results, frequenc)
setwd("~/prodes/resultados")
write.table(results, file="resultados.txt", sep="\t", row.names=F)
}
}
}
Error: In this point from my code above
( extrc <- extract(ras_PI, rings, na.rm=T) )
Cannot allocate large size vector 225.4 mb
The message seems pretty clear. You are extracting a lot of data.
So there are either very many rings and/or they are rather large. So you may need to either provide a function argument to extract or loop over the rings.
Perhaps you are doing something wrong ---- but there is no for us to tell as you are referring to data that we do not have. show(rings) could be helpful
I wish to extract raster values based on a list of coordinates. I’ve found online some scripts that include coordinates(), SpatialPoints(), crs() and spTransform() and other that don’t. Could someone kindly explain if script 1 or script 2 is correct and why? Thank you very much!
SCRIPT 1
sites <- read.csv("df.csv")
coordinates(sites)= ~ Longitude+ Latitude
mypoints = SpatialPoints(sites,proj4string = CRS("+init=epsg:4326"))
myproj = CRS(myraster)
points.proj = spTransform(mypoints, myproj)
myvalues = extract(myraster, points.proj)
SCRIPT 2
sites <- read.csv("df.csv")
myvalues = extract(myraster, cbind(sites$Longitude, y=sites$Latitude), df=TRUE, method='simple', cellnumbers=T)
Either could be correct. With RasterLayer r and data.frame sites you can do
v <- extract(r, sites[, c("Longitude", "Latitude")])
Under the assumption that "Longitude" and "Latitude" are variables in sites.
However that only works when r also has a ("Longitude", "Latitude") coordinate reference system. That may not be the case. Consider this RasterLayer
f <- system.file("external/test.grd", package="raster")
r <- raster(f)
r
#class : RasterLayer
#dimensions : 115, 80, 9200 (nrow, ncol, ncell)
#resolution : 40, 40 (x, y)
#extent : 178400, 181600, 329400, 334000 (xmin, xmax, ymin, ymax)
#crs : +proj=sterea +lat_0=52.15616055555555 +lon_0=5.38763888888889 +k=0.9999079 +x_0=155000 +y_0=463000 +ellps=bessel +units=m +towgs84=565.237,50.0087,465.658,-0.406857,0.350733,-1.87035,4.0812 +no_defs
#source : C:/soft/R/R-3.6.1/library/raster/external/test.grd
#names : test
#values : 128.434, 1805.78 (min, max)
The crs is "sterea ..." and the extent "178400, 181600, ...) shows that the coordinates are clearly not longitude and latitude (they are expressed in meters away from the origin of the crs.)
In this case, you might have a point in the area covered by r
site <- data.frame(Longitude=5.745039, Latitude=50.96254)
But extract returns NA because the crs do not match
extract(r, site)
# [,1]
#[1,] NA
So we do
pts <- SpatialPoints(site)
crs(pts) <- "+proj=longlat +datum=WGS84"
rcrs <- crs(r)
ptrans <- spTransform(pts, rcrs)
And now it works
extract(r, ptrans)
#1529.66