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

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

Author: ingmarvisser
Date: 2011-06-22 13:37:02 +0200 (Wed, 22 Jun 2011)
New Revision: 476

Modified:
   pkg/depmixS4/R/fb.R
   pkg/depmixS4/R/forwardbackward.R
Log:
Made useC=TRUE the default so it is always used when optimizing models and computing the likelihood

Modified: pkg/depmixS4/R/fb.R
===================================================================
--- pkg/depmixS4/R/fb.R	2011-06-22 10:25:43 UTC (rev 475)
+++ pkg/depmixS4/R/fb.R	2011-06-22 11:37:02 UTC (rev 476)
@@ -4,7 +4,7 @@
 # FORWARD-BACKWARD algoritme, 23-3-2008
 # 
 
-fb <- function(init,A,B,ntimes=NULL,return.all=FALSE,stationary=TRUE,useC=FALSE) {
+fb <- function(init,A,B,ntimes=NULL,return.all=FALSE,stationary=TRUE,useC=TRUE) {
 
 	# Forward-Backward algorithm (used in Baum-Welch)
 	# Returns alpha, beta, and full data likelihood
@@ -54,13 +54,12 @@
 			xi=as.double(xi),
  			package="depmixS4")[c("alpha","beta","sca","xi")]
 		
-		res$alpha <- matrix(res$alpha,nc=ns,byrow=TRUE)
-		res$beta <- matrix(res$beta,nc=ns,byrow=TRUE)
-		res$xi <- array(res$xi,dim=c(nt,ns,ns))
-		
-		res$gamma <- res$alpha*res$beta/res$sca
-		res$logLike <- -sum(log(sca))		
-		
+		alpha <- matrix(res$alpha,nc=ns,byrow=TRUE)
+		beta <- matrix(res$beta,nc=ns,byrow=TRUE)
+		xi <- array(res$xi,dim=c(nt,ns,ns))
+		xi[et,,] <- NA
+		sca <- res$sca
+				
 	} else {
 		
 		alpha <- matrix(ncol=ns,nrow=nt)
@@ -97,17 +96,17 @@
 			}
 			
 		}
+	}
 	
-		gamma <- alpha*beta/sca
-		like <- -sum(log(sca))
-		
-		if(return.all) {
-			res <- list(alpha=alpha,beta=beta,gamma=gamma,xi=xi,sca=sca,logLike=like)
-		} else {
-			res <- list(gamma=gamma,xi=xi,logLike=like)
-		}
- 	}
+	gamma <- alpha*beta/sca
+	like <- -sum(log(sca))
 	
+	if(return.all) {
+		res <- list(alpha=alpha,beta=beta,gamma=gamma,xi=xi,sca=sca,logLike=like)
+	} else {
+		res <- list(gamma=gamma,xi=xi,logLike=like)
+	}
+	
 	res
 }
 
Modified: pkg/depmixS4/R/forwardbackward.R
===================================================================
--- pkg/depmixS4/R/forwardbackward.R	2011-06-22 10:25:43 UTC (rev 475)
+++ pkg/depmixS4/R/forwardbackward.R	2011-06-22 11:37:02 UTC (rev 476)
@@ -5,14 +5,14 @@
 # 
 
 setMethod("forwardbackward","depmix",
-	function(object, return.all=TRUE, useC=FALSE, ...) {
+	function(object, return.all=TRUE, useC=TRUE, ...) {
 		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)
 	}
 )
 
 setMethod("forwardbackward","mix",
-	function(object, return.all=TRUE, useC=FALSE, ...) {
+	function(object, return.all=TRUE, useC=TRUE, ...) {
 		fb(init=object at init,matrix(0,1,1),B=object at dens,ntimes=ntimes(object), 
 			stationary=TRUE,return.all=return.all,useC=useC)
 	}