[Bayes] prod: M-H: Independence Sampler for Posterior Sampling

[Bayes] prod: M-H: Independence Sampler for Posterior Sampling

dchisq gives the density,                          # 计算出分布下某值处的密度值

pchisq gives the distribution function,

qchisq gives the quantile function,

rchisq generates random deviates.

---

通过一个例子直接了解：

原分布：从Rayleigh distribution中抽样。这是什么分布？ (一个不熟悉的分布)

当一个随机二维向量的两个分量呈独立的、有着相同的方差的正态分布时，这个 向量的模 呈 瑞利分布。

例如：两个正交高斯噪声信号之和的包络服从瑞利分布。

提议分布：卡方分布 （一个相对熟悉的分布）

若n个相互独立的随机变量ξ₁、ξ₂、……、ξn 独立同分布于标准正态分布，则这n个服从标准正态分布的随机变量的 平方和 构成一新的随机变量，其分布规律称为 卡方分布（chi-square distribution）。

Sol 思路：如何通过提议分布（卡方分布）的帮助下获得原分布（瑞利分布）的sampling points呢？

可见，其中没有通过积分求CDF的过程。但reject的过程依然会损失效率。

代码实现：

     f <- function(x, sigma) {　　    // 瑞利分布
         if (any(x < 0)) return (0)
         stopifnot(sigma > 0)
         return((x / sigma^2) * exp(-x^2 / (2*sigma^2)))
     }

     m <- 10000
     sigma <- 4　　　　　　　　　　　// constant
     x <- numeric(m)　　          // m个0构成的序列 就是x
     x[1] <- rchisq(1, df=1)　　  // R里的x的index 其实是xth; 第一个参数表示：取一个随机数。
     k <- 0　　                   // 被拒绝的次数
     u <- runif(m)

     for (i in 2:m) {
         xt  <- x[i-1]　　　　　　 　　 // 当前的; 第一个值是卡方df=1时的一个随机值。
         y   <- rchisq(1, df = xt)　　// 相比Gibbs，这里易给出一个随机点
         num <- f( y, sigma) * dchisq(xt, df = y)　　 // 分子; y,下一个预估计的值
         den <- f(xt, sigma) * dchisq(y,  df = xt)　　// 分母; xt,当前已有的值 （注意，卡方不是对称分布）
         if (u[i] <= num/den) x[i] <- y else {
              x[i] <- xt
              k <- k+1     #y is rejected 记录一次被拒绝
         }
     }

     print(k)/m　　　　　　　　　　　// 可知，此方法拒绝率很高,40%左右

     index <- 5000:5200
     y1 <- x[index]
     plot(index, y1, type="l", main="", ylab="x")　　// 可见，有很多短的平移线（被拒绝的时间点上链没有移动）

     b <- 2001      #discard the burnin sample
     y <- x[b:m]
     a <- ppoints(100)
     QR <- sigma * sqrt(-2 * log(1 - a))  #quantiles of Rayleigh　针对瑞利分布更为高效地产生随机数的方法，此处略
     Q <- quantile(x, a)

     qqplot(QR, Q, main="",
         xlab="Rayleigh Quantiles", ylab="Sample Quantiles")

     hist(y, breaks="scott", main="", xlab="", freq=FALSE)
     lines(QR, f(QR, 4))

参数为4时，瑞利分布与其模拟直方图对比如下：

x[ ]数据如下所示，拒绝率很高。

构成直方图的x中，可见有许多未有变化的值，如下：

问题：

被拒绝的点为什么要纳入直方图统计中？

拒绝率高，收敛的效率比较低。这与上一个问题有什么联系么？

答案请见下一个实验。

---

原分布： t分布 sampling。

把一般的正态分布标准化都是令u=（x－μ)/σ的吧，可是σ未知，所以t分布就出现了。

令 t=(x的平均数－μ)/样本平均数标准差。

这样就化成另一种标准正态分布了,不过为了和一般意义上的标准正态分布区别，特取名为t分布。

提议分布：如果是对称的, i.e. 正态分布。

代码实现：

    rw.Metropolis <- function(n, sigma, x0, N) {　　// 因为要做四次实验对比，所以封装成了函数
        # n: degree of freedom of t distribution
        # sigma:  standard variance of proposal distribution N(xt,sigma)
        # x0: initial value
        # N: size of random numbers required.
         x <- numeric(N)
         x[1] <- x0
         u <- runif(N)
         k <- 0
         for (i in 2:N) {
             y <- rnorm(1, x[i-1], sigma)
                 if (u[i] <= (dt(y, n) / dt(x[i-1], n)))　　// <-- 因为对称，所以约掉了提议分布部分;剩下的就只有dt(x),即：t分布
                     x[i] <- y
                 else {
                     x[i] <- x[i-1]
                     k <- k + 1
             }
         }
         return(list(x=x, k=k))
     }

     n <- 4  #degrees of freedom for target Student t dist.
     N <- 2000
     sigma <- c(.05, .5, 2,  16)　　// concatenate, 成为一个向量

     x0 <- 10 #初始值，所以导致了burn in
     rw1 <- rw.Metropolis(n, sigma[1], x0, N)
     rw2 <- rw.Metropolis(n, sigma[2], x0, N)
     rw3 <- rw.Metropolis(n, sigma[3], x0, N)
     rw4 <- rw.Metropolis(n, sigma[4], x0, N)
     //Notice: rw 保存了x的样本集，以及拒绝率
     #number of candidate points rejected
     print(c(rw1$k, rw2$k, rw3$k, rw4$k)/N)　　// 类中的某个成员变量，有意思的写法

     par(mfrow=c(2,2))  #display 4 graphs together
     refline <- qt(c(.025, .975), df=n)
     rw <- cbind(rw1$x, rw2$x, rw3$x,  rw4$x)
     for (j in 1:4) {
         plot(rw[,j], type="l",
              xlab=bquote(sigma == .(round(sigma[j],3))),
              ylab="X", ylim=range(rw[,j]))
         abline(h=refline)
     }
     par(mfrow=c(1,1)) #reset to default

【0.15, 0.5】之间是可以接受的“拒绝率区间”，以下只有一个符合。

> x0
[1] 10
> print(c(rw1$k, rw2$k, rw3$k, rw4$k)/N)　　// 十分必要的指标
[1] 0.0075 0.1460 0.4655 0.8960

方差太小，拒绝的少，有点游动的太随机。
方差太大，拒绝的多，产量少，效率太低。

方差太小，需要更多的迭代才能看出收敛性质，如下所示，迭代次数扩大100倍。

核心理解：

Rejection Rate 体现了mcmc收敛的稳定性。

2000个样本范围内，图1收敛慢，那么，所得到的样本，也就是x[ ]无法体现完整的t分布的属性，如下：

rw1$x
b <-       #discard the burnin sample
y <- rw1$x[b:N]
hist(y, breaks="scott", main="", xlab="", freq=FALSE)

500到2000的点属于在未稳定之前收集，故导致所得直方图不好。

mcmc收敛稳定后（图二），所得直方图如下：（左图是2000个样本点；右图是5000个样本点）

但并非收敛的快就好，副作用是图刻画的不够精细（图四）。如下：

　　提议分布的四个方差：sigma <- c(.05, .5, 2,  16)

Jeff: 好点够精细，但好点太少【n变大，等待收敛时刻，收集更多好点】 ----> 好点够多，但好点不够精细【n变大，好点多了，跳到精细的好点也就多了】

补充：http://blog.csdn.net/xianlingmao/article/details/7768833

这个算法是两个作者的合称，但不是同一篇论文的，一个是1953年，另外一个是197x年对1953年的工作进行了一些扩展，所以以这两位作者的名字来命名这个算法。

假设要采样的概率分布是\pi(x)，现在假设有一个概率分布p(y|x)，使得\pi(x)*p(y|x) = \pi(y)*p(x|y)成立，称细致平衡公式，这个细致平衡公式是markov chain能达到稳定分布的必要条件。因此关键是构建出一个概率分布p(y|x)使得它满足细致平衡。现在假设我们有一个容易采样的分布q(y|x)（称为建议分布)，对于目前的样本x，它能够通过q(y|x)得到下一个建议样本y，这个建议样本y按照一定的概率被接受或者不被接受，称为比率\alpha(x, y) = min{1, q(x|y)*\pi(y)/[q(y|x)*\pi(x)]}。即如果知道样本xi，如何知道下一个样本x_{i+1}是什么呢？就是通过q(y|xi)得到一个建议样本y，然后根据\alpha(xi, y)决定x_{i+1}=y 还是x_{i+1}=xi。可以证明分布q(y|x)*\alpha(x,y)满足细致平衡，同时可以证明这样抽取得到的样本是分布\pi(x)的样本。具体的步骤如下：

1. 给定一个起始样本x_0和一个建议分布q(y|x)；
2. 对于第i个样本xi，通过q(y|xi)得到一个建议样本y；计算比率\alpha(xi, y)= min{1, q(xi|y)*\pi(y)/[q(y|xi)*\pi(xi)]};
3. 抽取一个均匀分布样本ui ~ U(0,1)，如果ui <= \alpha(xi,y)，则x_{i+1} = y；否则x_{i+1} = xi；
4. 重复步骤2~3，直到抽取到想要的样本数量为止。

如果，建议分布q(y|x) 满足：q(y|x) = q(x|y)，即对称，这个时候比率\alpha(x, y) = min{1, \pi(y)/\pi(x)}就是1953年最原始的算法，后来hasting把这个算法扩展了，不要求建议分布式对称的，从而得到了上述的算法。

然而这个算法有一个缺点，就是抽样的效率不高，有些样本会被舍弃掉。从而产生了Gibbs算法。

Goto: Metroplis Algorithm --> Gibbs Sampling

[Bayes] prod: M-H: Independence Sampler for Posterior Sampling

M-H是Metropolis抽样方法的扩展，扩展后可以支持不对称的提议分布。

对于M-H而言，根据候选分布g的不同选择，衍生出了集中不同的变种：

（1）Metropolis抽样方法

（2）随机游动Metropolis

（3）独立抽样方法　　<---- 本章涉及的方法

（4）逐分量的M-H抽样方法

独立抽样方法是M-H的一个特殊形式。因为独立，所以提议分布去掉了先验的影响。

[Bayes] Metropolis-Hastings Algorithm 中可见的例如下图，是否可以用于预测参? 在此用于预测混合比例值。

所有样本连乘：

> print(prod(1:9)) == print(gamma(10))
[1] 362880
[1] 362880
[1] TRUE

---

一个后验sampling的例子，目的就是求出sita的后验，在如下例子中就是sita要逼近0.2。

混合分布：0.2*N(0,1) + 0.8*N(5,1)

     m <- 5000 #length of chain
     xt <- numeric(m)
     a <- 1             #parameter of Beta(a,b) proposal dist.
     b <- 1             #parameter of Beta(a,b) proposal dist.
     p <- .2            #mixing parameter
     n <- 30            #sample size
     mu <- c(0, 5)      #parameters of the normal densities
     sigma <- c(1, 1)

     # generate the observed sample
     i <- sample(1:2, size=n, replace=TRUE, prob=c(p, 1-p))　　//1:2之间de数，混合构成的一个set.
     x <- rnorm(n, mu[i], sigma[i])　　     // 按照你的份额(i)产生你的点，按照我的份额(i)产生我的点.

     # hist of sample x and true density
     hist(x,freq=F)
     z <- seq(min(x), max(x), length=100)
     lines(z, p*dnorm(z,mean=mu[1],sd=sigma[1])+(1-p)*dnorm(z,mean=mu[2],sd=sigma[2]))

Continue...

    # generate the independence sampler chain
    u <- runif(m)
    y <- rbeta(m, a, b)      #proposal distribution --> 提前给y设定好随机值序列，之后便无需一次生成一个的那般耗时
    xt[1] <- .5

    for (i in 2:m) {
        fy <- y[i]        * dnorm(x, mu[1], sigma[1]) +
              (1-y[i])    * dnorm(x, mu[2], sigma[2])　　　　// 分子 的f(x)
        fx <- xt[i-1]     * dnorm(x, mu[1], sigma[1]) +
              (1-xt[i-1]) * dnorm(x, mu[2], sigma[2])　　　　// 分母 的f(x)

        r  <- prod(fy/fx)     *　　                         // 点积，数量积，内积，product：表示了连乘，似然的感觉
              ( xt[i-1]^(a-1) * (1-xt[i-1])^(b-1) ) /
              ( y[i]^(a-1)    * (1-y[i])^(b-1) )

        if (u[i] <= r)
            xt[i] <- y[i]
        else {
            xt[i] <- xt[i-1]
 
    }

    # plot for convergence diagnostic purpose
    par(mfrow=c(1,2))
    plot(xt, type="l", ylab="p")
    hist(xt[101:m], main="", xlab="p", prob=TRUE)
    print(mean(xt[101:m]))

提议分布 改为 Be(5,2) 后，产生的链效率很低，如下。

期望是 [1] 0.2641469，而不是0.2。意味着什么？

估计的貌似不准？还是迭代的次数不够多？

答案：因为x的样本不够多，导致似然误差较大。

总结：

M-H用于给某个复杂的分布sampling。

M-H的简化形式：独立采样方法，则可以用于求后验分布，如上例所示。

---

扩展：

    m  <- 5000          #length of chain
    xt <- numeric(m)
# 提议分布参数
    a  <- 1             #parameter of Beta(a,b) proposal dist.
    b  <- 1             #parameter of Beta(a,b) proposal dist.
    p  <- .2            #mixing parameter
    n  <- 300           #sample size
    mu    <- c(0, 5)    #parameters of the normal densities
    sigma <- c(1, 1)
    k <- 0

    # generate the observed sample
    i <- sample(1:2, size=n, replace=TRUE, prob=c(p, 1-p))
# 原分布的样本点
    x <- rnorm(n, mu[i], sigma[i])

    # hist of sample x and true density
    hist(x,freq=F)
    z <- seq(min(x), max(x), length=100)
    lines(z, p*dnorm(z,mean=mu[1],sd=sigma[1])+(1-p)*dnorm(z,mean=mu[2],sd=sigma[2]))

    # generate the independence sampler chain
    u <- runif(m)
# 提议分布
    y <- rbeta(m, a, b)      #proposal distribution
    xt[1] <- .5

    for (i in 2:m) {
#原分布的样本点向量
        fy <- y[i] * dnorm(x, mu[1], sigma[1]) +
                (1-y[i]) * dnorm(x, mu[2], sigma[2])
        fx <- xt[i-1] * dnorm(x, mu[1], sigma[1]) +
                (1-xt[i-1]) * dnorm(x, mu[2], sigma[2])

        r <- prod(fy / fx) *
               (xt[i-1]^(a-1) * (1-xt[i-1])^(b-1)) /
                 (y[i]^(a-1) * (1-y[i])^(b-1))

        if (u[i] <= r)
          xt[i] <- y[i]
        else {
          xt[i] <- xt[i-1]
          k <- k+1
        }
    }

    # plot for convergence diagnostic purpose
    par(mfrow=c(1,2))
    plot(xt, type="l", ylab="p")
    hist(xt[101:m], main="", xlab="p", prob=TRUE)
    print(mean(xt[101:m]))
    print(k/m)