[Depmix-commits] r61 - trunk

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

Author: maarten
Date: 2008-03-07 11:51:11 +0100 (Fri, 07 Mar 2008)
New Revision: 61

Modified:
   trunk/EM.R
   trunk/depmix-test3EM.R
   trunk/responses.R
Log:
- fixed problem with multinomial fit (especially for init models)

Modified: trunk/EM.R
===================================================================
--- trunk/EM.R	2008-03-07 09:47:57 UTC (rev 60)
+++ trunk/EM.R	2008-03-07 10:51:11 UTC (rev 61)
@@ -40,8 +40,8 @@
 		
 		# should become object at prior <- fit(object at prior)
 		object at prior@y <- fbo$gamma[bt,]
-		object at prior <- fit(object at prior, w=NULL)
-		
+		object at prior <- fit(object at prior, w=NULL,ntimes=NULL)
+		object at init <- dens(object at prior)
 		# init needs to be recomputed here?
 		
 		#object at initModel <- setpars(object at initModel,values=object at initModel@family$linkfun(initprobs,base=object at initModel@family$base))
@@ -84,11 +84,17 @@
 		if( (LL >= LL.old) & (LL - LL.old < tol))  converge <- TRUE
 	}
 	
+	class(object) <- "depmix.fitted"
 	if(converge) object at message <- "Log likelihood converged to within tol."
 	else object at message <- "'maxit' iterations reached in EM without convergence."
 	
 	# no constraints in EM
-	object at conMat <- NULL
+	# NULL values not allowed in slot conMat!!!
+	object at conMat <- matrix()
+	#object at conMat <- NULL
 	
+	# what do we want in slot posterior?
+	object at posterior <- fbo$gamma
+	
 	object
 }

Modified: trunk/depmix-test3EM.R
===================================================================
--- trunk/depmix-test3EM.R	2008-03-07 09:47:57 UTC (rev 60)
+++ trunk/depmix-test3EM.R	2008-03-07 10:51:11 UTC (rev 61)
@@ -4,6 +4,7 @@
 source("responses.R")
 source("lystig.R")
 source("depmix.R")
+source("depmix.fitted.R")
 source("fb.r")
 source("EM.R")
 
@@ -24,3 +25,13 @@
 mod <- depmix(list(rt~1,corr~1),data=speed,family=list(gaussian(),multinomial()),transition=~Pacc,trstart=trstart,instart=instart,respst=resp,nst=2)
 fmod <- em(mod,verbose=T)
 logLik(fmod)
+
+# with only multinomial response
+mod <- depmix(list(corr~1),data=speed,family=list(multinomial()),transition=~Pacc,trstart=trstart,instart=instart,respst=resp[c(3,4,7,8)],nst=2)
+fmod.mult <- em(mod,verbose=T)
+logLik(fmod.mult)
+
+# with only gaussian response
+mod <- depmix(list(rt~1),data=speed,family=list(gaussian()),transition=~Pacc,trstart=trstart,instart=instart,respst=resp[c(1,2,5,6)],nst=2)
+fmod.gauss <- em(mod,verbose=T)
+logLik(fmod.gauss)

Modified: trunk/responses.R
===================================================================
--- trunk/responses.R	2008-03-07 09:47:57 UTC (rev 60)
+++ trunk/responses.R	2008-03-07 10:51:11 UTC (rev 61)
@@ -301,8 +301,10 @@
 	function(object,w) {
 		pars <- object at parameters
 		fit <- lm.wfit(x=object at x,y=object at y,w=w)
+		#fit <- glm.fit(x=object at x,y=object at y,weights=w,family=object at family)
 		pars$coefficients <- fit$coefficients
 		pars$sd <- sqrt(sum(w*fit$residuals^2/sum(w)))
+		#pars$sd <- sqrt(sum(w*residuals(fit)^2/sum(w)))
 		object <- setpars(object,unlist(pars))
 		object
 	}
@@ -559,13 +561,15 @@
 		y <- as.matrix(y)
 		x <- as.matrix(x)
 		na <- unique(na)
-		x <- x[-na,]
-		y <- y[-na,]
+		if(length(na)>0) {
+  		x <- x[-na,]
+  		y <- y[-na,]
 		#y <- round(y) # delete me
-		if(!is.null(w)) w <- w[-na]
+  		if(!is.null(w)) w <- w[-na]
+    }
 		#mask <- matrix(1,nrow=nrow(pars$coefficients),ncol=ncol(pars$coefficients))
 		#mask[,base] <- 0
-		if(!is.null(w)) fit <- multinom(y~x-1,weights=w,trace=FALSE) else fit <- multinom(y~x-1,weights=w,trace=FALSE)
+		if(!is.null(w)) fit <- multinom(y~x-1,weights=w,trace=FALSE) else fit <- multinom(y~x-1,trace=FALSE)
 		ids <- vector(,length=ncol(y))
 		ids[base] <- 1
 		ids[-base] <- 2:ncol(y)