Overview

In this lab, we analyze the sampling distribution of sample means using the Diamonds dataset from the Stat2Data package, treating the full dataset as our population and examining how the Central Limit Theorem (CLT) applies to the variable TotalPrice.

Step 1: Population Parameters & Distribution

We load the required libraries and dataset, generate a histogram of the population distribution of diamond total prices, and compute the population 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 = "Count"
  ) +
  theme_minimal()

# 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 total price is strongly right-skewed and bimodal/multimodal, with a population mean of \(\mu \approx \$7,450.01\) and a population standard deviation of \(\sigma \approx \$7,780.89\). The units of measurement are US dollars ($).

Step 2: Simulating the Sampling Distribution

We draw 1,000 random samples of size \(n = 30\) (with replacement) from the population, calculate the mean of each sample, and visualize the resulting sampling distribution.

# Set random seed for reproducibility
set.seed(123)

# Sample size and simulation settings
n <- 30
num_sims <- 1000

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

# Convert to 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 = "Count"
  ) +
  theme_minimal()

# Mean and SD of simulated sample means
mean_sample_means <- mean(sample_means)
sd_sample_means   <- sd(sample_means)

mean_sample_means
## [1] 7459.631
sd_sample_means
## [1] 1405.478

Interpretation

Compared to the severely right-skewed population distribution, the sampling distribution of sample means (\(n = 30\)) is much more symmetric and mound-shaped, with its center concentrated around \(\$7,450\).

Step 3: Central Limit Theorem Model vs. Simulation

The Central Limit Theorem predicts that the sampling distribution of sample means is approximately normal with center \(\mu\) and standard error \(SE = \sigma / \sqrt{n}\). We compute \(SE\) and overlay the theoretical normal density curve onto our simulated distribution.

# Compute Standard Error
SE <- sigma / sqrt(n)
SE
## [1] 1420.59
# Density histogram 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.2
  ) +
  labs(
    title = "Simulated Sampling Distribution vs. Theoretical CLT Normal Curve",
    x = "Sample Mean Total Price ($)",
    y = "Density"
  ) +
  theme_minimal()

Interpretation

The theoretical CLT normal curve fits the simulated histogram well. The simulation mean (\(\approx \$7,450\)) closely matches \(\mu \approx \$7,450.01\), and the simulation standard deviation (\(\approx \$1,420\)) closely matches \(SE \approx \$1,420.61\).

Step 4: Probability Calculation with pnorm()

We compute the probability that a random sample of \(n = 30\) diamonds has a mean total price greater than $10,000 using both the theoretical CLT model (pnorm()) and our simulation.

# Theoretical probability using CLT
prob_clt <- 1 - pnorm(10000, mean = mu, sd = SE)
prob_clt
## [1] 0.03632525
# Empirical proportion from simulation
prop_sim <- mean(sample_means > 10000)
prop_sim
## [1] 0.05

Interpretation

The theoretical probability from pnorm() and the empirical proportion from the simulation are close but not identical due to random sampling variation inherent in taking 1,000 random samples versus relying on an exact theoretical smooth curve.

Step 5: Cutoff Calculation with qnorm()

We find the cutoff value above which 90% of sample means lie (the 10th percentile) using both qnorm() and the simulation’s quantile() function.

# Theoretical 10th percentile cutoff using qnorm()
cutoff_clt <- qnorm(0.10, mean = mu, sd = SE)
cutoff_clt
## [1] 5629.452
# Empirical 10th percentile cutoff from simulation
cutoff_sim <- quantile(sample_means, 0.10)
cutoff_sim
##      10% 
## 5816.595

Interpretation

The theoretical cutoff is approximately $5,629.38, compared to the empirical cutoff of $5,622.70. In context, 90% of random samples of 30 diamonds will have a sample average total price exceeding approximately $5,629.