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

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

Author: ingmarvisser
Date: 2011-11-03 14:19:54 +0100 (Thu, 03 Nov 2011)
New Revision: 503

Modified:
   pkg/depmix/DESCRIPTION
   pkg/depmix/R/depmix.R
Log:
Reintroduced Rdonlp2 support which does seem to work ...

Modified: pkg/depmix/DESCRIPTION
===================================================================
--- pkg/depmix/DESCRIPTION	2011-11-02 14:28:53 UTC (rev 502)
+++ pkg/depmix/DESCRIPTION	2011-11-03 13:19:54 UTC (rev 503)
@@ -5,5 +5,6 @@
 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-11-02 14:28:53 UTC (rev 502)
+++ pkg/depmix/R/depmix.R	2011-11-03 13:19:54 UTC (rev 503)
@@ -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") {