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

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

Author: ingmarvisser
Date: 2011-07-06 16:32:53 +0200 (Wed, 06 Jul 2011)
New Revision: 485

Modified:
   pkg/depmixS4/R/depmix.R
   pkg/depmixS4/R/transInit.R
Log:
Added sanity check for the case that nstates=1 combined with non-trivial transition model.

Modified: pkg/depmixS4/R/depmix.R
===================================================================
--- pkg/depmixS4/R/depmix.R	2011-06-28 16:07:04 UTC (rev 484)
+++ pkg/depmixS4/R/depmix.R	2011-07-06 14:32:53 UTC (rev 485)
@@ -51,25 +51,25 @@
 #
 
 setMethod("depmix", signature(response = "ANY"), function(response, 
-    data = NULL, nstates, transition = ~1, family = gaussian(), 
-    prior = ~1, initdata = NULL, respstart = NULL, trstart = NULL, 
-    instart = NULL, ntimes = NULL, ...) {
+		data = NULL, nstates, transition = ~1, family = gaussian(), 
+		prior = ~1, initdata = NULL, respstart = NULL, trstart = NULL, 
+		instart = NULL, ntimes = NULL, ...) {
     
-    if (is.null(data)) {
-        if (is.null(ntimes)) 
-            stop("'ntimes' must be provided if not in the data")
-    } else {
-        if (is.null(attr(data, "ntimes"))) {
-            if (is.null(ntimes)) 
-                ntimes <- nrow(data)
-        } else {
-            ntimes <- attr(data, "ntimes")
-        }
-        if (sum(ntimes) != nrow(data)) 
-            stop("'ntimes' and data do not match")
-    }
-    
-    # make response models
+	if(is.null(data)) {
+		if(is.null(ntimes)) stop("'ntimes' must be provided if not in the data")
+	} else {
+		if(is.null(attr(data, "ntimes"))) {
+			if (is.null(ntimes)) ntimes <- nrow(data)
+		} else {
+			ntimes <- attr(data, "ntimes")
+		}
+		
+		if (sum(ntimes) != nrow(data)) stop("'ntimes' and data do not match")
+	}
+	
+	if(nstates==1&transition!=~1) {stop("1-state model can not have transition covariate")}
+	
+	# make response models
     response <- makeResponseModels(response = response, data = data, 
         nstates = nstates, family = family, values = respstart)
     

Modified: pkg/depmixS4/R/transInit.R
===================================================================
--- pkg/depmixS4/R/transInit.R	2011-06-28 16:07:04 UTC (rev 484)
+++ pkg/depmixS4/R/transInit.R	2011-07-06 14:32:53 UTC (rev 485)
@@ -10,7 +10,7 @@
 	signature(formula="formula"),
 	function(formula,nstates,data=NULL,family=multinomial(),pstart=NULL,fixed=NULL,prob=TRUE, ...) {
 		call <- match.call()
-		if(formula==formula(~1) & is.null(data)) {
+		if(formula==formula(~1)&is.null(data)) {
 			x <- matrix(1,ncol=1)
 		} else {
 			mf <- match.call(expand.dots = FALSE)