[Depmix-commits] r86 - in trunk: R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Mar 18 11:44:18 CET 2008
Author: ingmarvisser
Date: 2008-03-18 11:44:18 +0100 (Tue, 18 Mar 2008)
New Revision: 86
Modified:
trunk/R/allGenerics.R
trunk/R/depmix.R
trunk/R/responses.R
trunk/man/depmix.Rd
trunk/man/response.Rd
Log:
Codoc changes
Modified: trunk/R/allGenerics.R
===================================================================
--- trunk/R/allGenerics.R 2008-03-17 22:59:04 UTC (rev 85)
+++ trunk/R/allGenerics.R 2008-03-18 10:44:18 UTC (rev 86)
@@ -11,7 +11,8 @@
# Guess what: all generics
-setGeneric("depmix", function(response=any, transition=any, ...) standardGeneric("depmix"))
+setGeneric("depmix", function(response,data=NULL,nstates,transition=~1,family=gaussian(),prior=~1,initdata=NULL,
+ respstart=NULL,trstart=NULL,instart=NULL,ntimes=NULL, ...) standardGeneric("depmix"))
setGeneric("npar", function(object, ...) standardGeneric("npar"))
@@ -37,9 +38,11 @@
setGeneric("getdf",function(object) standardGeneric("getdf"))
-setGeneric("GLMresponse", function(formula, ... ) standardGeneric("GLMresponse"))
+setGeneric("GLMresponse", function(formula, data = NULL, family = gaussian(), pstart =
+ NULL, fixed = NULL, prob=TRUE, ...) standardGeneric("GLMresponse"))
-setGeneric("transInit", function(formula, ... ) standardGeneric("transInit"))
+setGeneric("transInit", function(formula, nstates, data = NULL, family = multinomial(),
+ pstart = NULL, fixed = NULL, prob=TRUE, ...) standardGeneric("transInit"))
setGeneric("setpars", function(object,values,which="pars",...) standardGeneric("setpars"))
Modified: trunk/R/depmix.R
===================================================================
--- trunk/R/depmix.R 2008-03-17 22:59:04 UTC (rev 85)
+++ trunk/R/depmix.R 2008-03-18 10:44:18 UTC (rev 86)
@@ -37,60 +37,55 @@
# 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
-setGeneric("depmix", function(response=any, transition=any, ...) standardGeneric("depmix"))
-
-setMethod("depmix",
- signature(response = "list", transition= "list"),
- function(response, transition, prior, ntimes=NULL, stationary=TRUE, ...) {
+makeDepmix <- function(response, transition, prior, ntimes=NULL, stationary=TRUE, ...) {
- nstates <- length(response)
- nresp <- length(response[[1]])
-
- # make appropriate ntimes
- if(is.null(ntimes)) {
- ntimes <- nrow(response[[1]][[1]]@y)
+ nstates <- length(response)
+ nresp <- length(response[[1]])
+
+ # make appropriate ntimes
+ if(is.null(ntimes)) {
+ ntimes <- nrow(response[[1]][[1]]@y)
+ }
+
+ # count the number of parameters
+ npars <- npar(prior)
+ for(i in 1:nstates) {
+ npars <- npars + sum(sapply(response[[i]],npar))
+ }
+ npars <- npars + sum(sapply(transition,npar))
+
+ # make appropriate array for transition densities
+ nt <- sum(ntimes)
+ if(stationary) trDens <- array(0,c(1,nstates,nstates))
+ else trDens <- array(0,c(nt,nstates,nstates))
+
+ # make appropriate array for response densities
+ 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
}
-
- # count the number of parameters
- npars <- npar(prior)
- for(i in 1:nstates) {
- npars <- npars + sum(sapply(response[[i]],npar))
- }
- npars <- npars + sum(sapply(transition,npar))
-
- # make appropriate array for transition densities
- nt <- sum(ntimes)
- if(stationary) trDens <- array(0,c(1,nstates,nstates))
- else trDens <- array(0,c(nt,nstates,nstates))
-
- # make appropriate array for response densities
- 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
- }
- trDens[,,i] <- dens(transition[[i]])
- }
-
- # compute initial state probabilties
- init <- dens(prior)
-
- new("depmix",response=response,transition=transition,prior=prior,
- dens=dens,trDens=trDens,init=init,stationary=stationary,
- ntimes=ntimes,nstates=nstates,nresp=nresp,npars=npars)
-
+ trDens[,,i] <- dens(transition[[i]])
}
-)
+
+ # compute initial state probabilties
+ init <- dens(prior)
+
+ new("depmix",response=response,transition=transition,prior=prior,
+ dens=dens,trDens=trDens,init=init,stationary=stationary,
+ ntimes=ntimes,nstates=nstates,nresp=nresp,npars=npars)
+
+}
#
# UNIVARIATE AND MULTIVARIATE MARKOV MIXTURE OF GLM'S
#
setMethod("depmix",
- signature(response="ANY",transition="formula"),
- function(response,data=NULL,nstates,transition,family=gaussian(),prior=~1,initdata=NULL,
+ signature(response="ANY"),
+ function(response,data=NULL,nstates,transition=~1,family=gaussian(),prior=~1,initdata=NULL,
respstart=NULL,trstart=NULL,instart=NULL,ntimes=NULL, ...) {
if(is.null(data)) {
@@ -116,7 +111,7 @@
prior <- makePriorModel(nstates=nstates,ncases=length(ntimes),formula=prior,data=initdata,values=instart)
# call main depmix with all these models, ntimes and stationary
- model <- depmix(response=response,transition=transition,prior=prior,ntimes=ntimes,stationary=stationary)
+ model <- makeDepmix(response=response,transition=transition,prior=prior,ntimes=ntimes,stationary=stationary)
# deal with starting values here!!!!!!
@@ -124,18 +119,9 @@
}
)
-setMethod("depmix",
- signature(response="ANY",transition="missing"),
- function(response,data=NULL,nstates,transition=~1,family=gaussian(),prior=~1,initdata=NULL,
- respstart=NULL,trstart=NULL,instart=NULL,ntimes=NULL, ...) {
-
- model <- depmix(response=response,data=data,nstates=nstates,transition=~1,family=family,
- prior=prior,initdata=initdata,respstart=respstart,trstart=trstart,instart=instart,ntimes=ntimes, ...)
-
- return(model)
-
- }
-)
+#
+# internal functions
+#
makeResponseModels <- function(response,data=NULL,nstates,family,values=NULL,...) {
Modified: trunk/R/responses.R
===================================================================
--- trunk/R/responses.R 2008-03-17 22:59:04 UTC (rev 85)
+++ trunk/R/responses.R 2008-03-18 10:44:18 UTC (rev 86)
@@ -53,7 +53,7 @@
setMethod("GLMresponse",
signature(formula="formula"),
- function(formula,data=NULL,family=gaussian(),pstart=NULL,fixed=NULL,prob=TRUE) {
+ function(formula,data=NULL,family=gaussian(),pstart=NULL,fixed=NULL,prob=TRUE, ...) {
call <- match.call()
mf <- match.call(expand.dots = FALSE)
m <- match(c("formula", "data"), names(mf), 0)
@@ -148,7 +148,7 @@
# are no covariates (and there are by definition no responses ...)
setMethod("transInit",
signature(formula="formula"),
- function(formula,nstates,data=NULL,family=multinomial(),pstart=NULL,prob=TRUE,fixed=NULL) {
+ function(formula,nstates,data=NULL,family=multinomial(),pstart=NULL,fixed=NULL,prob=TRUE, ...) {
call <- match.call()
mf <- match.call(expand.dots = FALSE)
m <- match(c("formula", "data"), names(mf), 0)
Modified: trunk/man/depmix.Rd
===================================================================
--- trunk/man/depmix.Rd 2008-03-17 22:59:04 UTC (rev 85)
+++ trunk/man/depmix.Rd 2008-03-18 10:44:18 UTC (rev 86)
@@ -3,6 +3,7 @@
\alias{depmixS4}
\alias{depmix}
+\alias{depmix,depmix-method}
\alias{logLik}
\alias{logLik,depmix-method}
Modified: trunk/man/response.Rd
===================================================================
--- trunk/man/response.Rd 2008-03-17 22:59:04 UTC (rev 85)
+++ trunk/man/response.Rd 2008-03-18 10:44:18 UTC (rev 86)
@@ -15,10 +15,11 @@
\usage{
- GLMresponse(formula, data=NULL, family=gaussian(), pstart=NULL, fixed=NULL)
+ GLMresponse(formula, data=NULL, family=gaussian(), pstart=NULL,
+ fixed=NULL, prob=TRUE, ...)
transInit(formula, nstates, data=NULL, family=multinomial(),
- pstart=NULL, prob=TRUE, fixed=NULL)
+ pstart=NULL, fixed=NULL, prob=TRUE, ...)
}
@@ -35,6 +36,7 @@
\item{prob}{Logical indicating whether the starting values for
multinomial() family models are probabilities or logistic
parameters (see details).}
+ \item{...}{Not used currently.}
}
\details{
More information about the depmix-commits
mailing list