{"id":281,"date":"2020-12-18T11:28:27","date_gmt":"2020-12-18T11:28:27","guid":{"rendered":"https:\/\/www.tmwolock.com\/?p=281"},"modified":"2020-12-18T12:45:32","modified_gmt":"2020-12-18T12:45:32","slug":"distributional-regression-models-brms-tutorial","status":"publish","type":"post","link":"https:\/\/www.tmwolock.com\/index.php\/2020\/12\/18\/distributional-regression-models-brms-tutorial\/","title":{"rendered":"Fitting Distributional Regression Models in brms<\/code>: a Brief Tutorial"},"content":{"rendered":"\n

“Someone must<\/em> have done this before,” I mutter to myself as I type “what do you call it when…” into Google. I am convinced that one of the hardest parts of doing research is knowing what terms to search for. Modern search engines handle incoherent queries like “binomial distribution but with weights please” surprisingly well, but it can only do so much when I truly don't know what something is called.<\/p>\n

I ran into a surprising instance of this problem a few months ago when I fell into a project modeling sexual partner age distributions. People select partners in fairly predictable ways, and the resulting age distributions exhibit clear patterns with respect to age and sex. The stumbling block for this project was that the whole distributions<\/em> seemed to vary across the dataset. For example, middle aged people's partners have much more variable ages than teenagers' partners. In fact, we observed systematic variation by age and sex in each of the first four moments of the data; men aged 34 years exhibited systematically different kurtosis<\/em> than women aged 23 years.<\/p>\n

The obvious thing to do was to model each of those moments as a function of data (not just the mean), but no one seemed to know what that would be called (or if it was even legal). Many Google searches of the form “what do you call it when you model the variance too?” later, I found this vignette<\/a> from the brms<\/code> R package<\/a> by Dr. Paul B\u00fcrkner. Dr. B\u00fcrkner identified what I was looking for as “distributional regression” and questioned why it wasn't more widely used. Someone had indeed done it before and had already implemented it in well-regarded statistical inference framework. If only it worked out so well every time.<\/p>\n

That vignette is an extremely useful resource, but I wasn't able to find a worked, introductory example to the topic. At that point, I wanted to make sure I understood the basics of the method and its implementation. In this post, I will provide an overview of the justification for and mechanics of distributional regression methods, as well as an detailed demonstration of how to fit a distributional regression model to heteroscedastic data in brms<\/code>.<\/p>\n

What is Distributional Regression?<\/h2>\n

Distributional regression arises naturally when we look closely at the assumptions made by conventional Bayesian regression. In the Gaussian case of Bayesian regression, we assume that each observation of a response variable, \\(y_i\\), is normally distributed around an inferred location and standard deviation:<\/p>\n

\\[
\ny_i \\sim \\mathrm{N}(\\mu_i, \\sigma)
\n\\]<\/p>\n

We typically assume that \\(\\mu_i\\) is some linear transformation of data, \\(X_i\\), and that \\(\\sigma\\) is constant across all observations. We all know that assuming that \\(\\mu_i\\) is a linear transformation of data is only a convenient-but-inaccurate approximation in most cases, but I would argue that not allowing \\(\\sigma\\) to vary with respect to data could actually be the less realistic of the two assumptions. Why should we expect that every single observation's generating process has exactly the same variance?<\/p>\n

Instead, we can allow \\(\\sigma\\) to vary with respect to data as well, leading to the following linear distributional model:<\/p>\n

\\[
\n\\begin{array}{rcl}
\ny_i &\\sim&\\mathrm{N}(\\mu_i, \\sigma_i) \\newline
\n\\mu_i &=&\\beta^\\mu X_i ^\\mu \\newline
\n\\log\\sigma_i &=&\\beta^\\sigma X_i ^\\sigma
\n\\end{array}
\n\\]<\/p>\n

Note that we do not require \\(X^\\mu = X^\\sigma\\). In practice, we have found that even this small change can allow models to explain far more variation than would be possible under conventional regression.<\/p>\n

To see this in practice, we will simulate a dataset that might appear to adequately modeled by conventional regression, but actually requires distributional regression.<\/p>\n

Fake Data Simulation<\/h2>\n

First, we need to generate data that might benefit from distributional regression. The case that everyone learned about in their undergrad Statistics course are data that exhibit heteroscedasticity<\/a>. We call a collection of random variables “heteroscedastic” when their variability<\/em> varies along some (hopefully) measurable dimension. In this case, we will simulate a relatively small dataset (100 observations) to test distributional regression in a case where we might not consider it a possibility.<\/p>\n

Generating heteroscedastic data is straightforward enough in R. Step zero is to fix a seed and load in the packages we will need for the analysis.<\/p>\n

library(ggplot2)\nlibrary(brms)\nset.seed(404)\n<\/pre>\n
Then, we generate a matrix, X<\/code>, with 100 rows and 2 columns (one intercept and one covariate) that we will use to generate each observation's true mean and standard deviation. We fix the coefficients for the mean and standard deviation, B_mu<\/code> and B_sigma<\/code>, respectively, and find the true means and standard deviations, mu<\/code> and sigma<\/code>. Finally, we take one normally distributed sample per observation according to mu<\/code> and sigma<\/code>. We use a log-linear model for sigma<\/code> to ensure that it will always be positive.<\/p>\n
N <- 100\nX <- cbind(1, runif(N, 0, 100))\n\nB_mu <- c(10, 0.2)\nB_sigma <- c(0, 0.022)\n\nmu <- X %*% B_mu\nsigma <- exp(X %*% B_sigma)\n\ny <- rnorm(N, mu, sigma)\n<\/pre>\n
We can use ggplot2<\/code> to check that our fake data simulation works as expected, noting that we see the expected “fan” shape.<\/p>\n
ggplot() +\n  geom_point(aes(x = X[,2], y = y), shape=3) + \n  scale_x_continuous(expand=c(0,0)) +\n  scale_y_continuous(expand=c(0,0)) +\n  labs(y=NULL, x = NULL)\n<\/pre>\n
\"plot<\/p>\n
Conventional Regression<\/h2>\n
If we were less careful, we would proceed with plain old Bayesian linear regression, in which we have (omitting priors):<\/p>\n
\\[
\n\\begin{array}{rcl}
\ny_i &\\sim&\\mathrm{N}(\\mu_i, \\sigma) \\newline
\n\\mu_i &=& \\beta X_i.
\n\\end{array}
\n\\]<\/p>\n
In other words, we have a linear model for each observation's mean, but assume that \\(\\sigma\\) is constant across the entire dataset. Because we have generated our data from scratch, we know for a fact that this assumption is wrong.<\/p>\n
We can implement this model quickly with brms<\/code>. First, we put our data into a convenient data.frame<\/code>. Then we define our “conventional” regression model using typical R formula syntax. Note that brms<\/code> will automatically add a constant if we do not specify \u2026 + 0<\/code> or \u2026 - 1<\/code>. Finally, we fit the model using the brm<\/code> function. I am suppressing the output from this step to hide some compiler warnings.<\/p>\n
sim_data <- data.frame(y, X)\n\nconv_fm <- bf(\n  y ~ X2\n)\nconv_brm <- brm(conv_fm, data = sim_data)\n<\/pre>\n
Here is the output from that model:<\/p>\n
print(conv_brm)\n<\/pre>\n
##  Family: gaussian \n##   Links: mu = identity; sigma = identity \n## Formula: y ~ X2 \n##    Data: sim_data (Number of observations: 100) \n## Samples: 4 chains, each with iter = 2000; warmup = 1000; thin = 1;\n##          total post-warmup samples = 4000\n## \n## Population-Level Effects: \n##           Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS\n## Intercept     9.68      0.79     8.12    11.19 1.00     4042     3034\n## X2            0.21      0.01     0.19     0.24 1.00     4089     3161\n## \n## Family Specific Parameters: \n##       Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS\n## sigma     4.05      0.30     3.50     4.70 1.00     3676     2782\n## \n## Samples were drawn using sampling(NUTS). For each parameter, Bulk_ESS\n## and Tail_ESS are effective sample size measures, and Rhat is the potential\n## scale reduction factor on split chains (at convergence, Rhat = 1).\n<\/pre>\n
First, we note that we have fit a “gaussian” regression, which has two parameters: mu<\/code> and sigma<\/code>. All of the Rhat<\/code> values are 1.00, so everything appears to be in order. In general, the coefficient estimates are not too far from the truth.<\/p>\n
Most importantly, if we didn't know for a fact that this model was wrong, we would look at our (very precise) estimates and assume that everything was working well. Fortunately, we can take advantage of the posterior checking tools brms<\/code> provides to see how wrong the model is. In particular, we can find the posterior predictive distribution at regularly spaced values of X2<\/code>. Here, the predict<\/code> function is actually taking samples from the posterior distribution, not just returning the predicted mean.<\/p>\n
pred_df <- data.frame(X2 = seq(0, 100))\n\nconv_post_pred <- cbind(pred_df, predict(conv_brm, newdata = pred_df))\nhead(conv_post_pred)\n<\/pre>\n
##   X2  Estimate Est.Error     Q2.5    Q97.5\n## 1  0  9.683700  4.177371 1.292286 17.85911\n## 2  1  9.678432  4.143473 1.783049 17.84957\n## 3  2 10.103117  4.054727 2.096661 18.03102\n## 4  3 10.375159  4.095678 2.407267 18.44198\n## 5  4 10.592883  4.198666 2.457239 19.01788\n## 6  5 10.737160  4.124102 2.693994 18.67832\n<\/pre>\n
We can plot the predicted intervals with our data to see how our model performs:<\/p>\n
\"plot<\/p>\n
We would like the red region to cover 95% of the data points and generally replicate the patterns we observed, which it seems to do. The heteroscedasticity built into the dataset is very hard to see from this perspective (try covering half the image with your hand). Conventional regression is operating exactly as expected, which, in this case, means that we are making an explicit (and incorrect) assumption that the variance of the outcome variable is constant across the whole dataset.<\/p>\n
Distributional Regression<\/h2>\n
Instead, we can move into a distributional regression framework:<\/p>\n
\\[
\n\\begin{array}{rcl}
\ny_i &\\sim&\\mathrm{N}(\\mu_i, \\sigma_i) \\newline
\n\\mu_i &=& \\beta^\\mu X^\\mu_i \\newline
\n\\log\\sigma_i &=&\\beta^\\sigma X^\\sigma_i.
\n\\end{array}
\n\\]<\/p>\n
Note that \\(\\sigma\\) is now indexed by observation and that we have introduced parameter-specific coefficients and design matrices. We do not need to assume that \\(X^\\mu\\) and \\(X^\\sigma\\) are identical, but in this demonstration, they are.<\/p>\n
We can define slightly more complex bf<\/code> object to fit this model. The first formula implicitly corresponds to the mu<\/code> parameter, which is required by all brms<\/code> families, and must have the desired outcome variable as its dependent variable. Each subsequent formula can correspond to any of the other (non-mu<\/code>) distributional parameters in the family. We have already noted from our first model that the “gaussian” family expects mu<\/code> and sigma<\/code>, so our second formula has sigma<\/code> as its dependent variable.<\/p>\n
dist_fm <- bf(\n  y ~ X2,\n  sigma ~ X2\n)\ndist_brm <- brm(dist_fm, data = sim_data)\n<\/pre>\n
This model takes just a bit longer to fit that the previous one and returns the following results<\/p>\n
print(dist_brm)\n<\/pre>\n
##  Family: gaussian \n##   Links: mu = identity; sigma = log \n## Formula: y ~ X2 \n##          sigma ~ X2\n##    Data: sim_data (Number of observations: 100) \n## Samples: 4 chains, each with iter = 2000; warmup = 1000; thin = 1;\n##          total post-warmup samples = 4000\n## \n## Population-Level Effects: \n##                 Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS\n## Intercept          10.28      0.30     9.69    10.84 1.00     3298     3131\n## sigma_Intercept    -0.02      0.14    -0.28     0.27 1.00     2643     2178\n## X2                  0.20      0.01     0.18     0.22 1.00     1965     2268\n## sigma_X2            0.02      0.00     0.02     0.03 1.00     3250     2540\n## \n## Samples were drawn using sampling(NUTS). For each parameter, Bulk_ESS\n## and Tail_ESS are effective sample size measures, and Rhat is the potential\n## scale reduction factor on split chains (at convergence, Rhat = 1).\n<\/pre>\n
Here, Intercept<\/code> and X2<\/code> have an implicit mu_<\/code> in front of them, and sigma_Intercept<\/code> and sigma_X2<\/code> comprise \\(\\beta^\\sigma\\). Again, we see that each Rhat<\/code> value is 1.00, suggesting that the four chains have mixed well. We also note that sigma<\/code> now has a log<\/code> link function, which we have slyly anticipated in our fake data simulation.<\/p>\n
We can find and plot posterior predictions as before.<\/p>\n
dist_post_pred <- cbind(pred_df, predict(dist_brm, newdata = pred_df))\nhead(dist_post_pred)\n<\/pre>\n
##   X2 Estimate Est.Error     Q2.5    Q97.5\n## 1  0 10.27464  1.042657 8.173381 12.26846\n## 2  1 10.48839  1.068219 8.446713 12.64576\n## 3  2 10.68979  1.086983 8.547180 12.83999\n## 4  3 10.87010  1.112608 8.697068 13.12031\n## 5  4 11.08150  1.119850 8.908548 13.33388\n## 6  5 11.26817  1.126003 9.012126 13.51619\n<\/pre>\n
\"plot<\/p>\n
Unsurprisingly, the correct model appears to fit far better than the incorrect model, but we cannot say for sure that the extra complexity is valuable without more robust model comparisons.<\/p>\n
Model Comparisons<\/h2>\n
The first question we can ask is: did each model recover the true values? We can extract the estimated coefficients and intercepts and plot them against the true values to see.<\/p>\n
conv_fixef <- data.frame(fixef(conv_brm))\nconv_fixef$variable <- rownames(fixef(conv_brm))\ntmp_sigma <- data.frame(log(t(summary(conv_brm)$spec_pars[1:4])),variable = 'sigma_Intercept')\nnames(tmp_sigma) <- names(conv_fixef)\nconv_fixef <- rbind(conv_fixef, tmp_sigma)\nconv_fixef$Model <- 'Conventional'\n\ndist_fixef <- data.frame(fixef(dist_brm))\ndist_fixef$variable <- rownames(fixef(dist_brm))\ndist_fixef$Model <- 'Distributional'\n\ntrue_fixef <- data.frame(\n  variable = c('mu_Intercept', 'mu_X2', 'sigma_Intercept', 'sigma_X2'),\n  value = c(B_mu, B_sigma)\n)\n\nall_fixef <- rbind(conv_fixef, dist_fixef)\n\nall_fixef$variable[all_fixef$variable == 'Intercept'] <- 'mu_Intercept'\nall_fixef$variable[all_fixef$variable == 'X2'] <- 'mu_X2'\nggplot() +\n  geom_crossbar(data = all_fixef, aes(x=Model, y = Estimate, ymin = Q2.5, ymax=Q97.5),\n                width=0.2, fill='darkcyan', color='darkcyan', alpha=0.7) +\n  geom_hline(data = true_fixef, aes(yintercept=value)) +\n  facet_wrap('variable', scales='free_y') +\n  labs(y = NULL)\n<\/pre>\n
\"plot<\/p>\n
Here, each crossbar is the point estimate and 95% credible interval, and the horizontal lines are the true values. We can see that both models actually do relatively well inferring the true parameters for mu<\/code>. However, the sigma_Intercept<\/code> panel illustrates how inappropriate our estimate of \\(\\log\\sigma\\) is when X2<\/code> is equal to zero.<\/p>\n
We can also estimate and compare the two models' expected log posterior densities (ELPDs) to estimate which model would offer better out-of-sample fit. With the loo<\/code> function built-in to brms<\/code> (borrowed from the loo<\/code> package), we can easily estimate and compare these ELPDs. Here, loo_res<\/code> will contain the ELPD estimates for both models, as well as the differences between the two models. Higher ELPD is better.<\/p>\n
loo_res <- loo(conv_brm, dist_brm)\nloo_comparison <- loo_res$diffs\n\nprint(loo_res)\n<\/pre>\n
## Output of model 'conv_brm':\n## \n## Computed from 4000 by 100 log-likelihood matrix\n## \n##          Estimate   SE\n## elpd_loo   -283.9 12.2\n## p_loo         5.2  2.3\n## looic       567.8 24.4\n## ------\n## Monte Carlo SE of elpd_loo is 0.1.\n## \n## Pareto k diagnostic values:\n##                          Count Pct.    Min. n_eff\n## (-Inf, 0.5]   (good)     99    99.0%   1781      \n##  (0.5, 0.7]   (ok)        1     1.0%   218       \n##    (0.7, 1]   (bad)       0     0.0%   <NA>      \n##    (1, Inf)   (very bad)  0     0.0%   <NA>      \n## \n## All Pareto k estimates are ok (k < 0.7).\n## See help('pareto-k-diagnostic') for details.\n## \n## Output of model 'dist_brm':\n## \n## Computed from 4000 by 100 log-likelihood matrix\n## \n##          Estimate   SE\n## elpd_loo   -246.9  9.1\n## p_loo         4.1  1.0\n## looic       493.7 18.2\n## ------\n## Monte Carlo SE of elpd_loo is 0.1.\n## \n## Pareto k diagnostic values:\n##                          Count Pct.    Min. n_eff\n## (-Inf, 0.5]   (good)     98    98.0%   1563      \n##  (0.5, 0.7]   (ok)        2     2.0%   594       \n##    (0.7, 1]   (bad)       0     0.0%   <NA>      \n##    (1, Inf)   (very bad)  0     0.0%   <NA>      \n## \n## All Pareto k estimates are ok (k < 0.7).\n## See help('pareto-k-diagnostic') for details.\n## \n## Model comparisons:\n##          elpd_diff se_diff\n## dist_brm   0.0       0.0  \n## conv_brm -37.0       8.6\n<\/pre>\n
Interestingly, the estimated number of parameters is slightly lower<\/em> in the distributional model. The absolute value of the ratio of the difference to the standard error in the difference is 4.3, suggesting that the distributional model is significantly better than the conventional model. Again, given that the second model is literally correct, this just confirms that the inference machine is functioning as expected.<\/p>\n
So what?<\/h2>\n
The distributional model we built in this post doesn't even begin to scratch the surface of what we could do with this framework. Building models in brms<\/code> gives us access to a wide set of sophisticated prior distributions, regression families, and hierarchical modeling tools, any of which could be applied to any distributional parameter. For example, if our data were collected at heterogeneous sites, we could use a hierarchical model to allow each site to have a completely distinct distribution.<\/p>\n
In the original application (modeling sexual partner age distributions), I integrated these techniques with another fabulous feature from brms<\/code>: custom families. We were able to model the first four moments of these distributions as functions of respondent age and sexm not just the first. These models replicated observed partner age distributions far more accurately than previously possible.<\/p>\n
Hopefully, this tutorial offered enough context to help you get started using distributional models in brms<\/code>. The formula syntax and built-in model comparison tools make it easy to fit distributional models alongside conventional regression models. We will not always have enough data to fit complex distributional models, but, if nothing else, we do always need to think carefully about the level at which our models assume homogeneity.<\/p>\n","protected":false},"excerpt":{"rendered":"
“Someone must have done this before,” I mutter to myself as I type “what do you call it when…” into Google. I am convinced that one of the hardest parts of doing research is knowing what terms to search for. Modern search engines handle incoherent queries like “binomial distribution but with weights please” surprisingly well, … Continue reading Fitting Distributional Regression Models in brms<\/code>: a Brief Tutorial<\/span><\/a><\/p>\n","protected":false},"author":1,"featured_media":352,"comment_status":"open","ping_status":"open","sticky":false,"template":"","format":"standard","meta":[],"categories":[4],"tags":[7,8,5,6],"_links":{"self":[{"href":"https:\/\/www.tmwolock.com\/index.php\/wp-json\/wp\/v2\/posts\/281"}],"collection":[{"href":"https:\/\/www.tmwolock.com\/index.php\/wp-json\/wp\/v2\/posts"}],"about":[{"href":"https:\/\/www.tmwolock.com\/index.php\/wp-json\/wp\/v2\/types\/post"}],"author":[{"embeddable":true,"href":"https:\/\/www.tmwolock.com\/index.php\/wp-json\/wp\/v2\/users\/1"}],"replies":[{"embeddable":true,"href":"https:\/\/www.tmwolock.com\/index.php\/wp-json\/wp\/v2\/comments?post=281"}],"version-history":[{"count":64,"href":"https:\/\/www.tmwolock.com\/index.php\/wp-json\/wp\/v2\/posts\/281\/revisions"}],"predecessor-version":[{"id":366,"href":"https:\/\/www.tmwolock.com\/index.php\/wp-json\/wp\/v2\/posts\/281\/revisions\/366"}],"wp:featuredmedia":[{"embeddable":true,"href":"https:\/\/www.tmwolock.com\/index.php\/wp-json\/wp\/v2\/media\/352"}],"wp:attachment":[{"href":"https:\/\/www.tmwolock.com\/index.php\/wp-json\/wp\/v2\/media?parent=281"}],"wp:term":[{"taxonomy":"category","embeddable":true,"href":"https:\/\/www.tmwolock.com\/index.php\/wp-json\/wp\/v2\/categories?post=281"},{"taxonomy":"post_tag","embeddable":true,"href":"https:\/\/www.tmwolock.com\/index.php\/wp-json\/wp\/v2\/tags?post=281"}],"curies":[{"name":"wp","href":"https:\/\/api.w.org\/{rel}","templated":true}]}}