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

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

Author: maarten
Date: 2012-11-07 11:49:27 +0100 (Wed, 07 Nov 2012)
New Revision: 572

Modified:
   pkg/depmixS4/R/nobs.R
   pkg/depmixS4/R/responseGLM.R
   pkg/depmixS4/R/responseGLMMULTINOM.R
Log:
- fixed problem with NA estimates of coefficients in GLM response models (these are now not used in the predict method)
- nobs now counts valid (nonmissing) observations using the y matrix, rather than from the density slot

Modified: pkg/depmixS4/R/nobs.R
===================================================================
--- pkg/depmixS4/R/nobs.R	2012-10-02 10:27:44 UTC (rev 571)
+++ pkg/depmixS4/R/nobs.R	2012-11-07 10:49:27 UTC (rev 572)
@@ -1,8 +1,15 @@
 setMethod("nobs", signature(object="mix"),
 	function(object, ...) {
 		nt <- sum(object at ntimes)
-		n <- sum(!apply(object at dens,1,function(x) any(is.na(x))))
+    nmiss <- rep(1,nt)
+    #for(i in 1:length(object at response)) {
+      for(j in 1:length(object at response[[1]])) {
+        nmiss <- nmiss*as.numeric(apply(as.matrix(object at response[[1]][[j]]@y),1,function(x) !any(is.na(x))))
+      }
+    #}
+    n <- sum(nmiss)
+		#n <- sum(!apply(object at response[[1]]y,1,function(x) any(is.na(x))))
 		if(n!=nt) warning("missing values detected; nobs is number of cases without any missing values")
 		return(n)
 	}
-)
+)
\ No newline at end of file

Modified: pkg/depmixS4/R/responseGLM.R
===================================================================
--- pkg/depmixS4/R/responseGLM.R	2012-10-02 10:27:44 UTC (rev 571)
+++ pkg/depmixS4/R/responseGLM.R	2012-11-07 10:49:27 UTC (rev 572)
@@ -240,7 +240,9 @@
 	function(object,w) {
     if(missing(w)) w <- NULL
 		pars <- object at parameters
-		fit <- glm.fit(x=object at x,y=object at y,weights=w,family=object at family,start=pars$coefficients)
+    start <- pars$coefficients
+    start[is.na(start)] <- 0
+		fit <- glm.fit(x=object at x,y=object at y,weights=w,family=object at family,start=start)
 		pars$coefficients <- fit$coefficients
 		object <- setpars(object,unlist(pars))
 		object
@@ -255,6 +257,11 @@
 
 setMethod("predict","GLMresponse",
 	function(object) {
-		object at family$linkinv(object at x%*%object at parameters$coefficients)
+	  nas <- is.na(object at parameters$coefficients)
+    if(sum(nas) == 0) {
+      object at family$linkinv(object at x%*%object at parameters$coefficients)
+    } else {
+		  object at family$linkinv(as.matrix(object at x[,!nas])%*%object at parameters$coefficients[!nas])
+    }
 	}
 )

Modified: pkg/depmixS4/R/responseGLMMULTINOM.R
===================================================================
--- pkg/depmixS4/R/responseGLMMULTINOM.R	2012-10-02 10:27:44 UTC (rev 571)
+++ pkg/depmixS4/R/responseGLMMULTINOM.R	2012-11-07 10:49:27 UTC (rev 572)
@@ -40,7 +40,7 @@
 				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-6] <- 0 # set small values to zero
+				if(!all(pars < 1e-6)) pars[pars<1e-6] <- 0 # set small values to zero
 				pars <- pars/sum(pars)
 				object <- setpars(object,pars)
 		}