Introduction

In this analysis, we explore the behavior of sampling distributions and demonstrate the Central Limit Theorem (CLT). We treat the Diamonds dataset from the Stat2Data package as our population, specifically analyzing the TotalPrice variable.

We will compare the empirical properties of simulated sample means against the theoretical predictions made by the Central Limit Theorem using pnorm() and qnorm().

library(Stat2Data)
library(dplyr)
library(ggplot2)

Step 1: Population Baseline

We begin by loading the population data and examining the distribution of diamond total prices.

# Load data
data("Diamonds")

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

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

# Output population parameters
mu
## [1] 7450.012
sigma
## [1] 7780.894

Analysis

The population distribution of diamond total prices is strongly unimodal and right-skewed, with a large concentration of lower-priced diamonds and a long right tail of high-value diamonds. The population mean is \(\mu \approx \$7,450.00\) USD and the population standard deviation is \(\sigma \approx \$7,780.90\) USD.

Step 2: Simulating the Sampling Distribution

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

# Set seed for reproducibility
set.seed(42)

# Simulation parameters
n <- 30
num_samples <- 1000

# Draw 1000 samples of size n=30 and compute sample means
sample_means <- replicate(num_samples, {
  sample_data <- sample(Diamonds$TotalPrice, size = n, replace = TRUE)
  mean(sample_data)
})

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

# Summary statistics of simulated sample means
mean(sample_means)
## [1] 7421.124
sd(sample_means)
## [1] 1405.82

Analysis

Despite the population distribution being heavily right-skewed, the sampling distribution of sample means (\(n = 30\)) is unimodal and approximately symmetric (bell-shaped). The empirical mean of our \(1,000\) sample means is very close to the population mean \(\mu\), while the spread (standard deviation of sample means) is significantly narrower than the population standard deviation \(\sigma\).

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

The Central Limit Theorem states that for a sufficiently large sample size (\(n \ge 30\)), the sampling distribution of the sample mean is approximately normal:

\[\bar{X} \sim N\left(\mu, \text{SE}\right) \quad \text{where} \quad \text{SE} = \frac{\sigma}{\sqrt{n}}\]

We calculate the theoretical Standard Error (\(\text{SE}\)) and overlay the CLT normal density curve (dnorm) on top of our simulated sampling distribution histogram.

# Calculate and store Standard Error
SE <- sigma / sqrt(n)
SE
## [1] 1420.59
# Graph histogram on density scale with theoretical normal curve superimposed
ggplot(data.frame(sample_means), aes(x = sample_means)) +
  geom_histogram(aes(y = after_stat(density)), bins = 30, fill = "salmon", color = "black") +
  stat_function(fun = dnorm, args = list(mean = mu, sd = SE), color = "blue", linewidth = 1.2) +
  labs(
    title = "Sampling Distribution with CLT Normal Curve Overlay",
    x = "Sample Mean Total Price ($)",
    y = "Density"
  ) +
  theme_minimal()

Analysis

The theoretical CLT normal model (\(\mu \approx \$7,450\), \(\text{SE} \approx \$1,420.61\)) provides an excellent fit for the empirical simulation. The center and spread of the theoretical normal density curve closely mirror the mean (\(\approx \$7,450\)) and standard deviation (\(\approx \$1,420\)) of our simulated sample means.

Step 4: Probability Above a Cutoff Value

We now calculate the probability that a random sample of \(n = 30\) diamonds has a mean price greater than $9,500 (roughly \(1.44\) standard errors above \(\mu\)).

We compare the theoretical normal probability calculated using pnorm() with the empirical proportion of simulated sample means exceeding $9,500.

# Theoretical probability using CLT model
prob_theoretical <- 1 - pnorm(9500, mean = mu, sd = SE)
prob_theoretical
## [1] 0.07450266
# Empirical proportion from simulated sample means
prop_empirical <- mean(sample_means > 9500)
prop_empirical
## [1] 0.084

Analysis

The theoretical CLT model estimates a \(7.47\%\) chance (pnorm) that a random sample of \(30\) diamonds will have a mean total price exceeding \(\$9,500\). In our empirical simulation of \(1,000\) samples, \(8.10\%\) of the sample means exceeded \(\$9,500\). These two values are very close because the simulation reflects actual random sampling variation, which naturally fluctuates slightly around the smooth mathematical ideal predicted by the Central Limit Theorem.

Step 5: Finding a Percentile Cutoff

Finally, we determine the price threshold above which \(90\%\) of samples of size \(n = 30\) will fall. This corresponds to finding the 10th percentile (the lower \(10\%\) cutoff).

We compute the theoretical threshold using qnorm() and compare it to the 10th percentile (quantile) of our simulated sample means.

# Theoretical cutoff from CLT (10th percentile)
cutoff_theoretical <- qnorm(0.10, mean = mu, sd = SE)
cutoff_theoretical
## [1] 5629.452
# Empirical cutoff from simulated sample means
cutoff_empirical <- quantile(sample_means, 0.10)
cutoff_empirical
##      10% 
## 5776.638

Analysis

According to the Central Limit Theorem, \(90\%\) of random samples of \(30\) diamonds will have a sample mean total price above \(\approx \$5,629.42\). In our empirical simulation, \(90\%\) of the sample means fell above \(\approx \$5,616.89\). For a researcher or buyer taking random samples of size \(30\), this indicates it is quite rare (less than a \(10\%\) chance) to obtain a sample mean price below roughly \(\$5,620-\$5,630\).