应用贝叶斯 model (JAGS) 进行各种迭代

Question

考虑以下数据框：

set.seed(5678)
sub_df<- data.frame(clustersize= rep(1, 4), 
            lepsp= c("A", "B", "C", "D"), 
            dens= round(runif(4, c(0, 1)), 3), 
            db= sample(1:10, 4, replace=TRUE))

假设我想运行以下贝叶斯线性 model，它返回samples ，一个mc.array object：

library("rjags")
library("coda")
dataForJags <- list(dens=sub_df$dens, db=sub_df$db, N=length(sub_df$dens))


model<-"model{
  for(i in 1:N){
  dens[i] ~ dnorm(mu[i], tau)  
  # identity
  mu[i] <- int + beta1*db[i] 
  }
  tau ~ dgamma(0.1,0.1)
  int ~ dnorm(0, 0.001)
  beta1 ~ dnorm(0, 0.001) 
  }"

 ##compile
 
 mod1 <- jags.model(textConnection(model),data= dataForJags,n.chains=2)
 
 ##samples returns a list of mcarray objects  
 
 samples<-jags.samples(model= mod1,variable.names=c("beta1", 
 "int","mu","tau"),n.iter=100000)

鉴于samples$beta1[,,]表示来自 jags model 参数的后验分布的随机样本，那么总结一下，我的下一步是计算后验分布的均值和 95% 可信区间。 所以我会使用：

coeff_output<- round(quantile(samples$beta1[,,],probs=c(0.5,0.025,0.975)),3)

现在，假设我的实际数据框有多个级别的clustersize 。

set.seed(5672)
df<- data.frame(clustersize= c(rep(1, 4), rep(2,4), rep(3, 3)), 
            lepsp= c("A", "B", "C", "D", "B", "C", "D", "E", "A", "D", "F"), 
            dens= round(runif(11, c(0, 1)), 3), 
            db= sample(1:10, 11, replace=TRUE))

如何分别为每个级别的clustersize大小运行此 model 并使用 forloop 将 output 编译为单个结果数据帧或apply forloop ？ 对于clustersize的每个级别，生成的mc.array object samples应该是 output 到result_list和coeff_output应该是 output 到数据帧result_coeff 。

下面我分别计算每个clustersize的output，以产生预期的结果列表和数据框。

 #clustersize==1
 sub_df1<- data.frame(clustersize= rep(1, 4), 
                 lepsp= c("A", "B", "C", "D"), 
                 dens= round(runif(4, c(0, 1)), 3), 
                 db= sample(1:10, 4, replace=TRUE))

dataForJags <- list(dens=sub_df$dens, db=sub_df$db, N=length(sub_df$dens))
model<-"model{
for(i in 1:N){
dens[i] ~ dnorm(mu[i], tau)  
mu[i] <- int + beta1*db[i] 
}
tau ~ dgamma(0.1,0.1)
int ~ dnorm(0, 0.001)
beta1 ~ dnorm(0, 0.001) 
}"

mod1 <- jags.model(textConnection(model),data= dataForJags,n.chains=2)

samples1<-jags.samples(model= mod1,variable.names=c("beta1", 
"int","mu","tau"),n.iter=100000)

coeff_output1<- 
data.frame(as.list(round(quantile(samples1$beta1[,,],probs=c(0.5,0.025,0.975)),3)))

#clustersize==2
sub_df2<- data.frame(clustersize=  rep(2,4), 
                 lepsp= c( "B", "C", "D", "E"), 
                 dens= round(runif(4, c(0, 1)), 3), 
                 db= sample(1:10, 4, replace=TRUE))
dataForJags <- list(dens=sub_df$dens, db=sub_df$db, N=length(sub_df$dens))
model<-"model{
for(i in 1:N){
dens[i] ~ dnorm(mu[i], tau)  
mu[i] <- int + beta1*db[i] 
}
tau ~ dgamma(0.1,0.1)
int ~ dnorm(0, 0.001)
beta1 ~ dnorm(0, 0.001) 
}"

mod1 <- jags.model(textConnection(model),data= dataForJags,n.chains=2)

samples2<-jags.samples(model= mod1,variable.names=c("beta1", 
 "int","mu","tau"),n.iter=100000)

coeff_output2<- 
data.frame(as.list(round(quantile(samples2$beta1[,,],probs=c(0.5,0.025,0.975)),3)))    

#clustersize==3
sub_df3<- data.frame(clustersize= rep(3, 3), 
                 lepsp= c("A", "D", "F"), 
                 dens= round(runif(3, c(0, 1)), 3), 
                 db= sample(1:10, 3, replace=TRUE))
dataForJags <- list(dens=sub_df$dens, db=sub_df$db, N=length(sub_df$dens))
model<-"model{
for(i in 1:N){
dens[i] ~ dnorm(mu[i], tau)  
mu[i] <- int + beta1*db[i] 
}
tau ~ dgamma(0.1,0.1)
int ~ dnorm(0, 0.001)
beta1 ~ dnorm(0, 0.001) 
}"

mod1 <- jags.model(textConnection(model),data= dataForJags,n.chains=2)

samples3<-jags.samples(model= mod1,variable.names=c("beta1", 
"int","mu","tau"),n.iter=100000)

coeff_output3<- 
data.frame(as.list(round(quantile(samples3$beta1[,,],probs=c(0.5,0.025,0.975)),3)))

所需的最终 output：

result_list<- list(samples1, samples2, samples3)

result_coeff<-rbind(coeff_output1, coeff_output2, coeff_output3)

这是实际数据框的链接。 该解决方案应该能够处理集群大小高达 600 的大型 dataframe。

download.file("https://drive.google.com/file/d/1ZYIQtb_QHbYsInDGkta-5P2EJrFRDf22/view?usp=sharing",temp)

Answer 1

这里有几个问题需要考虑，这些问题是由您尝试做的事情的规模引起的。 您正在创建超过 550 个不同jags.sample对象，每个对象都有 100000 次迭代，然后尝试将所有这些对象存储在一个列表中。 在大多数机器上，这将导致 memory 问题：output 太大了。

我们至少有两种方法可以解决这个问题：

1. 采取措施尽可能减少 memory 对我们输入数据的使用。
2. 调整我们的 JAGS output，使其不会从每个链中节省太多迭代。

我对您的代码进行了许多修改，以使其能够与您的实际数据集一起使用。

创建输入数据：

在您的原始代码中， clustersize和db都具有数据类型numeric ，即使它们只需要是整数。 numeric类型占用 8 个字节，而integer类型仅占用 4 个字节。 如果我们将这两列强制转换为integer类型，我们实际上可以将下一步数据帧列表的 memory 大小减少大约 30%。

library("tidyverse")

#### Load Raw Data ####
df <- read_csv("example.csv") %>%
  select(-1) %>%
  mutate(clustersize = as.integer(clustersize),
         db = as.integer(db))

初始 JAGS 调优

您为每个链使用了太多的迭代； niter = 100000 非常高。 您还应该使用 n.burn 指定老化期，使用n.burn指定适应期，并使用n.adapt指定thin参数。 细化参数在这里特别重要——这直接减少了我们从每个链中节省的迭代次数。 细化参数为 50 意味着我们只保存每 50 个结果。

有一些事后方法可以选择您的细化参数、老化和适应期，但该讨论超出了 SO 的 scope。 有关所有这些 arguments 所做的一些基本信息，这里有一个很好的答案： https://stackoverflow.com/a/38875637/9598813 。 目前，我提供了允许此代码在整个数据集上运行的值，但我建议您仔细 select 用于最终分析的值。

使用 tidybayes

以下解决方案使用tidybayes package。 这提供了一个干净的 output 并允许我们巧妙地将所有系数汇总行绑定到单个 dataframe 中。 请注意，我们使用coda.samples()而不是jags.samples() ，因为这提供了更通用的 MCMC object ，我们可以将其传递给spread_draws() 。 我们还使用dplyr::group_split() ，它的计算效率比split()略高。

library("rjags")
library("coda")
library("tidybayes")

set.seed(5672)
result <- df %>% group_split(clustersize) %>% map(~{
  
  dataForJags <- list(dens=.x$dens, db=.x$db, N=length(.x$dens))
  
  # Declare model structure
  mod1 <- jags.model(textConnection(model),
                     data=dataForJags,
                     n.chains=2)
  
  # samples returns a list of mcmc objects  
  samples<-coda.samples(model=mod1,
                        variable.names=c("beta1","int","mu","tau"),
                        n.burn=10000,
                        n.adapt=5000,
                        n.iter=25000,
                        thin=50
  )
  # Extract individual draws
  samp <- spread_draws(samples, beta1)
  
  # Summarize 95% credible intervals
  coeff_output <- spread_draws(samples, beta1) %>%
    median_qi(beta1)

  list(samples = samp, coeff_output = coeff_output)
}) %>% transpose()

# List of sample objects
result$samples
# Dataframe of coefficient estimates and 95% credible intervals
result_coeff <- bind_rows(result$coeff_output, .id = "clustersize")

Answer 2

您可以使用来自map purrr的 map 并split不同的clustersize ：

library(rjags)
library(coda)
library(purrr)

set.seed(5678)
set.seed(5672)
df<- data.frame(clustersize= c(rep(1, 4), rep(2,4), rep(3, 3)), 
                lepsp= c("A", "B", "C", "D", "B", "C", "D", "E", "A", "D", "F"), 
                dens= round(runif(11, c(0, 1)), 3), 
                db= sample(1:10, 11, replace=TRUE))

model<-"model{
  for(i in 1:N){
  dens[i] ~ dnorm(mu[i], tau)  
  # identity
  mu[i] <- int + beta1*db[i] 
  }
  tau ~ dgamma(0.1,0.1)
  int ~ dnorm(0, 0.001)
  beta1 ~ dnorm(0, 0.001) 
  }"

# split data for different clustersize and calculate result
result <- df %>% split(.$clustersize) %>% map(~{

    dataForJags <- list(dens=.x$dens, db=.x$db, N=length(.x$dens))

    ##compile
    mod1 <- jags.model(textConnection(model),data= dataForJags,n.chains=2)

    ##samples returns a list of mcarray objects  
    samples<-jags.samples(model= mod1,variable.names=c("beta1","int","mu","tau"),n.iter=100000)
    coeff_output<- data.frame(as.list(round(quantile(samples$beta1[,,],probs=c(0.5,0.025,0.975)),3)))
    list(samples = samples, coeff_output = coeff_output)
    }) %>% transpose()

result$samples
result$coeff_output

请注意使用purrr::transpose根据您的要求将最终结果转换为样本list和 coefs list 。