我可以使用WinBUGS运行简单的Jolly-Seber模型，但不能运行Jags。我可以使用Jags运行线性回归，这表明R能够找到并执行Jags。因此，我怀疑问题可能是Jags无法解释模型代码中的一行（或多行）。请检查下面的代码，并建议如何修改它以在Jags中运行。最初我怀疑prod中可能没有Jags功能。但是，搜索Jags手册会显示Jags确实包含prod功能。
这是我能想到的最简单的工作示例，但如果可能的话会进一步简化。
底部提供了一个示例数据集。模型代码从Kery和Schaub（2012）修改。
# BUGS code
sink("C:/Users/mmiller/Documents/simple R programs/my.model.txt")
cat("
model {
for (i in 1:M) {
for (t in 1:(n.occasions-1)) {
phi[i,t] <- mean.phi
}
for (t in 1:n.occasions) {
p[i,t] <- mean.p
}
}
mean.phi ~ dunif(0, 1)
mean.p ~ dunif(0, 1)
for (t in 1:n.occasions) {
gamma[t] ~ dunif(0, 1)
}
for (i in 1:M) {
z[i,1] ~ dbern(gamma[1])
mu1[i] <- z[i,1] * p[i,1]
y[i,1] ~ dbern(mu1[i])
for (t in 2:n.occasions) {
q[i,t-1] <- 1-z[i,t-1]
mu2[i,t] <- phi[i,t-1] * z[i,t-1] + gamma[t] * prod(q[i,1:(t-1)])
z[i,t] ~ dbern(mu2[i,t])
mu3[i,t] <- z[i,t] * p[i,t]
y[i,t] ~ dbern(mu3[i,t])
}
}
}
",fill=TRUE)
sink()
# run R2WinBUGS
setwd('C:/Users/mmiller/Documents/simple R programs')
library(R2WinBUGS)
data <- list(y = my.data, n.occasions = dim(my.data)[2], M = dim(my.data)[1])
inits <- function() {list(mean.phi = runif(1, 0, 1), mean.p = runif(1, 0, 1), z = my.data)}
parameters <- c("mean.p", "mean.phi")
bugs.out <- bugs(data, inits, parameters,
"C:/Users/mmiller/Documents/simple R programs/my.model.txt",
n.thin=1, n.chains=2, n.burnin=500, n.iter=1000, debug=FALSE, working.dir=getwd())
print(bugs.out, digits=2)
# run R2jags
library('R2jags')
data <- list(y = my.data, n.occasions = dim(my.data)[2], M = dim(my.data)[1])
inits <- function() {list(mean.phi = runif(1, 0, 1), mean.p = runif(1, 0, 1), z = my.data)}
parameters <- c("mean.p", "mean.phi")
jags.out2 <- jags(data = data, inits = inits, parameters,
model.file = "C:/Users/mmiller/Documents/simple R programs/my.model.txt",
n.thin=1, n.chains=2, n.burnin=500, n.iter=1000, working.dir=getwd())
print(jags.out2, digits=2)
以下是示例数据集：
my.data <- read.table(text = '
1 1 1 0 0 0 0
0 1 1 1 1 0 0
0 1 0 0 0 0 0
0 0 1 1 0 1 0
0 1 1 0 0 0 0
1 0 0 0 0 0 0
1 0 0 0 0 0 0
1 0 0 0 0 0 0
1 0 0 0 0 0 0
1 0 1 0 0 0 0
1 0 0 0 0 0 0
1 0 1 1 1 0 0
1 0 0 0 0 0 0
1 0 0 0 0 0 0
1 1 0 0 0 0 0
0 0 0 0 1 0 0
1 0 0 0 0 0 0
1 1 0 0 0 0 0
1 0 1 0 0 0 0
0 1 0 0 0 0 0
0 1 1 0 0 0 0
1 0 0 0 0 0 0
0 1 1 0 0 0 0
0 0 1 0 0 0 0
0 0 0 1 0 0 0
0 1 0 0 0 0 0
0 0 0 0 1 1 0
0 1 1 0 0 0 0
0 1 1 0 0 0 0
0 0 1 1 0 0 0
0 0 0 1 0 0 0
0 0 1 1 0 0 0
0 0 1 1 1 0 0
0 0 1 1 0 0 0
0 0 1 0 0 0 0
0 0 0 1 0 1 1
0 0 0 0 1 1 0
0 0 0 1 0 0 0
0 0 0 1 0 0 0
0 0 0 0 1 0 0
0 0 0 1 0 0 0
0 0 0 0 1 1 1
0 0 0 1 0 0 0
0 0 0 1 0 1 1
0 0 0 1 0 0 0
0 0 0 0 1 0 0
0 0 0 1 0 0 0
0 0 0 0 1 0 0
0 0 0 0 0 1 1
0 0 0 0 0 0 1
0 0 0 0 1 1 0
0 0 0 0 0 1 1
0 0 0 0 0 1 1
0 0 0 0 0 1 1
0 0 0 0 0 1 0
0 0 0 0 0 1 0
0 0 0 0 0 1 1
0 0 0 0 0 0 1
0 0 0 0 0 0 1
0 0 0 0 0 0 1
0 0 0 0 0 1 1
0 0 0 0 0 1 0
0 0 0 0 0 0 1
0 0 0 0 0 0 1
0 0 0 0 0 0 1
0 0 0 0 0 0 1
0 0 0 0 0 0 1
0 0 0 0 0 0 1', header = FALSE)
nz <- 300
my.data <- rbind(my.data, matrix(0, ncol = ncol(my.data), nrow = nz))
dim(my.data)
head(my.data)
my.data <- as.matrix(my.data)
这是一个在Jags中运行的线性回归：
# Linear regression in JAGS using R2jags
library('R2jags')
x <- rnorm(10)
mu <- -3.2 + 1.5 * x
y <- rnorm(10, mu, sd = 4)
cat ("
model {
for (i in 1:10) {
y[i] ~ dnorm(mu[i], tau)
mu[i] <- beta0 + beta1*x[i]
}
beta0 ~ dnorm(0, .01)
beta1 ~ dnorm(0, .01)
sigma ~ dunif(0,100)
tau <- 1 / (sigma * sigma)
}
", file = 'C:/Users/mmiller/Documents/simple R programs/normal.txt')
data <- list(y=y, x=x)
inits <- function()
list(beta1 = rnorm(1), beta0 = rnorm(1), sigma = runif(1,0,2))
parameters <- c("beta0", "beta1", "sigma", "tau")
out <- jags(data = data, inits = inits, parameters,
model.file = 'C:/Users/mmiller/Documents/simple R programs/normal.txt',
n.thin=1, n.chains=2, n.burnin=2000, n.iter=6000, working.dir=getwd())
print(out, digits=2)
答案 0 :(得分：2)
我想我已经找到了解决方案。 Jags对初始值很敏感。人们用Jags来克服这个问题的一个策略是尝试提出接近真值的起始值。
我使用z矩阵通过复制检测矩阵并从每个个体的第一次到最后一次检测中用1来填充该副本来做到这一点。当我使用新矩阵作为Jags的初始值时，z会运行。
以下是使用WinBUGS和Jags的占用方法分析样本数据集的完整代码。多州方法和暂定超人口（POPAN）方法如下所示。
# data
my.data <- read.table(text = '
1 1 1 0 0 0 0
0 1 1 1 1 0 0
0 1 0 0 0 0 0
0 0 1 1 0 1 0
0 1 1 0 0 0 0
1 0 0 0 0 0 0
1 0 0 0 0 0 0
1 0 0 0 0 0 0
1 0 0 0 0 0 0
1 0 1 0 0 0 0
1 0 0 0 0 0 0
1 0 1 1 1 0 0
1 0 0 0 0 0 0
1 0 0 0 0 0 0
1 1 0 0 0 0 0
0 0 0 0 1 0 0
1 0 0 0 0 0 0
1 1 0 0 0 0 0
1 0 1 0 0 0 0
0 1 0 0 0 0 0
0 1 1 0 0 0 0
1 0 0 0 0 0 0
0 1 1 0 0 0 0
0 0 1 0 0 0 0
0 0 0 1 0 0 0
0 1 0 0 0 0 0
0 0 0 0 1 1 0
0 1 1 0 0 0 0
0 1 1 0 0 0 0
0 0 1 1 0 0 0
0 0 0 1 0 0 0
0 0 1 1 0 0 0
0 0 1 1 1 0 0
0 0 1 1 0 0 0
0 0 1 0 0 0 0
0 0 0 1 0 1 1
0 0 0 0 1 1 0
0 0 0 1 0 0 0
0 0 0 1 0 0 0
0 0 0 0 1 0 0
0 0 0 1 0 0 0
0 0 0 0 1 1 1
0 0 0 1 0 0 0
0 0 0 1 0 1 1
0 0 0 1 0 0 0
0 0 0 0 1 0 0
0 0 0 1 0 0 0
0 0 0 0 1 0 0
0 0 0 0 0 1 1
0 0 0 0 0 0 1
0 0 0 0 1 1 0
0 0 0 0 0 1 1
0 0 0 0 0 1 1
0 0 0 0 0 1 1
0 0 0 0 0 1 0
0 0 0 0 0 1 0
0 0 0 0 0 1 1
0 0 0 0 0 0 1
0 0 0 0 0 0 1
0 0 0 0 0 0 1
0 0 0 0 0 1 1
0 0 0 0 0 1 0
0 0 0 0 0 0 1
0 0 0 0 0 0 1
0 0 0 0 0 0 1
0 0 0 0 0 0 1
0 0 0 0 0 0 1
0 0 0 0 0 0 1', header = FALSE)
#####
#####
my.z.init <- my.data
my.Sums <- rowSums(my.z.init)
mean(my.Sums)
first.one <- apply(my.z.init[,1:ncol(my.data)], 1, function(x) min(which(x == 1)))
first.one
last.one <- apply(my.z.init[,1:ncol(my.data)], 1, function(x) max(which(x == 1)))
last.one
for(i in 1:nrow(my.z.init)) {
my.z.init[i, c(first.one[i]:last.one[i])] = 1
}
my.z.init
#####
#####
nz <- 300
my.data <- rbind(my.data, matrix(0, ncol = ncol(my.data), nrow = nz))
dim(my.data)
head(my.data)
my.data <- as.matrix(my.data)
my.z.init <- rbind(my.z.init, matrix(0, ncol = ncol(my.z.init), nrow = nz))
dim(my.z.init)
head(my.z.init)
my.z.init <- as.matrix(my.z.init)
#####
#####
# BUGS code
sink("C:/Users/mmiller/Documents/simple R programs/my.model.txt")
cat("
model {
for (i in 1:M) {
for (t in 1:(n.occasions-1)) {
phi[i,t] <- mean.phi
}
for (t in 1:n.occasions) {
p[i,t] <- mean.p
}
}
mean.phi ~ dunif(0, 1)
mean.p ~ dunif(0, 1)
for (t in 1:n.occasions) {
gamma[t] ~ dunif(0, 1)
}
for (i in 1:M) {
z[i,1] ~ dbern(gamma[1])
mu1[i] <- z[i,1] * p[i,1]
y[i,1] ~ dbern(mu1[i])
for (t in 2:n.occasions) {
q[i,t-1] <- 1-z[i,t-1]
mu2[i,t] <- phi[i,t-1] * z[i,t-1] + gamma[t] * prod(q[i,1:(t-1)])
z[i,t] ~ dbern(mu2[i,t])
mu3[i,t] <- z[i,t] * p[i,t]
y[i,t] ~ dbern(mu3[i,t])
}
}
}
",fill=TRUE)
sink()
# run R2WinBUGS
setwd('C:/Users/mmiller/Documents/simple R programs')
library(R2WinBUGS)
data <- list(y = my.data, n.occasions = dim(my.data)[2], M = dim(my.data)[1])
inits <- function() {list(mean.phi = runif(1, 0, 1), mean.p = runif(1, 0, 1), z = my.data)}
parameters <- c("mean.p", "mean.phi")
bugs.out <- bugs(data, inits, parameters,
"C:/Users/mmiller/Documents/simple R programs/my.model.txt",
n.thin=1, n.chains=2, n.burnin=500, n.iter=1000, debug=FALSE, working.dir=getwd())
print(bugs.out, digits=2)
# run R2jags
library('R2jags')
data <- list(y = my.data, n.occasions = dim(my.data)[2], M = dim(my.data)[1])
inits <- function() {list(mean.phi = runif(1, 0, 1), mean.p = runif(1, 0, 1), z = my.z.init)}
parameters <- c("mean.p", "mean.phi", "gamma")
jags.out2 <- jags(data = data, inits = inits, parameters,
model.file = "C:/Users/mmiller/Documents/simple R programs/my.model.txt",
n.thin=1, n.chains=2, n.burnin=500, n.iter=1000, working.dir=getwd())
print(jags.out2, digits=2)
以下是我在z中运行模型时用于为多状态Jolly-Seber模型创建Jags矩阵的初始值的代码。我还没有复制多州模型代码：
CH.du <- cbind(rep(0, dim(CH)[1]), CH)
my.z.init <- CH.du
first.one <- apply(my.z.init[,1:ncol(CH.du)], 1, function(x) min(which(x == 1)))
last.one <- apply(my.z.init[,1:ncol(CH.du)], 1, function(x) max(which(x == 1)))
for(i in 1:nrow(my.z.init)) {
my.z.init[i, first.one[i] : last.one[i] ] = 2
if(first.one[i] > 1) my.z.init[i, 1 : (first.one[i] - 1) ] = 1
if(last.one[i] < ncol(my.z.init)) my.z.init[i, (last.one[i] + 1) : ncol(my.z.init) ] = 3
}
nz <- 500
CH.ms <- rbind(CH.du, matrix(0, ncol = dim(CH.du)[2], nrow = nz))
CH.ms[CH.ms==0] <- 2
my.z.init.ms <- rbind(my.z.init, matrix(0, ncol = dim(my.z.init)[2], nrow = nz))
my.z.init.ms[my.z.init.ms==0] <- 1
library('jagsUI')
data <- list(y = CH.ms, n.occasions = dim(CH.ms)[2], M = dim(CH.ms)[1])
inits <- function() {list(mean.phi = runif(1, 0, 1), mean.p = runif(1, 0, 1),
z = cbind(rep(NA, dim(my.z.init.ms)[1]), my.z.init.ms[,-1]))}
parameters <- c("mean.p", "mean.phi", "b", "Nsuper", "N", "B")
ni <- 2000
nt <- 3
nb <- 500
nc <- 3
js.occ <- jags(data = data, inits = inits, parameters,
model.file = "C:/Users/mmiller/Documents/simple R programs/js-ms.txt",
n.chains = nc, n.thin = nt, n.iter = ni, n.burnin = nb)
print(js.occ, digits = 3)
到目前为止，我能够在Jags中运行超人口（POPAN）方法的唯一方法是先在WinBUGS中运行模型，然后将这些平均估计用作启动Jags的值。我不确定这是创建初始值的好方法。
inits <- function() {list(mean.phi = js.super$mean$mean.phi,
mean.p = js.super$mean$mean.p,
psi = js.super$mean$psi,
z = round(js.super$mean$z) )}