[Depmix-commits] r166 - trunk/R

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

Author: ingmarvisser
Date: 2008-06-17 11:34:30 +0200 (Tue, 17 Jun 2008)
New Revision: 166

Modified:
   trunk/R/responseGLM.R
   trunk/R/responseGLMMULTINOM.R
Log:
Fixed bug in setpars for multinomial models

Modified: trunk/R/responseGLM.R
===================================================================
--- trunk/R/responseGLM.R	2008-06-17 08:48:16 UTC (rev 165)
+++ trunk/R/responseGLM.R	2008-06-17 09:34:30 UTC (rev 166)
@@ -91,8 +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),
+			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
@@ -119,9 +119,10 @@
 		switch(which,
 			"pars"= {
 				if(object at family$family=="multinomial") {
-					object at parameters$coefficients[1,] <- values[1:ncol(object at parameters$coefficients)]
-					values <- matrix(values,,ncol(object at x),byrow=TRUE)
-					if(ncol(object at x)>1) object at parameters$coefficients[2:ncol(object at x),] <- values[2:ncol(object at x),]
+					object at parameters$coefficients <- matrix(values,ncol(object at x),byrow=TRUE)
+# 					object at parameters$coefficients[1,] <- values[1:ncol(object at parameters$coefficients)]
+# 					values <- matrix(values,,ncol(object at x),byrow=TRUE)
+# 					if(ncol(object at x)>1) object at parameters$coefficients[2:ncol(object at x),] <- values[2:ncol(object at x),]
 				} else {
 					object at parameters$coefficients <- values[1:length(object at parameters$coefficients)]
 				}
Modified: trunk/R/responseGLMMULTINOM.R
===================================================================
--- trunk/R/responseGLMMULTINOM.R	2008-06-17 08:48:16 UTC (rev 165)
+++ trunk/R/responseGLMMULTINOM.R	2008-06-17 09:34:30 UTC (rev 166)
@@ -3,7 +3,7 @@
 
 setMethod("fit","MULTINOMresponse",
 	function(object,w) {
-    if(missing(w)) w <- NULL
+		if(missing(w)) w <- NULL
 		pars <- object at parameters
 		base <- object at family$base # delete me
 		y <- object at y
@@ -15,12 +15,11 @@
 		Wts <- mask
 		Wts[-1,] <- t(pars$coefficients) # set starting weights
 		if(!is.null(w)) {
-		  fit <- nnet.default(x,y,weights=w,size=0,entropy=TRUE,skip=TRUE,mask=mask,Wts=Wts,trace=FALSE)
-    } else {
-		  fit <- nnet.default(x,y,size=0,entropy=TRUE,skip=TRUE,mask=mask,Wts=Wts,trace=FALSE)
-    }
-		pars$coefficients <- t(matrix(fit$wts,ncol=ncol(pars$coefficients),nrow=nrow(pars$coefficients)+1)[-1,])
-		object <- setpars(object,unlist(pars))
+			fit <- nnet.default(x,y,weights=w,size=0,entropy=TRUE,skip=TRUE,mask=mask,Wts=Wts,trace=FALSE)
+		} 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,]
 		object
 	}
 )