R语言：Newton法、似然函数

hello，大家好，上一篇分享了如何用R语言实现蒙特卡洛模拟，并用蒙特卡洛模拟计算了分布的均值和方差，今天给大家分享如何用R语言来进行矩估计和似然函数的求解。

因为在求解矩估计和似然函数时，可能会遇到非线性方程组，所以先给大家介绍一下如何用Newton法来求解非线性方程组。

本文所涉及的前两道例题来自于《R统计建模与R软件》——薛毅、陈立萍编著。

Newton法

牛顿迭代法（Newton’s method）是牛顿在17世纪提出的一种在实数域和复数域上近似求解方程的方法。

设$r$是$f(x)=0$的根，选取$x_0$作为$r$的初始近似值，过点$(x_0,f(x_0))$做曲线$y=f(x)$的切线$L$，$L:y=f(x_0)+f^{\prime }(x_0)(x-x_0)$，则$L$与$x$轴的交点的横坐标$x_1=x_0-\frac{f(x_0)}{f^{\prime }(x_0)}$，称$x_1$为$r$的一次近似值。过点$(x_1,f(x_1))$做曲线$y=f(X)$的切线，并求该切线与$x$轴交点的横坐标$x_2=x_1-\frac{f(x_1)}{f^{\prime }(x_1)}$称$x_2$为$r$的二次近似值。重复以上过程，得$r$的近似值序列，其中，$x_{n+1}=x_n-\frac{f(x_n)}{f^{\prime }(x_n)}$称为$r$的$n+1$次近似值，上式称为牛顿迭代公式。

利用牛顿迭代算法的基本思路：确定迭代变量->建立迭代关系式->对迭代过程进行控制，接下来我们用一个例子来讲解。

例1：求解方程组

$$\{\begin{array}{l}{x}_1^2+x_2^2-5=0\\ (x_1+1)x_2-(3x_1+1)=0\end{array}$$

1、确定迭代变量$x=(x_1,x_2{)}^T$，设定初始值$x^{(0)}=(0,1{)}^T$；

2、建立迭代关系式：
$$x^{(k+1)}=x^{(k)}-[J(x^{(k)}{)}^{-1}]f(x^k)$$
其中$J(x)$为函数$f(x)$的Jacobi矩阵，即
$$J=\left(\begin{array}{cccc}\frac{\partial f_1}{\partial x_1}& \frac{\partial f_1}{\partial x_2}& \dots & \frac{\partial f_1}{\partial x_n}\\ \frac{\partial f_2}{\partial x_1}& \frac{\partial f_2}{\partial x_2}& \dots & \frac{\partial f_2}{\partial x_n}\\ ⋮& ⋮& & ⋮\\ \frac{\partial f_n}{\partial x_1}& \frac{\partial f_n}{\partial x_2}& \dots & \frac{\partial f_n}{\partial x_n}\end{array}\right)$$
3、对迭代过程进行控制，即精度要求$\epsilon =10^{-5}$。

Newtons <- function(fun, x, ep = 1e-5, it_max = 100){
    index <- 0; k <- 1
    while (k <= it_max){
        x1 <- x; obj <- fun(x)
        x <- x - solve(obj$J, obj$f)
        norm <- sqrt((x - x1) %*% (x - x1))
        if (norm < ep){
            index <- 1; break
        }
        k <- k + 1
    }
    obj <- fun(x)
    list(root = x, it = k, index = index, FunVal = obj$f)
}

funs <- function(x){
    f <- c(x[1]^2 + x[2]^2 - 5, (x[1] + 1)*x[2] - (3*x[1] + 1))
    J <- matrix(c(2*x[1], 2*x[2], x[2]-3, x[1]+1), nrow = 2, byrow = T)
    list(f = f, J = J)
}

Newtons(funs,c(0,1))
## $root
## [1] 1 2
## 
## $it
## [1] 6
## 
## $index
## [1] 1
## 
## $FunVal
## [1] 1.598721e-14 6.217249e-15

所以方程的解为$x^{\ast }=(1,2{)}^T$，总共迭代了6次。

矩估计

例2：设总体$X$服从二项分布$B(k,p)$，其中$k,p$为未知参数，$X_1,X_2,\dots ,X_n$是总体$X$的一个样本，求参数$k,p$的矩估计$\hat{k},\hat{p}$.

由二项分布的均值（一阶原点矩）和方差（二阶中心矩）可得方程组
$$\{\begin{array}{l}kp-\bar{X}=0\\ kp(1-p)-M_2=0\end{array}$$

moment_fun <- function(p){
    f <- c(p[1]*p[2]-A1,p[1]*p[2]-p[1]*p[2]^2-M2)
    J <- matrix(c(p[2],p[1],p[2]-p[2]^2,p[1]-2*p[1]*p[2]),nrow=2,byrow=T)
    list(f=f,J=J)
}

x <- rbinom(100,20,0.7)
n <- length(x)
A1 <- mean(x)
M2 <- (n-1)/n*var(x)
p <- c(10,0.5)
Newtons(moment_fun,p)
## $root
## [1] 19.9129849  0.7221419
## 
## $it
## [1] 6
## 
## $index
## [1] 1
## 
## $FunVal
## [1] 1.776357e-15 1.776357e-15

从结果可以看出，误差非常的小，但是也发现了一个弊端，在能用这个算法的情况下，计算往往也比较简单，所以它的效率相对较低。

接下来再给大家分享一个新的工具——uniroot函数，在遇到一些较为复杂的一元方程时可以用uniroot函数进行求解。

例3：设总体密度函数如下，$x_1,\dots ,x_n$是样本，试求未知参数的矩估计

$$p(x;\theta )=\sqrt{\theta }{x}^{\sqrt{\theta }-1},0<x<1,\theta >0.$$

按一般做法我们需要由$E(X)={\int }_0^{1}x\sqrt{\theta }{x}^{\sqrt{\theta }-1}\mathrm{d}x$推导出矩估计量$\hat{\theta }$，现在我们不推导直接用uniroot求解；

因为这个密度函数是自定义的一个密度函数，因此我们需要先写一个服从该密度函数的随机数生成函数：

rdensity <- function(n, theta){
    obj <- function(x){
        sqrt(theta)*x^(sqrt(theta)-1)
    }
    u <- c()
    while(length(u)<n){
        x <- runif(1,0,1)
        y <- runif(1,0,sqrt(theta)) #sqrt(theta)是当x=1是所对应的密度函数值
        if(y<=obj(x)){
            u <- c(u,x)
        }
    }
    return(u)
}

注：

这里的随机数生成采用的是随机投点的方式，取落在密度函数内的值。

x <- rdensity(100, 5)
fun <- function(theta){
    obj <- function(x) x*sqrt(theta)*x^(sqrt(theta)-1)
    integrate(obj, 0, 1)$value-mean(x)
}
uniroot(fun,c(1,10))
## $root
## [1] 5.214032
## 
## $f.root
## [1] 2.338409e-07
## 
## $iter
## [1] 6
## 
## $init.it
## [1] NA
## 
## $estim.prec
## [1] 6.103516e-05

注：

integrate()为定积分函数。

从结果可以看出，准确率还是非常高的。

似然函数

最后，我们再在似然函数上进行下实验，以t分布为例；

例3：设总体$X$服从自由度为p的t分布，其概率密度函数为

$$f(t;p)=\frac{\Gamma (\frac{p+1}{2})}{\Gamma (\frac{p}{2})}\frac{1}{(p\pi {)}^{\frac{1}{2}}}\frac{1}{(1+\frac{t^2}{p}{)}^{\frac{p+1}{2}}},其中\Gamma (x)={\int }_0^{\infty }{t}^{x-1}{e}^{-t}\mathrm{d}t$$

其中$p$为未知参数.$X_1,X_2,\dots ,X_n$是来自总体$X$的样本，求$p$的极大似然估计.

解：t分布的似然函数为
$$L(p;t)=\prod _{i=1}^{n}f(t_i;p)=[\frac{\Gamma (\frac{p+1}{2})}{\Gamma (\frac{p}{2})}\frac{1}{(p\pi {)}^{\frac{p+1}{2}}}{]}^n\frac{1}{{\prod }_{i=1}^n[(1+\frac{t_i^2}{p}{)}^{\frac{p+1}{2}}]}$$
相应的对数似然函数为
$$\ln L(p;t)=n\ln \Gamma (\frac{p+1}{2})-n\ln \Gamma (\frac{p}{2})-\frac{n}{2}\ln (p\pi )+\frac{p+1}{2}\sum _{i=1}^n\ln (1+\frac{t_i^2}{p})$$
得到对数似然方程
$$\frac{\mathrm{d}}{\mathrm{d}p}\ln L(p;t)=\frac{n}{2}\frac{{\Gamma }^{\prime }(\frac{p+1}{2})}{\Gamma (\frac{p+1}{2})}-\frac{n}{2}\frac{{\Gamma }^{\prime }(\frac{p}{2})}{\Gamma (\frac{p}{2})}-\frac{n}{2p}-\frac{1}{2}\sum _{i=1}^n\ln (1+\frac{t_i^2}{p})+\frac{p+1}{2}\sum _{i=1}^n\frac{(\frac{t_i}{p}{)}^2}{1+\frac{t_i^2}{p}}=0$$
其中${\Gamma }^{\prime }(x)={\int }_0^{\infty }{t}^{x-1}\ln t{e}^{-t}\mathrm{d}t$

n <- 100000
t <- rt(n, 6)
lnL <- function(p){
  (n/2)*digamma((p+1)/2)-(n/2)*digamma(p/2)-n/(2*p)-0.5*sum(log(1+t^2/p))+(p+1)/2*sum((t/p)^2/(1+t^2/p))
}
uniroot(lnL,c(1,10))
## $root
## [1] 6.092751
## 
## $f.root
## [1] -0.004239805
## 
## $iter
## [1] 8
## 
## $init.it
## [1] NA
## 
## $estim.prec
## [1] 6.103516e-05

注：

1、$digamma(x)=\frac{{\Gamma }^{\prime }(x)}{\Gamma (x)}$；

2、因为方程中p有充当分母，因此给定的范围不能包含0，不然会报错。

获取代码

本文代码均已上传，关注公众号，回复“似然函数”，即可获得