Week 2B Classification Metrics

In this assignment, I will evaluate a binary classification model using the penguin_predictions.csv dataset. I will compare model performance at probability thresholds of 0.2, 0.5, and 0.8.

Setup

First, I loaded the packages needed for the analysis.

library(tidyverse)

Read in the data

I loaded the penguin prediction data directly from the course GitHub repository.

penguins <- read_csv(
  "https://raw.githubusercontent.com/acatlin/data/refs/heads/master/penguin_predictions.csv",
  show_col_types = FALSE
)

head(penguins)

# A tibble: 6 × 3
  .pred_female .pred_class sex   
         <dbl> <chr>       <chr> 
1        0.992 female      female
2        0.954 female      female
3        0.985 female      female
4        0.187 male        female
5        0.995 female      female
6        1.000 female      female

I also checked the structure and column names.

str(penguins)

spc_tbl_ [93 × 3] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
 $ .pred_female: num [1:93] 0.992 0.954 0.985 0.187 0.995 ...
 $ .pred_class : chr [1:93] "female" "female" "female" "male" ...
 $ sex         : chr [1:93] "female" "female" "female" "female" ...
 - attr(*, "spec")=
  .. cols(
  ..   .pred_female = col_double(),
  ..   .pred_class = col_character(),
  ..   sex = col_character()
  .. )
 - attr(*, "problems")=<pointer: 0x1441591f0> 

names(penguins)

[1] ".pred_female" ".pred_class"  "sex"         

The dataset contains the predicted probability of being female, the predicted class, and the actual sex.

Null error rate

First, I checked the distribution of the actual sex variable.

class_distribution <- penguins %>%
  count(sex)

class_distribution

# A tibble: 2 × 2
  sex        n
  <chr>  <int>
1 female    39
2 male      54

I created a plot to show the class distribution.

ggplot(class_distribution, aes(x = sex, y = n, fill = sex)) +
  geom_col() +
  labs(
    title = "Distribution of Actual Penguin Sex",
    x = "Sex",
    y = "Count"
  ) +
  theme_minimal() +
  theme(legend.position = "none")

Next, I calculated the null error rate.

majority_count <- max(class_distribution$n)
total_count <- sum(class_distribution$n)

null_error_rate <- 1 - (majority_count / total_count)

null_error_rate

[1] 0.4193548

round(null_error_rate * 100, 2)

[1] 41.94

The null error rate is about 41.94%. This tells us how often we would be wrong if we always predicted the most common class. It gives us a baseline to compare with the classification model.

Create predictions at different thresholds

For this analysis, I treated female as the positive class.

I created predictions using thresholds of 0.2, 0.5, and 0.8.

penguins <- penguins %>%
  mutate(
    pred_02 = ifelse(.pred_female > 0.2, "female", "male"),
    pred_05 = ifelse(.pred_female > 0.5, "female", "male"),
    pred_08 = ifelse(.pred_female > 0.8, "female", "male")
  )

head(penguins)

# A tibble: 6 × 6
  .pred_female .pred_class sex    pred_02 pred_05 pred_08
         <dbl> <chr>       <chr>  <chr>   <chr>   <chr>  
1        0.992 female      female female  female  female 
2        0.954 female      female female  female  female 
3        0.985 female      female female  female  female 
4        0.187 male        female male    male    male   
5        0.995 female      female female  female  female 
6        1.000 female      female female  female  female 

A lower threshold predicts more observations as female, while a higher threshold requires a higher probability before predicting female.

Confusion matrices

I created a confusion matrix for each probability threshold.

Threshold 0.2

confusion_02 <- table(
  Actual = penguins$sex,
  Predicted = penguins$pred_02
)

confusion_02

        Predicted
Actual   female male
  female     37    2
  male        6   48

Threshold 0.5

confusion_05 <- table(
  Actual = penguins$sex,
  Predicted = penguins$pred_05
)

confusion_05

        Predicted
Actual   female male
  female     36    3
  male        3   51

Threshold 0.8

confusion_08 <- table(
  Actual = penguins$sex,
  Predicted = penguins$pred_08
)

confusion_08

        Predicted
Actual   female male
  female     36    3
  male        2   52

The confusion matrices show the true positives, false positives, true negatives, and false negatives at each threshold.

Performance metrics

I created a function to calculate accuracy, precision, recall, and F1 score.

calculate_metrics <- function(actual, predicted, threshold) {

  TP <- sum(actual == "female" & predicted == "female")
  FP <- sum(actual == "male" & predicted == "female")
  TN <- sum(actual == "male" & predicted == "male")
  FN <- sum(actual == "female" & predicted == "male")

  accuracy <- (TP + TN) / (TP + FP + TN + FN)
  precision <- TP / (TP + FP)
  recall <- TP / (TP + FN)
  f1 <- 2 * (precision * recall) / (precision + recall)

  tibble(
    Threshold = threshold,
    TP = TP,
    FP = FP,
    TN = TN,
    FN = FN,
    Accuracy = accuracy,
    Precision = precision,
    Recall = recall,
    F1 = f1
  )
}

I calculated the metrics for each threshold.

metrics_02 <- calculate_metrics(
  penguins$sex,
  penguins$pred_02,
  0.2
)

metrics_05 <- calculate_metrics(
  penguins$sex,
  penguins$pred_05,
  0.5
)

metrics_08 <- calculate_metrics(
  penguins$sex,
  penguins$pred_08,
  0.8
)

Results

I combined the results into one table.

metrics_table <- bind_rows(
  metrics_02,
  metrics_05,
  metrics_08
)

final_metrics <- metrics_table %>%
  mutate(
    across(
      c(Accuracy, Precision, Recall, F1),
      ~ round(.x, 3)
    )
  )

final_metrics

# A tibble: 3 × 9
  Threshold    TP    FP    TN    FN Accuracy Precision Recall    F1
      <dbl> <int> <int> <int> <int>    <dbl>     <dbl>  <dbl> <dbl>
1       0.2    37     6    48     2    0.914     0.86   0.949 0.902
2       0.5    36     3    51     3    0.935     0.923  0.923 0.923
3       0.8    36     2    52     3    0.946     0.947  0.923 0.935

At the 0.2 threshold, the model has the highest recall because it predicts more observations as female.

At the 0.8 threshold, the model has the highest accuracy, precision, and F1 score because it produces fewer false positives.

Threshold use cases

A threshold of 0.2 could be useful in medical screening. In this case, missing a patient who may actually have a disease could be more serious than sending someone for extra testing. A lower threshold can help reduce false negatives.

A threshold of 0.8 could be useful in fraud detection. A bank may want to be more confident before blocking a transaction. A higher threshold can help reduce false positives and avoid blocking legitimate purchases.

Conclusion

In this assignment, I compared a binary classification model using thresholds of 0.2, 0.5, and 0.8.

Changing the threshold changed the number of false positives and false negatives. The 0.2 threshold had the highest recall, while the 0.8 threshold had the highest accuracy, precision, and F1 score.

The null error rate gave a baseline for comparison. Overall, the best threshold depends on the situation and which type of error is more important to avoid.