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(DATA606)
##
## Welcome to CUNY DATA606 Statistics and Probability for Data Analytics
## This package is designed to support this course. The text book used
## is OpenIntro Statistics, 4th Edition. You can read this by typing
## vignette('os4') or visit www.OpenIntro.org.
##
## The getLabs() function will return a list of the labs available.
##
## The demo(package='DATA606') will list the demos that are available.
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.
<- tibble(
global_monitor scientist_work = c(rep("Benefits", 80000), rep("Doesn't benefit", 20000))
)
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 × 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.
<- global_monitor %>%
samp1 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.We would be looking at the sampling proportions then we can use the p-hat. In this sample, instead of looking at 20% and 80%, it’s 41% benefits and 9% doesn’t benefit.
#Set seed
set.seed(58223)
<- global_monitor %>%
samp1 sample_n(50)
%>%
samp1 count(scientist_work) %>%
mutate(p1 = n /sum(n))
## # A tibble: 2 × 3
## scientist_work n p1
## <chr> <int> <dbl>
## 1 Benefits 41 0.82
## 2 Doesn't benefit 9 0.18
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.
%>%
samp1 count(scientist_work) %>%
mutate(p_hat = n /sum(n))
## # A tibble: 2 × 3
## scientist_work n p_hat
## <chr> <int> <dbl>
## 1 Benefits 41 0.82
## 2 Doesn't benefit 9 0.18
Depending on which 50 people you selected, your estimate could be a bit above or a bit below the true population proportion of 0.18. 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 do not expect for the sample proportion to match another student’s sample because we each get a random selection of the population. I do however expect the sample proportions to be similar.
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?Comparing sample 2 with sample 1 there is a slight difference in the outcomes. In sample 1 we have 41% benefits and 9% doesn’t benefit and in sample 2 it’s 35% benefits and 15% doesn’t benefit.
#Set seed
set.seed(58245)
#Sample 2 of 50
<- global_monitor %>%
samp2 sample_n(50)
%>%
samp2 count(scientist_work) %>%
mutate(p1 = n /sum(n))
## # A tibble: 2 × 3
## scientist_work n p1
## <chr> <int> <dbl>
## 1 Benefits 35 0.7
## 2 Doesn't benefit 15 0.3
Based on the sample proportions below, the sample 4 with the size 100 provides a more accurate estimate of the sample population. As seen below the outcomes are 81% benefits and 19% doesn’t benefit, which is very similar to the 80% and 20% from the assumed true population proportion.
#Set seed
set.seed(58256)
#Sample 3 for 100
<- global_monitor %>%
samp3 sample_n(100)
%>%
samp3 count(scientist_work) %>%
mutate(p1 = n /sum(n))
## # A tibble: 2 × 3
## scientist_work n p1
## <chr> <int> <dbl>
## 1 Benefits 81 0.81
## 2 Doesn't benefit 19 0.19
#Set seed
set.seed(58213)
#Sample 4 for 1000
<- global_monitor %>%
samp4 sample_n(1000)
%>%
samp4 count(scientist_work) %>%
mutate(p1 = n /sum(n))
## # A tibble: 2 × 3
## scientist_work n p1
## <chr> <int> <dbl>
## 1 Benefits 775 0.775
## 2 Doesn't benefit 225 0.225
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.
<- global_monitor %>%
sample_props50 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.
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.There are 50 elements in the sample_pros50 with a sample size of 15000. The plot seems to be normally distributed with a very slight skewed to the right. Mean is close to 0.2 and a standard deviation of 0.06.
#Set seed
set.seed(8927)
#Distribution of sample proportions for Doesn't benefit
<- global_monitor %>%
sample_props50 rep_sample_n(size = 50, reps = 15000, replace = TRUE) %>%
count(scientist_work) %>%
mutate(p_hat = n /sum(n)) %>%
filter(scientist_work == "Doesn't benefit")
#Plot
ggplot(data = sample_props50, aes(x = p_hat)) +
geom_histogram(binwidth = 0.01) +
labs(
x = "p_hat (Doesn't benefit)",
title = "Sampling distribution of p_hat",
subtitle = "Sample size = 50, Number of samples = 15000"
)
#Mean and standard deviation for sample_props50
mean(sample_props50$p_hat)
## [1] 0.199716
sd(sample_props50$p_hat)
## [1] 0.05683287
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 × 3
## scientist_work n p_hat
## <chr> <int> <dbl>
## 1 Doesn't benefit 11 0.22
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 5 observations 0.1, 0.2, 0.3, 0.4 and 0.5 representing those who say the work scientist do doesn’t benefit people like them. This sample size has a mean of 0.19 and a standard deviation of 0.12. The plot is also unimodal right skewed.
#Set seed
set.seed(6783)
#Distribution of sample proportions for Doesn't benefit
<- global_monitor %>%
sample_props_small rep_sample_n(size = 10, reps = 25, replace = TRUE) %>%
count(scientist_work) %>%
mutate(p_hat = n /sum(n)) %>%
filter(scientist_work == "Doesn't benefit")
#Plot
ggplot(data = sample_props_small, aes(x = p_hat)) +
geom_histogram(binwidth = 0.05) +
labs(
x = "p_hat (Doesn't benefit)",
title = "Sampling distribution of p_hat",
subtitle = "Sample size = 10, Number of samples = 25"
)
#Mean and standard deviation for sample_props_small
mean(sample_props_small$p_hat)
## [1] 0.1904762
sd(sample_props_small$p_hat)
## [1] 0.1179185
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.
From this app, the sample size of starting at 10, 50 and then 100, the mean starts getting closer to 0.2. The standard error of the sampling distribution decreases as the sample size increase. The plot also shifts fro being right skewed to appearing more normally distributed as the sample size gets larger.
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.
Based on the sampling, 80% of the sampled population think that the work scientist do benefits their lives.
set.seed(75893)
<- global_monitor %>%
samp15 sample_n(15)
%>%
samp15 count(scientist_work) %>%
mutate(p15 = n /sum(n))
## # A tibble: 2 × 3
## scientist_work n p15
## <chr> <int> <dbl>
## 1 Benefits 12 0.8
## 2 Doesn't benefit 3 0.2
%>%
samp15 count(scientist_work) %>%
mutate(p_hat = n /sum(n))
## # A tibble: 2 × 3
## scientist_work n p_hat
## <chr> <int> <dbl>
## 1 Benefits 12 0.8
## 2 Doesn't benefit 3 0.2
ggplot(samp15, aes(x = scientist_work)) +
geom_bar() +
labs(
x = "Study", y = "Sample 15",
title = "Do you believe that the work scientists do benefit people like you?"
+
) coord_flip()
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 enhances their lives to be? Finally,
calculate and report the population proportion.Based on the plot the sample distribution with a sample size of 15 is left skewed with a mean of 0.80 and a standard deviation of 0.10.
set.seed(492871)
<- global_monitor %>%
sample_props15 rep_sample_n(size = 15, reps = 2000, replace = TRUE) %>%
count(scientist_work) %>%
mutate(p_hat = n /sum(n)) %>%
filter(scientist_work == "Benefits")
ggplot(data = sample_props15, aes(x = p_hat)) +
geom_histogram(binwidth = 0.03) +
labs(
x = "p_hat (Benefits)",
title = "Sampling distribution of p_hat",
subtitle = "Sample size = 15, Number of samples = 2000"
)
%>%
global_monitor sample_n(size = 15, replace = TRUE) %>%
count(scientist_work) %>%
mutate(p_hat = n /sum(n)) %>%
filter(scientist_work == "Benefits")
## # A tibble: 1 × 3
## scientist_work n p_hat
## <chr> <int> <dbl>
## 1 Benefits 14 0.933
mean(sample_props15$p_hat)
## [1] 0.7989667
sd(sample_props15$p_hat)
## [1] 0.1042109
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 enhances their lives?This plot looks more normally distributed but there’s still a slight left skeweness. The mean is 0.80 and the standard deviation is 0.032. Basing from this sampling distribution this does appear to be the trie proportion of 80% of those who think the work scientist do is beneficial to them.
set.seed(192839)
<- global_monitor %>%
sample_props150 rep_sample_n(size = 150, reps = 2000, replace = TRUE) %>%
count(scientist_work) %>%
mutate(p_hat = n /sum(n)) %>%
filter(scientist_work == "Benefits")
ggplot(data = sample_props150, aes(x = p_hat)) +
geom_histogram(binwidth = 0.02) +
labs(
x = "p_hat (Benefits)",
title = "Sampling distribution of p_hat",
subtitle = "Sample size = 150, Number of samples = 2000"
)
%>%
global_monitor sample_n(size = 150, replace = TRUE) %>%
count(scientist_work) %>%
mutate(p_hat = n /sum(n)) %>%
filter(scientist_work == "Benefits")
## # A tibble: 1 × 3
## scientist_work n p_hat
## <chr> <int> <dbl>
## 1 Benefits 123 0.82
mean(sample_props150$p_hat)
## [1] 0.80034
sd(sample_props150$p_hat)
## [1] 0.0316675
The third sample distribution has a smaller spread. If concerned with making estimates that are more often close to the true value then I’d prefer a larger spread.