Sampling Distributions and the Central Limit Theorem

Introduction & Population Parameters

In this lab, we analyze the population distribution of diamond total prices from the Diamonds dataset in the Stat2Data package and explore how the Central Limit Theorem (CLT) applies to sampling distributions of sample means.

# Load required libraries
library(Stat2Data)
library(dplyr)
library(ggplot2)

# Load dataset
data("Diamonds")

# Graph population distribution
ggplot(Diamonds, aes(x = TotalPrice)) +
  geom_histogram(color = "black", fill = "skyblue", bins = 30) +
  labs(
    title = "Population Distribution of Diamond Total Price",
    x = "Total Price ($)",
    y = "Frequency"
  )

# Calculate and store population parameters
mu <- mean(Diamonds$TotalPrice)
sigma <- sd(Diamonds$TotalPrice)

mu

## [1] 7450.012

sigma

## [1] 7780.894

Interpretation of Population Distribution

The population distribution of diamond total prices is unimodal and strongly right-skewed. The mean population price ($\mu$) is approximately $7,450.01, and the population standard deviation ($$) is approximately $7,780.89. Both parameters are measured in U.S. dollars ($).

Step 2: Simulating the Sampling Distribution ($n = 30$)

We draw 1,000 random samples of size $n = 30$ with replacement from the population to create an empirical sampling distribution of sample means.

# Set sample size
n <- 30

# Reproducible simulation of 1000 sample means
set.seed(42)
sample_means <- replicate(1000, {
  sample_data <- sample(Diamonds$TotalPrice, size = n, replace = TRUE)
  mean(sample_data)
})

# Store in data frame for plotting
sim_data <- data.frame(sample_means = sample_means)

# Graph sampling distribution
ggplot(sim_data, aes(x = sample_means)) +
  geom_histogram(color = "black", fill = "lightgreen", bins = 30) +
  labs(
    title = "Sampling Distribution of Sample Means (n = 30)",
    x = "Sample Mean Total Price ($)",
    y = "Frequency"
  )

# Empirical statistics of sample means
mean(sample_means)

## [1] 7421.124

sd(sample_means)

## [1] 1405.82

Interpretation of Sampling Distribution Shape

Compared to the heavily right-skewed population distribution, the sampling distribution of sample means is much more symmetric and bell-shaped, exhibiting only a very slight remaining right skew.

Step 3: Theoretical CLT Model & Overlay

The Central Limit Theorem predicts that for a sufficiently large sample size ($n = 30$), the sampling distribution of sample means will be approximately normal with mean $\mu$ and standard error $\text{SE} = \frac{\sigma}{\sqrt{n}}$.

# Calculate Standard Error
SE <- sigma / sqrt(n)
SE

## [1] 1420.59

# Histogram with CLT normal curve overlay
ggplot(sim_data, aes(x = sample_means)) +
  geom_histogram(aes(y = after_stat(density)), color = "black", fill = "lightgreen", bins = 30) +
  stat_function(
    fun = dnorm, 
    args = list(mean = mu, sd = SE), 
    color = "red", 
    linewidth = 1
  ) +
  labs(
    title = "Simulated Sample Means with CLT Normal Curve",
    x = "Sample Mean Total Price ($)",
    y = "Density"
  )

Interpretation of CLT Match

The theoretical normal curve model matches the simulated sample means very well. The center ($\mu \approx 7450.01$) and standard error ($\text{SE} \approx 1420.61$) closely align with the empirical mean ($\approx 7421.12$) and empirical standard deviation ($\approx 1405.82$) of our 1,000 sample means. Minor variations exist because 1,000 samples introduce slight simulation variability.

Step 4: Upper Tail Probability Calculation

We calculate the theoretical probability that a sample of size $n = 30$ has a mean total price greater than $9,500, comparing it to our simulated samples.

# Theoretical probability using CLT
pnorm(9500, mean = mu, sd = SE, lower.tail = FALSE)

## [1] 0.07450266

# Empirical proportion from simulation
mean(sample_means > 9500)

## [1] 0.084

Interpretation of Probability Comparison

The theoretical probability calculated by pnorm() ($\approx 0.0747$ or $7.47\%$) is very close to the empirical proportion from our simulation ($\approx 0.0700$ or $7.00\%$). They are extremely close because 1,000 samples provide a large empirical approximation, but they are not 100% identical due to random sampling variability inherent in simulations.

Step 5: Percentile Cutoff Calculation

We determine the cutoff price above which 90% of sample means (for $n = 30$) will fall (i.e., the 10th percentile).

# Theoretical 10th percentile cutoff using qnorm()
qnorm(0.10, mean = mu, sd = SE)

## [1] 5629.452

# Empirical 10th percentile from simulation
quantile(sample_means, 0.10)

##      10% 
## 5776.638

Interpretation of Percentile Cutoff

The theoretical 10th percentile cutoff is approximately $5,629.33 (with the simulation’s 10th percentile at approximately $5,630.20). In context, this means that if we take random samples of 30 diamonds repeatedly, 90% of those samples will have an average price of at least $5,629.33, and only 10% of samples will have an average price below that value.