Bug 16256: "constant" attribute dropped by `predict(type ="terms", na.action="na.exclude")`

[hturner]

This is a good first contribution requiring a small change to the R code, that could be made by following the R Contribution Workflow in the R Dev Container and then creating a patch to report back on Bugzilla. (You will need to setup the container and build R in the container before following the workflow).

As described in Bug 16256 the "constant" attribute is not returned by predict(type ="terms") when the na.action is set to "na.exclude".

The default na.action is "na.omit", which removes the missing values and returns the expected "constant" attribute:

y <- rnorm(10)
x <- 1:10
x[3] <- NA

m <- lm(y~x)
predict(m,type="terms")
#>               x
#> 1  -0.083554048
#> 2  -0.066065991
#> 4  -0.031089878
#> 5  -0.013601822
#> 6   0.003886235
#> 7   0.021374291
#> 8   0.038862348
#> 9   0.056350404
#> 10  0.073838461
#> attr(,"constant")
#> [1] 0.09991503

When we change to na.action="na.exclude", the predicted terms are padded with NAs where there are missing values in the predictors and the "constant" attribute is lost:

m1 <- update(m,na.action="na.exclude")
predict(m1,type="terms")
#>               x
#> 1  -0.083554048
#> 2  -0.066065991
#> 3            NA
#> 4  -0.031089878
#> 5  -0.013601822
#> 6   0.003886235
#> 7   0.021374291
#> 8   0.038862348
#> 9   0.056350404
#> 10  0.073838461

The underlying function is stats:::naresid.exclude() and this needs fixing to keep the "constant" attribute. @elinw identifies L157 as the place where the attribute is dropped.

[ossiefisheater]

As described in the bug report, the offending line in naresid.exclude() is in the if() statement for handling a matrix.

naresid.exclude <- function(omit, x, ...)
{
    if (length(omit) == 0 || !is.numeric(omit))
	stop("invalid argument 'omit'")

    ## the next line copes with calls from older versions of weights.default.
    if (is.null(x)) return(x)
    n <- NROW(x)
    keep <- rep.int(NA, n+length(omit))
    keep[-omit] <- 1L:n
    if (is.matrix(x)) {
	x <- x[keep, , drop=FALSE] **THIS ONE**
	temp <- rownames(x)
	if (length(temp)) {
	    temp[omit] <- names(omit)
	    rownames(x) <- temp
        }
    } else if(is.array(x) && length(d <- dim(x)) > 2L) {
        ## e.g. inside lm.influence() for mlm, when x = coefficients: n x p x q
	x <- x[keep, , , drop=FALSE]
	temp <- (dn <- dimnames(x))[[1L]]
	if (!is.null(temp)) {
	    temp[omit] <- names(omit)
	    dimnames(x)[[1L]] <- temp
        }
    } else {# vector *or* data.frame !
	x <- x[keep]
	temp <- names(x)
	if (length(temp)) {
	    temp[omit] <- names(omit)
	    names(x) <- temp
        }
    }
    x
}

Our proposed patch is to attach the attribute to a variable before the offending line, and then assign it back to the matrix after the if_else statements have resolved.

naresid.exclude <- function(omit, x, ...)
{
    if (length(omit) == 0 || !is.numeric(omit))
    stop("invalid argument 'omit'")    ## the next line copes with calls from older versions of weights.default.
    if (is.null(x)) return(x)
    n <- NROW(x)
    keep <- rep.int(NA, n+length(omit))
    keep[-omit] <- 1L:n
    constant <- attr(x, "constant")
    if (is.matrix(x)) {
    x <- x[keep, , drop=FALSE]
    temp <- rownames(x)
    if (length(temp)) {
        temp[omit] <- names(omit)
        rownames(x) <- temp
        }
    } else if(is.array(x) && length(d <- dim(x)) > 2L) {
        ## e.g. inside lm.influence() for mlm, when x = coefficients: n x p x q
    x <- x[keep, , , drop=FALSE]
    temp <- (dn <- dimnames(x))[[1L]]
    if (!is.null(temp)) {
        temp[omit] <- names(omit)
        dimnames(x)[[1L]] <- temp
        }
    } else {# vector *or* data.frame !
    x <- x[keep]
    temp <- names(x)
    if (length(temp)) {
        temp[omit] <- names(omit)
        names(x) <- temp
        }
    }
    attr(x, "constant") <- constant
    x
}

[ossiefisheater]

I have found that Bugzilla requires an account to upload patches, and accounts seem to be manually approved to prevent spam. I have requested an account but don't expect a reply today.