I trying two generate points from rLGCP function. I assumed that the presence of these points in the Window is governed by two covaiates ras1 and ras2. Hence I need to comptute log-lambda.
rm(list= ls(all=T))
#Libraries
library(spatstat)
library(raster)
library(maptools)
library(fields)
Creating the domaine D and two rasters
D <- c(300, 300) # Square Domaine D of side 300
Win <- owin(xrange =c(0, D[1]), yrange =c(0,D[2]))
spatstat.options(npixel=c(D[1],D[2]))
ext <- extent(Win$xrange, Win$yrange) # Extent of the rasters
# First raster ras1
par(mfrow=c(1,1))
ras1 <- raster()
extent(ras1) <- ext
res(ras1) <- 10
names(ras1) <- 'Radiation sim'
crs(ras1) <- "+proj=lcc +lat_1=48 +lat_2=33 +lon_0=-100 +datum=WGS84"
values(ras1) <- matrix(c(seq(from =0, to =50, length.out=200), seq(from=50, to=100, length.out = 100), seq(from=100, to=150, length.out = 200), seq(from=150, to=200, length.out = 200), seq(from=200, to=290, length.out = 200)), nrow = 30, ncol = 30)
ras1
plot(ras1, asp=1)
# Second Raster ras2
ras2 <- raster()
extent(ras2) <- ext
res(ras2) <- 10
names(ras2) <- 'Precipitation sim'
crs(ras2) <- "+proj=lcc +lat_1=48 +lat_2=33 +lon_0=-100 +datum=WGS84"
values(ras2) <- matrix(c(seq(from =-0, to =200, length.out=500), seq(from=400, to=893, length.out = 20), seq(from=200, to=300, length.out = 300),seq(from=300, to = 400, length.out=80)))
ras2
plot(ras2, asp=1)
Rasters.group <- stack(ras1, ras2)
plot(Rasters.group)
graphics.off()
From Rasters to im. objects
im.ras1 <- as.im.RasterLayer(ras1); summary(im.ras1)
im.ras2 <- as.im.RasterLayer(ras2); summary(im.ras2)
covar.list <- list(Radiation.sim=im.ras1, Precipitation.sim=im.ras2)
# plot .im object
par(mfrow=c(1,2))
image.plot(list(x=im.ras1$xcol, y=im.ras1$yrow, z=t(im.ras1$v)), main= "Radiation sim", asp=1)
image.plot(list(x=im.ras2$xcol, y=im.ras2$yrow, z=t(im.ras2$v)), main= "Precipitation sim", asp=1)
Now I can compute log-Lambda
#normalization
norm.im.ras1 <- (im.ras1- summary(im.ras1)$mean)/sd(im.ras1) ; summary(norm.im.ras1)
norm.im.ras2 <- (im.ras2- summary(im.ras2)$mean)/sd(im.ras2) ; summary(norm.im.ras2)
#Compute log-lambda
log.lambda <- norm.im.ras1 + 2*norm.im.ras2
summary(log.lambda)
resut dispays very weak values
Pixel values
range = [-4.657923, 10.94624]
integral = -9.678445e-12
mean = -1.075383e-16
When I try to simulate from rLGCP
gen.lgcp <- rLGCP("matern", mu=log.lambda, var=0.5, scale=0.05, nu=1)
Error: could not allocate a vector of size 181.9 MB
I tried to get around that with
log.lambda0 <- as.im(solutionset(log.lambda>0))
gen.lgcp <- rLGCP("matern", mu=log.lambda0, var=0.5, scale=0.05, nu=1)
summary(gen.lgcp)
I can move forward. But further, I did not get relevent results
#Thinning
image.plot(list(x=log.lambda$xcol, y=log.lambda$yrow, z=t(log.lambda$v)), main= "log.lambda", asp=1)
samp.lgcp <- rthin(gen.lgcp, P=seq(from=0.02, to=0.2, length.out = gen.lgcp$n)); points(samp.lgcp$x, samp.lgcp$y, type = 'p', cex=0.2, lwd=1, col='white')
#point pattern
pts.locations <- as.data.frame(cbind(longitude=samp.lgcp$x, latitude=samp.lgcp$y))
ppp.lgcp <- ppp(pts.locations$longitude, pts.locations$latitude, window = owin(xrange=c(min(pts.locations [,1]),max(pts.locations [,1])), yrange = c(min(pts.locations[,2]),max(pts.locations[,2]))))
plot(ppp.lgcp)
#Extract value of each sampled point covariate
cov.value <- extract(Rasters.group, pts.locations)
cov.value <- as.data.frame(cov.value )
presence.data <- data.frame(pts.locations, cov.value, presence=rep(1, nrow(cov.value)))
### Choosing absence point pattern
abs.region <- crop(Virtual.species.domaine, extent(25.28486 , 162.2897 ,181.7417 , 280.7651 ))
im.abs.region <- as.im.RasterLayer(abs.region)
abs.points <- rasterToPoints(abs.region)
ppp.abs.points <- ppp(abs.points[,1], abs.points[,2], window = owin(xrange = c(min(abs.points[,1]), max(abs.points[,1])), yrange =c(min(abs.points[,2]), max(abs.points[,2]))))
plot(ppp.abs.points)
cov.value.abs <- extract(Rasters.group, abs.points[,1:2])
absence.data <- data.frame(abs.points[,1:2], cov.value.abs, presence=rep(0, nrow(abs.points)))
colnames(absence.data)[1:2] <- c("longitude", "latitude")
head(absence.data)
# Get database for LGCP
LGCP.Data.Set <- rbind(presence.data, absence.data)
#' Model
#' we will use non-stationary formula
covar.formula <- as.formula(paste("~", paste(names(LGCP.Data.Set[,3:4]), collapse = "+")))
#Quadrature scheme
Q.lgcp <- quadscheme(ppp.lgcp, ppp.abs.points, method = 'grid')
plot(Q.lgcp)
Warning message:
In countingweights(id, areas) :
some tiles with positive area do not contain any quadrature points: relative error = 94.2%
# Inhomogenous poisson process Model
fit.ipp <- ppm(Q.lgcp, trend = covar.formula, covariates = LGCP.Data.Set[,3:4])
summary(fit.ipp)
Warning message:
glm.fit: algorithm did not converge
What is going wrong?
My goal is to evaluate de model and the predict with
prediction.ipp <- predict.ppm(fit.ipp, log.lambda, type = 'intensity')
This is a very long and un-focused question but I will try to help.
After constructing the image log.lambda, you say "result shows very weak values". What do you mean? The image values were assigned as a sequence of values ranging from 0 to 200, and then standardised to have mean zero and standard deviation 1. How is this "weak"?
You then call rLGCP using this image as the mean log intensity. The values of log.lambda range from about -4 to +10. This means that the desired intensity will range from exp(-4) to exp(+10), that is, about 0.01 to 20 000 points per square unit. The image dimensions are 30 by 30 units. Thus, a very large number of random points must be generated, and this fails because of memory limits. (The expected number of points is integral(exp(log.lambda)).
You then change log.lambda to another image which takes only the values 0 and 1.
The next body of code appears to take a raster image (of "absence" pixels) and try to construct a quadrature scheme using the "absence" pixels as dummy points. This is not the purpose for which quadscheme is designed (for quadscheme the dummy points should be sparse).
You don't need to construct a quadrature scheme to use ppm. You could just do something like
D <- solist(A=im.ras.1, B=im.ras.2)
ppm(ppp.logi ~ A+B , data=D)
If you really want to construct a quadrature scheme, I suggest you use the function pixelquad instead. Just do pixelquad(ppp.lgcp, im.abs.region) or similar. Then use ppm.
Since the data were generated by a Cox process, it would be more appropriate to use kppm rather than ppm.
See the spatstat book for further information.
Related
I have 608 observations of satellite-tagged turtles. I want to model these with environmental data which includes sea surface temperature, current speed, wind speed etc. Of course, both the tagging and environmental data vary spatially and temporally. I have generated pseudo-absence data using the code below which I adapted from here. However, it has now occurred to me that the data points I have generated are only spatial samples. Is there some way I can edit this code to sample temporally as well so that my resulting csv has a date/time for each point so that I can match it up to my environmental data? Alternatively, is there a different package I could try that would allow me to do this?
dir.create(path = "data")
library("sp")
library("raster")
library("maptools")
library("rgdal")
library("dismo")
bioclim.data <- getData(name = "worldclim",
var = "bio",
res = 2.5,
path = "data/")
# Read in observations
obs.data <- read.csv(file = "data/Presence.csv")
# Determine geographic extent of 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))
# Use the bioclim data files for sampling resolution
bil.files <- list.files(path = "data/wc2-5",
pattern = "*.bil$",
full.names = TRUE)
# only need one file, so use the first one in the list of .bil files
mask <- raster(bil.files[1])
# Randomly sample points (same number as our observed points)
background <- randomPoints(mask = mask, # Provides resolution of sampling points
n = nrow(obs.data), # Number of random points
ext = geographic.extent, # Spatially restricts sampling
extf = 1.25) # Expands sampling a little bit
write.csv(background, "pseudo-absence.csv")
I solved this issue by simply generating random times with the code below and merging the resulting and above .csv.
#ADD TIMES
time.start <- as.POSIXct('2014-12-01T01:00:00z', format = "%Y-%m-%dT%H:%M:%S")
time.end <- as.POSIXct('2015-04-30T01:00:00z', format = "%Y-%m-%dT%H:%M:%S")
seconds <- difftime(time.end, time.start, units = "secs")
# Option with runif()
v <- round(runif(6000, 0, seconds))
# Option with sample()
v <- sample(1:seconds, 6000, replace = T)
time.uniform <- time.start + v
write.csv(time.uniform, "time.csv")
tag<-read.csv("pseudo-absence.csv")
time<- read.csv("time.csv")
myfulldata = merge(tag,time)
write.csv(myfulldata, "pseudo-absence_with_time.csv")
The documentation for adehabitat HR recommends the following code for calculating a 95% kernel for a home range after creating the UD object:
## Calculation of the 95 percent home range
ver <- getverticeshr(ud, 95)
For some of my data, the following error appears:
Error in getverticeshr.estUD(x[[i]], percent, ida = names(x)[i], unin, :
The grid is too small to allow the estimation of home-range.
You should rerun kernelUD with a larger extent parameter
On a Nabble forum people recommending changing the "grid" and "extent" inputs, but I wasn't able to get any better results after using numerous combinations of these 2 parameters. Any suggestions?
This a common issue I've found in some forums. But the answer is simple and is exactly in the error message. "You need to extent your grid". This is happening because when you apply getverticeshr(ud, 95) part of the polygons is out of the grid, so it is not possible to get an area.
For example, in the below code, KDE is estimated for two hypothetical animals. I use random points from 0 to 100, so I have defined a grid 100x100 (Domain).
#"""
# Language: R script
# This is a temporary script file.
#"""
# 1. Packages
library(adehabitatHR) # Package for spatal analysis
# 2. Empty Dataframe
points <- data.frame(ID = double())
XY_cor <- data.frame(X = double(),
Y = double())
# 3. Assigning values (this will be our spatial coordinates)
set.seed(17)
for(i in c(1:100)){
if(i >= 50){points[i, 1] <- 1}
else {points[i, 1] <- 2}
XY_cor[i, 1] <- runif(1, 0, 100)
XY_cor[i, 2] <- runif(1, 0, 100)}
# 4. Transform to SpatialDataframe
coordinates(points) <- XY_cor[, c("X", "Y")]
class(points)
# 5. Domain
x <- seq(0, 100, by=1.) # resolution is the pixel size you desire
y <- seq(0, 100, by=1.)
xy <- expand.grid(x=x,y=y)
coordinates(xy) <- ~x+y
gridded(xy) <- TRUE
class(xy)
# 6. Kernel Density
kud_points <- kernelUD(points, h = "href", grid = xy)
image(kud_points)
# 7. Get the Volum
vud_points <- getvolumeUD(kud_points)
# 8. Get contour
levels <- c(50, 75, 95)
list <- vector(mode="list", length = 2)
list[[1]] <- as.image.SpatialGridDataFrame(vud_points[[1]])
list[[2]] <- as.image.SpatialGridDataFrame(vud_points[[2]])
# 9. Plot
par(mfrow = c(2, 1))
image(vud_points[[1]])
contour(list[[1]], add=TRUE, levels=levels)
image(vud_points[[2]])
contour(list[[2]], add=TRUE, levels=levels)
The plot shows that the contour to 50% is inside the grid, but 75% contour is cut, this means part of this one is out.
If you try to estimate vertices of KDE to 50% you will obtain a fine result:
# 10. Get vertices (It will be fine)
vkde_points <- getverticeshr(kud_points, percent = 50,
unin = 'm', unout='m2')
plot(vkde_points)
But if you try with 75% level you will obtain the classical error: Error in getverticeshr.estUD(x[[i]], percent, ida = names(x)[i], unin, :
The grid is too small to allow the estimation of home-range.
You should rerun kernelUD with a larger extent parameter
# 10. Get vertices (Will be an Error)
vkde_points <- getverticeshr(kud_points, percent = 75,
unin = 'm', unout='m2')
plot(vkde_points)
Now, you can see clearly what is happening, R can't estimate the vertices to 75% because they are outside of the grid, so you need to increase the domain (grid)! Here I will increase the domain in 50 (see # 5. Domain)
# 5. Domain HERE GRID IS INCREASED 50 AT X AND Y!!
x <- seq(-50, 150, by=1.) # resolution is the pixel size you desire
y <- seq(-50, 150, by=1.)
xy <- expand.grid(x=x,y=y)
coordinates(xy) <- ~x+y
gridded(xy) <- TRUE
class(xy)
# 6. Kernel Density
kud_points <- kernelUD(points, h = "href", grid = xy)
image(kud_points)
# 7. Get the Volum
vud_points <- getvolumeUD(kud_points)
# 8. Get contour
levels <- c(50, 75, 95)
list <- vector(mode="list", length = 2)
list[[1]] <- as.image.SpatialGridDataFrame(vud_points[[1]])
list[[2]] <- as.image.SpatialGridDataFrame(vud_points[[2]])
# 9. Plot
par(mfrow = c(2, 1))
image(vud_points[[1]])
contour(list[[1]], add=TRUE, levels=levels)
image(vud_points[[2]])
contour(list[[2]], add=TRUE, levels=levels)
You can see all the contours are inside the grid (domain). So, now you will be able to estimate the vertices.
# 10. Get vertices
vkde_points <- getverticeshr(kud_points, percent = 75,
unin = 'm', unout='m2')
plot(vkde_points)
suppose that we have a pde that describes the evolution of a variable y(t,x) over time t and space x, and I would like to plot its evolution on a three dimensional diagram (t,x,y). With deSolve I can solve the pde, but I have no idea about how to obtain this kind of diagram.
The example in the deSolve package instruction is the following, where y is aphids, t=0,...,200 and x=1,...,60:
library(deSolve)
Aphid <- function(t, APHIDS, parameters) {
deltax <- c (0.5, rep(1, numboxes - 1), 0.5)
Flux <- -D * diff(c(0, APHIDS, 0)) / deltax
dAPHIDS <- -diff(Flux) / delx + APHIDS * r
list(dAPHIDS )
}
D <- 0.3 # m2/day diffusion rate
r <- 0.01 # /day net growth rate
delx <- 1 # m thickness of boxes
numboxes <- 60
Distance <- seq(from = 0.5, by = delx, length.out = numboxes)
APHIDS <- rep(0, times = numboxes)
APHIDS[30:31] <- 1
state <- c(APHIDS = APHIDS) # initialise state variables
times <-seq(0, 200, by = 1)
out <- ode.1D(state, times, Aphid, parms = 0, nspec = 1, names = "Aphid")
"out" produces a matrix containing all the data that we need, t, y(x1), y(x2), ... y(x60). How can I produce a surface plot to show the evolution and variability of y in (t,x)?
The ways change a bit depending on using package. But you can do it with little cost because out[,-1] is an ideal matrix form to draw surface. I showed two examples using rgl and plot3D package.
out2 <- out[,-1]
AphID <- 1:ncol(out2)
library(rgl)
persp3d(times, AphID, out2, col="gray50", zlab="y")
# If you want to change color with value of Z-axis
# persp3d(times, AphID, out2, zlab="y", col=topo.colors(256)[cut(c(out2), 256)])
library(plot3D)
mat <- mesh(times, AphID)
surf3D(mat$x, mat$y, out2, bty="f", ticktype="detailed", xlab="times", ylab="AphID", zlab="y")
In R, using the np package, I have created the bandwidths for a conditional density. What I would like to do is, given some new conditional vector, sample from the resulting distribution.
Current code:
library('np')
# Generate some test data.
somedata = data.frame(replicate(10,runif(100, 0, 1)))
# Conditional variables.
X <- data.frame(somedata[, c('X1', 'X2', 'X3')])
# Dependent variables.
Y <- data.frame(somedata[, c('X4', 'X5', 'X6')])
# Warning, this can be slow (but shouldn't be too bad).
bwsome = npcdensbw(xdat=X, ydat=Y)
# TODO: Given some vector t of conditional data, how can I sample from the resulting distribution?
I am quite new to R, so while I did read the package documentation, I haven't been able to figure out if what I vision makes sense or is possible. If necessary, I would happily use a different package.
Here is the Example 2.49 from: https://cran.r-project.org/web/packages/np/vignettes/np_faq.pdf , it gives the following
solution for for 2 variables:
###
library(np)
data(faithful)
n <- nrow(faithful)
x1 <- faithful$eruptions
x2 <- faithful$waiting
## First compute the bandwidth vector
bw <- npudensbw(~x1 + x2, ckertype = "gaussian")
plot(bw, view = "fixed", ylim = c(0, 3))
## Next generate draws from the kernel density (Gaussian)
n.boot <- 1000
i.boot <- sample(1:n, n.boot, replace = TRUE)
x1.boot <- rnorm(n.boot,x1[i.boot],bw$bw[1])
x2.boot <- rnorm(n.boot,x2[i.boot],bw$bw[2])
## Plot the density for the bootstrap sample using the original
## bandwidths
plot(npudens(~x1.boot+x2.boot,bws=bw$bw), view = "fixed")
Following this hint from #coffeejunky, the following is a possible
solution to your problem with 6 variables:
## Generate some test data.
somedata = data.frame(replicate(10, runif(100, 0, 1)))
## Conditional variables.
X <- data.frame(somedata[, c('X1', 'X2', 'X3')])
## Dependent variables.
Y <- data.frame(somedata[, c('X4', 'X5', 'X6')])
## First compute the bandwidth vector
n <- nrow(somedata)
bw <- npudensbw(~X$X1 + X$X2 + X$X3 + Y$X4 + Y$X5 + Y$X6, ckertype = "gaussian")
plot(bw, view = "fixed", ylim = c(0, 3))
## Next generate draws from the kernel density (Gaussian)
n.boot <- 1000
i.boot <- sample(1:n, n.boot, replace=TRUE)
x1.boot <- rnorm(n.boot, X$X1[i.boot], bw$bw[1])
x2.boot <- rnorm(n.boot, X$X2[i.boot], bw$bw[2])
x3.boot <- rnorm(n.boot, X$X3[i.boot], bw$bw[3])
x4.boot <- rnorm(n.boot, Y$X4[i.boot], bw$bw[4])
x5.boot <- rnorm(n.boot, Y$X5[i.boot], bw$bw[5])
x6.boot <- rnorm(n.boot, Y$X6[i.boot], bw$bw[6])
## Plot the density for the bootstrap sample using the original
## bandwidths
ob1 <- npudens(~x1.boot + x2.boot + x3.boot + x4.boot + x5.boot + x6.boot, bws = bw$bw)
plot(ob1, view = "fixed", ylim = c(0, 3))
I would like to plot a variable number of points as my sample size increases. However, for some reason the "variogram" function only plots 15 points every time.
I checked to make sure that the size of the data I'm passing "variogram" was varying correctly - it was.
library(gstat)
library(RandomFields)
library(lattice)
library(latticeExtra)
mod <- RMexp(var=1, scale=5) + RMtrend(mean=3)
# theoretical mean 3
# (x,y) coordinates for simulation grid
x <- seq(0,50,by=0.5)
y <- seq(0,0,by=0.5)
xx <- rep(x, times=length(y))
yy <- rep(y, each=length(x))
zz <- RFsimulate(mod, x=xx, y=yy,spConform=FALSE)
field <- data.frame(x=xx,y=yy,z=zz)
d <- sample(zz,10)
g <- gstat(formula=z~1, locations=~x+y, data=raw.dat)
# N=10:
n10 <- sample(1:length(field[[1]]),10,replace=F)
#g <- gstat(formula=z~1, locations=~x+y, data=raw.dat)
f10 = field[n10,]
g10 <- gstat(formula=z~1, locations=~x+y, data=f10)
raw.vgm <- variogram(g10) # create method of class "gstatVariogram"
plot(raw.vgm,main='Variogram of Raw Data for N = 10',type='b') # plot method for class "gstatVariogram"
# N=25:
n25 <- sample(1:length(field[[1]]),25,replace=F)
#g <- gstat(formula=z~1, locations=~x+y, data=raw.dat)
f25 = field[n25,]
g25 <- gstat(formula=z~1, locations=~x+y, data=f25)
#f25 is of length 25 - I checked #
raw.vgm <- variogram(g25) # create method of class "gstatVariogram"
plot(raw.vgm,main='Variogram of Raw Data for N = 25',type='b') # plot method for class "gstatVariogram"
Both raw variograms only plot 15 points. Does anyone know why? I did not see this as a default.
?variogram gives as a default for argument width the value cutoff/15, which causes the default of 15 points. If you make the value for width smaller, you will see more points. Try
raw.vgm <- variogram(g25, width = .5)
plot(raw.vgm,main='Variogram of Raw Data for N = 25')
for more points, and try modifying cutoff if you feel adventurous. I would not recommend type='b' as the line connecting the sample variogram points suggests more than there is, really.