regression anatomy

gistfile1.txt

reganatomy <- function(model, variable) {
    variable <- if (is.character(variable) & 1 == length(variable)) {
      variable
    } else {
      deparse(substitute(variable))
    }
    mod.mat <- model.matrix(model)
    var.names <- colnames(mod.mat)
    var <- which(variable == var.names)
    if (0 == length(var))  {
      stop(paste(variable, "is not a column of the model matrix."))
    }
    response <- model.response(model.frame(model))
    if (is.null(weights(model))) {
      wt <- rep(1, length(response))
    } else {
      wt <- weights(model)
    }
    res0 <- as_tibble(lm(cbind(mod.mat[, var], response) ~ 1, weights = wt)$residual)
    names(res0) <- c("y", "x")
    res <- as_tibble(lsfit(mod.mat[, -var], cbind(mod.mat[, var], response), 
                           wt = wt, intercept = FALSE)$residuals)
    names(res) <- c("y_partial", "x_partial")
    bind_cols(res0, res)
}
data("Bfox", package = "car")
m1 <- lm(partic ~ tfr + menwage + womwage + debt + parttime, data = Bfox)
an <- reganatomy(m1, "womwage")
ggplot(an, aes(x = x, y = y)) + geom_point()
ggplot(an, aes(x = x_partial, y = y_partial)) + geom_point()

betawt <- function(model, variables = NULL) {
  X <- model.matrix(model)
  var_names <- colnames(X)
  variables <- variables %||% setdiff(colnames(X), "(Intercept)")
  badvars <- setdiff(variables, var_names)
  if (length(badvars)) {
    stop("Variables not found in model matrix: ", paste0(badvars, collapse = ", "))
  }
  wt <- model$weights
  offset <- model$offset
  f <- function(i) {
    ii <- which(i == var_names)
    mod2 <- if (!is.null(wt)) {
      lm.wfit(X[ , -ii], X[, ii], wt, offset = offset)
    } else {
      lm.fit(X[ , -ii], X[, ii], offset = offset)
    }
    weighted.residuals(mod2) ^ 2
  }
  as_tibble(set_names(map(variables, f), variables))
}
data("Bfox", package = "car")
m1 <- lm(partic ~ tfr + menwage + womwage + debt + parttime, data = Bfox)
an <- betawt(m1, c("womwage", "tfr", "debt", "parttime"))