library(alr4)         # for data
library(tidyverse)    # for plotting and summarizing
library(ggridges)     # for ridge plots
library(ggmosaic)     # for mosaic plots
library(moderndive)   # for nice model output
library(infer)        # for making inferences about models
library(broom)        # for nice model output 
library(equatiomatic) # for nice model equations
theme_set(theme_minimal()) #changes the theme of ggplots to theme_minimal, my personal favorite
# Make a small change to the data so that our output shows up as expected.

diamonds <- diamonds %>% 
  mutate(cut = fct_relevel(fct_inorder(cut, ordered = FALSE), 
                           "Fair", "Good", "Very Good", "Premium"))

Let’s look at the diamonds data from the tidyverse library. We are interested in testing if there is a relationship between cut and log(price).

diamonds %>% 
  ggplot(aes(x=cut, y=log(price))) +
  geom_boxplot() +
  theme_minimal()

And we could fit a model:

lm_cut <- lm(log(price) ~ cut, 
              data=diamonds)
tidy(lm_cut)

YOUR TURN!

  • What is the hypothesis in any of the rows testing?

  • Is that what we’re interested in testing?

The hypothesis test we conduct to test the significance of cut overall is:

\[ H_0: \beta_1 = \beta_2 = \beta_3 = \beta_4 = 0 \\ H_a: \text{at least one of the } \beta_i \ne 0 \]

In general, this is called an “F-Test” and is:

\[ H_0: \beta_{k+1} = \beta_{k+2} = ... = \beta_{k+p} = 0 \\ H_a: \text{at least one of the } \beta_i \neq 0, \]

which we can think of as testing if at least one of the variables is “useful” in the model. Notice that this test is a little trickier than the other hypothesis tests we’ve been doing because we’re dealing with more than one coefficient. We’d like to be able to summarize our results to one number in order to compare what we’re seeing in our data to what we’d expect when the null hypothesis is true.

Using “theory”, ie. R output

There is a statistic we can use, \(F\), that has a well-defined theoretical distribution under \(H_0\) (ie. when \(H_0\) is true). I have written its formula below. I will not talk about the detail of it, but notice that it is a function of \(R^2\).

\[ F = \frac{\frac{R^2}{p}}{\frac{1 - R^2}{n-(p+1)}} \]

We can use the anova(), AN(alysis) O(f) VA(riance), function in R to test the desired hypothesis. First, we need the “null” model, which in this case is a model with no variables. The p.value is the p-value for the test we described above. Caution: the two models must be “nested” models in order to use ANOVA. That means that one model is a subset of the other, or that the variables from the smaller model are all in the larger model.

null_mod <- lm(log(price) ~ 1, data = diamonds)

anova(null_mod, lm_cut) %>% tidy()

Using \(R^2\) and simulation

We could also use a simulation method to compute a p-value. One number we could use to summarize the relationship is \(R^2\).

YOUR TURN!

What would you expect the \(R^2\) to be if there were no relationship?

We can extract the \(R^2\) from the model. This is the actual \(R^2\) from our sample of data. I have also saved this into a variable called r_squared_actual.

glance(lm_cut) %>% select(r.squared)
r_squared_actual <- glance(lm_cut) %>% select(r.squared) %>% pull()

Now, just like when we had a quantitative variable, we can break the relationship between cut and log(price). Below is one example. Note that I did NOT set a seed (set.seed) at the top, so you will get a different answer when you run it on your computer. Try running it a few times. What values of \(R^2\) do you see?

mod_no_relationship <- lm(sample(log(price)) ~ cut,
                          data=diamonds)
tidy(mod_no_relationship)
glance(mod_no_relationship) %>% select(r.squared)

Now, let’s use R to help us do this many times (100 seems good enough this time - the intial dataset is big!) and keep track of the \(R^2\) each time. (This takes a bit of time since there’s so much data).

set.seed(100)

r_squared <- diamonds %>% 
  rep_sample_n(size = 53940, 
               replace = FALSE, 
               reps = 100) %>% 
  group_by(replicate) %>% 
  summarize(lm(sample(log(price)) ~ cut) %>% glance()) %>% 
  ungroup() %>% 
  select(replicate, r.squared)

r_squared

Now, let’s plot these in a histogram.

r_squared %>% 
  ggplot(aes(x=r.squared)) +
  geom_histogram(bins = 500) + # do this b/c the actual is so far away
  geom_vline(xintercept = r_squared_actual, color="darkred")

YOUR TURN!

How would you describe the distribution? How could we calculate a p-value?

Adding more variables to the model

Now, what if we want to test the significance of a categorical variable, with other variables already in the model? For example,

lm_more <- lm(log(price) ~ cut + carat,
                 data=diamonds)
tidy(lm_more)

YOUR TURN!

Write out your hypotheses and use the anova() function to conduct the test.

lm_carat <- lm(log(price) ~ carat, data = diamonds)
# add the anova function here
LS0tCnRpdGxlOiAiSHlwb3RoZXNpcyB0ZXN0aW5nIHdpdGggY2F0ZWdvcmljYWwgdmFyaWFibGVzIgpvdXRwdXQ6CiAgaHRtbF9kb2N1bWVudDoKICAgIHRvYzogdHJ1ZQogICAgdG9jX2Zsb2F0OiB0cnVlCiAgICBkZl9wcmludDogcGFnZWQKICAgIGNvZGVfZG93bmxvYWQ6IHRydWUKLS0tCgpgYGB7ciwgbWVzc2FnZT1GQUxTRSwgd2FybmluZz1GQUxTRX0KbGlicmFyeShhbHI0KSAgICAgICAgICMgZm9yIGRhdGEKbGlicmFyeSh0aWR5dmVyc2UpICAgICMgZm9yIHBsb3R0aW5nIGFuZCBzdW1tYXJpemluZwpsaWJyYXJ5KGdncmlkZ2VzKSAgICAgIyBmb3IgcmlkZ2UgcGxvdHMKbGlicmFyeShnZ21vc2FpYykgICAgICMgZm9yIG1vc2FpYyBwbG90cwpsaWJyYXJ5KG1vZGVybmRpdmUpICAgIyBmb3IgbmljZSBtb2RlbCBvdXRwdXQKbGlicmFyeShpbmZlcikgICAgICAgICMgZm9yIG1ha2luZyBpbmZlcmVuY2VzIGFib3V0IG1vZGVscwpsaWJyYXJ5KGJyb29tKSAgICAgICAgIyBmb3IgbmljZSBtb2RlbCBvdXRwdXQgCmxpYnJhcnkoZXF1YXRpb21hdGljKSAjIGZvciBuaWNlIG1vZGVsIGVxdWF0aW9ucwp0aGVtZV9zZXQodGhlbWVfbWluaW1hbCgpKSAjY2hhbmdlcyB0aGUgdGhlbWUgb2YgZ2dwbG90cyB0byB0aGVtZV9taW5pbWFsLCBteSBwZXJzb25hbCBmYXZvcml0ZQpgYGAKCmBgYHtyfQojIE1ha2UgYSBzbWFsbCBjaGFuZ2UgdG8gdGhlIGRhdGEgc28gdGhhdCBvdXIgb3V0cHV0IHNob3dzIHVwIGFzIGV4cGVjdGVkLgoKZGlhbW9uZHMgPC0gZGlhbW9uZHMgJT4lIAogIG11dGF0ZShjdXQgPSBmY3RfcmVsZXZlbChmY3RfaW5vcmRlcihjdXQsIG9yZGVyZWQgPSBGQUxTRSksIAogICAgICAgICAgICAgICAgICAgICAgICAgICAiRmFpciIsICJHb29kIiwgIlZlcnkgR29vZCIsICJQcmVtaXVtIikpCmBgYAoKCkxldCdzIGxvb2sgYXQgdGhlIGBkaWFtb25kc2AgZGF0YSBmcm9tIHRoZSBgdGlkeXZlcnNlYCBsaWJyYXJ5LgpXZSBhcmUgaW50ZXJlc3RlZCBpbiB0ZXN0aW5nIGlmIHRoZXJlIGlzIGEgcmVsYXRpb25zaGlwIGJldHdlZW4gYGN1dGAgYW5kIGBsb2cocHJpY2UpYC4KCmBgYHtyfQpkaWFtb25kcyAlPiUgCiAgZ2dwbG90KGFlcyh4PWN1dCwgeT1sb2cocHJpY2UpKSkgKwogIGdlb21fYm94cGxvdCgpICsKICB0aGVtZV9taW5pbWFsKCkKYGBgCgpBbmQgd2UgY291bGQgZml0IGEgbW9kZWw6CgpgYGB7cn0KbG1fY3V0IDwtIGxtKGxvZyhwcmljZSkgfiBjdXQsIAogICAgICAgICAgICAgIGRhdGE9ZGlhbW9uZHMpCnRpZHkobG1fY3V0KQpgYGAKCjxkaXYgY2xhc3M9ImFsZXJ0IGFsZXJ0LWluZm8iPgogIDxzdHJvbmc+WU9VUiBUVVJOITwvc3Ryb25nPgoKCiogV2hhdCBpcyB0aGUgaHlwb3RoZXNpcyBpbiBhbnkgb2YgdGhlIHJvd3MgdGVzdGluZz8gIAoKKiBJcyB0aGF0IHdoYXQgd2UncmUgaW50ZXJlc3RlZCBpbiB0ZXN0aW5nPwoKPC9kaXY+CgpUaGUgaHlwb3RoZXNpcyB0ZXN0IHdlIGNvbmR1Y3QgdG8gdGVzdCB0aGUgc2lnbmlmaWNhbmNlIG9mIGBjdXRgIG92ZXJhbGwgaXM6CgokJApIXzA6IFxiZXRhXzEgPSBcYmV0YV8yID0gXGJldGFfMyA9IFxiZXRhXzQgPSAwIFxcCkhfYTogXHRleHR7YXQgbGVhc3Qgb25lIG9mIHRoZSB9IFxiZXRhX2kgXG5lIDAKJCQKCkluIGdlbmVyYWwsIHRoaXMgaXMgY2FsbGVkIGFuICJGLVRlc3QiIGFuZCBpczoKCiQkCkhfMDogXGJldGFfe2srMX0gPSBcYmV0YV97aysyfSA9IC4uLiA9IFxiZXRhX3trK3B9ID0gMCBcXApIX2E6IFx0ZXh0e2F0IGxlYXN0IG9uZSBvZiB0aGUgfSBcYmV0YV9pIFxuZXEgMCwKJCQKCndoaWNoIHdlIGNhbiB0aGluayBvZiBhcyB0ZXN0aW5nIGlmIGF0IGxlYXN0IG9uZSBvZiB0aGUgdmFyaWFibGVzIGlzICJ1c2VmdWwiIGluIHRoZSBtb2RlbC4gTm90aWNlIHRoYXQgdGhpcyB0ZXN0IGlzIGEgbGl0dGxlIHRyaWNraWVyIHRoYW4gdGhlIG90aGVyIGh5cG90aGVzaXMgdGVzdHMgd2UndmUgYmVlbiBkb2luZyBiZWNhdXNlIHdlJ3JlIGRlYWxpbmcgd2l0aCBtb3JlIHRoYW4gb25lIGNvZWZmaWNpZW50LiBXZSdkIGxpa2UgdG8gYmUgYWJsZSB0byBzdW1tYXJpemUgb3VyIHJlc3VsdHMgdG8gb25lIG51bWJlciBpbiBvcmRlciB0byBjb21wYXJlIHdoYXQgd2UncmUgc2VlaW5nIGluIG91ciBkYXRhIHRvIHdoYXQgd2UnZCBleHBlY3Qgd2hlbiB0aGUgbnVsbCBoeXBvdGhlc2lzIGlzIHRydWUuCgojIFVzaW5nICJ0aGVvcnkiLCBpZS4gUiBvdXRwdXQKClRoZXJlIGlzIGEgc3RhdGlzdGljIHdlIGNhbiB1c2UsICRGJCwgdGhhdCBoYXMgYSB3ZWxsLWRlZmluZWQgdGhlb3JldGljYWwgZGlzdHJpYnV0aW9uIHVuZGVyICRIXzAkIChpZS4gd2hlbiAkSF8wJCBpcyB0cnVlKS4gSSBoYXZlIHdyaXR0ZW4gaXRzIGZvcm11bGEgYmVsb3cuIEkgd2lsbCBub3QgdGFsayBhYm91dCB0aGUgZGV0YWlsIG9mIGl0LCBidXQgbm90aWNlIHRoYXQgaXQgaXMgYSBmdW5jdGlvbiBvZiAkUl4yJC4gCgokJApGID0gXGZyYWN7XGZyYWN7Ul4yfXtwfX17XGZyYWN7MSAtIFJeMn17bi0ocCsxKX19CiQkCgpXZSBjYW4gdXNlIHRoZSBgYW5vdmEoKWAsIEFOKGFseXNpcykgTyhmKSBWQShyaWFuY2UpLCBmdW5jdGlvbiBpbiBSIHRvIHRlc3QgdGhlIGRlc2lyZWQgaHlwb3RoZXNpcy4gRmlyc3QsIHdlIG5lZWQgdGhlICJudWxsIiBtb2RlbCwgd2hpY2ggaW4gdGhpcyBjYXNlIGlzIGEgbW9kZWwgd2l0aCBubyB2YXJpYWJsZXMuIFRoZSBgcC52YWx1ZWAgaXMgdGhlIHAtdmFsdWUgZm9yIHRoZSB0ZXN0IHdlIGRlc2NyaWJlZCBhYm92ZS4gKipDYXV0aW9uKio6IHRoZSB0d28gbW9kZWxzIG11c3QgYmUgIm5lc3RlZCIgbW9kZWxzIGluIG9yZGVyIHRvIHVzZSBBTk9WQS4gVGhhdCBtZWFucyB0aGF0IG9uZSBtb2RlbCBpcyBhIHN1YnNldCBvZiB0aGUgb3RoZXIsIG9yIHRoYXQgdGhlIHZhcmlhYmxlcyBmcm9tIHRoZSBzbWFsbGVyIG1vZGVsIGFyZSBhbGwgaW4gdGhlIGxhcmdlciBtb2RlbC4KCmBgYHtyfQpudWxsX21vZCA8LSBsbShsb2cocHJpY2UpIH4gMSwgZGF0YSA9IGRpYW1vbmRzKQoKYW5vdmEobnVsbF9tb2QsIGxtX2N1dCkgJT4lIHRpZHkoKQpgYGAKCgojIFVzaW5nICRSXjIkIGFuZCBzaW11bGF0aW9uCgpXZSBjb3VsZCBhbHNvIHVzZSBhIHNpbXVsYXRpb24gbWV0aG9kIHRvIGNvbXB1dGUgYSBwLXZhbHVlLiBPbmUgbnVtYmVyIHdlIGNvdWxkIHVzZSB0byBzdW1tYXJpemUgdGhlIHJlbGF0aW9uc2hpcCBpcyAkUl4yJC4KCjxkaXYgY2xhc3M9ImFsZXJ0IGFsZXJ0LWluZm8iPgogIDxzdHJvbmc+WU9VUiBUVVJOITwvc3Ryb25nPgoKV2hhdCB3b3VsZCB5b3UgZXhwZWN0IHRoZSAkUl4yJCB0byBiZSBpZiB0aGVyZSB3ZXJlIG5vIHJlbGF0aW9uc2hpcD8KCjwvZGl2PgoKCldlIGNhbiBleHRyYWN0IHRoZSAkUl4yJCBmcm9tIHRoZSBtb2RlbC4gVGhpcyBpcyB0aGUgKmFjdHVhbCogJFJeMiQgZnJvbSBvdXIgc2FtcGxlIG9mIGRhdGEuIEkgaGF2ZSBhbHNvIHNhdmVkIHRoaXMgaW50byBhIHZhcmlhYmxlIGNhbGxlZCAqcl9zcXVhcmVkX2FjdHVhbCouCgpgYGB7cn0KZ2xhbmNlKGxtX2N1dCkgJT4lIHNlbGVjdChyLnNxdWFyZWQpCgpyX3NxdWFyZWRfYWN0dWFsIDwtIGdsYW5jZShsbV9jdXQpICU+JSBzZWxlY3Qoci5zcXVhcmVkKSAlPiUgcHVsbCgpCmBgYAoKTm93LCBqdXN0IGxpa2Ugd2hlbiB3ZSBoYWQgYSBxdWFudGl0YXRpdmUgdmFyaWFibGUsIHdlIGNhbiBicmVhayB0aGUgcmVsYXRpb25zaGlwIGJldHdlZW4gYGN1dGAgYW5kIGBsb2cocHJpY2UpYC4gQmVsb3cgaXMgb25lIGV4YW1wbGUuIE5vdGUgdGhhdCBJIGRpZCBOT1Qgc2V0IGEgc2VlZCAoYHNldC5zZWVkYCkgYXQgdGhlIHRvcCwgc28geW91IHdpbGwgZ2V0IGEgZGlmZmVyZW50IGFuc3dlciB3aGVuIHlvdSBydW4gaXQgb24geW91ciBjb21wdXRlci4gVHJ5IHJ1bm5pbmcgaXQgYSBmZXcgdGltZXMuIFdoYXQgdmFsdWVzIG9mICRSXjIkIGRvIHlvdSBzZWU/CgpgYGB7cn0KbW9kX25vX3JlbGF0aW9uc2hpcCA8LSBsbShzYW1wbGUobG9nKHByaWNlKSkgfiBjdXQsCiAgICAgICAgICAgICAgICAgICAgICAgICAgZGF0YT1kaWFtb25kcykKdGlkeShtb2Rfbm9fcmVsYXRpb25zaGlwKQpnbGFuY2UobW9kX25vX3JlbGF0aW9uc2hpcCkgJT4lIHNlbGVjdChyLnNxdWFyZWQpCmBgYAoKTm93LCBsZXQncyB1c2UgUiB0byBoZWxwIHVzIGRvIHRoaXMgbWFueSB0aW1lcyAoMTAwIHNlZW1zIGdvb2QgZW5vdWdoIHRoaXMgdGltZSAtIHRoZSBpbnRpYWwgZGF0YXNldCBpcyBiaWchKSBhbmQga2VlcCB0cmFjayBvZiB0aGUgJFJeMiQgZWFjaCB0aW1lLiAoVGhpcyB0YWtlcyBhIGJpdCBvZiB0aW1lIHNpbmNlIHRoZXJlJ3Mgc28gbXVjaCBkYXRhKS4KCmBgYHtyfQpzZXQuc2VlZCgxMDApCgpyX3NxdWFyZWQgPC0gZGlhbW9uZHMgJT4lIAogIHJlcF9zYW1wbGVfbihzaXplID0gNTM5NDAsIAogICAgICAgICAgICAgICByZXBsYWNlID0gRkFMU0UsIAogICAgICAgICAgICAgICByZXBzID0gMTAwKSAlPiUgCiAgZ3JvdXBfYnkocmVwbGljYXRlKSAlPiUgCiAgc3VtbWFyaXplKGxtKHNhbXBsZShsb2cocHJpY2UpKSB+IGN1dCkgJT4lIGdsYW5jZSgpKSAlPiUgCiAgdW5ncm91cCgpICU+JSAKICBzZWxlY3QocmVwbGljYXRlLCByLnNxdWFyZWQpCgpyX3NxdWFyZWQKYGBgCgoKTm93LCBsZXQncyBwbG90IHRoZXNlIGluIGEgaGlzdG9ncmFtLiAKCmBgYHtyfQpyX3NxdWFyZWQgJT4lIAogIGdncGxvdChhZXMoeD1yLnNxdWFyZWQpKSArCiAgZ2VvbV9oaXN0b2dyYW0oYmlucyA9IDUwMCkgKyAjIGRvIHRoaXMgYi9jIHRoZSBhY3R1YWwgaXMgc28gZmFyIGF3YXkKICBnZW9tX3ZsaW5lKHhpbnRlcmNlcHQgPSByX3NxdWFyZWRfYWN0dWFsLCBjb2xvcj0iZGFya3JlZCIpCmBgYAoKPGRpdiBjbGFzcz0iYWxlcnQgYWxlcnQtaW5mbyI+CiAgPHN0cm9uZz5ZT1VSIFRVUk4hPC9zdHJvbmc+CgpIb3cgd291bGQgeW91IGRlc2NyaWJlIHRoZSBkaXN0cmlidXRpb24/IEhvdyBjb3VsZCB3ZSBjYWxjdWxhdGUgYSBwLXZhbHVlPwoKPC9kaXY+CgojIEFkZGluZyBtb3JlIHZhcmlhYmxlcyB0byB0aGUgbW9kZWwKCk5vdywgd2hhdCBpZiB3ZSB3YW50IHRvIHRlc3QgdGhlIHNpZ25pZmljYW5jZSBvZiBhIGNhdGVnb3JpY2FsIHZhcmlhYmxlLCB3aXRoIG90aGVyIHZhcmlhYmxlcyBhbHJlYWR5IGluIHRoZSBtb2RlbD8gRm9yIGV4YW1wbGUsIAoKYGBge3J9CmxtX21vcmUgPC0gbG0obG9nKHByaWNlKSB+IGN1dCArIGNhcmF0LAogICAgICAgICAgICAgICAgIGRhdGE9ZGlhbW9uZHMpCnRpZHkobG1fbW9yZSkKYGBgCgo8ZGl2IGNsYXNzPSJhbGVydCBhbGVydC1pbmZvIj4KICA8c3Ryb25nPllPVVIgVFVSTiE8L3N0cm9uZz4KCldyaXRlIG91dCB5b3VyIGh5cG90aGVzZXMgYW5kIHVzZSB0aGUgYGFub3ZhKClgIGZ1bmN0aW9uIHRvIGNvbmR1Y3QgdGhlIHRlc3QuIAoKYGBge3J9CmxtX2NhcmF0IDwtIGxtKGxvZyhwcmljZSkgfiBjYXJhdCwgZGF0YSA9IGRpYW1vbmRzKQojIGFkZCB0aGUgYW5vdmEgZnVuY3Rpb24gaGVyZQpgYGAKCjwvZGl2PgoK