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.
In this sample,58.3% of the adults think climate change affects their local community
## # A tibble: 2 × 3
## climate_change_affects n p_hat
## <chr> <int> <dbl>
## 1 No 21 0.35
## 2 Yes 39 0.65
I took another sample, this value changed slightly,In this sample,68.3% of the adults think climate change affects their local community
## # A tibble: 2 × 3
## climate_change_affects n p_hat
## <chr> <int> <dbl>
## 1 No 21 0.35
## 2 Yes 39 0.65
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 resampling 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.
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.517 0.767
specify
we specify the response
variable and the level of that variable we are calling a
success
.generate
we provide the number of resamples we want
from the population in the reps
argument (this should be a
reasonably large number) as well as the type of resampling 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 resamples, which is prop
ortion.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.
It means that if we were to take many random samples from the population and construct confidence intervals for each sample, about 95% of those intervals would contain the true population proportion
# Load necessary libraries
library(tidyverse)
library(infer)
# Set seed for reproducibility
set.seed(38)
# Create the population
population_size <- 100000
prop_yes <- 0.62 # 62% say "Yes"
us_adults <- tibble(
climate_change_affects = c(rep("Yes", prop_yes * population_size),
rep("No", (1 - prop_yes) * population_size))
)
# Function to generate a confidence interval
generate_ci <- function(sample_size, conf_level = 0.95) {
samp <- us_adults %>%
sample_n(size = sample_size) # Take a random sample
ci <- samp %>%
specify(response = climate_change_affects, success = "Yes") %>%
generate(reps = 1000, type = "bootstrap") %>%
calculate(stat = "prop") %>%
get_ci(level = conf_level)
return(ci)
}
# Generate 50 confidence intervals
num_intervals <- 50
sample_size <- 60
conf_level <- 0.95
ci_results <- map_dfr(1:num_intervals, ~generate_ci(sample_size, conf_level))
# Count how many confidence intervals contain the true population proportion (0.62)
ci_results <- ci_results %>%
mutate(contains_true_prop = ifelse(lower_ci <= 0.62 & upper_ci >= 0.62, 1, 0))
# Calculate the proportion of intervals that contain 0.62
coverage_rate <- mean(ci_results$contains_true_prop)
# Display results
ci_results
## # A tibble: 50 × 3
## lower_ci upper_ci contains_true_prop
## <dbl> <dbl> <dbl>
## 1 0.45 0.7 1
## 2 0.45 0.7 1
## 3 0.367 0.617 0
## 4 0.617 0.833 1
## 5 0.45 0.7 1
## 6 0.533 0.783 1
## 7 0.5 0.75 1
## 8 0.533 0.767 1
## 9 0.6 0.817 1
## 10 0.583 0.817 1
## # ℹ 40 more rows
## [1] 0.9
In this case, you have the rare luxury of knowing the true population proportion (62%) since you have data on the entire population.
Some confidence intervals will include 0.62, while others might not. But overall, we expect about 95% of students’ confidence intervals to contain the true proportion
#Capturing the true population with bootstrapping
# Load necessary libraries
library(tidyverse)
library(infer)
# Set seed for reproducibility
set.seed(38)
# Create the population
population_size <- 100000
prop_yes <- 0.62 # 62% say "Yes"
us_adults <- tibble(
climate_change_affects = c(rep("Yes", prop_yes * population_size),
rep("No", (1 - prop_yes) * population_size))
)
# Take a random sample of 60
n <- 60
samp <- us_adults %>%
sample_n(size = n)
# Construct a 95% confidence interval using bootstrapping
ci_95 <- samp %>%
specify(response = climate_change_affects, success = "Yes") %>%
generate(reps = 1000, type = "bootstrap") %>%
calculate(stat = "prop") %>%
get_ci(level = 0.95)
# Check if the confidence interval includes the true proportion (0.62)
captures_true_prop <- ci_95$lower_ci <= 0.62 & ci_95$upper_ci >= 0.62
# Print results
ci_95
## # A tibble: 1 × 2
## lower_ci upper_ci
## <dbl> <dbl>
## 1 0.45 0.7
## [1] TRUE
Confidence intervals come from sample data, which naturally varies because of randomness. Over time, the way we build these intervals makes sure that 95% of them actually include the true population proportion.
#Simulate students generating CI with bootstrapping
# Load necessary libraries
library(tidyverse)
library(infer)
# Set seed for reproducibility
set.seed(42)
# Create the population
population_size <- 100000
prop_yes <- 0.62 # 62% say "Yes"
us_adults <- tibble(
climate_change_affects = c(rep("Yes", prop_yes * population_size),
rep("No", (1 - prop_yes) * population_size))
)
# Function to generate a confidence interval
generate_ci <- function(sample_size, conf_level = 0.95) {
samp <- us_adults %>%
sample_n(size = sample_size) # Take a random sample
ci <- samp %>%
specify(response = climate_change_affects, success = "Yes") %>%
generate(reps = 1000, type = "bootstrap") %>%
calculate(stat = "prop") %>%
get_ci(level = conf_level)
return(ci)
}
# Generate 50 confidence intervals (simulating 50 students)
num_intervals <- 50
sample_size <- 60
conf_level <- 0.95
ci_results <- map_dfr(1:num_intervals, ~generate_ci(sample_size, conf_level))
# Check how many intervals contain the true population proportion (0.62)
ci_results <- ci_results %>%
mutate(contains_true_prop = ifelse(lower_ci <= 0.62 & upper_ci >= 0.62, 1, 0))
# Calculate the proportion of intervals that contain 0.62
coverage_rate <- mean(ci_results$contains_true_prop)
# Print results
ci_results
## # A tibble: 50 × 3
## lower_ci upper_ci contains_true_prop
## <dbl> <dbl> <dbl>
## 1 0.517 0.75 1
## 2 0.533 0.783 1
## 3 0.55 0.783 1
## 4 0.467 0.7 1
## 5 0.517 0.767 1
## 6 0.433 0.683 1
## 7 0.567 0.8 1
## 8 0.45 0.7 1
## 9 0.517 0.767 1
## 10 0.433 0.683 1
## # ℹ 40 more rows
## [1] 0.94
Out of 50 confidence intervals, 47 out of 50 (or 94%) successfully captured the true population proportion (0.62). 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).
** Simulating 50 CI with bootstrapping to capture the true population, seed change to higher number and a plot of the CI results**
# Load necessary libraries
library(tidyverse)
library(infer)
# Set seed for reproducibility
set.seed(62)
# Create the population
population_size <- 100000
prop_yes <- 0.62 # 62% say "Yes"
us_adults <- tibble(
climate_change_affects = c(rep("Yes", prop_yes * population_size),
rep("No", (1 - prop_yes) * population_size))
)
# Function to generate a confidence interval
generate_ci <- function(sample_size, conf_level = 0.95) {
samp <- us_adults %>%
sample_n(size = sample_size) # Take a random sample
ci <- samp %>%
specify(response = climate_change_affects, success = "Yes") %>%
generate(reps = 1000, type = "bootstrap") %>%
calculate(stat = "prop") %>%
get_ci(level = conf_level)
return(ci)
}
# Generate 50 confidence intervals
num_intervals <- 50
sample_size <- 60
conf_level <- 0.95
true_proportion <- 0.62
ci_results <- map_dfr(1:num_intervals, ~generate_ci(sample_size, conf_level))
# Add an index column to avoid row_number() error in ggplot
ci_results <- ci_results %>%
mutate(sample_index = row_number())
# Check how many intervals contain the true population proportion (0.62)
ci_results <- ci_results %>%
mutate(contains_true_prop = ifelse(lower_ci <= true_proportion & upper_ci >= true_proportion, 1, 0))
# Calculate the proportion of intervals that capture 0.62
coverage_rate <- mean(ci_results$contains_true_prop)
# Plot the confidence intervals
ggplot(ci_results, aes(y = sample_index, x = lower_ci, xend = upper_ci)) +
geom_segment(aes(yend = sample_index), color = "blue") +
geom_vline(xintercept = true_proportion, linetype = "dashed", color = "red") +
labs(title = paste0("Confidence Intervals (50 Samples) - ", round(coverage_rate * 100, 2), "% contain true proportion"),
x = "Proportion", y = "Sample Index") +
theme_minimal()
## [1] 0.94
Out of 50 confidence intervals, 47 out of 50 successfully captured the true population proportion (0.62)
58% confidence interval using bootstrapping, change the seed higher
# Load necessary libraries
library(tidyverse)
library(infer)
# Set seed for reproducibility
set.seed(95)
# Take a random sample of 60 from the population
n <- 60
samp <- us_adults %>%
sample_n(size = n)
# Construct a 58% confidence interval using bootstrapping
ci_58 <- samp %>%
specify(response = climate_change_affects, success = "Yes") %>%
generate(reps = 1000, type = "bootstrap") %>%
calculate(stat = "prop") %>%
get_ci(level = 0.58)
# Print the 58% confidence interval
ci_58
## # A tibble: 1 × 2
## lower_ci upper_ci
## <dbl> <dbl>
## 1 0.55 0.65
The 58% confidence interval is narrower than the 95% CI because we’re allowing for more uncertainty, and yet it still precise to the true the population.
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.With a 58% confidence level, we’re saying the true proportion of U.S. adults who think climate change is affecting their local community is somewhere between [lower bound, upper bound]. Since 58% is way lower than 95%, the interval is narrower, making the estimate more precise, but at the cost of higher uncertainty.
# Load necessary libraries
library(tidyverse)
library(infer)
# Set seed for reproducibility
set.seed(75)
# Take a random sample of 60 from the population
n <- 60
samp <- us_adults %>%
sample_n(size = n)
# Define your desired confidence level (e.g., 58% or 90%)
chosen_conf_level <- 0.58 # Change this to any other level you prefer
# Construct the confidence interval using bootstrapping
ci_custom <- samp %>%
specify(response = climate_change_affects, success = "Yes") %>%
generate(reps = 1000, type = "bootstrap") %>%
calculate(stat = "prop") %>%
get_ci(level = chosen_conf_level)
# Print the custom confidence interval
ci_custom
## # A tibble: 1 × 2
## lower_ci upper_ci
## <dbl> <dbl>
## 1 0.5 0.6
50 confidence intervals at 58% confidence level w/plots and calculation of the coverage rate
# Load necessary libraries
library(tidyverse)
library(infer)
# Set seed for reproducibility
set.seed(75) # Your chosen seed
# Function to generate a confidence interval
generate_ci <- function(sample_size, conf_level = 0.58) {
samp <- us_adults %>%
sample_n(size = sample_size) # Take a random sample
ci <- samp %>%
specify(response = climate_change_affects, success = "Yes") %>%
generate(reps = 1000, type = "bootstrap") %>%
calculate(stat = "prop") %>%
get_ci(level = conf_level)
return(ci)
}
# Generate 50 confidence intervals
num_intervals <- 50
sample_size <- 60
chosen_conf_level <- 0.58
true_proportion <- 0.62
ci_results <- map_dfr(1:num_intervals, ~generate_ci(sample_size, chosen_conf_level))
# Add an index column to track sample number
ci_results <- ci_results %>%
mutate(sample_index = row_number())
# Check how many intervals contain the true population proportion (0.62)
ci_results <- ci_results %>%
mutate(contains_true_prop = ifelse(lower_ci <= true_proportion & upper_ci >= true_proportion, 1, 0))
# Calculate the proportion of intervals that capture 0.62
coverage_rate <- mean(ci_results$contains_true_prop)
# Plot the confidence intervals
ggplot(ci_results, aes(y = sample_index, x = lower_ci, xend = upper_ci)) +
geom_segment(aes(yend = sample_index), color = "blue") +
geom_vline(xintercept = true_proportion, linetype = "dashed", color = "red") +
labs(title = paste0("Confidence Intervals (50 Samples) - ", round(coverage_rate * 100, 2), "% contain true proportion"),
x = "Proportion", y = "Sample Index") +
theme_minimal()
## [1] 0.48
Ran 50 intervals at 58% confidence, and 48% caught 0.62—lower than expected but just random variation. More intervals would get closer to 58%. Lower confidence = narrower intervals = more risk.
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 am going with a higher CI level, and we already established Higher the CI, the interval will be more wider and confident to the true population
# Generate 50 confidence intervals at the new confidence level
num_intervals <- 50
ci_results_new <- map_dfr(1:num_intervals, ~generate_ci(sample_size, chosen_conf_level))
# Add an index column for plotting
ci_results_new <- ci_results_new %>%
mutate(sample_index = row_number())
# Check how many intervals capture the true population proportion (0.62)
ci_results_new <- ci_results_new %>%
mutate(contains_true_prop = ifelse(lower_ci <= 0.62 & upper_ci >= 0.62, 1, 0))
# Calculate the proportion of intervals that include 0.62
coverage_rate_new <- mean(ci_results_new$contains_true_prop)
# Plot the confidence intervals
ggplot(ci_results_new, aes(y = sample_index, x = lower_ci, xend = upper_ci)) +
geom_segment(aes(yend = sample_index), color = "blue") +
geom_vline(xintercept = 0.62, linetype = "dashed", color = "red") +
labs(title = paste0("Confidence Intervals (50 Samples) - ", round(coverage_rate_new * 100, 2), "% contain true proportion"),
x = "Proportion", y = "Sample Index") +
theme_minimal()
## [1] 0.62
# Generate 50 confidence intervals at the new confidence level
num_intervals <- 50
ci_results_new <- map_dfr(1:num_intervals, ~generate_ci(sample_size, chosen_conf_level))
# Add an index column for plotting
ci_results_new <- ci_results_new %>%
mutate(sample_index = row_number())
# Check how many intervals capture the true population proportion (0.62)
ci_results_new <- ci_results_new %>%
mutate(contains_true_prop = ifelse(lower_ci <= 0.62 & upper_ci >= 0.62, 1, 0))
# Calculate the proportion of intervals that include 0.62
coverage_rate_new <- mean(ci_results_new$contains_true_prop)
# Plot the confidence intervals
ggplot(ci_results_new, aes(y = sample_index, x = lower_ci, xend = upper_ci)) +
geom_segment(aes(yend = sample_index), color = "blue") +
geom_vline(xintercept = 0.62, linetype = "dashed", color = "red") +
labs(title = paste0("Confidence Intervals (50 Samples) - ", round(coverage_rate_new * 100, 2), "% contain true proportion"),
x = "Proportion", y = "Sample Index") +
theme_minimal()
## [1] 0.62
Bigger sample = narrower, more precise confidence intervals. Smaller sample = wider, more uncertain intervals. More data = better accuracy, less data = more guesswork.
I tested 60 samples with 100 to 10,000 bootstraps and found that increasing resamples doesn’t shrink the interval width—it only stabilizes the estimate. This happens because bootstrapping doesn’t reduce variability, it just refines the standard error (SE). Since SE depends on sample size, adding more resamples won’t make the interval narrower—only a larger sample size will.