Sampling Distributions and Central Limit Theorem: Diamonds Dataset

Introduction

In this report, we explore sampling distributions and the Central Limit Theorem (CLT) using the Diamonds dataset from the Stat2Data package. We treat the full dataset as our population and focus on the variable TotalPrice (measured in dollars).

Step 1: Population Parameters & Distribution

First, we load the required packages, inspect the population distribution of diamond prices, and calculate the true population parameters: mean (\(\mu\)) and standard deviation (\(\sigma\)).

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

# Load dataset
data("Diamonds")

# Graph the 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

The population distribution of diamond prices is strongly right-skewed and unimodal, with values measured in dollars ($).

---

Step 2: Simulating the Sampling Distribution

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

# Set seed for reproducibility
set.seed(123)

# Set sample size
n <- 30

# Simulate 1000 sample means
sample_means <- replicate(1000, {
  sample_data <- sample(Diamonds$TotalPrice, size = n, replace = TRUE)
  mean(sample_data)
})

# Convert to data frame for plotting
sim_data <- data.frame(sample_means)

# Graph the 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"
  )

# Summary statistics of simulated sample means
mean(sample_means)

## [1] 7459.631

sd(sample_means)

## [1] 1405.478

Interpretation

While the original population was heavily right-skewed, the sampling distribution of the sample mean is much more symmetric and bell-shaped.

---

Step 3: Theoretical CLT Model vs. Simulation

According to the Central Limit Theorem (CLT), for a sufficiently large sample size (\(n \ge 30\)), the sampling distribution of the sample mean is approximately normal with center \(\mu\) and standard error \(SE = \sigma / \sqrt{n}\).

We calculate \(SE\) and superimpose the theoretical normal curve (\(\text{dnorm}\)) onto our simulated sampling distribution.

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

## [1] 1420.59

# Graph histogram on a density scale with superimposed CLT normal curve
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 Sampling Distribution vs. CLT Theoretical Normal Curve",
    x = "Sample Mean Total Price ($)",
    y = "Density"
  )

Interpretation

The CLT’s theoretical model provides an excellent match for the simulated sample means. Even though the underlying population data was heavily right-skewed, the sampling distribution naturally forms a symmetric, bell-shaped normal curve. Furthermore, the mean of the sample means is virtually identical to \(\mu\), and sd(sample_means) closely matches \(SE\).

---

Step 4: Tail Probabilities with pnorm()

We calculate the probability that a random sample of size \(n = 30\) has a mean price greater than \(\$6,200\) (roughly \(1.62\) standard errors above \(\mu\)).

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

## [1] 0.8105498

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

## [1] 0.824

Interpretation

The small difference between the theoretical probability (clt_prob) and the simulated proportion (sim_prop) is caused by simulation error (sampling variability). The theoretical probability uses an ideal, continuous normal curve, whereas the simulation draws a finite set of 1,000 samples.

---

Step 5: Cutoff Values with qnorm()

Finally, we determine the dollar value above which 90% of sample means lie (i.e., the 10th percentile).

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

## [1] 5629.452

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

##      10% 
## 5816.595

Interpretation

The 10th percentile calculated by qnorm() is approximately \(\$4,084\). This means that about 90% of random samples of size \(n = 30\) will have an average total price above \(\$4,084\). The empirical percentile from our simulation closely matches this theoretical value.