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

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

Author: ingmarvisser
Date: 2010-03-10 17:08:33 +0100 (Wed, 10 Mar 2010)
New Revision: 411

Modified:
   pkg/depmixS4/R/EM.R
   pkg/depmixS4/R/depmixfit.R
   pkg/depmixS4/R/responseGLM.R
Log:
Minor code cleanups

Modified: pkg/depmixS4/R/EM.R
===================================================================
--- pkg/depmixS4/R/EM.R	2010-03-10 16:07:53 UTC (rev 410)
+++ pkg/depmixS4/R/EM.R	2010-03-10 16:08:33 UTC (rev 411)
@@ -30,18 +30,19 @@
 	converge <- FALSE
 	j <- 0
 	
+	# compute responsibilities
+	B <- apply(object at dens,c(1,3),prod)
+	gamma <- object at init*B
+	LL <- sum(log(rowSums(gamma)))
+	# normalize
+	gamma <- gamma/rowSums(gamma)
+	
 	if(random.start) {
 		nr <- sum(ntimes(object))
 		gamma <- matrix(runif(nr*ns,min=.0001,max=.9999),nr=nr,nc=ns)
 		gamma <- gamma/rowSums(gamma)
-	} else {
-		# compute responsibilities
-		B <- apply(object at dens,c(1,3),prod)
-		gamma <- object at init*B
-		LL <- sum(log(rowSums(gamma)))
-		# normalize
-		gamma <- gamma/rowSums(gamma)
-	}
+	} 
+	
 	LL.old <- LL + 1
 	
 	while(j <= maxit & !converge) {

Modified: pkg/depmixS4/R/depmixfit.R
===================================================================
--- pkg/depmixS4/R/depmixfit.R	2010-03-10 16:07:53 UTC (rev 410)
+++ pkg/depmixS4/R/depmixfit.R	2010-03-10 16:08:33 UTC (rev 411)
@@ -38,14 +38,6 @@
 		
 		if(method=="donlp"||method=="rsolnp") {
 			
-			reqdon <- require(Rdonlp2,quietly=TRUE)
-			if(method=="donlp"&!reqdon) {
-				warning("Rdonlp2 not available, method changed to rsolnp")
-				method="rsolnp"
-			}
-			
-			if(method=="rsolnp"&!(require(Rsolnp,quietly=TRUE))) stop("Optimization requires either 'Rdonlp2' or 'Rsolnp'")
-			
 			# determine which parameters are fixed
  			if(fi) {
  				if(length(fixed)!=npar(object)) stop("'fixed' does not have correct length")
@@ -124,6 +116,11 @@
 			}
 			
 			if(method=="donlp") {
+				
+				reqdon <- require(Rdonlp2,quietly=TRUE)
+				
+				if(!reqdon) stop("Rdonlp2 not available.")
+				
 				# set donlp2 control parameters
 				cntrl <- donlp2.control(hessian=FALSE,difftype=2,report=TRUE)	
 				
@@ -156,6 +153,8 @@
 			
 			if(method=="rsolnp") {
 				
+				if(!(require(Rsolnp,quietly=TRUE))) stop("Method 'rsolnp' requires package 'Rsolnp'")
+				
 				# separate equality and inequality constraints
 				ineq <- which(lin.u!=lin.l)
 				if(length(ineq)>0) lineq <- lincon[-ineq, ,drop=FALSE]
@@ -196,7 +195,8 @@
 					ineqUB = ineqUB, 
 					LB = par.l[!fixed], 
 					UB = par.u[!fixed], 
-					control = list(trace = 1)
+					control = list(delta = 1e-5, tol = 1e-6, trace = 1),
+					...
 				)
 				
 				if(class(object)=="depmix") class(object) <- "depmix.fitted"

Modified: pkg/depmixS4/R/responseGLM.R
===================================================================
--- pkg/depmixS4/R/responseGLM.R	2010-03-10 16:07:53 UTC (rev 410)
+++ pkg/depmixS4/R/responseGLM.R	2010-03-10 16:08:33 UTC (rev 411)
@@ -126,7 +126,7 @@
 
 setMethod("show","GLMresponse",
 	function(object) {
-		cat("Model of type ", object at family$family, ", formula: ",sep="")
+		cat("Model of type ", object at family$family," (", object at family$link, "), formula: ", sep="")
 		print(object at formula)
 		cat("Coefficients: \n")
 		print(object at parameters$coefficients)