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 561, Fri Feb 18 19:24:43 2005 UTC revision 562, Fri Feb 18 19:25:47 2005 UTC
# Line 404  Line 404 
404    
405  setMethod("solve", signature(a = "lmer", b = "missing"),  setMethod("solve", signature(a = "lmer", b = "missing"),
406            function(a, b, ...)            function(a, b, ...)
407            .Call("lmer_invert", a)            .Call("lmer_invert", a, PACKAGE = "Matrix")
408            )            )
409    
410  setMethod("formula", "lmer", function(x, ...) x@call$formula)  setMethod("formula", "lmer", function(x, ...) x@call$formula)
411    
412  setMethod("vcov", signature(object = "lmer"),  setMethod("vcov", signature(object = "lmer"),
413            function(object, REML = object@REML, useScale = TRUE,...) {            function(object, REML = object@REML, useScale = TRUE,...) {
               ## force an "lmer_invert"  
414                sc <- .Call("lmer_sigma", object, REML, PACKAGE = "Matrix")                sc <- .Call("lmer_sigma", object, REML, PACKAGE = "Matrix")
415                rr <- object@RXX                rr <- object@RXX
416                nms <- object@cnames[[".fixed"]]                nms <- object@cnames[[".fixed"]]
# Line 430  Line 429 
429      ((i - 1) * i)/2 + j      ((i - 1) * i)/2 + j
430  }  }
431    
 ## Generalize this and return the transpose of the current matrix  
 ##  so it can be checked by a crossprod operation.  
 Lmat <- function(from) {  
     L <- lapply(from@L, as, "dgTMatrix")  
     nf <- length(from@D)  
     Gp <- from@Gp  
     nL <- Gp[nf + 1]  
     Zi <- integer(0)  
     Zj <- integer(0)  
     Zx <- double(0)  
     for (i in 1:nf) {  
         for (j in 1:i) {  
             Lij <- L[[Lind(i, j)]]  
             if (i == j) { ## fix up diagonal  
                 nc <- Lij@Dim[2]  
                 Lij@Dim <- c(nc, nc)  
                 Lij@i <- c(Lij@i, as.integer(0:(nc-1)))  
                 Lij@j <- c(Lij@j, as.integer(0:(nc-1)))  
                 Lij@x <- c(Lij@x, rep(1, nc))  
             }  
             Zi <- c(Zi, Lij@i + Gp[i])  
             Zj <- c(Zj, Lij@j + Gp[j])  
             Zx <- c(Zx, Lij@x)  
         }  
     }  
     new("dgTMatrix", Dim = as.integer(c(nL, nL)), i = Zi, j = Zj, x = Zx)  
 }  
   
432  Dhalf <- function(from) {  Dhalf <- function(from) {
433      D <- from@D      D <- from@D
434      nf <- length(D)      nf <- length(D)
# Line 486  Line 457 
457        nf <- length(from@D)        nf <- length(from@D)
458        Gp <- from@Gp        Gp <- from@Gp
459        nL <- Gp[nf + 1]        nL <- Gp[nf + 1]
460        Zi <- integer(0)        Li <- integer(0)
461        Zj <- integer(0)        Lj <- integer(0)
462        Zx <- double(0)        Lx <- double(0)
463        for (i in 1:nf) {        for (i in 1:nf) {
464            for (j in 1:i) {            for (j in 1:i) {
465                Lij <- L[[Lind(i, j)]]                Lij <- L[[Lind(i, j)]]
466                Zi <- c(Zi, Lij@i + Gp[i])                Li <- c(Li, Lij@i + Gp[i])
467                Zj <- c(Zj, Lij@j + Gp[j])                Lj <- c(Lj, Lij@j + Gp[j])
468                Zx <- c(Zx, Lij@x)                Lx <- c(Lx, Lij@x)
469            }            }
470        }        }
471        new("dtTMatrix", Dim = as.integer(c(nL, nL)), i = Zi, j = Zj, x = Zx,        new("dtTMatrix", Dim = as.integer(c(nL, nL)), i = Li, j = Lj, x = Lx,
472            uplo = "L", diag = "U")            uplo = "L", diag = "U")
473    })    })
474    
475    ## Extract the ZZX matrix
476    setAs("lmer", "dsTMatrix",
477          function(from)
478      {
479          .Call("lmer_inflate", from, PACKAGE = "Matrix")
480          ZZpO <- lapply(from@ZZpO, as, "dgTMatrix")
481          ZZ <- lapply(from@ZtZ, as, "dgTMatrix")
482          nf <- length(ZZpO)
483          Gp <- from@Gp
484          nZ <- Gp[nf + 1]
485          Zi <- integer(0)
486          Zj <- integer(0)
487          Zx <- double(0)
488          for (i in 1:nf) {
489              ZZpOi <- ZZpO[[i]]
490              Zi <- c(Zi, ZZpOi@i + Gp[i])
491              Zj <- c(Zj, ZZpOi@j + Gp[i])
492              Zx <- c(Zx, ZZpOi@x)
493              if (i > 1) {
494                  for (j in 1:(i-1)) {
495                      ZZij <- ZZ[[Lind(i, j)]]
496                      ## off-diagonal blocks are transposed
497                      Zi <- c(Zi, ZZij@j + Gp[j])
498                      Zj <- c(Zj, ZZij@i + Gp[i])
499                      Zx <- c(Zx, ZZij@x)
500                  }
501              }
502          }
503          new("dsTMatrix", Dim = as.integer(c(nZ, nZ)), i = Zi, j = Zj, x = Zx,
504              uplo = "U")
505      })

Legend:
Removed from v.561  
changed lines
  Added in v.562

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