I want to assess if the observations in my data are spatially randomly distributed over the sampling area (Sweden). I wanted to reproduce the example given in this answer: Spatial Autocorrelation Analysis (Global Moran's I) in R
Here is a small subset of my data, and the spatial polygon I used. Note that the coordinates are in SWEREF99 (ESPG: 3006)
## spatial polygon of Sweden
library(rworldmap)
library(sp)
worldmap <- getMap(resolution = "high")
sweden <- worldmap[which(worldmap$SOVEREIGNT == "Sweden"),]
plot(sweden)
sweden
## conversion to EPSG: 3006 (SWEREF99 TM) (https://spatialreference.org/ref/epsg/3006/)
crs.laea <- CRS("+proj=utm +zone=33 +ellps=GRS80 +towgs84=0,0,0,0,0,0,0 +units=m +no_defs")
sweden_proj <- spTransform(sweden, crs.laea)
## Data subset
x <- c(669894, 669894, 669894, 671088, 671117, 671117, 671117, 670513, 670513, 670513, 669921, 669310, 669310, 669310, 669303, 629720, 630318, 630925, 630925, 630925)
y <- c(7116684, 7116684, 7116684, 7116706, 7114900, 7114900, 7114900, 7114896, 7114896, 7114896, 7114888, 7115473, 7115473, 7115473, 7116075, 7131172, 7131180, 7131190, 7131190, 7131190)
library(spatstat)
coords.ppp_1 <- ppp( x , y , xrange = c(280227, 911417) , yrange = c(6142436, 7605020) )
coords.ppp <- unique(coords.ppp_1)
### plot data and Sweden map for check
plot(coords.ppp_1)
plot(sweden_proj, add=T)
So far it seems ok. Then I convert the spatial polygon to an owin object, simulate random data for comparison, and do the analysis.
library(maptools)
sw <- as.owin.SpatialPolygons(sweden_proj)
# Generate completely spatially random point patterns to compare against the observed
n <- coords.ppp_1$n
ex <- expression(runifpoint( n , sw))
# Compute a simulation envelope using Gest, which estimates the nearest neighbour distance distribution function G(r)
set.seed(1)
res <- envelope( coords.ppp , Gest , nsim = 99, simulate = ex ,verbose = FALSE, savefuns = TRUE )
plot(res)
With the envelope() I get the following error message:
"In envelopeEngine(X = X, fun = fun, simul = simrecipe, nsim = nsim, :
Window containing simulated patterns is not a subset of data window"
I suspect that there is a problem with the conversion between sp and owin, but I couldn't figure out what the issue really is.
Any advice?
Related
I am calculating a home range using the following data (extract)
x y
437850.3 7220701
465101.3 7210903
489314.6 7159065
513795.7 7114472
532871.0 7075753
I use the following code to calculate home range, with my coordinates converted to UTM:
#Load packages
library(rgdal)
library(ks)
library(rgeos)
library(maptools)
#Project data into UTM
coordinates(data) <- c("x","y")
proj4string(data) <- CRS( "+proj=utm +zone=18 +datum=WGS84 +units=m +no_defs" )
data<-as.data.frame(data)
#Calculate plugin home range
h1 <- Hpi(data[,1:2], pilot = "samse", binned = T)
kernPI1 <- kde(data[,1:2], H = h1)
cont = contourLevels(kernPI1, cont = 95)
line = contourLines(x = kernPI1$eval.points[[1]], y =
kernPI1$eval.points[[2]], z = kernPI1$estimate,
level = cont)
sldf = ContourLines2SLDF(line)
sldf = SpatialLines2PolySet(sldf)
sldf = PolySet2SpatialPolygons(sldf)
gArea(sldf) #result is 2010204962.
I am trying to calculate my area in km^2, and I know for a fact that my areas should be around 1000-10000 km^2. I am guessing this has to do with the UTM coordinates, but am not sure how to proceed beyond that.
I am trying to interpolate a irregular raster grid to a regular grid using akima library in R. However, after I define the regular grid and interpolate the values to the new regular grid, I end up in a strange raster position. I'm doing something wrong but I don't see where. If anyone has a solution (or know a different approach), please let me know. Thank you very much.
library(raster)
library(akima)
library(rgdal)
library(sp)
# download the file
url <- 'https://downloads.psl.noaa.gov/Datasets/NARR/Derived/monolevel/air.2m.mon.ltm.nc'
file <- paste0(getwd(), "/airtemp.nc")
download.file(url, file, quiet = TRUE, mode = "wb") # less than 4 mb
# define the grid edges according to https://psl.noaa.gov/data/gridded/data.narr.monolevel.html
y <- c(12.2, 14.3, 57.3, 54.5)
x <- c(-133.5, -65.1, -152.9, -49.4)
xym <- cbind(x, y)
p = Polygon(xym)
ps = Polygons(list(p),1)
sps = SpatialPolygons(list(ps))
# create a spatial grid to 0.3 cell size
xy <- makegrid(sps, cellsize = 0.3)
xy$first <-1
names(xy) <- c('x','y',"first")
coordinates(xy)<-~x+y
gridded(xy)<-T
# read the netcdf file and extract the values
cape <- brick(file)[[1]] #get the first layer only
rp <- rasterToPoints(cape)
rp <- na.exclude(rp)
# interpolate to the crs for Northern America Conformal Conic
r2 <- project(rp[,1:2], paste('+proj=lcc +lat_1=20 +lat_2=60 +lat_0=40 +lon_0=-96 +x_0=0 +y_0=0 +datum=NAD83 +units=m +no_defs'), inv=TRUE, use_ob_tran=TRUE)
# add the transformed coordinates
rp[,1:2] <-r2
rp <- as.data.frame(rp)
# create a spatial points object and plot it
coordinates(rp)<-~x+y
spplot(rp, scales=list(draw = T))
# interpolate the points to the coordinates (takes a while)
akima.sp <- interpp(x = coordinates(rp)[,1], y = coordinates(rp)[,2],
z = rp#data[,names(rp)[1]],
xo = coordinates(xy)[,1],
yo = coordinates(xy)[,2],
linear = F, extrap = F)
# create a raster file
r.a <- rasterFromXYZ(as.matrix(data.frame(akima.sp)))
plot(r.a)
I have a Digital Elevation Model for the Alps (containing x,y,z). I would like to extract polygons representing two elevation levels (<=1000, >1000). The polygons need to be applied to a more elaborate registration of the Alps with different x, y points (x,y,snowdepth). The second registration must be filtered for all points above 1000m. So. it would be nice if I could store the polygon and use it to different spatial data frames. My question is: how can I capture the polygon representing the elevation level above 1000m and filter the spatial data frame in R.
#packages
packages <- c("RCurl", "RColorBrewer","ggmap","rgeos","fields","dismo","rgdal", "deldir", "dplyr","tidyr","ggplot2","contoureR",
"maptools","raster","gstat", "magick","lubridate", "ggplot2","viridis","scales","inlmisc")
has_available <- packages %in% rownames(installed.packages())
if(any(!has_available)) install.packages(packages[!has_available])
lapply(packages,library,character.only = TRUE)
for(pkg in packages) {
library(pkg, character.only = TRUE)
}
geo_proj = "+proj=longlat +datum=WGS84 +no_defs +ellps=WGS84 +towgs84=0,0,0"
alps <- shapefile("Alpine_Convention_Perimeter_2018.shp")
proj4string(alps)
bbalps <- bbox(alps)
alps <- spTransform(alps,geo_proj)
r <- raster(alps,ncols=990,nrows=990)
srtm <- getData('SRTM', lon=15, lat=47)
srtm2 <- getData('SRTM', lon=12, lat=47)
srtm3 <- getData('SRTM', lon=9, lat=47)
srtm4 <- getData('SRTM', lon=6, lat=45)
#Mosaic/merge srtm tiles
srtmmosaic <- mosaic(srtm, srtm2, srtm3, srtm4, fun=mean)
srtmmosaic <- spTransform(srtmmosaic,geo_proj)
rm(srtm, srtm2, srtm3, srtm4)
rst0 <- projectRaster(srtmmosaic, r, crs=geo_proj)
#set the z-factor, which increases contrast
mosaic <- rst0 * 10
#then create the hillshade
slope <- terrain(mosaic, opt="slope", unit='radians')
aspect <- terrain(mosaic, opt="aspect", unit='radians')
hillshade <- hillShade(slope, aspect, angle=45, direction=315)
hillshade <- crop(hillshade, extent(alps))
hillshade <- mask(hillshade, alps)
slope <- crop(slope, extent(alps))
slope <- mask(slope, alps)
rst0 <- crop(rst0, extent(alps))
rst0 <- mask(rst0,alps)
#elevation
elev.df <- rasterToPoints(rst0)
elev.df <- data.frame(elev.df)
colnames(elev.df) <- c("lon", "lat", "elevation")
#ggplot makes me turn the raster into points
hills.df <- rasterToPoints(hillshade)
hills.df <- data.frame(hills.df)
colnames(hills.df) <- c("lon", "lat", "hills")
#merging the slope shade with the hillshade
slope.df <- rasterToPoints(slope)
slope.df <- data.frame(slope.df)
colnames(slope.df) <- c("lon", "lat", "slope")
slope.df$slope <- 1- slope.df$slope #invert the scale so that more slope is darker
#elevation normalised
elev.df$val_norm <- (elev.df[,3]-min(elev.df[,3]))/diff(range(elev.df[,3]))
mnt.df<-hills.df %>%
left_join(slope.df) %>%
full_join(elev.df)
df = getContourLines(mnt.df, binwidth=1000)
ggplot(df,aes(x,y,group=Group,colour=z)) + geom_path()
I use machine learning algorithms for species distribution modeling. This involves fitting a model in R and applying the model to a raster stack of environmental predictors using the predict() function. This is relatively straightforward for functions such as randomForest, glm, and maxent. However, I would like to use the best model selected using the h2o.automl function in the package h2o to predict occurrence probabilities across a stack of environmental predictors. Now, it is possible to convert raster stacks into data frames and then use these for h2o prediction. However, this tends to eat up a lot of RAM for large raster stacks. Below is an example using some publicly available low-resolution data.
library(sp)
library(raster)
library(maptools)
library(rgdal)
library(dismo)
library(h2o)
library(sp)
library(h2o)
bioclim.data <- getData(name = "worldclim",
var = "bio",
res = 2.5)
obs.data <- read.csv("https://raw.githubusercontent.com/jcoliver/learn-r/gh-pages/data/Carnegiea-gigantea-GBIF.csv")
obs.data <- obs.data[!is.na(obs.data$latitude), ]
obs.data <- obs.data[, c("longitude", "latitude")]
obs.sp<-SpatialPoints(obs.data, proj4string = CRS("+proj=longlat +datum=WGS84 +no_defs"))
# Determine geographic extent of our data
max.lat <- ceiling(max(obs.data$latitude))
min.lat <- floor(min(obs.data$latitude))
max.lon <- ceiling(max(obs.data$longitude))
min.lon <- floor(min(obs.data$longitude))
geographic.extent <- extent(x = c(min.lon, max.lon, min.lat, max.lat))
bioclim.data <- crop(x = bioclim.data, y = geographic.extent)
background<-randomPoints(mask = bioclim.data,
n = nrow(obs.data),
ext = geographic.extent,
extf = 1.25)
colnames(background)<-c("longitude", "latitude")
background.sp<-SpatialPoints(background, proj4string = CRS("+proj=longlat +datum=WGS84 +no_defs"))
presence<-data.frame(Presence = rep(1, times = nrow(obs.data)), extract(bioclim.data, obs.sp))
absence<-data.frame(Presence = rep(0, times = nrow(obs.data)), extract(bioclim.data, background.sp))
df<-rbind(presence, absence)
df$Presence<-as.factor(df$Presence)
h2o.init(max_mem_size = "4g")
set.seed(1234)
df_h2o <- as.h2o(df)
splits <- h2o.splitFrame(df_h2o, c(0.7, 0.15), seed = 1234)
train <- h2o.assign(splits[[1]], "train")
valid <- h2o.assign(splits[[2]], "valid")
test <- h2o.assign(splits[[3]], "test")
y <- "Presence"
x <- setdiff(names(df_h2o), y)
aml <- h2o.automl(x = x,
y= y,
training_frame = train,
leaderboard_frame = valid,
max_runtime_secs = 60) #default 1 hour 3600 secs, more time, more accurate
pred<-as.data.frame(predict(aml, test)) # this works. It reports predicted probabilities of presence vs. absence.
pred_rstr<-predict(aml, bioclim.data) # this doesn't work. Must be an H2oFrame
biodf<-as.data.frame(bioclim.data) # this forces the raster stack into a dataframe. This works, but only for low resolution rasters.
bio_h2o<-as.h2o(biodf)
pred2<-as.data.frame(predict(aml, bio_h2o))
pred_rstr<-bioclim.data[[1]] # pull one of the rasters from the stack to serve as a template
values(pred_rstr)<-as.vector(pred2$p1) # set raster values to predicted probabilities
plot(pred_rstr)
I defined a polygon:
library(rgee)
ee_Initialize()
polygon <- ee$Geometry$Polygon(
list(
c(91.17, -13.42),
c(154.10, -13.42),
c(154.10, 21.27),
c(91.17, 21.27),
c(91.17, -13.42)
))
Map$addLayer(polygon)
The polygon covers countries around south-east Asia
For each pixel in the polygon, I want to calculate monthly sum of a given band for a given year as follows:
month_vec <- 1:12
pr_ls <- list()
for(m in seq_along(month_vec)){
month_ref <- month_vec[m]
pr_ls[[m]] <-
ee$ImageCollection("NASA/NEX-GDDP")$
filterBounds(polygon)$ # filter it by polygon
select('pr')$ # select rainfall
filter(ee$Filter$calendarRange(2000, 2000, "year"))$ # filter the year
filter(ee$Filter$calendarRange(month_ref, month_ref, "month"))$ # filter the month
filter(ee$Filter$eq("model","ACCESS1-0"))$ # filter the model
sum() # sum the rainfall
}
Imagecollection_pr <- ee$ImageCollection(pr_ls)
ee_imagecollection_to_local(
ic = Imagecollection_pr,
region = polygon,
dsn = paste0('pr_')
)
Reading a single month's file
my_rast <- raster(list.files(pattern = '.tif', full.names = TRUE)[1])
Since this raster covers southeast asian countries, I downloaded the shapefile
sea_shp <- getData('GADM', country = c('IDN','MYS','SGP','BRN','PHL'), level = 0)
Plotting them on top of each other:
plot(my_rast)
plot(sea_shp, add = T)
There is a misalignment and I am not sure if it is the right raster that has been
processed for the given polygon. I also checked if their projection is same
crs(my_rast)
CRS arguments: +proj=longlat +datum=WGS84 +no_defs
crs(sea_shp)
CRS arguments: +proj=longlat +datum=WGS84 +no_defs
Both of them have the same projection as well. I cannot figure out what went wrong?
EDIT
As suggested in comments, I defined a new polygon covering Australia as follows:
polygon <- ee$Geometry$Polygon(
list(
c(88.75,-45.26),
c(162.58,-45.26),
c(162.58,8.67),
c(88.75,8.67),
c(88.75,-45.26)
)
)
Map$addLayer(polygon)
and repeated the above code. Plotting the raster again for the month of March on polygon gives me this:
Does anyone know if I can check if my raster is reversed w.r.t to polygon boundaries?
This seems to be related to rgdal rather than to the raster package. Some raster downloaded from GEE have data flipped with respect to y. I solved this problem, as follow:
library(rgee)
library(raster)
ee_Initialize()
polygon <- ee$Geometry$Polygon(
list(
c(91.17, -13.42),
c(154.10, -13.42),
c(154.10, 21.27),
c(91.17, 21.27),
c(91.17, -13.42)
))
month_vec <- 1:12
pr_ls <- list()
for(m in seq_along(month_vec)){
month_ref <- month_vec[m]
pr_ls[[m]] <-
ee$ImageCollection("NASA/NEX-GDDP")$
filterBounds(polygon)$ # filter it by polygon
select('pr')$ # select rainfall
filter(ee$Filter$calendarRange(2000, 2000, "year"))$ # filter the year
filter(ee$Filter$calendarRange(month_ref, month_ref, "month"))$ # filter the month
filter(ee$Filter$eq("model","ACCESS1-0"))$ # filter the model
sum() # sum the rainfall
}
Imagecollection_pr <- ee$ImageCollection(pr_ls) %>% ee_get(0)
exp1 <- ee_imagecollection_to_local(
ic = Imagecollection_pr,
region = polygon,
dsn = "pp_via_drive",
via = "drive" # please always use "drive" or "gcs" until rgee 1.0.6 release
)
# One option
gdalinfo <- try (rgdal::GDALinfo(exp1))
if (isTRUE(attr(gdalinfo, "ysign") == 1)) {
exp1_r <- flip(raster(exp1), direction='y')
}
Recent versions of the earthengine Python API causes some inconsistencies when via = "getInfo" is used, please always use via = "drive" until the release of rgee 1.0.6.
There does not seem to be a misalignment. To plot all these countries in one step, you could do
x <- lapply(c('IDN','MYS','SGP','BRN','PHL'), function(i) getData('GADM', country = i, level = 0))
sea_shp <- bind(x)