R学习之统计算法与R优化包(极大似然估计) --(R语言编程)-----数模

极大似然估计(直接上典例)

这里写图片描述

这里写图片描述

R代码

library(MASS);attach(geyser);hist(waiting,freq = F)

#
mnf<-function(pa,data){
  x<-dnorm(data,pa[2],sqrt(pa[4]))
  y<-dnorm(data,pa[3],sqrt(pa[5]))
  pdf=pa[1]*x+(1-pa[1])*y
  l=sum(log(pdf))
  return(-l)
}
ML.waiting=nlminb(c(0.5,53,80,3,4),
                  mnf,
                  data=waiting,
                  lower=c(0.01,-Inf,-Inf,0,0),
                  upper=c(0.999,Inf,Inf,Inf,Inf))
ML.waiting

#
hist(waiting,freq = F,ylim = c(0,0.04))
z=seq(40,120,length=100)
f=ML.waiting$par[1]*dnorm(z,ML.waiting$par[2],sqrt(ML.waiting$par[4]))+(1-ML.waiting$par[1])*dnorm(z,ML.waiting$par[3],sqrt(ML.waiting$par[5]))
lines(z,f,col=2,lwd=2)
lines(z,dnorm(z,mean(waiting),sd(waiting)),col="blue")

detach()

其中函数说明:

  • library()
    载入包的命令,在一个函数中,如果一个包不存在,执行到library将会停止执行
    MASS一个工具包
    相关操作:
    (.packages()) #列出当前已经加载的包
    detach(package:ggplot2) # 卸载ggplot2包
    例:
> (.packages())
[1] "stats"     "graphics"  "grDevices" "utils"    
[5] "datasets"  "methods"   "base"     
> library(MASS)
> (.packages())
[1] "MASS"      "stats"     "graphics"  "grDevices"
[5] "utils"     "datasets"  "methods"   "base"     
> detach(package:MASS)
> (.packages())
[1] "stats"     "graphics"  "grDevices" "utils"    
[5] "datasets"  "methods"   "base" 

R语言包很多,需要一个个取了解,下面是博友罗列的包作用,可以参考

  • attach()
    attach函数可用于对应数据框的拆分,使得可以方便使用数据库单独元素
    data.frame()是用于组合成数据框的函数
    使用如例
> d <- data.frame(name=c("李明", "张聪", "王建"), age=c(30, 35, 28),  height=c(180, 162, 175))
> d
  name age height
1 李明  30    180
2 张聪  35    162
3 王建  28    175
> name
Error: object 'name' not found
> attach(d)
> name
[1] 李明 张聪 王建
Levels: 李明 王建 张聪
> age
[1] 30 35 28
detach()

tip:注意与detach()配合使用,防止出错
更多关于数据框处理的
geyser是MASS中一组数据,

>geyser
    waiting  duration
1        80 4.0166667
2        71 2.1500000
3        57 4.0000000
4        80 4.0000000
5        75 4.0000000
……

该数据采集自美国黄石公园内的一个名叫Old Faithful 的喷泉。“waiting”就是喷泉两次喷发的间隔时间,“duration”当然就是指每次喷发的持续时间。在这里,我们只用到“waiting”数据,为了简单一点,可以使用attach()函数。

  • hist()
    hist函数是画直方图函数
    其中参数freq默认为TRUE,表示纵坐标为频次,FALSE表示纵坐标为频率
    ylim用于描述纵坐标
    这里写图片描述
  • dnorm()
    dnorm函数是用来生成正态密度函数
    如dnorm(0,1,2)则得出的是均值为1,标准差为2的正态分布在0处的概率值
    更多详见

  • return()
    return(-l)其中return()可以省略,直接写-l,函数默认返回就会是-l
    由于nlminb()是计算极小值的,而要求求的是极大值,因此函数function中最后返回的是对数似然函数的相反数。

  • nlminb()
    做参数估计的一个函数
    nlminb(start, objective, gradient = NULL, hessian = NULL, …,scale = 1, control = list(), lower = -Inf, upper = Inf)
    参数start是数值向量,用于设置参数的初始值;
    objective指定要优化的函数;
    gradient和hess用于设置对数似然的梯度,通常采用默认状态;
    control是一个控制参数的列表:
    lower和upper设置参数的下限和上限,如果未指定,则假设所有参数都不受约束。
    其中要加data参数,为了给后面参数的mnf函数中用,是mnf的一个参数(不nlminb官方文档好像没写这种参数,这种操作!!!),不加data参数的话,只要改去掉nmf中data参数,并在全局定义了
    使用nlminb()之前最大的要点是确定初始值,初始值越接近真实值,计算的结果才能越精确。我们猜想数据的分布是两个正态的混合,概率P直接用0.5做初值即可。通过直方图中两个峰对应的x轴数值(大概为50和80,或者题目给出的53和80),就可以将初值设定为μ1和μ2。而概率P处于((0,1)区间内,参数σ1,σ2是正态分布的标准差,必须大于0,所以通过lower和upper两个参数进行一定的约束。
    得到的优化结果参数放在 名字$par 中
    详见

  • sd()
    用于求数据的标准差

结果

> library(MASS);attach(geyser);hist(waiting,freq = F)
> 
> #
> mnf<-function(pa,data){
+   x<-dnorm(data,pa[2],sqrt(pa[4]))
+   y<-dnorm(data,pa[3],sqrt(pa[5]))
+   pdf=pa[1]*x+(1-pa[1])*y
+   l=sum(log(pdf))
+   return(-l)
+ }
> ML.waiting=nlminb(c(0.5,53,80,3,4),
+                   mnf,
+                   data=waiting,
+                   lower=c(0.01,-Inf,-Inf,0,0),
+                   upper=c(0.999,Inf,Inf,Inf,Inf))
> ML.waiting
$`par`
[1]  0.3075936 54.2026478 80.3603111 24.5223139 56.3645684

$objective
[1] 1157.542

$convergence
[1] 0

$iterations
[1] 37

$evaluations
function gradient 
      39      227 

$message
[1] "relative convergence (4)"

> 
> #
> hist(waiting,freq = F,ylim = c(0,0.04))
> z=seq(40,120,length=100)
> f=ML.waiting$par[1]*dnorm(z,ML.waiting$par[2],sqrt(ML.waiting$par[4]))+(1-ML.waiting$par[1])*dnorm(z,ML.waiting$par[3],sqrt(ML.waiting$par[5]))
> lines(z,f,col=2,lwd=2)
> lines(z,dnorm(z,mean(waiting),sd(waiting)),col="blue")
> 
> detach()

这里写图片描述

DONE!!!

猜你喜欢

转载自blog.csdn.net/qq_36306781/article/details/81455375