################################
##Spatial multivariate poisson
################################
##Generate some data
n <- 100
q <- 3
nltr <- q*(q-1)/2+q
coords <- cbind(runif(n,1,100),runif(n,1,100))
theta <- rep(3/50,q)
A <- matrix(0,q,q)
A[lower.tri(A,TRUE)] <- rnorm(nltr,1,1)
K <- A%*%t(A)
Psi <- diag(0,q)
c1 <- mvCovInvLogDet(coords=coords, knots=coords,
cov.model="exponential",
V=K, Psi=Psi, theta=theta,
modified.pp=TRUE, SWM=FALSE)
w <- mvrnorm(1,rep(0,nrow(c1$C)),c1$C)
X <- mkMvX(list(matrix(1,n,1), matrix(1,n,1), matrix(1,n,1)))
beta <- c(-1,0,1)
y <- rpois(n*q, exp(X%*%beta+w))
y.1 <- y[seq(1,length(y),q)]
y.2 <- y[seq(2,length(y),q)]
y.3 <- y[seq(3,length(y),q)]
##Specify starting values and collect samples. For
##a true analysis, several longer chains should be
##run.
A.starting <- diag(1,q)[lower.tri(diag(1,q), TRUE)]
beta.starting <- coefficients(glm(y~X-1, family="poisson"))
beta.tuning <- t(chol(vcov(glm(y~X-1, family="poisson"))))
n.samples <- 5000
m.1 <- spMvGLM(list(y.1~1,y.2~1,y.3~1), family="poisson", coords=coords,
starting=
list("beta"=beta.starting, "phi"=rep(0.06,q),
"A"=A.starting, "w"=0),
tuning=
list("beta"=beta.tuning, "phi"=rep(0.01,q),
"A"=rep(0.005,nltr), "w"=0.001),
priors=
list("beta.Flat", "phi.Unif"=rep(c(0.03, 0.3),q),
"K.IW"=list(q+1, diag(0.1,q))),
cov.model="exponential",
n.samples=n.samples, sub.sample=c(5000,n.samples,10),
verbose=TRUE, n.report=500)
m.1$p.samples[,paste("phi_",1:q,sep="")] <-
3/m.1$p.samples[,paste("phi_",1:q,sep="")]
print(summary(mcmc(m.1$p.samples)))
beta.hat <- colMeans(m.1$p.samples[,1:q])
w.hat <- rowMeans(m.1$sp.effects)
y.hat <- exp(X%*%beta.hat+w.hat)
y.hat.1 <- y.hat[seq(1,length(y.hat),q)]
y.hat.2 <- y.hat[seq(2,length(y.hat),q)]
y.hat.3 <- y.hat[seq(3,length(y.hat),q)]
##Take a look
par(mfrow=c(3,2))
surf <- mba.surf(cbind(coords,y.1),no.X=100, no.Y=100, extend=TRUE)$xyz.est
image(surf, main="Observed counts")
contour(surf, drawlabels=FALSE, add=TRUE)
text(coords, labels=y.1, cex=1, col="blue")
surf <- mba.surf(cbind(coords,y.hat.1),no.X=100, no.Y=100, extend=TRUE)$xyz.est
image(surf, main="Fitted counts")
contour(surf, add=TRUE)
contour(surf, drawlabels=FALSE, add=TRUE)
text(coords, labels=round(y.hat.1,0), cex=1, col="blue")
surf <- mba.surf(cbind(coords,y.2),no.X=100, no.Y=100, extend=TRUE)$xyz.est
image(surf)
contour(surf, drawlabels=FALSE, add=TRUE)
text(coords, labels=y.2, cex=1, col="blue")
surf <- mba.surf(cbind(coords,y.hat.2),no.X=100, no.Y=100, extend=TRUE)$xyz.est
image(surf)
contour(surf, drawlabels=FALSE, add=TRUE)
text(coords, labels=round(y.hat.2,0), cex=1, col="blue")
surf <- mba.surf(cbind(coords,y.3),no.X=100, no.Y=100, extend=TRUE)$xyz.est
image(surf)
contour(surf, drawlabels=FALSE, add=TRUE)
text(coords, labels=y.3, cex=1, col="blue")
surf <- mba.surf(cbind(coords,y.hat.3),no.X=100, no.Y=100, extend=TRUE)$xyz.est
image(surf)
contour(surf, drawlabels=FALSE, add=TRUE)
text(coords, labels=round(y.hat.3,0), cex=1, col="blue")
Run the code above in your browser using DataLab