[Depmix-commits] r49 - trunk

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

Author: ingmarvisser
Date: 2008-03-06 12:28:56 +0100 (Thu, 06 Mar 2008)
New Revision: 49

Modified:
   trunk/EM.R
Log:
Changed reestimation of initial parameters for multiple cases

Modified: trunk/EM.R
===================================================================
--- trunk/EM.R	2008-03-06 10:40:42 UTC (rev 48)
+++ trunk/EM.R	2008-03-06 11:28:56 UTC (rev 49)
@@ -18,7 +18,8 @@
 		
 		B <- exp(apply(object at logdens,c(1,3),sum))
 		# TODO: add functionality for inModel
-		init <- predict(object at initModel)
+		init <- exp(logDens(object at initModel))
+# 		print(init)
 		LL.old <- LL
 		j <- j+1
 		
@@ -31,7 +32,20 @@
 		#object at init <- fit(object at init,ip=fbo$gamma[1,])
 		#object at init <- matrix(fbo$gamma[1,],nrow=1)
 		
-		object at initModel <- setpars(object at initModel,values=object at initModel@family$linkfun(fbo$gamma[1,],base=object at initModel@family$base))
+		# FIX ME for length(ntimes)>1
+		# print(fbo$gamma[1,])
+		# Here we need an average of gamma[bt[case],], which may need to be weighted ?? (see Rabiner, p283)
+		
+		ntimes <- object at ntimes
+		lt <- length(ntimes)
+		et <- cumsum(ntimes)
+		bt <- c(1,et[-lt]+1)
+		
+		# this is without weighting
+		initprobs <- apply(fbo$gamma[bt,],2,mean)
+		
+		object at initModel <- setpars(object at initModel,values=object at initModel@family$linkfun(initprobs,base=object at initModel@family$base))
+		
 		# This should become:
 		# lt <- length(object at ntimes)
 		# et <- cumsum(object at ntimes)
@@ -58,11 +72,13 @@
 				#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]]))
 				
+				# update trans slot of the model
 				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])
+				# update logdens slot of the model
 				object at logdens[,k,i] <- logDens(object at rModels[[i]][[k]])
 			}
 		}