[Depmix-commits] r495 - in pkg/depmix: . R

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

Author: ingmarvisser
Date: 2011-10-24 22:15:16 +0200 (Mon, 24 Oct 2011)
New Revision: 495

Modified:
   pkg/depmix/DESCRIPTION
   pkg/depmix/R/depmix.R
Log:
Removed Rdonlp2 optimization option as Rdonlp2 does not install anymore.

Modified: pkg/depmix/DESCRIPTION
===================================================================
--- pkg/depmix/DESCRIPTION	2011-10-24 19:39:09 UTC (rev 494)
+++ pkg/depmix/DESCRIPTION	2011-10-24 20:15:16 UTC (rev 495)
@@ -1,10 +1,9 @@
 Package: depmix
-Version: 0.9.9
-Date: 2011-09-22
+Version: 0.9.10
+Date: 2011-10-24
 Title: Dependent Mixture Models
 Author: Ingmar Visser <i.visser at uva.nl>
 Maintainer: Ingmar Visser <i.visser at uva.nl>
 Depends: R (>= 2.13.1), MASS
-Suggests: Rdonlp2
 Description: Fit (multigroup) mixtures of latent Markov models on mixed categorical and continuous (timeseries) data 
 License: GPL-3
\ No newline at end of file

Modified: pkg/depmix/R/depmix.R
===================================================================
--- pkg/depmix/R/depmix.R	2011-10-24 19:39:09 UTC (rev 494)
+++ pkg/depmix/R/depmix.R	2011-10-24 20:15:16 UTC (rev 495)
@@ -93,8 +93,8 @@
 	
 	if(method=="npsol") {
 		if(!is.loaded("npsolc")) {
-			method="donlp"
-			warning("Optimization method changed to donlp because npsol is not available on this computer.")
+			method="optim"
+			warning("Optimization method changed to optim because npsol is not available on this computer.")
 		}
 	}
 	
@@ -254,64 +254,64 @@
 		z
 	}
 	
-	##  call npmain to optimize the model (non-linear constraints not implemented yet)
-	if(method=="donlp") {
-		
-		require("Rdonlp2")
-		
-		bu=bu[which(fixed==1)]
-		bl=bl[which(fixed==1)]
-		
-		if(printlevel>29) {
-			print(A)
-			print(bl)
-			print(bu)
-			print(bllin)
-			print(bulin)
-		}
-		
-		# donlp specific inputs
-		optpars=fitpars[which(fixed==1)]
-		A=A[,which(fixed==1),drop=FALSE]			
-		
-		# define loglike function
-		logl <- function(pars) {
-			xgmod$pars[which(fixed==1)]=pars
-			-loglike(dat=dat,dmm=xgmod,print=0,set=FALSE,tdcov=tdcov)$logl
-		}
-		
-		if(der) {
-			grad <- function(pars) {
-				xgmod$pars[which(fixed==1)]=pars
-				gr <- -loglike(dat=dat,dmm=xgmod,print=0,set=FALSE,tdcov=tdcov,grad=TRUE)$gr[which(fixed==1)]
-				return(gr)
-			}
-			attr(logl, "gr") <- grad
-		}
-		
-		timeUsed <- system.time(
-			res <- donlp2(optpars, logl,
-				par.upper=bu,
-				par.lower=bl,
-				A = A,
-				lin.upper=bulin,
-				lin.lower=bllin,
-				nlin = list(),
-				control=donlp2.control(),
-				env=.GlobalEnv, name="Rdonlp2")
-		)
-		
-		z=list()
-		z$objf=-res$fx
-		z$iter=res$step.nr
-		z$inform=res$message
-		z$timeUsed=timeUsed[3]
-		fitpars[which(fixed==1)]=res$par
-		z$pars=fitpars
-		z$npars=xgmod$npars
-		z$totMem=NULL
-		z
-	}
+# 	##  call npmain to optimize the model (non-linear constraints not implemented yet)
+# 	if(method=="donlp") {
+# 		
+# 		require("Rdonlp2")
+# 		
+# 		bu=bu[which(fixed==1)]
+# 		bl=bl[which(fixed==1)]
+# 		
+# 		if(printlevel>29) {
+# 			print(A)
+# 			print(bl)
+# 			print(bu)
+# 			print(bllin)
+# 			print(bulin)
+# 		}
+# 		
+# 		# donlp specific inputs
+# 		optpars=fitpars[which(fixed==1)]
+# 		A=A[,which(fixed==1),drop=FALSE]			
+# 		
+# 		# define loglike function
+# 		logl <- function(pars) {
+# 			xgmod$pars[which(fixed==1)]=pars
+# 			-loglike(dat=dat,dmm=xgmod,print=0,set=FALSE,tdcov=tdcov)$logl
+# 		}
+# 		
+# 		if(der) {
+# 			grad <- function(pars) {
+# 				xgmod$pars[which(fixed==1)]=pars
+# 				gr <- -loglike(dat=dat,dmm=xgmod,print=0,set=FALSE,tdcov=tdcov,grad=TRUE)$gr[which(fixed==1)]
+# 				return(gr)
+# 			}
+# 			attr(logl, "gr") <- grad
+# 		}
+# 		
+# 		timeUsed <- system.time(
+# 			res <- donlp2(optpars, logl,
+# 				par.upper=bu,
+# 				par.lower=bl,
+# 				A = A,
+# 				lin.upper=bulin,
+# 				lin.lower=bllin,
+# 				nlin = list(),
+# 				control=donlp2.control(),
+# 				env=.GlobalEnv, name="Rdonlp2")
+# 		)
+# 		
+# 		z=list()
+# 		z$objf=-res$fx
+# 		z$iter=res$step.nr
+# 		z$inform=res$message
+# 		z$timeUsed=timeUsed[3]
+# 		fitpars[which(fixed==1)]=res$par
+# 		z$pars=fitpars
+# 		z$npars=xgmod$npars
+# 		z$totMem=NULL
+# 		z
+# 	}
 	
 	##  call optim or nlm to optimize the model
 	if(method=="optim" || method=="nlm") {
@@ -811,7 +811,7 @@
 	better=ifelse(gof[,1]>object$logl,1,0)
 	if(pvalonly==0) {
 		object$bootpars=bootpars
-		object$bse=sd(bootpars)
+		object$bse=apply(bootpars,2,sd)
 		object$gof=gof
 	}
 	else object$gof=gof[,1]