[Depmix-commits] r389 - in trunk: R man

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

Author: ingmarvisser
Date: 2010-03-05 16:55:37 +0100 (Fri, 05 Mar 2010)
New Revision: 389

Modified:
   trunk/R/makeResponseModels.R
   trunk/R/response-class.R
   trunk/R/responseGLM.R
   trunk/man/depmix.fit.Rd
Log:
Started adding constraints on multinomial identity models and adapting examples in help files accordingly ...

Modified: trunk/R/makeResponseModels.R
===================================================================
--- trunk/R/makeResponseModels.R	2010-03-05 15:54:38 UTC (rev 388)
+++ trunk/R/makeResponseModels.R	2010-03-05 15:55:37 UTC (rev 389)
@@ -17,7 +17,7 @@
 	nresp <- length(resp)
 	for(i in 1:nstates) {
 		response[[i]] <- list()
-		for(j in 1:nresp) {				
+		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/response-class.R
===================================================================
--- trunk/R/response-class.R	2010-03-05 15:54:38 UTC (rev 388)
+++ trunk/R/response-class.R	2010-03-05 15:55:37 UTC (rev 389)
@@ -14,7 +14,8 @@
 		fixed="logical",
 		y = "matrix",
 		x = "matrix",
-		npar = "numeric" # this is not really needed as it simply is length(unlist(parameters))
+		npar = "numeric", # this is not really needed as it simply is length(unlist(parameters))
+		constr = "ANY"
 	)
 )
 
Modified: trunk/R/responseGLM.R
===================================================================
--- trunk/R/responseGLM.R	2010-03-05 15:54:38 UTC (rev 388)
+++ trunk/R/responseGLM.R	2010-03-05 15:55:37 UTC (rev 389)
@@ -28,6 +28,7 @@
 		y <- model.response(mf)
 		if(!is.matrix(y)) y <- matrix(y,ncol=1)
 		parameters <- list()
+		constr <- NULL
 		parameters$coefficients <- vector("numeric",length=ncol(x))
 		if(family$family=="gaussian") {
 			parameters$sd <- 1
@@ -68,8 +69,15 @@
 			if(family$link=="identity") {
 				if(ncol(x)>1) stop("covariates not allowed in multinomial model with identity link")
 				parameters$coefficients <- matrix(1/ncol(y),ncol=ncol(y),1)
-				fixed <- c(rep(0,ncol(y)-1),1) # this needs to be fixed at some point using contraints
+				fixed <- rep(0,ncol(y)) 
 				fixed <- c(as.logical(t(fixed)))
+				constr <- list(
+					lin = matrix(1,nr=1,nc=ncol(y)),
+					linup = 1,
+					linlow = 1,
+					parup = rep(1,ncol(y)),
+					parlow = rep(0,ncol(y))
+				)
 			}
 		}
 		npar <- length(unlist(parameters))
@@ -101,12 +109,12 @@
 			}
 		}
 		mod <- switch(family$family,
-			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),
-			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)
+			gaussian = new("NORMresponse",formula=formula,family=family,parameters=parameters,fixed=fixed,x=x,y=y,npar=npar,constr=constr),
+			binomial = new("BINOMresponse",formula=formula,family=family,parameters=parameters,fixed=fixed,x=x,y=y,npar=npar,constr=constr),
+			multinomial = new("MULTINOMresponse",formula=formula,family=family,parameters=parameters,fixed=fixed,x=x,y=y,npar=npar,constr=constr),
+			poisson = new("POISSONresponse",formula=formula,family=family,parameters=parameters,fixed=fixed,x=x,y=y,npar=npar,constr=constr),
+			Gamma = new("GAMMAresponse",formula=formula,family=family,parameters=parameters,fixed=fixed,x=x,y=y,npar=npar,constr=constr),
+			new("GLMresponse",formula=formula,family=family,parameters=parameters,fixed=fixed,x=x,y=y,npar=npar,constr=constr)
 		)
 		mod
 	}
Modified: trunk/man/depmix.fit.Rd
===================================================================
--- trunk/man/depmix.fit.Rd	2010-03-05 15:54:38 UTC (rev 388)
+++ trunk/man/depmix.fit.Rd	2010-03-05 15:55:37 UTC (rev 389)
@@ -164,7 +164,7 @@
 tr=runif(6)
 trst=c(tr[1:2],0,tr[3:5],0,tr[6])
 mod1 <- depmix(list(rt~1,corr~1),data=speed,transition=~Pacc,nstates=2,
-	family=list(gaussian(),multinomial()),trstart=trst)
+	family=list(gaussian(),multinomial("identity")),trstart=trst)
 # fit the model
 fmod1 <- fit(mod1)
 fmod1 # to see the logLik and optimization information