[Depmix-commits] r156 - in trunk: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Jun 11 23:06:46 CEST 2008
Author: ingmarvisser
Date: 2008-06-11 23:06:46 +0200 (Wed, 11 Jun 2008)
New Revision: 156
Added:
trunk/man/mix.Rd
Modified:
trunk/NAMESPACE
trunk/R/EM.R
trunk/R/depmix-class.R
trunk/R/depmix.R
trunk/R/depmixAIC.R
trunk/R/depmixBIC.R
trunk/R/depmixfit-class.R
trunk/R/depmixfit.R
trunk/R/freepars.R
trunk/R/getpars.R
trunk/R/logLik.R
trunk/R/lystig.R
trunk/R/makeDepmix.R
trunk/R/makeResponseModels.R
trunk/R/nobs.R
trunk/R/setpars.R
trunk/R/viterbi.R
trunk/man/depmix.Rd
trunk/man/depmixS4-package.Rd
Log:
Added mix class for mixture and latent class models
Modified: trunk/NAMESPACE
===================================================================
--- trunk/NAMESPACE 2008-06-11 10:26:32 UTC (rev 155)
+++ trunk/NAMESPACE 2008-06-11 21:06:46 UTC (rev 156)
@@ -4,6 +4,7 @@
export(
makeDepmix,
+ makeMix,
lystig,
fb,
forwardbackward,
@@ -16,7 +17,9 @@
exportClasses(
depmix,
+ mix,
depmix.fitted,
+ mix.fitted,
response,
GLMresponse,
transInit
@@ -32,7 +35,9 @@
nobs,
nresp,
ntimes,
+ nstates,
depmix,
+ mix,
posterior,
GLMresponse,
transInit,
Modified: trunk/R/EM.R
===================================================================
--- trunk/R/EM.R 2008-06-11 10:26:32 UTC (rev 155)
+++ trunk/R/EM.R 2008-06-11 21:06:46 UTC (rev 156)
@@ -4,7 +4,7 @@
em <- function(object,maxit=100,tol=1e-6,verbose=FALSE,...) {
- if(!is(object,"depmix")) stop("object is not of class 'depmix'")
+ if(!is(object,"mix")) stop("object is not of class '(dep)mix'")
ns <- object at nstates
@@ -36,7 +36,6 @@
trm <- matrix(0,ns,ns)
for(i in 1:ns) {
-
if(max(ntimes(object)>1)) { # skip transition parameters update in case of latent class model
if(!object at stationary) {
object at transition[[i]]@y <- fbo$xi[,,i]/fbo$gamma[,i]
@@ -48,7 +47,6 @@
# FIX THIS; it will only work with a specific trinModel
object at transition[[i]]@parameters$coefficients <- object at transition[[i]]@family$linkfun(trm[i,],base=object at transition[[i]]@family$base)
}
-
# update trDens slot of the model
object at trDens[,,i] <- dens(object at transition[[i]])
}
@@ -78,16 +76,14 @@
}
- class(object) <- "depmix.fitted"
+ if(class(object)=="depmix") class(object) <- "depmix.fitted"
+ if(class(object)=="mix") class(object) <- "mix.fitted"
+
if(converge) object at message <- "Log likelihood converged to within tol."
else object at message <- "'maxit' iterations reached in EM without convergence."
# no constraints in EM
object at conMat <- matrix()
- # what do we want in slot posterior?
- # this is moved to depmix.fit
- # object at posterior <- viterbi(object)
-
object
}
Modified: trunk/R/depmix-class.R
===================================================================
--- trunk/R/depmix-class.R 2008-06-11 10:26:32 UTC (rev 155)
+++ trunk/R/depmix-class.R 2008-06-11 21:06:46 UTC (rev 156)
@@ -1,45 +1,46 @@
#
-# Ingmar Visser, 23-3-2008
+# Ingmar Visser, 11-6-2008
#
#
+# DEPMIX CLASS BELOW THE MIX CLASS
+#
+
+#
# Class definition, accessor functions, print and summary methods
#
#
-# DEPMIX CLASS
+# MIX CLASS
#
-setClass("depmix",
+setClass("mix",
representation(response="list", # response models
- transition="list", # transition models (multinomial logistic)
prior="ANY", # the prior model (multinomial logistic)
dens="array", # response densities (B)
- trDens="array", # transition densities (A)
init="array", # usually called pi
- stationary="logical",
- ntimes="numeric",
nstates="numeric",
nresp="numeric",
+ ntimes="numeric",
npars="numeric" # number of parameters
)
)
# accessor functions
-setMethod("npar","depmix",
+setMethod("npar","mix",
function(object) return(object at npars)
)
-setMethod("ntimes","depmix",
+setMethod("ntimes","mix",
function(object) return(object at ntimes)
)
-setMethod("nstates","depmix",
+setMethod("nstates","mix",
function(object) return(object at nstates)
)
-setMethod("nresp","depmix",
+setMethod("nresp","mix",
function(object) return(object at nresp)
)
@@ -48,6 +49,52 @@
# PRINT method
#
+setMethod("show","mix",
+ function(object) {
+ cat("Initial state probabilties model \n")
+ print(object at prior)
+ cat("\n")
+ for(i in 1:object at nstates) {
+ cat("Response model(s) for state", i,"\n\n")
+ for(j in 1:object at nresp) {
+ cat("Response model for response",j,"\n")
+ print(object at response[[i]][[j]])
+ cat("\n")
+ }
+ cat("\n")
+ }
+ }
+)
+
+#
+# SUMMARY method: to do
+#
+
+
+#
+# Ingmar Visser, 23-3-2008
+#
+
+#
+# Class definition, accessor functions, print and summary methods
+#
+
+#
+# DEPMIX CLASS
+#
+
+setClass("depmix",
+ representation(transition="list", # transition models (multinomial logistic)
+ trDens="array", # transition densities (A)
+ stationary="logical"
+ ),
+ contains="mix"
+)
+
+#
+# PRINT method
+#
+
setMethod("show","depmix",
function(object) {
cat("Initial state probabilties model \n")
Modified: trunk/R/depmix.R
===================================================================
--- trunk/R/depmix.R 2008-06-11 10:26:32 UTC (rev 155)
+++ trunk/R/depmix.R 2008-06-11 21:06:46 UTC (rev 156)
@@ -1,5 +1,44 @@
+#
+# 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
#
Modified: trunk/R/depmixAIC.R
===================================================================
--- trunk/R/depmixAIC.R 2008-06-11 10:26:32 UTC (rev 155)
+++ trunk/R/depmixAIC.R 2008-06-11 21:06:46 UTC (rev 156)
@@ -4,3 +4,10 @@
c(-2 * logLik(object) + freepars(object) * k)
}
)
+
+# depends on logLik and freepars
+setMethod("AIC", signature(object="mix"),
+ function(object, ..., k=2){
+ c(-2 * logLik(object) + freepars(object) * k)
+ }
+)
\ No newline at end of file
Modified: trunk/R/depmixBIC.R
===================================================================
--- trunk/R/depmixBIC.R 2008-06-11 10:26:32 UTC (rev 155)
+++ trunk/R/depmixBIC.R 2008-06-11 21:06:46 UTC (rev 156)
@@ -4,3 +4,9 @@
c(-2 * logLik(object) + freepars(object) * log(nobs(object)))
}
)
+
+setMethod("BIC", signature(object="mix"),
+ function(object, ...){
+ c(-2 * logLik(object) + freepars(object) * log(nobs(object)))
+ }
+)
Modified: trunk/R/depmixfit-class.R
===================================================================
--- trunk/R/depmixfit-class.R 2008-06-11 10:26:32 UTC (rev 155)
+++ trunk/R/depmixfit-class.R 2008-06-11 21:06:46 UTC (rev 156)
@@ -1,5 +1,55 @@
#
+# Ingmar Visser, 11-6-2008
+#
+
+#
+# MIX.FITTED CLASS
+#
+
+setClass("mix.fitted",
+ representation(message="character", # convergence information
+ conMat="matrix", # constraint matrix on the parameters for general linear constraints
+ posterior="data.frame" # posterior probabilities for the states
+ ),
+ contains="mix"
+)
+
+# accessor functions
+
+setMethod("posterior","mix.fitted",
+ function(object) {
+ return(object at posterior)
+ }
+)
+
+setMethod("show","mix.fitted",
+ function(object) {
+ cat("Convergence info:",object at message,"\n")
+ print(logLik(object))
+ cat("AIC: ", AIC(object),"\n")
+ cat("BIC: ", BIC(object),"\n")
+ }
+)
+
+setMethod("summary","mix.fitted",
+ function(object) {
+ cat("Mixture probabilities model \n")
+ print(object at prior)
+ cat("\n")
+ for(i in 1:object at nstates) {
+ cat("Response model(s) for state", i,"\n\n")
+ for(j in 1:object at nresp) {
+ cat("Response model for response",j,"\n")
+ print(object at response[[i]][[j]])
+ cat("\n")
+ }
+ cat("\n")
+ }
+ }
+)
+
+#
# Ingmar Visser, 23-3-2008
#
@@ -15,7 +65,7 @@
contains="depmix"
)
-# accessor function
+# accessor functions
setMethod("posterior","depmix.fitted",
function(object) {
Modified: trunk/R/depmixfit.R
===================================================================
--- trunk/R/depmixfit.R 2008-06-11 10:26:32 UTC (rev 155)
+++ trunk/R/depmixfit.R 2008-06-11 21:06:46 UTC (rev 156)
@@ -1,6 +1,6 @@
setMethod("fit",
- signature(object="depmix"),
+ signature(object="mix"),
function(object,fixed=NULL,equal=NULL,conrows=NULL,conrows.upper=0,conrows.lower=0,method=NULL,...) {
# when there are linear constraints donlp should be used
@@ -107,7 +107,8 @@
...
)
- class(object) <- "depmix.fitted"
+ if(class(object)=="depmix") class(object) <- "depmix.fitted"
+ if(class(object)=="mix") class(object) <- "mix.fitted"
object at conMat <- linconFull
object at message <- result$message
Modified: trunk/R/freepars.R
===================================================================
--- trunk/R/freepars.R 2008-06-11 10:26:32 UTC (rev 155)
+++ trunk/R/freepars.R 2008-06-11 21:06:46 UTC (rev 156)
@@ -1,5 +1,5 @@
# depends on nlin(object) and getpars(object)
-setMethod("freepars","depmix",
+setMethod("freepars","mix",
function(object) {
free <- sum(!getpars(object,which="fixed"))
# free <- free-nlin(object) # FIX ME!!!!
Modified: trunk/R/getpars.R
===================================================================
--- trunk/R/getpars.R 2008-06-11 10:26:32 UTC (rev 155)
+++ trunk/R/getpars.R 2008-06-11 21:06:46 UTC (rev 156)
@@ -1,10 +1,12 @@
-setMethod("getpars","depmix",
+setMethod("getpars","mix",
function(object,which="pars",...) {
parameters <- getpars(object at prior,which=which)
+ if(class(object)=="depmix") {
+ for(i in 1:object at nstates) {
+ parameters <- c(parameters,getpars(object at transition[[i]],which=which))
+ }
+ }
for(i in 1:object at nstates) {
- parameters <- c(parameters,getpars(object at transition[[i]],which=which))
- }
- for(i in 1:object at nstates) {
for(j in 1:object at nresp) {
parameters <- c(parameters,getpars(object at response[[i]][[j]],which=which))
}
Modified: trunk/R/logLik.R
===================================================================
--- trunk/R/logLik.R 2008-06-11 10:26:32 UTC (rev 155)
+++ trunk/R/logLik.R 2008-06-11 21:06:46 UTC (rev 156)
@@ -8,4 +8,16 @@
class(ll) <- "logLik"
ll
}
+)
+
+# depends on getpars and nobs
+setMethod("logLik",signature(object="mix"),
+ function(object,method="lystig") {
+ if(method=="fb") ll <- fb(object at init,matrix(0,1,1),object at dens,object at ntimes,TRUE)$logLike
+ if(method=="lystig") ll <- lystig(object at init,matrix(0,1,1),object at dens,object at ntimes,TRUE)$logLike
+ attr(ll, "df") <- freepars(object)
+ attr(ll, "nobs") <- nobs(object)
+ class(ll) <- "logLik"
+ ll
+ }
)
\ No newline at end of file
Modified: trunk/R/lystig.R
===================================================================
--- trunk/R/lystig.R 2008-06-11 10:26:32 UTC (rev 155)
+++ trunk/R/lystig.R 2008-06-11 21:06:46 UTC (rev 156)
@@ -16,9 +16,9 @@
# IN COMPUTING ALPHA AND BETA BUT IS NOW NECCESSARY IN COMPUTING XI
# A = K*K matrix with transition probabilities, from column to row !!!!!!!
# change to T*K*K
+
+ B <- apply(B,c(1,3),prod)
- B <- apply(B,c(1,3),prod)
-
# B = T*K*nresp matrix with elements ab_{tij} = P(y_t_i|s_j)
# init = K vector with initial probabilities !!!OR!!! K*length(ntimes) matrix with initial probs per case
# Returns: 'sca'le factors, recurrent variables 'phi', loglikelihood
@@ -34,10 +34,10 @@
et <- cumsum(ntimes)
bt <- c(1,et[-lt]+1)
- ll <- 0
-
+ ll <- 0
+
for(case in 1:lt) { # multiple cases
- phi[bt[case],] <- init[case,]*B[bt[case],] # initialize
+ phi[bt[case],] <- init[case,]*B[bt[case],] # initialize case
sca[bt[case]] <- 1/sum(phi[bt[case],])
if(ntimes[case]>1) {
for(i in (bt[case]+1):et[case]) {
Modified: trunk/R/makeDepmix.R
===================================================================
--- trunk/R/makeDepmix.R 2008-06-11 10:26:32 UTC (rev 155)
+++ trunk/R/makeDepmix.R 2008-06-11 21:06:46 UTC (rev 156)
@@ -1,4 +1,43 @@
+
+# the main function constructing a mix model with full information, ie all models already in place
+# this function is probably not ever called by users ...
+
+makeMix <-
+function(response, prior, ...) {
+
+ nstates <- length(response)
+ nresp <- length(response[[1]])
+
+ # count the number of parameters
+ npars <- npar(prior)
+ for(i in 1:nstates) {
+ npars <- npars + sum(sapply(response[[i]],npar))
+ }
+
+ # make appropriate array for response densities
+ nt <- nrow(response[[1]][[1]]@y)
+ ntimes <- rep(1,nt)
+ dens <- array(,c(nt,nresp,nstates))
+
+ # compute observation and transition densities
+ for(i in 1:nstates) {
+ for(j in 1:nresp) {
+ dens[,j,i] <- dens(response[[i]][[j]]) # remove this response as an argument from the call to setpars
+ }
+ }
+
+ # compute initial state probabilties
+ init <- dens(prior)
+
+ new("mix",response=response,prior=prior,
+ dens=dens,init=init,nstates=nstates,
+ nresp=nresp,ntimes=ntimes,npars=npars)
+
+}
+
+
+
# the main function constructing a depmix model with full information, ie all models already in place
# this function is probably not ever called by users
Modified: trunk/R/makeResponseModels.R
===================================================================
--- trunk/R/makeResponseModels.R 2008-06-11 10:26:32 UTC (rev 155)
+++ trunk/R/makeResponseModels.R 2008-06-11 21:06:46 UTC (rev 156)
@@ -22,7 +22,7 @@
}
}
- # multi variate response data
+ # multivariate response data
if(is.list(resp)) {
nresp <- length(resp)
for(i in 1:nstates) {
Modified: trunk/R/nobs.R
===================================================================
--- trunk/R/nobs.R 2008-06-11 10:26:32 UTC (rev 155)
+++ trunk/R/nobs.R 2008-06-11 21:06:46 UTC (rev 156)
@@ -1,4 +1,4 @@
-setMethod("nobs", signature(object="depmix"),
+setMethod("nobs", signature(object="mix"),
function(object, ...) {
sum(object at ntimes)
}
Modified: trunk/R/setpars.R
===================================================================
--- trunk/R/setpars.R 2008-06-11 10:26:32 UTC (rev 155)
+++ trunk/R/setpars.R 2008-06-11 21:06:46 UTC (rev 156)
@@ -1,5 +1,5 @@
# depends on npar
-setMethod("setpars","depmix",
+setMethod("setpars","mix",
function(object,values,which="pars",...) {
if(!(length(values)==npar(object))) stop("Argument 'values' has incorrect length")
bp <- npar(object at prior)
@@ -17,22 +17,24 @@
)
bp <- bp+1
values <- values[bp:npar(object)]
- for(i in 1:object at nstates) {
- bp <- npar(object at transition[[i]])
- switch(which,
- "pars"= {
- if(!all(getpars(object at transition[[i]]) == values[1:bp])) {
- object at transition[[i]] <- setpars(object at transition[[i]],values[1:bp])
- # recompute transition densities if pars have changed
- object at trDens[,,i] <- dens(object at transition[[i]])
+ if(class(object)=="depmix") {
+ for(i in 1:object at nstates) {
+ bp <- npar(object at transition[[i]])
+ switch(which,
+ "pars"= {
+ if(!all(getpars(object at transition[[i]]) == values[1:bp])) {
+ object at transition[[i]] <- setpars(object at transition[[i]],values[1:bp])
+ # recompute transition densities if pars have changed
+ object at trDens[,,i] <- dens(object at transition[[i]])
+ }
+ },
+ "fixed" = {
+ object at transition[[i]] <- setpars(object at transition[[i]],values[1:bp],which="fixed")
}
- },
- "fixed" = {
- object at transition[[i]] <- setpars(object at transition[[i]],values[1:bp],which="fixed")
- }
- )
- bp <- bp+1
- values <- values[bp:length(values)]
+ )
+ bp <- bp+1
+ values <- values[bp:length(values)]
+ }
}
for(i in 1:object at nstates) {
for(j in 1:object at nresp) {
Modified: trunk/R/viterbi.R
===================================================================
--- trunk/R/viterbi.R 2008-06-11 10:26:32 UTC (rev 155)
+++ trunk/R/viterbi.R 2008-06-11 21:06:46 UTC (rev 156)
@@ -17,7 +17,7 @@
prior <- object at init
- A <- object at trDens
+ if(max(ntimes(object)>1)) A <- object at trDens
B <- apply((object at dens),c(1,3),prod)
for(case in 1:lt) {
Modified: trunk/man/depmix.Rd
===================================================================
--- trunk/man/depmix.Rd 2008-06-11 10:26:32 UTC (rev 155)
+++ trunk/man/depmix.Rd 2008-06-11 21:06:46 UTC (rev 156)
@@ -69,9 +69,7 @@
attribute ntimes, then this is used.}
\item{...}{Not used currently.}
-
- \item{object}{An object of class \code{depmix}.}
-
+
}
\details{
Modified: trunk/man/depmixS4-package.Rd
===================================================================
--- trunk/man/depmixS4-package.Rd 2008-06-11 10:26:32 UTC (rev 155)
+++ trunk/man/depmixS4-package.Rd 2008-06-11 21:06:46 UTC (rev 156)
@@ -21,6 +21,10 @@
observations. The response densities for each state may be chosen from
the GLM family, or a multinomial. User defined response densities are
easy to add.
+
+ Mixture or latent class (regression) models can also be fitted; these
+ are the limit case in which the length of observed time series is 1 for
+ all cases.
}
@@ -35,7 +39,8 @@
}
Model fitting is done in two steps; first, models are specified through
- the \code{\link{depmix}} function, which uses standard
+ the \code{\link{depmix}} function (or the \code{\link{mix}} function for
+ mixture and latent class models), which both use standard
\code{\link{glm}} style arguments to specify the observed
distributions; second, the model needs to be fitted by using the
\code{\link{fit}} function; imposing constraints is done through the
Added: trunk/man/mix.Rd
===================================================================
--- trunk/man/mix.Rd (rev 0)
+++ trunk/man/mix.Rd 2008-06-11 21:06:46 UTC (rev 156)
@@ -0,0 +1,159 @@
+
+\name{mix}
+
+\docType{methods}
+
+\alias{mix}
+\alias{mix,ANY-method}
+
+\alias{show,mix-method}
+\alias{summary,mix-method}
+
+\title{ Mixture Model Specifiction }
+
+\description{
+
+ \code{mix} creates an object of class \code{mix}, an (independent)
+ mixture model (as a limit case of dependent mixture models in which all
+ observed time series are of length 1), otherwise known latent class or
+ mixture model. For a short description of the package see
+ \code{\link{depmixS4}}.
+
+}
+
+\usage{
+
+ mix(response, data=NULL, nstates, family=gaussian(),
+ prior=~1, initdata=NULL, respstart=NULL, instart=NULL,...)
+
+}
+
+\arguments{
+
+ \item{response}{The response to be modeled; either a formula or a list
+ of formulae in the multivariate case; this interfaces to the glm
+ distributions. See 'Details'.}
+
+ \item{data}{An optional data.frame to interpret the variables in
+ the response and transition arguments.}
+
+ \item{nstates}{The number of states of the model.}
+
+ \item{family}{A family argument for the response. This must be a list
+ of family's if the response is multivariate.}
+
+ \item{prior}{A one-sided formula specifying the density for the prior
+ or initial state probabilities.}
+
+ \item{initdata}{An optional data.frame to interpret the variables
+ occuring in prior. The number of rows of this data.frame must be
+ equal to the number of cases being modeled. See 'Details'.}
+
+ \item{respstart}{Starting values for the parameters of the response
+ models.}
+
+ \item{instart}{Starting values for the parameters of the prior or
+ initial state probability model.}
+
+ \item{...}{Not used currently.}
+
+}
+
+\details{
+
+ The function \code{mix} creates an S4 object of class \code{mix},
+ which needs to be fitted using \code{\link{fit}} to optimize the
+ parameters.
+
+ The response model(s) are created by call(s) to \code{\link{response}}
+ providing the response formula and the family specifying the error
+ distribution. If response is a list of formulae, the \code{response}'s
+ are assumed to be independent conditional on the latent state.
+
+ The prior density is modeled as a multinomial logistic. This model is
+ created by a call to \code{\link{transInit}}.
+
+ Starting values may be provided by the respective arguments. The order
+ in which parameters must be provided can be easily studied by using the
+ \code{\link{setpars}} function.
+
+ Linear constraints on parameters can be provided as argument to the
+ \code{\link{fit}} function.
+
+ The print function prints the formulae for the response and prior
+ models along with their parameter values.
+
+}
+
+\value{
+
+\code{depmix} returns an object of class \code{depmix} which has the
+following slots:
+
+ \item{response}{A list of a list of response models; the first
+ index runs over states; the second index runs over the independent
+ responses in case a multivariate response is provided.}
+
+ \item{prior}{A multinomial logistic model for the initial state
+ probabilities.}
+
+ \item{dens,init}{See \code{\link{mix-class}} help for details. For
+ internal use.}
+
+ \item{ntimes}{A vector containing the lengths of independent time
+ series; if data is provided, sum(ntimes) must be equal to
+ nrow(data).}
+
+ \item{nstates}{The number of states of the model.}
+
+ \item{nresp}{The number of independent responses.}
+
+ \item{npars}{The total number of parameters of the model. Note: this
+ is \emph{not} the degrees of freedom because there are redundancies in the
+ parameters, in particular in the multinomial models for the transitions
+ and prior probabilities.}
+
+}
+
+\author{Ingmar Visser}
+
+\seealso{
+
+ \code{\link{fit}}, \code{\link{transInit}}, \code{\link{response}},
+ \code{\link{depmix-methods}} for accessor functions to \code{depmix}
+ objects.
+
+}
+
+\references{
+
+ On hidden Markov models: Lawrence R. Rabiner (1989). A tutorial on
+ hidden Markov models and selected applications in speech recognition.
+ \emph{Proceedings of IEEE}, 77-2, p. 267-295.
+
+ On latent class models: A. L. McCutcheon (1987). \emph{Latent class
+ analysis}. Sage Publications.
+
+}
+
+\examples{
+
+# four binary items on the balance scale task
+data(balance)
+
+# define a latent class model
+instart=c(0.5,0.5)
+set.seed(1)
+respstart=runif(16)
+# note that ntimes argument is used to make this a mixture model
+mod <- mix(list(d1~1,d2~1,d3~1,d4~1), data=balance, nstates=2,
+ family=list(multinomial(),multinomial(),multinomial(),multinomial()),
+ respstart=respstart,instart=instart)
+# to see the model
+mod
+
+}
+
+\keyword{methods}
+
+
Property changes on: trunk/man/mix.Rd
___________________________________________________________________
Name: svn:executable
+ *
More information about the depmix-commits
mailing list