[Depmix-commits] r631 - pkg/depmixS4/R

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Tue May 13 10:24:52 CEST 2014


Author: ingmarvisser
Date: 2014-05-13 10:24:51 +0200 (Tue, 13 May 2014)
New Revision: 631

Modified:
   pkg/depmixS4/R/responseGLM.R
Log:
Fixed names for GLMresponse models.

Modified: pkg/depmixS4/R/responseGLM.R
===================================================================
--- pkg/depmixS4/R/responseGLM.R	2014-04-02 12:09:29 UTC (rev 630)
+++ pkg/depmixS4/R/responseGLM.R	2014-05-13 08:24:51 UTC (rev 631)
@@ -58,6 +58,7 @@
 		}
 		if(family$family=="multinomial") {
 			y <- model.response(mf)
+			namesy <- NULL
 			if(NCOL(y) == 1) {
 				if(is.factor(y)) {
 						namesy <- levels(y)
@@ -207,32 +208,32 @@
 )
 
 setMethod("getpars","GLMresponse",
-		function(object,which="pars",...) {
-				switch(which,
-						"pars" = {
-								parameters <- numeric()
-								if(object at family$family=="multinomial"&object at family$link=="mlogit") {
-										# coefficient is usually a matrix here
-                    tmp <- object at parameters$coefficients
-										parameters <- c(t(tmp)) # Why transpose?
-										names(parameters) <- paste(rep(rownames(tmp),each=length(colnames(tmp))),colnames(tmp),sep=".")
-								} else {
-										parameters <- object at parameters$coefficients
-										if(object at family$family=="gaussian") {
-												nms <- names(parameters)
-												parameters <- c(parameters,object at parameters$sd)
-												names(parameters) <- c(nms,"sd")
-										}
-										
-								}
-								pars <- parameters
-						},
-						"fixed" = {
-								pars <- object at fixed
-						}
-				)
-				return(pars)
-		}
+	function(object,which="pars",...) {
+		switch(which,
+			"pars" = {
+				parameters <- numeric()
+				if(object at family$family=="multinomial"&object at family$link=="mlogit") {
+					# coefficient is usually a matrix here
+					tmp <- object at parameters$coefficients
+					parameters <- c(t(tmp)) # Why transpose?
+					names(parameters) <- paste(rep(rownames(tmp),each=length(colnames(tmp))),colnames(tmp),sep=".")
+				} else {
+					parameters <- object at parameters$coefficients
+					if(object at family$family=="gaussian") {
+						nms <- names(parameters)
+						parameters <- c(parameters,object at parameters$sd)
+						names(parameters) <- c(nms,"sd")
+					}
+					
+				}
+				pars <- parameters
+			},
+			"fixed" = {
+				pars <- object at fixed
+			}
+		)
+		return(pars)
+	}
 )
 
 # methods: fit, logDens, predict



More information about the depmix-commits mailing list