SCM

SCM Repository

[matrix] View of /branches/trunk-lme4/R/ssclme.R
ViewVC logotype

View of /branches/trunk-lme4/R/ssclme.R

Parent Directory Parent Directory | Revision Log Revision Log


Revision 46 - (download) (annotate)
Mon Apr 5 01:08:02 2004 UTC (16 years, 3 months ago) by bates
File size: 4822 byte(s)
Added vcov method, rearranged source files
setReplaceMethod("LMEoptimize", signature(x="ssclme", value="list"),
                 function(x, value)
             {
                 if (value$msMaxIter < 1) return(x)
                 st = coef(x, unconstr = TRUE) # starting values
                 if (value$optimizer == "optim") {
                     optimRes =
                         if (value$analyticGradient) {
                             optim(st,
                                   fn = function(pars) {
                                       coef(x, unconstr = TRUE) = pars
                                       deviance(x, REML = value$REML)
                                   },
                                   gr = function(pars) {
                                       coef(x, unconstr = TRUE) = pars
                                       gradient(x, REML = value$REML)
                                   },
                                   method = "BFGS",
                                   control = list(trace = value$msVerbose,
                                                  reltol = value$msTol,
                                                  maxit = value$msMaxIter))
                         } else {
                             optim(st,
                                   fn = function(pars) {
                                       coef(x, unconstr = TRUE) = pars
                                       deviance(x, REML = value$REML)
                                   },
                                   method = "BFGS",
                                   control = list(trace = value$msVerbose,
                                                  reltol = value$msTol,
                                                  maxit = value$msMaxIter))
                         }
                     if (optimRes$convergence != 0) {
                         warning("optim failed to converge")
                     }
                     coef(x, unconstr = TRUE) = optimRes$par
                 } else {
                     typsize <- rep(1.0, length(st))
                     if (is.null(value$nlmStepMax))
                         value$nlmStepMax <-
                             max(100 * sqrt(sum((st/typsize)^2)), 100)
                     nlmRes =
                         nlm(f = if (value$analyticGradient) {
                             function(pars) {
                                 coef(x, unconstr = TRUE) = pars
                                 ans = deviance(x, REML = value$REML)
                                 attr(ans, "gradient") =
                                     gradient(x, REML = value$REML)
                                 ans
                             }
                         } else {
                             function(pars)
                             {
                                 coef(x, unconstr = TRUE) = pars
                                 deviance(x, REML = value$REML)
                             }
                         },
                             p = st,
                             print.level = if (value$msVerbose) 2 else 0,
                             steptol = value$msTol,
                             gradtol = value$msTol,
                             stepmax = value$nlmStepMax,
                             typsize=typsize,
                             iterlim = value$msMaxIter)
                     coef(x, unconstr = TRUE) = nlmRes$estimate
                 }
                 return(x)
             })

setMethod("deviance", signature(object = "ssclme"),
          function(object, REML = FALSE, ...) {
              .Call("ssclme_factor", object, PACKAGE = "Matrix")
              object@deviance[ifelse(REML, 2, 1)]
          })

setMethod("coef", signature(object = "ssclme"),
          function(object, ...) {
              .Call("ssclme_coef", object, PACKAGE = "Matrix")
          })

setMethod("ranef", signature(object = "ssclme"),
          function(object, ...) {
              val = .Call("ssclme_ranef", object, PACKAGE = "Matrix")
              bv = object@bVar
              names(val) = names(bv)
              for (i in seq(along = val)) {
                  dimnames(val[[i]]) = dimnames(bv[[i]])[-1]
              }
              lapply(val, t)
          })


setMethod("fixef", signature(object = "ssclme"),
          function(object, ...) {
              val = .Call("ssclme_fixef", object, PACKAGE = "Matrix")
              names(val) = dimnames(object@XtX)[[2]][seq(along = val)]
              val
          })

setMethod("vcov", signature(object = "ssclme"),
          function(object, ...) {
              sigma = .Call("ssclme_sigma", object, PACKAGE = "Matrix")
              rr = object@RXX
              nr = nrow(rr)
              rr = rr[-nr, -nr, drop = FALSE]
              sigma^2 * rr %*% t(rr)
          })


root@r-forge.r-project.org
ViewVC Help
Powered by ViewVC 1.0.0  
Thanks to:
Vienna University of Economics and Business Powered By FusionForge