我想针对这些参数的先验绘制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)
现在我了解到,可以像这样简单地从模型字符串中省略似然性,从而可以从先验样本中提取样本
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);
}
"
但是有什么方法可以从第一个模型中的先前样本中获取样本吗?也许通过生成的数量块?
答案 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_alpha
,p_beta
和p_sigma
。这些将与alpha
,beta
和sigma
类似,但不会出现在任何似然函数中。
请注意,我们必须在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
/ alpha
和p_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_beta
和beta
放入一个数据框中,使其为长格式,以便估计值在一个列中,而分布在另一列中(先验对后验)。
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")