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 analyze the variable TotalPrice (measured in dollars).

Step 1: Population Distribution

We begin by loading the required R packages, inspecting the population, and calculating the population parameters \(\mu\) (mu) and \(\sigma\) (sigma).

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

# Load data
data("Diamonds")

# Store population parameters
mu <- mean(Diamonds$TotalPrice)
sigma <- sd(Diamonds$TotalPrice)

# View parameter values
mu
## [1] 7450.012
sigma
## [1] 7780.894
# Plot population histogram
ggplot(Diamonds, aes(x = TotalPrice)) +
  geom_histogram(color = "black", fill = "skyblue", bins = 30) +
  labs(
    title = "Population Distribution of Diamond Prices",
    x = "Total Price ($)",
    y = "Frequency"
  ) +
  theme_minimal()

Analysis

The population distribution of diamond total prices is unimodal and strongly right-skewed. The population mean is \(\mu = \$7,450.01\) and the population standard deviation is \(\sigma = \$7,780.89\).

Step 2: Simulating the Sampling Distribution

Next, we set the sample size to \(n = 30\). Using replicate(), we draw 1,000 random samples of size 30 with replacement, calculate each sample mean, and examine the resulting empirical sampling distribution.

# Set seed for reproducibility
set.seed(123)

# Set sample size
n <- 30

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

# Summary statistics of sample means
mean(sample_means)
## [1] 7459.631
sd(sample_means)
## [1] 1405.478
# Plot histogram of simulated sample means
ggplot(data.frame(sample_means), 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"
  ) +
  theme_minimal()

Analysis

Although the original population distribution was heavily right-skewed, the sampling distribution of sample means (\(n = 30\)) is still unimodal but significantly closer to symmetric and bell-shaped.

Step 3: Central Limit Theorem Model

The Central Limit Theorem predicts that for \(n = 30\), the sampling distribution of sample means is approximately normal with center \(\mu\) and standard error \(\text{SE} = \sigma / \sqrt{n}\). We calculate SE and superimpose the theoretical normal curve over our simulated sample means on a density scale.

# Calculate Standard Error
SE <- sigma / sqrt(n)
SE
## [1] 1420.59
# Plot density histogram with superimposed CLT normal curve
ggplot(data.frame(sample_means), 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 vs. Theoretical CLT Normal Curve",
    x = "Sample Mean Total Price ($)",
    y = "Density"
  ) +
  theme_minimal()

Analysis

The theoretical normal curve fits the simulated sample means remarkably well. While a slight residual right-skewness remains noticeable on the left tail due to the extreme skewness of the underlying population, the theoretical parameters (\(\mu = \$7,450.01\), \(\text{SE} \approx \$1,420.64\)) match the mean and standard deviation of the simulated sample means almost perfectly.

Step 4: Probability Calculation with pnorm()

We evaluate the probability that a random sample of size \(n = 30\) has a sample mean greater than \(\$9,500\). We compare the CLT theoretical probability obtained using pnorm() to the empirical proportion from our simulation.

# Cutoff value
cutoff <- 9500

# CLT theoretical probability (upper tail)
clt_prob <- 1 - pnorm(cutoff, mean = mu, sd = SE)
clt_prob
## [1] 0.07450266
# Empirical simulation proportion
sim_prob <- mean(sample_means > cutoff)
sim_prob
## [1] 0.087

Analysis

  • CLT Theoretical Probability: 0.0745
  • Simulation Empirical Proportion: 0.087

The CLT probability and the simulated proportion are very close (~7.5%). They are not identical because the simulation uses random sampling, which introduces natural random variation across finite runs.

Step 5: Quantile Calculation with qnorm()

Finally, we determine the dollar value above which 90% of sample means will fall. This corresponds to the 10th percentile (0.10 lower-tail probability). We compute the CLT theoretical cutoff using qnorm() and compare it to the 10th percentile of our simulated sample means using quantile().

# CLT theoretical cutoff (10th percentile)
clt_cutoff <- qnorm(0.10, mean = mu, sd = SE)
clt_cutoff
## [1] 5629.452
# Simulation empirical cutoff (10th percentile)
sim_cutoff <- quantile(sample_means, 0.10)
sim_cutoff
##      10% 
## 5816.595

Analysis

  • CLT Theoretical Cutoff: \(\$5629.45\)
  • Simulation Empirical Cutoff: \(\$5816.6\)

About 90% of random samples of size \(n = 30\) will have a mean diamond price greater than approximately \(\$5,629\). Only 10% of random sample means fall below this dollar amount.