[Depmix-commits] r386 - trunk/R

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

Author: ingmarvisser
Date: 2010-03-05 15:31:54 +0100 (Fri, 05 Mar 2010)
New Revision: 386

Modified:
   trunk/R/responseGLM.R
   trunk/R/transInit.R
Log:
Added temporary fix for df in multinomial identity models, ok for em, not for rsolnp

Modified: trunk/R/responseGLM.R
===================================================================
--- trunk/R/responseGLM.R	2010-03-05 14:06:55 UTC (rev 385)
+++ trunk/R/responseGLM.R	2010-03-05 14:31:54 UTC (rev 386)
@@ -162,7 +162,7 @@
 					object at parameters$coefficients <- values[1:length(object at parameters$coefficients)] # matrix(values,ncol(object at x),byrow=TRUE) # this needs fixing!!!!
 				}
 				if(length(unlist(object at parameters))>length(object at parameters$coefficients)) {
-					if(object at family$family=="gaussian") object at parameters$sd <- as.numeric(values[(length(object at parameters$coefficients)+1)])
+					if(object at family$family=="gaussian") object at parameters$sd <- values[(length(object at parameters$coefficients)+1)]
 				}
 			},
 			"fixed" = {
Modified: trunk/R/transInit.R
===================================================================
--- trunk/R/transInit.R	2010-03-05 14:06:55 UTC (rev 385)
+++ trunk/R/transInit.R	2010-03-05 14:31:54 UTC (rev 386)
@@ -23,12 +23,13 @@
 		}
 		y <- matrix(1,ncol=1) # y is not needed in the transition and init models
 		parameters <- list()
-		if(is.null(nstates)) stop("'nstates' must be provided in call to trinModel")
+		if(is.null(nstates)) stop("'nstates' must be provided in call to transInit model")
 		if(family$family=="multinomial") {
 			if(family$link=="identity") {
 				parameters$coefficients <- t(apply(matrix(1,ncol=nstates,nrow=ncol(x)),1,function(x) x/sum(x)))
 				if(is.null(fixed)) {
 					fixed <- matrix(0,nrow=nrow(parameters$coefficients),ncol=ncol(parameters$coefficients))
+					fixed <- c(rep(0,nstates-1),1) # this needs to be fixed at some point using contraints
 					fixed <- c(as.logical(t(fixed)))
 				}
 			} else {
@@ -176,7 +177,7 @@
 			return(states)
 		} else {
 			if(missing(times)) {
-				# this is likely to be a stationary model...
+				# this is likely to be a stationary model...???
 				pr <- predict(object)
 			} else {
 				pr <- predict(object)[times,]