penguins <- read.csv(
"https://raw.githubusercontent.com/acatlin/data/refs/heads/master/penguin_predictions.csv"
)
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
class_counts <- table(penguins$sex)
class_counts
##
## female male
## 39 54
null_error_rate <- 1 - max(class_counts) / sum(class_counts)
null_error_rate
## [1] 0.4193548
library(ggplot2)
ggplot(penguins, aes(x = sex)) +
geom_bar() +
labs(
title = "Distribution of Actual Penguin Sex",
x = "Sex",
y = "Count"
)
Explanation: The null error rate gives us a baseline to compare the model against. Since male is the more common class, a model that always guessed male would still be right a decent amount of the time. This helps show whether the actual model is doing better than just making the simplest possible guess.
confusion_matrix <- function(data, threshold) {
predicted_class <- ifelse(
data$.pred_female > threshold,
"female",
"male"
)
TP <- sum(predicted_class == "female" & data$sex == "female")
FP <- sum(predicted_class == "female" & data$sex == "male")
TN <- sum(predicted_class == "male" & data$sex == "male")
FN <- sum(predicted_class == "male" & data$sex == "female")
matrix(
c(TP, FN,
FP, TN),
nrow = 2,
byrow = TRUE,
dimnames = list(
Actual = c("Female", "Male"),
Predicted = c("Female", "Male")
)
)
}
cm_02 <- confusion_matrix(penguins, 0.2)
cm_05 <- confusion_matrix(penguins, 0.5)
cm_08 <- confusion_matrix(penguins, 0.8)
cm_02
## Predicted
## Actual Female Male
## Female 37 2
## Male 6 48
cm_05
## Predicted
## Actual Female Male
## Female 36 3
## Male 3 51
cm_08
## Predicted
## Actual Female Male
## Female 36 3
## Male 2 52
Explanation: As the threshold increased from 0.2 to 0.8, the model became more conservative about predicting the female class. At the 0.2 threshold, the model identified more females correctly but also produced more false positives. At the higher thresholds, false positives decreased while false negatives increased slightly. This shows the tradeoff between catching more positive cases and making fewer incorrect positive predictions.
performance_metrics <- function(TP, FP, TN, FN) {
accuracy <- (TP + TN) / (TP + TN + FP + FN)
precision <- TP / (TP + FP)
recall <- TP / (TP + FN)
f1 <- 2 * (precision * recall) / (precision + recall)
data.frame(
Accuracy = accuracy,
Precision = precision,
Recall = recall,
F1_Score = f1
)
}
metrics_02 <- performance_metrics(
TP = 37,
FP = 6,
TN = 48,
FN = 2
)
metrics_05 <- performance_metrics(
TP = 36,
FP = 3,
TN = 51,
FN = 3
)
metrics_08 <- performance_metrics(
TP = 36,
FP = 2,
TN = 52,
FN = 3
)
metrics_table <- rbind(
cbind(Threshold = 0.2, metrics_02),
cbind(Threshold = 0.5, metrics_05),
cbind(Threshold = 0.8, metrics_08)
)
round(metrics_table, 3)
## Threshold Accuracy Precision Recall F1_Score
## 1 0.2 0.914 0.860 0.949 0.902
## 2 0.5 0.935 0.923 0.923 0.923
## 3 0.8 0.946 0.947 0.923 0.935
Explanation: The 0.2 threshold produced the highest recall, meaning it identified the largest proportion of actual female cases, but it also had the lowest precision because it produced more false positives. The 0.8 threshold had the highest accuracy, precision, and F1 score.
Answer: From my understanding, a lower threshold such as 0.2 would be useful in a situation where missing a positive case would be costly. For example, in a hospital, it may be better to flag more people for more testing or follow-ups even if that creates some false positives. A higher threshold such as 0.8 would be useful when false positives are more costly. An example of that is like an insurance company may want stronger evidence before automatically giving a customer a payout.