Dear all,
This is a continuation of this thread, but as the problem evolved and doesn’t fit the subject any more, I am
starting a new one.
The general idea: I am running a point pattern model with a 2d spde for the spatial effect and a 1d spde to fit the covariate. I want to achieve two things:
1 – To check the effect the covariate has on the intensity of my point pattern.
2 – To plot this effect mean and sd
on a grid.
But I have two problems:
First, I get a slightly different output
(fitted values, range, spatial variance, precision) with and without the prediction stack, even if the rest of the code and the formula are the same, and
Second, I can’t project the fitted values onto a grid.
I have been jumping between this
spde tutorial and the code for Blangiardo et al 2012. The code to set up my
model is here, and the rest of the code, and data, are attached.
#### 0.3 load data, mesh and boundary ####
load("data_mesh_boundary.Rdata")
## Remove CRS information
proj4string(bound) = inla.CRS()
proj4string(ds.df3) = inla.CRS()
mesh$crs <- NULL
# set seed
set.seed(2016)
set.inla.seed = 2016
#### 0.4 Source helper functions ####
source("C:/Users/Virginia/Dropbox/Virginia/GPS_multi/scripts/INLA_helper_functions.R")
#### 1. PREPARE NECESSARY DATA ####
# 1.1 calculate weights for each node ####
dmesh <- inla.mesh.dual(mesh)
# par(mfrow = c(1,2));plot(mesh);plot(dmesh)
# par(mfrow = c(1,1))
# number of meshnodes and number of datapoints
(nv <- mesh$n)
(n <- nrow(ds.df3))
# calculate weights for each meshnode depending on whether they are inside or outside the boundary
sum(w <- sapply(1:length(dmesh), function(i) {
if (gIntersects(dmesh[i,], bound))
return(gArea(gIntersection(dmesh[i,], bound)))
else return(0)
}))
table(w > 0) # false = nodes with weight 0 (outside the boundary)/true = nodes with some weight (inside the boundary)
# plot mesh, weights, and boundary. As we are working with lgcp we don't mind the integration points being in the nodes of the mesh
par(mar = c(2,2,1,1), mgp = 2:0)
plot(mesh$loc, asp = 1, col = (w == 0) + 1, pch = 19, xlab = '', ylab = '')
plot(mesh, add = TRUE)
plot(bound, border = 3, add = T)
# 1.2 Construct response ####
length(y.pp <- rep(0:1, c(nv, n))) # response (0 for all meshnodes, 1 for all data points)
summary(y.pp) # all 0 and 1
# expected (weights at each mesh node and 0 for all data points)
length(e.pp <- c(w, rep(0, n)))
summary(e.pp) # different values
# 1.3 projector matrix ####
lmat <- inla.spde.make.A(mesh, ds.df3@coords)
imat <- Diagonal(nv, rep(1, nv))
A.pp <- rBind(imat, lmat)
str(A.pp) # 4658 x 564, correct
# 1.4 collect all covariates at points and mesh vertex ina single dataset ####
# this contains all covars at mesh nodes and locations scaled using base::scale
load("covars.Rdata")
# 1.5 create spde model and indices ####
spde <- inla.spde2.pcmatern(mesh = mesh, alpha = 2,### mesh and smoothness parameter
prior.range = c(300, 0.01), ### P(practic.range<300)=0.01
prior.sigma = c(1, 0.1)) ### P(sigma>3)=0.1
field.indices <- inla.spde.make.index("sp_rdm", n.spde = spde$n.spde)
# 1.6 Create 1D SPDE model for the covariates ####
# create mesh
knots <- seq(round(min(covars[,1], na.rm = T) - 5), round(max(covars[,1], na.rm = T) + 5), length = 25) # leave an "outer boundary" of 5
mesh1d <- inla.mesh.1d(knots, interval = c(-10, 15), degree = 2, boundary = "free")
# define model
spde1d <- inla.spde2.pcmatern(mesh = mesh1d, alpha = 2,### mesh and smoothness parameter
prior.range = c(20, NA), ### Prange == NA means range is fixed at 20
prior.sigma = c(1, 0.1), ### P(sigma>1)=0.1
constr = TRUE)
# make A matrix for the 1d spde
A.1d <- inla.spde.make.A(mesh1d, covars[,1])
str(A.1d) #4658 x 28 correct?
# create index
covar.index <- inla.spde.make.index("Covar", n.spde = spde1d$n.spde) # I had done this following the Tokyo example, but I think this is only for temporal models?
# 1.6 stack all the things we've created ####
# we include here the covariates, and choose which effects to use for each model later
# make a stack with data, A = observation matrix (projector matrix), effects = predictors (as many as obs matrices)
stk.data <- inla.stack(data = list(y = y.pp, e = e.pp),
A = list(A.pp, # 4658*564
A.1d), # 4658*28
tag = 'dat',
effects = list(c(field.indices, list(b0 = 1)), # 564
covar.index)) # 28
Now, without creating a prediction stack I can run this model and check the effects of the covariate like this:
#### 2. MODEL WITH COVARIATE ####
# 2.1 formula for the model with covariate ####
frml_covar <- y ~ 0 + b0 +
f(Covar, model = spde1d) +
f(sp_rdm, model = spde)
# check it is correct
frml_covar
# 2.2 Run the model ####
cov.model <- inla(frml_covar, family = 'poisson',
data = inla.stack.data(stk.data),
control.predictor = list(A = inla.stack.A(stk.data),
compute = FALSE, link = 1),
E = inla.stack.data(stk.data)$e,
control.compute = list(dic = F, waic = F),
control.inla = list(int.strategy = "eb"),
verbose = TRUE)
# 2.3 Output of the model ####
m <- matrix(c(1,2,3,4,5,5),nrow = 2,byrow = TRUE) # 5 plotting areas, without scale
layout(mat = m, heights = c(0.5, 0.5))
plot(cov.model$marginals.fix[[1]], type = 'l', xlab = 'Intercept', ylab = 'Density')
plot(cov.model$marginals.hyperpar[[3]], type = 'l', xlab = expression(sigma^2~"of the spatial random field"), ylab = 'Density')
plot(cov.model$marginals.hyperpar[[2]], type = 'l', xlab = 'Range for the spatial random field', ylab = 'Density')
plot(cov.model$marginals.hyperpar[[1]], type = 'l', xlab = expression(tau~"for the covariate"), ylab = 'Density')
plot(cov.model$summary.random[[1]][,1:2], type = 'l', xlab = 'Covariate effect', ylab = 'Effect')
abline(h = 0, lty = 3)
for (i in c(4,6)) {lines(cov.model$summary.random[[1]][,c(1,i)], lty = 2) }
# spatial field
par(mfrow = c(1,1))
p.mean <- my.levelplot(proj, cov.model$summary.random$sp_rdm$mean, col.regions = plasma(20), main = "Posterior mean")
(p.mean <- p.mean + latticeExtra::layer(sp.polygons(poly.barrier, lwd = 1, fill = "gray")))
p.sd <- my.levelplot(proj, cov.model$summary.random$sp_rdm$sd, col.regions = plasma(20), main = "Posterior mean")
(p.sd <- p.sd + latticeExtra::layer(sp.polygons(poly.barrier, lwd = 1, fill = "gray")))
grid.arrange(p.mean, p.sd, ncol = 2)
But if I add the prediction stack, and run the model again, using exactly the same formula and inla call, just changing to compute = TRUE in the control.predictor() call:
####3. PREDICTIVE MODELS WITH COVARIATES ####
# 3.1 Create the prediction stack ####
stk.pred <- inla.stack(data = list(y = NA, e = NA),
tag = "pred",
A = list(A.1d, 1), # for the intercept
effects = list(covar.index,
list(b0 = rep(1, nrow(A.1d))))) # 4658??
# 3.2 Stack the stacks ####
stk.all <- inla.stack(stk.data, stk.pred)
# 3.3 Rerun the model with the prediction stack ####
#exactly the same model but with stk.all instead of stk.data, na in the data call, and compute = TRUE in the predictor call
pred.model <- inla(frml_covar, family = 'poisson',
data = inla.stack.data(stk.all),
control.predictor = list(A = inla.stack.A(stk.all),
compute = TRUE, link = 1),
E = inla.stack.data(stk.all)$e,
control.compute = list(dic = FALSE, waic = FALSE),
control.inla = list(int.strategy = "eb"),
verbose = TRUE)
Here you can see the slightly different output. For the covariate effect, for example, the shape is the same but the values change.
# 3.4 Outputs of the model ####
m <- matrix(c(1,2,3,4,5,5),nrow = 2,byrow = TRUE) # 5 plotting areas, without scale
layout(mat = m, heights = c(0.5, 0.5))
plot(pred.model$marginals.fix[[1]], type = 'l', xlab = 'Intercept', ylab = 'Density')
plot(pred.model$marginals.hyperpar[[3]], type = 'l', xlab = expression(sigma^2~"of the spatial random field"), ylab = 'Density')
plot(pred.model$marginals.hyperpar[[2]], type = 'l', xlab = 'Range for the spatial random field', ylab = 'Density')
plot(pred.model$marginals.hyperpar[[1]], type = 'l', xlab = expression(tau~"for the covariate"), ylab = 'Density')
plot(pred.model$summary.random[[1]][,1:2], type = 'l', xlab = 'Covariate effect', ylab = 'Effect')
abline(h = 0, lty = 3)
for (i in c(4,6)) {lines(pred.model$summary.random[[1]][,c(1,i)], lty = 2) }
# spatial field
p2.mean <- my.levelplot(proj, pred.model$summary.random$sp_rdm$mean, col.regions = plasma(20), main = "Posterior mean")
(p2.mean <- p2.mean + latticeExtra::layer(sp.polygons(poly.barrier, lwd = 1, fill = "gray")))
p2.sd <- my.levelplot(proj, pred.model$summary.random$sp_rdm$sd, col.regions = plasma(20), main = "Posterior mean")
(p2.sd <- p2.sd + latticeExtra::layer(sp.polygons(poly.barrier, lwd = 1, fill = "gray")))
grid.arrange(p.mean, p2.mean, p.sd, p2.sd, ncol = 2) #for comparison
And here's my attempt so far to project the fitted values onto a grid:
# create index from stack
id.prd <- inla.stack.index(stk.all,'pred')$data
# use the index to extract the effect values
mean_effect <- pred.model$summary.fitted.values$mean[id.prd]
m.eff <- my.levelplot(proj, mean_effect)
# generate grid to project into
seq.x.grid <- seq(from = poly.barrier@bbox[1,1], to = poly.barrier@bbox[1,2],
length = round(diff(poly.barrier@bbox[1,])/10)) #10 km cells
seq.y.grid <- seq(from = poly.barrier@bbox[2,1],to = poly.barrier@bbox[2,2],
length = round(diff(poly.barrier@bbox[2,])/10)) #10 km cells
pred.grid = expand.grid(seq.x.grid,seq.y.grid)
str(pred.grid)
# dimensions of the grid (dividing range of long and lat by stepsize to get ncol and nrow)
(nxy <- round(c(diff(poly.barrier@bbox[1,]), # range of longitude
diff(poly.barrier@bbox[2,]))/stepsize)) # range of latitude
# Create mapping between mesh and grid
proj_grid <- inla.mesh.projector(mesh,
xlim = range(pred.grid[,1]),
ylim = range(pred.grid[,2]),
dims = nxy)
# Project the linear predictor on the grid
lp.mean.grid = inla.mesh.project(proj_grid, mean_effect)
At this step I get the error:
Error in projector$proj$A %*% as.vector(field) :
Cholmod error 'X and/or Y have wrong dimensions' at file ../MatrixOps/cholmod_sdmult.c, line 90
Any help will be greatly appreciated!
Virginia.
--
You received this message because you are subscribed to the Google Groups "R-inla discussion group" group.
To unsubscribe from this group and stop receiving emails from it, send an email to r-inla-discussion-group+unsub...@googlegroups.com.
To post to this group, send email to r-inla-discussion-group@googlegroups.com.
Visit this group at https://groups.google.com/group/r-inla-discussion-group.
For more options, visit https://groups.google.com/d/optout.
To post to this group, send email to r-inla-disc...@googlegroups.com.
Visit this group at https://groups.google.com/group/r-inla-discussion-group.
For more options, visit https://groups.google.com/d/optout.
To unsubscribe from this group and stop receiving emails from it, send an email to r-inla-discussion-group+unsubscr...@googlegroups.com.
To post to this group, send email to r-inla-disc...@googlegroups.com.
Visit this group at https://groups.google.com/group/r-inla-discussion-group.
For more options, visit https://groups.google.com/d/optout.
--
You received this message because you are subscribed to the Google Groups "R-inla discussion group" group.
To unsubscribe from this group and stop receiving emails from it, send an email to r-inla-discussion-group+unsub...@googlegroups.com.
To post to this group, send email to r-inla-discussion-group@googlegroups.com.
Visit this group at https://groups.google.com/group/r-inla-discussion-group.
For more options, visit https://groups.google.com/d/optout.
Min. 1st Qu. Median Mean 3rd Qu. Max. 88.26 88.26 88.26 88.26 88.26 88.26
[1] 22848
[1] 22848 | |
To unsubscribe from this group and stop receiving emails from it, send an email to r-inla-discussion...@googlegroups.com.
To post to this group, send email to r-inla-disc...@googlegroups.com.
Visit this group at https://groups.google.com/group/r-inla-discussion-group.
For more options, visit https://groups.google.com/d/optout.
--
You received this message because you are subscribed to the Google Groups "R-inla discussion group" group.
To unsubscribe from this group and stop receiving emails from it, send an email to r-inla-discussion...@googlegroups.com.
To post to this group, send email to r-inla-disc...@googlegroups.com.
Visit this group at https://groups.google.com/group/r-inla-discussion-group.
For more options, visit https://groups.google.com/d/optout.
<mime-attachment.png>
COMPARE SPATIAL FIELDS FOR BOTH MODELSp.mean <- my.levelplot(proj, cov.model$summary.random$sp_rdm$mean, col.regions = plasma(20), main = "Posterior mean")
p.mean <- p.mean + latticeExtra::layer(sp.polygons(poly.barrier, lwd = 1, fill = "gray"))
p.sd <- my.levelplot(proj, cov.model$summary.random$sp_rdm$sd, col.regions = plasma(20), main = "Posterior sd")
p.sd <- p.sd + latticeExtra::layer(sp.polygons(poly.barrier, lwd = 1, fill = "gray"))
p2.mean <- my.levelplot(proj, pred.model$summary.random$sp_rdm$mean, col.regions = plasma(20), main = "Posterior mean pred")
p2.mean <- p2.mean + latticeExtra::layer(sp.polygons(poly.barrier, lwd = 1, fill = "gray"))
p2.sd <- my.levelplot(proj, pred.model$summary.random$sp_rdm$sd, col.regions = plasma(20), main = "Posterior sd pred")
p2.sd <- p2.sd + latticeExtra::layer(sp.polygons(poly.barrier, lwd = 1, fill = "gray"))
grid.arrange(p.mean, p2.mean, p.sd, p2.sd, ncol = 2) # for comparison
<mime-attachment.png>
<pred.pts.Rdata>
<covars.Rdata>
<data_mesh_boundary.Rdata>
<INLA_fitting_last.R>
samples <- inlabru:::generate.inla(cov.model3, n.samples = 1)
Error in generate.bru(object, ...) :
argument "data" is missing, with no default
samples <- inlabru::generate(cov.model3, n.samples = 1)
Error in generate.bru(object, ...) :
argument "data" is missing, with no default


$tag [1] "APredictor" "Predictor" "Covar" "sp_rdm" "b0" $start [1] 1 4659 5241 5259 5823 $length [1] 4658 582 18 564 1