Sampling Distributions & Central Limit Theorem Analysis

Introduction

In this analysis, we investigate the sampling distribution of sample means using the Diamonds dataset from the Stat2Data package, treating the dataset as our entire population.

Step 1: Population Parameters & Distribution

We load the necessary packages, access the dataset, plot the population distribution of TotalPrice, and calculate the population parameters \(\mu\) and \(\sigma\).

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

# Load dataset
data("Diamonds")

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

# Calculate population mean (mu) and standard deviation (sigma)
mu <- mean(Diamonds$TotalPrice)
sigma <- sd(Diamonds$TotalPrice)

mu

## [1] 7450.012

sigma

## [1] 7780.894

Interpretation: The population distribution of diamond total prices is strongly unimodal and right-skewed. The variable TotalPrice is measured in US Dollars (USD).

---

Step 2: Simulating the Sampling Distribution

Next, we set \(n = 30\) and simulate 1,000 random samples (with replacement) to create the sampling distribution of the sample mean (\(\bar{x}\)).

n <- 30
set.seed(42)

# Simulate 1,000 samples of size n = 30
sample_means <- replicate(1000, {
  sample_data <- sample(Diamonds$TotalPrice, size = n, replace = TRUE)
  mean(sample_data)
})

# Plot sampling distribution
ggplot(data.frame(sample_means), aes(x = sample_means)) +
  geom_histogram(fill = "salmon", color = "black", bins = 30) +
  labs(title = "Sampling Distribution of Sample Means (n = 30)",
       x = "Sample Mean Total Price (USD)",
       y = "Count") +
  theme_minimal()

# Summary statistics of simulated sample means
mean(sample_means)

## [1] 7421.124

sd(sample_means)

## [1] 1405.82

Interpretation: Unlike the strongly right-skewed population distribution, the sampling distribution of the sample means is symmetric and bell-shaped, mimicking the normal model much more closely while remaining unimodal.

---

Step 3: Central Limit Theorem (CLT) & Model Overlay

We compute the theoretical Standard Error (\(SE = \frac{\sigma}{\sqrt{n}}\)) and superimpose the theoretical CLT normal density curve onto our simulated sample means histogram.

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

## [1] 1420.59

# Plot density histogram with overlayed normal curve
ggplot(data.frame(sample_means), aes(x = sample_means)) +
  geom_histogram(aes(y = after_stat(density)), fill = "salmon", color = "black", bins = 30) +
  stat_function(fun = dnorm, args = list(mean = mu, sd = SE), color = "blue", linewidth = 1.2) +
  labs(title = "Sampling Distribution with Overlayed CLT Normal Curve",
       x = "Sample Mean Total Price (USD)",
       y = "Density") +
  theme_minimal()

Interpretation: The Central Limit Theorem’s theoretical normal curve matches the simulated sample means remarkably well.

---

Step 4: Probability Above a Cutoff Value

We use pnorm() to compute the theoretical probability that a sample mean of size \(n = 30\) exceeds $6,200, and compare it to the simulated proportion.

# Theoretical probability using CLT
clt_prob <- pnorm(6200, mean = mu, sd = SE, lower.tail = FALSE)
clt_prob

## [1] 0.8105498

# Empirical proportion from simulation
sim_prob <- mean(sample_means > 6200)
sim_prob

## [1] 0.795

Interpretation: The theoretical probability calculated via CLT is approximately 0.8105, while the empirical proportion from the simulation is 0.795. These values are very similar; they differ slightly because the CLT provides an ideal continuous model, whereas the simulation relies on 1,000 random samples subject to minor empirical sampling variability.

---

Step 5: Finding a Cutoff Value (Quantiles)

Finally, we calculate the cutoff price above which 90% of sample means will fall (the 10th percentile) using qnorm() and check it against the empirical 10th percentile.

# Theoretical cutoff using qnorm
clt_cutoff <- qnorm(0.10, mean = mu, sd = SE)
clt_cutoff

## [1] 5629.452

# Empirical cutoff from simulation
sim_cutoff <- quantile(sample_means, 0.10)
sim_cutoff

##      10% 
## 5776.638

Interpretation: The theoretical cutoff is approximately $5,629.45 and the empirical cutoff is $5,776.64. In context, this means that 90% of random samples of size \(n = 30\) have a mean total price greater than roughly $5,629 to $5,777, with only 10% falling below this threshold.