Chapter 7 Statistical Foundations

Samples and Populations

library(pacman)
p_load(mdsr, nycflights13, tidyverse)

Recall the flights dataframe.

flights

Get all of the flights to SF and take a sample of 25 of them.

Note that I did not set a seed for the sample, so your answers will differ from what is in the book.

SF <- flights %>% 
  filter(dest == "SFO", !is.na(arr_delay))
SF

  
Sample25 <- SF %>%
  sample_n(size = 25)
Sample25

Sample25 %>% favstats(~ arr_delay, data = .)

SF %>% favstats(~ arr_delay, data = .)

Sample25 %>% qdata(~arr_delay, p = 0.98, data = .)

       p quantile 
    0.98   158.12 

SF %>% tally(~ arr_delay < 90, data = ., format = "proportion")

arr_delay < 90
      TRUE      FALSE 
0.95141577 0.04858423 

SF %>% qdata(~ arr_delay, p = 0.98, data = .)

       p quantile 
    0.98   153.00 

Sample Statistics

The sampling distribution.

n <- 25
SF %>% sample_n(size=n, replace = FALSE) %>%
  summarize(mean(arr_delay))

SF %>% sample_n(size=n, replace = FALSE) %>%
  summarize(mean(arr_delay))

Trials <- do(500)*
  mean( ~ arr_delay, data = sample_n(SF, size = n, replace = TRUE))
Trials

Trials %>% favstats(~ mean, data = .)

Confidence intervals

mean(~ mean, data = Trials) + 2*sd(~ mean, data = Trials)*c(-1,1)

[1] -17.19053  22.00797

Using a larger sample size.

n <- 100
Trials_100 <- do(500)*
  mean( ~ arr_delay, data = sample_n(SF, size = n, replace = TRUE))
Trials_100

Plots to compare the sampling distributions with different sample sizes.

rbind(Trials %>% mutate(n=25), Trials_100 %>% mutate(n=100)) %>%
  ggplot(aes(x = mean)) +
  geom_histogram(bins = 30) +
  facet_grid(~ n) +
  xlab("Sample mean")

Boostrap

Small <- SF %>% sample_n(size = 3, replace = FALSE)
Small

Small <- SF %>% sample_n(size = 3, replace = TRUE)
Small

n <- 200
Orig_sample <- SF %>% sample_n(size = n, replace = FALSE)
Orig_sample

Orig_sample %>% sample_n(size=n, replace = TRUE) %>%
  summarize(mean(arr_delay))

Boostrap_trials <- do(500)*
  mean(~ arr_delay, data = sample_n(Orig_sample, size = n, replace = TRUE))
       
Boostrap_trials %>% favstats(~ mean, data = .)

Trials_200 <- do(500)*
  mean(~ arr_delay, data = sample_n(SF, size = n, replace = FALSE))
       
Trials_200 %>% favstats(~ mean, data = .)

Orig_sample %>% qdata( ~arr_delay, p = 0.98, data = .)

       p quantile 
    0.98   187.18 

Bootstrap_trials <- do(500)*
  qdata(~arr_delay, p = 0.98, data = sample_n(Orig_sample, size = n, replace = TRUE))
Bootstrap_trials %>% favstats(~ quantile, data = .)

Bootstrap_trials <- do(10000)*
  qdata(~arr_delay, p = 0.98, data = sample_n(Orig_sample, size = n, replace = TRUE))
Bootstrap_trials %>% favstats(~ quantile, data = .)

outliers

SF %>% filter(arr_delay >= 420) %>%
  select(month, day, dep_delay, arr_delay, carrier)

SF %>% mutate(long_delay = arr_delay > 60) %>%
  tally(~ long_delay | month, data = .)

          month
long_delay    1    2    3    4    5    6    7    8    9   10   11   12
     TRUE    29   21   61  112   65  209  226   96   65   36   51   66
     FALSE  856  741  812  993 1128  980  966 1159 1124 1177 1107 1093

SF %>% mutate(long_delay = arr_delay > 60) %>%
  tally(~ long_delay | carrier, data = .)

          carrier
long_delay   AA   B6   DL   UA   VX
     TRUE   148   86   91  492  220
     FALSE 1250  934 1757 6236 1959