[Depmix-commits] r657 - pkg/depmixS4/R

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

Author: maarten
Date: 2018-07-25 17:53:33 +0200 (Wed, 25 Jul 2018)
New Revision: 657

Modified:
   pkg/depmixS4/R/EM.R
Log:
EM returns object as fitted (with warning) if likelihood decreases

Modified: pkg/depmixS4/R/EM.R
===================================================================
--- pkg/depmixS4/R/EM.R	2018-07-25 15:13:08 UTC (rev 656)
+++ pkg/depmixS4/R/EM.R	2018-07-25 15:53:33 UTC (rev 657)
@@ -125,6 +125,7 @@
 	init <- dens(object at prior)
 
 	converge <- FALSE
+	likelihood_decreased <- FALSE
 	
 	if(random.start) {
 		nr <- sum(ntimes(object))
@@ -214,7 +215,17 @@
 			}
 		} else {
 			# this should not really happen...
-			if(j > 0 && (LL.old - LL) > tol) stop("likelihood decreased on iteration ",j)
+			if(j > 0 && (LL.old - LL) >= tol) {
+			  likelihood_decreased <- TRUE
+			  warning("likelihood decreased on iteration ",j)
+			  break
+			}
+		  if(j > 0 && ((crit == "absolute" && abs(LL.old - LL) < tol) || (crit == "relative" && abs(LL - LL.old)/abs(LL.old)  < tol))) {
+		    likelihood_decreased <- TRUE
+		    warning("likelihood decreased on iteration ",j, " but decrease was within tolerance, so assuming convergence")
+		    converge <- TRUE
+		    break
+		  }
 		}
 
 		LL.old <- LL
@@ -245,7 +256,13 @@
 			  absolute = "Log likelihood converged to within tol. (absolute change)"
 		  )
 		}
-	} else object at message <- "'maxit' iterations reached in EM without convergence."
+	} else {
+	  if(likelihood_decreased) {
+	    object at message <- "likelihood decreased in EM iteration; stopped without convergence."
+	  } else {
+	    object at message <- "'maxit' iterations reached in EM without convergence."
+	  }
+	}
 
 	# no constraints in EM, except for the standard constraints ...
 	# which are produced by the following (only necessary for getting df right in logLik and such)
@@ -318,6 +335,7 @@
 	LL.old <- LL + 1 # force the "old" likelihood to be larger...
 	
 	converge <- FALSE
+	likelihood_decreased <- FALSE
 	for(j in 0:maxit) {
 		
 		# maximization
@@ -390,7 +408,17 @@
 			}
 		} else {
 		  # this should not really happen...
-		  if(j > 0 && (LL.old - LL) > tol) stop("likelihood decreased on iteration ",j)
+		  if(j > 0 && (LL.old - LL) > tol) {
+		    likelihood_decreased <- TRUE
+		    warning("likelihood decreased on iteration ",j)
+		    break
+		  }
+		  if(j > 0 && ((crit == "absolute" && abs(LL.old - LL) < tol) || (crit == "relative" && abs(LL - LL.old)/abs(LL.old)  < tol))) {
+		    likelihood_decreased <- TRUE
+		    warning("likelihood decreased on iteration ",j, " but decrease was within tolerance, so assuming convergence")
+		    converge <- TRUE
+		    break
+		  }
 		}
 		
 		LL.old <- LL
@@ -426,7 +454,13 @@
 			    absolute = "Log likelihood converged to within tol. (absolute change)"
 		    )
 		}
-	} else object at message <- "'maxit' iterations reached in EM without convergence."
+	} else {
+	  if(likelihood_increased) {
+	    object at message <- "likelihood decreased in EM iteration; stopped without convergence."
+	  } else {
+	    object at message <- "'maxit' iterations reached in EM without convergence."
+	  }
+	}
 	
 	# no constraints in EM, except for the standard constraints ...
 	# which are produced by the following (only necessary for getting df right in logLik and such)