Lecture 15
June 5, 2025
Do your team peer evaluations!
Milestone 2 will be graded by tomorrow morning! Pick your data sets ASAP.
Tomorrow we will talk about some project details at the beginning of class - please try to be here!!
Scores will be posted later today.
In class: score out of 70
Take home: score out of 30
Overall midterm grade: add the two scores together!
We will talk about some project stuff! I’ll also try to give teams some time to talk about their proposal feedback. Try to be here!
A single quantitative \(x\) and \(y\)
Population Model:
\[ Y = \beta_0 + \beta_1 X + \epsilon \]
Regression Line:
\[ \hat{Y} = b_0 + b_1 X \]
A single categorical \(x\) and quantitative \(y\)
R creates dummy variables for each level of the categorical predictor
The result has one intercept (predicted \(y\) for baseline level) and one slope for each non-baseline level
We are predicting audience scores using variable imdb_cat with levels low, medium, and high:
\[ \widehat{audience} = 85.1 -45.8 \times low -21.6 \times med \]
Both of these use flipper_length_mm and island to predict body_mass_g:
bm_fl_island_fit <- linear_reg() |>
fit(body_mass_g ~ flipper_length_mm + island, data = penguins)
tidy(bm_fl_island_fit)# A tibble: 4 × 5
term estimate std.error statistic p.value
<chr> <dbl> <dbl> <dbl> <dbl>
1 (Intercept) -4625. 392. -11.8 4.29e-27
2 flipper_length_mm 44.5 1.87 23.9 1.65e-74
3 islandDream -262. 55.0 -4.77 2.75e- 6
4 islandTorgersen -185. 70.3 -2.63 8.84e- 3\[ \begin{aligned} \widehat{body~mass} = -4625 &+ 44.5 \times flipper~length \\ &- 262 \times Dream \\ &- 185 \times Torgersen \end{aligned} \]
\[ \begin{aligned} \widehat{body~mass} = -4625 &+ 44.5 \times flipper~length \\ &- 262 \times Dream \\ &- 185 \times Torgersen \end{aligned} \]
\[ \begin{aligned} \widehat{body~mass} = -4625 &+ 44.5 \times flipper~length \\ &- 262 \times Dream \\ &- 185 \times Torgersen \end{aligned} \]
\[ \begin{aligned} \widehat{body~mass} = -4625 &+ 44.5 \times flipper~length \\ &- 262 \times Dream \\ &- 185 \times Torgersen \end{aligned} \]
\[ \begin{aligned} \widehat{body~mass} = -4625 &+ 44.5 \times flipper~length \\ &- 262 \times Dream \\ &- 185 \times Torgersen \end{aligned} \]
bm_fl_island_int_fit <- linear_reg() |>
fit(body_mass_g ~ flipper_length_mm * island, data = penguins)
tidy(bm_fl_island_int_fit) |> select(term, estimate)# A tibble: 6 × 2
term estimate
<chr> <dbl>
1 (Intercept) -5464.
2 flipper_length_mm 48.5
3 islandDream 3551.
4 islandTorgersen 3218.
5 flipper_length_mm:islandDream -19.4
6 flipper_length_mm:islandTorgersen -17.4\[ \begin{aligned} \widehat{body~mass} = -5464 + 48.5 \times flipper~length &+ 3551 \times Dream \\ &+ 3218 \times Torgersen \\ &- 19.4 \times flipper~length*Dream \\ &- 17.4 \times flipper~length*Torgersen \end{aligned} \]
\[ \begin{aligned} \small\widehat{body~mass} = -5464 &+ 48.5 \times flipper~length \\ &+ 3551 \times Dream \\ &+ 3218 \times Torgersen \\ &- 19.4 \times flipper~length*Dream \\ &- 17.4 \times flipper~length*Torgersen \end{aligned} \]
If penguin is from Biscoe, Dream = 0 and Torgersen = 0:
\[ \begin{aligned} \widehat{body~mass} = -5464 &+ 48.5 \times flipper~length \end{aligned} \]
\[ \begin{aligned} \small\widehat{body~mass} = -5464 &+ 48.5 \times flipper~length \\ &+ 3551 \times Dream \\ &+ 3218 \times Torgersen \\ &- 19.4 \times flipper~length*Dream \\ &- 17.4 \times flipper~length*Torgersen \end{aligned} \]
If penguin is from Dream, Dream = 1 and Torgersen = 0:
\[ \begin{aligned} \widehat{body~mass} &= (-5464 + 3551) + (48.5-19.4) \times flipper~length\\ &=-1913+29.1\times flipper~length. \end{aligned} \]
\[ \begin{aligned} \small\widehat{body~mass} = -5464 &+ 48.5 \times flipper~length \\ &+ 3551 \times Dream \\ &+ 3218 \times Torgersen \\ &- 19.4 \times flipper~length*Dream \\ &- 17.4 \times flipper~length*Torgersen \end{aligned} \] If penguin is from Torgersen, Dream = 0 and Torgersen = 1:
We can interpret each of the lines just as we would a simple linear regression, keeping in mind that we are only looking at penguins from one specific island.
Dream Penguins: \(\widehat{body~mass} = -1913 + 29.1 \times flipper~length\)
new_penguin <- tibble(
flipper_length_mm = 200,
island = "Torgersen"
)
predict(bm_fl_island_int_fit, new_data = new_penguin)# A tibble: 1 × 1
.pred
<dbl>
1 3980.\[ \widehat{body~mass} = (-5464 + 3218) + (48.5-17.4) \times 200. \]
This, we have done. It is what R naturally does when we use color = island!
This, we have not! Here, we use the predicted y values (attained using augment) from an additive model in geom_smooth().
# Fit Model and use Augment
bm_fl_island_fit <- linear_reg() |>
fit(body_mass_g ~ flipper_length_mm + island, data = penguins)
bm_fl_island_aug <- augment(bm_fl_island_fit, new_data = penguins)
# Additive model
ggplot(
bm_fl_island_aug,
aes(x = flipper_length_mm, y = body_mass_g, color = island)
) +
geom_point(alpha = 0.5) +
geom_smooth(aes(y = .pred), method = "lm") +
labs(
title = "Plot A - Additive model",
x = "Flipper Length (mm)",
y = "Body Mass (g)",
color = "Island"
) +
theme(
legend.position = "bottom",
plot.title = element_text(size = 18, face = "bold"),
axis.title = element_text(size = 16),
axis.text = element_text(size = 14),
legend.title = element_text(size = 14),
legend.text = element_text(size = 12)
)What if we want to use multiple numerical predictors to model a numerical outcome?
Example:
Using flipper length and bill length to predict body mass.
Using Rotten Tomato critic score + metacritic score to predict audience score
So many more!!
bm_fl_bl_fit <- linear_reg() |>
fit(body_mass_g ~ flipper_length_mm * bill_length_mm, data = penguins)
tidy(bm_fl_bl_fit)# A tibble: 4 × 5
term estimate std.error statistic p.value
<chr> <dbl> <dbl> <dbl> <dbl>
1 (Intercept) 5091. 2925. 1.74 8.27e-2
2 flipper_length_mm -7.31 15.0 -0.486 6.27e-1
3 bill_length_mm -229. 63.4 -3.61 3.47e-4
4 flipper_length_mm:bill_length_… 1.20 0.322 3.72 2.32e-4\[ \small\widehat{body~mass}=-5736+48.1\times flipper~length+6\times bill~length \]
\[ \small\widehat{body~mass}=-5736+48.1\times flipper~length+6\times bill~length \]
This is how we interpret additive models with as many predictors as we want!
new_penguin <- tibble(
flipper_length_mm = 200,
bill_length_mm = 45
)
predict(bm_fl_bl_fit, new_data = new_penguin)# A tibble: 1 × 1
.pred
<dbl>
1 4112.\[ \widehat{body~mass}=-5736+48.1\times 200+6\times 45 \]
2 predictors + 1 response = 3 dimensions. Ick!
Instead of a line of best fit, it’s a plane of best fit. Double ick!
bm_fl_bl_int_fit <- linear_reg() |>
fit(body_mass_g ~ flipper_length_mm * bill_length_mm, data = penguins)
tidy(bm_fl_bl_int_fit)# A tibble: 4 × 5
term estimate std.error statistic p.value
<chr> <dbl> <dbl> <dbl> <dbl>
1 (Intercept) 5091. 2925. 1.74 8.27e-2
2 flipper_length_mm -7.31 15.0 -0.486 6.27e-1
3 bill_length_mm -229. 63.4 -3.61 3.47e-4
4 flipper_length_mm:bill_length_… 1.20 0.322 3.72 2.32e-4\[ \begin{aligned} \small \widehat{body~mass} =\;& 5090.5 - 7.3 \times flipper \\ &- 229.2 \times bill \\ &+ 1.2 \times flipper \times bill \end{aligned} \]
flipper and bill. But now we also have an interaction term.
