-
-
Notifications
You must be signed in to change notification settings - Fork 16
Open
Labels
Description
Is this something we can add here?
(After I built the function, I saw it was implemented in the {wec}
package....)
contr.wsum <- function(x, ref, ...) {
x <- as.factor(x)
lvls <- levels(x)
n <- nlevels(x)
if (!missing(ref)) {
if (!ref %in% lvls) stop("")
lvls <- c(setdiff(lvls, ref), ref)
x <- factor(x, levels = lvls)
} else {
ref <- lvls[n]
}
M <- contr.sum(n)
rownames(M) <- lvls
tab <- proportions(table(x))
M[ref,] <- -unname(tab[-n] / tab[n])
M
}
contr.wsum(mtcars$cyl)
#> [,1] [,2]
#> 4 1.0000000 0.0
#> 6 0.0000000 1.0
#> 8 -0.7857143 -0.5
# same as:
wec::contr.wec(factor(mtcars$cyl), "8")
#> 4 6
#> 1 1.0000000 0.0
#> 2 0.0000000 1.0
#> 3 -0.7857143 -0.5
Usage:
mtcars$cyl_f <- factor(mtcars$cyl)
contrasts(mtcars$cyl_f) <- contr.wsum(mtcars$cyl_f)
m <- lm(mpg ~ cyl_f, mtcars)
coef(m)[1]
#> (Intercept)
#> 20.09062
mean(mtcars$mpg)
#> [1] 20.09062
Created on 2023-02-08 with reprex v2.0.2