SCM

SCM Repository

[matrix] Diff of /branches/trunk-lme4/R/lme.R
ViewVC logotype

Diff of /branches/trunk-lme4/R/lme.R

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 45, Mon Apr 5 01:06:55 2004 UTC revision 46, Mon Apr 5 01:08:02 2004 UTC
# Line 142  Line 142 
142                tmp[[3]][[3]] <- formula(pdm)[[2]]                tmp[[3]][[3]] <- formula(pdm)[[2]]
143                form <- tmp                form <- tmp
144            }            }
145            environment(form) <- environment(formula)            environment(form) = environment(formula)
146            mCall$formula <- form            mCall$formula = form
147            mCall$drop.unused.levels <- TRUE            mCall$drop.unused.levels = TRUE
148            data <- eval(mCall, parent.frame())            data = eval(mCall, parent.frame())
149            facs <- lapply(names(random),            facs = lapply(names(random),
150                           function(x) eval(as.name(x), envir = data))                           function(x) eval(as.name(x), envir = data))
151              names(facs) = names(random)
152            mmats <- c(lapply(random,            mmats <- c(lapply(random,
153                              function(x) model.matrix(formula(x), data = data)),                              function(x) model.matrix(formula(x), data = data)),
154                       list(.Xy = cbind(model.matrix(formula, data = data),                       list(.Xy = cbind(model.matrix(formula, data = data),
155                            .response = model.response(data))))                            .response = model.response(data))))
156            obj <- .Call("ssclme_create", facs, unlist(lapply(mmats, ncol)),            obj = .Call("ssclme_create", facs, unlist(lapply(mmats, ncol)),
157                         as.integer(2e5), PACKAGE = "Matrix")                         as.integer(2e5), PACKAGE = "Matrix")
158            facs = facshuffle(obj, facs)            facs = facshuffle(obj, facs)
           names(facs) <- names(random)  
159            obj = obj[[1]]            obj = obj[[1]]
160            .Call("ssclme_update_mm", obj, facs, mmats, PACKAGE="Matrix")            .Call("ssclme_update_mm", obj, facs, mmats, PACKAGE="Matrix")
161            .Call("ssclme_initial", obj, PACKAGE="Matrix")            .Call("ssclme_initial", obj, PACKAGE="Matrix")
# Line 172  Line 172 
172  setMethod("fitted", signature=c(object="lme"),  setMethod("fitted", signature=c(object="lme"),
173            function(object, ...)            function(object, ...)
174        {        {
175            if (object@x) {            object@fitted
               .Call("ssclme_fitted", object, object@facs, object@x,  
                     PACKAGE = "Matrix")  
           }  
176        })        })
177    
178  setMethod("residuals", signature=c(object="lme"),  setMethod("residuals", signature=c(object="lme"),
# Line 186  Line 183 
183            -deviance(object@rep, REML = REML)/2)            -deviance(object@rep, REML = REML)/2)
184    
185  setMethod("deviance", signature(object="lme"),  setMethod("deviance", signature(object="lme"),
186            function(object, REML = FALSE, ...)            function(object, REML, ...)
187            deviance(object@rep,            deviance(object@rep,
188                     REML = ifelse(missing(REML), object@REML, REML))                     REML = ifelse(missing(REML), object@REML, REML))
189            )            )
# Line 240  Line 237 
237  setMethod("show", "lme",  setMethod("show", "lme",
238            function(object)            function(object)
239        {        {
240            sumry = summary(object)            #sumry = summary(object)
241            rdig <- 5            rdig <- 5
242            cat("Linear mixed-effects model\n")            cat("Linear mixed-effects model\n")
243            cat(" Data:", deparse( sumry@call$data ), "\n")            cat(" Data:", deparse( object@call$data ), "\n")
244            if (!is.null(sumry@call$subset)) {            if (!is.null(object@call$subset)) {
245                cat("  Subset:",                cat("  Subset:",
246                    deparse(asOneSidedFormula(sumry@call$subset)[[2]]),"\n")                    deparse(asOneSidedFormula(object@call$subset)[[2]]),"\n")
247            }            }
248            cat(paste(" log-", ifelse(sumry@re@REML, "restricted-", ""),            cat(paste(" log-", ifelse(object@REML, "restricted-", ""),
249                      "likelihood: ", sep = ''), sumry@logLik, "\n")                      "likelihood: ", sep = ''), logLik(object), "\n")
250            sumry@re@useScale = TRUE            show(fixef(object))
251            sumry@re@showCorrelation = FALSE            show(c(object@rep@Omega,
252            saveopt = options(show.signif.stars=FALSE)                   sigmaSq = .Call("ssclme_sigma",
253            on.exit(saveopt)                                   object@rep, PACKAGE="Matrix")^2))
254            show(sumry@re)            nc = object@rep@nc
255            options(saveopt)            cat("\nNumber of Observations:", nc[length(nc)], "\n")
           on.exit()  
           cat("\nNumber of Observations:", sumry@re@nobs, "\n")  
256            invisible(object)            invisible(object)
257        })        })
258    
# Line 318  Line 313 
313            else call            else call
314        })        })
315    
316  setMethod("getResponse", signature(object="lme"),  setMethod("vcov", signature(object = "lme"),
           function(object, form)  
       {  
           object <- object@reStruct  
           callGeneric()  
       })  
   
 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"),  
317            function(object, ...) {            function(object, ...) {
318                .Call("ssclme_coef", object, PACKAGE = "Matrix")                object = object@rep
319                  callGeneric()
320            })            })
321    
 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)  
           })  
322    
 setMethod("fixef", signature(object = "ssclme"),  
           function(object, ...) {  
               val = .Call("ssclme_fixef", object, PACKAGE = "Matrix")  
               names(val) = dimnames(object@XtX)[[2]][seq(along = val)]  
               val  
           })  

Legend:
Removed from v.45  
changed lines
  Added in v.46

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