init

#443

NAMESPACE

@@ -202,6 +202,7 @@ export(coef_var)
 export(coerce_to_numeric)
 export(colnames_to_row)
 export(column_as_rownames)
+export(contr.deviation)
 export(convert_na_to)
 export(convert_to_na)
 export(data_addprefix)

R/contrs.R

@@ -0,0 +1,83 @@
+#' Deviation Contrast Matrix
+#'
+#' Build a deviation contrast matrix, a type of _effects contrast_ matrix.
+#'
+#' @inheritParams stats::contr.sum
+#'
+#' @details
+#' In effects coding, unlike dummy coding ([stats::contr.treatment()]), each
+#' contrasts sums to 0. In regressions models, this results in an intercept that
+#' represents the (unweighted) average of the group means. In ANOVA settings,
+#' this also guarantees that lower order effects represent _main_ effects (and
+#' not _simple_ or _conditional_ effects, as is the case when using
+#' [stats::contr.treatment()], which is `R`'s default).
+#' \cr\cr
+#' `contr.deviation`, unlike [stats::contr.sum()], also has the added benefit
+#' that the factor-related coefficients are interpretable. In fact, they
+#' represent the same contrasts as those of [stats::contr.treatment()]: the
+#' difference of each level from the base level.
+#'
+#' @seealso [stats::contr.sum()]
+#'
+#' @examples
+#' \dontrun{
+#' data("mtcars")
+#'
+#' mtcars$cyl <- factor(mtcars$cyl)
+#'
+#' c.treatment <- cbind(Intercept = 1, contrasts(mtcars$cyl))
+#' solve(c.treatment)
+#' #>            4 6 8
+#' #> Intercept  1 0 0  # Intercept is the mean of the 1st level
+#' #> 6         -1 1 0  # Difference between 2nd and 1st level
+#' #> 8         -1 0 1  # Difference between 3rd and 1st level
+#'
+#' contrasts(mtcars$cyl) <- contr.sum
+#' c.sum <- cbind(Intercept = 1, contrasts(mtcars$cyl))
+#' solve(c.sum)
+#' #>                    4          6          8
+#' #> Intercept  0.3333333  0.3333333  0.3333333   # Intercept is the overall mean
+#' #>            0.6666667 -0.3333333 -0.3333333   # 2/3 of the different between 2nd/3rd and 1st levels
+#' #>           -0.3333333  0.6666667 -0.3333333   # 2/3 of the different between 1st/3rd and 2nd levels
+#'
+#'
+#' contrasts(mtcars$cyl) <- contr.deviation
+#' c.deviation <- cbind(Intercept = 1, contrasts(mtcars$cyl))
+#' solve(c.deviation)
+#' #>                    4         6         8
+#' #> Intercept  0.3333333 0.3333333 0.3333333   # Intercept is the overall mean
+#' #> 6         -1.0000000 1.0000000 0.0000000   # Difference between 2nd and 1st level
+#' #> 8         -1.0000000 0.0000000 1.0000000   # Difference between 3rd and 1st level
+#'
+#' ## With Interactions -----------------------------------------
+#' mtcars$am <- factor(mtcars$am)
+#' contrasts(mtcars$am) <- contr.deviation
+#'
+#' mtcars <- mtcars[order(mtcars$cyl, mtcars$am),]
+#' mm <- unique(model.matrix(~ cyl * am, data = mtcars))
+#' rownames(mm) <- c("cyl4.am0", "cyl4.am1", "cyl6.am0", "cyl6.am1", "cyl8.am0", "cyl8.am1")
+#'
+#' solve(mm)
+#' #>               cyl4.am0   cyl4.am1   cyl6.am0  cyl6.am1   cyl8.am0  cyl8.am1
+#' #> (Intercept)  0.1666667  0.1666667  0.1666667 0.1666667  0.1666667 0.1666667   # Overall mean
+#' #> cyl6        -0.5000000 -0.5000000  0.5000000 0.5000000  0.0000000 0.0000000   # MAIN effect cyl contrasts - 2nd and 1st diff
+#' #> cyl8        -0.5000000 -0.5000000  0.0000000 0.0000000  0.5000000 0.5000000   # MAIN effect cyl contrasts - 3rd and 1st diff
+#' #> am1         -0.3333333  0.3333333 -0.3333333 0.3333333 -0.3333333 0.3333333   # MAIN effect for am
+#' #> cyl6:am1     1.0000000 -1.0000000 -1.0000000 1.0000000  0.0000000 0.0000000
+#' #> cyl8:am1     1.0000000 -1.0000000  0.0000000 0.0000000 -1.0000000 1.0000000
+#' }
+#'
+#' @export
+contr.deviation <- function(n, base = 1,
+                            contrasts = TRUE,
+                            sparse = FALSE) {
+  cont <- stats::contr.treatment(n,
+                                 base = base,
+                                 contrasts = contrasts,
+                                 sparse = sparse)
+  if (contrasts) {
+    n <- nrow(cont)
+    cont <- cont - 1 / n
+  }
+  cont
+}