Skip to content

Add function for Weighted Effect Coding? #363

@mattansb

Description

@mattansb

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

Metadata

Metadata

Assignees

No one assigned

    Type

    No type

    Projects

    No projects

    Milestone

    No milestone

    Relationships

    None yet

    Development

    No branches or pull requests

    Issue actions