R语言: MLE以及EM算法模拟实验

阅读更多

看了一篇来自zouxy09的“从最大似然到EM算法浅解”博文

详细算法和数学公式在 http://blog.csdn.net/zouxy09

本文主要想实现上述文中的例子：例子简要描述。

某学校抽样100位男生和100位女生的身高，男生和女生身高分别满足各自的高斯分布。现在200个样本数据混乱放置在一起，如何通过EM算法，求出男生身高的均值和标准差？

首先，我们模拟男女生身高样本。模拟男生theta值为mu=1.75, sd=0.316。女生theta值为mu=1.65, sd=0.316

#Data simulation
set.seed(1001)
mStudent<-rnorm(100,1.75,0.316)
fStudent<-rnorm(100,1.65,0.316)
totalStu<-cbind(mStudent,fStudent)
totalStu1<-c(mStudent,fStudent)

按照EM算法步骤，E-Step. 对hidden vairiable （z）进行估计，把男生和女生分成两类。

###################
#E-step:
###################
eStep.fn=function(data,flag, muB,sigmaB,muG,sigmaG){
  listB = c()
  listG = c()
  numB=0
  numG=0
  for(i in 1:200){
    testB<-dnorm(data[i],muB,sigmaB)
    testG<-dnorm(data[i],muG,sigmaG)
    pb=testB/(testB+testG)
    pg=testG/(testB+testG)
    if(pb>=pg){
      numB=numB+1
      listB[numB]=data[i]
    }else{
      numG=numG+1
      listG[numG]=data[i]
    }
  }
  if(flag==1){
    return (listB)
  }else
    return (listG)
}

接着， M-Step： 对特定的男生类，或者女生类进行MLE估计

#log-likelihood function
set.seed(1001)
LL.fn <- function(mu, sigma) {
      R = suppressWarnings(dnorm(data, mu, sigma)) 
      -sum(log(R))
}

# Maximum likelihood Estimator
mle(LL.fn, start = list(mu = 1, sigma=1))

最后上EM 算法

#####################
# Iteration
#####################
itr.fn=function(data,muIniB,sigmaIniB,muIniG,sigmaIniG,itrNum){
  #E-step
  dataB<-eStep.fn(data,1,muIniB,sigmaIniB,muIniG,sigmaIniG)
  dataG<-eStep.fn(data,2,muIniB,sigmaIniB,muIniG,sigmaIniG)
  #Redefine LL function
  #log-likelihood function
  LLB.fn <- function(mu, sigma) {
      R = suppressWarnings(dnorm(dataB, mu, sigma)) 
      -sum(log(R))
  }
  LLG.fn <- function(mu, sigma) {
    R = suppressWarnings(dnorm(dataG, mu, sigma)) 
    -sum(log(R))
  }
  # Maximum likelihood Estimator
  b.mle.coefs<-mle(LLB.fn, start = list(mu=muIniB, sigma=sigmaIniB))
  g.mle.coefs<-mle(LLG.fn, start = list(mu=muIniG, sigma=sigmaIniG))
  b.muItr<-coef(b.mle.coefs)[["mu"]]#coef(mle.test)[["mu"]]
  b.sigmaItr<-coef(b.mle.coefs)[["sigma"]]
  g.muItr<-coef(g.mle.coefs)[["mu"]]#coef(mle.test)[["mu"]]
  g.sigmaItr<-coef(g.mle.coefs)[["sigma"]]
  itrNum=itrNum-1
  #Iteration-step
  if(itrNum==0){
    return (c(coef(b.mle.coefs),coef(g.mle.coefs)))
  }else{
    itr.fn(data,b.muItr,b.sigmaItr,g.muItr,g.sigmaItr,itrNum)
  }
}

最后结果

itr.fn(totalStu1,1.8,1,1.6,1,n)#n为迭代的次数。

迭代三次，就开始收敛。但是效果不好，下面是结果
bmu           bsigma           gmu             gsigma
1.9658193 0.2170255     1.4610679   0.1583682
对比模拟值：theta值为mu=1.75, sd=0.316。女生theta值为mu=1.65, sd=0.316

下面是简单地思考，在E-step的过程中，由于两个分布重叠部分较大，所以考虑这样在使用R语言求dnorm时，分类情况如下，男生的身高均值在1.96,女生则在1.46。

下一步考虑如何去除这个干扰。。。本篇未完，待续。。。。

参考：
http://www.r-bloggers.com/fitting-a-model-by-maximum-likelihood/
http://xccds1977.blogspot.de/2012/08/emr.html