# 10 Big Entropy and the Generalized Linear Model

Statistical models force many choices upon us. Some of these choices are distributions that represent uncertainty. We must choose, for each parameter, a prior distribution. And we must choose a likelihood function, which serves as a distribution of data. There are conventional choices, such as wide Gaussian priors and the Gaussian likelihood of linear regression. These conventional choices work unreasonably well in many circumstances. But very often the conventional choices are not the best choices. Inference can be more powerful when we use all of the information, and doing so usually requires going beyond convention.

To go beyond convention, it helps to have some principles to guide choice. When an engineer wants to make an unconventional bridge, engineering principles help guide choice. When a researcher wants to build an unconventional model, entropy provides one useful principle to guide choice of probability distributions: Bet on the distribution with the biggest entropy. (McElreath, 2020a, p. 299)

#### 10.0.0.1 Rethinking: Bayesian updating is entropy maximization.

Another kind of probability distribution, the posterior distribution deduced by Bayesian updating, is also a case of maximizing entropy. The posterior distribution has the greatest entropy relative to the prior (the smallest cross entropy) among all distributions consistent with the assumed constraints and the observed data. (p. 300)

## 10.1 Maximum entropy

In Chapter 7, you met the basics of information theory. In brief, we seek a measure of uncertainty that satisfies three criteria: (1) the measure should be continuous; (2) it should increase as the number of possible events increases; and (3) it should be additive. The resulting unique measure of the uncertainty of a probability distribution \(p\) with probabilities \(p_i\) for each possible event \(i\) turns out to be just the average log-probability:

\[H(p) = - \sum_i p_i \log p_i\]

This function is known as

information entropy.The principle of maximum entropy applies this measure of uncertainty to the problem of choosing among probability distributions. Perhaps the simplest way to state the maximum entropy principle is:

The distribution that can happen the most ways is also the distribution with the biggest information entropy. The distribution with the biggest entropy is the most conservative distribution that obeys its constraints.

There’s nothing intuitive about this idea, so if it seems weird, you are normal. (pp. 300–301,

emphasisin the original)

Let’s execute the code for the pebbles-in-buckets example.

```
library(tidyverse)
<-
d tibble(a = c(0, 0, 10, 0, 0),
b = c(0, 1, 8, 1, 0),
c = c(0, 2, 6, 2, 0),
d = c(1, 2, 4, 2, 1),
e = 2)
# this is our analogue to McElreath's `lapply()` code
%>%
d mutate_all(~ . / sum(.)) %>%
# the next few lines constitute our analogue to his `sapply()` code
pivot_longer(everything(), names_to = "plot") %>%
group_by(plot) %>%
summarise(h = -sum(ifelse(value == 0, 0, value * log(value))))
```

```
## # A tibble: 5 x 2
## plot h
## <chr> <dbl>
## 1 a 0
## 2 b 0.639
## 3 c 0.950
## 4 d 1.47
## 5 e 1.61
```

For more on the formula syntax we used within `mutate_all()`

, you might check out this or this.

Anyway, we’re almost ready to plot, which brings us to color. For the plots in this chapter, we’ll be taking our color palettes from the **ghibli** package (Henderson, 2020), which provides palettes based on scenes from anime films by the Studio Ghibli.

`library(ghibli)`

The main function is `ghibli_palette()`

which you can use to both preview the palettes before using them and also index in order to use specific colors. For example, we’ll play with “MarnieMedium1,” first.

`ghibli_palette("MarnieMedium1")`

`ghibli_palette("MarnieMedium1")[1:7]`

`## [1] "#28231DFF" "#5E2D30FF" "#008E90FF" "#1C77A3FF" "#C5A387FF" "#67B8D6FF" "#E9D097FF"`

Now we’re ready to plot five of the six panels of Figure 10.1.

```
%>%
d mutate(bucket = 1:5) %>%
pivot_longer(-bucket,
names_to = "letter",
values_to = "pebbles") %>%
ggplot(aes(x = bucket, y = pebbles)) +
geom_col(width = 1/5, fill = ghibli_palette("MarnieMedium1")[2]) +
geom_text(aes(y = pebbles + 1, label = pebbles)) +
geom_text(data = tibble(
letter = letters[1:5],
bucket = 5.5,
pebbles = 10.5,
label = str_c(c(1, 90, 1260, 37800, 113400),
rep(c(" way", " ways"), times = c(1, 4)))),
aes(label = label),
hjust = 1) +
scale_y_continuous(breaks = c(0, 5, 10), limits = c(0, 12)) +
theme(panel.background = element_rect(fill = ghibli_palette("MarnieMedium1")[6]),
panel.grid = element_blank(),
strip.background = element_rect(fill = ghibli_palette("MarnieMedium1")[7])) +
facet_wrap(~ letter, ncol = 2)
```

We might plot our version of the final panel like so.

```
%>%
d # the next four lines are the same from above
mutate_all(~ . / sum(.)) %>%
pivot_longer(everything()) %>%
group_by(name) %>%
summarise(h = -sum(ifelse(value == 0, 0, value * log(value)))) %>%
# here's the R code 9.4 stuff
mutate(n_ways = c(1, 90, 1260, 37800, 113400)) %>%
group_by(name) %>%
mutate(log_ways = log(n_ways) / 10,
text_y = ifelse(name < "c", h + .15, h - .15)) %>%
# plot
ggplot(aes(x = log_ways, y = h)) +
geom_abline(intercept = 0, slope = 1.37, color = "white") +
geom_point(size = 2.5, color = ghibli_palette("MarnieMedium1")[7]) +
geom_text(aes(y = text_y, label = name)) +
labs(x = "log(ways) per pebble",
y = "entropy") +
theme(panel.background = element_rect(fill = ghibli_palette("MarnieMedium1")[6]),
panel.grid = element_blank())
```

“The distribution that can happen the greatest number of ways is the most plausible distribution. Call this distribution the **maximum entropy distribution**” (p. 303, **emphasis** in the original). Among the pebbles, the maximum entropy distribution was `e`

(i.e., the uniform).

#### 10.1.0.1 Rethinking: What good is intuition?

“Like many aspects of information theory, maximum entropy is not very intuitive. But note that intuition is just a guide to developing methods. When a method works, it hardly matters whether our intuition agrees” (p. 303).

### 10.1.1 Gaussian.

Behold the probability density for the generalized normal distribution:

\[\text{Pr} (y | \mu, \alpha, \beta) = \frac{\beta}{2 \alpha \Gamma \left (\frac{1}{\beta} \right )} e ^ {- \left (\frac{|y - \mu|}{\alpha} \right ) ^ {\beta}},\]

where \(\alpha =\) the scale, \(\beta =\) the shape, \(\mu =\) the location, and \(\Gamma =\) the gamma function. If you read closely in the text, you’ll discover that the densities in the right panel of Figure 10.2 were all created with the constraint \(\sigma^2 = 1\). But \(\sigma^2 \neq \alpha\) and there’s no \(\sigma\) in the equations in the text. However, it appears the variance for the generalized normal distribution follows the form

\[\sigma^2 = \frac{\alpha^2 \Gamma (3/\beta)}{\Gamma (1/\beta)}.\]

So if you do the algebra, you’ll see that you can compute \(\alpha\) for a given \(\sigma^2\) and \(\beta\) with the equation

\[\alpha = \sqrt{ \frac{\sigma^2 \Gamma (1/\beta)}{\Gamma (3/\beta)} }.\]

I got the formula from Wikipedia.com. Don’t judge. We can wrap that formula in a custom function, `alpha_per_beta()`

, use it to solve for the desired \(\beta\) values, and plot. But one more thing: McElreath didn’t tell us exactly which \(\beta\) values the left panel of Figure 10.2 was based on. So the plot below is my best guess.

```
<- function(beta, variance = 1) {
alpha_per_beta sqrt((variance * gamma(1 / beta)) / gamma(3 / beta))
}
crossing(value = seq(from = -5, to = 5, by = .1),
# I arrived at these values by trial and error
beta = c(1, 1.5, 2, 4)) %>%
mutate(mu = 0,
alpha = alpha_per_beta(beta)) %>%
# behold the formula for the generalized normal distribution in code!
mutate(density = (beta / (2 * alpha * gamma(1 / beta))) *
exp(1) ^ (-1 * (abs(value - mu) / alpha) ^ beta)) %>%
# plot
ggplot(aes(x = value, y = density, group = beta)) +
geom_line(aes(color = beta == 2, size = beta == 2)) +
scale_color_manual(values = c(ghibli_palette("MarnieMedium2")[c(2, 4)])) +
scale_size_manual(values = c(1/4, 1.25)) +
labs(subtitle = "Guess which color denotes the Gaussian.") +
coord_cartesian(xlim = c(-4, 4)) +
theme(legend.position = "none",
panel.background = element_rect(fill = ghibli_palette("MarnieMedium2")[7]),
panel.grid = element_blank())
```

Here’s right panel of Figure 10.2.

```
crossing(value = -8:8,
# this time we need a more densely-packed sequence of `beta` values
beta = seq(from = 1, to = 4, length.out = 100)) %>%
mutate(mu = 0,
alpha = alpha_per_beta(beta)) %>%
mutate(density = (beta / (2 * alpha * gamma(1 / beta))) *
exp(1) ^ (-1 * (abs(value - mu) / alpha) ^ beta)) %>%
group_by(beta) %>%
# this is just an abbreviated version of the formula we used in our first code block
summarise(entropy = -sum(density * log(density))) %>%
ggplot(aes(x = beta, y = entropy)) +
geom_vline(xintercept = 2, color = "white") +
geom_line(size = 2, color = ghibli_palette("MarnieMedium2")[6]) +
xlab(expression(beta(i.e.*", "*shape))) +
coord_cartesian(ylim = c(1.34, 1.42)) +
theme(panel.background = element_rect(fill = ghibli_palette("MarnieMedium2")[7]),
panel.grid = element_blank())
```

If you look closely, you’ll see our version doesn’t quite match up with McElreath’s. Over \(x\)-axis values of 2 to 4, they match up pretty well. But as you go from 2 to 1, you’ll see our line drops off more steeply than his did. [And no, `coord_cartesian()`

isn’t the problem.] If you can figure out why our numbers diverged, please share the answer.

But getting back on track:

The take-home lesson from all of this is that, if all we are willing to assume about a collection of measurements is that they have a finite variance, then the Gaussian distribution represents the most conservative probability distribution to assign to those measurements. But very often we are comfortable assuming something more. And in those cases, provided our assumptions are good ones, the principle of maximum entropy leads to distributions other than the Gaussian. (p. 306)

### 10.1.2 Binomial.

The binomial likelihood entails

counting the numbers of ways that a given observation could arise, according to our assumptions. The resulting distribution is known as the

binomial distribution. If only two things can happen (blue or white marble, for example), and there’s a constant chance \(p\) of each across \(n\) trials, then the probability of observing \(y\) events of type 1 and \(n - y\) events of type 2 is:\[\text{Pr} (y | n, p) = \frac{n!}{y! (n - y)!} p^y (1 - p)^{n - y}\]

It may help to note that the fraction with the factorials is just saying how many different ordered sequences of \(n\) outcomes have a count of \(y\). (p. 307,

emphasisin the original)

For me, that last sentence made more sense when I walked it out in an example. To do so, let’s wrap that fraction of factorials into a function.

```
<- function(n, y) {
count_ways # n = the total number of trials (i.e., the number of rows in your vector)
# y = the total number of 1s (i.e., successes) in your vector
factorial(n) / (factorial(y) * factorial(n - y)))
( }
```

Now consider three sequences:

- 0, 0, 0, 0 (i.e., \(n = 4\) and \(y = 0\))
- 1, 0, 0, 0 (i.e., \(n = 4\) and \(y = 1\))
- 1, 1, 0, 0 (i.e., \(n = 4\) and \(y = 2\))

We can organize that information in a little tibble and then demo our `count_ways()`

function.

```
tibble(sequence = 1:3,
n = 4,
y = c(0, 1, 2)) %>%
mutate(n_ways = count_ways(n = n, y = y))
```

```
## # A tibble: 3 x 4
## sequence n y n_ways
## <int> <dbl> <dbl> <dbl>
## 1 1 4 0 1
## 2 2 4 1 4
## 3 3 4 2 6
```

Here’s the pre-Figure 10.3 data McElreath presented on page 308.

```
# data
<-
d tibble(distribution = letters[1:4],
ww = c(1/4, 2/6, 1/6, 1/8),
bw = c(1/4, 1/6, 2/6, 4/8),
wb = c(1/4, 1/6, 2/6, 2/8),
bb = c(1/4, 2/6, 1/6, 1/8))
# table
%>%
d mutate_if(is.numeric, ~MASS::fractions(.) %>% as.character()) %>%
::flextable() flextable
```

distribution | ww | bw | wb | bb |

a | 1/4 | 1/4 | 1/4 | 1/4 |

b | 1/3 | 1/6 | 1/6 | 1/3 |

c | 1/6 | 1/3 | 1/3 | 1/6 |

d | 1/8 | 1/2 | 1/4 | 1/8 |

Those data take just a tiny bit of wrangling before they’re ready to plot in our version of Figure 10.3.

```
<-
d %>%
d pivot_longer(-distribution,
names_to = "sequence",
values_to = "probability") %>%
mutate(sequence = factor(sequence, levels = c("ww", "bw", "wb", "bb")))
%>%
d ggplot(aes(x = sequence, y = probability, group = 1)) +
geom_point(size = 2, color = ghibli_palette("PonyoMedium")[4]) +
geom_line(color = ghibli_palette("PonyoMedium")[5]) +
labs(x = NULL, y = NULL) +
coord_cartesian(ylim = 0:1) +
theme(axis.ticks.x = element_blank(),
panel.background = element_rect(fill = ghibli_palette("PonyoMedium")[2]),
panel.grid = element_blank(),
strip.background = element_rect(fill = ghibli_palette("PonyoMedium")[6])) +
facet_wrap(~ distribution)
```

If we go step by step, we might count the expected value for each `distribution`

like follows.

```
%>%
d # `str_count()` will count the number of times "b" occurs within a given row of `sequence`
mutate(n_b = str_count(sequence, "b")) %>%
mutate(product = probability * n_b) %>%
group_by(distribution) %>%
summarise(expected_value = sum(product))
```

```
## # A tibble: 4 x 2
## distribution expected_value
## <chr> <dbl>
## 1 a 1
## 2 b 1
## 3 c 1
## 4 d 1
```

We can use the same `group_by()`

strategy on the way to computing the entropies.

```
%>%
d group_by(distribution) %>%
summarise(entropy = -sum(probability * log(probability)))
```

```
## # A tibble: 4 x 2
## distribution entropy
## <chr> <dbl>
## 1 a 1.39
## 2 b 1.33
## 3 c 1.33
## 4 d 1.21
```

Like in the text, `distribution == "a"`

had the largest `entropy`

of the four. In the next example, the \(\text{expected value} = 1.4\) and \(p = .7\).

```
<- 0.7
p
(<-
a c((1 - p)^2,
* (1 - p),
p 1 - p) * p,
(^2)
p )
```

`## [1] 0.09 0.21 0.21 0.49`

Here’s the entropy for our distribution `a`

.

`-sum(a * log(a))`

`## [1] 1.221729`

I’m going to alter McElreath’s simulation function from **R** code 10.9 to take a `seed`

argument. In addition, I altered the names of the objects within the function and changed the output to a tibble that will also include the conditions “ww,” “bw,” “wb,” and “bb.”

```
<- function(seed, g = 1.4) {
sim_p
set.seed(seed)
<- runif(3)
x_123 <- ((g) * sum(x_123) - x_123[2] - x_123[3]) / (2 - g)
x_4 <- sum(c(x_123, x_4))
z <- c(x_123, x_4) / z
p
tibble(h = -sum(p * log(p)),
p = p,
key = factor(c("ww", "bw", "wb", "bb"), levels = c("ww", "bw", "wb", "bb")))
}
```

For a given `seed`

and `g`

value, our augmented `sim_p()`

function returns a \(4 \times 3\) tibble.

`sim_p(seed = 9.9, g = 1.4)`

```
## # A tibble: 4 x 3
## h p key
## <dbl> <dbl> <fct>
## 1 1.02 0.197 ww
## 2 1.02 0.0216 bw
## 3 1.02 0.184 wb
## 4 1.02 0.597 bb
```

So the next step is to determine how many replications we’d like, create a tibble with seed values ranging from 1 to that number, and then feed those `seed`

values into `sim_p()`

via `purrr::map2()`

, which will return a nested tibble. We’ll then `unnest()`

and take a peek.

```
# how many replications would you like?
<- 1e5
n_rep
<-
d tibble(seed = 1:n_rep) %>%
mutate(sim = map2(seed, 1.4, sim_p)) %>%
unnest(sim)
```

Take a look.

`head(d)`

```
## # A tibble: 6 x 4
## seed h p key
## <int> <dbl> <dbl> <fct>
## 1 1 1.21 0.108 ww
## 2 1 1.21 0.151 bw
## 3 1 1.21 0.233 wb
## 4 1 1.21 0.508 bb
## 5 2 1.21 0.0674 ww
## 6 2 1.21 0.256 bw
```

In order to intelligently choose which four replications we want to highlight in Figure 10.4, we’ll want to rank order them by entropy, `h`

.

```
<-
ranked_d %>%
d group_by(seed) %>%
arrange(desc(h)) %>%
ungroup() %>%
# here's the rank order step
mutate(rank = rep(1:n_rep, each = 4))
head(ranked_d)
```

```
## # A tibble: 6 x 5
## seed h p key rank
## <int> <dbl> <dbl> <fct> <int>
## 1 55665 1.22 0.0903 ww 1
## 2 55665 1.22 0.209 bw 1
## 3 55665 1.22 0.210 wb 1
## 4 55665 1.22 0.490 bb 1
## 5 71132 1.22 0.0902 ww 2
## 6 71132 1.22 0.210 bw 2
```

And we’ll also want a subset of the data to correspond to McElreath’s “A” through “D” distributions.

```
<-
subset_d %>%
ranked_d # I arrived at these `rank` values by trial and error
filter(rank %in% c(1, 87373, n_rep - 1500, n_rep - 10)) %>%
# I arrived at the `height` values by trial and error, too
mutate(height = rep(c(8, 2.25, .75, .5), each = 4),
distribution = rep(letters[1:4], each = 4))
head(subset_d)
```

```
## # A tibble: 6 x 7
## seed h p key rank height distribution
## <int> <dbl> <dbl> <fct> <int> <dbl> <chr>
## 1 55665 1.22 0.0903 ww 1 8 a
## 2 55665 1.22 0.209 bw 1 8 a
## 3 55665 1.22 0.210 wb 1 8 a
## 4 55665 1.22 0.490 bb 1 8 a
## 5 50981 1.00 0.0459 ww 87373 2.25 b
## 6 50981 1.00 0.0459 bw 87373 2.25 b
```

We’re finally ready to make our version of the left panel of Figure 10.4.

```
<-
p1 %>%
d ggplot(aes(x = h)) +
geom_density(size = 0, fill = ghibli_palette("LaputaMedium")[3],
adjust = 1/4) +
# note the data statements for the next two geoms
geom_linerange(data = subset_d %>% group_by(seed) %>% slice(1),
aes(ymin = 0, ymax = height),
color = ghibli_palette("LaputaMedium")[5]) +
geom_text(data = subset_d %>% group_by(seed) %>% slice(1),
aes(y = height + .5, label = distribution)) +
scale_x_continuous("Entropy", breaks = seq(from = .7, to = 1.2, by = .1)) +
theme(panel.background = element_rect(fill = ghibli_palette("LaputaMedium")[7]),
panel.grid = element_blank())
```

Did you notice how our `adjust = 1/4`

with `geom_density()`

served a similar function to the `adj=0.1`

in McElreath’s `dens()`

code? Anyways, here we make the right panel and combine the two with **patchwork**.

```
<-
p2 %>%
ranked_d filter(rank %in% c(1, 87373, n_rep - 1500, n_rep - 10)) %>%
mutate(distribution = rep(letters[1:4], each = 4)) %>%
ggplot(aes(x = key, y = p, group = 1)) +
geom_line(color = ghibli_palette("LaputaMedium")[5]) +
geom_point(size = 2, color = ghibli_palette("LaputaMedium")[4]) +
scale_y_continuous(NULL, breaks = NULL, limits = c(0, .75)) +
xlab(NULL) +
theme(axis.ticks.x = element_blank(),
panel.background = element_rect(fill = ghibli_palette("LaputaMedium")[7]),
panel.grid = element_blank(),
strip.background = element_rect(fill = ghibli_palette("LaputaMedium")[6])) +
facet_wrap(~ distribution)
# combine and plot
library(patchwork)
| p2 p1
```

Because we simulated, our values won’t match up identically with those in the text. We got pretty close, eh?

Since we saved our `sim_p()`

output in a nested tibble, which we then `unnested()`

, there’s no need to separate the entropy values from the distributional values the way McElreath did in his **R** code 10.11. If we wanted to determine our highest entropy value–and the corresponding `seed`

and `p`

values, while we’re at it–, we might execute something like this.

```
%>%
ranked_d group_by(key) %>%
arrange(desc(h)) %>%
slice(1)
```

```
## # A tibble: 4 x 5
## # Groups: key [4]
## seed h p key rank
## <int> <dbl> <dbl> <fct> <int>
## 1 55665 1.22 0.0903 ww 1
## 2 55665 1.22 0.209 bw 1
## 3 55665 1.22 0.210 wb 1
## 4 55665 1.22 0.490 bb 1
```

That maximum `h`

value matched up nicely with the one in the text. If you look at the `p`

column, you’ll see our values approximated McElreath’s `distribution`

values, too. In both cases, they’re real close to the `a`

values we computed, above.

` a`

`## [1] 0.09 0.21 0.21 0.49`

“All four of these distributions really do have expected value 1.4. But among the infinite distributions that satisfy this constraint, it is only the most even distribution, the exact one nominated by the binomial distribution, that has greatest entropy” (p. 310).

## 10.2 Generalized linear models

For an outcome variable that is continuous and far from any theoretical maximum or minimum, [a simple] Gaussian model has maximum entropy. But when the outcome variable is either discrete or bounded, a Gaussian likelihood is not the most powerful choice. (p. 312)

I winged the values for our Figure 10.5.

```
tibble(x = seq(from = -1, to = 3, by = .01)) %>%
mutate(probability = .35 + x * .5) %>%
ggplot(aes(x = x, y = probability)) +
geom_rect(xmin = -1, xmax = 3,
ymin = 0, ymax = 1,
fill = ghibli_palette("MononokeMedium")[5]) +
geom_hline(yintercept = 0:1, linetype = 2, color = ghibli_palette("MononokeMedium")[7]) +
geom_line(aes(linetype = probability > 1, color = probability > 1),
size = 1) +
geom_segment(x = 1.3, xend = 3,
y = 1, yend = 1,
size = 2/3, color = ghibli_palette("MononokeMedium")[3]) +
annotate(geom = "text",
x = 1.28, y = 1.04, hjust = 1,
label = "This is why we need link functions",
color = ghibli_palette("MononokeMedium")[4], size = 2.6) +
scale_color_manual(values = c(ghibli_palette("MononokeMedium")[3:4])) +
scale_y_continuous(breaks = c(0, .5, 1)) +
coord_cartesian(xlim = c(0, 2),
ylim = c(0, 1.2)) +
theme(legend.position = "none",
panel.background = element_rect(fill = ghibli_palette("MononokeMedium")[1]),
panel.grid = element_blank())
```

Luckily, it’s easy to do better. By using all of our prior knowledge about the outcome variable, usually in the form of constraints on the possible values it can take, we can appeal to maximum entropy for the choice of distribution. Then all we have to do is generalize the linear regression strategy–replace a parameter describing the shape of the likelihood with a linear model–to probability distributions other than the Gaussian. (p. 313)

As we will see, doing better will often involve using link functions.

#### 10.2.0.1 Rethinking: The scourge of Histomancy.

One strategy for choosing an outcome distribution is to plot the histogram of the outcome variable and, by gazing into its soul, decide what sort of distribution function to use. Call this strategy

Histomancy, the ancient art of divining likelihood functions from empirical histograms. This sorcery is used, for example, when testing for normality before deciding whether or not to use a non-parametric procedure. Histomancy is a false god. (p. 314,emphasisin the original)

Stop worshiping at alter of this false god. Use domain knowledge and principles maximum entropy to pick your likelihoods.

### 10.2.1 Meet the family.

The most common distributions used in statistical modeling are members of a family known as the

exponential family. Every member of this family is a maximum entropy distribution, for some set of constraints. And conveniently, just about every other statistical modeling tradition employs the exact same distributions, even though they arrive at them via justifications other than maximum entropy. (p. 314,emphasisin the original)

Here are the Gamma and Exponential panels for Figure 10.6.

```
<- 100
length_out
tibble(x = seq(from = 0, to = 5, length.out = length_out)) %>%
mutate(Gamma = dgamma(x, 2, 2),
Exponential = dexp(x)) %>%
pivot_longer(-x, values_to = "density") %>%
mutate(label = ifelse(name == "Gamma", "y %~% Gamma(lambda, kappa)", "y %~% Exponential(lambda)")) %>%
ggplot(aes(x = x, y = density)) +
geom_area(fill = ghibli_palette("SpiritedMedium")[3]) +
scale_x_continuous(NULL, breaks = NULL) +
scale_y_continuous(NULL, breaks = NULL) +
coord_cartesian(xlim = c(0, 4)) +
theme(panel.background = element_rect(fill = ghibli_palette("SpiritedMedium")[5]),
panel.grid = element_blank(),
strip.background = element_rect(fill = ghibli_palette("SpiritedMedium")[7])) +
facet_wrap(~ label, scales = "free_y", labeller = label_parsed)
```

The Gaussian:

```
tibble(x = seq(from = -5, to = 5, length.out = length_out)) %>%
mutate(density = dnorm(x),
strip = "y %~% Normal(mu, sigma)") %>%
ggplot(aes(x = x, y = density)) +
geom_area(fill = ghibli_palette("SpiritedMedium")[3]) +
scale_x_continuous(NULL, breaks = NULL) +
scale_y_continuous(NULL, breaks = NULL) +
coord_cartesian(xlim = c(-4, 4)) +
theme(panel.background = element_rect(fill = ghibli_palette("SpiritedMedium")[5]),
panel.grid = element_blank(),
strip.background = element_rect(fill = ghibli_palette("SpiritedMedium")[7])) +
facet_wrap(~ strip, labeller = label_parsed)
```

Here is the Poisson.

```
tibble(x = 0:20) %>%
mutate(density = dpois(x, lambda = 2.5),
strip = "y %~% Poisson(lambda)") %>%
ggplot(aes(x = x, y = density)) +
geom_col(fill = ghibli_palette("SpiritedMedium")[2], width = 1/2) +
scale_x_continuous(NULL, breaks = NULL) +
scale_y_continuous(NULL, breaks = NULL) +
coord_cartesian(xlim = c(0, 10)) +
theme(panel.background = element_rect(fill = ghibli_palette("SpiritedMedium")[5]),
panel.grid = element_blank(),
strip.background = element_rect(fill = ghibli_palette("SpiritedMedium")[7])) +
facet_wrap(~ strip, labeller = label_parsed)
```

Finally, the Binomial:

```
tibble(x = 0:10) %>%
mutate(density = dbinom(x, size = 10, prob = .85),
strip = "y %~% Binomial(n, p)") %>%
ggplot(aes(x = x, y = density)) +
geom_col(fill = ghibli_palette("SpiritedMedium")[2], width = 1/2) +
scale_x_continuous(NULL, breaks = NULL) +
scale_y_continuous(NULL, breaks = NULL) +
coord_cartesian(xlim = c(0, 10)) +
theme(panel.background = element_rect(fill = ghibli_palette("SpiritedMedium")[5]),
panel.grid = element_blank(),
strip.background = element_rect(fill = ghibli_palette("SpiritedMedium")[7])) +
facet_wrap(~ strip, labeller = label_parsed)
```

#### 10.2.1.1 Rethinking: A likelihood is a prior.

In traditional statistics, likelihood functions are “objective” and prior distributions “subjective.” In Bayesian statistics, likelihoods are deeply related to prior probability distributions: They are priors for the data, conditional on the parameters. And just like with other priors, there is no correct likelihood. But there are better and worse likelihoods, depending upon the context. (p. 316)

For a little more in this, check out McElreath’s great lecture, Bayesian statistics without frequentist language. This subsection also reminds me of the title of one of Gelman’s blog posts, *“It is perhaps merely an accident of history that skeptics and subjectivists alike strain on the gnat of the prior distribution while swallowing the camel that is the likelihood”*. The title, which itself is a quote, comes from one of his papers, which he linked to in the blog, along with several related papers. It’s taken some time for the weight of that quote to sink in with me, and indeed it’s still sinking. Perhaps you’ll benefit from it, too.

### 10.2.2 Linking linear models to distributions.

To build a regression model from any of the exponential family distributions is just a matter of attaching one or more linear models to one or more of the parameters that describe the distribution’s shape. But as hinted at earlier, usually we require a

link functionto prevent mathematical accidents like negative distances or probability masses that exceed 1. (p. 316,emphasisin the original)

These models generally follow the form

\[\begin{align*} y_i & \sim \color{#4D6D93}{\operatorname{Some distribution}} (\theta_i, \phi) \\ \color{#4D6D93}{f(\theta_i)} & = \alpha + \beta (x_i - \bar x), \end{align*}\]

where \(\theta_i\) is a parameter of central interest (e.g., the probability of 1 in a Binomial distribution) and \(\phi\) is a placeholder for any other parameters necessary for the likelihood but not typically of primary substantive interest (e.g., \(\sigma\) in conventional Gaussian models). The \(f(\cdot)\) portion is the link function.

Speaking about links,

the

logit linkmaps a parameter that is defined as a probability mass, and therefore constrained to lie between zero and one, onto a linear model that can take on any real value. This link is extremely common when working with binomial GLMs. In the context of a model definition, it looks like this:\[\begin{align*} y_i & \sim \color{#4D6D93}{\operatorname{Binomial}}(n, p_i) \\ \color{#4D6D93}{\operatorname{logit}}(p_i) & = \alpha + \beta x_i \end{align*}\]

And the logit function itself is defined as the

log-odds:\[\operatorname{logit}(p_i) = \log \frac{p_i}{1 - p_i}\]

The “odds” of an event are just the probability it happens divided by the probability it does not happen. So really all that is being stated here is:

\[\log \frac{p_i}{1 - p_i} = \alpha + \beta x_i\]

If we do the final algebraic manipulation on page 317, we can solve for \(p_i\) in terms of the linear model

\[p_i = \frac{\exp (\alpha + \beta x_i)}{1 + \exp (\alpha + \beta x_i)}.\]

As we’ll see later, we will make great use of this formula via the `brms::inv_logit_scaled()`

when making sense of logistic regression models. Now we have that last formula in hand, we can make the data necessary for Figure 10.7.

```
# first, we'll make data for the horizontal lines
<- 0
alpha <- 4
beta
<-
lines tibble(x = seq(from = -1, to = 1, by = .25)) %>%
mutate(`log-odds` = alpha + x * beta,
probability = exp(alpha + x * beta) / (1 + exp(alpha + x * beta)))
# now we're ready to make the primary data
<- 2
beta <-
d tibble(x = seq(from = -1.5, to = 1.5, length.out = 50)) %>%
mutate(`log-odds` = alpha + x * beta,
probability = exp(alpha + x * beta) / (1 + exp(alpha + x * beta)))
# now we make the individual plots
<-
p1 %>%
d ggplot(aes(x = x, y = `log-odds`)) +
geom_hline(data = lines,
aes(yintercept = `log-odds`),
color = ghibli_palette("YesterdayMedium")[6]) +
geom_line(size = 1.5, color = ghibli_palette("YesterdayMedium")[3]) +
coord_cartesian(xlim = c(-1, 1)) +
theme(panel.background = element_rect(fill = ghibli_palette("YesterdayMedium")[5]),
panel.grid = element_blank())
<-
p2 %>%
d ggplot(aes(x = x, y = probability)) +
geom_hline(data = lines,
aes(yintercept = probability),
color = ghibli_palette("YesterdayMedium")[6]) +
geom_line(size = 1.5, color = ghibli_palette("YesterdayMedium")[3]) +
coord_cartesian(xlim = c(-1, 1)) +
theme(panel.background = element_rect(fill = ghibli_palette("YesterdayMedium")[7]),
panel.grid = element_blank())
# finally, we're ready to mash the plots together and behold their nerdy glory
| p2) +
(p1 plot_annotation(subtitle = "The logit link transforms a linear model (left) into a probability (right).")
```

The key lesson for now is just that no regression coefficient, such as \(\beta\), from a GLM ever produces a constant change on the outcome scale. Recall that we defined interaction (Chapter 8) as a situation in which the effect of a predictor depends upon the value of another predictor. Well now every predictor essentially interacts with itself, because the impact of a change in a predictor depends upon the value of the predictor before the change….

The second very common link function is the

log link. This link function maps a parameter that is defined over only positive real values onto a linear model. For example, suppose we want to model the standard deviation \(\sigma\) of a Gaussian distribution so it is a function of a predictor variable \(x\). The parameter \(\sigma\) must be positive, because a standard deviation cannot be negative nor can it be zero. The model might look like:\[\begin{align*} y_i & \sim \operatorname{Normal}(\mu, \color{#0E84B4}{\sigma_i}) \\ \color{#0E84B4}{\log (\sigma_i)} & = \alpha + \beta x_i \end{align*}\]

In this model, the mean \(\mu\) is constant, but the standard deviation scales with the value \(x_i\). (p. 318,

emphasisin the original)

This kind of model is trivial in the **brms** framework, which you can learn more about in Bürkner’s (2021b) vignette, *Estimating distributional models with brms*. Before moving on with the text, let’s detour and see how we might fit such a model. First, we’ll simulate some continuous data `y`

for which the \(SD\) is affected by a dummy variable `x`

.

```
set.seed(10)
(<-
d tibble(x = rep(0:1, each = 100)) %>%
mutate(y = rnorm(n = n(), mean = 100, sd = 10 + x * 10))
)
```

```
## # A tibble: 200 x 2
## x y
## <int> <dbl>
## 1 0 100.
## 2 0 98.2
## 3 0 86.3
## 4 0 94.0
## 5 0 103.
## 6 0 104.
## 7 0 87.9
## 8 0 96.4
## 9 0 83.7
## 10 0 97.4
## # … with 190 more rows
```

These data are based on IQ data. In psychology, general intelligence is often operationalized by and measured with standardized intelligence tests. The results form these tests are often summarized with an a single intelligence quotient (IQ) score, often called the full-scale IQ score. For many years now, the convention within among IQ test developers is to scale full-scale IQ scores so they have a population mean of 100 and a standard deviation of 15. One of the old and continuing controversies in the literature is whether men and women differ not in their means–they don’t–but in their standard deviations (e.g., Johnson et al., 2008). To give a sense of how one might explore such a controversy, we simulated data where the `y`

variables have a mean of 100 and standard deviations of either 10 or 20, depending on one’s status on `x`

. We can view what data like these look like with aid from `tidybayes::stat_halfeye()`

.

```
library(tidybayes)
%>%
d mutate(x = x %>% as.character()) %>%
ggplot(aes(x = y, y = x, fill = x)) +
stat_halfeye(point_interval = mean_qi, .width = .68,
color = ghibli_palette("KikiMedium")[2]) +
scale_fill_manual(values = c(ghibli_palette("KikiMedium")[c(4, 6)])) +
coord_cartesian(ylim = c(1.5, 2)) +
theme(axis.ticks.y = element_blank(),
legend.position = "none",
panel.background = element_rect(fill = ghibli_palette("KikiMedium")[7]),
panel.grid = element_blank())
```

Even though the means of `y`

are the same for both levels of the `x`

dummy, the variance for `x == 1`

is substantially larger than that for `x == 0`

. Let’s open **brms**.

`library(brms)`

For such a model, we have two formulas: one for \(\mu\) and one for \(\sigma\). We wrap both within the `bf()`

function.

```
.1 <-
b10brm(data = d,
family = gaussian,
bf(y ~ 1, sigma ~ 1 + x),
prior = c(prior(normal(100, 5), class = Intercept),
prior(normal(2.70805, 0.5), class = Intercept, dpar = sigma),
prior(normal(0, 0.5), class = b, dpar = sigma)),
seed = 10,
file = "fits/b10.01")
```

Do note our use of the `dpar`

arguments in the `prior()`

functions Here’s the summary.

`print(b10.1)`

```
## Family: gaussian
## Links: mu = identity; sigma = log
## Formula: y ~ 1
## sigma ~ 1 + x
## Data: d (Number of observations: 200)
## Samples: 4 chains, each with iter = 2000; warmup = 1000; thin = 1;
## total post-warmup samples = 4000
##
## Population-Level Effects:
## Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## Intercept 98.57 0.86 96.88 100.26 1.00 3982 2819
## sigma_Intercept 2.26 0.07 2.13 2.41 1.00 3368 2777
## sigma_x 0.69 0.10 0.50 0.88 1.00 4052 3091
##
## Samples were drawn using sampling(NUTS). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).
```

Now we get an intercept for both \(\mu\) and \(\sigma\), with the intercept for sigma labeled as `sigma_Intercept`

. And note the \(\beta\) coefficient for \(\sigma\) was named `sigma_x`

. Also notice the scale the `sigma_i`

coefficients are on. These are not in the original metric, but rather based on a logarithmic transformation of \(\sigma\). You can confirm that by the second line of the `print()`

output: `Links: mu = identity; sigma = log`

. So if you want to get a sense of the effects of `x`

on the \(\sigma\) for `y`

, you have to exponentiate the formula. Here we’ll do so with the `posterior_samples()`

.

```
<- posterior_samples(b10.1)
post head(post)
```

```
## b_Intercept b_sigma_Intercept b_sigma_x lp__
## 1 98.70843 2.240895 0.7359405 -807.6554
## 2 99.25465 2.364534 0.6248927 -809.1533
## 3 99.73125 2.274513 0.7635480 -809.2723
## 4 100.59124 2.363369 0.5976097 -811.1601
## 5 97.55274 2.235885 0.8263562 -809.6148
## 6 98.62746 2.288775 0.6987624 -807.8320
```

With the samples in hand, we’ll use the model formula to compute the model-implied standard deviations of `y`

based on the `x`

dummy and then examine them in a plot.

```
%>%
post mutate(`x == 0` = exp(b_sigma_Intercept + b_sigma_x * 0),
`x == 1` = exp(b_sigma_Intercept + b_sigma_x * 1)) %>%
pivot_longer(contains("==")) %>%
ggplot(aes(x = value, y = name, fill = name)) +
stat_halfeye(point_interval = median_qi, .width = .95,
color = ghibli_palette("KikiMedium")[2]) +
scale_fill_manual(values = c(ghibli_palette("KikiMedium")[c(4, 6)])) +
labs(subtitle = "Model-implied standard deviations by group",
x = expression(sigma[x]),
y = NULL) +
coord_cartesian(ylim = c(1.5, 2)) +
theme(axis.ticks.y = element_blank(),
legend.position = "none",
panel.background = element_rect(fill = ghibli_palette("KikiMedium")[7]),
panel.grid = element_blank())
```

If we looked back at the data, those \(SD\) estimates are right about what we’d expect.

```
%>%
d group_by(x) %>%
summarise(sd = sd(y) %>% round(digits = 1))
```

```
## # A tibble: 2 x 2
## x sd
## <int> <dbl>
## 1 0 9.4
## 2 1 19.4
```

For more on models like this, check out Christakis’s blog post, *2014: What scientific idea is ready for retirement?*, or his paper with Subramanian and Kim, *The “average” treatment effect: A construct ripe for retirement. A commentary on Deaton and Cartwright*, (Subramanian et al., 2018). Kruschke covered modeling \(\sigma\) a bit in his (2015) *Doing Bayesian data analysis, second edition: A tutorial with R, JAGS, and Stan*, my (2020c) translation for which lives here. Finally, this is foreshadowing a bit because it requires the multilevel model (see Chapters 13 and 14), but you might also check out the (2019) preprint by Williams, Liu, Martin, and Rast, *Bayesian multivariate mixed-effects location scale modeling of longitudinal relations among affective traits, states, and physical activity* or Williams’s blog post, *A defining feature of cognitive interference tasks: Heterogeneous within-person variance*.

But getting back to the text,

What the log link effectively assumes is that the parameter’s value is the exponentiation of the linear model. Solving \(\log (\sigma_i) = \alpha + \beta x_i\) for \(\sigma_i\) yields the inverse link:

\[\sigma_i = \exp (\alpha + \beta x_i)\]

The impact of this assumption can be seen in [our version of] Figure 10.8. (pp. 318–319)

```
# first, we'll make data that'll be make the horizontal lines
<- 0
alpha <- 2
beta
<-
lines tibble(`log-measurement` = -3:3,
`original measurement` = exp(-3:3))
# now we're ready to make the primary data
<-
d tibble(x = seq(from = -1.5, to = 1.5, length.out = 50)) %>%
mutate(`log-measurement` = alpha + x * beta,
`original measurement` = exp(alpha + x * beta))
# now we make the individual plots
<-
p1 %>%
d ggplot(aes(x = x, y = `log-measurement`)) +
geom_hline(data = lines,
aes(yintercept = `log-measurement`),
color = ghibli_palette("YesterdayMedium")[6]) +
geom_line(size = 1.5, color = ghibli_palette("YesterdayMedium")[3]) +
coord_cartesian(xlim = c(-1, 1)) +
theme(panel.background = element_rect(fill = ghibli_palette("YesterdayMedium")[5]),
panel.grid = element_blank())
<-
p2 %>%
d ggplot(aes(x = x, y = `original measurement`)) +
geom_hline(data = lines,
aes(yintercept = `original measurement`),
color = ghibli_palette("YesterdayMedium")[6]) +
geom_line(size = 1.5, color = ghibli_palette("YesterdayMedium")[3]) +
scale_y_continuous(position = "right", limits = c(0, 10)) +
coord_cartesian(xlim = c(-1, 1)) +
theme(panel.background = element_rect(fill = ghibli_palette("YesterdayMedium")[7]),
panel.grid = element_blank())
# combine the ggplots
| p2 p1
```

Using a log link for a linear model (left) implies an exponential scaling of the outcome with the predictor variable (right). Another way to think of this relationship is to remember that logarithms are

magnitudes. An increase of one unit on the log scale means an increase of an order of magnitude on the untransformed scale. And this fact is reflected in the widening intervals between the horizontal lines in the right-hand plot of Figure 10.8. (p. 319,emphasisin the original)

#### 10.2.2.1 Rethinking: When in doubt, play with assumptions.

Link functions are assumptions. And like all assumptions, they are useful in different contexts. The conventional logit and log links are widely useful, but they can sometimes distort inference. If you ever have doubts, and want to reassure yourself that your conclusions are not sensitive to choice of link function, then you can use

sensitivity analysis. A sensitivity analysis explores how changes in assumptions influence inference. (p. 319,emphasisin the original)

As an example, a common alternative to the logit link is the probit. Both are available with **brms**.

### 10.2.3 Omitted variable bias again.

Back in Chapters 5 and 6, you saw some examples of omitted variable bias, where leaving a causally important variable out of a model leads to biased inference. The same thing can of course happen in GLMs. But it can be worse in GLMs, because even a variable that isn’t technically a confounder can bias inference, once we have a link function. The reason is that the ceiling and floor effects described above can distort estimates by suppressing the causal influence of a variable. (p. 320)

### 10.2.4 Absolute and relative differences.

Within the context of GLMs with non-identity link functions,

parameter estimates do not by themselves tell you the importance of a predictor on the outcome. The reason is that each parameter represents a

relativedifference on the scale of the linear model, ignoring other parameters, while we are really interested inabsolutedifferences in outcomes that must incorporate all parameters. (p. 320,emphasisin the original)

This will make more sense after we start playing around with logistic regression, count regression, and so on. For now, just file it away.

## Session info

`sessionInfo()`

```
## R version 4.0.4 (2021-02-15)
## Platform: x86_64-apple-darwin17.0 (64-bit)
## Running under: macOS Catalina 10.15.7
##
## Matrix products: default
## BLAS: /Library/Frameworks/R.framework/Versions/4.0/Resources/lib/libRblas.dylib
## LAPACK: /Library/Frameworks/R.framework/Versions/4.0/Resources/lib/libRlapack.dylib
##
## locale:
## [1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
##
## attached base packages:
## [1] stats graphics grDevices utils datasets methods base
##
## other attached packages:
## [1] brms_2.15.0 Rcpp_1.0.6 tidybayes_2.3.1 patchwork_1.1.1 ghibli_0.3.2 forcats_0.5.1
## [7] stringr_1.4.0 dplyr_1.0.5 purrr_0.3.4 readr_1.4.0 tidyr_1.1.3 tibble_3.1.0
## [13] ggplot2_3.3.3 tidyverse_1.3.0
##
## loaded via a namespace (and not attached):
## [1] readxl_1.3.1 uuid_0.1-4 backports_1.2.1 systemfonts_1.0.1
## [5] plyr_1.8.6 igraph_1.2.6 splines_4.0.4 svUnit_1.0.3
## [9] crosstalk_1.1.0.1 TH.data_1.0-10 rstantools_2.1.1 inline_0.3.17
## [13] digest_0.6.27 htmltools_0.5.1.1 rsconnect_0.8.16 fansi_0.4.2
## [17] magrittr_2.0.1 modelr_0.1.8 RcppParallel_5.0.2 matrixStats_0.57.0
## [21] officer_0.3.17 sandwich_3.0-0 xts_0.12.1 prettyunits_1.1.1
## [25] colorspace_2.0-0 rvest_0.3.6 ggdist_2.4.0.9000 haven_2.3.1
## [29] xfun_0.22 callr_3.5.1 crayon_1.4.1 prismatic_0.2.0
## [33] jsonlite_1.7.2 lme4_1.1-25 survival_3.2-7 zoo_1.8-8
## [37] glue_1.4.2 gtable_0.3.0 emmeans_1.5.2-1 V8_3.4.0
## [41] distributional_0.2.2 pkgbuild_1.2.0 rstan_2.21.2 abind_1.4-5
## [45] scales_1.1.1 mvtnorm_1.1-1 DBI_1.1.0 miniUI_0.1.1.1
## [49] xtable_1.8-4 StanHeaders_2.21.0-7 stats4_4.0.4 DT_0.16
## [53] htmlwidgets_1.5.2 httr_1.4.2 threejs_0.3.3 arrayhelpers_1.1-0
## [57] ellipsis_0.3.1 pkgconfig_2.0.3 loo_2.4.1 farver_2.0.3
## [61] dbplyr_2.0.0 utf8_1.1.4 tidyselect_1.1.0 labeling_0.4.2
## [65] rlang_0.4.10 reshape2_1.4.4 later_1.1.0.1 munsell_0.5.0
## [69] cellranger_1.1.0 tools_4.0.4 cli_2.3.1 generics_0.1.0
## [73] broom_0.7.5 ggridges_0.5.2 evaluate_0.14 fastmap_1.0.1
## [77] processx_3.4.5 knitr_1.31 fs_1.5.0 zip_2.1.1
## [81] nlme_3.1-152 mime_0.10 projpred_2.0.2 xml2_1.3.2
## [85] compiler_4.0.4 bayesplot_1.8.0 shinythemes_1.1.2 rstudioapi_0.13
## [89] curl_4.3 gamm4_0.2-6 reprex_0.3.0 statmod_1.4.35
## [93] stringi_1.5.3 highr_0.8 ps_1.6.0 Brobdingnag_1.2-6
## [97] gdtools_0.2.2 lattice_0.20-41 Matrix_1.3-2 nloptr_1.2.2.2
## [101] markdown_1.1 shinyjs_2.0.0 vctrs_0.3.6 pillar_1.5.1
## [105] lifecycle_1.0.0 bridgesampling_1.0-0 estimability_1.3 data.table_1.14.0
## [109] flextable_0.6.4 httpuv_1.5.4 R6_2.5.0 bookdown_0.21
## [113] promises_1.1.1 gridExtra_2.3 codetools_0.2-18 boot_1.3-26
## [117] colourpicker_1.1.0 MASS_7.3-53 gtools_3.8.2 assertthat_0.2.1
## [121] withr_2.4.1 shinystan_2.5.0 multcomp_1.4-16 mgcv_1.8-33
## [125] parallel_4.0.4 hms_0.5.3 grid_4.0.4 coda_0.19-4
## [129] minqa_1.2.4 rmarkdown_2.7 shiny_1.5.0 lubridate_1.7.9.2
## [133] base64enc_0.1-3 dygraphs_1.1.1.6
```