[Depmix-commits] r168 - trunk/R

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

Author: ingmarvisser
Date: 2008-06-17 12:31:00 +0200 (Tue, 17 Jun 2008)
New Revision: 168

Modified:
   trunk/R/EM.R
   trunk/R/makeResponseModels.R
   trunk/R/responseGLMMULTINOM.R
Log:
Fixed bug in setpars for multinomial models (again)

Modified: trunk/R/EM.R
===================================================================
--- trunk/R/EM.R	2008-06-17 10:06:32 UTC (rev 167)
+++ trunk/R/EM.R	2008-06-17 10:31:00 UTC (rev 168)
@@ -53,15 +53,17 @@
 				object at dens[,k,i] <- dens(object at response[[i]][[k]])
 			}
 		}
-
+		
 		# expectation
-    B <- apply(object at dens,c(1,3),prod)
-    gamma <- object at init*B
-    LL <- sum(log(rowSums(gamma)))
-    # normalize
-    gamma <- gamma/rowSums(gamma)
-
+		B <- apply(object at dens,c(1,3),prod)
+		gamma <- object at init*B
+		LL <- sum(log(rowSums(gamma)))
+		# normalize
+		gamma <- gamma/rowSums(gamma)
+		
+		# print stuff
 		if(verbose&((j%%5)==0)) cat("iteration",j,"logLik:",LL,"\n")
+		
 		if( (LL >= LL.old) & (LL - LL.old < tol))  {
 			cat("iteration",j,"logLik:",LL,"\n")
 			converge <- TRUE

Modified: trunk/R/makeResponseModels.R
===================================================================
--- trunk/R/makeResponseModels.R	2008-06-17 10:06:32 UTC (rev 167)
+++ trunk/R/makeResponseModels.R	2008-06-17 10:31:00 UTC (rev 168)
@@ -22,6 +22,7 @@
 			response[[i]] <- list()
 			for(j in 1:nresp) {
 				response[[i]][[j]] <- GLMresponse(resp[[j]],data=data,family=family[[j]])
+				nresppars <- nresppars + npar(response[[i]][[j]])
 			}
 		}
 	}

Modified: trunk/R/responseGLMMULTINOM.R
===================================================================
--- trunk/R/responseGLMMULTINOM.R	2008-06-17 10:06:32 UTC (rev 167)
+++ trunk/R/responseGLMMULTINOM.R	2008-06-17 10:31:00 UTC (rev 168)
@@ -19,7 +19,8 @@
 		} else {
 			fit <- nnet.default(x,y,size=0,entropy=TRUE,skip=TRUE,mask=mask,Wts=Wts,trace=FALSE)
 		}
-		object at parameters$coefficients <- matrix(fit$wts,ncol=ncol(pars$coefficients),nrow=nrow(pars$coefficients)+1)[-1,]
+		pars$coefficients <- t(matrix(fit$wts,ncol=ncol(pars$coefficients),nrow=nrow(pars$coefficients)+1)[-1,])
+		object <- setpars(object,unlist(pars))
 		object
 	}
 )