Contrasts

Note: Some of the code in this vignette requires marginaleffects version 0.6.0 or the development version from github.

In another vignette, we introduced the “marginal effect” as a partial derivative. Since derivatives are only properly defined for continuous variables, we cannot use them to interpret the effects of changes in categorical variables. For this, we turn to contrasts between Adjusted predictions. In the context of this package, a “Contrast” is defined as:

A difference, ratio, or function of adjusted predictions, calculated for meaningfully different predictor values (e.g., College graduates vs. Others).

The marginaleffects() function automatically calculates contrasts instead of derivatives for factor, logical, or character variables.

The comparisons() function gives users more powerful features to compute different contrasts, such as differences, risk ratios, linear combinations, and transformations.

Predictor types

Logical and factor predictors

Consider a simple model with a logical and a factor variable:

library(marginaleffects)
library(magrittr)

tmp <- mtcars
tmp$am <- as.logical(tmp$am)
mod <- lm(mpg ~ am + factor(cyl), tmp)

The marginaleffects function automatically computes contrasts for each level of the categorical variables, relative to the baseline category (FALSE for logicals, and the reference level for factors), while holding all other values at their mode or mean:

mfx <- marginaleffects(mod)
summary(mfx)
#>   Term     Contrast  Effect Std. Error z value   Pr(>|z|)     2.5 % 97.5 %
#> 1   am TRUE - FALSE   2.560      1.298   1.973    0.04851   0.01675  5.103
#> 2  cyl        6 - 4  -6.156      1.536  -4.009 6.1077e-05  -9.16608 -3.146
#> 3  cyl        8 - 4 -10.068      1.452  -6.933 4.1146e-12 -12.91359 -7.222
#> 
#> Model type:  lm 
#> Prediction type:  response

The summary printed above says that moving from the reference category 4 to the level 6 on the cyl factor variable is associated with a change of -6.156 in the adjusted prediction. Similarly, the contrast from FALSE to TRUE on the am variable is equal to 2.560.

We can obtain different contrasts by using the comparisons() function. For example:

comparisons(mod, variables = list(cyl = "sequential")) %>% tidy()
#>       type term contrast  estimate std.error statistic      p.value  conf.low conf.high
#> 1 response  cyl    6 - 4 -6.156118  1.535723 -4.008612 6.107658e-05 -9.166079 -3.146156
#> 2 response  cyl    8 - 6 -3.911442  1.470254 -2.660385 7.805144e-03 -6.793087 -1.029797
comparisons(mod, variables = list(cyl = "pairwise")) %>% tidy()
#>       type term contrast   estimate std.error statistic      p.value   conf.low conf.high
#> 1 response  cyl    6 - 4  -6.156118  1.535723 -4.008612 6.107658e-05  -9.166079 -3.146156
#> 2 response  cyl    8 - 4 -10.067560  1.452082 -6.933187 4.114626e-12 -12.913589 -7.221530
#> 3 response  cyl    8 - 6  -3.911442  1.470254 -2.660385 7.805144e-03  -6.793087 -1.029797
comparisons(mod, variables = list(cyl = "reference")) %>% tidy()
#>       type term contrast   estimate std.error statistic      p.value   conf.low conf.high
#> 1 response  cyl    6 - 4  -6.156118  1.535723 -4.008612 6.107658e-05  -9.166079 -3.146156
#> 2 response  cyl    8 - 4 -10.067560  1.452082 -6.933187 4.114626e-12 -12.913589 -7.221530

For comparison, this code produces the same results using the emmeans package:

library(emmeans)
emm <- emmeans(mod, specs = "cyl")
contrast(emm, method = "revpairwise")
#>  contrast    estimate   SE df t.ratio p.value
#>  cyl6 - cyl4    -6.16 1.54 28  -4.009  0.0012
#>  cyl8 - cyl4   -10.07 1.45 28  -6.933  <.0001
#>  cyl8 - cyl6    -3.91 1.47 28  -2.660  0.0331
#> 
#> Results are averaged over the levels of: am 
#> P value adjustment: tukey method for comparing a family of 3 estimates

emm <- emmeans(mod, specs = "am")
contrast(emm, method = "revpairwise")
#>  contrast     estimate  SE df t.ratio p.value
#>  TRUE - FALSE     2.56 1.3 28   1.973  0.0585
#> 
#> Results are averaged over the levels of: cyl

Note that these commands also work on for other types of models, such as GLMs, on different scales:

mod_logit <- glm(am ~ factor(gear), data = mtcars, family = binomial)

comparisons(mod_logit) %>% tidy()
#>       type term contrast  estimate    std.error    statistic     p.value  conf.low conf.high
#> 1 response gear    4 - 3 0.6666667 1.360805e-01     4.899061 9.62957e-07 0.3999538 0.9333795
#> 2 response gear    5 - 3 1.0000000 1.071403e-05 93335.529594 0.00000e+00 0.9999790 1.0000210

comparisons(mod_logit, type = "link") %>% tidy()
#>   type term contrast estimate std.error   statistic   p.value   conf.low conf.high
#> 1 link gear    4 - 3 21.25922  4577.962 0.004643817 0.9962948  -8951.381   8993.90
#> 2 link gear    5 - 3 41.13214  9155.924 0.004492407 0.9964156 -17904.148  17986.41

Character predictors

All functions of the marginaleffects package attempt to treat character predictors as factor predictors. However, using factors instead of characters when modelling is strongly encouraged, because they are much safer and faster. This is because factors hold useful information about the full list of levels, which makes them easier to track and handle internally by marginaleffects. Users are strongly encouraged to convert their character variables to factor before fitting their models and using marginaleffects functions.

Numeric predictors

We can also compute contrasts for differences in numeric variables. For example, we can see what happens to the adjusted predictions when we increment the hp variable by 1 unit (default) or by 5 units:

mod <- lm(mpg ~ hp, data = mtcars)

comparisons(mod) %>% tidy()
#>       type term    contrast    estimate std.error statistic      p.value    conf.low   conf.high
#> 1 response   hp (x + 1) - x -0.06822828 0.0101193 -6.742389 1.558037e-11 -0.08806175 -0.04839481

comparisons(
    mod,
    variables = list(hp = 5)) %>% tidy()
#>       type term    contrast   estimate  std.error statistic      p.value   conf.low conf.high
#> 1 response   hp (x + 5) - x -0.3411414 0.05059652 -6.742389 1.558038e-11 -0.4403087 -0.241974

Compare adjusted predictions for a change in the regressor between two arbitrary values:

comparisons(mod, variables = list(hp = c(90, 110))) %>% tidy()
#>       type term contrast  estimate std.error statistic      p.value  conf.low  conf.high
#> 1 response   hp 110 - 90 -1.364566 0.2023861 -6.742389 1.558038e-11 -1.761235 -0.9678961

Compare adjusted predictions when the regressor changes across the interquartile range, across one or two standard deviations about its mean, or from across its full range:

comparisons(mod, variables = list(hp = "iqr")) %>% tidy()
#>       type term contrast  estimate std.error statistic      p.value  conf.low conf.high
#> 1 response   hp  Q3 - Q1 -5.697061 0.8449619 -6.742389 1.558038e-11 -7.353156 -4.040966

comparisons(mod, variables = list(hp = "sd")) %>% tidy()
#>       type term                contrast  estimate std.error statistic      p.value  conf.low conf.high
#> 1 response   hp (x + sd/2) - (x - sd/2) -4.677926 0.6938085 -6.742389 1.558038e-11 -6.037766 -3.318087

comparisons(mod, variables = list(hp = "2sd")) %>% tidy()
#>       type term            contrast  estimate std.error statistic      p.value  conf.low conf.high
#> 1 response   hp (x - sd) - (x + sd) -9.355853  1.387617 -6.742389 1.558038e-11 -12.07553 -6.636174

comparisons(mod, variables = list(hp = "minmax")) %>% tidy()
#>       type term  contrast estimate std.error statistic      p.value  conf.low conf.high
#> 1 response   hp Max - Min -19.3086  2.863763 -6.742389 1.558038e-11 -24.92147 -13.69573

Interactions

In some contexts we would like to know what happens when two (or more) predictors change at the same time. In the marginaleffects package terminology, this is an “interaction between contrasts.”

For example, consider a model with two factor variables:

mod <- lm(mpg ~ am * factor(cyl), data = mtcars)

What happens if am increases by 1 unit and cyl changes from a baseline reference to another level?

cmp <- comparisons(mod, variables = c("cyl", "am"))
summary(cmp)
#>     cyl    am Effect Std. Error z value  Pr(>|z|)   2.5 % 97.5 %
#> 1 4 - 4 1 - 0  5.175      2.053  2.5209 0.0117059   1.151  9.199
#> 2 6 - 4 1 - 0 -2.333      2.476 -0.9424 0.3459644  -7.186  2.519
#> 3 8 - 4 1 - 0 -7.500      2.768 -2.7095 0.0067389 -12.925 -2.075
#> 
#> Model type:  lm 
#> Prediction type:  response

When the variables argument is used and the model formula includes interactions, the “cross-contrasts” will automatically be displayed. You can also force comparisons() to do it by setting interactions=TRUE and using the variables argument to specify which variables should be manipulated simultaneously.

Quantities of interest

This section compares 4 quantities:

  1. Unit-Level Contrasts
  2. Average Contrast
  3. Contrast at the Mean
  4. Contrast Between Marginal Means

The ideas discussed in this section focus on contrasts, but they carry over directly to analogous types of marginal effects.

Unit-level contrasts

In models with interactions or non-linear components (e.g., link function), the value of a contrast or marginal effect can depend on the value of all the predictors in the model. As a result, contrasts and marginal effects are fundamentally unit-level quantities. The effect of a 1 unit increase in \(X\) can be different for Mary or John. Every row of a dataset has a different contrast and marginal effect.

The mtcars dataset has 32 rows, so the comparisons() function produces 32 contrast estimates:

library(marginaleffects)
mod <- glm(vs ~ factor(gear) + mpg, family = binomial, data = mtcars)
cmp <- comparisons(mod, variables = "mpg")
nrow(cmp)
#> [1] 32

Average contrasts

By default, the marginaleffects() and comparisons() functions compute marginal effects and contrasts for every row of the original dataset. These unit-level estimates can be unwieldy and hard to interpret. To help interpretation, the summary() function computes the “Average Marginal Effect” or “Average Contrast,” by taking the mean of all the unit-level estimates.

summary(cmp)
#>   Term    Contrast  Effect Std. Error z value   Pr(>|z|)   2.5 %  97.5 %
#> 1  mpg (x + 1) - x 0.06081    0.01284   4.737 2.1714e-06 0.03565 0.08597
#> 
#> Model type:  glm 
#> Prediction type:  response

which is equivalent to:

mean(cmp$comparison)
#> [1] 0.06080995

We could also show the full distribution of contrasts across our dataset with a histogram:

library(ggplot2)

cmp <- comparisons(mod, variables = "gear")

ggplot(cmp, aes(comparison)) +
    geom_histogram(bins = 30) +
    facet_wrap(~contrast, scale = "free_x") +
    labs(x = "Distribution of unit-level contrasts")

This graph display the effect of a change of 1 unit in the mpg variable, for each individual in the observed data.

Contrasts at the mean

An alternative which used to be very common but has now fallen into a bit of disfavor is to compute “Contrasts at the mean.” The idea is to create a “synthetic” or “hypothetical” individual (row of the dataset) whose characteristics are completely average. Then, we compute and report the contrast for this specific hypothetical individual.

This can be achieved by setting newdata="mean" or to newdata=datagrid(), both of which fix variables to their means or modes:

comparisons(mod, variables = "mpg", newdata = "mean")
#>   rowid     type term    contrast comparison  std.error statistic     p.value   conf.low conf.high gear
#> 1     1 response  mpg (x + 1) - x  0.1664787 0.06245542   2.66556 0.007686022 0.04406829  0.288889    3
#>        mpg     eps
#> 1 20.09062 0.00235

Contrasts at the mean can differ substantially from average contrasts.

The advantage of this approach is that it is very cheap and fast computationally. The disadvantage is that the interpretation is somewhat ambiguous. Often times, there simply does not exist an individual who is perfectly average across all dimensions of the dataset. It is also not clear why the analyst should be particularly interested in the contrast for this one, synthetic, perfectly average individual.

Contrasts between marginal means

Yet another type of contrast is the “Contrast between marginal means.” This type of contrast is closely related to the “Contrast at the mean”, with a few wrinkles. It is the default approach used by the emmeans package for R.

Roughly speaking, the procedure is as follows:

  1. Create a prediction grid with one cell for each combination of categorical predictors in the model, and all numeric variables held at their means.
  2. Make adjusted predictions in each cell of the prediction grid.
  3. Take the average of those predictions (marginal means) for each combination of btype (focal variable) and resp (group by variable).
  4. Compute pairwise differences (contrasts) in marginal means across different levels of the focal variable btype.

The contrast obtained through this approach has two critical characteristics:

  1. It is the contrast for a synthetic individual with perfectly average qualities on every (numeric) predictor.
  2. It is a weighted average of unit-level contrasts, where weights assume a perfectly balanced dataset across every categorical predictor.

With respect to (a), the analyst should ask themselves: Is my quantity of interest the contrast for a perfectly average hypothetical individual? With respect to (b), the analyst should ask themselves: Is my quantity of interest the contrast in a model estimated using (potentially) unbalanced data, but interpreted as if the data were perfectly balanced?

For example, imagine that one of the control variables in your model is a variable measuring educational attainment in 4 categories: No high school, High school, Some college, Completed college. The contrast between marginal is a weighted average of contrasts estimated in the 4 cells, and each of those contrasts will be weighted equally in the overall estimate. If the population of interest is highly unbalanced in the educational categories, then the estimate computed in this way will not be most useful.

If the contrasts between marginal means is really the quantity of interest, it is easy to use the comparisons() to estimate contrasts between marginal means. The newdata determines the values of the predictors at which we want to compute contrasts. We can set newdata="marginalmeans" to emulate the emmeans behavior. For example, here we compute contrasts in a model with an interaction:

dat <- read.csv("https://vincentarelbundock.github.io/Rdatasets/csv/palmerpenguins/penguins.csv")
mod <- lm(bill_length_mm ~ species * sex + island + body_mass_g, data = dat)

cmp <- comparisons(
    mod,
    newdata = "marginalmeans",
    variables = c("species", "island"))
summary(cmp)
#>              species             island   Effect Std. Error z value   Pr(>|z|)   2.5 %  97.5 %
#> 1    Adelie - Adelie     Dream - Biscoe -0.45571     0.4533  -1.005    0.31472 -1.3441  0.4327
#> 2    Adelie - Adelie Torgersen - Biscoe  0.08507     0.4701   0.181    0.85639 -0.8363  1.0064
#> 3 Chinstrap - Adelie    Biscoe - Biscoe 10.26934     0.4067  25.252 < 2.22e-16  9.4723 11.0664
#> 4 Chinstrap - Adelie     Dream - Biscoe  9.81362     0.4336  22.630 < 2.22e-16  8.9637 10.6636
#> 5 Chinstrap - Adelie Torgersen - Biscoe 10.35441     0.6217  16.656 < 2.22e-16  9.1360 11.5728
#> 6    Gentoo - Adelie    Biscoe - Biscoe  5.89568     0.6773   8.705 < 2.22e-16  4.5683  7.2231
#> 7    Gentoo - Adelie     Dream - Biscoe  5.43996     0.9413   5.779  7.504e-09  3.5951  7.2849
#> 8    Gentoo - Adelie Torgersen - Biscoe  5.98075     0.9542   6.268  3.667e-10  4.1105  7.8510
#> 
#> Model type:  lm 
#> Prediction type:  response

Which is equivalent to this in emmeans:

emm <- emmeans(
    mod,
    specs = c("species", "island"))
contrast(emm, method = "trt.vs.ctrl1")
#>  contrast                            estimate    SE  df t.ratio p.value
#>  Chinstrap Biscoe - Adelie Biscoe     10.2693 0.407 324  25.252  <.0001
#>  Gentoo Biscoe - Adelie Biscoe         5.8957 0.677 324   8.705  <.0001
#>  Adelie Dream - Adelie Biscoe         -0.4557 0.453 324  -1.005  0.8274
#>  Chinstrap Dream - Adelie Biscoe       9.8136 0.434 324  22.630  <.0001
#>  Gentoo Dream - Adelie Biscoe          5.4400 0.941 324   5.779  <.0001
#>  Adelie Torgersen - Adelie Biscoe      0.0851 0.470 324   0.181  0.9994
#>  Chinstrap Torgersen - Adelie Biscoe  10.3544 0.622 324  16.656  <.0001
#>  Gentoo Torgersen - Adelie Biscoe      5.9808 0.954 324   6.268  <.0001
#> 
#> Results are averaged over the levels of: sex 
#> P value adjustment: dunnettx method for 8 tests

The emmeans section of the Alternative Software vignette shows further examples.

The excellent vignette of the emmeans package discuss the same issues in a slightly different (and more positive) way:

The point is that the marginal means of cell.means give equal weight to each cell. In many situations (especially with experimental data), that is a much fairer way to compute marginal means, in that they are not biased by imbalances in the data. We are, in a sense, estimating what the marginal means would be, had the experiment been balanced. Estimated marginal means (EMMs) serve that need.

All this said, there are certainly situations where equal weighting is not appropriate. Suppose, for example, we have data on sales of a product given different packaging and features. The data could be unbalanced because customers are more attracted to some combinations than others. If our goal is to understand scientifically what packaging and features are inherently more profitable, then equally weighted EMMs may be appropriate; but if our goal is to predict or maximize profit, the ordinary marginal means provide better estimates of what we can expect in the marketplace.

Conditional contrasts

Consider a model with an interaction term. What happens to the dependent variable when the hp variable increases by 10 units?

library(marginaleffects)

mod <- lm(mpg ~ hp * wt, data = mtcars)

plot_cco(
    mod,
    effect = list(hp = 10),
    condition = "wt")

Transformations

So far we have focused on simple differences between adjusted predictions. Now, we show how to use ratios, back transformations, and arbitrary functions to estimate a slew of quantities of interest. Powerful transformations and custom contrasts are made possible by using three arguments which act at different stages of the computation process:

Consider the case of a model with a single predictor \(x\). To compute average contrasts, we proceed as follows:

  1. Compute adjusted predictions for each row of the dataset for the observed values \(x\): \(\hat{y}_x\)
  2. Compute adjusted predictions for each row of the dataset for the observed values \(x + 1\): \(\hat{y}_{x+1}\)
  3. transform_pre: Compute unit-level contrasts by taking the difference between (or some other function of) adjusted predictions: \(\hat{y}_{x+1} - \hat{y}_x\)
  4. transform_post: Transform the unit-level contrasts or return them as-is.
  5. Compute the average contrast by taking the mean of unit-level contrasts: \(1/N \sum_{i=1}^N \hat{y}_{x+1} - \hat{y}_x\)
  6. transform_avg: Transform the average contrast or return them as-is.

The transform_pre argument of the comparisons() function determines how adjusted predictions are combined to create a contrast. By default, we take a simple difference between predictions with hi value of \(x\), and predictions with a lo value of \(x\): function(hi, lo) hi-lo.

The transform_post argument of the comparisons() function applies a custom transformation to the unit-level contrasts.

The transform_avg argument is available in the tidy() and summary() functions. It applies a custom transformation to the average contrast.

The difference between transform_post and transform_avg is that the former is applied before we take the average, and the latter is applied to the average. This seems like a subtle distinction, but it can be important practical implications, since a function of the average is rarely the same as the average of a function:

set.seed(1024)
x <- rnorm(100)
exp(mean(x))
#> [1] 0.9806912
mean(exp(x))
#> [1] 1.587238

Differences

The default contrast calculate by the comparisons() function is a (untransformed) difference between two adjusted predictions. For instance, to estimate the effect of a change of 1 unit, we do:

library(marginaleffects)
library(magrittr)

mod <- glm(vs ~ mpg, data = mtcars, family = binomial)

# construct data

mtcars_minus <- mtcars_plus <- mtcars
mtcars_minus$mpg <- mtcars_minus$mpg - 0.5
mtcars_plus$mpg <- mtcars_plus$mpg + 0.5

# adjusted predictions
yhat_minus <- predict(mod, newdata = mtcars_minus, type = "response")
yhat_plus <- predict(mod, newdata = mtcars_plus, type = "response")

# unit-level contrasts
con <- yhat_plus - yhat_minus

# average contrasts
mean(con)
#> [1] 0.05540227

We can use the comparisons() and summary() functions to obtain the same results:

con <- comparisons(mod)
summary(con)
#>   Term    Contrast Effect Std. Error z value   Pr(>|z|)   2.5 %  97.5 %
#> 1  mpg (x + 1) - x 0.0554   0.008327   6.653 2.8699e-11 0.03908 0.07172
#> 
#> Model type:  glm 
#> Prediction type:  response

Ratios

Instead of taking simple differences between adjusted predictions, it can sometimes be useful to compute ratios or other functions of predictions. For example, the adjrr function the Stata software package can compute “adjusted risk ratios”, which are ratios of adjusted predictions. To do this in R, we use the transform_pre argument:

comparisons(mod, transform_pre = "ratio") %>% summary()
#>   Term    Contrast Effect Std. Error z value   Pr(>|z|) 2.5 % 97.5 %
#> 1  mpg (x + 1) / x  1.287     0.1328   9.697 < 2.22e-16 1.027  1.548
#> 
#> Model type:  glm 
#> Prediction type:  response

This result is the average adjusted risk ratio, that is, the adjusted predictions when the mpg are incremented by 1, divided by the adjusted predictions when mpg is at its original value.

The transform_pre accepts different values for common types of contrasts: ‘difference’, ‘ratio’, ‘lnratio’, ‘ratioavg’, ‘lnratioavg’, ‘lnoravg’, ‘differenceavg’. These strings are shortcuts for functions that accept two vectors of adjusted predictions and returns a single vector of contrasts. For example, these two commands yield identical results:

comparisons(mod, transform_pre = "ratio") %>% summary()
#>   Term    Contrast Effect Std. Error z value   Pr(>|z|) 2.5 % 97.5 %
#> 1  mpg (x + 1) / x  1.287     0.1328   9.697 < 2.22e-16 1.027  1.548
#> 
#> Model type:  glm 
#> Prediction type:  response

comparisons(mod, transform_pre = function(hi, lo) hi / lo) %>% summary()
#>   Term Contrast Effect Std. Error z value   Pr(>|z|) 2.5 % 97.5 %
#> 1  mpg   custom  1.287     0.1328   9.697 < 2.22e-16 1.027  1.548
#> 
#> Model type:  glm 
#> Prediction type:  response 
#> Pre-transformation:  function(hi, lo) hi/lo

This mechanism is powerful, because it lets users create fully customized contrasts. Here is a non-sensical example:

comparisons(mod, transform_pre = function(hi, lo) sqrt(hi) / log(lo + 10)) %>% summary()
#>   Term Contrast Effect Std. Error z value   Pr(>|z|)  2.5 % 97.5 %
#> 1  mpg   custom 0.2641    0.02614    10.1 < 2.22e-16 0.2128 0.3153
#> 
#> Model type:  glm 
#> Prediction type:  response 
#> Pre-transformation:  function(hi, lo) sqrt(hi)/log(lo + 10)

The same arguments work in the plotting function plot_cco() as well, which allows us to plot various custom contrasts. Here is a comparison of Adjusted Risk Ratio and Adjusted Risk Difference in a model of the probability of survival aboard the Titanic:

library(ggplot2)
library(patchwork)
titanic <- "https://vincentarelbundock.github.io/Rdatasets/csv/Stat2Data/Titanic.csv"
titanic <- read.csv(titanic)
mod_titanic <- glm(
    Survived ~ Sex * PClass + Age + I(Age^2),
    family = binomial,
    data = titanic)

cmp <- comparisons(mod_titanic)
summary(cmp)
#>     Term      Contrast    Effect Std. Error z value   Pr(>|z|)     2.5 %    97.5 %
#> 1    Sex male - female -0.484676   0.030607 -15.835 < 2.22e-16 -0.544665 -0.424687
#> 2 PClass     2nd - 1st -0.205782   0.039374  -5.226 1.7296e-07 -0.282954 -0.128609
#> 3 PClass     3rd - 1st -0.404283   0.039839 -10.148 < 2.22e-16 -0.482367 -0.326199
#> 4    Age   (x + 1) - x -0.006504   0.001072  -6.069 1.2904e-09 -0.008605 -0.004403
#> 
#> Model type:  glm 
#> Prediction type:  response

p1 <- plot_cco(
    mod_titanic,
    effect = "Age",
    condition = "Age",
    transform_pre = "ratio") +
    ylab("Adjusted Risk Ratio\nP(Survival | Age + 1) / P(Survival | Age)")

p2 <- plot_cco(
    mod_titanic,
    effect = "Age",
    condition = "Age") +
    ylab("Adjusted Risk Difference\nP(Survival | Age + 1) - P(Survival | Age)")

p1 + p2

By default, the standard errors around contrasts are computed using the delta method on the scale determined by the type argument (e.g., “link” or “response”). Some analysts may prefer to proceed differently. For example, in Stata, the adjrr computes adjusted risk ratios (ARR) in two steps:

  1. Compute the natural log of the ratio between the mean of adjusted predictions with \(x+1\) and the mean of adjusted predictions with \(x\).
  2. Exponentiate the estimate and confidence interval bounds.

Step 1 is easy to achieve with the transform_pre argument described above. Step 2 can be achieved with the transform_post argument:

comparisons(
    mod,
    transform_pre = function(hi, lo) log(hi / lo),
    transform_post = exp) |>
    summary()
#>   Term Contrast Effect Std. Error z value   Pr(>|z|) 2.5 % 97.5 %
#> 1  mpg   custom  1.287    0.09313   13.82 < 2.22e-16 1.105   1.47
#> 
#> Model type:  glm 
#> Prediction type:  response 
#> Pre-transformation:  function(hi, lo) log(hi/lo) 
#> Post-transformation:  exp

Note that we can use the lnratioavg shortcut instead of defining the function ourselves.

The order of operations in previous command was:

  1. Compute the custom unit-level log ratios
  2. Exponentiate them
  3. Take the average using the summary() function

There is a very subtle difference between the procedure above and this code:

comparisons(
    mod,
    transform_pre = function(hi, lo) log(hi / lo)) %>%
    summary(transform_avg = exp)
#>   Term Contrast Effect  Pr(>|z|) 2.5 % 97.5 %
#> 1  mpg   custom  1.274 0.0093462 1.061  1.529
#> 
#> Model type:  glm 
#> Prediction type:  response 
#> Pre-transformation:  function(hi, lo) log(hi/lo) 
#> Average-transformation:

Since the exp function is now passed to the transform_avg argument of summary() function, the exponentiation is now done only after unit-level contrasts have been averaged. This is what Stata appears to does under the hood, and the results are slightly different.

comparisons(
    mod,
    transform_pre = function(hi, lo) log(mean(hi) / mean(lo)),
    transform_post = exp)
#>       type term contrast comparison      p.value conf.low conf.high
#> 1 response  mpg   custom   1.135065 2.380805e-10 1.091432  1.180442

Note that equivalent results can be obtained using shortcut strings in the transform_pre argument: “ratio”, “lnratio”, “lnratioavg”.

comparisons(
    mod,
    transform_pre = "lnratioavg",
    transform_post = exp)
#>       type term                  contrast comparison      p.value conf.low conf.high
#> 1 response  mpg ln(mean(x + 1) / mean(x))   1.135065 2.380805e-10 1.091432  1.180442

All the same arguments apply to the plotting functions of the marginaleffects package as well. For example we can plot the Adjusted Risk Ratio in a model with a quadratic term:

library(ggplot2)

mod2 <- glm(vs ~ mpg + mpg^2, data = mtcars, family = binomial)

plot_cco(
    mod2,
    effect = list("mpg" = 10),
    condition = "mpg",
    transformation_pre = "ratio") +
    ylab("Adjusted Risk Ratio\nP(vs = 1 | mpg + 10) / P(vs = 1 | mpg)")

Lognormal hurdle model

With hurdle models, we can fit two separate models simultaneously:

  1. A model that predicts if the outcome is zero or not zero
  2. If the outcome is not zero, a model that predicts what the value of the outcome is

We can calculate predictions and marginal effects for each of these hurdle model processes, but doing so requires some variable transformation since the stages of these models use different link functions.

The hurdle_lognormal() family in brms uses logistic regression (with a logit link) for the hurdle part of the model and lognormal regression (where the outcome is logged before getting used in the model) for the non-hurdled part. Let’s look at an example of predicting GDP per capita (which is distributed exponentially) using life expectancy. We’ll add some artificial zeros so that we can work with a hurdle stage of the model.

library(dplyr)
library(ggplot2)
library(patchwork)
library(brms)
library(marginaleffects)
library(gapminder)

# Build some 0s into the GDP column
set.seed(1234)
gapminder <- gapminder::gapminder %>% 
  filter(continent != "Oceania") %>% 
  # Make a bunch of GDP values 0
  mutate(prob_zero = ifelse(lifeExp < 50, 0.3, 0.02),
         will_be_zero = rbinom(n(), 1, prob = prob_zero),
         gdpPercap0 = ifelse(will_be_zero, 0, gdpPercap)) %>% 
  select(-prob_zero, -will_be_zero)

mod <- brm(
  bf(gdpPercap0 ~ lifeExp,
     hu ~ lifeExp),
  data = gapminder,
  family = hurdle_lognormal(),
  chains = 4, cores = 4, seed = 1234)

We have two different sets of coefficients here for the two different processes. The hurdle part (hu) uses a logit link, and the non-hurdle part (mu) uses an identity link. However, that’s a slight misnomer—a true identity link would show the coefficients on a non-logged dollar value scale. Because we’re using a lognormal family, GDP per capita is pre-logged, so the “original” identity scale is actually logged dollars.

summary(mod)
#>  Family: hurdle_lognormal 
#>   Links: mu = identity; sigma = identity; hu = logit 
#> Formula: gdpPercap0 ~ lifeExp 
#>          hu ~ lifeExp
#>    Data: gapminder (Number of observations: 1680) 
#>   Draws: 4 chains, each with iter = 2000; warmup = 1000; thin = 1;
#>          total post-warmup draws = 4000
#> 
#> Population-Level Effects: 
#>              Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> Intercept        3.47      0.09     3.29     3.65 1.00     4757     3378
#> hu_Intercept     3.16      0.40     2.37     3.96 1.00     2773     2679
#> lifeExp          0.08      0.00     0.08     0.08 1.00     5112     3202
#> hu_lifeExp      -0.10      0.01    -0.12    -0.08 1.00     2385     2652
#> ...

We can get predictions for the hu part of the model on the link (logit) scale:

predictions(mod, dpar = "hu", type = "link",
            newdata = datagrid(lifeExp = seq(40, 80, 20)))
#>   rowid type predicted  conf.low  conf.high lifeExp
#> 1     1 link -0.817487 -1.033982 -0.6043308      40
#> 2     2 link -2.805488 -3.062906 -2.5550801      60
#> 3     3 link -4.790200 -5.337808 -4.2745563      80

…or on the response (percentage point) scale:

predictions(mod, dpar = "hu", type = "response",
            newdata = datagrid(lifeExp = seq(40, 80, 20)))
#>   rowid     type   predicted    conf.low  conf.high lifeExp
#> 1     1 response 0.306297360 0.262312829 0.35335351      40
#> 2     2 response 0.057028334 0.044663565 0.07208594      60
#> 3     3 response 0.008242295 0.004783404 0.01372716      80

We can also get slopes for the hu part of the model on the link (logit) or response (percentage point) scales:

marginaleffects(mod, dpar = "hu", type = "link",
                newdata = datagrid(lifeExp = seq(40, 80, 20)))
#>   rowid type    term        dydx   conf.low   conf.high predicted predicted_hi predicted_lo lifeExp
#> 1     1 link lifeExp -0.09930925 -0.1157859 -0.08366088 -0.817487   -0.8180725    -0.817487      40
#> 2     2 link lifeExp -0.09930925 -0.1157859 -0.08366088 -2.805488   -2.8060666    -2.805488      60
#> 3     3 link lifeExp -0.09930925 -0.1157859 -0.08366088 -4.790200   -4.7908031    -4.790200      80
#>         eps
#> 1 0.0059004
#> 2 0.0059004
#> 3 0.0059004

marginaleffects(mod, dpar = "hu", type = "response",
                newdata = datagrid(lifeExp = seq(40, 80, 20)))
#>   rowid     type    term          dydx     conf.low     conf.high   predicted predicted_hi predicted_lo
#> 1     1 response lifeExp -0.0210776902 -0.025913450 -0.0165879119 0.306297360  0.306172973  0.306297360
#> 2     2 response lifeExp -0.0053208087 -0.006148655 -0.0045608559 0.057028334  0.056997229  0.057028334
#> 3     3 response lifeExp -0.0008118892 -0.001154388 -0.0005429417 0.008242295  0.008237367  0.008242295
#>   lifeExp       eps
#> 1      40 0.0059004
#> 2      60 0.0059004
#> 3      80 0.0059004

Working with the mu part of the model is trickier. Switching between type = "link" and type = "response" doesn’t change anything, since the outcome is pre-logged:

predictions(mod, dpar = "mu", type = "link",
            newdata = datagrid(lifeExp = seq(40, 80, 20)))
#>   rowid type predicted conf.low conf.high lifeExp
#> 1     1 link  6.612435 6.542113  6.685787      40
#> 2     2 link  8.183520 8.145944  8.220893      60
#> 3     3 link  9.753512 9.687209  9.820665      80
predictions(mod, dpar = "mu", type = "response",
            newdata = datagrid(lifeExp = seq(40, 80, 20)))
#>   rowid     type predicted conf.low conf.high lifeExp
#> 1     1 response  6.612435 6.542113  6.685787      40
#> 2     2 response  8.183520 8.145944  8.220893      60
#> 3     3 response  9.753512 9.687209  9.820665      80

For predictions, we need to exponentiate the results to scale them back up to dollar amounts. We can do this by post-processing the results (e.g. with dplyr::mutate(predicted = exp(predicted))), or we can use the transform_post argument in predictions() to pass the results to exp() after getting calculated:

predictions(mod, dpar = "mu", 
            newdata = datagrid(lifeExp = seq(40, 80, 20)),
            transform_post = exp)
#>   rowid     type  predicted   conf.low  conf.high lifeExp
#> 1     1 response   744.2932   693.7513   800.9406      40
#> 2     2 response  3581.4392  3449.3601  3717.8204      60
#> 3     3 response 17214.5804 16110.2130 18410.2831      80

We can pass transform_post = exp to plot_cap() too:

plot_cap(
  mod,
  dpar = "hu",
  type = "link",
  condition = "lifeExp") +
  labs(y = "hu",
       title = "Hurdle part (hu)",
       subtitle = "Logit-scale predictions") +
plot_cap(
  mod,
  dpar = "hu",
  type = "response",
  condition = "lifeExp") +
  labs(y = "hu",
       subtitle = "Percentage point-scale predictions") +
plot_cap(
  mod,
  dpar = "mu",
  condition = "lifeExp") +
  labs(y = "mu",
       title = "Non-hurdle part (mu)",
       subtitle = "Log-scale predictions") +
plot_cap(
  mod,
  dpar = "mu",
  transform_post = exp,
  condition = "lifeExp") +
  labs(y = "mu",
       subtitle = "Dollar-scale predictions")

For marginal effects, we need to transform the predictions before calculating the instantaneous slopes. We also can’t use the marginaleffects() function directly—we need to use comparisons() and compute the numerical derivative ourselves (i.e. predict gdpPercap at lifeExp of 40 and 40.001 and calculate the slope between those predictions). We can use the transform_pre argument to pass the pair of predicted values to exp() before calculating the slopes:

# step size of the numerical derivative
eps <- 0.001

comparisons(
  mod,
  dpar = "mu",
  variables = list(lifeExp = eps),
  newdata = datagrid(lifeExp = seq(40, 80, 20)),
  # rescale the elements of the slope
  # (exp(40.001) - exp(40)) / exp(0.001)
  transform_pre = function(hi, lo) ((exp(hi) - exp(lo)) / exp(eps)) / eps
)
#>   rowid     type    term contrast comparison   conf.low  conf.high predicted predicted_hi predicted_lo
#> 1     1 response lifeExp   custom   58.39448   55.84743   61.02206  6.612435     6.612474     6.612396
#> 2     2 response lifeExp   custom  280.89410  266.57621  295.50894  8.183520     8.183559     8.183481
#> 3     3 response lifeExp   custom 1349.40503 1222.58608 1490.38119  9.753512     9.753551     9.753473
#>   lifeExp       eps
#> 1      40 0.0059004
#> 2      60 0.0059004
#> 3      80 0.0059004

We can visually confirm that these are the instantaneous slopes at each of these levels of life expectancy:

predictions_data <- predictions(
  mod,
  newdata = datagrid(lifeExp = seq(30, 80, 1)),
  dpar = "mu",
  transform_post = exp) |>
  select(lifeExp, predicted)

slopes_data <- comparisons(
  mod,
  dpar = "mu",
  variables = list(lifeExp = eps),
  newdata = datagrid(lifeExp = seq(40, 80, 20)),
  transform_pre = function(hi, lo) ((exp(hi) - exp(lo)) / exp(eps)) / eps) %>%
  select(lifeExp, comparison) %>%
  left_join(predictions_data, by = "lifeExp") %>%
  # Point-slope formula: (y - y1) = m(x - x1)
  mutate(intercept = comparison * (-lifeExp) + predicted)

ggplot(predictions_data, aes(x = lifeExp, y = predicted)) +
  geom_line(size = 1) + 
  geom_abline(data = slopes_data, aes(slope = comparison, intercept = intercept), 
              size = 0.5, color = "red") +
  geom_point(data = slopes_data) +
  geom_label(data = slopes_data, aes(label = paste0("Slope: ", round(comparison, 1))),
             nudge_x = -1, hjust = 1) +
  theme_minimal()