ggplot等效于gelman。r中的MCMC诊断图

我正在使用ggplot在r中创建一系列MCMC诊断图。我意识到gg中已经有一个用于MCMC绘图的软件包，但其中大部分是供我自己学习和实际使用的。有一件事我似乎不明白，那就是如何在ggplot框架中生成gelman.plot

gelman.diag函数只返回一个简单的数据点，我想重新创建完整的运行图，如gelman.plot所示

有人熟悉gelman势标度折减系数的算法结构和/或将其输出移植到ggplot的方法吗

---

谢谢大家!

您没有提供可复制的示例，因此我使用了。我们需要该示例中名为

combinedchains

的对象。为了避免把答案弄得乱七八糟，我在这篇文章的末尾放了相应的代码

现在我们可以在

combined.chains

上运行

gelman.plot

。这是我们要复制的绘图：

library(coda)
gelman.plot(combined.chains)

要创建ggplot版本，我们需要获取绘图的数据。我以前没有做过MCMC，所以我将让

gelman.plot

为我生成数据。对于您的实际用例，您可以直接生成适当的数据

让我们看看gelman.plot正在做什么：我们可以通过在控制台中键入裸函数名来查看该函数的代码。下面是部分功能代码。

…

显示为简洁起见，我删除了原始代码部分的位置。注意调用

gelman.preplot

，该函数的输出存储在

y

中。还请注意，

y

在末尾以不可见的方式返回

y

是一个列表，其中包含在ggplot中创建

gelman.plot

所需的数据

gelman.plot = function (x, bin.width = 10, max.bins = 50, confidence = 0.95, 
          transform = FALSE, autoburnin = TRUE, auto.layout = TRUE, 
          ask, col = 1:2, lty = 1:2, xlab = "last iteration in chain", 
          ylab = "shrink factor", type = "l", ...) 
{ 
  ...
  y <- gelman.preplot(x, bin.width = bin.width, max.bins = max.bins, 
                      confidence = confidence, transform = transform, autoburnin = autoburnin)
...
  return(invisible(y))
}

现在是ggplot版本。首先，

gp.dat

是一个列表，我们需要将该列表的各个部分转换为ggplot可以使用的单个数据帧

library(ggplot2)
library(dplyr)
library(reshape2)

df = data.frame(bind_rows(as.data.frame(gp.dat[["shrink"]][,,1]), 
                          as.data.frame(gp.dat[["shrink"]][,,2])), 
                q=rep(dimnames(gp.dat[["shrink"]])[[3]], each=nrow(gp.dat[["shrink"]][,,1])),
                last.iter=rep(gp.dat[["last.iter"]], length(gp.dat)))

对于绘图，我们将把

df

融入到长格式中，这样我们就可以将每条链放在一个单独的方面中

ggplot(melt(df, c("q","last.iter"), value.name="shrink_factor"), 
       aes(last.iter, shrink_factor, colour=q, linetype=q)) + 
  geom_hline(yintercept=1, colour="grey30", lwd=0.2) +
  geom_line() +
  facet_wrap(~variable, labeller= labeller(.cols=function(x) gsub("V", "Chain ", x))) +
  labs(x="Last Iteration in Chain", y="Shrink Factor",
       colour="Quantile", linetype="Quantile") +
  scale_linetype_manual(values=c(2,1))

---

MCMC创建

combinedchains

对象（代码复制自）的示例代码：

trueA = 5
trueB = 0
trueSd = 10
sampleSize = 31

x = (-(sampleSize-1)/2):((sampleSize-1)/2)
y =  trueA * x + trueB + rnorm(n=sampleSize,mean=0,sd=trueSd)

likelihood = function(param){
  a = param[1]
  b = param[2]
  sd = param[3]

  pred = a*x + b
  singlelikelihoods = dnorm(y, mean = pred, sd = sd, log = T)
  sumll = sum(singlelikelihoods)
  return(sumll)
}

prior = function(param){
  a = param[1]
  b = param[2]
  sd = param[3]
  aprior = dunif(a, min=0, max=10, log = T)
  bprior = dnorm(b, sd = 5, log = T)
  sdprior = dunif(sd, min=0, max=30, log = T)
  return(aprior+bprior+sdprior)
}

proposalfunction = function(param){
  return(rnorm(3,mean = param, sd= c(0.1,0.5,0.3)))
}

run_metropolis_MCMC = function(startvalue, iterations) {
  chain = array(dim = c(iterations+1,3))
  chain[1,] = startvalue
  for (i in 1:iterations) {
    proposal = proposalfunction(chain[i,])

    probab = exp(likelihood(proposal) + prior(proposal) - likelihood(chain[i,]) - prior(chain[i,]))

    if (runif(1)  <  probab){
      chain[i+1,] = proposal
    }else{
      chain[i+1,] = chain[i,]
    }
  }
  return(mcmc(chain))
}

startvalue = c(4,2,8)
chain = run_metropolis_MCMC(startvalue, 10000)

chain2 = run_metropolis_MCMC(startvalue, 10000)
combinedchains = mcmc.list(chain, chain2)

trueA=5
trueB=0
trueSd=10
样本大小=31
x=（（样本大小-1）/2）：（（样本大小-1）/2）
y=trueA*x+trueB+rnorm（n=sampleSize，平均值=0，sd=trueSd）
似然=函数（参数）{
a=参数[1]
b=参数[2]
sd=参数[3]
pred=a*x+b
单一可能性=dnorm（y，平均值=pred，sd=sd，log=T）
sumll=总和（单可能性）
返回（sumll）
}
先验=函数（参数）{
a=参数[1]
b=参数[2]
sd=参数[3]
aprior=dunif（a，最小值=0，最大值=10，对数=T）
b周期=d形式（b，标准差=5，对数=T）
sdprior=dunif（标准差，最小值=0，最大值=30，对数=T）
返回（四月+三月+三月）
}
proposalfunction=函数（参数）{
收益率（rnorm（3，平均值=参数，标准差=c（0.1,0.5,0.3）））
}
run_metropolis_MCMC=函数（起始值，迭代次数）{
链=数组（dim=c（迭代+1,3））
链[1，]=起始值
for（1中的i：迭代）{
建议=建议函数（链[i，]）
probab=exp（可能性（建议）+先前（建议）-可能性（链[i，]）-先前（链[i，]））
if（runif（1）

---

---

更新：

gelman.preplot

是一个内部

coda

功能，用户无法直接看到。要获取函数代码，请在控制台中键入

getAnywhere（gelman.preplot）

。然后，您可以看到函数在做什么，如果您愿意，可以构造自己的函数，以更适合ggplot的形式返回适当的诊断数据。

您没有提供可复制的示例，因此我使用了。我们需要该示例中名为

combinedchains

的对象。为了避免把答案弄得乱七八糟，我在这篇文章的末尾放了相应的代码

现在我们可以在

combined.chains

上运行

gelman.plot

。这是我们要复制的绘图：

library(coda)
gelman.plot(combined.chains)

要创建ggplot版本，我们需要获取绘图的数据。我以前没有做过MCMC，所以我将让

gelman.plot

为我生成数据。对于您的实际用例，您可以直接生成适当的数据

让我们看看gelman.plot正在做什么：我们可以通过在控制台中键入裸函数名来查看该函数的代码。下面是部分功能代码。

…

显示为简洁起见，我删除了原始代码部分的位置。注意调用

gelman.preplot

，该函数的输出存储在

y

中。还请注意，

y

在末尾以不可见的方式返回

y

是一个列表，其中包含在ggplot中创建

gelman.plot

所需的数据

gelman.plot = function (x, bin.width = 10, max.bins = 50, confidence = 0.95, 
          transform = FALSE, autoburnin = TRUE, auto.layout = TRUE, 
          ask, col = 1:2, lty = 1:2, xlab = "last iteration in chain", 
          ylab = "shrink factor", type = "l", ...) 
{ 
  ...
  y <- gelman.preplot(x, bin.width = bin.width, max.bins = max.bins, 
                      confidence = confidence, transform = transform, autoburnin = autoburnin)
...
  return(invisible(y))
}

现在是ggplot版本。首先，

gp.dat

是一个列表，我们需要将该列表的各个部分转换为ggplot可以使用的单个数据帧

library(ggplot2)
library(dplyr)
library(reshape2)

df = data.frame(bind_rows(as.data.frame(gp.dat[["shrink"]][,,1]), 
                          as.data.frame(gp.dat[["shrink"]][,,2])), 
                q=rep(dimnames(gp.dat[["shrink"]])[[3]], each=nrow(gp.dat[["shrink"]][,,1])),
                last.iter=rep(gp.dat[["last.iter"]], length(gp.dat)))

对于绘图，我们将把

df

融入到长格式中，这样我们就可以将每条链放在一个单独的方面中

ggplot(melt(df, c("q","last.iter"), value.name="shrink_factor"), 
       aes(last.iter, shrink_factor, colour=q, linetype=q)) + 
  geom_hline(yintercept=1, colour="grey30", lwd=0.2) +
  geom_line() +
  facet_wrap(~variable, labeller= labeller(.cols=function(x) gsub("V", "Chain ", x))) +
  labs(x="Last Iteration in Chain", y="Shrink Factor",
       colour="Quantile", linetype="Quantile") +
  scale_linetype_manual(values=c(2,1))

---

MCMC创建

combinedchains

对象（代码复制自）的示例代码：

trueA = 5
trueB = 0
trueSd = 10
sampleSize = 31

x = (-(sampleSize-1)/2):((sampleSize-1)/2)
y =  trueA * x + trueB + rnorm(n=sampleSize,mean=0,sd=trueSd)

likelihood = function(param){
  a = param[1]
  b = param[2]
  sd = param[3]

  pred = a*x + b
  singlelikelihoods = dnorm(y, mean = pred, sd = sd, log = T)
  sumll = sum(singlelikelihoods)
  return(sumll)
}

prior = function(param){
  a = param[1]
  b = param[2]
  sd = param[3]
  aprior = dunif(a, min=0, max=10, log = T)
  bprior = dnorm(b, sd = 5, log = T)
  sdprior = dunif(sd, min=0, max=30, log = T)
  return(aprior+bprior+sdprior)
}

proposalfunction = function(param){
  return(rnorm(3,mean = param, sd= c(0.1,0.5,0.3)))
}

run_metropolis_MCMC = function(startvalue, iterations) {
  chain = array(dim = c(iterations+1,3))
  chain[1,] = startvalue
  for (i in 1:iterations) {
    proposal = proposalfunction(chain[i,])

    probab = exp(likelihood(proposal) + prior(proposal) - likelihood(chain[i,]) - prior(chain[i,]))

    if (runif(1)  <  probab){
      chain[i+1,] = proposal
    }else{
      chain[i+1,] = chain[i,]
    }
  }
  return(mcmc(chain))
}

startvalue = c(4,2,8)
chain = run_metropolis_MCMC(startvalue, 10000)

chain2 = run_metropolis_MCMC(startvalue, 10000)
combinedchains = mcmc.list(chain, chain2)

trueA=5
trueB=0
trueSd=10
样本大小=31
x=（（样本大小-1）/2）：（（样本大小-1）/2）
y=trueA*x+trueB+rnorm（n=sampleSize，平均值=0，sd=trueSd）
似然=函数（参数）{
a=参数[1]
b=参数[2]
sd=参数[3]
pred=a*x+b
单一可能性=dnorm（y，平均值=pred，sd=sd，log=T）
sumll=总和（单可能性）
返回（sumll）
}
先验=函数（参数）{
a=参数[1]
b=参数[2]
sd=参数[3]
aprior=dunif（a，最小值=0，最大值=10，