## Not run:
# rmvn <- function(n, mu=0, V = matrix(1)){
# p <- length(mu)
# if(any(is.na(match(dim(V),p)))){stop("Dimension problem!")}
# D <- chol(V)
# t(matrix(rnorm(n*p), ncol=p)%*%D + rep(mu,rep(n,p)))
# }
#
# set.seed(1)
#
# ##Generate some data
# n <- 25 ##number of locations
# q <- 2 ##number of outcomes at each location
# nltr <- q*(q+1)/2 ##number of triangular elements in the cross-covariance matrix
#
# coords <- cbind(runif(n,0,1), runif(n,0,1))
#
# ##Parameters for the bivariate spatial random effects
# theta <- rep(3/0.5,q)
#
# A <- matrix(0,q,q)
# A[lower.tri(A,TRUE)] <- c(1,-1,0.25)
# K <- A%*%t(A)
#
# Psi <- diag(0,q)
#
# C <- mkSpCov(coords, K, Psi, theta, cov.model="exponential")
#
# w <- rmvn(1, rep(0,nrow(C)), C)
#
# w.1 <- w[seq(1,length(w),q)]
# w.2 <- w[seq(2,length(w),q)]
#
# ##Covariate portion of the mean
# x.1 <- cbind(1, rnorm(n))
# x.2 <- cbind(1, rnorm(n))
# x <- mkMvX(list(x.1, x.2))
#
# B.1 <- c(1,-1)
# B.2 <- c(-1,1)
# B <- c(B.1, B.2)
#
# Psi <- diag(c(0.1, 0.5))
#
# y <- rnorm(n*q, x%*%B+w, diag(n)%x%Psi)
#
# y.1 <- y[seq(1,length(y),q)]
# y.2 <- y[seq(2,length(y),q)]
#
# ##Call spMvLM
# A.starting <- diag(1,q)[lower.tri(diag(1,q), TRUE)]
# n.samples <- 1000
#
# starting <- list("phi"=rep(3/0.5,q), "A"=A.starting, "Psi"=rep(1,q))
# tuning <- list("phi"=rep(1,q), "A"=rep(0.01,length(A.starting)), "Psi"=rep(0.01,q))
# priors <- list("beta.Flat", "phi.Unif"=list(rep(3/0.75,q), rep(3/0.25,q)),
# "K.IW"=list(q+1, diag(0.1,q)), "Psi.ig"=list(c(2,2), c(0.1,0.1)))
#
# m.1 <- spMvLM(list(y.1~x.1-1, y.2~x.2-1),
# coords=coords, starting=starting, tuning=tuning, priors=priors,
# n.samples=n.samples, cov.model="exponential", n.report=100)
#
# burn.in <- 0.75*n.samples
#
# m.1 <- spRecover(m.1, start=burn.in)
#
# round(summary(m.1$p.theta.recover.samples)$quantiles[,c(3,1,5)],2)
# round(summary(m.1$p.beta.recover.samples)$quantiles[,c(3,1,5)],2)
#
# m.1.w.hat <- summary(mcmc(t(m.1$p.w.recover.samples)))$quantiles[,c(3,1,5)]
# m.1.w.1.hat <- m.1.w.hat[seq(1, nrow(m.1.w.hat), q),]
# m.1.w.2.hat <- m.1.w.hat[seq(2, nrow(m.1.w.hat), q),]
#
# par(mfrow=c(1,2))
# plot(w.1, m.1.w.1.hat[,1], xlab="Observed w.1", ylab="Fitted w.1",
# xlim=range(w), ylim=range(m.1.w.hat), main="Spatial random effects w.1")
# arrows(w.1, m.1.w.1.hat[,1], w.1, m.1.w.1.hat[,2], length=0.02, angle=90)
# arrows(w.1, m.1.w.1.hat[,1], w.1, m.1.w.1.hat[,3], length=0.02, angle=90)
# lines(range(w), range(w))
#
# plot(w.2, m.1.w.2.hat[,1], xlab="Observed w.2", ylab="Fitted w.2",
# xlim=range(w), ylim=range(m.1.w.hat), main="Spatial random effects w.2")
# arrows(w.2, m.1.w.2.hat[,1], w.2, m.1.w.2.hat[,2], length=0.02, angle=90)
# arrows(w.2, m.1.w.2.hat[,1], w.2, m.1.w.2.hat[,3], length=0.02, angle=90)
# lines(range(w), range(w))
# ## End(Not run)
Run the code above in your browser using DataLab