Week 2B Classification Metrics

Quarto

Quarto enables you to weave together content and executable code into a finished document. To learn more about Quarto see https://quarto.org.

Running Code

When you click the Render button a document will be generated that includes both content and the output of embedded code. You can embed code like this:

# ============================================================
# Classification Metrics: Code Base Submission
# Assignment: Evaluating Classification Model Performance
# Positive class: female
# ============================================================

# ---------------------------
# 1. Load packages and data
# ---------------------------

# Install ggplot2 once if needed:
# install.packages("ggplot2")

library(ggplot2)

url <- "https://raw.githubusercontent.com/acatlin/data/refs/heads/master/penguin_predictions.csv"

penguins <- read.csv(url, check.names = FALSE)

# Inspect the data
head(penguins)

  .pred_female .pred_class    sex
1    0.9921746      female female
2    0.9542394      female female
3    0.9847350      female female
4    0.1870206        male female
5    0.9947012      female female
6    0.9999891      female female

str(penguins)

'data.frame':   93 obs. of  3 variables:
 $ .pred_female: num  0.992 0.954 0.985 0.187 0.995 ...
 $ .pred_class : chr  "female" "female" "female" "male" ...
 $ sex         : chr  "female" "female" "female" "female" ...

table(penguins$sex)

female   male 
    39     54 

# Convert the actual class to binary:
# female = 1 (positive class)
# male   = 0 (negative class)
penguins$actual <- ifelse(penguins$sex == "female", 1, 0)


# ============================================================
# TASK 1: NULL ERROR RATE
# ============================================================

class_counts <- table(penguins$sex)
class_counts

female   male 
    39     54 

majority_count <- max(class_counts)
total_count <- nrow(penguins)

null_accuracy <- majority_count / total_count
null_error_rate <- 1 - null_accuracy

cat("Null accuracy =", round(null_accuracy, 4), "\n")

Null accuracy = 0.5806 

cat("Null error rate =", round(null_error_rate, 4), "\n")

Null error rate = 0.4194 

# Plot actual class distribution
class_plot <- ggplot(penguins, aes(x = sex)) +
  geom_bar() +
  labs(
    title = "Distribution of Actual Penguin Sex",
    x = "Actual Class",
    y = "Count"
  ) +
  theme_minimal()

print(class_plot)

# Optional: save the plot
ggsave(
  "actual_class_distribution.png",
  plot = class_plot,
  width = 7,
  height = 5
)


# ============================================================
# TASKS 2 AND 3:
# CONFUSION MATRICES AND PERFORMANCE METRICS
# ============================================================

# Function to evaluate a probability threshold
evaluate_threshold <- function(data, threshold) {
  
  # Recompute predicted class from probability
  predicted <- ifelse(data$.pred_female > threshold, 1, 0)
  
  # Confusion-matrix counts
  TP <- sum(predicted == 1 & data$actual == 1)
  FP <- sum(predicted == 1 & data$actual == 0)
  TN <- sum(predicted == 0 & data$actual == 0)
  FN <- sum(predicted == 0 & data$actual == 1)
  
  # Confusion matrix:
  # Rows = Actual
  # Columns = Predicted
  confusion_matrix <- matrix(
    c(TN, FP,
      FN, TP),
    nrow = 2,
    byrow = TRUE,
    dimnames = list(
      Actual = c("Male (0)", "Female (1)"),
      Predicted = c("Male (0)", "Female (1)")
    )
  )
  
  # Performance metrics
  accuracy <- (TP + TN) / (TP + FP + TN + FN)
  precision <- TP / (TP + FP)
  recall <- TP / (TP + FN)
  f1 <- 2 * precision * recall / (precision + recall)
  
  # Return everything
  list(
    threshold = threshold,
    TP = TP,
    FP = FP,
    TN = TN,
    FN = FN,
    confusion_matrix = confusion_matrix,
    accuracy = accuracy,
    precision = precision,
    recall = recall,
    f1 = f1
  )
}


# Evaluate the three required thresholds
result_02 <- evaluate_threshold(penguins, 0.2)
result_05 <- evaluate_threshold(penguins, 0.5)
result_08 <- evaluate_threshold(penguins, 0.8)


# ---------------------------
# Confusion Matrix: 0.2
# ---------------------------
cat("\nThreshold = 0.2\n")

Threshold = 0.2

print(result_02$confusion_matrix)

            Predicted
Actual       Male (0) Female (1)
  Male (0)         48          6
  Female (1)        2         37

# ---------------------------
# Confusion Matrix: 0.5
# ---------------------------
cat("\nThreshold = 0.5\n")

Threshold = 0.5

print(result_05$confusion_matrix)

            Predicted
Actual       Male (0) Female (1)
  Male (0)         51          3
  Female (1)        3         36

# ---------------------------
# Confusion Matrix: 0.8
# ---------------------------
cat("\nThreshold = 0.8\n")

Threshold = 0.8

print(result_08$confusion_matrix)

            Predicted
Actual       Male (0) Female (1)
  Male (0)         52          2
  Female (1)        3         36

# ============================================================
# PERFORMANCE-METRICS TABLE
# ============================================================

metrics_table <- data.frame(
  Threshold = c(0.2, 0.5, 0.8),
  
  TP = c(
    result_02$TP,
    result_05$TP,
    result_08$TP
  ),
  
  FP = c(
    result_02$FP,
    result_05$FP,
    result_08$FP
  ),
  
  TN = c(
    result_02$TN,
    result_05$TN,
    result_08$TN
  ),
  
  FN = c(
    result_02$FN,
    result_05$FN,
    result_08$FN
  ),
  
  Accuracy = c(
    result_02$accuracy,
    result_05$accuracy,
    result_08$accuracy
  ),
  
  Precision = c(
    result_02$precision,
    result_05$precision,
    result_08$precision
  ),
  
  Recall = c(
    result_02$recall,
    result_05$recall,
    result_08$recall
  ),
  
  F1 = c(
    result_02$f1,
    result_05$f1,
    result_08$f1
  )
)

# Round for easier reading
metrics_table[, c("Accuracy", "Precision", "Recall", "F1")] <-
  round(
    metrics_table[, c("Accuracy", "Precision", "Recall", "F1")],
    4
  )

print(metrics_table)

  Threshold TP FP TN FN Accuracy Precision Recall     F1
1       0.2 37  6 48  2   0.9140    0.8605 0.9487 0.9024
2       0.5 36  3 51  3   0.9355    0.9231 0.9231 0.9231
3       0.8 36  2 52  3   0.9462    0.9474 0.9231 0.9351

# Optional: save table as CSV
write.csv(
  metrics_table,
  "classification_metrics_results.csv",
  row.names = FALSE
)


# ============================================================
# TASK 4: THRESHOLD USE CASES
# ============================================================

cat(
  "\nTHRESHOLD INTERPRETATION\n",
  "\n0.2 threshold:\n",
  "A lower threshold is useful when missing a true positive is costly.\n",
  "Example: medical screening for a serious disease. The model can flag\n",
  "more people for additional testing, accepting more false positives in\n",
  "exchange for higher recall.\n",
  "\n0.8 threshold:\n",
  "A higher threshold is useful when false positives are costly.\n",
  "Example: automatically approving a high-risk action only when the model\n",
  "is very confident. Fewer observations are labeled positive, which tends\n",
  "to increase precision but can miss some true positives.\n",
  sep = ""
)

THRESHOLD INTERPRETATION

0.2 threshold:
A lower threshold is useful when missing a true positive is costly.
Example: medical screening for a serious disease. The model can flag
more people for additional testing, accepting more false positives in
exchange for higher recall.

0.8 threshold:
A higher threshold is useful when false positives are costly.
Example: automatically approving a high-risk action only when the model
is very confident. Fewer observations are labeled positive, which tends
to increase precision but can miss some true positives.

# ============================================================
# SHORT INTERPRETATION
# ============================================================

cat(
  "\nINTERPRETATION\n",
  "The null error rate shows the error we would get by always predicting\n",
  "the majority class. A useful classification model should improve on\n",
  "this simple baseline. Lowering the probability threshold predicts more\n",
  "positive cases and usually increases recall. Raising the threshold makes\n",
  "positive predictions more selective and usually increases precision.\n",
  "Therefore, threshold choice should depend on the consequences of false\n",
  "positives and false negatives.\n",
  sep = ""
)

INTERPRETATION
The null error rate shows the error we would get by always predicting
the majority class. A useful classification model should improve on
this simple baseline. Lowering the probability threshold predicts more
positive cases and usually increases recall. Raising the threshold makes
positive predictions more selective and usually increases precision.
Therefore, threshold choice should depend on the consequences of false
positives and false negatives.