[Depmix-commits] r363 - in trunk: R man

[noreply at r-forge.r-project.org]

Author: maarten
Date: 2010-02-24 00:22:23 +0100 (Wed, 24 Feb 2010)
New Revision: 363

Modified:
   trunk/R/EM.R
   trunk/man/depmix.fit.Rd
Log:
- changed convergence criterion for EM
- fixed documentation for fit (EM arguments added)

Modified: trunk/R/EM.R
===================================================================
--- trunk/R/EM.R	2010-02-23 14:05:21 UTC (rev 362)
+++ trunk/R/EM.R	2010-02-23 23:22:23 UTC (rev 363)
@@ -2,7 +2,7 @@
 # Maarten Speekenbrink 23-3-2008
 # 
 
-em <- function(object,maxit=100,tol=1e-6,verbose=FALSE,...) {
+em <- function(object,maxit=100,tol=1e-8,crit=c(relative,absolute),verbose=FALSE,...) {
 	if(!is(object,"mix")) stop("object is not of class '(dep)mix'")
 	call <- match.call()
 	if(is(object,"depmix")) {
@@ -15,8 +15,9 @@
 }
 
 # em for lca and mixture models
-em.mix <- function(object,maxit=100,tol=1e-6,verbose=FALSE,...) {
+em.mix <- function(object,maxit=100,tol=1e-8,crit=c("relative","absolute"),verbose=FALSE,...) {
 	if(!is(object,"mix")) stop("object is not of class 'mix'")
+	crit <- match.arg(crit)
 	
 	ns <- object at nstates
 	
@@ -66,9 +67,14 @@
 			cat("iteration",j,"logLik:",LL,"\n")
 		}
 		
-		if( (LL >= LL.old) & (LL - LL.old < tol))  {
-			cat("iteration",j,"logLik:",LL,"\n")
-			converge <- TRUE
+		if(LL >= LL.old) {
+		  if((crit == "absolute" &&  LL - LL.old < tol) || (crit == "relative" && (LL.old - LL)/LL.old  < tol)) {
+			  cat("iteration",j,"logLik:",LL,"\n")
+			  converge <- TRUE
+			}
+		} else {
+		  # this should not really happen...
+		  if(j > 0) warning("likelihood decreased on iteration",j)
 		}
 
 		LL.old <- LL
@@ -78,8 +84,12 @@
 
 	class(object) <- "mix.fitted"
 
-	if(converge) object at message <- "Log likelihood converged to within tol."
-	else object at message <- "'maxit' iterations reached in EM without convergence."
+	if(converge) {
+    object at message <- switch(crit,
+    relative = "Log likelihood converged to within tol. (relative change crit.)",
+    absolute = "Log likelihood converged to within tol. (absolute change crit.)"
+    )
+  } else object at message <- "'maxit' iterations reached in EM without convergence."
 
 	# no constraints in EM
 	object at conMat <- matrix()
@@ -91,9 +101,10 @@
 }
 
 # em for hidden markov models
-em.depmix <- function(object,maxit=100,tol=1e-6,verbose=FALSE,...) {
+em.depmix <- function(object,maxit=100,tol=1e-8,crit=c("relative","absolute"),verbose=FALSE,...) {
 	
 	if(!is(object,"depmix")) stop("object is not of class '(dep)mix'")
+	crit <- match.arg(crit)
 	
 	ns <- object at nstates
 	
@@ -154,10 +165,16 @@
 		fbo <- fb(init=object at init,A=object at trDens,B=object at dens,ntimes=ntimes(object),stationary=object at stationary)
 		LL <- fbo$logLike
 				
-		if(verbose&((j%%5)==0)) cat("iteration",j,"logLik:",LL,"\n")
-		if( (LL >= LL.old) & (LL - LL.old < tol))  {
-			cat("iteration",j,"logLik:",LL,"\n")
-			converge <- TRUE
+		if(verbose&((j%%5)==0)) cat("iteration",j,"logLik:",LL,"\n")
+		
+		if( (LL >= LL.old)) {
+		  if((crit == "absolute" &&  LL - LL.old < tol) || (crit == "relative" && (LL.old - LL)/LL.old  < tol)) {
+			  cat("iteration",j,"logLik:",LL,"\n")
+			  converge <- TRUE
+			}
+		} else {
+		  # this should not really happen...
+		  if(j > 0) warning("likelihood decreased on iteration",j)
 		}
 		
 		LL.old <- LL
@@ -170,8 +187,12 @@
 	
 	class(object) <- "depmix.fitted"
 	
-	if(converge) object at message <- "Log likelihood converged to within tol."
-	else object at message <- "'maxit' iterations reached in EM without convergence."
+	if(converge) {
+    object at message <- switch(crit,
+	  relative = "Log likelihood converged to within tol. (relative change crit.)",
+	  absolute = "Log likelihood converged to within tol. (absolute change crit.)"
+	 )
+	} else object at message <- "'maxit' iterations reached in EM without convergence."
 	
 	# no constraints in EM
 	object at conMat <- matrix()

Modified: trunk/man/depmix.fit.Rd
===================================================================
--- trunk/man/depmix.fit.Rd	2010-02-23 14:05:21 UTC (rev 362)
+++ trunk/man/depmix.fit.Rd	2010-02-23 23:22:23 UTC (rev 363)
@@ -28,12 +28,14 @@
 \usage{
 	
 	\S4method{fit}{depmix}(object, fixed=NULL, equal=NULL, conrows=NULL,
-		conrows.upper=0, conrows.lower=0, method=NULL,...)
+		conrows.upper=0, conrows.lower=0, method=NULL,tol=1e-8,
+		crit=c("relative","absolute"),verbose=TRUE,...)
 	
 	\S4method{summary}{depmix.fitted}(object)
 
 	\S4method{fit}{mix}(object, fixed=NULL, equal=NULL, conrows=NULL,
-		conrows.upper=0, conrows.lower=0, method=NULL,...)
+		conrows.upper=0, conrows.lower=0, method=NULL,tol=1e-8,
+		crit=c("relative","absolute"),verbose=TRUE,...)
 	
 	\S4method{summary}{mix.fitted}(object)
 
@@ -56,7 +58,14 @@
 
 	\item{method}{The optimization method; mostly determined by
 		constraints.}
-
+		
+  \item{tol}{The tolerance level for convergence.}
+  
+  \item{crit}{The convergence criterion in the EM algorithm; either the relative
+  change in the log likelihood, or the absolute change in the log-likelihood.}
+  
+  \item{verbose}{Should optimization information be displayed on screen?}
+  
 	\item{...}{Further arguments passed on to the optimization methods.}
 
 }