[Depmix-commits] r48 - trunk

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

Author: ingmarvisser
Date: 2008-03-06 11:40:42 +0100 (Thu, 06 Mar 2008)
New Revision: 48

Modified:
   trunk/EM.R
Log:
Added support for dealing with timeseries of length 1, ie for latent class models

Modified: trunk/EM.R
===================================================================
--- trunk/EM.R	2008-03-06 10:38:48 UTC (rev 47)
+++ trunk/EM.R	2008-03-06 10:40:42 UTC (rev 48)
@@ -1,4 +1,4 @@
-em <- function(object,maxit=100,tol=1e-9,verbose=FALSE,...) {
+em <- function(object,maxit=100,tol=1e-6,verbose=FALSE,...) {
 	if(!is(object,"hmModel")) stop("object must be 'hmModel'")
 	
 	# pseudocode
@@ -44,21 +44,23 @@
 		trm <- matrix(0,ns,ns)
 		for(i in 1:ns) {
 			
-			if(!object at stationary) {
-				object at trModels[[i]]@y <- fbo$xi[,,i]/fbo$gamma[,i]
-				object at trModels[[i]] <- fit(object at trModels[[i]],w=as.matrix(fbo$gamma[,i]),ntimes=object at ntimes) # check this
-			} else {
-				for(k in 1:ns) {
-					trm[i,k] <- sum(fbo$xi[-c(et),k,i])/sum(fbo$gamma[-c(et),i])
+			if(max(object at ntimes)>1) { #skip transition parameters update in case of latent class model
+				if(!object at stationary) {
+					object at trModels[[i]]@y <- fbo$xi[,,i]/fbo$gamma[,i]
+					object at trModels[[i]] <- fit(object at trModels[[i]],w=as.matrix(fbo$gamma[,i]),ntimes=object at ntimes) # check this
+				} else {
+					for(k in 1:ns) {
+						trm[i,k] <- sum(fbo$xi[-c(et),k,i])/sum(fbo$gamma[-c(et),i])
+					}
+					object at trModels[[i]]@parameters$coefficients <- object at trModels[[i]]@family$linkfun(trm[i,],base=object at initModel@family$base)
 				}
-				object at trModels[[i]]@parameters$coefficients <- object at trModels[[i]]@family$linkfun(trm[i,],base=object at initModel@family$base)
+				
+				#object at trModels[[i]] <- fit(object at trModels[[i]],w=NULL,ntimes=object at ntimes) # check this
+				#object at trans[,,i] <- exp(logDens(object at trModels[[i]]))
+				
+				object at trans[,,i] <- predict(object at trModels[[i]])
 			}
 			
-			#object at trModels[[i]] <- fit(object at trModels[[i]],w=NULL,ntimes=object at ntimes) # check this
-			#object at trans[,,i] <- exp(logDens(object at trModels[[i]]))
-			
-			object at trans[,,i] <- predict(object at trModels[[i]])
-			
 			for(k in 1:object at nresp) {
 				object at rModels[[i]][[k]] <- fit(object at rModels[[i]][[k]],w=fbo$gamma[,i])
 				object at logdens[,k,i] <- logDens(object at rModels[[i]][[k]])