Introduction

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

Packages and Setup

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

data("Diamonds")

Step 1: Population Distribution & Parameters

We calculate the population mean (\(\mu\)) and population standard deviation (\(\sigma\)) for diamond prices, then display the population histogram.

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

mu
## [1] 7450.012
sigma
## [1] 7780.894
# Population Histogram
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")

Analysis & Interpretation

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

Step 2: Simulating the Sampling Distribution

We take 1,000 random samples of size \(n = 30\) with replacement from the population and compute the sample mean for each.

set.seed(42)
n <- 30

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

sim_data <- data.frame(sample_means = sample_means)

# Histogram of sample means
ggplot(sim_data, aes(x = sample_means)) +
  geom_histogram(bins = 30, fill = "lightgreen", color = "black") +
  labs(title = "Sampling Distribution of Sample Means (n = 30)",
       x = "Sample Mean Total Price (USD)",
       y = "Count")

# Mean and SD of simulated sample means
mean(sample_means)
## [1] 7421.124
sd(sample_means)
## [1] 1405.82

Analysis & Interpretation

Even though the population distribution is strongly right-skewed, the sampling distribution of sample_means is much more symmetric and bell-shaped.

Step 3: Central Limit Theorem Model

The Central Limit Theorem predicts that the distribution of sample means will be approximately normal with mean \(\mu\) and standard error \(\text{SE} = \frac{\sigma}{\sqrt{n}}\).

# Standard Error
SE <- sigma / sqrt(n)
SE
## [1] 1420.59
# Density Histogram with Overlay Normal Curve
ggplot(sim_data, aes(x = sample_means)) +
  geom_histogram(aes(y = after_stat(density)), bins = 30, fill = "lightgreen", color = "black") +
  stat_function(fun = dnorm, args = list(mean = mu, sd = SE), color = "red", linewidth = 1) +
  labs(title = "Simulated Sampling Distribution with CLT Normal Curve",
       x = "Sample Mean Total Price (USD)",
       y = "Density")

Analysis & Interpretation

The Central Limit Theorem theoretical model matches the simulated sampling distribution closely. The population mean \(\mu\) and theoretical standard error \(\text{SE}\) are very similar to the mean and standard deviation of the simulated sample means (mean(sample_means) and sd(sample_means)), and the theoretical normal density curve aligns well with the histogram.

Step 4: Probability Above a Cutoff Value

We calculate the probability that a random sample of size \(n = 30\) has a mean price greater than $6,200 using both the theoretical normal distribution (pnorm()) and our simulation.

# 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_prop <- mean(sample_means > 6200)
sim_prop
## [1] 0.795

Analysis & Interpretation

The CLT theoretical probability and the simulated proportion are very close. They are not completely identical due to random sampling variation inherent in taking 1,000 random samples in the simulation.

Step 5: Finding a Percentile / Cutoff Value

We determine the cutoff value above which 90% of sample means will fall (equivalent to the 10th percentile of the sampling distribution) using qnorm() and compare it to the 10th percentile of the simulated sample means (quantile()).

# Theoretical 10th percentile (CLT)
clt_cutoff <- qnorm(0.10, mean = mu, sd = SE)
clt_cutoff
## [1] 5629.452
# Empirical 10th percentile (Simulation)
sim_cutoff <- quantile(sample_means, probs = 0.10)
sim_cutoff
##      10% 
## 5776.638

Analysis & Interpretation

The theoretical cutoff calculated with qnorm() and the empirical 10th percentile from quantile() are very close. In context, this means that about 90% of random samples of 30 diamonds will have an average total price above this value (or equivalently, only 10% of samples of size 30 will have a mean total price below it).