[Depmix-commits] r161 - trunk/R

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

Author: maarten
Date: 2008-06-13 17:06:32 +0200 (Fri, 13 Jun 2008)
New Revision: 161

Modified:
   trunk/R/responseGLM.R
Log:
- fixed bug in creation of multinom with a factor response

Modified: trunk/R/responseGLM.R
===================================================================
--- trunk/R/responseGLM.R	2008-06-13 14:23:51 UTC (rev 160)
+++ trunk/R/responseGLM.R	2008-06-13 15:06:32 UTC (rev 161)
@@ -16,7 +16,7 @@
 
 setMethod("GLMresponse",
 	signature(formula="formula"),
-	function(formula,data=NULL,family=gaussian(),pstart=NULL,fixed=NULL,prob=TRUE, ...) {
+	function(formula,family=gaussian(),data,pstart=NULL,fixed=NULL,prob=TRUE, ...) {
 		call <- match.call()
 		mf <- match.call(expand.dots = FALSE)
 		m <- match(c("formula", "data"), names(mf), 0)
@@ -36,31 +36,31 @@
 			# FIX ME
 		  y <- model.response(mf)
 			switch(is(y)[1],
-		factor = {
-		  y <- as.matrix(as.numeric(as.numeric(y)==1))
-		  n <- matrix(1,nrow=nrow(y))
-		},
-		matrix = {
-		  if(ncol(y) == 2) {
-			n <- as.matrix(rowSums(y))
-			y <- as.matrix(y[,1])
-		  } else {
-			stop("model response not valid for binomial model")
-		  }
-		},
-		numeric = {
-		  if(sum(y %in% c(0,1)) != length(y)) stop("model response not valid for binomial model")
-		  n <- matrix(1,nrow=length(y))
-		  y <- as.matrix(y)
-		},
-		stop("model response not valid for binomial model")
-			 # assume 1 success, rest not
-			 #y <- as.numeric(as.numeric(y)==1)
-		  )
+    		factor = {
+    		  y <- as.matrix(as.numeric(as.numeric(y)==1))
+    		  n <- matrix(1,nrow=nrow(y))
+    		},
+    		matrix = {
+    		  if(ncol(y) == 2) {
+    			n <- as.matrix(rowSums(y))
+    			y <- as.matrix(y[,1])
+    		  } else {
+    			stop("model response not valid for binomial model")
+    		  }
+    		},
+    		numeric = {
+    		  if(sum(y %in% c(0,1)) != length(y)) stop("model response not valid for binomial model")
+    		  n <- matrix(1,nrow=length(y))
+    		  y <- as.matrix(y)
+    		},
+    		stop("model response not valid for binomial model")
+    			 # assume 1 success, rest not
+    			 #y <- as.numeric(as.numeric(y)==1)
+      )
 	  }
 		if(family$family=="multinomial") {
-			if(is.factor(y)) y <- model.matrix(~y-1)
-			if(is.numeric(y)) y <- model.matrix(~factor(y)-1)
+      y <- model.response(mf)
+			if(is.factor(y)) y <- model.matrix(~y-1) else if(is.numeric(y)) y <- model.matrix(~factor(y)-1)
 			parameters$coefficients <- matrix(0,ncol=ncol(y),nrow=ncol(x))
 			if(is.null(fixed)) {
 				fixed <- parameters$coefficients
@@ -91,6 +91,8 @@
 			gaussian = new("NORMresponse",formula=formula,family=family,parameters=parameters,fixed=fixed,x=x,y=y,npar=npar),
 			binomial = new("BINOMresponse",formula=formula,family=family,parameters=parameters,fixed=fixed,x=x,y=y,npar=npar,n=n),
 			multinomial = new("MULTINOMresponse",formula=formula,family=family,parameters=parameters,fixed=fixed,x=x,y=y,npar=npar),
+      poisson = new("POISSONresponse",formula=formula,family=family,parameters=parameters,fixed=fixed,x=x,y=y,npar=npar),
+      Gamma = new("GAMMAresponse",formula=formula,family=family,parameters=parameters,fixed=fixed,x=x,y=y,npar=npar),
 			new("GLMresponse",formula=formula,family=family,parameters=parameters,fixed=fixed,x=x,y=y,npar=npar)
 		)
 		mod