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.
In this lab, we will explore and visualize the data using the tidyverse suite of packages. We will also use the infer package for resampling.
Let’s load the packages.
library(tidyverse)
library(openintro)
library(infer)
library(tidyverse)
library(openintro)
library(infer) # Needed for resampling
library(shiny) # Needed for the shiny app
A 2019 Gallup report states the following:
The premise that scientific progress benefits people has been embodied in discoveries throughout the ages – from the development of vaccinations to the explosion of technology in the past few decades, resulting in billions of supercomputers now resting in the hands and pockets of people worldwide. Still, not everyone around the world feels science benefits them personally.
The Wellcome Global Monitor finds that 20% of people globally do not believe that the work scientists do benefits people like them. In this lab, you will assume this 20% is a true population proportion and learn about how sample proportions can vary from sample to sample by taking smaller samples from the population. We will first create our population assuming a population size of 100,000. This means 20,000 (20%) of the population think the work scientists do does not benefit them personally and the remaining 80,000 think it does.
global_monitor <- tibble(
scientist_work = c(rep("Benefits", 80000), rep("Doesn't benefit", 20000))
)
head(global_monitor)
## # A tibble: 6 x 1
## scientist_work
## <chr>
## 1 Benefits
## 2 Benefits
## 3 Benefits
## 4 Benefits
## 5 Benefits
## 6 Benefits
The name of the data frame is global_monitor
and the name of the variable that contains responses to the question “Do you believe that the work scientists do benefit people like you?” is scientist_work
.
We can quickly visualize the distribution of these responses using a bar plot.
ggplot(global_monitor, aes(x = scientist_work)) +
geom_bar() +
labs(
x = "", y = "",
title = "Do you believe that the work scientists do benefit people like you?"
) +
coord_flip()
We can also obtain summary statistics to confirm we constructed the data frame correctly.
global_monitor %>%
count(scientist_work) %>%
mutate(p = n /sum(n))
## # A tibble: 2 x 3
## scientist_work n p
## <chr> <int> <dbl>
## 1 Benefits 80000 0.8
## 2 Doesn't benefit 20000 0.2
In this lab, you have access to the entire population, but this is rarely the case in real life. Gathering information on an entire population is often extremely costly or impossible. Because of this, we often take a sample of the population and use that to understand the properties of the population.
If you are interested in estimating the proportion of people who don’t think the work scientists do benefits them, you can use the sample_n
command to survey the population.
samp1 <- global_monitor %>%
sample_n(50)
This command collects a simple random sample of size 50 from the global_monitor
dataset, and assigns the result to samp1
. This is similar to randomly drawing names from a hat that contains the names of all in the population. Working with these 50 names is considerably simpler than working with all 100,000 people in the population.
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.If you’re interested in estimating the proportion of all people who do not believe that the work scientists do benefits them, but you do not have access to the population data, your best single guess is the sample mean.
The proportion of people in the sample who don’t believe Science benefits them is 20% which is same as the total dataset’s 20%.
global_monitor %>%
count(scientist_work) %>%
mutate(p = n /sum(n))
## # A tibble: 2 x 3
## scientist_work n p
## <chr> <int> <dbl>
## 1 Benefits 80000 0.8
## 2 Doesn't benefit 20000 0.2
set.seed(3345)
samp1 <- global_monitor %>%
sample_n(50)
samp1
## # A tibble: 50 x 1
## scientist_work
## <chr>
## 1 Benefits
## 2 Benefits
## 3 Benefits
## 4 Benefits
## 5 Benefits
## 6 Benefits
## 7 Benefits
## 8 Benefits
## 9 Benefits
## 10 Benefits
## # ... with 40 more rows
# For use inline below
samp1_p_hat <- samp1 %>%
count(scientist_work) %>%
mutate(p_hat = n /sum(n)) %>%
filter(scientist_work == "Doesn't benefit") %>%
pull(p_hat) %>%
round(2)
samp1_p_hat
## [1] 0.2
ggplot(samp1, aes(x = scientist_work)) +
geom_bar() +
labs(
x = "", y = "",
title = "Do you believe that the work scientists do benefit people like you?"
) +
coord_flip()
Depending on which 50 people you selected, your estimate could be a bit above or a bit below the true population proportion of 0.2. In general, though, the sample proportion turns out to be a pretty good estimate of the true population proportion, and you were able to get it by sampling less than 1% of the population.
I don’t expect the sample proportion to match the sample proportion of another’s student sample.Sample is truly random and there could be an opportunity where a student can have more “benefits” in their table compared to other students.
samp1 %>%
count(scientist_work) %>%
mutate(p_hat = n /sum(n))
## # A tibble: 2 x 3
## scientist_work n p_hat
## <chr> <int> <dbl>
## 1 Benefits 40 0.8
## 2 Doesn't benefit 10 0.2
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?# Create a second sample
set.seed(3345)
samp2 <- global_monitor %>%
sample_n(50)
samp2_p_hat <- samp2 %>%
count(scientist_work) %>%
mutate(p_hat = n /sum(n)) %>%
filter(scientist_work == "Doesn't benefit") %>%
pull(p_hat) %>%
round(2)
samp2_p_hat
## [1] 0.2
ggplot(samp2, aes(x = scientist_work)) +
geom_bar() +
labs(
x = "", y = "",
title = "Do you believe that the work scientists do benefit people like you?"
) +
coord_flip()
samp2 %>%
count(scientist_work) %>%
mutate(p = n /sum(n))
## # A tibble: 2 x 3
## scientist_work n p
## <chr> <int> <dbl>
## 1 Benefits 40 0.8
## 2 Doesn't benefit 10 0.2
# Create a second sample
set.seed(3345)
samp3 <- global_monitor %>%
sample_n(100)
samp3_p_hat <- samp3 %>%
count(scientist_work) %>%
mutate(p_hat = n /sum(n)) %>%
filter(scientist_work == "Doesn't benefit") %>%
pull(p_hat) %>%
round(2)
samp3_p_hat
## [1] 0.15
Not surprisingly, every time you take another random sample, you might get a different sample proportion. It’s useful to get a sense of just how much variability you should expect when estimating the population mean this way. The distribution of sample proportions, called the sampling distribution (of the proportion), can help you understand this variability. In this lab, because you have access to the population, you can build up the sampling distribution for the sample proportion by repeating the above steps many times. Here, we use R to take 15,000 different samples of size 50 from the population, calculate the proportion of responses in each sample, filter for only the Doesn’t benefit responses, and store each result in a vector called sample_props50
. Note that we specify that replace = TRUE
since sampling distributions are constructed by sampling with replacement.
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.The sampling distribution is symmetric with no skew there is a prominent center at 0.2 or 20%.
set.seed(3345)
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")
And we can visualize the distribution of these proportions with a histogram.
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"
)
Next, you will review how this set of code works.
The idea behind the rep_sample_n
function is repetition. Earlier, you took a single sample of size n
(50) from the population of all people in the population. With this new function, you can repeat this sampling procedure rep
times in order to build a distribution of a series of sample statistics, which is called the sampling distribution.
Note that in practice one rarely gets to build true sampling distributions, because one rarely has access to data from the entire population.
Without the rep_sample_n
function, this would be painful. We would have to manually run the following code 15,000 times
global_monitor %>%
sample_n(size = 50, replace = TRUE) %>%
count(scientist_work) %>%
mutate(p_hat = n /sum(n)) %>%
filter(scientist_work == "Doesn't benefit")
## # A tibble: 1 x 3
## scientist_work n p_hat
## <chr> <int> <dbl>
## 1 Doesn't benefit 9 0.18
as well as store the resulting sample proportions each time in a separate vector.
Note that for each of the 15,000 times we computed a proportion, we did so from a different sample!
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?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
set.seed(3345)
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: 20 x 4
## # Groups: replicate [20]
## replicate scientist_work n p_hat
## <int> <chr> <int> <dbl>
## 1 2 Doesn't benefit 3 0.3
## 2 3 Doesn't benefit 2 0.2
## 3 4 Doesn't benefit 1 0.1
## 4 5 Doesn't benefit 4 0.4
## 5 6 Doesn't benefit 3 0.3
## 6 8 Doesn't benefit 1 0.1
## 7 9 Doesn't benefit 1 0.1
## 8 11 Doesn't benefit 3 0.3
## 9 12 Doesn't benefit 3 0.3
## 10 13 Doesn't benefit 4 0.4
## 11 14 Doesn't benefit 2 0.2
## 12 15 Doesn't benefit 1 0.1
## 13 17 Doesn't benefit 1 0.1
## 14 18 Doesn't benefit 1 0.1
## 15 19 Doesn't benefit 2 0.2
## 16 20 Doesn't benefit 4 0.4
## 17 21 Doesn't benefit 3 0.3
## 18 22 Doesn't benefit 1 0.1
## 19 23 Doesn't benefit 3 0.3
## 20 24 Doesn't benefit 4 0.4
ggplot(data = sample_props_small, 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 = 10, Number of samples = 25"
)
Mechanics aside, let’s return to the reason we used the rep_sample_n
function: to compute a sampling distribution, specifically, the sampling distribution of the proportions from samples of 50 people.
ggplot(data = sample_props50, aes(x = p_hat)) +
geom_histogram(binwidth = 0.02)
The sampling distribution that you computed tells you much about estimating the true proportion of people who think that the work scientists do doesn’t benefit them. Because the sample proportion is an unbiased estimator, the sampling distribution is centered at the true population proportion, and the spread of the distribution indicates how much variability is incurred by sampling only 50 people at a time from the population.
In the remainder of this section, you will work on getting a sense of the effect that sample size has on your sampling distribution.
I ran this shiny app and noticed mean value change from 22% to 20% with the change of sample size 10,50 & 100. Found same mean 0.2 for sample size 50 and 100. However, Standard error changes from 0.11, 0.06 & 0.04 for for each sample size 10,50 & 100.
So far, you have only focused on estimating the proportion of those you think the work scientists doesn’t benefit them. Now, you’ll try to estimate the proportion of those who think it does.
Note that while you might be able to answer some of these questions using the app, you are expected to write the required code and produce the necessary plots and summary statistics. You are welcome to use the app for exploration.
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?
of people who think the work scientists do enchances their lives.
# Create a third sample
set.seed(3345)
samp3 <- global_monitor %>%
sample_n(15)
samp3_p_hat <- samp3 %>%
count(scientist_work) %>%
mutate(p_hat = n /sum(n)) %>%
filter(scientist_work == "Benefits") %>%
pull(p_hat) %>%
round(2)
samp3_p_hat
## [1] 0.8
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.
set.seed(3345)
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")
head(sample_props15)
## # A tibble: 6 x 4
## # Groups: replicate [6]
## replicate scientist_work n p_hat
## <int> <chr> <int> <dbl>
## 1 1 Benefits 12 0.8
## 2 2 Benefits 13 0.867
## 3 3 Benefits 11 0.733
## 4 4 Benefits 11 0.733
## 5 5 Benefits 15 1
## 6 6 Benefits 13 0.867
ggplot(data = sample_props15, aes(x = p_hat)) +
geom_histogram(binwidth = 0.02) +
labs(
x = "p_hat (Benefits)",
title = "Sampling distribution of p_hat",
subtitle = "Sample size = 15, Number of samples = 2000"
)
mean(sample_props15$p_hat)
## [1] 0.7976333
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 x 4
## # Groups: replicate [2,000]
## replicate scientist_work n p_hat
## <int> <chr> <int> <dbl>
## 1 1 Benefits 115 0.767
## 2 2 Benefits 115 0.767
## 3 3 Benefits 122 0.813
## 4 4 Benefits 116 0.773
## 5 5 Benefits 117 0.78
## 6 6 Benefits 128 0.853
## 7 7 Benefits 119 0.793
## 8 8 Benefits 117 0.78
## 9 9 Benefits 119 0.793
## 10 10 Benefits 114 0.76
## # ... 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"
)
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.
mean(sample_props150$p_hat)
## [1] 0.7995967
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?
The distribution from exercise 9 with a sample size of 150 has a smaller spread than the distribution from exercise 8 with a sample size of 15. Smaller samples in general would gives us a more accurate representation of the population proportion
library(tidyverse) library(openintro) library(infer) # Needed for resampling library(shiny) # Needed for the shiny app
You have to add “library(shiny)” at the top of your rmarkdown