SCM

SCM Repository

[matrix] Diff of /pkg/R/lmer.R
ViewVC logotype

Diff of /pkg/R/lmer.R

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

revision 690, Tue Apr 5 22:17:04 2005 UTC revision 691, Fri Apr 15 14:37:38 2005 UTC
# Line 99  Line 99 
99            Xmat <- model.matrix(fixed.form, frm)            Xmat <- model.matrix(fixed.form, frm)
100            mmats <- c(lapply(random, "[[", 1),            mmats <- c(lapply(random, "[[", 1),
101                       .fixed = list(cbind(Xmat, .response = model.response(frm))))                       .fixed = list(cbind(Xmat, .response = model.response(frm))))
           ## FIXME: Use Xfrm and Xmat to get the terms and assign  
           ## slots, pass them to lmer_create, then destroy them  
102            obj <- .Call("lmer_create", lapply(random, "[[", 2),            obj <- .Call("lmer_create", lapply(random, "[[", 2),
103                         mmats, PACKAGE = "Matrix")                         mmats, PACKAGE = "Matrix")
104              slot(obj, "frame") <- frm
105            slot(obj, "terms") <- attr(model.frame(fixed.form, data), "terms")            slot(obj, "terms") <- attr(model.frame(fixed.form, data), "terms")
106            slot(obj, "assign") <- attr(Xmat, "assign")            slot(obj, "assign") <- attr(Xmat, "assign")
107            slot(obj, "call") <- match.call()            slot(obj, "call") <- match.call()
# Line 345  Line 344 
344                       .fixed = list(cbind(glm.fit$x, .response = glm.fit$y)))                       .fixed = list(cbind(glm.fit$x, .response = glm.fit$y)))
345            ## FIXME: Use Xfrm and Xmat to get the terms and assign            ## FIXME: Use Xfrm and Xmat to get the terms and assign
346            ## slots, pass these to lmer_create, then destroy Xfrm, Xmat, etc.            ## slots, pass these to lmer_create, then destroy Xfrm, Xmat, etc.
347            obj <- .Call("lmer_create", lapply(random, "[[", 2), mmats, PACKAGE = "Matrix")            obj <- .Call("lmer_create", lapply(random, "[[", 2),
348            obj@terms <- attr(glm.fit$model, "terms")                         mmats, PACKAGE = "Matrix")
349            obj@assign <- attr(glm.fit$x, "assign")            slot(obj, "frame") <- frm
350            obj@call <- match.call()            slot(obj, "terms") <- attr(glm.fit$model, "terms")
351            obj@REML <- FALSE            slot(obj, "assign") <- attr(glm.fit$x, "assign")
352              slot(obj, "call") <- match.call()
353              slot(obj, "REML") <- FALSE
354            rm(glm.fit)            rm(glm.fit)
355            .Call("lmer_initial", obj, PACKAGE="Matrix")            .Call("lmer_initial", obj, PACKAGE="Matrix")
356            mmats.unadjusted <- mmats            mmats.unadjusted <- mmats
# Line 646  Line 647 
647    })    })
648    
649  setMethod("fitted", signature(object = "lmer"),  setMethod("fitted", signature(object = "lmer"),
650            function(object, ...) object@fitted)            function(object, ...)
651              napredict(attr(object@frame, "na.action"), object@fitted))
652    
653  setMethod("residuals", signature(object = "lmer"),  setMethod("residuals", signature(object = "lmer"),
654            function(object, ...) object@residuals)            function(object, ...)
655              naresid(attr(object@frame, "na.action"), object@residuals))
656    
657  setMethod("resid", signature(object = "lmer"),  setMethod("resid", signature(object = "lmer"),
658            function(object, ...) do.call("residuals", c(list(object), list(...))))            function(object, ...) do.call("residuals", c(list(object), list(...))))
# Line 705  Line 708 
708    
709  setMethod("with", signature(data = "lmer"),  setMethod("with", signature(data = "lmer"),
710            function(data, expr, ...) {            function(data, expr, ...) {
711            lst <- c(list(. = data), data@flist, eval(data@call$data))                dat <- eval(data@call$data)
712            eval(substitute(expr), lst[unique(names(lst))])})                if (!is.null(na.act <- attr(data@frame, "na.action")))
713                      dat <- dat[-na.act, ]
714                  lst <- c(list(. = data), data@flist, data@frame, dat)
715                  eval(substitute(expr), lst[unique(names(lst))])
716              })
717    
718    setMethod("terms", signature(x = "lmer"),
719              function(x, ...) x@terms)

Legend:
Removed from v.690  
changed lines
  Added in v.691

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