[Depmix-commits] r276 - in trunk: . man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Jun 24 23:43:28 CEST 2009
Author: ingmarvisser
Date: 2009-06-24 23:43:28 +0200 (Wed, 24 Jun 2009)
New Revision: 276
Modified:
trunk/DESCRIPTION
trunk/man/depmix.Rd
trunk/man/depmixS4-package.Rd
trunk/man/makeDepmix.Rd
Log:
Added exgaus example to makeDepmix help file and links to this page in various places.
Modified: trunk/DESCRIPTION
===================================================================
--- trunk/DESCRIPTION 2009-06-24 19:39:58 UTC (rev 275)
+++ trunk/DESCRIPTION 2009-06-24 21:43:28 UTC (rev 276)
@@ -1,6 +1,6 @@
Package: depmixS4
-Version: 0.2-2
-Date: 2009-06-24
+Version: 0.2-3
+Date: 2009-06-25
Title: Dependent Mixture Models
Author: Ingmar Visser <i.visser at uva.nl>, Maarten Speekenbrink <m.speekenbrink at ucl.ac.uk>
Maintainer: Ingmar Visser <i.visser at uva.nl>
Modified: trunk/man/depmix.Rd
===================================================================
--- trunk/man/depmix.Rd 2009-06-24 19:39:58 UTC (rev 275)
+++ trunk/man/depmix.Rd 2009-06-24 21:43:28 UTC (rev 276)
@@ -143,8 +143,10 @@
\code{\link{fit}}, \code{\link{transInit}}, \code{\link{response}},
\code{\link{depmix-methods}} for accessor functions to \code{depmix}
- objects.
-
+ objects.
+
+ For full control check the \code{\link{makeDepmix}} help page and its
+ example section for the possibility to add new response distributions.
}
\references{
Modified: trunk/man/depmixS4-package.Rd
===================================================================
--- trunk/man/depmixS4-package.Rd 2009-06-24 19:39:58 UTC (rev 275)
+++ trunk/man/depmixS4-package.Rd 2009-06-24 21:43:28 UTC (rev 276)
@@ -34,7 +34,7 @@
Package: \tab depmixS4\cr
Type: \tab Package\cr
Version: \tab 0.2-2\cr
- Date: \tab 2009-13-05\cr
+ Date: \tab 2009-24-06\cr
License: \tab GPL\cr
}
@@ -46,6 +46,9 @@
\code{\link{fit}} function; imposing constraints is done through the
fit function. Standard output includes the optimized parameters and
the posterior densities for the states and the optimal state sequence.
+
+ For full control and the possibility to add new response distributions,
+ check the \code{\link{makeDepmix}} help page.
}
Modified: trunk/man/makeDepmix.Rd
===================================================================
--- trunk/man/makeDepmix.Rd 2009-06-24 19:39:58 UTC (rev 275)
+++ trunk/man/makeDepmix.Rd 2009-06-24 21:43:28 UTC (rev 276)
@@ -5,7 +5,7 @@
\alias{makeDepmix}
-\title{Dependent Mixture Model Specifiction: the long way}
+\title{Dependent Mixture Model Specifiction: full control and adding response models}
\description{
@@ -124,6 +124,149 @@
summary(fm)
+# in below example we add the exgaus distribution as a response model and fit
+# this instead of the gaussian distribution to the rt slot of the speed data
+# most of the actual computations for the exgaus distribution is done by calling
+# functions from the gamlss family of packages; see their help pages for
+# interpretation of the mu, nu and sigma parameters that are fitted below
+
+require(gamlss)
+require(gamlss.dist)
+
+data(speed)
+rt <- speed$rt
+
+# define a response class which only contains the standard slots, no additional slots
+setClass("exgaus", contains="response")
+
+# define a generic for the method defining the response class
+
+setGeneric("exgaus", function(y, pstart = NULL, fixed = NULL, ...) standardGeneric("exgaus"))
+
+# define the method that creates the response class
+
+setMethod("exgaus",
+ signature(y="ANY"),
+ function(y,pstart=NULL,fixed=NULL, ...) {
+ y <- matrix(y,length(y))
+ x <- matrix(1)
+ parameters <- list()
+ npar <- 3
+ if(is.null(fixed)) fixed <- as.logical(rep(0,npar))
+ if(!is.null(pstart)) {
+ if(length(pstart)!=npar) stop("length of 'pstart' must be ",npar)
+ parameters$mu <- pstart[1]
+ parameters$sigma <- log(pstart[2])
+ parameters$nu <- log(pstart[3])
+ }
+ mod <- new("exgaus",parameters=parameters,fixed=fixed,x=x,y=y,npar=npar)
+ mod
+ }
+)
+
+setMethod("show","exgaus",
+ function(object) {
+ cat("Model of type exgaus (see ?gamlss for details) \n")
+ cat("Parameters: \n")
+ cat("mu: ", object at parameters$mu, "\n")
+ cat("sigma: ", object at parameters$sigma, "\n")
+ cat("nu: ", object at parameters$nu, "\n")
+ }
+)
+
+setMethod("dens","exgaus",
+ function(object,log=FALSE) {
+ dexGAUS(object at y, mu = predict(object), sigma = exp(object at parameters$sigma), nu = exp(object at parameters$nu), log = log)
+ }
+)
+
+setMethod("getpars","response",
+ function(object,which="pars",...) {
+ switch(which,
+ "pars" = {
+ parameters <- numeric()
+ parameters <- unlist(object at parameters)
+ pars <- parameters
+ },
+ "fixed" = {
+ pars <- object at fixed
+ }
+ )
+ return(pars)
+ }
+)
+
+setMethod("setpars","exgaus",
+ function(object, values, which="pars", ...) {
+ npar <- npar(object)
+ if(length(values)!=npar) stop("length of 'values' must be",npar)
+ # determine whether parameters or fixed constraints are being set
+ nms <- names(object at parameters)
+ switch(which,
+ "pars"= {
+ object at parameters$mu <- values[1]
+ object at parameters$sigma <- values[2]
+ object at parameters$nu <- values[3]
+ },
+ "fixed" = {
+ object at fixed <- as.logical(values)
+ }
+ )
+ names(object at parameters) <- nms
+ return(object)
+ }
+)
+
+setMethod("fit","exgaus",
+ function(object,w) {
+ if(missing(w)) w <- NULL
+ y <- object at y
+ fit <- gamlss(y~1,weights=w,family=exGAUS(),
+ control=gamlss.control(n.cyc=100,trace=FALSE),
+ mu.start=object at parameters$mu,
+ sigma.start=exp(object at parameters$sigma),
+ nu.start=exp(object at parameters$nu))
+ pars <- c(fit$mu.coefficients,fit$sigma.coefficients,fit$nu.coefficients)
+ object <- setpars(object,pars)
+ object
+ }
+)
+
+setMethod("predict","exgaus",
+ function(object) {
+ ret <- object at parameters$mu
+ return(ret)
+ }
+)
+
+rModels <- list(
+ list(
+ exgaus(rt,pstart=c(5,.1,.1)),
+ GLMresponse(formula=corr~1,data=speed,family=multinomial(),pstart=c(0.5,0.5))
+ ),
+ list(
+ exgaus(rt,pstart=c(6,.1,.1)),
+ GLMresponse(formula=corr~1,data=speed,family=multinomial(),pstart=c(.1,.9))
+ )
+)
+
+trstart=c(0.9,0.1,0.1,0.9)
+
+transition <- list()
+transition[[1]] <- transInit(~Pacc,nstates=2,data=speed,pstart=c(trstart[1:2],0,0))
+transition[[2]] <- transInit(~Pacc,nstates=2,data=speed,pstart=c(trstart[3:4],0,0))
+
+instart=c(0.5,0.5)
+inMod <- transInit(~1,ns=2,ps=instart,data=data.frame(rep(1,3)))
+
+mod <- makeDepmix(response=rModels,transition=transition,prior=inMod,ntimes=attr(speed,"ntimes"),stat=FALSE)
+
+logLik(mod)
+
+fm1 <- fit(mod)
+
+summary(fm1)
+
}
\keyword{methods}
More information about the depmix-commits
mailing list