Introduction

In this lab, you will investigate the ways in which the statistics from a random sample of data can serve as point estimates for population parameters. We’re interested in formulating a sampling distribution of our estimate in order to learn about the properties of the estimate, such as its distribution.

Setting a seed: We will take some random samples and build sampling distributions in this lab, which means you should set a seed at the start of your lab. If this concept is new to you, review the lab on probability.

Libraries

set.seed(199)
library(tidyverse)
## ── Attaching packages ─────────────────────────────────────── tidyverse 1.3.2 ──
## ✔ ggplot2 3.4.1     ✔ purrr   0.3.4
## ✔ tibble  3.1.7     ✔ dplyr   1.0.9
## ✔ tidyr   1.2.0     ✔ stringr 1.4.0
## ✔ readr   2.1.2     ✔ forcats 0.5.1
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
library(openintro)
## Loading required package: airports
## Loading required package: cherryblossom
## Loading required package: usdata
library(infer)

Exervise 1

Describe the distribution of responses in this sample. How does it compare to the distribution of responses in the population. Hint: Although the sample_n function takes a random sample of observations (i.e. rows) from the dataset, you can still refer to the variables in the dataset with the same names. Code you presented earlier for visualizing and summarizing the population data will still be useful for the sample, however be careful to not label your proportion p since you’re now calculating a sample statistic, not a population parameters. You can customize the label of the statistics to indicate that it comes from the sample.

global_monitor <- tibble(
  scientist_work = c(rep("Benefits", 80000), rep("Doesn't benefit", 20000))
)
samp1 <- global_monitor %>%
  sample_n(50)
ggplot(samp1, aes(x = scientist_work)) +
  geom_bar() +
  labs(
    x = "", y = "",
    title = "A smaller pop  sample of the Question:"
  ) +
  coord_flip() 

samp1 %>%
  count(scientist_work) %>%
  mutate(samp_le = n /sum(n))
## # A tibble: 2 × 3
##   scientist_work      n samp_le
##   <chr>           <int>   <dbl>
## 1 Benefits           42    0.84
## 2 Doesn't benefit     8    0.16

The distribution of responses in this sample is rather skewed toward people who believe that the work scientists does benefits the people.Compared to the larger data of global_monitor I say the sample proportion turns out to be a pretty good estimate of the true population proportion

Exervise 2

Would you expect the sample proportion to match the sample proportion of another student’s sample? Why, or why not? If the answer is no, would you expect the proportions to be somewhat different or very different? Ask a student team to confirm your answer.

samp1 %>%
  count(scientist_work) %>%
  mutate(p_hat = n /sum(n))
## # A tibble: 2 × 3
##   scientist_work      n p_hat
##   <chr>           <int> <dbl>
## 1 Benefits           42  0.84
## 2 Doesn't benefit     8  0.16

I don’t expect the sample proportion to match the sample proportion of another’s student sample since because the sample is truly random and there could be an opportunity where a student can have more “benefits” in their table compared to other students.

Exervise 3

Take a second sample, also of size 50, and call it samp2. How does the sample proportion of samp2 compare with that of samp1? Suppose we took two more samples, one of size 100 and one of size 1000. Which would you think would provide a more accurate estimate of the population proportion? 

samp2 <- global_monitor %>%
  sample_n(50) 

samp2 %>%
  count(scientist_work) %>%
  mutate(p_hat_ = n /sum(n))
## # A tibble: 2 × 3
##   scientist_work      n p_hat_
##   <chr>           <int>  <dbl>
## 1 Benefits           42   0.84
## 2 Doesn't benefit     8   0.16

The sample proportion of samp2 is pretty smiliar to samp1 where there are more benefits than doesn’t benefits. In this sample there are a bit more doesn’t benefits than in samp1.I think a size of 1000 would provide a more accurate measurement since we are counting more people and distribution would align more with the data.

Exervise 4

How many elements are there in sample_props50? Describe the sampling distribution, and be sure to specifically note its center. Make sure to include a plot of the distribution in your answer.

sample_props50 <- global_monitor %>%
                    rep_sample_n(size = 50, reps = 15000, replace = TRUE) %>%
                    count(scientist_work) %>%
                    mutate(p_hat = n /sum(n)) %>%
                    filter(scientist_work == "Doesn't benefit")
ggplot(data = sample_props50, aes(x = p_hat)) +
  geom_histogram(binwidth = 0.02) +
  labs(
    x = "p_hat (Doesn't benefit)",
    title = "Sampling distribution of p_hat",
    subtitle = "Sample size = 50, Number of samples = 15000"
  )

According to the histogram above, approx 2000 elements in the graph. The sampling distribution is symmetric with no skew there is a prominent center at 0.2 or 20%.

Exervise 5

To make sure you understand how sampling distributions are built, and exactly what the rep_sample_n function does, try modifying the code to create a sampling distribution of 25 sample proportions from samples of size 10, and put them in a data frame named sample_props_small. Print the output. How many observations are there in this object called sample_props_small? What does each observation represent?

sample_props_small <- global_monitor %>%
                    rep_sample_n(size = 10, reps = 25, replace = TRUE) %>%
                    count(scientist_work) %>%
                    mutate(p_hat = n /sum(n)) %>%
                    filter(scientist_work == "Doesn't benefit")

sample_props_small
## # A tibble: 23 × 4
## # Groups:   replicate [23]
##    replicate scientist_work      n p_hat
##        <int> <chr>           <int> <dbl>
##  1         1 Doesn't benefit     2   0.2
##  2         3 Doesn't benefit     1   0.1
##  3         4 Doesn't benefit     4   0.4
##  4         5 Doesn't benefit     6   0.6
##  5         6 Doesn't benefit     2   0.2
##  6         7 Doesn't benefit     1   0.1
##  7         8 Doesn't benefit     1   0.1
##  8         9 Doesn't benefit     1   0.1
##  9        11 Doesn't benefit     6   0.6
## 10        12 Doesn't benefit     1   0.1
## # … with 13 more rows

There are 25 observation in sample_props_small, each observation represents a proportion of response in each sample that believes that scientists doesn’t benefit them

Exervise 6

Use the app below to create sampling distributions of proportions of Doesn’t benefit from samples of size 10, 50, and 100. Use 5,000 simulations. What does each observation in the sampling distribution represent? How does the mean, standard error, and shape of the sampling distribution change as the sample size increases? How (if at all) do these values change if you increase the number of simulations? (You do not need to include plots in your answer.)

## samples of size 10 of 5000 simulations
set.seed(1)
sample_props_small1 <- global_monitor %>%
                    rep_sample_n(size = 10, reps = 5000, replace = TRUE) %>%
                    count(scientist_work) %>%
                    mutate(p_hat = n /sum(n)) %>%
                    filter(scientist_work == "Doesn't benefit")

sample_props_small1
## # A tibble: 4,486 × 4
## # Groups:   replicate [4,486]
##    replicate scientist_work      n p_hat
##        <int> <chr>           <int> <dbl>
##  1         2 Doesn't benefit     4   0.4
##  2         3 Doesn't benefit     5   0.5
##  3         4 Doesn't benefit     1   0.1
##  4         5 Doesn't benefit     2   0.2
##  5         6 Doesn't benefit     1   0.1
##  6         7 Doesn't benefit     2   0.2
##  7         8 Doesn't benefit     1   0.1
##  8         9 Doesn't benefit     3   0.3
##  9        10 Doesn't benefit     2   0.2
## 10        11 Doesn't benefit     1   0.1
## # … with 4,476 more rows
set.seed(2)
## samples of size 50 of 5000 simulations
sample_props_small2 <- global_monitor %>%
                    rep_sample_n(size = 50, reps = 5000, replace = TRUE) %>%
                    count(scientist_work) %>%
                    mutate(p_hat = n /sum(n)) %>%
                    filter(scientist_work == "Doesn't benefit")

sample_props_small2
## # A tibble: 5,000 × 4
## # Groups:   replicate [5,000]
##    replicate scientist_work      n p_hat
##        <int> <chr>           <int> <dbl>
##  1         1 Doesn't benefit     8  0.16
##  2         2 Doesn't benefit     9  0.18
##  3         3 Doesn't benefit    13  0.26
##  4         4 Doesn't benefit     5  0.1 
##  5         5 Doesn't benefit    10  0.2 
##  6         6 Doesn't benefit    16  0.32
##  7         7 Doesn't benefit     8  0.16
##  8         8 Doesn't benefit     9  0.18
##  9         9 Doesn't benefit    10  0.2 
## 10        10 Doesn't benefit     6  0.12
## # … with 4,990 more rows
## samples of size 100 of 5000 simulations
set.seed(3)
sample_props_small3 <- global_monitor %>%
                    rep_sample_n(size = 100, reps = 5000, replace = TRUE) %>%
                    count(scientist_work) %>%
                    mutate(p_hat = n /sum(n)) %>%
                    filter(scientist_work == "Doesn't benefit")

sample_props_small3
## # A tibble: 5,000 × 4
## # Groups:   replicate [5,000]
##    replicate scientist_work      n p_hat
##        <int> <chr>           <int> <dbl>
##  1         1 Doesn't benefit    26  0.26
##  2         2 Doesn't benefit    17  0.17
##  3         3 Doesn't benefit    16  0.16
##  4         4 Doesn't benefit    20  0.2 
##  5         5 Doesn't benefit    22  0.22
##  6         6 Doesn't benefit    17  0.17
##  7         7 Doesn't benefit    18  0.18
##  8         8 Doesn't benefit    22  0.22
##  9         9 Doesn't benefit    19  0.19
## 10        10 Doesn't benefit    24  0.24
## # … with 4,990 more rows

I set a seed for each individual simulation since the values were constantly changing, each observation represents each a proportion of people in each sample that believes that scientists doesn’t benefit them personally. Acoording to the data when the sample size of the sampling distribution increases they seem to converge closer around the true population proportion of around 0.26 and the standard error is smaller compared to the sample size of 10. So the bigger the sample the more accurate our data becomes.

Exervise 7

Take a sample of size 15 from the population and calculate the proportion of people in this sample who think the work scientists do enhances their lives. Using this sample, what is your best point estimate of the population proportion of people who think the work scientists do enchances their lives? 

set.seed(4)
samp3 <- global_monitor %>%
  sample_n(15)

samp3 %>%
  count(scientist_work) %>%
  mutate(sam = n/sum(n))
## # A tibble: 2 × 3
##   scientist_work      n    sam
##   <chr>           <int>  <dbl>
## 1 Benefits           14 0.933 
## 2 Doesn't benefit     1 0.0667

According to the sample, over 93% of people think that the work scientists does benefit them everyday. My best point estimate of the population proportion would be that the true proportion would be around 80 to 85%

Exervise 8

Since you have access to the population, simulate the sampling distribution of proportion of those who think the work scientists do enchances their lives for samples of size 15 by taking 2000 samples from the population of size 15 and computing 2000 sample proportions. Store these proportions in as sample_props15. Plot the data, then describe the shape of this sampling distribution. Based on this sampling distribution, what would you guess the true proportion of those who think the work scientists do enchances their lives to be? Finally, calculate and report the population proportion.

sample_props15 <- global_monitor %>%
                    rep_sample_n(size = 15, reps = 2000, replace = TRUE) %>%
                    count(scientist_work) %>%
                    mutate(p_hat = n /sum(n)) %>%
                    filter(scientist_work == "Benefits")

sample_props15
## # A tibble: 2,000 × 4
## # Groups:   replicate [2,000]
##    replicate scientist_work     n p_hat
##        <int> <chr>          <int> <dbl>
##  1         1 Benefits          11 0.733
##  2         2 Benefits          13 0.867
##  3         3 Benefits          12 0.8  
##  4         4 Benefits          12 0.8  
##  5         5 Benefits          13 0.867
##  6         6 Benefits          15 1    
##  7         7 Benefits          14 0.933
##  8         8 Benefits          13 0.867
##  9         9 Benefits          12 0.8  
## 10        10 Benefits          13 0.867
## # … with 1,990 more rows
ggplot(data = sample_props15, aes(x = p_hat)) +
  geom_histogram(binwidth = 0.02) +
  labs(
    x = "p_hat (Benefits)",
    title = "Sampling distribution of population proportion",
    subtitle = "Sample size = 15, Number of samples = 2000"
  )

mean(sample_props15$p_hat)
## [1] 0.8038667

According to the average of p_hat about 80% of the population truly believe that scientists do enhance their everyday lives.

Exervise 9

Change your sample size from 15 to 150, then compute the sampling distribution using the same method as above, and store these proportions in a new object called sample_props150. Describe the shape of this sampling distribution and compare it to the sampling distribution for a sample size of 15. Based on this sampling distribution, what would you guess to be the true proportion of those who think the work scientists do enchances their lives?

sample_props150 <- global_monitor %>%
                    rep_sample_n(size = 150, reps = 2000, replace = TRUE) %>%
                    count(scientist_work) %>%
                    mutate(p_hat = n /sum(n)) %>%
                    filter(scientist_work == "Benefits") 
sample_props150
## # A tibble: 2,000 × 4
## # Groups:   replicate [2,000]
##    replicate scientist_work     n p_hat
##        <int> <chr>          <int> <dbl>
##  1         1 Benefits         121 0.807
##  2         2 Benefits         123 0.82 
##  3         3 Benefits         113 0.753
##  4         4 Benefits         119 0.793
##  5         5 Benefits         120 0.8  
##  6         6 Benefits         126 0.84 
##  7         7 Benefits         118 0.787
##  8         8 Benefits         124 0.827
##  9         9 Benefits         127 0.847
## 10        10 Benefits         118 0.787
## # … with 1,990 more rows
ggplot(data = sample_props150, aes(x = p_hat)) +
  geom_histogram(binwidth = 0.02) +
  labs(
    x = "p_hat (Benefits)",
    title = "Sampling distribution of population proportion",
    subtitle = "Sample size = 150, Number of samples = 2000"
  )

mean(sample_props150$p_hat)
## [1] 0.80095

The data looks symmetrical and there are no skews like the graph in exercise 8 and calculating the mean to find proportion population we can see that it is around 80% again.

Exervise 10

Of the sampling distributions from 2 and 3, which has a smaller spread? If you’re concerned with making estimates that are more often close to the true value, would you prefer a sampling distribution with a large or small spread?

Looking at the chart I would say that chart 2 has a smaller spread because it would be easier to work with smaller samples and that smaller samples in general would gives us a more accurate representation of the population proportion