Summary
Forums
Tracker
Lists
News
SCM
R Packages

SCM Repository

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

Diff of /pkg/R/lmer.R

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

revision 1122, Tue Jan 10 16:47:38 2006 UTC revision 1123, Tue Jan 10 17:04:29 2006 UTC
# Line 404  Line 404 
404                useScale <- object@useScale                useScale <- object@useScale
405                corF <- as(as(vcov(object, useScale = useScale), "pdmatrix"),                corF <- as(as(vcov(object, useScale = useScale), "pdmatrix"),
406                           "corrmatrix")                           "corrmatrix")
407                DF <- getFixDF(object)                #DF <- getFixDF(object)
408                coefs <- cbind(fcoef, corF@stdDev, DF)                coefs <- cbind(fcoef, corF@stdDev) #, DF)
409                nc <- object@nc                nc <- object@nc
410                dimnames(coefs) <-                dimnames(coefs) <-
411                    list(names(fcoef), c("Estimate", "Std. Error", "DF"))                    list(names(fcoef), c("Estimate", "Std. Error")) #, "DF"))
412                              digits <- max(3, getOption("digits") - 2)                              digits <- max(3, getOption("digits") - 2)
413                REML <- object@method == "REML"                REML <- object@method == "REML"
414                llik <- object@logLik                llik <- object@logLik
# Line 457  Line 457 
457                        .Call("lmer_sigma", object, FALSE, PACKAGE = "Matrix"),                        .Call("lmer_sigma", object, FALSE, PACKAGE = "Matrix"),
458                        "\n")                        "\n")
459                if (nrow(coefs) > 0) {                if (nrow(coefs) > 0) {
460                      if (0) {              #this section removed because of objections to its validity
461                    if (useScale) {                    if (useScale) {
462                        stat <- coefs[,1]/coefs[,2]                        stat <- coefs[,1]/coefs[,2]
463                        pval <- 2*pt(abs(stat), coefs[,3], lower = FALSE)                        pval <- 2*pt(abs(stat), coefs[,3], lower = FALSE)
# Line 471  Line 472 
472                        coefs <- cbind(coefs, stat, pval)                        coefs <- cbind(coefs, stat, pval)
473                        colnames(coefs) <- c(nms, "z value", "Pr(>|z|)")                        colnames(coefs) <- c(nms, "z value", "Pr(>|z|)")
474                    }                    }
475                      }
476                    cat("\nFixed effects:\n")                    cat("\nFixed effects:\n")
477                    printCoefmat(coefs, tst.ind = 4, zap.ind = 3)                    printCoefmat(coefs)
478                      #printCoefmat(coefs, tst.ind = 4, zap.ind = 3)
479                    if (length(object@showCorrelation) > 0 && object@showCorrelation[1]) {                    if (length(object@showCorrelation) > 0 && object@showCorrelation[1]) {
480                        rn <- rownames(coefs)                        rn <- rownames(coefs)
481                        dimnames(corF) <- list(                        dimnames(corF) <- list(
# Line 580  Line 583 
583                    nmeffects <- c("(Intercept)", nmeffects)                    nmeffects <- c("(Intercept)", nmeffects)
584                ss <- unlist(lapply(split(ss, asgn), sum))                ss <- unlist(lapply(split(ss, asgn), sum))
585                df <- unlist(lapply(split(asgn,  asgn), length))                df <- unlist(lapply(split(asgn,  asgn), length))
586                dfr <- unlist(lapply(split(dfr, asgn), function(x) x[1]))                #dfr <- unlist(lapply(split(dfr, asgn), function(x) x[1]))
587                ms <- ss/df                ms <- ss/df
588                f <- ms/(ssr/dfr)                #f <- ms/(ssr/dfr)
589                P <- pf(f, df, dfr, lower.tail = FALSE)                #P <- pf(f, df, dfr, lower.tail = FALSE)
590                table <- data.frame(df, ss, ms, dfr, f, P)                #table <- data.frame(df, ss, ms, dfr, f, P)
591                  table <- data.frame(df, ss, ms)
592                dimnames(table) <-                dimnames(table) <-
593                    list(nmeffects,                    list(nmeffects,
594                         c("Df", "Sum Sq", "Mean Sq", "Denom", "F value", "Pr(>F)"))  #                       c("Df", "Sum Sq", "Mean Sq", "Denom", "F value", "Pr(>F)"))
595                           c("Df", "Sum Sq", "Mean Sq"))
596                if ("(Intercept)" %in% nmeffects) table <- table[-1,]                if ("(Intercept)" %in% nmeffects) table <- table[-1,]
597                attr(table, "heading") <- "Analysis of Variance Table"                attr(table, "heading") <- "Analysis of Variance Table"
598                class(table) <- c("anova", "data.frame")                class(table) <- c("anova", "data.frame")
# Line 620  Line 625 
625    
626  setMethod("confint", signature(object = "lmer"),  setMethod("confint", signature(object = "lmer"),
627            function (object, parm, level = 0.95, ...)            function (object, parm, level = 0.95, ...)
628        {            warning("confint method for lmer objects has been withdrawn")
629            cf <- fixef(object)  ##       {
630            pnames <- names(cf)  ##           cf <- fixef(object)
631            if (missing(parm))  ##           pnames <- names(cf)
632                parm <- seq(along = pnames)  ##           if (missing(parm))
633            else if (is.character(parm))  ##               parm <- seq(along = pnames)
634                parm <- match(parm, pnames, nomatch = 0)  ##           else if (is.character(parm))
635            a <- (1 - level)/2  ##               parm <- match(parm, pnames, nomatch = 0)
636            a <- c(a, 1 - a)  ##           a <- (1 - level)/2
637            pct <- paste(round(100 * a, 1), "%")  ##           a <- c(a, 1 - a)
638            ci <- array(NA, dim = c(length(parm), 2),  ##           pct <- paste(round(100 * a, 1), "%")
639                        dimnames = list(pnames[parm], pct))  ##           ci <- array(NA, dim = c(length(parm), 2),
640            ses <- sqrt(diag(vcov(object)))[parm]  ##                       dimnames = list(pnames[parm], pct))
641            ci[] <- cf[parm] + ses * t(outer(a, getFixDF(object)[parm], qt))  ##           ses <- sqrt(diag(vcov(object)))[parm]
642            ci  ##           ci[] <- cf[parm] + ses * t(outer(a, getFixDF(object)[parm], qt))
643        })  ##           ci
644    ##       }
645              )
646    
647  setMethod("deviance", "mer",  setMethod("deviance", "mer",
648            function(object, REML = NULL, ...) {            function(object, REML = NULL, ...) {
Legend:
Removed from v.1122  
changed lines
  Added in v.1123
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