在不运行单独模型的情况下从先前采样

时间:2019-08-29 06:06:05

标签: r stan rstan

我想针对这些参数的先验绘制stan模型的参数估计值的直方图。我尝试通过在stan中运行一个模型,用ggplot2对其进行图形绘制,然后使用R的随机生成器函数(例如rnorm()rbinom())覆盖先验分布的近似值来进行此操作,但是我遇到了很多缩放问题,使图形无法正确显示。

我在想更好的方法是直接从先前的分布中直接采样,然后根据参数估计值绘制这些采样,但是运行一个完整的独立模型 just 从先验似乎很耗时。我想知道是否有一种方法可以在现有模型中甚至与之并行。

这是示例脚本。

# simulate linear model
a <- 3 # intercept
b <- 2 # slope

# data
x <- rnorm(28, 0, 1)
eps <- rnorm(28, 0, 2)
y <- a + b*x + eps

# put data into list
data_reg <- list(N = 28, x = x, y = y)

# create the model string

ms <- "
    data {
    int<lower=0> N;
    vector[N] x;
    vector[N] y;
    }
    parameters {
    real alpha;
    real beta;
    real<lower=0> sigma;
    }
    model {
    vector[N] mu;
    sigma ~ cauchy(0, 2);
    beta ~ normal(0,10);
    alpha ~ normal(0,100);
    for ( i in 1:N ) {
    mu[i] = alpha + beta * x[i];
    }
    y ~ normal(mu, sigma);
    }
"

# now fit the model in stan
fit1 <- stan(model_code = ms,     # model string
             data = data_reg,        # named list of data
             chains = 1,             # number of Markov chains
             warmup = 1e3,          # number of warmup iterations per chain
             iter = 2e3)         # show progress every 'refresh' iterations

# extract the sample estimates
post <- extract(fit1, pars = c("alpha", "beta", "sigma"))

# now for the density plots. Write a plotting function
densFunct <- function (parName) {
  g <- ggplot(postDF, aes_string(x = parName)) + 
              geom_histogram(aes(y=..density..), fill = "white", colour = "black", bins = 50) +
              geom_density(fill = "skyblue", alpha = 0.3)
  return(g)
}

# plot 
gridExtra::grid.arrange(grobs = lapply(names(postDF), function (i) densFunct(i)), ncol = 1)

enter image description here

现在我了解到,可以像这样简单地从模型字符串中省略似然性,从而可以从先验样本中提取样本

ms <- "
  data {
    int<lower=0> N;
    vector[N] x;
    vector[N] y;
  }
  parameters {
    real alpha;
    real beta;
    real<lower=0> sigma;
  }
  model {
    sigma ~ cauchy(0, 2);
    beta ~ normal(0,10);
    alpha ~ normal(0,100);
  }
"

但是有什么方法可以从第一个模型中的先前样本中获取样本吗?也许通过生成的数量块?

2 个答案:

答案 0 :(得分:2)

有两种方法可以做到这一点。

首先,如果程序足够通用,则只需传入零大小的数据,以使后验为先验。例如,在您给出的回归示例中,v <- c("nike", "adidas") unlist( mapply(function(x, y) { sapply(1:y, function(a) substr(x, 1, a)) }, v, nchar(v)) ) nike1 nike2 nike3 nike4 adidas1 adidas2 adidas3 adidas4 adidas5 adidas6 "n" "ni" "nik" "nike" "a" "ad" "adi" "adid" "adida" "adidas" 将起作用(以及正确的零尺寸x和y)。

第二,您可以在生成的数量块中编写一个纯Monte Carlo生成器(不使用MCMC)。像这样:

N = 0

第二种方法效率更高,因为它可以方便地绘制独立的样本,而无需执行任何MCMC。

答案 1 :(得分:0)

如何做到这一点的答案今天早上在我的公共汽车上出现了。当然,当我写完这些内容时,@ Bob Carpenter发布了我正在寻找的解决方案。相比之下,我的方法既笨拙又笨拙,但是确实有效。

我们需要做的是指定反映实际先验的先验,但绝不将其传递给似然函数。

因此,在上面的示例中,我们要做的就是在模型字符串中创建这些镜像变量。我们将它们称为p_alphap_betap_sigma。这些将与alphabetasigma类似,但不会出现在任何似然函数中。

请注意,我们必须在parameters{}块和model{}块中创建这些变量。

ms <- "
  data {
    int<lower=0> N;
    vector[N] x;
    vector[N] y;
  }

  parameters {
    // priors to sample from
    real p_alpha;
    real p_beta;
    real p_sigma;

    // real priors
    real alpha;
    real beta;
    real<lower=0> sigma;
  }

  model {
    vector[N] mu;

    // priors to sample from
    p_sigma ~ cauchy(0, 2);
    p_beta ~ normal(3,1);  // for didactic purposes
    p_alpha ~ normal(0,100);

    // actual priors
    sigma ~ cauchy(0, 2);
    beta ~ normal(0,10);
    alpha ~ normal(0,100);

    // likelihood
    for ( i in 1:N ) {
    mu[i] = alpha + beta * x[i];
    }
    y ~ normal(mu, sigma);
  }
"

请注意,镜像参数分布的规范应与实际先验的规范相匹配,这是我对p_alpha / alphap_sigma / sigma做的。出于教学目的,我故意使p_beta的中心和展开与beta不同,因为我将在下面在同一张图上绘制这些图。

现在再次运行模型

fit1 <- stan(model_code = ms,     
             data = data_reg,       
             chains = 1,            
             warmup = 1e3,         
             iter = 2e3)  

提取样品

post <- as.data.frame(extract(fit1, pars = c("p_alpha", "p_beta", "p_sigma", "alpha", "beta", "sigma")))  

head(post)


# output
    p_alpha   p_beta     p_sigma    alpha     beta    sigma
1 -81.44259 3.275672  -1.1416369 3.121382 2.499459 2.354001
2 161.03740 3.694711   0.2989131 3.648288 2.335520 2.140973
3 126.58106 3.495947  -2.0027929 3.846835 2.266247 3.037055
4  18.55785 3.283425  -0.4045153 2.903958 1.854639 1.807591
5 103.02826 5.213568 -18.3721863 3.980290 1.725396 2.178264
6  49.50477 1.737679   6.5971377 4.209471 2.535044 2.941958

这里有先验和后验作为单独的情节

所以现在我们在同一数据帧中具有相同参数的原始先验和后验。

现在如果要在同一张图上放置先验和后验怎么办?

首先将两个参数p_betabeta放入一个数据框中,使其为长格式,以便估计值在一个列中,而分布在另一列中(先验对后验)。

library(dplyr)
betaDF <- post %>% dplyr::select(grep("^.*beta$", names(.))) %>%
                   gather(key = source, value = estimate) %>%
                   transform(source = factor(ifelse(source == "p_beta", "prior", "posterior"), levels = c("prior", "posterior")))

现在绘制它

ggplot(betaDF, aes(x = estimate, fill = source)) +
       geom_density(alpha = 0.3) +
       coord_cartesian(xlim = c(-5,10)) +
       labs(x = "beta")

enter image description here