Typo in print.aov

classic Classic list List threaded Threaded
2 messages Options
Reply | Threaded
Open this post in threaded view
|

Typo in print.aov

Andrews, Chris

While looking at the code of print.aov for a different reason, I noticed that 'coefficient' was spelled with 3 'f's in one location.  Perhaps this is on purpose but in another location it has just 2 'f's.  This has not caused me any problem (that I know of) but I found it curious.

Chris



R version 3.5.1 (2018-07-02) -- "Feather Spray"
Copyright (C) 2018 The R Foundation for Statistical Computing
Platform: x86_64-w64-mingw32/x64 (64-bit)




> getAnywhere(print.aov)
A single object matching 'print.aov' was found
It was found in the following places
  registered S3 method for print from namespace stats
  namespace:stats
with value

function (x, intercept = FALSE, tol = sqrt(.Machine$double.eps),
    ...)
{
    if (!is.null(cl <- x$call)) {
        cat("Call:\n   ")
        dput(cl, control = NULL)
    }
    qrx <- if (x$rank)
        qr(x)
    asgn <- x$assign[qrx$pivot[1L:x$rank]]
    effects <- x$effects
    if (!is.null(effects))
        effects <- as.matrix(effects)[seq_along(asgn), , drop = FALSE]
    rdf <- x$df.residual
    resid <- as.matrix(x$residuals)
    wt <- x$weights
    if (!is.null(wt))
        resid <- resid * sqrt(wt)
    RSS <- colSums(resid^2)
    uasgn <- unique(asgn)
    nmeffect <- c("(Intercept)", attr(x$terms, "term.labels"))[1 +
        uasgn]
    nterms <- length(uasgn)
    nresp <- NCOL(effects)
    df <- numeric(nterms)
    ss <- matrix(NA, nterms, nresp)
    if (nterms) {
        for (i in seq(nterms)) {
            ai <- asgn == uasgn[i]
            df[i] <- sum(ai)
            ef <- effects[ai, , drop = FALSE]
            ss[i, ] <- if (sum(ai) > 1)
                colSums(ef^2)
            else ef^2
        }
        keep <- df > 0L
        if (!intercept && uasgn[1L] == 0)
            keep[1L] <- FALSE
        nmeffect <- nmeffect[keep]
        df <- df[keep]
        ss <- ss[keep, , drop = FALSE]
        nterms <- length(df)
    }
    cat("\nTerms:\n")
    if (nterms == 0L) {
        if (rdf > 0L) {
            ss <- RSS
            ssp <- sapply(ss, format)
            if (!is.matrix(ssp))
                ssp <- t(ssp)
            tmp <- as.matrix(c(ssp, format(rdf)))
            if (length(ss) > 1L) {
                rn <- colnames(x$fitted.values)
                if (is.null(rn))
                  rn <- paste("resp", seq_along(ss))
            }
            else rn <- "Sum of Squares"
            dimnames(tmp) <- list(c(rn, "Deg. of Freedom"), "Residuals")
            print(tmp, quote = FALSE, right = TRUE)
            cat("\n")
            rs <- sqrt(RSS/rdf)
            cat(if (length(rs) > 1L)
                "Residual standard errors:"
            else "Residual standard error:", sapply(rs, format))
            cat("\n")
        }
        else print(matrix(0, 2L, 1L, dimnames = list(c("Sum of Squares",
            "Deg. of Freedom"), "<empty>")))
    }
    else {
        if (rdf > 0L) {
            nterms <- nterms + 1L
            df <- c(df, rdf)
            ss <- rbind(ss, RSS)
            nmeffect <- c(nmeffect, "Residuals")
        }
        ssp <- apply(zapsmall(ss), 2L, format)
        tmp <- t(cbind(ssp, format(df)))
        if (ncol(effects) > 1L) {
            rn <- colnames(x$coeffficients) ###############************ <------- HERE
            if (is.null(rn))
                rn <- paste("resp", seq(ncol(effects)))
        }
        else rn <- "Sum of Squares"
        dimnames(tmp) <- list(c(rn, "Deg. of Freedom"), nmeffect)
        print(tmp, quote = FALSE, right = TRUE)
        rank <- x$rank
        cat("\n")
        if (rdf > 0L) {
            rs <- sqrt(RSS/rdf)
            cat(if (length(rs) > 1L)
                "Residual standard errors:"
            else "Residual standard error:", sapply(rs, format))
            cat("\n")
        }
        coef <- as.matrix(x$coefficients)[, 1L]  ################## ************ <- NOT HERE
        R <- qrx$qr
        R <- R[1L:min(dim(R)), , drop = FALSE]
        R[lower.tri(R)] <- 0
        if (rank < (nc <- length(coef))) {
            cat(paste(nc - rank, "out of", nc, "effects not estimable\n"))
            R <- R[, 1L:rank, drop = FALSE]
        }
        d2 <- sum(abs(diag(R)))
        diag(R) <- 0
        if (sum(abs(R))/d2 > tol)
            cat("Estimated effects may be unbalanced\n")
        else cat("Estimated effects are balanced\n")
        if (nzchar(mess <- naprint(x$na.action)))
            cat(mess, "\n", sep = "")
    }
    invisible(x)
}
<bytecode: 0x0000000014c90ca0>
<environment: namespace:stats>


**********************************************************
Electronic Mail is not secure, may not be read every day, and should not be used for urgent or sensitive issues

______________________________________________
[hidden email] mailing list -- To UNSUBSCRIBE and more, see
https://stat.ethz.ch/mailman/listinfo/r-help
PLEASE do read the posting guide http://www.R-project.org/posting-guide.html
and provide commented, minimal, self-contained, reproducible code.
Reply | Threaded
Open this post in threaded view
|

Re: Typo in print.aov

Peter Dalgaard-2
That's a bug... no other place in the sources has "coeffficients". The net result is that the NULL case is used even when colnames _are_ present. It does make a difference, e.g. to examples(manova). I am fixing this in r-devel since the urgency must be rather low.

- Peter D.

> On 13 Aug 2018, at 14:27 , Andrews, Chris <[hidden email]> wrote:
>
>
> While looking at the code of print.aov for a different reason, I noticed that 'coefficient' was spelled with 3 'f's in one location.  Perhaps this is on purpose but in another location it has just 2 'f's.  This has not caused me any problem (that I know of) but I found it curious.
>
> Chris
>
>
>
> R version 3.5.1 (2018-07-02) -- "Feather Spray"
> Copyright (C) 2018 The R Foundation for Statistical Computing
> Platform: x86_64-w64-mingw32/x64 (64-bit)
>
>
>
>
>> getAnywhere(print.aov)
> A single object matching 'print.aov' was found
> It was found in the following places
>  registered S3 method for print from namespace stats
>  namespace:stats
> with value
>
> function (x, intercept = FALSE, tol = sqrt(.Machine$double.eps),
>    ...)
> {
>    if (!is.null(cl <- x$call)) {
>        cat("Call:\n   ")
>        dput(cl, control = NULL)
>    }
>    qrx <- if (x$rank)
>        qr(x)
>    asgn <- x$assign[qrx$pivot[1L:x$rank]]
>    effects <- x$effects
>    if (!is.null(effects))
>        effects <- as.matrix(effects)[seq_along(asgn), , drop = FALSE]
>    rdf <- x$df.residual
>    resid <- as.matrix(x$residuals)
>    wt <- x$weights
>    if (!is.null(wt))
>        resid <- resid * sqrt(wt)
>    RSS <- colSums(resid^2)
>    uasgn <- unique(asgn)
>    nmeffect <- c("(Intercept)", attr(x$terms, "term.labels"))[1 +
>        uasgn]
>    nterms <- length(uasgn)
>    nresp <- NCOL(effects)
>    df <- numeric(nterms)
>    ss <- matrix(NA, nterms, nresp)
>    if (nterms) {
>        for (i in seq(nterms)) {
>            ai <- asgn == uasgn[i]
>            df[i] <- sum(ai)
>            ef <- effects[ai, , drop = FALSE]
>            ss[i, ] <- if (sum(ai) > 1)
>                colSums(ef^2)
>            else ef^2
>        }
>        keep <- df > 0L
>        if (!intercept && uasgn[1L] == 0)
>            keep[1L] <- FALSE
>        nmeffect <- nmeffect[keep]
>        df <- df[keep]
>        ss <- ss[keep, , drop = FALSE]
>        nterms <- length(df)
>    }
>    cat("\nTerms:\n")
>    if (nterms == 0L) {
>        if (rdf > 0L) {
>            ss <- RSS
>            ssp <- sapply(ss, format)
>            if (!is.matrix(ssp))
>                ssp <- t(ssp)
>            tmp <- as.matrix(c(ssp, format(rdf)))
>            if (length(ss) > 1L) {
>                rn <- colnames(x$fitted.values)
>                if (is.null(rn))
>                  rn <- paste("resp", seq_along(ss))
>            }
>            else rn <- "Sum of Squares"
>            dimnames(tmp) <- list(c(rn, "Deg. of Freedom"), "Residuals")
>            print(tmp, quote = FALSE, right = TRUE)
>            cat("\n")
>            rs <- sqrt(RSS/rdf)
>            cat(if (length(rs) > 1L)
>                "Residual standard errors:"
>            else "Residual standard error:", sapply(rs, format))
>            cat("\n")
>        }
>        else print(matrix(0, 2L, 1L, dimnames = list(c("Sum of Squares",
>            "Deg. of Freedom"), "<empty>")))
>    }
>    else {
>        if (rdf > 0L) {
>            nterms <- nterms + 1L
>            df <- c(df, rdf)
>            ss <- rbind(ss, RSS)
>            nmeffect <- c(nmeffect, "Residuals")
>        }
>        ssp <- apply(zapsmall(ss), 2L, format)
>        tmp <- t(cbind(ssp, format(df)))
>        if (ncol(effects) > 1L) {
>            rn <- colnames(x$coeffficients) ###############************ <------- HERE
>            if (is.null(rn))
>                rn <- paste("resp", seq(ncol(effects)))
>        }
>        else rn <- "Sum of Squares"
>        dimnames(tmp) <- list(c(rn, "Deg. of Freedom"), nmeffect)
>        print(tmp, quote = FALSE, right = TRUE)
>        rank <- x$rank
>        cat("\n")
>        if (rdf > 0L) {
>            rs <- sqrt(RSS/rdf)
>            cat(if (length(rs) > 1L)
>                "Residual standard errors:"
>            else "Residual standard error:", sapply(rs, format))
>            cat("\n")
>        }
>        coef <- as.matrix(x$coefficients)[, 1L]  ################## ************ <- NOT HERE
>        R <- qrx$qr
>        R <- R[1L:min(dim(R)), , drop = FALSE]
>        R[lower.tri(R)] <- 0
>        if (rank < (nc <- length(coef))) {
>            cat(paste(nc - rank, "out of", nc, "effects not estimable\n"))
>            R <- R[, 1L:rank, drop = FALSE]
>        }
>        d2 <- sum(abs(diag(R)))
>        diag(R) <- 0
>        if (sum(abs(R))/d2 > tol)
>            cat("Estimated effects may be unbalanced\n")
>        else cat("Estimated effects are balanced\n")
>        if (nzchar(mess <- naprint(x$na.action)))
>            cat(mess, "\n", sep = "")
>    }
>    invisible(x)
> }
> <bytecode: 0x0000000014c90ca0>
> <environment: namespace:stats>
>
>
> **********************************************************
> Electronic Mail is not secure, may not be read every day, and should not be used for urgent or sensitive issues
>
> ______________________________________________
> [hidden email] mailing list -- To UNSUBSCRIBE and more, see
> https://stat.ethz.ch/mailman/listinfo/r-help
> PLEASE do read the posting guide http://www.R-project.org/posting-guide.html
> and provide commented, minimal, self-contained, reproducible code.

--
Peter Dalgaard, Professor,
Center for Statistics, Copenhagen Business School
Solbjerg Plads 3, 2000 Frederiksberg, Denmark
Phone: (+45)38153501
Office: A 4.23
Email: [hidden email]  Priv: [hidden email]

______________________________________________
[hidden email] mailing list -- To UNSUBSCRIBE and more, see
https://stat.ethz.ch/mailman/listinfo/r-help
PLEASE do read the posting guide http://www.R-project.org/posting-guide.html
and provide commented, minimal, self-contained, reproducible code.