R: Milk quality binary classification

R libraries I used

I used R with the tidyverse tools for data import and preprocessing, along with tidymodels for creating a logistic regression model and assessing its performance.

Initial data load

In the dataset, there are 1,059 observations with eight variables each. There is no missing data.

milk_raw <- read_csv("data/milknew.csv")

## Rows: 1059 Columns: 8
## ── Column specification ───────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────
## Delimiter: ","
## chr (1): Grade
## dbl (7): pH, Temprature, Taste, Odor, Fat, Turbidity, Colour
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

knitr::kable(head(milk_raw))

Preprocessing

I only performed one preprocessing step to create a binary classification from three original classes. Because there are three classes in the data, and I could only use two for a binary classifier, I combined the initial “high” and “medium” qualities into a new category I called “good” and the original “low” quality into a new category called “bad.” I then used these new categories to train the binary classifier. My positive event is finding milk of “good” quality, so I make “good” the first factor level for the outcome variable.

milk_clean <- milk_raw %>%
  transmute(
    pH,
    Temperature = Temprature,
    Odor,
    Fat,
    Turbidity,
    Taste,
    Color = Colour,
    Quality = factor(
      case_when(
        Grade == "high" ~ "good",
        Grade == "medium" ~ "good",
        Grade == "low" ~ "bad"
      ),
      levels = c("good", "bad")
    )
  )

knitr::kable(head(milk_clean))

Model setup and training

I used 793 rows for training and 266 rows for testing. First, I set up a logistic regression binary classifier using R’s glm function. Then, I predicted the class (stored as the variable Quality) using every other variable.

milk_split <- initial_split(milk_clean, prop = 0.75, strata = Quality)

logistic_model <- logistic_reg() %>%
  set_engine("glm") %>%
  set_mode("classification")

logistic_last_fit <- logistic_model %>%
  last_fit(Quality ~ ., split = milk_split)

ROC AUC and accuracy metrics

logistic_last_fit %>%
  collect_metrics() %>%
  knitr::kable()

ROC curve and mosaic plot

logistic_last_fit_results <- logistic_last_fit %>%
  collect_predictions()

logistic_last_fit_results %>%
  roc_curve(truth = Quality, .pred_good) %>%
  autoplot()

logistic_last_fit_results %>%
  conf_mat(truth = Quality, estimate = .pred_class) %>%
  autoplot(type = "mosaic")

The ROC plot shows the ROC AUC of 0.92 visually. In the mosaic plot, we see the sensitivity of 90% is better than the specificity of 77%.

All metrics

logistic_last_fit_results %>%
  conf_mat(truth = Quality, estimate = .pred_class) %>%
  summary() %>%
  knitr::kable()