[Depmix-commits] r467 - in pkg/depmixS4: R src

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

Author: ingmarvisser
Date: 2011-06-20 10:01:49 +0200 (Mon, 20 Jun 2011)
New Revision: 467

Modified:
   pkg/depmixS4/R/EM.R
   pkg/depmixS4/R/fb.R
   pkg/depmixS4/R/forwardbackward.R
   pkg/depmixS4/src/fb.cc
Log:
Minor changes to C-code, changed default to useC=FALSE for now.

Modified: pkg/depmixS4/R/EM.R
===================================================================
--- pkg/depmixS4/R/EM.R	2011-06-20 07:38:00 UTC (rev 466)
+++ pkg/depmixS4/R/EM.R	2011-06-20 08:01:49 UTC (rev 467)
@@ -96,8 +96,8 @@
 			  converge <- TRUE
 			}
 		} else {
-		  # this should not really happen...
-		  if(j > 0) warning("likelihood decreased on iteration",j)
+			# this should not really happen...
+			if(j > 0 && (LL.old - LL) > tol) warning("likelihood decreased on iteration ",j)
 		}
 
 		LL.old <- LL
@@ -221,7 +221,7 @@
 			}
 		} else {
 		  # this should not really happen...
-		  if(j > 0) warning("likelihood decreased on iteration",j)
+			if(j > 0 && (LL.old - LL) > tol) warning("likelihood decreased on iteration ",j)
 		}
 		
 		LL.old <- LL

Modified: pkg/depmixS4/R/fb.R
===================================================================
--- pkg/depmixS4/R/fb.R	2011-06-20 07:38:00 UTC (rev 466)
+++ pkg/depmixS4/R/fb.R	2011-06-20 08:01:49 UTC (rev 467)
@@ -4,7 +4,7 @@
 # FORWARD-BACKWARD algoritme, 23-3-2008
 # 
 
-fb <- function(init,A,B,ntimes=NULL,return.all=FALSE,stationary=TRUE,useC=TRUE) {
+fb <- function(init,A,B,ntimes=NULL,return.all=FALSE,stationary=TRUE,useC=FALSE) {
 
 	# Forward-Backward algorithm (used in Baum-Welch)
 	# Returns alpha, beta, and full data likelihood
@@ -19,9 +19,6 @@
 	
 	# NOTE: xi[t,i,j] = P(S[t] = j & S[t+1] = i) !!!NOTE the order of i and j!!!
 	
-	
-	
-	
 	B <- apply(B,c(1,3),prod)
 	
 	nt <- nrow(B)	
@@ -33,6 +30,7 @@
 	xi <- array(0,dim=c(nt,ns,ns))
 	
 	if(is.null(ntimes)) ntimes <- nt
+	
 	lt <- length(ntimes)
 
 	if(useC) {
Modified: pkg/depmixS4/R/forwardbackward.R
===================================================================
--- pkg/depmixS4/R/forwardbackward.R	2011-06-20 07:38:00 UTC (rev 466)
+++ pkg/depmixS4/R/forwardbackward.R	2011-06-20 08:01:49 UTC (rev 467)
@@ -5,7 +5,7 @@
 # 
 
 setMethod("forwardbackward","depmix",
-	function(object, return.all=TRUE, useC=TRUE, ...) {
+	function(object, return.all=TRUE, useC=FALSE, ...) {
 		fb(init=object at init,A=object at trDens,B=object at dens,ntimes=ntimes(object), 
 			stationary=object at stationary,return.all=return.all,useC=useC)
 	}
Modified: pkg/depmixS4/src/fb.cc
===================================================================
--- pkg/depmixS4/src/fb.cc	2011-06-20 07:38:00 UTC (rev 466)
+++ pkg/depmixS4/src/fb.cc	2011-06-20 08:01:49 UTC (rev 467)
@@ -41,7 +41,9 @@
 // gamma is computed as alpha*beta/sca in R (no loop needed)
 
 
-void forwardbackward(int *ns, int *nc, int *nt, int *ntimes, double *init, double *trdens, double *dens, double *alpha, double *beta, double *sca, double *xi) {
+void forwardbackward(int *ns, int *nc, int *nt, int *ntimes, 
+					 double *init, double *trdens, double *dens, 
+					 double *alpha, double *beta, double *sca, double *xi) {
 		
 		Rprintf("ns=%d\n",ns[0]);
 		Rprintf("nc=%d\n",nc[0]);