[Depmix-commits] r226 - in trunk: . R

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

Author: ingmarvisser
Date: 2008-09-05 13:55:08 +0200 (Fri, 05 Sep 2008)
New Revision: 226

Modified:
   trunk/NAMESPACE
   trunk/R/depmix-class.R
   trunk/R/depmixsim-class.R
   trunk/R/responseGLM.R
Log:
added prob=TRUE support for binomial models in GLMresponse

Modified: trunk/NAMESPACE
===================================================================
--- trunk/NAMESPACE	2008-08-26 21:39:56 UTC (rev 225)
+++ trunk/NAMESPACE	2008-09-05 11:55:08 UTC (rev 226)
@@ -19,7 +19,8 @@
 exportClasses(
 	depmix,
 	depmix.sim,
-	mix,
+	mix,
+	mix.sim,
 	depmix.fitted,
 	mix.fitted,
 	response,

Modified: trunk/R/depmix-class.R
===================================================================
--- trunk/R/depmix-class.R	2008-08-26 21:39:56 UTC (rev 225)
+++ trunk/R/depmix-class.R	2008-09-05 11:55:08 UTC (rev 226)
@@ -96,7 +96,7 @@
 			responses[[i]] <- tmp
 		}
 		
-		# generate new depmix.sim object
+		# generate new mix.sim object
 		class(object) <- "mix.sim"
 		object at states <- as.matrix(states)
 		

Modified: trunk/R/depmixsim-class.R
===================================================================
--- trunk/R/depmixsim-class.R	2008-08-26 21:39:56 UTC (rev 225)
+++ trunk/R/depmixsim-class.R	2008-09-05 11:55:08 UTC (rev 226)
@@ -1,15 +1,16 @@
-# Class for simulated depmix model
+# Classes for simulated mix and depmix models
 
+setClass("mix.sim",
+	contains="mix",
+	representation(
+		states="matrix"
+	)
+)
+
 setClass("depmix.sim",
-  contains="depmix",
-  representation(
-    states="matrix"
-  )
+	contains="depmix",
+	representation(
+		states="matrix"
+	)
 )
 
-setClass("mix.sim",
-  contains="mix",
-  representation(
-	states="matrix"
-  )
-)
\ No newline at end of file

Modified: trunk/R/responseGLM.R
===================================================================
--- trunk/R/responseGLM.R	2008-08-26 21:39:56 UTC (rev 225)
+++ trunk/R/responseGLM.R	2008-09-05 11:55:08 UTC (rev 226)
@@ -36,24 +36,24 @@
 			# FIX ME
 			y <- model.response(mf)
 			if(NCOL(y) == 1) {
-        if(is.factor(y)) y <- as.matrix(as.numeric(as.numeric(y)==1)) else {
-          if(!is.numeric(y)) stop("model response not valid for binomial model")
-          if(sum(y %in% c(0,1)) != length(y)) stop("model response not valid for binomial model")
+				if(is.factor(y)) y <- as.matrix(as.numeric(as.numeric(y)==1)) else {
+					if(!is.numeric(y)) stop("model response not valid for binomial model")
+					if(sum(y %in% c(0,1)) != length(y)) stop("model response not valid for binomial model")
 					y <- as.matrix(y)
-		   }
+				}
 			} else {
-			 if(ncol(y) != 2) {
-			   stop("model response not valid for binomial model")
-			 }
+				if(ncol(y) != 2) {
+					stop("model response not valid for binomial model")
+				}
 			}
 		}
 		if(family$family=="multinomial") {
 			y <- model.response(mf)
 			if(NCOL(y) == 1) {
-        if(is.factor(y)) y <- model.matrix(~y-1) else {
-          if(!is.numeric(y)) stop("model response not valid for binomial model")
+				if(is.factor(y)) y <- model.matrix(~y-1) else {
+					if(!is.numeric(y)) stop("model response not valid for binomial model")
 					y <- model.matrix(~factor(y)-1)
-		   }
+				}
 			}
 			parameters$coefficients <- matrix(0,ncol=ncol(y),nrow=ncol(x))
 			if(is.null(fixed)) {
@@ -77,6 +77,13 @@
 			} else {
 				parameters$coefficients <- family$linkfun(as.numeric(pstart[1:length(parameters$coefficients)]))
 			}
+			
+			if(family$family=="binomial") {
+				if(prob) parameters$coefficients[1] <- family$linkfun(pstart[1])
+				else parameters$coefficients[1] <- pstart[1]
+				if(ncol(x)>1) parameters$coefficients[2:ncol(x),] <- pstart[2:ncol(x),]
+			}
+			
 			if(length(unlist(parameters))>length(parameters$coefficients)) {
 				if(family$family=="gaussian") parameters$sd <- as.numeric(pstart[(length(parameters$coefficients)+1)])
 			}