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

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

Author: ingmarvisser
Date: 2008-06-17 10:48:16 +0200 (Tue, 17 Jun 2008)
New Revision: 165

Modified:
   trunk/NAMESPACE
   trunk/R/makeResponseModels.R
Log:
Fixed bug in makeResponseModels to give a sensible error if the number of start values is incorrect

Modified: trunk/NAMESPACE
===================================================================
--- trunk/NAMESPACE	2008-06-13 16:05:45 UTC (rev 164)
+++ trunk/NAMESPACE	2008-06-17 08:48:16 UTC (rev 165)
@@ -49,6 +49,6 @@
 	predict,
 	dens,
 	show,
-	simulate
+	simulate,
 	summary
 )

Modified: trunk/R/makeResponseModels.R
===================================================================
--- trunk/R/makeResponseModels.R	2008-06-13 16:05:45 UTC (rev 164)
+++ trunk/R/makeResponseModels.R	2008-06-17 08:48:16 UTC (rev 165)
@@ -3,22 +3,15 @@
 	
 	resp <- response
 	response <- list()
-	
-	st=FALSE
-	if(!is.null(values)) st=TRUE
-	
+	nresppars <- 0
+		
 	# univariate response data
 	if(class(resp)=="formula") {
 		nresp <- 1
 		for(i in 1:nstates) {
 			response[[i]] <- list()
 			response[[i]][[1]] <- GLMresponse(resp,data=data,family=family)
-			if(st) {
-				bp <- npar(response[[i]][[1]])
-				response[[i]][[1]] <- GLMresponse(resp,data=data,family=family,pstart=values[1:bp])
-				bp <- bp+1
-				values <- values[bp:length(values)]
-			}
+			nresppars <- nresppars + npar(response[[i]][[1]])
 		}
 	}
 	
@@ -29,16 +22,23 @@
 			response[[i]] <- list()
 			for(j in 1:nresp) {
 				response[[i]][[j]] <- GLMresponse(resp[[j]],data=data,family=family[[j]])
-				if(st) {
-					bp <- npar(response[[i]][[j]])
-					response[[i]][[j]] <- GLMresponse(resp[[j]],data=data,family=family[[j]],pstart=values[1:bp])
-					bp <- bp+1
-					values <- values[bp:length(values)]
-				}
 			}
 		}
 	}
 	
+	# set the starting values, if any
+	if(!is.null(values)) {
+		if(!(length(values)==nresppars)) stop(paste("'respstart' has incorrect length, it should be", nresppars, "\n"))
+		for(i in 1:nstates) {
+			for(j in 1:nresp) {
+				bp <- npar(response[[i]][[j]])
+				response[[i]][[j]] <- setpars(response[[i]][[j]],val=values[1:bp])
+				bp <- bp+1
+				values <- values[bp:length(values)]
+			}
+		}
+	}
+	
 	return(response)
 }