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

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

Author: maarten
Date: 2012-06-21 19:55:49 +0200 (Thu, 21 Jun 2012)
New Revision: 532

Modified:
   pkg/depmixS4/R/EM.R
Log:
- added xi computation to classification likelihood (still needs correct logL)

Modified: pkg/depmixS4/R/EM.R
===================================================================
--- pkg/depmixS4/R/EM.R	2012-06-21 14:12:50 UTC (rev 531)
+++ pkg/depmixS4/R/EM.R	2012-06-21 17:55:49 UTC (rev 532)
@@ -214,9 +214,13 @@
 		# should become object at prior <- fit(object at prior, gamma)
 		
 		if(clsf == "hard") {
-		    vstate <- as.factor(viterbi(object)[,1])
-		    gamma <- as.matrix(model.matrix(~ vstate - 1))
-		}
+		    vstate <- viterbi(object)[,1]
+		    fbo$gamma <- as.matrix(model.matrix(~ factor(vstate) - 1))
+		    # TODO: compute fbo$xi
+		    fbo$xi <- array(0,dim=dim(fbo$xi))
+		    fbo$xi[cbind(1:(dim(fbo$xi)[1] - 1),vstate[-1],vstate[-length(vstate)])] <- 1
+	        # TODO: check likelihood
+		} 
 	
 		object at prior@y <- fbo$gamma[bt,,drop=FALSE]
 		object at prior <- fit(object at prior, w=NULL, ntimes=NULL)
@@ -225,6 +229,7 @@
 		trm <- matrix(0,ns,ns)
 		for(i in 1:ns) {
 			if(!object at stationary) {
+
 				object at transition[[i]]@y <- fbo$xi[,,i]/fbo$gamma[,i]
 				object at transition[[i]] <- fit(object at transition[[i]],w=as.matrix(fbo$gamma[,i]),ntimes=ntimes(object)) # check this
 			} else {