[Depmix-commits] r170 - trunk/R

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

Author: ingmarvisser
Date: 2008-06-17 14:52:04 +0200 (Tue, 17 Jun 2008)
New Revision: 170

Modified:
   trunk/R/makeResponseModels.R
   trunk/R/responseGLM.R
Log:
Added prob argument to setpars for multinom models (internal use only)

Modified: trunk/R/makeResponseModels.R
===================================================================
--- trunk/R/makeResponseModels.R	2008-06-17 12:24:16 UTC (rev 169)
+++ trunk/R/makeResponseModels.R	2008-06-17 12:52:04 UTC (rev 170)
@@ -1,5 +1,5 @@
 makeResponseModels <-
-function(response,data=NULL,nstates,family,values=NULL,...) {
+function(response,data=NULL,nstates,family,values=NULL,prob=TRUE,...) {
 	
 	resp <- response
 	response <- list()
@@ -33,7 +33,7 @@
 		for(i in 1:nstates) {
 			for(j in 1:nresp) {
 				bp <- npar(response[[i]][[j]])
-				response[[i]][[j]] <- setpars(response[[i]][[j]],val=values[1:bp])
+				response[[i]][[j]] <- setpars(response[[i]][[j]],val=values[1:bp],prob=prob)
 				bp <- bp+1
 				values <- values[bp:length(values)]
 			}

Modified: trunk/R/responseGLM.R
===================================================================
--- trunk/R/responseGLM.R	2008-06-17 12:24:16 UTC (rev 169)
+++ trunk/R/responseGLM.R	2008-06-17 12:52:04 UTC (rev 170)
@@ -112,14 +112,18 @@
 )
 
 setMethod("setpars","GLMresponse",
-	function(object,values,which="pars",...) {
+	function(object, values, which="pars", prob=FALSE, ...) {
 		npar <- npar(object)
 		if(length(values)!=npar) stop("length of 'values' must be",npar)
 		# determine whether parameters or fixed constraints are being set
 		switch(which,
 			"pars"= {
 				if(object at family$family=="multinomial") {
+					
 					object at parameters$coefficients <- matrix(values,ncol(object at x),byrow=TRUE)
+					
+					if(prob) object at parameters$coefficients[1,] <- object at family$linkfun(values[1:ncol(object at parameters$coefficients)],base=object at family$base)
+					
 # 					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),]