使用gamlss包获得要在depmixs4包中使用的高斯分布

时间:2019-02-20 18:54:38

标签: r gamlss

我正在使用带有封装depmixs4的Hidden Markov Modeling对反应时间数据进行建模。该软件包的默认设置是高斯分布,但是,由于我正在使用的总体中反应时间通常很长,因此我们认为最好使用Ex-高斯分布。高斯分布不是程序包中系列默认选项之一,因此我可以使用您的帮助来解释代码以使其适用于我的数据:

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@parameters$mu, "\n")
                   cat("sigma: ", object@parameters$sigma, "\n")
                   cat("nu: ", object@parameters$nu, "\n")
                 }
       )

       setMethod("dens","exgaus",
                 function(object,log=FALSE) {
                   dexGAUS(object@y, mu = predict(object),
                           sigma = exp(object@parameters$sigma), nu = exp(object@parameters$nu), log = log)
                 }
       )

       setMethod("getpars","response",
                 function(object,which="pars"){
                   switch(which,
                          "pars" = {
                            parameters <- numeric()
                            parameters <- unlist(object@parameters)
                            pars <- parameters
                          },
                          "fixed" = {
                            pars <- object@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@parameters)
            switch(which,
                   "pars"= {
                     object@parameters$mu <- values[1]
                     object@parameters$sigma <- values[2]
                     object@parameters$nu <- values[3]
                   },
                   "fixed" = {
                     object@fixed <- as.logical(values)
                   }
            )
            names(object@parameters) <- nms
            return(object)
          }
)
setMethod("fit","exgaus",
          function(object,w) {
            if(missing(w)) w <- NULL
            y <- object@y
            fit <- gamlss(y~1,weights=w,family=exGAUS(),
                          control=gamlss.control(n.cyc=100,trace=FALSE),
                          mu.start=object@parameters$mu,
                          sigma.start=exp(object@parameters$sigma),
                          nu.start=exp(object@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@parameters$mu
            return(ret)
          }
)

#changed formula=corr~1 to formula=rt~1
#transInit - creates the initial transition probabilities but I don't them?

rModels <- list(
  list(
  exgaus(rt,pstart=NULL),
  GLMresponse(formula=rt~1, data=datanow5,
              family=multinomial("identity"))
),
list(
  exgaus(rt,pstart=NULL),
  GLMresponse(formula=rt~1, data=datanow5,
              family=multinomial("identity"), pstart=NULL
)
),
trstart=NULL,
transition <- list(),
transition[[1]] <- transInit(nstates=2,data=datanow5,pstart=c(trstart[1:2],0,0)),
transition[[2]] <- transInit(nstates=2,data=datanow5,pstart=c(trstart[3:4],0,0)),
instart=c(0.5,0.5),
inMod <- transInit(~1,ns=2,ps=instart,family=multinomial("identity"), data=data.frame(rep(1,3))),
mod <- makeDepmix(response=rModels,transition=transition,prior=inMod,
                  homogeneous=FALSE),
fm3 <- fit(mod,emc=em.control(rand=FALSE)),
summary(fm3))

以上是软件包中提供的默认代码,最后做了一些更改。我运行了上面的代码,并收到以下错误:

错误(函数(类,fdef,mtable)):   找不到签名““缺失””的函数“ transInit”的继承方法

我没有模型的初始概率(因为以前从未使用过),我也不知道初始转换概率。我可以将其设置为NULL还是可以在模型中使用一些默认值?

0 个答案:

没有答案