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

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

Author: ingmarvisser
Date: 2010-07-01 22:20:08 +0200 (Thu, 01 Jul 2010)
New Revision: 426

Modified:
   pkg/depmixS4/R/EM.R
   pkg/depmixS4/R/allGenerics.R
   pkg/depmixS4/R/depmix.R
Log:
Cleaned up comments, minor edits to messages.

Modified: pkg/depmixS4/R/EM.R
===================================================================
--- pkg/depmixS4/R/EM.R	2010-07-01 12:34:54 UTC (rev 425)
+++ pkg/depmixS4/R/EM.R	2010-07-01 20:20:08 UTC (rev 426)
@@ -93,8 +93,8 @@
 
 	if(converge) {
 		object at message <- switch(crit,
-			relative = "Log likelihood converged to within tol. (relative change crit.)",
-			absolute = "Log likelihood converged to within tol. (absolute change crit.)"
+			relative = "Log likelihood converged to within tol. (relative change)",
+			absolute = "Log likelihood converged to within tol. (absolute change)"
 		)
 	} else object at message <- "'maxit' iterations reached in EM without convergence."
 

Modified: pkg/depmixS4/R/allGenerics.R
===================================================================
--- pkg/depmixS4/R/allGenerics.R	2010-07-01 12:34:54 UTC (rev 425)
+++ pkg/depmixS4/R/allGenerics.R	2010-07-01 20:20:08 UTC (rev 426)
@@ -8,6 +8,7 @@
 	require(methods)
 	require(MASS)
  	require(nnet)
+	require(Rsolnp)
 }
 
 .Last.lib <- function(libpath) {}

Modified: pkg/depmixS4/R/depmix.R
===================================================================
--- pkg/depmixS4/R/depmix.R	2010-07-01 12:34:54 UTC (rev 425)
+++ pkg/depmixS4/R/depmix.R	2010-07-01 20:20:08 UTC (rev 426)
@@ -1,93 +1,94 @@
-# 
-# Ingmar Visser, 11-6-2008
-# 
-
-# 
-# Main function to construct mix models
-# 
-
-#
-# UNIVARIATE AND MULTIVARIATE MIXTURE OF GLM'S
-# 
-
-
-setGeneric("mix", function(response,data=NULL,nstates,family=gaussian(),prior=~1,initdata=NULL,
-		respstart=NULL,instart=NULL, ...) standardGeneric("mix"))
-
-
-setMethod("mix",
-	signature(response="ANY"),
-	function(response, data=NULL, nstates, family=gaussian(), prior=~1, initdata=NULL,
-		respstart=NULL, instart=NULL, ...) {
-		
-		# make response models
-		response <- makeResponseModels(response=response,data=data,nstates=nstates,family=family,values=respstart)
-		
-		# FIX ME: this only works if data are actually provided ... (maybe make this obligatory ...)
-		ntimes <- rep(1,nrow(data))
-		
-		# make prior model
-		prior <- makePriorModel(nstates=nstates,ncases=length(ntimes),formula=prior,data=initdata,values=instart)
-		
-		# call main depmix with all these models, ntimes and stationary
-		model <- makeMix(response=response,prior=prior)
-		
-		# deal with starting values here!!!!!!
-		
-		return(model)
-	}
-)
-
-# 
-# Ingmar Visser, 23-3-2008
-# 
-
-# 
-# Main function to construct depmix models
-# 
-
-#
-# UNIVARIATE AND MULTIVARIATE MARKOV MIXTURE OF GLM'S
-# 
-
-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, ...) {
-		
-		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
-		response <- makeResponseModels(response=response,data=data,nstates=nstates,family=family,values=respstart)
-		
-		# make transition models
-		stationary=FALSE
-		if(transition==~1) stationary=TRUE
-		transition <- makeTransModels(nstates=nstates,formula=transition,data=data,stationary=stationary,values=trstart)
-		
-		# make prior model
-		prior <- makePriorModel(nstates=nstates,ncases=length(ntimes),formula=prior,data=initdata,values=instart)
-		
-		# call main depmix with all these models, ntimes and stationary
-		model <- makeDepmix(response=response,transition=transition,prior=prior,ntimes=ntimes,stationary=stationary)
-		
-		# deal with starting values here!!!!!!
-		
-		return(model)
-	}
-)
-
-
-
-
-
-
+#
+# Ingmar Visser, 11-6-2008
+#
+
+#
+# Main function to construct mix models
+#
+
+#
+# UNIVARIATE AND MULTIVARIATE MIXTURE OF GLM'S
+#
+
+
+setGeneric("mix", function(response, data = NULL, 
+    nstates, family = gaussian(), prior = ~1, initdata = NULL, 
+    respstart = NULL, instart = NULL, ...) standardGeneric("mix"))
+
+
+setMethod("mix", signature(response = "ANY"), function(response, 
+    data = NULL, nstates, family = gaussian(), prior = ~1, initdata = NULL, 
+    respstart = NULL, instart = NULL, ...) {
+    
+    # make response models
+    response <- makeResponseModels(response = response, data = data, 
+        nstates = nstates, family = family, values = respstart)
+    
+    # FIX ME: this only works if data are actually provided ... 
+	# (maybe make this obligatory ...)
+    ntimes <- rep(1, nrow(data))
+    
+    # make prior model
+    prior <- makePriorModel(nstates = nstates, ncases = length(ntimes), 
+        formula = prior, data = initdata, values = instart)
+    
+    # call main depmix with all these models, ntimes and stationary
+    model <- makeMix(response = response, prior = prior)
+        
+    return(model)
+})
+
+#
+# Ingmar Visser, 23-3-2008
+#
+
+#
+# Main function to construct depmix models
+#
+
+#
+# UNIVARIATE AND MULTIVARIATE MARKOV MIXTURE OF GLM'S
+#
+
+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, ...) {
+    
+    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
+    response <- makeResponseModels(response = response, data = data, 
+        nstates = nstates, family = family, values = respstart)
+    
+    # make transition models
+    stationary = FALSE
+    if (transition == ~1) 
+        stationary = TRUE
+    transition <- makeTransModels(nstates = nstates, formula = transition, 
+        data = data, stationary = stationary, values = trstart)
+    
+    # make prior model
+    prior <- makePriorModel(nstates = nstates, ncases = length(ntimes), 
+        formula = prior, data = initdata, values = instart)
+    
+    # call main depmix with all these models, ntimes and stationary
+    model <- makeDepmix(response = response, transition = transition, 
+        prior = prior, ntimes = ntimes, stationary = stationary)
+    
+    # deal with starting values here!!!!!!
+    
+    return(model)
+})