\[\bar{y} = \frac{1}{n}\sum_{i \in S} y_i, \qquad SE(\bar{y}) = \sqrt{\left(1 - \frac{n}{N}\right)\frac{s^2}{n}}\]

\[\hat{p} = \frac{1}{n}\sum_{i \in S} y_i \ (y_i = 0 \text{ or } 1), \qquad SE(\hat{p}) = \sqrt{\left(1 - \frac{n}{N}\right)\frac{\hat{p}(1-\hat{p})}{n-1}}\]

\[\hat{t} = N\bar{y}, \qquad SE(\hat{t}) = N \cdot SE(\bar{y})\]

A 95% confidence interval is the estimate \(\pm\, t_{0.025,\,n-1} \times SE\).

# Read a data file if it is in the same folder as this .Rmd file.
# Otherwise, load the same data from the textbook's SDAResources package.
load_data <- function(file_names, package_name) {
  for (f in file_names) {
    if (file.exists(f)) return(read.csv(f))
  }
  if (!requireNamespace("SDAResources", quietly = TRUE)) {
    install.packages("SDAResources", repos = "https://cloud.r-project.org")
  }
  e <- new.env()
  data(list = package_name, package = "SDAResources", envir = e)
  as.data.frame(e[[package_name]])
}

# Estimated mean, SE, and 95% CI for an SRS
srs_mean <- function(y, N) {
  n     <- length(y)
  ybar  <- mean(y)
  se    <- sqrt((1 - n / N) * var(y) / n)
  tcrit <- qt(0.975, df = n - 1)
  c(Mean = ybar, SE = se, Lower = ybar - tcrit * se, Upper = ybar + tcrit * se)
}

# Estimated proportion, SE, and 95% CI for an SRS (y is TRUE/FALSE or 0/1)
srs_prop <- function(y, N) {
  n     <- length(y)
  p     <- mean(y)
  se    <- sqrt((1 - n / N) * p * (1 - p) / (n - 1))
  tcrit <- qt(0.975, df = n - 1)
  c(Proportion = p, SE = se, Lower = p - tcrit * se, Upper = p + tcrit * se)
}

# Format a number with commas and a fixed number of decimal places
fmt <- function(x, digits = 2) formatC(x, format = "f", digits = digits, big.mark = ",")

# Histogram with consistent formatting
plot_hist <- function(x, title, xlab) {
  hist(x, col = "hotpink", border = "white",
       main = title, xlab = xlab, ylab = "Frequency")
}

Agricultural Data

Problem 1

The file agsrs.csv is an SRS of \(n = 300\) counties from the \(N = 3{,}078\) counties in the United States.

agsrs <- load_data(c("agsrs.csv", "agsrs-1-2.csv"), "agsrs")
N_ag  <- 3078
n_ag  <- nrow(agsrs)
n_ag
[1] 300

(a) Acres devoted to farms in 1987 (acres87)

plot_hist(agsrs$acres87, "Acres Devoted to Farms in 1987", "Acres (acres87)")

p1a <- srs_mean(agsrs$acres87, N_ag)
round(p1a, 2)
     Mean        SE     Lower     Upper 
301953.72  18913.67 264732.96 339174.49

The estimated mean is \(\bar{y}\) = 301,953.72 acres per county. A 95% CI is (264,732.96, 339,174.49).

(b) Number of farms in 1992 (farms92)

plot_hist(agsrs$farms92, "Number of Farms in 1992", "Farms (farms92)")

p1b <- srs_mean(agsrs$farms92, N_ag)
round(p1b, 2)
  Mean     SE  Lower  Upper 
599.06  22.06 555.64 642.48

The estimated mean is \(\bar{y}\) = 599.06 farms per county. A 95% CI is (555.64, 642.48).

(c) Number of farms with 1,000 acres or more in 1992 (largef92)

plot_hist(agsrs$largef92, "Farms with 1,000 Acres or More in 1992", "Large farms (largef92)")

p1c <- srs_mean(agsrs$largef92, N_ag)
round(p1c, 2)
 Mean    SE Lower Upper 
56.59  3.99 48.74 64.45

The estimated mean is \(\bar{y}\) = 56.59 large farms per county. A 95% CI is (48.74, 64.45).

(d) Number of farms with 9 acres or fewer in 1992 (smallf92)

plot_hist(agsrs$smallf92, "Farms with 9 Acres or Fewer in 1992", "Small farms (smallf92)")

p1d <- srs_mean(agsrs$smallf92, N_ag)
round(p1d, 2)
 Mean    SE Lower Upper 
46.82  3.64 39.66 53.98

The estimated mean is \(\bar{y}\) = 46.82 small farms per county. A 95% CI is (39.66, 53.98).

Summary

p1 <- rbind(acres87 = p1a, farms92 = p1b, largef92 = p1c, smallf92 = p1d)
knitr::kable(p1, digits = 2, format.args = list(big.mark = ","),
             col.names = c("Mean", "SE", "95% CI Lower", "95% CI Upper"))
Mean SE 95% CI Lower 95% CI Upper
acres87 301,953.72 18,913.67 264,732.96 339,174.49
farms92 599.06 22.06 555.64 642.48
largef92 56.59 3.99 48.74 64.45
smallf92 46.82 3.64 39.66 53.98

All four histograms are skewed to the right: most counties have small values, and a few counties have very large values.

Golf Data

The file golfsrs.csv is an SRS of \(n = 120\) courses from a list of \(N = 14{,}938\) golf courses in the United States.

golfsrs <- load_data(c("golfsrs.csv", "golfsrs-4.csv"), "golfsrs")
N_golf  <- 14938
n_golf  <- nrow(golfsrs)
n_golf
[1] 120

Problem 2: Weekday greens fee for nine holes (wkday9)

(a) Histogram and shape

plot_hist(golfsrs$wkday9, "Weekday Greens Fee for Nine Holes", "Fee in dollars (wkday9)")

summary(golfsrs$wkday9)
   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
   3.00    9.50   12.00   20.15   25.00  101.00

The distribution is skewed to the right. Most courses charge a low fee (the median is $12), and a few courses charge much more, up to $101. Because of the long right tail, the mean ($20.15) is well above the median.

(b) Estimated mean and SE

p2 <- srs_mean(golfsrs$wkday9, N_golf)
round(p2[c("Mean", "SE")], 4)
   Mean      SE 
20.1533  1.6299

The estimated population mean weekday greens fee for nine holes is \(\bar{y}\) = $20.15, with \(SE(\bar{y})\) = 1.6299.

Problem 3: Back tee yardage (backtee)

(a) Histogram and shape

plot_hist(golfsrs$backtee, "Back Tee Yardage", "Yards (backtee)")

summary(golfsrs$backtee)
   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
    683    3151    6262    5310    6593    7176

The distribution is skewed to the left and bimodal. Most courses are clustered around 6,000 to 7,000 yards, and a smaller group is around 2,000 to 4,000 yards. The two peaks match the two course sizes: 18-hole courses are long, and 9-hole courses are about half as long.

# Back tee yardage by number of holes
tapply(golfsrs$backtee, golfsrs$holes, median)
   9   11   18 
2982 3016 6494

(b) Estimated mean and SE

p3 <- srs_mean(golfsrs$backtee, N_golf)
round(p3[c("Mean", "SE")], 4)
     Mean        SE 
5309.7667  164.5316

The estimated population mean back tee yardage is \(\bar{y}\) = 5,309.77 yards, with \(SE(\bar{y})\) = 164.5316.

Problem 4: Proportion of courses with 18 holes

table(golfsrs$holes)

 9 11 18 
34  1 85 
p4 <- srs_prop(golfsrs$holes == 18, N_golf)
round(p4, 4)
Proportion         SE      Lower      Upper 
    0.7083     0.0415     0.6262     0.7905

(a) Estimated proportion

The estimated population proportion of golf courses with 18 holes is \(\hat{p}\) = 0.7083.

(b) 95% confidence interval

A 95% CI for the population proportion is (0.6262, 0.7905).

Chicago Police Data

Problem 5

The file crimes.csv is an SRS of \(n = 5{,}000\) records from the \(N = 7{,}048{,}107\) crimes known to Chicago police from 2001 through 2019.

crimes  <- load_data(c("crimes.csv"), "crimes")
N_crime <- 7048107
n_crime <- nrow(crimes)
n_crime
[1] 5000

(a) Sampling weight

crimes$weight <- N_crime / n_crime
unique(crimes$weight)
[1] 1409.621

Each record has a sampling weight of \(w_i = N/n = 7{,}048{,}107/5{,}000\) = 1,409.6214.

(b) Percentage of crimes with an arrest

p5b <- srs_prop(crimes$arrest == 1, N_crime)
round(100 * p5b, 2)   # shown as percentages
Proportion         SE      Lower      Upper 
     27.66       0.63      26.42      28.90

An estimated 27.66% of crimes had an arrest. A 95% CI is (26.42%, 28.90%).

(c) Total number of burglaries

\[\hat{t} = N\hat{p}, \qquad SE(\hat{t}) = N \cdot SE(\hat{p})\]

p_burg <- srs_prop(crimes$crimetype == "burglary", N_crime)
t_burg <- N_crime * p_burg
names(t_burg) <- c("Total", "SE", "Lower", "Upper")
round(t_burg, 0)
 Total     SE  Lower  Upper 
415838  23480 369807 461869

The estimated total number of burglaries known to police from 2001 through 2019 is 415,838. A 95% CI for the total is (369,807, 461,869).