If you have access to data on an entire population, say the opinion of every adult in the United States on whether or not they think climate change is affecting their local community, it’s straightforward to answer questions like, “What percent of US adults think climate change is affecting their local community?”. Similarly, if you had demographic information on the population you could examine how, if at all, this opinion varies among young and old adults and adults with different leanings. If you have access to only a sample of the population, as is often the case, the task becomes more complicated. What is your best guess for this proportion if you only have data from a small sample of adults? This type of situation requires that you use your sample to make inference on what your population looks like.
Setting a seed: You will take random samples and build sampling distributions in this lab, which means you should set a seed on top 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, and perform statistical inference using infer.
Let’s load the packages.
A 2019 Pew Research report states the following:
To keep our computation simple, we will assume a total population size of 100,000 (even though that’s smaller than the population size of all US adults).
Roughly six-in-ten U.S. adults (62%) say climate change is currently affecting their local community either a great deal or some, according to a new Pew Research Center survey.
Source: Most Americans say climate change impacts their community, but effects vary by region
In this lab, you will assume this 62% 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 62,000 (62%) of the adult population think climate change impacts their community, and the remaining 38,000 does not think so.
The name of the data frame is us_adults and the name of
the variable that contains responses to the question “Do you think
climate change is affecting your local community?” is
climate_change_affects.
We can quickly visualize the distribution of these responses using a bar plot.
ggplot(us_adults, aes(x = climate_change_affects)) +
geom_bar() +
labs(x = "", y = "",
title = "Do you think climate change is affecting your local community?") +
coord_flip() We can also obtain summary statistics to confirm we constructed the data frame correctly.
## # A tibble: 2 × 3
## climate_change_affects n p
## <chr> <int> <dbl>
## 1 No 38000 0.38
## 2 Yes 62000 0.62
In this lab, you’ll start with a simple random sample of size 60 from the population.
67% of adults in samp think climate change
affects their local community.
## # A tibble: 2 × 3
## climate_change_affects n p
## <chr> <int> <dbl>
## 1 No 20 0.333
## 2 Yes 40 0.667
I would not expect another student’s sample proportion to be
identical to mine because the sample_n function takes
random samples. However, I do expect the proportions to be
similar.
Return for a moment to the question that first motivated this lab:
based on this sample, what can you infer about the population? With just
one sample, the best estimate of the proportion of US adults who think
climate change affects their local community would be the sample
proportion, usually denoted as \(\hat{p}\) (here we are calling it
p_hat). That serves as a good point
estimate, but it would be useful to also communicate how
uncertain you are of that estimate. This uncertainty can be quantified
using a confidence interval.
One way of calculating a confidence interval for a population proportion is based on the Central Limit Theorem, as \(\hat{p} \pm z^\star SE_{\hat{p}}\) is, or more precisely, as \[ \hat{p} \pm z^\star \sqrt{ \frac{\hat{p} (1-\hat{p})}{n} } \]
Another way is using simulation, or to be more specific, using bootstrapping. The term bootstrapping comes from the phrase “pulling oneself up by one’s bootstraps”, which is a metaphor for accomplishing an impossible task without any outside help. In this case the impossible task is estimating a population parameter (the unknown population proportion), and we’ll accomplish it using data from only the given sample. Note that this notion of saying something about a population parameter using only information from an observed sample is the crux of statistical inference, it is not limited to bootstrapping.
In essence, bootstrapping assumes that there are more of observations in the populations like the ones in the observed sample. So we “reconstruct” the population by re-sampling from our sample, with replacement. The bootstrapping scheme is as follows:
Instead of coding up each of these steps, we will construct confidence intervals using the infer package.
Below is an overview of the functions we will use to construct this confidence interval:
| Function | Purpose |
|---|---|
specify |
Identify your variable of interest |
generate |
The number of samples you want to generate |
calculate |
The sample statistic you want to do inference with, or you can also think of this as the population parameter you want to do inference for |
get_ci |
Find the confidence interval |
This code will find the 95 percent confidence interval for proportion of US adults who think climate change affects their local community.
set.seed(2)
samp %>%
specify(response = climate_change_affects, success = "Yes") %>%
generate(reps = 1000, type = "bootstrap") %>%
calculate(stat = "prop") %>%
get_ci(level = 0.95)## # A tibble: 1 × 2
## lower_ci upper_ci
## <dbl> <dbl>
## 1 0.550 0.783
specify we specify the response
variable and the level of that variable we are calling a
success.generate we provide the number of re-samples we want
from the population in the reps argument (this should be a
reasonably large number) as well as the type of re-sampling we want to
do, which is "bootstrap" in the case of constructing a
confidence interval.calculate the sample statistic of interest for
each of these re-samples, which is proportion.Feel free to test out the rest of the arguments for these functions, since these commands will be used together to calculate confidence intervals and solve inference problems for the rest of the semester. But we will also walk you through more examples in future chapters.
To recap: even though we don’t know what the full population looks like, we’re 95% confident that the true proportion of US adults who think climate change affects their local community is between the two bounds reported as result of this pipeline.
95% confidence refers to the probability that the true population parameter falls between the Confidence Interval
In this case, you have the rare luxury of knowing the true population proportion (62%) since you have data on the entire population.
My interval does not capture the true population proportion of US adults who think climate change affects their local community.
Since the confidence level is 95%, therefore we would expect around 95% of those student’s confidence intervals to capture the true population mean.
In the next part of the lab, you will collect many samples to learn more about how sample proportions and confidence intervals constructed based on those samples vary from one sample to another.
Doing this would require learning programming concepts like iteration so that you can automate repeating running the code you’ve developed so far many times to obtain many (50) confidence intervals. In order to keep the programming simpler, we are providing the interactive app below that basically does this for you and created a plot similar to Figure 5.6 on OpenIntro Statistics, 4th Edition (page 182).
Around 94% which is close to the actual confidence level. It’s not exactly equal because Bootstrapping involves random sampling with replacement. Each bootstrap sample creates a slightly different estimate of the proportion.
set.seed(3)
# Function to take sample of population
take_sample <- function(data, size) {
data |>
sample_n(size = size)
}
# Function to calculate a confidence interval
conf_int_function <-
function(data,
response,
success,
reps,
type,
stat,
level) {
data |>
specify(response = {
{
response
}
}, success = success) |>
generate(reps = reps, type = type) |>
calculate(stat = stat) |>
get_ci(level = level)
}
# Function that calls the take_sample function and the conf_int_function
entire_conf_int_func <-
function(data,
size,
response,
success,
reps,
type,
stat,
level) {
data |>
take_sample(size = size) |>
conf_int_function(
response = {
{
response
}
},
success = success,
reps = reps,
type = type,
stat = stat,
level = level
)
}
# Function to loop entire_conf_int_func n times
loop_entire_conf_int_func <-
function(data,
size,
response,
success,
reps,
type,
stat,
level,
n) {
map_dfr(
1:n,
~ entire_conf_int_func(
data = data,
size = size,
response = {
{
response
}
},
success = success,
reps = reps,
type = type,
stat = stat,
level = level
),
.id = "replicate"
)
}
# Create the many samples
many_samp <- loop_entire_conf_int_func(
data = us_adults,
size = 60,
response = climate_change_affects,
success = "Yes",
reps = 1000,
type = "bootstrap",
stat = "prop",
level = .95,
n = 50
) |>
mutate(is_in_ci = ifelse(.62 >= lower_ci &
.62 <= upper_ci, "Yes", "No"))
# Percentage of times the true population proportion is in the confidence interval"
many_samp |>
count(is_in_ci) |>
mutate(percentage = n / sum(n))## # A tibble: 2 × 3
## is_in_ci n percentage
## <chr> <int> <dbl>
## 1 No 3 0.06
## 2 Yes 47 0.94
# Plot the many samples
ggplot(
many_samp,
aes(
x = lower_ci,
xend = upper_ci,
y = replicate,
yend = replicate,
color = is_in_ci
)
) +
geom_point() +
geom_segment() +
geom_vline(xintercept = .62, color = "darkgray") +
labs(x = "Bounds of the confidence interval",
y = "",
color = "Does the interval capture the true population proportion?") +
theme(legend.position = "bottom", axis.text.y = element_blank())The higher the confidence level, the wider the interval. This is because the higher interval needs to capture a larger portion of the possible values to be that confident about containing the true value. For example, I chose 90% confidence level, this will be a narrower interval than a 95% confidence level.
# Compare Confidence levels
set.seed(4)
# Create sample at 90% confidence level
samp_90 <- loop_entire_conf_int_func(
data = us_adults,
size = 60,
response = climate_change_affects,
success = "Yes",
reps = 1000,
type = "bootstrap",
stat = "prop",
level = .90,
n = 50
) |>
mutate(is_in_ci = ifelse(.62 >= lower_ci &
.62 <= upper_ci, "Yes", "No"))
# Create a sample at 95% confidence level
samp_95 <- loop_entire_conf_int_func(
data = us_adults,
size = 60,
response = climate_change_affects,
success = "Yes",
reps = 1000,
type = "bootstrap",
stat = "prop",
level = .95,
n = 50
) |>
mutate(is_in_ci = ifelse(.62 >= lower_ci &
.62 <= upper_ci, "Yes", "No"))
# Plot the samp_90 and samp_95
grid.arrange(
ggplot(
samp_90,
aes(
x = lower_ci,
xend = upper_ci,
y = replicate,
yend = replicate,
color = is_in_ci
)
) +
geom_point() +
geom_segment() +
geom_vline(xintercept = .62, color = "darkgray") +
labs(x = "Bounds of the 90% confidence interval",
y = "",
color = "Capture True Population?") +
theme(legend.position = "bottom", axis.text.y = element_blank()),
ggplot(
samp_95,
aes(
x = lower_ci,
xend = upper_ci,
y = replicate,
yend = replicate,
color = is_in_ci
)
) +
geom_point() +
geom_segment() +
geom_vline(xintercept = .62, color = "darkgray") +
labs(x = "Bounds of the 95% confidence interval",
y = "",
color = "Capture True Population?") +
theme(legend.position = "bottom", axis.text.y = element_blank()),
ncol = 2
)# Calculate and Compare the average width of the confidence intervals
bind_rows(
samp_95 |>
mutate(width = upper_ci - lower_ci) |>
summarize(mean_width = mean(width)) |>
mutate(type = "width_95_Conf_Lev"),
samp_90 |>
mutate(width = upper_ci - lower_ci) |>
summarize(mean_width = mean(width)) |>
mutate(type = "width_90_Conf_Lev")
) |>
pivot_wider(names_from = type, values_from = mean_width)## # A tibble: 1 × 2
## width_95_Conf_Lev width_90_Conf_Lev
## <dbl> <dbl>
## 1 0.238 0.202
samp), find a confidence interval
for the proportion of US Adults who think climate change is affecting
their local community with a confidence level of your choosing (other
than 95%) and interpret it.We can say with 80% confidence that the proportion of US Adults who think climate change is affecting their local community is 58% - 73%
set.seed(5)
# Use the conf_int_function to calculate the 80% confidence interval for samp and calculate the width
conf_int_function(
data = samp,
response = climate_change_affects,
success = "Yes",
reps = 1000,
type = "bootstrap",
stat = "prop",
level = .80
) |>
mutate(width = upper_ci - lower_ci)## # A tibble: 1 × 3
## lower_ci upper_ci width
## <dbl> <dbl> <dbl>
## 1 0.583 0.733 0.150
The proportion of intervals that include the true population proportion is 82%, which is very close to the 80% confidence level selected
set.seed(6)
# Create a sample at 80% confidence level 50 times
samp_80 <- loop_entire_conf_int_func(
data = us_adults,
size = 60,
response = climate_change_affects,
success = "Yes",
reps = 1000,
type = "bootstrap",
stat = "prop",
level = .80,
n = 50
) |>
mutate(is_in_ci = ifelse(.62 >= lower_ci &
.62 <= upper_ci, "Yes", "No"))
# Plot the samp_80
ggplot(
samp_80,
aes(
x = lower_ci,
xend = upper_ci,
y = replicate,
yend = replicate,
color = is_in_ci
)
) +
geom_point() +
geom_segment() +
geom_vline(xintercept = .62, color = "darkgray") +
labs(x = "Bounds of the 80% confidence interval",
y = "",
color = "Does the interval capture the true population proportion?") +
theme(legend.position = "bottom", axis.text.y = element_blank())# Proportion of intervals that include the true population proportion
samp_80 |>
count(is_in_ci) |>
mutate(percentage = n / sum(n))## # A tibble: 2 × 3
## is_in_ci n percentage
## <chr> <int> <dbl>
## 1 No 5 0.1
## 2 Yes 45 0.9
samp and
interpret it. Finally, use the app to generate many intervals and
calculate the proportion of intervals that are capture the true
population proportion.I chose 99% confidence level. I expect the width of the interval to be extremely wide. The wider the interval the more confidence we gain that the proportion is within the interval.
set.seed(7)
# Create a sample at 99% confidence level 50 times
samp_99 <- loop_entire_conf_int_func(
data = us_adults,
size = 60,
response = climate_change_affects,
success = "Yes",
reps = 1000,
type = "bootstrap",
stat = "prop",
level = .99,
n = 50
) |>
mutate(is_in_ci = ifelse(.62 >= lower_ci &
.62 <= upper_ci, "Yes", "No"))
# Plot the samp_80
ggplot(
samp_99,
aes(
x = lower_ci,
xend = upper_ci,
y = replicate,
yend = replicate,
color = is_in_ci
)
) +
geom_point() +
geom_segment() +
geom_vline(xintercept = .62, color = "darkgray") +
labs(x = "Bounds of the 99% confidence interval",
y = "",
color = "Does the interval capture the true population proportion?") +
theme(legend.position = "bottom", axis.text.y = element_blank())# Proportion of intervals that include the true population proportion
samp_99 |>
count(is_in_ci) |>
mutate(percentage = n / sum(n))## # A tibble: 2 × 3
## is_in_ci n percentage
## <chr> <int> <dbl>
## 1 No 2 0.04
## 2 Yes 48 0.96
As Sample sizes increase the width decreases. The sample size of 1000 has a smaller width than the sample size of 100
set.seed(8)
# Create sample size of 1000
samp_size_1000 <- loop_entire_conf_int_func(
data = us_adults,
size = 1000,
response = climate_change_affects,
success = "Yes",
reps = 1000,
type = "bootstrap",
stat = "prop",
level = .95,
n = 50
) |>
mutate(is_in_ci = ifelse(.62 >= lower_ci &
.62 <= upper_ci, "Yes", "No"))
# Create sample size 100
samp_size_100 <- loop_entire_conf_int_func(
data = us_adults,
size = 100,
response = climate_change_affects,
success = "Yes",
reps = 1000,
type = "bootstrap",
stat = "prop",
level = .95,
n = 50
) |>
mutate(is_in_ci = ifelse(.62 >= lower_ci &
.62 <= upper_ci, "Yes", "No"))
# Plot the samp_size_1000 and samp_size_100
grid.arrange(
ggplot(
samp_size_1000,
aes(
x = lower_ci,
xend = upper_ci,
y = replicate,
yend = replicate,
color = is_in_ci
)
) +
geom_point() +
geom_segment() +
geom_vline(xintercept = .62, color = "darkgray") +
labs(x = "Bounds of the confidence interval with 1000 samples",
y = "",
color = "Capture True Population?") +
theme(legend.position = "bottom", axis.text.y = element_blank()),
ggplot(
samp_size_100,
aes(
x = lower_ci,
xend = upper_ci,
y = replicate,
yend = replicate,
color = is_in_ci
)
) +
geom_point() +
geom_segment() +
geom_vline(xintercept = .62, color = "darkgray") +
labs(x = "Bounds of the confidence interval with 100 samples",
y = "",
color = "Capture True Population?") +
theme(legend.position = "bottom", axis.text.y = element_blank()),
ncol = 2
)# Calculate and Compare the average width of the confidence intervals
bind_rows(
samp_size_1000 |>
mutate(width = upper_ci - lower_ci) |>
summarize(mean_width = mean(width)) |>
mutate(type = "width_samp_size_1000"),
samp_size_100 |>
mutate(width = upper_ci - lower_ci) |>
summarize(mean_width = mean(width)) |>
mutate(type = "width_samp_size_100")
) |>
pivot_wider(names_from = type, values_from = mean_width)## # A tibble: 1 × 2
## width_samp_size_1000 width_samp_size_100
## <dbl> <dbl>
## 1 0.0598 0.188
Increasing the number of bootstrap samples does not directly affect the width of the confidence interval for a specific confidence level. However, it improves the accuracy of the estimated standard error, which indirectly affects the perceived width of the interval.
set.seed(9)
# Create sample size of 60 and 1000 bootstrap samples
samp_1000_bootstrap <- loop_entire_conf_int_func(
data = us_adults,
size = 60,
response = climate_change_affects,
success = "Yes",
reps = 1000,
type = "bootstrap",
stat = "prop",
level = .95,
n = 50
) |>
mutate(is_in_ci = ifelse(.62 >= lower_ci &
.62 <= upper_ci, "Yes", "No"))
# Create sample size 60 and 100 bootstrap samples
samp_100_bootstrap <- loop_entire_conf_int_func(
data = us_adults,
size = 60,
response = climate_change_affects,
success = "Yes",
reps = 100,
type = "bootstrap",
stat = "prop",
level = .95,
n = 50
) |>
mutate(is_in_ci = ifelse(.62 >= lower_ci &
.62 <= upper_ci, "Yes", "No"))
# Plot samp_1000_bootstrap and samp_100 bootstrap
grid.arrange(
ggplot(
samp_1000_bootstrap,
aes(
x = lower_ci,
xend = upper_ci,
y = replicate,
yend = replicate,
color = is_in_ci
)
) +
geom_point() +
geom_segment() +
geom_vline(xintercept = .62, color = "darkgray") +
labs(x = "Confidence interval with 1000 bootstrap samples",
y = "",
color = "Capture True Population?") +
theme(legend.position = "bottom", axis.text.y = element_blank()),
ggplot(
samp_100_bootstrap,
aes(
x = lower_ci,
xend = upper_ci,
y = replicate,
yend = replicate,
color = is_in_ci
)
) +
geom_point() +
geom_segment() +
geom_vline(xintercept = .62, color = "darkgray") +
labs(x = "Confidence interval with 100 bootstrap samples",
y = "",
color = "Capture True Population?") +
theme(legend.position = "bottom", axis.text.y = element_blank()),
ncol = 2
)# Calculate and Compare the average width of the confidence intervals
bind_rows(
samp_1000_bootstrap |>
mutate(width = upper_ci - lower_ci) |>
summarize(mean_width = mean(width)) |>
mutate(type = "width_1000_bootstrap"),
samp_100_bootstrap |>
mutate(width = upper_ci - lower_ci) |>
summarize(mean_width = mean(width)) |>
mutate(type = "width_100_bootstrap")
) |>
pivot_wider(names_from = type, values_from = mean_width)## # A tibble: 1 × 2
## width_1000_bootstrap width_100_bootstrap
## <dbl> <dbl>
## 1 0.238 0.230