# Bayes’ theorem in three panels

**Higher Order Functions**, and kindly contributed to R-bloggers]. (You can report issue about the content on this page here)

Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.

In my last post, I walked through an intuition-building visualization I created to describe mixed-effects models for a nonspecialist audience. For that presentation, I also created an analogous visualization to introduce Bayes’ Theorem, so here I will walk through that figure..

As in the earlier post, let’s start by looking at the visualization and then we will recreate it using a simpler model and smaller dataset.

## Names for things

First, let’s review the theorem. Mathematically, it says how to convert one conditional probability into another one.

The formula becomes more interesting in the context of statistical modeling. We
have some model that describes a data-generating process and we have some
*observed* data, but we want to estimate some *unknown* model parameters.
In that case, the formula reads like:

When I was first learning Bayes, this form was my anchor for remember the formula. The goal is to learn about unknown quantity from data, so the left side needs be “unknown given data”.

These terms have conventional names:

*Prior* and *posterior* describe when information is obtained: what we know pre-data is our
prior information, and what we learn post-data is the updated information
(“posterior”).

The *likelihood* in the equation says how likely the data is given the model
parameters. I think of it as *fit*: How well do the parameters fit the data?
Classical regression’s line of best fit is the maximum likelihood line. The
likelihood also encompasses the data-generating process behind the model. For
example, if we assume that the observed data is normally distributed, then we
evaluate the likelihood by using the normal probability density function. You
don’t need to know what that last sentence means. What’s important is that the
likelihood contains our built-in assumptions about how the data is distributed.

The *average likelihood*—sometimes called *evidence*—is weird. I don’t have a
script for how to describe it in an intuitive way. It’s there to make sure the
math works out so that the posterior probabilities sum to 1. Some presentations
of Bayes theorem gloss over it, noting that the posterior is proportion to the
likelihood and prior information.

There it is. *Update your prior information in proportion to how well it fits
the observed data.* My plot about Bayes’ theorem is really just this form of the
equation expressed visually.

## The model: nonlinear beta regression

The data I presented at the conference involved the same kinds of logistic growth curves I wrote about last year. I will use the same example dataset as in that post.

library(tidyverse) #> -- Attaching packages --------------------------------------- tidyverse 1.3.0 -- #> √ ggplot2 3.2.1 √ purrr 0.3.3 #> √ tibble 2.1.3 √ stringr 1.4.0 #> √ tidyr 1.0.2 √ forcats 0.5.0 #> √ readr 1.3.1 #> Warning: package 'forcats' was built under R version 3.6.3 #> -- Conflicts ------------------------------------------ tidyverse_conflicts() -- #> x dplyr::filter() masks stats::filter() #> x dplyr::lag() masks stats::lag() data <- tibble( age = c(38, 45, 52, 61, 80, 74), prop = c(0.146, 0.241, 0.571, 0.745, 0.843, 0.738) )

Here *x* is a child’s age in months and *y* is
how intelligible the child’s speech is to strangers as a proportion. We use a
nonlinear beta regression model. The beta regression handles the fact that the
data are proportions, and the nonlinear encodes some assumptions about growth:
it starts at 0, reaches some asymptote, etc. Finally, our prior information
comes from our knowledge about when and how children learn to talk. (Nobody is
talking in understandable sentences at 16 months of age.)

Here is the model specification. I won’t go over it in detail.

library(brms) #> Loading required package: Rcpp #> Loading 'brms' package (version 2.12.0). Useful instructions #> can be found by typing help('brms'). A more detailed introduction #> to the package is available through vignette('brms_overview'). #> #> Attaching package: 'brms' #> The following object is masked from 'package:stats': #> #> ar inv_logit <- function(x) 1 / (1 + exp(-x)) model_formula <- bf( # Logistic curve prop ~ inv_logit(asymlogit) * inv(1 + exp((mid - age) * exp(scale))), # Each term in the logistic equation gets a linear model asymlogit ~ 1, mid ~ 1, scale ~ 1, # Precision phi ~ 1, # This is a nonlinear Beta regression model nl = TRUE, family = Beta(link = identity) ) prior_fixef <- c( # Point of steepest growth is age 4 plus/minus 2 years prior(normal(48, 12), nlpar = "mid", coef = "Intercept"), prior(normal(1.25, .75), nlpar = "asymlogit", coef = "Intercept"), prior(normal(-2, 1), nlpar = "scale", coef = "Intercept") ) prior_phi <- c( prior(normal(2, 1), dpar = "phi", class = "Intercept") )

## Sampling from the prior

Bayesian models are generative. They describe a data-generating process, so they
can be used to simulate new observations. Richard McElreath sometimes uses the
language
of running a model *forwards* to generate new observations using parameters and
running it *backwards* to infer the data-generating parameters from the data.

If we don’t have any data in hand, then running the model forwards to simulate data will using only the prior. I am not going as far as simulating actual observations; rather I will sample regression lines from the prior. These samples represent growth trajectories that are plausible before seeing any data.

We can use `sample_prior = "only"`

to have brms ignore the data and sample from
the prior distribution.

fit_prior <- brm( model_formula, data = data, prior = c(prior_fixef, prior_phi), iter = 2000, chains = 4, sample_prior = "only", cores = 1, control = list(adapt_delta = 0.9, max_treedepth = 15) ) #> Compiling the C++ model #> Start sampling

We can randomly draw some lines from the prior distribution by using
`add_fitted_draws()`

from the tidybayes package.

draws_prior <- data %>% tidyr::expand(age = 0:100) %>% tidybayes::add_fitted_draws(fit_prior, n = 100) p1 <- ggplot(draws_prior) + aes(x = age, y = .value) + geom_line(aes(group = .draw), alpha = .2) + theme( axis.ticks = element_blank(), axis.text = element_blank(), axis.title = element_blank() ) + expand_limits(y = 0:1) + ggtitle("Plausible curves before seeing data") p1

**A word of encouragement!** The prior is an intimidating part of Bayesian
statistics. It seems highly subjective, as though we are pulling numbers from
thin air, and it can be overwhelming for complex models. But if we are familiar
with the kind of data we are modeling, we have prior information. We can have
the model simulate new observations using the prior distribution and then
plot the hypothetical data. Does anything look wrong or implausible about the
simulated data? If so, then we have some prior information that we can include
in our model. Note that we do not evaluate the plausibility of the simulated
data based on the data we have in hand (the data we want to model); that’s not
prior information.

## Finding the best fit

To illustrate the likelihood, I am going to visualize a curve with a very high
likelihood. I won’t use Bayes here; instead, I will use nonlinear least squares
`nls()`

to illustrate what a purely data-driven fit would be. This approach is
not the same as finding the best-fitting line from the posterior
distribution—*waves hands*—but hey, we’re just building intuitions here.

# Maximum likelihood estimate fm1 <- nls(prop ~ SSlogis(age, Asym, xmid, scal), data) new_data <- tibble(age = 0:100) %>% mutate( fit = predict(fm1, newdata = .) ) point_orange <- "#FB6542" p2 <- ggplot(data) + aes(x = age, y = prop) + geom_line(aes(y = fit), data = new_data, size = 1) + geom_point(color = point_orange, size = 2) + theme( axis.ticks = element_blank(), axis.text = element_blank(), axis.title = element_blank() ) + expand_limits(y = 0:1) + expand_limits(x = c(0, 100)) + ggtitle("How well do the curves fit the data") p2

## Sample from the posterior

Now, let’s fit the actual model and randomly draw regression lines from the posterior distribution.

fit <- brm( model_formula, data = data, prior = c(prior_fixef, prior_phi), iter = 2000, chains = 4, cores = 1, control = list(adapt_delta = 0.9, max_treedepth = 15) ) #> Compiling the C++ model #> recompiling to avoid crashing R session #> Start sampling draws_posterior <- data %>% tidyr::expand(age = 0:100) %>% tidybayes::add_fitted_draws(fit, n = 100)

And now let’s plot the curves with the data, as we have data in hand now.

p3 <- ggplot(draws_posterior) + aes(x = age, y = .value) + geom_line(aes(group = .draw), alpha = .2) + geom_point( aes(y = prop), color = point_orange, size = 2, data = data ) + theme( axis.ticks = element_blank(), axis.text = element_blank(), axis.title = element_blank() ) + expand_limits(y = 0:1) + ggtitle("Plausible curves after seeing data") p3

Finally, we can assemble everything into one nice plot.

library(patchwork) p1 + p2 + p3

## A nice echo

3Blue1Brown is a YouTube channel that specializes in visualizing mathematical
concepts. It’s amazing. About a month after my presentation, the channel
covered Bayes’
theorem. The
approach was more basic: It looked at probability as discrete frequency counts
and using Bayes to synthesize different frequency probabilities together. Think
of the familiar illness-screening puzzle: *x*% of positive tests are accurate, *y*%
of the population has the illness, what is the chance of having the illness
given a positive test? And yet, the video recapped Bayes’ theorem with a
three-panel visualization:

The heart of Bayes’ theorem indeed.

**leave a comment**for the author, please follow the link and comment on their blog:

**Higher Order Functions**.

R-bloggers.com offers

**daily e-mail updates**about R news and tutorials about learning R and many other topics. Click here if you're looking to post or find an R/data-science job.

Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.