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

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

Author: ingmarvisser
Date: 2012-07-23 13:41:50 +0200 (Mon, 23 Jul 2012)
New Revision: 537

Modified:
   pkg/depmixS4/R/responseGLMMULTINOM.R
   pkg/depmixS4/R/transInit.R
Log:
Small transition parameters (<1e-5) in multinomial identity models are now set to zero.

Modified: pkg/depmixS4/R/responseGLMMULTINOM.R
===================================================================
--- pkg/depmixS4/R/responseGLMMULTINOM.R	2012-07-19 13:51:11 UTC (rev 536)
+++ pkg/depmixS4/R/responseGLMMULTINOM.R	2012-07-23 11:41:50 UTC (rev 537)
@@ -36,13 +36,13 @@
 			object <- setpars(object,unlist(pars))
 		}
 		if(object at family$link=="identity") {
-			if(is.null(w)) w <- rep(1,nrow(object at y))
-			sw <- sum(w[!nas])
-			pars <- c(apply(as.matrix(object at y[!nas,]),2,function(x){sum(x*w[!nas])/sw}))
-# 			if(any(pars<1e-5)) warning("Parameters smaller than 1e-5 have been set to zero.")
-			pars[pars<1e-5] <- 0 # set small values to zero
-			pars <- pars/sum(pars)
-			object <- setpars(object,pars)
+				if(is.null(w)) w <- rep(1,nrow(object at y))
+				sw <- sum(w[!nas])
+				pars <- c(apply(as.matrix(object at y[!nas,]),2,function(x){sum(x*w[!nas])/sw}))
+# 				if(any(pars<1e-5)) warning("Parameters smaller than 1e-5 have been set to zero.")
+				pars[pars<1e-5] <- 0 # set small values to zero
+				pars <- pars/sum(pars)
+				object <- setpars(object,pars)
 		}
 		object
 	}

Modified: pkg/depmixS4/R/transInit.R
===================================================================
--- pkg/depmixS4/R/transInit.R	2012-07-19 13:51:11 UTC (rev 536)
+++ pkg/depmixS4/R/transInit.R	2012-07-23 11:41:50 UTC (rev 537)
@@ -156,25 +156,27 @@
     		}
     		pars$coefficients <- t(matrix(fit$wts,ncol=ncol(pars$coefficients),nrow=nrow(pars$coefficients)+1)[-1,])
     		object <- setpars(object,unlist(pars))
-  		},
-  		identity = {
-  		  # object at y = fbo$xi[,,i]/fbo$gamma[,i]
-  		  # should become (see em):
-  		  #for(k in 1:ns) {
+		},
+		identity = {
+				# object at y = fbo$xi[,,i]/fbo$gamma[,i]
+				# should become (see em):
+				#for(k in 1:ns) {
 				#		trm[i,k] <- sum(fbo$xi[-c(et),k,i])/sum(fbo$gamma[-c(et),i])
 				#	}
 				if(!is.null(w)) {
-				  sw <- sum(w)
-				  pars <- colSums(w*object at y)/sum(w)
+						sw <- sum(w)
+						pars <- colSums(w*object at y)/sum(w)
 				} else {
-				  pars <- colMeans(object at y)
+						pars <- colMeans(object at y)
 				}
-			  object <- setpars(object,pars)
-  		},
-  		stop("link function not implemented")
-  	)
-		object
-	}
+ 				pars[pars<1e-6] <- 0 # set small values to zero
+				pars <- pars/sum(pars)
+				object <- setpars(object,pars)
+		},
+		stop("link function not implemented")
+	)
+	object
+}
 )
 
 setMethod("simulate",signature(object="transInit"),