Machine Learning on R Views

MLDataR - Real-world Datasets for Machine Learning Applications

Tue, 19 Apr 2022 00:00:00 +0000

This is a guest post from Gary Hutson, lead of Machine Learning at Crisp Thinking, a company that provides AI solutions to moderate and detect offensive and abusive content online. His website is available at https://hutsons-hacks.info/ and he can be reached through Twitter, @StatsGary.

MLDataR package motivation

I love all things Machine Learning. The MLDataR package was driven by the need to have example datasets across the healthcare system for machine learning problems. I have been a machine learning practitioner for over nine years; however, I still find it interesting to explore new examples and datasets related to supervised machine learning classification and regression.

Because the package contains clinical examples and examples from real hospital systems, it allows the potential machine learning engineer to practice all things related to supervised machine learning.

Despite the package initially being aimed at healthcare, I have expanded it to new territories and domains.

What does the package contain?

The package contains several datasets for modelling. This is just a start and I am working with the NHS-R community to build it out even further. It is a sort of a call to arms to equip the package with even more examples of excellent datasets that can be used for machine learning.

Diabetes disease prediction - This dataset contains key variables, gathered from hospital research and papers in the British Medical Journal to identify the drivers behind diabetes disease. This dataset is useful for working with supervised classification machine learning problems or statistical problems. It uses past historical patient information to train and classify a model, with the aim to classify if a patient will have diabetes when they first present to the service.

Diabetes early onset - Gathered by Asif Laldin, the package contributor from Gloucestershire Clinical Commissioning Group, this dataset contains information on the time between a prediabetes diagnosis and the onset of diabetes.

Failing care home prediction - Using measures from the NHS incident reporting databases, this dataset contains data to classify if a care home will fail based on results from retrospective inspections.

Heart disease prediction - This dataset is intended for supervised machine learning classification problems on which patients are likely to present with heart disease. This uses independent variables, such as resting blood pressure, maximum heart rate, history of angina, and other metrics.

Thyroid disease classification - This one has a personal effect on me, as I am a sufferer of this disease. This drove me to source this dataset from the Garavan Institute, based on a collection of studies this institute did around thyroid disease. This contains 28 independent or predictor variables of patients with or without the disease. It is also covered in the vignette supporting this package and the supporting YouTube tutorial using tidymodels with various ML techniques.

Counter Strike Global Offensive (CSGO) - This dataset was kindly contributed by Asif Laldin, and is a detraction from the healthcare datasets in the package. I never intended the package to be purely healthcare ML datasets, and I plan to include credit card fraud examples, tabular playground examples from Kaggle, and many more, so watch this space…

Run a tidymodels routine with heart disease dataset

Let’s explore the heart disease dataset contained in MLDataR using a logistic regression model.

# install.packages("MLDataR")
library(MLDataR)
library(dplyr)
library(tidyr)
library(tidymodels)
library(data.table)
library(ConfusionTableR)
library(OddsPlotty)
glimpse(MLDataR::heartdisease)

## Rows: 918
## Columns: 10
## $ Age              <dbl> 40, 49, 37, 48, 54, 39, 45, 54, 37, 48, 37, 58, 39, 4…
## $ Sex              <chr> "M", "F", "M", "F", "M", "M", "F", "M", "M", "F", "F"…
## $ RestingBP        <dbl> 140, 160, 130, 138, 150, 120, 130, 110, 140, 120, 130…
## $ Cholesterol      <dbl> 289, 180, 283, 214, 195, 339, 237, 208, 207, 284, 211…
## $ FastingBS        <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,…
## $ RestingECG       <chr> "Normal", "Normal", "ST", "Normal", "Normal", "Normal…
## $ MaxHR            <dbl> 172, 156, 98, 108, 122, 170, 170, 142, 130, 120, 142,…
## $ Angina           <chr> "N", "N", "N", "Y", "N", "N", "N", "N", "Y", "N", "N"…
## $ HeartPeakReading <dbl> 0.0, 1.0, 0.0, 1.5, 0.0, 0.0, 0.0, 0.0, 1.5, 0.0, 0.0…
## $ HeartDisease     <dbl> 0, 1, 0, 1, 0, 0, 0, 0, 1, 0, 0, 1, 0, 1, 0, 0, 1, 0,…

A glimpse into the dataset gives us a quick overview of our dataset. We have 918 rows and 10 columns. We can see our outcome, heart disease, and our nine predictors.

There are a couple of things we want to clean up. Notice that our outcome variable HeartDisease loads as a double variable. We want to convert it into a factor variable for our machine learning model.

The variables Sex, RestingECG, and AnginaY are character variables. For creating models, it is better to encode characters as factors.

hd <- heartdisease %>%
  mutate(across(where(is.character), as.factor),
         HeartDisease = as.factor(HeartDisease)) %>% 
  # Remove any non complete cases
  na.omit()
is.factor(hd$HeartDisease)

## [1] TRUE

For Machine Learning models, it is generally recommended to split your data into a training and testing set, or if you are using hyperparameter tuning and updating your model, a training / test and validation set. Other methods are available, such a K-Fold Cross Validation; however, we will stick to a basic training and testing split for the purposes of this walkthrough.

To do this, and to make sure that the results are repeatable, we will use the set.seed(123) value - which essentially says when we are randomly splitting this data, make sure that the random pattern is the same as the walkthrough., i.e. give me the same split as this post:

set.seed(123)
split_prop <- 0.8
testing_prop <- 1 - split_prop
split <- rsample::initial_split(hd, prop = split_prop)
training <- rsample::training(split)
testing <- rsample::testing(split)
# Print a custom message to show the samples involved
training_message <- function() {
  message(
    cat(
      'The training set has: ',
      nrow(training),
      ' examples and the testing set has:',
      nrow(testing),
      '.\nThis split has ',
      paste0(format(100 * split_prop), '%'),
      ' in the training set and ',
      paste0(format(100 * testing_prop), '%'),
      ' in the testing set.',
      sep = ''
    )
  )
}
training_message()

## The training set has: 734 examples and the testing set has:184.
## This split has 80% in the training set and 20% in the testing set.

##

We can fit a parsnip model to the training set and then we can evaluate the performance.

lr_hd_fit <- logistic_reg() %>%
  set_engine("glm") %>% 
  set_mode("classification") %>% 
  fit(HeartDisease ~ ., data = training)

If we want to see the summary results of our model in a tidy way (i.e., a data frame with standard column names), we can use the tidy() function:

tidy(lr_hd_fit)

## # A tibble: 11 × 5
##    term             estimate std.error statistic  p.value
##    <chr>               <dbl>     <dbl>     <dbl>    <dbl>
##  1 (Intercept)       0.925     1.29        0.718 4.73e- 1
##  2 Age               0.0175    0.0123      1.42  1.55e- 1
##  3 SexM              1.17      0.241       4.84  1.29e- 6
##  4 RestingBP        -0.00164   0.00544    -0.301 7.63e- 1
##  5 Cholesterol      -0.00335   0.00104    -3.23  1.25e- 3
##  6 FastingBS         0.944     0.248       3.81  1.39e- 4
##  7 RestingECGNormal -0.291     0.261      -1.12  2.64e- 1
##  8 RestingECGST     -0.383     0.343      -1.12  2.64e- 1
##  9 MaxHR            -0.0192    0.00450    -4.28  1.88e- 5
## 10 AnginaY           1.54      0.229       6.72  1.78e-11
## 11 HeartPeakReading  0.689     0.113       6.12  9.54e-10

We can see the statistically significant ones by pulling out those with p < 0.05: Male (SexM), cholesterol (Cholesterol), fasting blood sugar (FastingBS), maximum heart rate (MaxHR), having angina (AnginaY), and peak heart rate reading (HeartPeakReading).

tidy(lr_hd_fit) %>% 
  filter(p.value < 0.05) %>% 
  pull(term)

## [1] "SexM"             "Cholesterol"      "FastingBS"        "MaxHR"           
## [5] "AnginaY"          "HeartPeakReading"

Let’s convert the probabilities from the fitted GLM model into odds ratios (ORs). An OR measures the association between an exposure and an outcome.¹ In this case, the OR represents the odds of heart disease will occur given a particular condition, compared to the odds of heart disease occurring in the absence of that condition.

We can visualize the results using the OddsPlotty package and the fit list object from the model.

tidy_oddsplot <- OddsPlotty::odds_plot(
  lr_hd_fit$fit,
  title = "Heart Disease Odds Plot",
  point_col = "#6b95ff",
  h_line_color = "red"
)
tidy_oddsplot <- tidy_oddsplot$odds_plot +
  theme(legend.position = "none") +
  geom_text(
    label = round(tidy_oddsplot$odds_plot$data$OR, digits = 3),
    hjust = -0.5,
    vjust = 1,
    cex = 2.8
  )
tidy_oddsplot

We can also pull out the odds ratio data:

tidy_oddsplot$data

##                      OR  lower  upper             vars
## Age              1.0176 0.9935 1.0426              Age
## SexM             3.2156 2.0172 5.2026             SexM
## RestingBP        0.9984 0.9877 1.0090        RestingBP
## Cholesterol      0.9967 0.9946 0.9987      Cholesterol
## FastingBS        2.5710 1.5912 4.2114        FastingBS
## RestingECGNormal 0.7472 0.4471 1.2452 RestingECGNormal
## RestingECGST     0.6817 0.3474 1.3348     RestingECGST
## MaxHR            0.9809 0.9722 0.9895            MaxHR
## AnginaY          4.6768 2.9989 7.3842          AnginaY
## HeartPeakReading 1.9914 1.6056 2.4982 HeartPeakReading

In this example, odds ratios are used to compare the relative odds of the occurrence of heart disease, given exposure to the variable of interest. Looking at the results from odds_plot():

Having angina (AnginaY), peak heart rate reading (HeartPeakReading), Male (SexM), and fasting blood sugar (FastingBS) have an OR of greater than 1, implying that these conditions are associated with higher odds of heart disease. For example, people with Angina are 4.677 times more likely to get heart disease than those without this condition.
Normal resting electrocardiogram (RestingECGNormal) and normal ST segment of an electrocardiogram (RestingECGST) have an OR of less than 1, implying that these conditions are associated with lower odds of heart disease, however due to the length of the error bars these conditions do not have as significant effect on heart disease, as those outlined with odds greater than 1.

Note the confidence intervals, indicating the precision of the OR. The large CIs around RestingECGNormal and RestingECGST indicate a low level of precision of the OR. The small CIs around Age, RestingBP, Cholesterol, and MaxHRindicate a higher precision of the ORs. This is normally due to the representation of the encoded items within the model, i.e. the presence of an effect code.

I evaluate the outputs of logistic regression models by using the sampling probability values that the variables have been selected by chance (p-values) for the cut off, but then use the odds ratios of the effect of the predictor variable on my outcome, using the odds plots to make the final decision.

Evaluating with testing set

The final way we can evaluate how well our model fits, before pushing this into production, would be to use a confusion matrix to collect how well our testing partition performs, against our training model predictions. Here we are trying to get a sense of, if we pushed this into the wild, how well would it do on unseen observations i.e. those new items that we don’t have a label for, a label in this sense is whether someone has had heart disease, or not.

library(ConfusionTableR)
# Use our model to predict labels on to testing set
predictions <- cbind(predict(lr_hd_fit, new_data = testing),
                     testing)
# Create confusion matrix and output to record level for storage to monitor concept drift
cm <- ConfusionTableR::binary_class_cm(
  predictions$.pred_class,
  predictions$HeartDisease,
  mode = 'everything',
  positive = '1'
)

## [INFO] Building a record level confusion matrix to store in dataset

## [INFO] Build finished and to expose record level cm use the record_level_cm list item

The next step is to expose the confusion matrix to view how well our model did on estimating the labels on the testing set:

# Access the confusion matrix list object
cm$confusion_matrix

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction  0  1
##          0 70  6
##          1 16 92
##                                         
##                Accuracy : 0.88          
##                  95% CI : (0.825, 0.924)
##     No Information Rate : 0.533         
##     P-Value [Acc > NIR] : <2e-16        
##                                         
##                   Kappa : 0.758         
##                                         
##  Mcnemar's Test P-Value : 0.055         
##                                         
##             Sensitivity : 0.939         
##             Specificity : 0.814         
##          Pos Pred Value : 0.852         
##          Neg Pred Value : 0.921         
##               Precision : 0.852         
##                  Recall : 0.939         
##                      F1 : 0.893         
##              Prevalence : 0.533         
##          Detection Rate : 0.500         
##    Detection Prevalence : 0.587         
##       Balanced Accuracy : 0.876         
##                                         
##        'Positive' Class : 1             
##

Our model did relatively well. Picking apart some of the metrics:

True positives (TP) we have 92 correctly classified instances of heart failure
True negatives(TN) we have 70 cases classified as not having heart disease
False negatives (FN) we have 6 cases were our model said the patient didn’t have heart disease and they did
False positives (FP) we have 16 cases were our model said a patient did have heart disease, but they actually didn’t
Recall (also called Sensitivity) is 0.9388 meaning from all the patients that had heart disease - how many did we predict correctly - this equation is Recall=TP / (TP + FN)
Precision (also called Positive Predictive Value) is 0.8519 meaning from all the classes we predicted as positive, how many were actually positive. The equation here is Precision=TP/(TP + FP).

As I run many ML experiments, I wanted a way to store this data into a record-level extract. I actually stored this in a model metrics table on Postgres SQL database, but could be stored in any proprietary system. To get these metrics easily in record level, the package I created helps you do that with ease:

# As we used the binary record level cm method, this stores the model data down
record_level_cm <- cm$record_level_cm %>%
  dplyr::mutate(user_name = Sys.getenv("USERNAME"))
glimpse(record_level_cm)

## Rows: 1
## Columns: 24
## $ Pred_0_Ref_0         <int> 70
## $ Pred_1_Ref_0         <int> 16
## $ Pred_0_Ref_1         <int> 6
## $ Pred_1_Ref_1         <int> 92
## $ Accuracy             <dbl> 0.8804
## $ Kappa                <dbl> 0.7581
## $ AccuracyLower        <dbl> 0.8246
## $ AccuracyUpper        <dbl> 0.9235
## $ AccuracyNull         <dbl> 0.5326
## $ AccuracyPValue       <dbl> 4.902e-24
## $ McnemarPValue        <dbl> 0.05501
## $ Sensitivity          <dbl> 0.9388
## $ Specificity          <dbl> 0.814
## $ Pos.Pred.Value       <dbl> 0.8519
## $ Neg.Pred.Value       <dbl> 0.9211
## $ Precision            <dbl> 0.8519
## $ Recall               <dbl> 0.9388
## $ F1                   <dbl> 0.8932
## $ Prevalence           <dbl> 0.5326
## $ Detection.Rate       <dbl> 0.5
## $ Detection.Prevalence <dbl> 0.587
## $ Balanced.Accuracy    <dbl> 0.8764
## $ cm_ts                <dttm> 2022-04-19 11:18:51
## $ user_name            <chr> ""

#Export to csv
data.table::fwrite(record_level_cm, file = 'heart_disease_cm_record_level.csv')

If you were happy with your model now, you could put this into production.

Can I contribute my own dataset to MLDataR?

The answer is you can, and I would greatly encourage it. To boot, you will become a package contributor. I am looking for ML datasets from across a wide range of industries and organisations.

Suitable datasets for machine learning applications:

Have sufficient predictive variables for feature engineering
Have a nominal outcome variable
May have missing values
Consist of interesting features

If you have an idea, please submit a pull request to the GitHub repository and add your dataset.

Final thoughts

I have really enjoyed putting this package together and I hope you can use it to:

Learn tidymodels or caret. I have put together a few tutorials on these in the past:

Building a tidymodels classification model from scratch: https://www.youtube.com/watch?v=hxRx7ozLNKw&t=2583s
Advanced modelling with caret for supervised machine learning: https://www.youtube.com/watch?v=rO40vvKXU-4&t=3085s
Reticulate - R and Python a happy union: https://www.youtube.com/watch?v=8WE-EU5k97Q&t=235s
Collapsing a caret confusion matrix with ConfusionTableR: https://youtu.be/9zcUlgLySZo

Put your models into production:

Deploying a caret machine learning model as an API with Plumber: https://youtu.be/WMCkV_J5a0s
Creating a microservice with Docker and serving as a restful API: https://youtu.be/JK6VLAKRjO4

Szumilas M. (2010). Explaining odds ratios. Journal of the Canadian Academy of Child and Adolescent Psychiatry = Journal de l’Academie canadienne de psychiatrie de l’enfant et de l’adolescent, 19(3), 227–229.↩︎

A Guide to Binge Watching R / Medicine 2021

Thu, 09 Sep 2021 00:00:00 +0000

R / Medicine is a big deal. This year, the conference grew by 13% with 665 people from over 60 countries signing up for the virtual event which was held last month. 34% percent of the registrants were from outside of the United States and 17% identified as physicians.

The conference is now an established international event where experts report on the advanced use of the R language, Machine Learning, and statistical analysis, and discuss the successes and challenges associated with bringing these technologies to day-to-day medical practice.

Almost all of the talks, including keynotes, regular talks, lightning talks, pre-conference workshops and poster sessions are available online. Find the links on the R / Medicine site or look through the playlist on the R Consortium Youtube Channel. Note that the posters can be viewed by going to the conference spatial.chat site. (If you and a friend visit at the same time you should be able to “walk around” the posters and chat about what you see.)

To kick off an evening of binge watching the conference I would begin with the keynotes.

The Keynotes

Dr. Karandeep Singh sets the hook for his talk, Bringing Machine Learning Models to the Bedside at Scale, two minutes into the video when he asks:

Who are the twenty sickest patients in the hospital right now who are not in the ICU?

This straightforward question immediately gets to the promise and the problems of introducing large scale machine learning algorithms into the hospital, and indicates how medical practice interacts with big money questions about allocating resources. Both physicians and administrators would like to identify high risk patients and treat them proactively while being able to confidently spend less on unnecessary test for low risk patients. About (5:10) into the talk, Karandeep begins discussing the challenges associated with introducing machine learning models.

In the remainder of the talk he describes the technical infrastructure and then the governance or “social infrastructure” needed for success.

If you enjoy a good detective story, and take pride in your ability to interpret a well-done statistical plot you are certainly going to want to watch Ziad Obermeyer’s keynote Dissecting Algorithmic Bias. About two minutes into the video Professor Obermeyer sets the stage with the warning:

The single greatest threat to all of the gains that we can make in using algorithms in medicine is letting them go wrong in increasingly well known ways.

and the observation that due to the focus of the US health care management on “high risk care management” an estimated 150 to 200 million Americans are sorted by algorithms every year. He goes on to work through a case study that illustrates how an algorithm built with good intentions had the effect of scaling up racial bias.

A second case study features an algorithm that “fights against” racial bias. Along the way, Ziad weaves two common themes into his presentation:

So many of the ways that algorithms can go wrong come from training algorithms with the wrong target variables, often “convenient and tempting proxies”.
The necessity of follow-up work to fix underlying problems.

In the remainder of this post, I have organized the talks into six categories that you may find helpful for setting your viewing program: Clinical Practice, Clinical Trials, Medical Data, R in Production, R Tools, and Short Courses. The majority of the talks have a machine learning angle. There is quite a bit of Shiny and several R packages, not all of them on CRAN, are featured. I have provided links when I could find them. I don’t want to spoil anyone’s fun in searching through the videos for “Easter Eggs”, but the Reproducible Research with R short course contains the first preview on the Quarto Publishing system in a talk from anyone at RStudio. (Note that the video needs some editing. Start watching at 9 minutes.)

Clinical Practice

Building an Interpretable ML Model API for Interpretation of CNVs in Patients with Rare Diseases - Francisco Requena
Subgroup Identification and Precision Medicine with the personalized R Package - Jared Huling
R and Shiny Dashboards to Facilitate Quality Improvement in Anesthesiology and Periopeartive Care - Robert Lobato
tidytof: Predicting Patient Outcomes from Single-cell Data using Tidy Data Principles - Timothy Keyes
Assessing ML Model Performance in DIverse Populations and Across Time - Victor Castro, Roy Perlis

Clinical Trials

Designing Early Phase Clinical Trials with ppseq - Emily Zabor
Collaborative, Reproducible Exploration of Clinical Trial Data - Michael Kane
Graphical Displays in R for Clinical Trials - Steven Schwager
ctrialsgov: Access, Visualization, and Discovery of the ClinicalTrials.gov Database - Taylor Arnold

Medical Data

Scaling Up and Deploying Shiny and Text Mining for National Health Decisions - Andreas Soteriade, Chris Beeley
Mapping African Health Data with afrimapr Package, Training & Community - Andy South
You R What You Measure: Digital Biomarkers for Insights in Personalized Health - Irene van den Broek
Shiny and REDCap for a Global Research Consortium - Judith Lewis, Stephany Duda
Diving into Registry Data: Using R for Large Norwegian Health Registries - Julia Romanowska
ReviewR: A Shiny App for Reviewing Clinical Records - Laura Wiley, David Mayer
DOPE: An R package for Processing and Classifying Drug Names - Layla Bouzoubaa
medicaldata for Teaching #Rstats - Peter Higgins
Stem Cell Transplant Outcomes Reporting using R/Shiny - Richard Hanna, Stephan Kadauke

R in Production

Second Server to the Right and Straight On ‘til Production: Deploying a GxP Shiny Application - Marcus Adams
Target Markdown and stantargets for Bayesian model validation pipelines - Will Landau
GENETEX: A Genomics Report Text Mining R Package to Capture Real-world Clinico-genomic Data - David Miller, Sophia Shalhout

R Tools

Generalized Additive Models for Longitudinal Biomedical Data - Ariel Mundo
Multistate Data Using the survival Package - Beth Atkinson
Bayesian Random-Effects Meta-analysis using bayesmeta - Christian Rover
An arsenal of R Functions for Statistical Summaries - Ethan Heinzen, Beth Atkinson, Jason Sinnwell
R Markdown and officedown to Automate Clinical Trial Reporting - Damian Rodziewicz
Creating and Styling PPTX Slides with rmarkdown - Emil Hvitfeldt
runway: an R Package to Visualize Prediction Model Performance - Jie Cao, Karandeep Singh
clinspacy: An R package for Clinical Natural Language Processing - Jie Cao, Karandeep Singh
Data Visualization for Machine Learning Practitioners - Julie Silge
Animated Data Visualizations with gganimate for Science Communication during the Pandemic - Kristen Panthagani
Incorporating Risk-of-Bias Assessments into Evidence Syntheses with robvis - Luke McGuinness, Randall Boyes, Alex Fowler
‘gpmodels’: A Grammar of Prediction Models - Sean Meyer, Karandeep Singh
CONSORT Diagrams in R with ggconsort - Travis Gerke

Short Courses

Secure Medical Data Collection: Best Practices with Excel, and Leveling Up to REDCap and CollaboratoR - Peter Higgins, Will Beasley, Kenneth MacLean, Amanda Miller
Introduction to R for Medical Data - Ted Laderas, Daniel Chen, Mara Alexeev
An Introductory R Guide for Targeted Maximum Likelihood Estimation in Medical Research - Ehsan Karim, Hanna Frank
Mapping Spatial Health Data - Marynia Kolak, Susan Paykin
From SAS to R - Joe Krsszun
Reproducible Research with R - Alison Hill, Stephan Kaduke, Paul Villanueva

March 2021: "Top 40" New CRAN Packages

Thu, 22 Apr 2021 00:00:00 +0000

By my count, two hundred twenty-one new packages stuck to CRAN in March 2021.¹ Here are my “Top 40” selections in twelve categories: Computational Methods, Data, Engineering, Genomics, Machine Learning, Medicine, Music, Networks, Science, Statistics, Utility, and Visualization. Two of these categories Engineering and Music have only one entry each. However, I decided to give them their own category in order to draw attention to the use of R outside of the mainstream, and I have always lamented the fate of the Miscellaneous. In the same spirit, note that the complete works of the Bard appear in the Data category and that due to tidypaleo Paleoenvironmental is now a thing in R.

Computational Methods

gamlss v1.0-5: Implements computationally intensive calculations for Generalized Additive Models for location, scale, and shape as described in Rigby & Stasinopoulos (2005).

waydown v1.1.0: Implements an algorithm based on the classical Helmholtz decomposition to obtain an approximate potential function for non gradient fields. See Rodríguez-Sánchez (2020) for background and the vignette for examples.

Data

aopdata v0.2.1: Provides functions to download data from the Access to Opportunities Project (AOP) which includes annual estimates of access to employment, health and education services by transport mode, as well as data on the spatial distribution of population, schools and health-care facilities at a fine spatial resolution for all cities included in the study. There is an Introduction to the package, and there are vignettes on Analyzing Inequality, Mapping Urban Accessibility, and Mapping Pooulation and Land Use.

bardr v0.0.9: Provides R data structures for Shakespeare’s complete works, as provided by Project Gutenberg. See README.

metro v0.9.1: Provides access to the Metro Transparent Data Sets API published by the Washington Metropolitan Area Transit Authority, the government agency operating light rail and passenger buses in the Washington D.C. area. See README.

RAQSAPI v2.0.1: Provides functions to retrieve air monitoring data and associated metadata from the US Environmental Protection Agency’s Air Quality System Service. There are several short vignettes including an Introduction and a vignette on Usage tips and precautions.

troopdata v0.1.3: Provides access to U.S. Department of Defense data on overseas military deployments and includes functions for pulling country-year troop deployment and basing data. See README to get started

Engineering

pipenostics v0.1.7: Implements empirical and data-driven models of heat losses, corrosion diagnostics, reliability and predictive maintenance of pipeline systems which should be of interest to the engineering departments of heat generating and heat transferring companies. See Timashev et al. (2016) and Reddy (2017) for the methods used and README to get started.

Genomics

glmmSeq v0.1.0: Provides functions to fit negative binomial mixed effects models with matched samples to model expression data. See the vignette for examples.

ondisc v1.0.0: Implements a method to allow researchers to analyze large-scale single-cell data as and R object stored on disk. There is a tutorial on the the ondisc matrix class and another on Metadata.

SignacX v2.2.0: Implements a neural network trained with flow-sorted gene expression data to classify cellular phenotypes in single cell RNA-sequencing data. See Chamberlain et al. (2021) for background. There are seven vignettes including an Analysis of Kidney Lupus Data and an Analysis of PBMCs from 10X Genomics.

Machine Learning

opitools v1.0.3: Implements a tool to analyze opinions inherent in a text document relating to a specific subject (A) and assess how opinions expressed with respect to another subject (B) may affect the opinions on subject A. This package has been designed specifically for application to social media datasets, such as Twitter and Facebook. See Adepeju and Jimoh (2021) for an extended example that demonstrates the utility of the approach and the vignette to get started.

poems v1.0.1: Provides a framework of interoperable R6 classes for building ensembles of viable models via the pattern-oriented modeling (POM) approach. The package includes classes for encapsulating and generating model parameters, and managing the POM workflow which includes: model setup; generating model parameters via Latin hyper-cube sampling; running multiple sampled model simulations; collating summary results; and validating and selecting an ensemble of models that best match known patterns. There are two vignettes: Simple Example and Thylacine Example.

Medicine

dampack v1.0.0: Implements a suite of functions for analyzing and visualizing the health economic outputs of mathematical models. See Hunink et al. (2014) for the theoretical underpinnings. There are five vignettes including Basic Cost Effectiveness Analysis, Probabilistic Sensitivity Analysis: Analysis and Value of Information Analysis.

rdecision v1.0.3: Provides classes and functions for using decision trees to model health care interventions using cohort models. See Briggs et al. for theory and terminology. There are five vignettes including Elementary decision tree (Evans 1997) and Decision tree with PSA.

Music

gm v1.0.2: Implements a high-level language to create music including converting your music to musical scores and audio files. It works with R Markdown, R Jupyter Notebooks, and RStudio. There vignette is available in English and in Chinese.

Networks

sfnetworks v0.5.1: Provides a tidy approach to spatial network analysis in the form of classes and functions that enable a seamless interaction between the network analysis package tidygraph and the spatial analysis package sf. There are vignettes on sf network structure, Preprocessing, Spatial joins and filters, Routing, and Spatial morphers.

valhallr v0.1.0: Implements an interface to the Valhalla routing engine’s API for turn-by-turn routing, isochrones, and origin-destination analyses. See the vignette for examples.

Science

asteRisk v0.99.4: Provides functions to calculate the positions of satellites given a known state vector. It includes implementations of the SGP4 and SDP4 simplified perturbation models to propagate orbital state vectors. See Hoots et al. (1988), Vallado et al. (2012), and Hoots et al. (2014) for background and the vignette for examples.

forImage v0.1.0: Implements a tool to measure the size of foraminifera and other unicellulars and includes functions to guide foraminiferal test biovolume calculations and cell biomass estimations. The volume function includes several microalgae models geometric adaptations based on Hillebrand et al. (1999), Sun & Liu (2003), and Vadrucci et al. (2007). See the vignette to get started.

OpenSpecy v0.9.1: Provides functions to analyze, process, identify and share Raman and (FT)IR spectra with functions to implement Savitzky-Golay smoothing in accordance with Zhao et al. (2007) and identify spectra using an onboard reference library, see Cowger et al. 2020. Analyzed spectra can be shared via Shiny App. There is a vignette.

tidypaleo v0.1.1: Provides functions with a common framework for age-depth model management, stratigraphic visualization, and common statistical transformations with a focus on stratigraphic visualization using ggplot2. There are vignettes on Age-depth Models, Nested Analyses, and Stratigraphic Diagrams.

VulnToolkit v1.1.2: Provides functions to analyze and summarize tidal data sets and to access to NOAA mean sea level data. See Hill & Anisfeld (2015) for background and the vignette for examples.

Statistics

corncob v0.2.0: Implements functions for modeling correlated count data using the beta-binomial distribution, described in Martin et al. (2020). See the vignette for an introduction.

hawkesbow v1.0.2: Implements an estimation method for Hawkes processes when count data are only observed in discrete time, using a spectral approach derived from the Bartlett spectrum. See Cheysson and Lang (2020) for background and the vignette for examples.

LMMELSM v0.1.0: Implements two-level mixed effects location scale models on multiple observed or latent outcomes, and between-group variance modeling. See Williams et al. (2020) and Hedeker et al. (2008) for background and README for an example.

mixpoissinreg v1.0.0: Provides functions to fit mixed Poisson regression models (Poisson-Inverse Gaussian or Negative-Binomial) with count data response variables. See Barreto-Souza and Simas (2016) for background. There are five vignettes on Global and Local Influence, Confidence and Prediction Intervals, MLE, Tidy Methods, and Overdispersed Count Data.

ppdiag v0.1.0: Provides a suite of diagnostic tools for univariate point processes including tools for simulating and fitting both common and more complex temporal point processes and the diagnostic tools described in Brown et al. (2002) and Wu et al. (2020). There is a vignette on Markov Modulated Point Processes and another on Diagnostic Tools.

robustlm v0.1.0: Implements a computationally efficient exponential squared loss algorithm for variable selection proposed by Wang et al.(2013). See the vignette.

smmR v1.0.2: Provides functions to estimate and simulate multi-state semi-Markov models. The methods implemented are described in Barbu & Limnios (2008) and Trevezas & Limnios (2011). The vignette contains an extended example.

spotoroo v0.1.1: Implements an algorithm to cluster satellite hot spot data spatially and temporally. See the vignette.

Utilities

clock v0.2.0: Provides a comprehensive library for date-time manipulations using a new family of orthogonal date-time classes (duration, time points, zoned-times, and calendars) that partition responsibilities so that the complexities of time zones are only considered when they are really needed. There is a Getting Started guide, as well as vignettes on FAQ, and Examples and Recipies.

crosstable v0.2.1: Provides functions to create descriptive tables for continuous and categorical variables, apply summary statistics, and create reports using rmarkdown or officer. There is an Introduction, and vignettes on Troubleshooting, Making Automatic Reports, and Selecting Variables.

pkgdepends v0.1.0: Provides functions to find recursive dependencies for R packages from various sources including CRAN, Bioconductor, and GitHub enabling users to obtain a consistent set of packages to install. See README to get started.

pkglite v0.1.1: Implements a tool, grammar, and standard to represent and exchange R package source code as text files. Converts one or more source packages to a text file and restores the package structures from the file. There are vignettes on Generating File Specifications, Representing Packages, and Compact Package Representation.

Visualization

datplot v1.0.0: Provides tools to process and prepare data for visualization and employs the concept of aoristic analysis. See aorist and the vignettes Data Preparation and Visualization and Visualizing Chronological Distribution.

ferrn v0.0.1: Implements diagnostic plots for optimization, with a focus on projection pursuit which show paths the optimizer takes in the high-dimensional space. See README for examples.

funcharts v1.0.0: Provides functional control charts for statistical process monitoring of functional data, using the methods of Capezza et al. (2020) and Centofanti et al. (2020). There are vignettes on Capezza 2020, Centofanti 2020 and on the mfd class.

gghilbertstrings v0.3.3: Provides functions to plot Hilbert curves which are used to map one dimensional data into the 2D plane. A specific use case maps a character column in a data frame into 2D space allowing visually comparing long lists of URLs, words, genes or other data that has a fixed order and position. See README for examples.

mapsf v0.1.1: Provides functions to create and integrate thematic maps including functions to design various cartographic representations such as proportional symbols, choropleth or typology maps. Look here for examples.

¹ I have used phrases like By my count and stuck to CRAN in the past, but I do not believe that I have explained what I mean. For some time now, but I believe more frequently in recent months, packages will appear as new on CRAN, only to be removed within a relatively short period of time for failing to resolve check problems. If you happen to know about these packages and search for them by name on CRAN you will receive the message:

Package XXXX was removed from the CRAN repository. Formerly available versions can be obtained from the archive. Archived on 2021-04-17 as check problems remained after update. A summary of the most recent check results can be obtained from the check results archive. Please use the canonical form https://CRAN.R-project.org/package=XXXX to link to this page.

I did not include the ten packages that were identified as being new for March when I created my list of March packages on April 10, 2021, but were removed by the time I finalized my list for this post a week later, in my total count of new CRAN packages. So, there is some instability with the notion of counting new packages in a given month.

Modern Rule-Based Models

Thu, 21 May 2020 00:00:00 +0000

Modern Rule-Based Models

Machine learning models come in many shapes and sizes. While deep learning models currently have the lion’s share of coverage, there are many other classes of models that are effective across many different problem domains. This post gives a short summary of several rule-based models that are closely related to tree-based models (but are less widely known).

While this post is focused on explaining on how these models work, it coincides with the release of the rules package, a tidymodels package that provides a user interface to these models. A companion post at the tidyverse blog describes the usage of the package.

To start, let’s discuss the concept of rules more generally.

What is a rule?

Rules in machine learning have been around for a long time (Quinlan, 1979). The focus of this article is using rules for traditional supervised learning (as opposed to association rule mining). In the context of feature engineering, a rule is a conditional logical statement. It can be attached to some sort of predicted value too, such as

if (chance_of_rain > 0.75) {
  umbrella <- "yes"
} else {
  umbrella <- "no"
}

There are various ways to create rules from data. The most popular method is to create a tree-based model and then “flatten” the model structure into a set of rules. This is called a “separate and conquer” approach.

To demonstrate this, let’s use a data set with housing prices from Sacramento CA. Two predictors with a large number of levels are removed to make the rule output more readable:

for (pkg in c('dplyr', 'modeldata', 'rpart')) {
  if (!requireNamespace(pkg)) {
    install.packages(pkg)
  }
}

library(dplyr)

data(Sacramento, package = "modeldata")

Sacramento <-
  Sacramento %>% 
  mutate(price = log10(price)) %>% 
  select(-zip, -city)

str(Sacramento)

## tibble [932 × 7] (S3: tbl_df/tbl/data.frame)
##  $ beds     : int [1:932] 2 3 2 2 2 3 3 3 2 3 ...
##  $ baths    : num [1:932] 1 1 1 1 1 1 2 1 2 2 ...
##  $ sqft     : int [1:932] 836 1167 796 852 797 1122 1104 1177 941 1146 ...
##  $ type     : Factor w/ 3 levels "Condo","Multi_Family",..: 3 3 3 3 3 1 3 3 1 3 ...
##  $ price    : num [1:932] 4.77 4.83 4.84 4.84 4.91 ...
##  $ latitude : num [1:932] 38.6 38.5 38.6 38.6 38.5 ...
##  $ longitude: num [1:932] -121 -121 -121 -121 -121 ...

Consider a basic CART model created using rpart:

library(rpart)

rpart(price ~ ., data = Sacramento)

## n= 932 
## 
## node), split, n, deviance, yval
##       * denotes terminal node
## 
##  1) root 932 48.5000 5.334  
##    2) sqft< 1594 535 18.7200 5.211  
##      4) sqft< 1170 235  8.0440 5.107  
##        8) sqft< 934.5 71  2.2760 5.002 *
##        9) sqft>=934.5 164  4.6500 5.152 *
##      5) sqft>=1170 300  6.1390 5.292  
##       10) longitude< -121.3 243  4.8850 5.270 *
##       11) longitude>=-121.3 57  0.6081 5.388 *
##    3) sqft>=1594 397 10.6000 5.501  
##      6) sqft< 2317 245  4.7420 5.432  
##       12) longitude< -121.3 205  3.3190 5.407 *
##       13) longitude>=-121.3 40  0.6179 5.562 *
##      7) sqft>=2317 152  2.8450 5.611  
##       14) longitude< -121.2 110  1.6790 5.570 *
##       15) longitude>=-121.2 42  0.4864 5.720 *

The splits in this particular tree involve the same two predictors. These paths to the terminal nodes are comprised of a set of if-then rules. Consider the path to the eighth terminal node:

if (sqft < 1594 & sqft < 1169.5 & sqft < 934.5) then pred = 5.001820

It is easy to prune this rule down to just sqft < 934.5. In all, the rules generated from this model would be:

##  price                                              
##    5.0 when sqft <   935                            
##    5.2 when sqft is  935 to 1170                    
##    5.3 when sqft is 1170 to 1594 & longitude <  -121
##    5.4 when sqft is 1170 to 1594 & longitude >= -121
##    5.4 when sqft is 1594 to 2317 & longitude <  -121
##    5.6 when sqft is 1594 to 2317 & longitude >= -121
##    5.6 when sqft >=         2317 & longitude <  -121
##    5.7 when sqft >=         2317 & longitude >= -121

What are some more modern models that can use or generate rules? We’ll walk through three (which are all included in the rules package).

C5.0 rules

The C4.5 algorithm (Quinlan, 1993b) was an early tree-based model that was released not long after the more well known CART model. One cool aspect of this model is that it could generate a classification tree or a set of rules. These rules are derived from the original tree much in the same way that was shown above for rpart.

Over the years, the author (Ross Quinlan) kept evolving the next generation of the model called C5.0. About 10 years ago, he open-sourced that model and the C50 R package was born. Like its predecessor, C5.0 could be used for trees or for rules. There are a variety of advances to this model (detailed in Kuhn and Johnson (2013)), but the most significant was the inclusion of boosting. In effect, you could create an ensemble of classification rules. Rather than approaching the problem via the more modern stochastic gradient boosting paradigm, it is more similar to the classical AdaBoost methodology.

Since C5.0 is classification only, an example of a single rule set for the iris data is:

Rule 1: (50, lift 2.9)
    Petal.Length <= 1.9
    ->  class setosa  [0.981]

Rule 2: (48/1, lift 2.9)
    Petal.Length > 1.9
    Petal.Length <= 4.9
    Petal.Width <= 1.7
    ->  class versicolor  [0.960]

Rule 3: (46/1, lift 2.9)
    Petal.Width > 1.7
    ->  class virginica  [0.958]

Rule 4: (46/2, lift 2.8)
    Petal.Length > 4.9
    ->  class virginica  [0.938]

Default class: setosa

If used on the iris data, a boosting ensemble with 50 constituent models used a total of 276 rules and each iteration averaged 5.52 rules per rule set.

The primary method of controlling the complexity of each rule set is to adjust the minimum number of data points required to make additional splits within a node. The default for this parameter is two data points. If this value was increased to 20, the mean number of rules was reduced from 5.52 rules to 3.2 rules.

When tuning, the other main tuning parameter is the number of boosting iterations. The C50 R package enables sub-model predictions across boosting iterations; tuning this parameter over many values is not very computation expensive.

Cubist

The aforementioned Ross Quinlan also developed model trees (Quinlan, 1992). These are regression tree-based models that contain linear regression models in the terminal nodes. This model was called M5 and, much like C5.0, there was a rule-based analog. Most tree-based models, especially ensembles of trees, tend to produce models that underfit in the tails (much like regression to the mean). Model trees do not suffer from this issue since their terminal regression models could make predictions across the whole range of the outcome data.

After an initial set of papers in the 1990’s, Quinlan didn’t publish much on the methodology as he evolved it. The modern version of model rules was called Cubist. There were a number of small technical differences between Cubist and M5 rules (enumerated in Kuhn and Johnson (2013)) but the main improvements were:

An ensemble method for predictions called committees.
A nearest-neighbor adjustment that occurs after the model predictions.

We’ll summarize these approaches in-turn.

Committee ensembles are similar to boosting. In boosting, a set of models are created sequentially. For the current iteration of boosting, the model is created using case weights that are defined by the results of previous models. In committees, case weights are not changed. Instead the outcome values are modified for each iteration of committees. For example, if a sample is under-predicted previously, its outcome value is changed to be larger so that the model will be pulled upward in an effort to stop under-predicting.

In committees, the first model uses the original outcome value $y$. On further iterations, a modified value $y^*$ is used instead. For iteration $m$, the model uses this adjustment formula:

\[ y^*_{(m)} = y - (\widehat{y}_{(m-1)} - y) \]

As a demonstration, the plot below shows how the pseudo-outcome changes over iterations. The observed price of the house in question is 5.3. On the first iteration, the model under-predicts (show as the solid black dot). The vertical line represents the residual from this model. On the next iteration, the open blue circle shows the value of $y^*_{(2)}$. On the second iteration, the prediction for this data point becomes worse but, as iterations proceed, the residuals generally become smaller.

Ensemble predictions are made by averaging over the committee model predictions. This concludes in the model-based prediction made by Cubist.

After the model prediction, there is an option to conduct a post-model nearest-neighbor adjustment (Quinlan, 1993a). When predicting a new data point, the K-nearest neighbors are found in the training set (along with their original predictions). If the training set predictions for the neighbors are denoted as $t$, the adjustment is:

\[ \widehat{y}_{adj} = \frac{1}{K}\sum_{\ell=1}^K w_\ell \left[t_\ell + \left(\widehat{y} - \widehat{t}_\ell \right)\right] \]

where the weights $w_\ell$ are based on the inverse distances (so that far points contribute less to the adjustment). The adjustment is large when the difference between the original and new predictions is large. As the difference between the predictions of the new sample and its closest neighbor increases, the adjustment becomes larger.

Suppose our model used only square footage and longitude as predictors. The training data are shown below with a new prediction point represented as a large red square. The 6-closest neighbors in the training set are shown as red circles. The size of the circle represents the magnitude of the weight. This shows that the nearby points influence the adjustment more than distant points.

This adjustment generally improves performance of the model. Interestingly, there is often a pattern when tuning where the 1-nearest neighbor model does much worse than using no adjustment but two or more neighbors do a much better job. One idea is that the use of a single neighbor is likely overfitting to the training set (as would occur with a more traditional K-NN model).

Using both of these techniques, Cubist tends to produce very competitive in terms of performance. The two primary parameters are the number of committee members and the number of nearest neighbors to use in the adjustment. The Cubist package can use the same fitted model to make predictions across the number of neighbors, so there is little computational cost when tuning this parameter.

For the Sacramento data, a single model (e.g. one committee) consisted of 6 rules, each with its own linear regression model. For example, the first four rules are:

##   Rule 1: [198 cases, mean 5.187264, range 4.681241 to 5.759668, est err 0.131632]
## 
##     if
##  sqft <= 1712
##  latitude > 38.46639
##  latitude <= 38.61377
##  longitude > -121.5035
##     then
##  outcome = -48.838393 + 0.000376 sqft + 1.39 latitude
## 
##   Rule 2: [254 cases, mean 5.220439, range 4.477121 to 5.923762, est err 0.105572]
## 
##     if
##  sqft <= 1712
##  latitude > 38.61377
##  longitude > -121.5035
##  longitude <= -121.0504
##     then
##  outcome = 93.155414 + 0.000431 sqft + 0.78 longitude + 0.16 latitude
## 
##   Rule 3: [90 cases, mean 5.273133, range 4.851258 to 5.580444, est err 0.078920]
## 
##     if
##  sqft <= 1712
##  latitude <= 38.46639
##     then
##  outcome = 15.750124 + 0.000344 sqft + 0.09 longitude - 0.005 beds
##            + 0.005 baths
## 
##   Rule 4: [35 cases, mean 5.340909, range 5.018076 to 5.616476, est err 0.086056]
## 
##     if
##  sqft <= 1712
##  longitude <= -121.5035
##     then
##  outcome = 4.865655 + 0.000357 sqft

New samples being predicted will fall into one or more rule conditions and the final prediction is the average of all of the corresponding linear model predictions.

If the model is run for 50 committees, a total of 271 rules were used across the committees with the average of 5.42 rules per committee member.

RuleFit

RuleFit models (Friedman and Popescu, 2008) are fairly simple in concept: use a tree ensemble to create a large set of rules, use the rules as binary predictors, then fit a regularized model that only includes the most important rule features.

For example, if a boosted tree were used to generate rules, each path through each tree would generate a conditional statement that can be used to define a model predictor (as was shown above for rpart). If an xgboost model with 100 boosting iterations with a limit of three splits were used on the Sacramento data, an initial set of 609 rules were generated. Some examples:

sqft >= 1594

longitude < -121.2 & latitude >= 38.73 & latitude >= 38.86

longitude >= -121.2 & longitude < -121 & baths < 2.75

longitude < -121.3 & sqft >= 1246 & type == "Multi_Family"

Clearly, the rules show some redundancy; there tends to be a significant amount of similarity in the rules.

These predictors are added to a regularized regression model (e.g. linear or logistic) that will conduct feature selection to remove unhelpful or redundant rules. Based on how much the model is penalized, the user can choose the number of rules that are contained in the final model. For example, depending on the penalty, the final rule set for the Sacramento data can be as large as hundreds or as small as a handful.

We can generate glmnet variable importance scores and then parameterize the importance in terms of the original predictors (instead of the rules). For example: for a penalty value of $\lambda$ = 0.005:

RuleFit has many tuning parameters; it inherits them from the boosting model as well as one from glmnet (the amount of lasso regularization). Fortunately, multiple predictions can be made across the lasso penalty using the same model object.

All-in-all, RuleFit is a neat and powerful method for using rules as features. It is interesting to contrast this model and Cubist:

Cubist creates rules as data subsets then estimates a linear regression models within each.
RuleFit creates rules as predictors then fits one (generalized) linear model.

Acknowledgments

Ross Quinlan has been supportive of our efforts to publish the inner workings of C5.0 and Cubist. I’d like to thank him for his help and all of the excellent work he has done over the years.

References

Friedman JH; Popescu BE (2008) “Predictive learning via rule ensembles.” _Annals of Applied Statistic_s, pp. 916-954.

Kuhn M; Johnson K (2013) Applied Predictive Modeling, Springer. New York.

Quinlan R (1979). “Discovering rules by induction from large collections of examples.” Expert Systems in the Micro Electronics Age.

Quinlan R (1992). “Learning with continuous classes.” Proceedings of the 5th Australian Joint Conference On Artificial Intelligence, pp. 343-348.

Quinlan R (1993a). “Combining instance-based and model-based learning.” Proceedings of the Tenth International Conference on Machine Learning, pp. 236-243.

Quinlan R (1993b). C4.5: Programs for Machine Learning. Morgan Kaufmann Publishers.

Comparing Machine Learning Algorithms for Predicting Clothing Classes: Part 4

Tue, 24 Mar 2020 00:00:00 +0000

Florianne Verkroost is a Ph.D. candidate at Nuffield College at the University of Oxford. She has a passion for data science and a background in mathematics and econometrics. She applies her interdisciplinary knowledge to computationally address societal problems of inequality.

This is the fourth and final post in a series devoted to comparing different machine learning methods for predicting clothing categories from images using the Fashion MNIST data by Zalando. In the first post, we prepared the data for analysis and built a Python deep learning neural network model to predict the clothing categories of the Fashion MNIST data. In Part 2, we used principal components analysis (PCA) to compress the clothing image data down from 784 to just 17 pixels. In Part 3 we saw that gradient-boosted trees and random forests achieve relatively high accuracy on dimensionality-reduced data, although not as high as the neural network. In this post, we will fit a support vector machine, compare the findings from all models we have built and discuss the results. The R code for this post can be found on my Github repository.

Support Vector Machine

Support vector machines (SVMs) provide another method for classifying the clothing categories in the Fashion MNIST data. To better understand what SVMs entail, we’ll have to go through some more complex explanations –mainly summarizing James et. al. (2013)– so please bear with me! The figure below might help you in understanding the different classifiers I will discuss in the next sections (figures taken from here, here and here).

For an $n \times p$ data matrix and binary outcome variable $y_i \in \{-1, 1\}$, a hyperplane is a flat affine subspace of dimension $p - 1$ that divides the $p$-dimensional space into two halves, defined by $\beta_0 + \beta_1 X_1 + \dots + \beta_p X_p$. An observation in the test data is assigned an outcome class depending on which side of the perfectly separating hyperplane it lies, assuming that such a hyperplane exists. Cutoff $t$ for an observation’s score $\hat{f}(X) = \hat{\beta}_1 X_1 + \hat{\beta}_2 X_2 + \dots + \hat{\beta}_p X_p$ determines which class it will be assigned to. The further an observation is located from the hyperplane at zero, the more confident the classifier is about the class assignment. If existent, an infinite number of separating hyperplanes can be constructed. A good option in this case would be to use the maximal margin classifier (MMC), which maximizes the margin around the midline of the widest strip that can be inserted between the two outcome classes.

If a perfectly separating hyperplane does not exist, “almost separating” hyperplanes can be used by means of the support vector classifier (SVC). The SVC extends the MMC as it does not require classes to be separable by a linear boundary by including slack variables $\epsilon_i$ that allow some observations to be on the incorrect side of the margin or hyperplane. The extent to which incorrect placements are done is determined by tuning parameter cost $C \geq \sum_{i=1}^{n} \epsilon_i$, which thereby controls the bias-variance trade-off. The SVC is preferable over the MMC as it is more confident in class assignments due to the larger margins and ensures greater robustness as merely observations on the margin or violating the margin affect the hyperplane (James et al., 2013).

Both MMCs and SVCs assume a linear boundary between the two classes of the outcome variable. Non-linearity can be addressed by enlarging the feature space using functions of predictors. Support vector machines combine SVCs with non-linear (e.g. radial, polynomial or sigmoid) Kernels $K(x_i, x_{i'})$ to achieve efficient computations. Kernels are generalizations of inner products that quantify the similarity of two observations (James et al., 2013). Usually, the radial Kernel is selected for non-linear models as it provides a good default Kernel in the absence of prior knowledge of invariances regarding translations. The radial Kernel is defined as $K(x_i, x_{i'})= \exp{(-\sigma \sum_{j=1}^{p} (x_{ij} - x_{i'j})^2)}$, where $\sigma$ is a positive constant that makes the fit more non-linear as it increases. Tuning $C$ and $\sigma$ is necessary to find the optimal trade-off between reducing the number of training errors and making the decision boundary more irregular (by increasing C). As SVMs only require the computation of $\bigl(\begin{smallmatrix} n\\ 2 \end{smallmatrix}\bigr)$ Kernels for all distinct observation pairs, they greatly improve efficiency.

As aforementioned, the parameters that need to be tuned are cost C and, in the case of a radial Kernel, non-linearity constant sigma. Let’s start by tuning these parameters using a random search algorithm, again making use of the caret framework. We set the controls to perform 5-fold cross-validation and we use the multiClassSummary() function from the MLmetrics library to perform multi-class classification. We specify a radial Kernel, use accuracy as the performance metric¹ and let the algorithm perform a random search for the cost parameter C over pca.dims (=17) random values. Note that the random search algorithm only searches for values of C while keeping a constant value for sigma. Also, contrary to previous calls to trainControl(), we now set classProbs = FALSE because the base package used for estimating SVMs in caret, kernlab, leads to lower accuracies when specifying classProbs = TRUE due to using a secondary regression model (also check this link for the Github issue).

We begin with training the support vector machine using the PCA reduced training and test data sets train.images.pca and test.images.pca constructed in Part 2.

library(MLmetrics)
svm_control = trainControl(method = "repeatedcv",   
                            number = 5,  
                            repeats = 5, 
                            classProbs = FALSE,
                            allowParallel = TRUE, 
                            summaryFunction = multiClassSummary,
                           savePredictions = TRUE)

set.seed(1234)
svm_rand_radial = train(label ~ ., 
                data = cbind(train.images.pca, label = train.classes),
                method = "svmRadial", 
                trControl = svm_control, 
                tuneLength = pca.dims,
                metric = "Accuracy")
svm_rand_radial$results[, c("sigma", "C", 'Accuracy')]

We can check the model performance on both the training and test sets by means of different metrics using a custom function, model_performance, which can be found in this code on my Github.

mp.svm.rand.radial = model_performance(svm_rand_radial, train.images.pca, test.images.pca, 
                                       train.classes, test.classes, "svm_random_radial")

The results show that the model is achieving relatively high accuracies of 88% and 87% on the training and test sets respectively, selecting sigma = 0.040 and C = 32 as the optimal parameters. Let’s have a look at which clothing categories are best and worst predicted by visualizing the confusion matrix. First, let’s compute the predictions for the training data. We need to use the out-of-bag predictions contained in the model object (svm_rand_radial$pred) rather than the manually computed in-sample (non-out-of-bag) predictions for the training data computed using the predict() function. Object svm_rand_radial$pred contains the predictions for all tuning parameter values specified by the user. However, we only need those predictions belonging to the optimal tuning parameter values. Therefore, we subset svm_rand_radial$pred to only contain those predictions and observations in indices rows. Note that we convert svm_rand_radial$pred to a data.table object to find these indices as computations on data.table objects are much faster for large data (e.g. svm_rand_radial$pred has 4.5 million rows).

library(data.table)
pred_dt = as.data.table(svm_rand_radial$pred[, names(svm_rand_radial$bestTune)]) 
names(pred_dt) = names(svm_rand_radial$bestTune)
index_list = lapply(1:ncol(svm_rand_radial$bestTune), function(x, DT, tune_opt){
  return(which(DT[, Reduce(`&`, lapply(.SD, `==`, tune_opt[, x])), .SDcols = names(tune_opt)[x]]))
}, pred_dt, svm_rand_radial$bestTune)
rows = Reduce(intersect, index_list)
pred_train = svm_rand_radial$pred$pred[rows]
trainY = svm_rand_radial$pred$obs[rows]
conf = table(pred_train, trainY)

Next, we reshape the confusion matrix into a data frame with three columns: one for the true categories (trainY), one for the predicted categories (pred_train), and one for the proportion of correct predictions for the true category (Freq). We plot this as a tile plot with a blue color scale where lighter values indicate larger proportions of matches between a particular combination of true and predicted categories, and darker values indicate a small proportion of matches between them. Note that we use the custom plotting theme my_theme() as defined in the second blog post of this series.

conf = data.frame(conf / rowSums(conf))
ggplot() + 
  geom_tile(data = conf, aes(x = trainY, y = pred_train, fill = Freq)) + 
  labs(x = "Actual", y = "Predicted", fill = "Proportion") +
  my_theme() +
  theme(axis.text.x = element_text(angle = 90, hjust = 1)) + 
   scale_fill_continuous(breaks = seq(0, 1, 0.25)) +
  coord_fixed()

We observe from this plot that most of the classes are predicted accurately as the light blue (high percentages of correct predictions) are on the diagonal of the tile plot. We can also observe that the categories that are most often mixed up include shirts, tops, pullovers and coats, which makes sense because these are all mostly upper body clothing parts having similar shapes. The model predicts trousers, bags, boots and sneakers well, given that these rows and columns are particularly dark except for the diagonal element. These results are in agreement with those from the random forest and gradient-boosted trees from the previous blog post of this series.

Next, we repeat the above process for fitting a support vector machine but instead of a random search for the optimal parameters, we perform a grid search. As such, we can prespecify values to evaluate the model at, not only for C but also for sigma. We define the grid values in grid_radial.

grid_radial = expand.grid(sigma = c(.01, 0.04, 0.1), C = c(0.01, 10, 32, 70, 150))
set.seed(1234)
svm_grid_radial = train(label ~ ., 
                              data = cbind(train.images.pca, label = train.classes),
                              method = "svmRadial", 
                              trControl = svm_control, 
                              tuneGrid = grid_radial,
                              metric = "Accuracy")
svm_grid_radial$results[, c("sigma", "C", 'Accuracy')]

mp.svm.grid.radial = model_performance(svm_grid_radial, train.images.pca, test.images.pca, 
                                       train.classes, test.classes, "svm_grid_radial")

The grid search selects the same optimal parameter values as the random search (C=32 and sigma = 0.040), therefore also resulting in 88% and 87% training and test accuracies. To get an idea on how C and sigma influence the training set accuracy, we plot the cross-validation accuracy as a function of C, with separate lines for each value of sigma.

ggplot() + 
  my_theme() +
  geom_line(data = svm_grid_radial$results, aes(x = C, y = Accuracy, color = factor(sigma))) +
  geom_point(data = svm_grid_radial$results, aes(x = C, y = Accuracy, color = factor(sigma))) +
  labs(x = "Cost", y = "Cross-Validation Accuracy", color = "Sigma") +
  ggtitle('Relationship between cross-validation accuracy and values of cost and sigma')

The plot shows that the green line (sigma = 0.04) has the highest cross-validation accuracy for all values of C except for smaller values of C such as 0.01 and 10. Although the accuracy at C=10 and sigma = 0.1 (blue line) comes close, the highest overall accuracy achieved is for C=32 and sigma=32 (green line).

Wrapping Up

To compare the models we have estimated throughout this series of blog posts, we can look at the resampled accuracies of the models. We can do this in our case because we set the same seed of 1234 before training each model.² Essentially, resampling is an important tool to validate our models, and to what extent they are generalizeable onto data they have not been trained on. We used five repeats of five-fold cross-validation, which means that the training data was divided into five random subsets, and that throughout five iterations (“folds”) the model was trained on four of these subsets and tested on the remaining subset (changing with every fold), and that this whole process has been repeated five times. The goal of these repetitions of k-fold cross-validation is to reduce the bias in the estimator, given that the folds in non-repeated cross-validation are not independent (as data used for training at one fold is used for testing at another fold). As we performed five repeats of five-fold cross-validation, we can essentially obtain 5*5=25 accuracies per model. Let’s compare these resampled accuracies visually by means of a boxplot. First, we create a list of all models estimated, including the random forests, gradient-boosted trees and support vector machines. We then compute the resampled accuracies using the resamples() function from the caret package. From the resulting object, resamp, we only keep the columns containing the resample unit (e.g. Fold1.Rep1) and the five columns containing the accuracies for each of the five models. We melt this into a long format and from the result, plotdf, we remove the ~Accuracy part from the strings in column Model.

library(reshape2)
model_list = list(rf_rand, rf_grid, xgb_tune, svm_rand_radial, svm_grid_radial)
names(model_list) = c(paste0('Random forest ', c("(random ", "(grid "), "search)"), "Gradient-boosted trees", 
                      paste0('Support vector machine ', c("(random ", "(grid "), "search)"))
resamp = resamples(model_list)
accuracy_variables = names(resamp$values)[grepl("Accuracy", names(resamp$values))]
plotdf = melt(resamp$values[, c('Resample', accuracy_variables)], 
              id = "Resample", value.name = "Accuracy", variable.name = "Model")
plotdf$Model = gsub("~.*","", plotdf$Model)

Next, we create a boxplot with the estimated models on the x-axis and the accuracy on the y-axis.

ggplot() +
  geom_boxplot(data = plotdf, aes(x = Model, y = Accuracy, color = Model)) +
  ggtitle('Resampled accuracy for machine learning models estimated') + 
  my_theme() + 
  theme(axis.text.x = element_text(angle = 45, hjust = 1)) + 
  labs(x = NULL, color = NULL) +
  guides(color = FALSE)

We observe from these box plots that the support vector machines perform best, followed by the gradient-boosted trees and the random forests. Let’s also take a look at the other performance metrics from all models we have looked at.

mp.df = rbind(mp.rf.rand, mp.rf.grid, mp.xgb, mp.svm.rand.radial, mp.svm.grid.radial, mp.svm.grid.linear)
mp.df[order(mp.df$accuracy_test, decreasing = TRUE), ]

After taking measures to reduce overfitting, the convolutional neural network from the first blog post of this series achieved training and test set accuracies of 89.4% and 88.8% respectively. The random and grid search for the best value of mtry in the random forests resulted in the selection of mtry=5. The grid search performed better on the training set than the random search on the basis of all metrics except recall (i.e. sensitivity), and better on the test set on all metrics except precision (i.e. positive predictive value). The test set accuracies achieved by the random search and grid search were 84.7% and 84.8% respectively. The gradient-boosted decision trees performed slightly better than the random forests on all metrics and achieved a test set accuracy of 85.5%. Both tree-based models more often misclassified pullovers, shirts and coats, while correctly classifying trousers, boots, bags and sneakers. The random forests and gradient-boosted trees are however outperformed by the support vector machine with radial Kernel specification with tuning parameter values of C=32 and sigma=0.040: this model achieved 86.9% test set accuracy upon a random search for the best parameters. The grid search resulted in slightly worse test set performance, but better training set performance in terms of all metrics except accuracy. Nonetheless, none of the models estimated beats the convolutional neural network from the first blog post of this series, neither in performance nor computational time and feasibility. However, the differences in test set performance are only small: the convolutional neural network achieved 88.8% test set accuracy, compared to 86.9% test set accuracy achieved by the support vector machine with radial Kernel. This shows that we do not always need to resort to deep learning to obtain high accuracies, but that we can also perform image classification to a reasonable standard using basic machine learning models with dimensionality-reduced data.

Just as a side note, accuracy may not be a good model performance metric in some cases. As the Fashion MNIST data has balanced categories (i.e. each category has the same number of observations), accuracy can be a good measure of model performance. However, in the case of unbalanced data, accuracy may be a misleading metric (“accuracy paradox”). Imagine for example that in a binary classification problem of 100 instances, there are 99 observations of class 0 and 1 observation of class 1. If the predictions are 1 for each observation, the model performs with 99% accuracy. As this may be misleading, recall and precision are often used instead. Have a look at this blog post if you are unsure what these performance metrics entail.↩
Note that in order to compare the resampled accuracies of different models, they need to have been trained with the same seed, and they need to have the same training method and control settings as specified in the trainControl() function. In our case, the method used is repeatedcv, and so all models should have been trained with five repeats (repeats = 5) of five-fold cross-validation (number = 5). Note that the gradient-boosted model in the previous post of this series was trained with non-repeated five-fold cross-validation (method = "cv"). In order to compare this model with the random forests and support vector machines, the method in trainControl() should be changed to method = "repeatedcv" and the number of repeats should be five: repeats = 5. This should be the same for all models trained in order to compute resampled accuracies.↩

Comparing Machine Learning Algorithms for Predicting Clothing Classes: Part 4

Tue, 24 Mar 2020 00:00:00 +0000

Support Vector Machine

We begin with training the support vector machine using the PCA reduced training and test data sets train.images.pca and test.images.pca constructed in Part 2.

library(MLmetrics)
svm_control = trainControl(method = "repeatedcv",   
                            number = 5,  
                            repeats = 5, 
                            classProbs = FALSE,
                            allowParallel = TRUE, 
                            summaryFunction = multiClassSummary,
                           savePredictions = TRUE)

set.seed(1234)
svm_rand_radial = train(label ~ ., 
                data = cbind(train.images.pca, label = train.classes),
                method = "svmRadial", 
                trControl = svm_control, 
                tuneLength = pca.dims,
                metric = "Accuracy")
svm_rand_radial$results[, c("sigma", "C", 'Accuracy')]

We can check the model performance on both the training and test sets by means of different metrics using a custom function, model_performance, which can be found in this code on my Github.

mp.svm.rand.radial = model_performance(svm_rand_radial, train.images.pca, test.images.pca, 
                                       train.classes, test.classes, "svm_random_radial")

library(data.table)
pred_dt = as.data.table(svm_rand_radial$pred[, names(svm_rand_radial$bestTune)]) 
names(pred_dt) = names(svm_rand_radial$bestTune)
index_list = lapply(1:ncol(svm_rand_radial$bestTune), function(x, DT, tune_opt){
  return(which(DT[, Reduce(`&`, lapply(.SD, `==`, tune_opt[, x])), .SDcols = names(tune_opt)[x]]))
}, pred_dt, svm_rand_radial$bestTune)
rows = Reduce(intersect, index_list)
pred_train = svm_rand_radial$pred$pred[rows]
trainY = svm_rand_radial$pred$obs[rows]
conf = table(pred_train, trainY)

conf = data.frame(conf / rowSums(conf))
ggplot() + 
  geom_tile(data = conf, aes(x = trainY, y = pred_train, fill = Freq)) + 
  labs(x = "Actual", y = "Predicted", fill = "Proportion") +
  my_theme() +
  theme(axis.text.x = element_text(angle = 90, hjust = 1)) + 
   scale_fill_continuous(breaks = seq(0, 1, 0.25)) +
  coord_fixed()

grid_radial = expand.grid(sigma = c(.01, 0.04, 0.1), C = c(0.01, 10, 32, 70, 150))
set.seed(1234)
svm_grid_radial = train(label ~ ., 
                              data = cbind(train.images.pca, label = train.classes),
                              method = "svmRadial", 
                              trControl = svm_control, 
                              tuneGrid = grid_radial,
                              metric = "Accuracy")
svm_grid_radial$results[, c("sigma", "C", 'Accuracy')]

mp.svm.grid.radial = model_performance(svm_grid_radial, train.images.pca, test.images.pca, 
                                       train.classes, test.classes, "svm_grid_radial")

ggplot() + 
  my_theme() +
  geom_line(data = svm_grid_radial$results, aes(x = C, y = Accuracy, color = factor(sigma))) +
  geom_point(data = svm_grid_radial$results, aes(x = C, y = Accuracy, color = factor(sigma))) +
  labs(x = "Cost", y = "Cross-Validation Accuracy", color = "Sigma") +
  ggtitle('Relationship between cross-validation accuracy and values of cost and sigma')

Wrapping Up

library(reshape2)
model_list = list(rf_rand, rf_grid, xgb_tune, svm_rand_radial, svm_grid_radial)
names(model_list) = c(paste0('Random forest ', c("(random ", "(grid "), "search)"), "Gradient-boosted trees", 
                      paste0('Support vector machine ', c("(random ", "(grid "), "search)"))
resamp = resamples(model_list)
accuracy_variables = names(resamp$values)[grepl("Accuracy", names(resamp$values))]
plotdf = melt(resamp$values[, c('Resample', accuracy_variables)], 
              id = "Resample", value.name = "Accuracy", variable.name = "Model")
plotdf$Model = gsub("~.*","", plotdf$Model)

Next, we create a boxplot with the estimated models on the x-axis and the accuracy on the y-axis.

ggplot() +
  geom_boxplot(data = plotdf, aes(x = Model, y = Accuracy, color = Model)) +
  ggtitle('Resampled accuracy for machine learning models estimated') + 
  my_theme() + 
  theme(axis.text.x = element_text(angle = 45, hjust = 1)) + 
  labs(x = NULL, color = NULL) +
  guides(color = FALSE)

mp.df = rbind(mp.rf.rand, mp.rf.grid, mp.xgb, mp.svm.rand.radial, mp.svm.grid.radial, mp.svm.grid.linear)
mp.df[order(mp.df$accuracy_test, decreasing = TRUE), ]

Just as a side note, accuracy may not be a good model performance metric in some cases. As the Fashion MNIST data has balanced categories (i.e. each category has the same number of observations), accuracy can be a good measure of model performance. However, in the case of unbalanced data, accuracy may be a misleading metric (“accuracy paradox”). Imagine for example that in a binary classification problem of 100 instances, there are 99 observations of class 0 and 1 observation of class 1. If the predictions are 1 for each observation, the model performs with 99% accuracy. As this may be misleading, recall and precision are often used instead. Have a look at this blog post if you are unsure what these performance metrics entail.↩
Note that in order to compare the resampled accuracies of different models, they need to have been trained with the same seed, and they need to have the same training method and control settings as specified in the trainControl() function. In our case, the method used is repeatedcv, and so all models should have been trained with five repeats (repeats = 5) of five-fold cross-validation (number = 5). Note that the gradient-boosted model in the previous post of this series was trained with non-repeated five-fold cross-validation (method = "cv"). In order to compare this model with the random forests and support vector machines, the method in trainControl() should be changed to method = "repeatedcv" and the number of repeats should be five: repeats = 5. This should be the same for all models trained in order to compute resampled accuracies.↩

Comparing Machine Learning Algorithms for Predicting Clothing Classes: Part 3

Tue, 10 Mar 2020 00:00:00 +0000

This is the third post in a series devoted to comparing different machine learning methods for predicting clothing categories from images using the Fashion MNIST data by Zalando. In the first post of this series, we prepared the data for analysis and used my “go-to” Python deep learning neural network model to predict the clothing categories of the Fashion MNIST data. In Part 2, we used principal components analysis (PCA) to compress the clothing image data down from 784 to just 17 pixels. In this post, we pick up where we left off in Part 2 and use the two data sets train.data.pca and test.data.pca to build and compare random forest and gradient-boosted models. The R code for this post can be found on my Github repository.

Tree-Based Methods

Tree-based methods stratify or segment the predictor space into a number of simple regions using a set of decision rules that can be summarized in a decision tree. The focus here will be on classification trees, as the Fashion MNIST outcome variable is categorical with ten classes. Because single trees have a relatively low level of predictive accuracy compared to other classification approaches, I will not show you how to fit a single tree in this blog post, but you can find the code for this (as well as tree pruning) on my Github.

Ensemble methods improve predictive accuracy and decrease variance by aggregating many single decision trees. Here, I show both random forests and gradient-boosted trees as ensemble methods because the former are easier to implement as they are more robust to overfitting and require less tuning, while the latter generally outperform other tree-based methods in terms of prediction accuracy. The models are estimated in supervised mode here as labeled data are available and the goal is to predict classes. For a more formal explanation of the tree-based methods, I refer you to James et al. (2013).

Random Forest

Random forests use bootstrap aggregating to reduce the variance of the outcomes. In the first step, bootstrapping (sampling with replacement) is used to create B training sets from the population with the same size as the original training set. Hereafter, a separate tree for each of these training sets is built. Trees are grown using recursive binary splitting on the training data until a node reaches some minimum number of observations. The idea is that the tree should go from impure (equal mixing of classes) to pure (each leaf corresponds to one class exactly). The splits are determined such that they decrease variance, error and impurity. Random forests decorrelate the trees by considering only m of all p predictors as split candidates, whereby often m = sqrt(p).

Classification trees predict that each observation belongs to the most commonly occurring class (i.e. majority vote) of training observations in the region to which it belongs. The classification error rate is the fraction of the number of misclassified observations and the total number of classified observations. The Gini index and cross-entropy measures determine the level of impurity in order to decide on the best split at each node. In the final step, the average of the classification prediction results of all B trees is computed from the majority vote. The accuracy is computed as the out-of-bag (OOB) error and/or the test set error.

As each bootstrap samples from the training set with replacement, about ²⁄₃ of the observations are not sampled and some are sampled multiple times. In the case of B trees in the forest, each observation is left out of approximately B/ 3 trees. The non-sampled observations are used as test set and the B/ 3 trees are used for out-of-sample predictions. In random forests, pruning is not needed as potential over-fitting is (partially) mitigated by the usage of bootstrapped samples and multiple decorrelated random trees.

We start by tuning the number of variables that are randomly sampled as candidates at each split,mtry. We make use of the caret framework, which makes it easy to train and evaluate a large number of different types of models. For random forests, we have the repeatedcv method perform five-fold cross-validation with five repetitions. For now, we build a random forest containing 200 trees because previous analyses with these data showed that the error does not decrease substantially when the number of trees is larger than 200, while a larger number of trees does require more computational power. We will see later on that 200 trees is indeed sufficient for this analysis. We let the algorithm determine what the best model is based on the accuracy metric, and we ask the algorithm to run the model for pca.dims (= 17) different values of mtry. We first specify the controls in rf_rand_control: we perform 5-fold cross-validation with 5 repeats (method = "cv", number = 5 and repeats = 5), allow parallel computation (allowParallel = TRUE) and save the predicted values (savePredictions = TRUE).

library(caret)
rf_rand_control = trainControl(method = "repeatedcv", 
                             search = "random", 
                             number = 5, 
                             repeats = 5, 
                             allowParallel = TRUE, 
                             savePredictions = TRUE)
set.seed(1234)
rf_rand = train(x = train.images.pca, 
                 y = train.data.pca$label,
                 method = "rf", 
                 ntree = 200,
                 metric = "Accuracy", 
                 trControl = rf_rand_control, 
                 tuneLength = pca.dims)

print(rf_rand)

We can check the model performance on both the training and test sets by means of different metrics using a custom function, model_performance, which can be found on my Github.

mp.rf.rand = model_performance(rf_rand, train.images.pca, test.images.pca, 
                               train.data.pca$label, test.data.pca$label, "random_forest_random")

We can also use the caret framework to perform a grid search with pre-specified values for mtry rather than a random search as above.

rf_grid_control = trainControl(method = "repeatedcv", 
                             search = "grid", 
                             number = 5, 
                             repeats = 5, 
                             allowParallel = TRUE, 
                             savePredictions = TRUE)
set.seed(1234)
rf_grid = train(x = train.images.pca, 
                 y = train.data.pca$label,
                 method = "rf", 
                 ntree = 200,
                 metric = "Accuracy", 
                 trControl = rf_grid_control,
                 tuneGrid = expand.grid(.mtry = c(1:pca.dims)))

plot(rf_grid)

mp.rf.grid = model_performance(rf_grid, train.images.pca, test.images.pca, 
                               train.data.pca$label, test.data.pca$label, "random_forest_grid")

As shown by the results, the random search selects mtry=4 as the optimal parameter, resulting in 85% training and test set accuracies. The grid search selects mtry=5 and achieves similar accuracies for both values of 4 and 5 for mtry. We can see from the results that according to rf_rand, mtry values of 4 and 5 lead to very similar results, which also goes for mtry values of 5 and 6 for rf_grid. Although the results of rf_rand and rf_grid are very similar, we choose the best model on the basis of accuracy and save this in rf_best. For this model, we’ll look at the relationship between the error and random forest size as well as the receiver operating characteristic (ROC) curves for every class. Let’s start by subtracting the best performing model from rf_rand and rf_grid.

rf_models = list(rf_rand$finalModel, rf_grid$finalModel)
rf_accs = unlist(lapply(rf_models, function(x){ sum(diag(x$confusion)) / sum(x$confusion) }))
rf_best = rf_models[[which.max(rf_accs)]]

Next, we plot the relationship between the size of the random forest and the error using the plot() function from the randomForest package.

library(randomForest)
plot(rf_best, main = "Relation between error and random forest size")

We observe from this plot that the error does not decrease anymore for any of the classes after about 100 trees, and so we can conclude that our forest size of 200 is sufficient. We can also use the varImpPlot() function from the randomForest package to plot the importance for each variable. I will not show that here because it’s not as meaningful given that our variables are principal components of the actual pixels, but it’s good to keep in mind when extending these analyses to other data.

Finally, we plot the ROC curves for every class. On the x-axis of an ROC plot, we usually have the false positive rate (false positive / (true negative + false positive)) and on the y-axis the true positive rate (true positive / (true positive + false negative)). Essentially, the ROC plot helps us to compare the performance of our model with respect to predicting different classes. The area underneath each curve is the proportion of correct classifications for that particular class. Therefore, the further the curve is “drawn” towards the top left from the 45 degrees line, the better the classification for that class. We first need to obtain the data for the ROC curve for every class (or clothing category) in our data, which we bind together by rows, including a label for the classes.

library(ROCR)
library(plyr)
pred_roc = predict(rf_best, test.images.pca, type = "prob")
classes = unique(test.data.pca$label)
classes = classes[order(classes)]
plot_list = list()
for (i in 1:length(classes)) { 
  actual = ifelse(test.data.pca$label == classes[i], 1, 0)
  pred = prediction(pred_roc[, i], actual)
  perf = performance(pred, "tpr", "fpr")
  plot_list[[i]] = data.frame(matrix(NA, nrow = length(perf@x.values[[1]]), ncol = 2))
  plot_list[[i]]['x'] = perf@x.values[[1]]
  plot_list[[i]]['y'] = perf@y.values[[1]]
}
plotdf = rbind.fill(plot_list)
plotdf["Class"] = rep(cloth_cats, unlist(lapply(plot_list, nrow)))

Next, we plot the ROC curves for every class. Note that we use the custom plotting theme my_theme() as defined in the the second blog post of this series.

ggplot() +
  geom_line(data = plotdf, aes(x = x, y = y, color = Class)) + 
  labs(x = "False positive rate", y = "True negative rate", color = "Class") +
  ggtitle("ROC curve per class") + 
  theme(legend.position = c(0.85, 0.35)) +
  coord_fixed() + 
  my_theme()

We observe from the ROC curves that shirts and pullovers are most often misclassified, whereas trousers, bags, boots and sneakers are most often correctly classified. A possible explanation for this could be that shirts and pullovers can be very similar in shape to other categories, such as tops, coats and dresses; whereas bags, trousers, boots and sneakers are more dissimilar to other categories in the data.

Gradient-Boosted Trees

While in random forests each tree is fully grown and trained independently with a random sample of data, in boosting every newly built tree incorporates the error from the previously built tree. That is, the trees are grown sequentially on an adapted version of the initial data, which does not require bootstrap sampling. Because of this, boosted trees are usually smaller and more shallow than the trees in random forests, improving the tree where it does not work well enough yet. Boosting is often said to outperform random forests, which is mainly because the approach learns slowly. This learning rate can be controlled by the shrinkage parameter, which we’ll tune later.

In boosting, it’s important to tune the parameters well and play around with different values of the parameters, which can easily be done using the caret framework. These parameters include the learning rate, eta, the minimal required loss reduction to further partition on a leaf node of the tree, gamma, the maximal depth of a tree max_depth, the number of trees in the forest, nrounds, the minimum number of observations in the trees’ nodes, min_child_weight, the fraction of the training set observations randomly selected to grow trees, subsample, and the proportion of independent variables to use for each tree, colsample_bytree. An overview of all parameters can be found here. Again, we use the caret framework to tune our boosting model.

xgb_control = trainControl(
  method = "cv",
  number = 5,
  classProbs = TRUE,
  allowParallel = TRUE,
  savePredictions = TRUE
)

Next, we define the possible combinations of the tuning parameters in the form of a grid, named xgb_grid.

xgb_grid = expand.grid(
  nrounds = c(50, 100), 
  max_depth = seq(5, 15, 5),
  eta = c(0.002, 0.02, 0.2),
  gamma = c(0.1, 0.5, 1.0), 
  colsample_bytree = 1, 
  min_child_weight = c(1, 2, 3),
  subsample = c(0.5, 0.75, 1)
)

We set the seed and then train the model onto the transformed principal components of the training data using xgb_control and xgb_grid as specified earlier. Note that because of the relatively large number of tuning parameters, and thus the larger number of possible combinations of these parameters (nrow(xgb_grid) = 486), this may take quite a long time to run.

set.seed(1234)
xgb_tune = train(x = train.images.pca, 
                 y = train.classes,
                 method = "xgbTree",
                 trControl = xgb_control,
                 tuneGrid = xgb_grid
)
xgb_tune

(Note that the output of xgb_tune has been truncated for this post.)

Let’s have a look at the tuning parameters resulting in the highest accuracy, and the model performance overall.

xgb_tune$results[which.max(xgb_tune$results$Accuracy), ]

mp.xgb = model_performance(xgb_tune, train.images.pca, test.images.pca, 
                           train.classes, test.classes, "xgboost")

The optimal combination of tuning parameter values resulted in 86.2% training and 85.5% testing accuracies. Although there may be some slight overfitting going on, the model performs a bit better than the random forest, as was expected. Let’s have a look at the confusion matrix for the test set predictions to observe what clothing categories are mostly correctly or wrongly classified.

table(pred = predict(xgb_tune, test.images.pca),
      true = test.classes)

As we saw with the random forests, pullovers, shirts and coats are most often mixed up, while trousers, boots, bags and sneakers are most often correctly classified.

In the next and final post of this series, we will use the PCA reduced data again, but this time to estimate and assess support vector machines. Will these models be able to achieve similar results on the reduced data as neural networks on the full data? Let’s see!

Comparing Machine Learning Algorithms for Predicting Clothing Classes: Part 2

Tue, 03 Mar 2020 00:00:00 +0000

This is the second post in a series devoted to comparing different machine and deep learning methods to predict clothing categories from images using the Fashion MNIST data by Zalando. In the first blog post of this series, we explored the data, prepared the data for analysis and learned how to predict the clothing categories of the Fashion MNIST data using my go-to model: an artificial neural network in Python. In this second blog post, we will perform dimension reduction on the data in order to make it feasible to run standard machine learning models (including tree-based methods and support vector machines) in the future. The R code for the first post can be found on my Github.

library(keras)
library(magrittr)
library(ggplot2)

Data Preparation

Let’s fetch the data again and prepare the training and test sets.

install_keras()  
fashion_mnist = keras::dataset_fashion_mnist()
c(train.images, train.labels) %<-% fashion_mnist$train
c(test.images, test.labels) %<-% fashion_mnist$test

Next, we normalize the image data by dividing the pixel values by the maximum value of 255.

train.images = data.frame(t(apply(train.images, 1, c))) / max(fashion_mnist$train$x)
test.images = data.frame(t(apply(test.images, 1, c))) / max(fashion_mnist$train$x)

Now, we combine the training images train.images and labels train.labels as well as test images test.images and labels test.labels in separate data sets, train.data and test.data, respectively.

pixs = ncol(fashion_mnist$train$x)
names(train.images) = names(test.images) = paste0('pixel', 1:(pixs^2))
train.labels = data.frame(label = factor(train.labels))
test.labels = data.frame(label = factor(test.labels))
train.data = cbind(train.labels, train.images)
test.data = cbind(test.labels, test.images)

As train.labels and test.labels contain integer values for the clothing category (i.e. 0, 1, 2, etc.), we also create objects train.classes and test.classes that contain factor labels (i.e. Top, Trouser, Pullover etc.) for the clothing categories. We will need these for some of the machine learning models later on.

cloth_cats = c('Top', 'Trouser', 'Pullover', 'Dress', 'Coat',  
                'Sandal', 'Shirt', 'Sneaker', 'Bag', 'Boot')
train.classes = factor(cloth_cats[as.numeric(as.character(train.labels$label)) + 1])
test.classes = factor(cloth_cats[as.numeric(as.character(test.labels$label)) + 1])

Principal Components Analysis

Our training and test image data sets currently contain 784 pixels or variables. We may expect a large share of these pixels, especially those towards the boundaries of the images, to have relatively small variance, because most of the fashion items are centered in the images. In other words, there may be quite some redundant pixels in our data set. To check whether this is the case, let’s plot the average pixel value on a 28 by 28 grid. We first obtain the average pixel values and store these in train.images.ave, after which we plot these values on the grid. We also define a custom plotting theme, my_theme, to make sure all our figures have the same aesthetics. Note that in the plot created, a higher cell (pixel) value means that the average value of that pixel is higher, and thus that the pixel is darker on average (as a pixel value of 0 refers to white and a pixel value of 255 refers to black).

train.images.ave = data.frame(pixel = apply(train.images, 2, mean), 
                               x = rep(1:pixs, each = pixs), 
                               y = rep(1:pixs, pixs))
my_theme = function () { 
  theme_bw() + 
    theme(axis.text = element_text(size = 14),
          axis.title = element_text(size = 14),
          strip.text = element_text(size = 14),
          panel.grid.major = element_blank(), 
          panel.grid.minor = element_blank(),
          panel.background = element_blank(), 
          legend.position = "bottom",
          strip.background = element_rect(fill = 'white', colour = 'white'))
}
ggplot() +
  geom_raster(data = train.images.ave, aes(x = x, y = y, fill = pixel)) +
  my_theme() +
  labs(x = NULL, y = NULL, fill = "Average scaled pixel value") +
  ggtitle('Average image in Fashion MNIST training data')

As we can see from the plot, there are many pixels with a low average value, meaning that they are white in most of the images in our training data. These pixels are mostly redundant, while they do contribute to computational costs and sparsity. Therefore, we might be better off reducing the dimensionality in our data to reduce redundancy, overfitting and computational cost. One method to do so is principal components analysis (PCA). Essentially, PCA statistically reduces the dimensions of a set of correlated variables by transforming them into a smaller number of linearly uncorrelated variables. The resulting “principal components” are linear combinations of the original variables. The first principal component explains the largest part of the variance, followed by the second principal component and so forth. For a more extensive explanation of PCA, I refer you to James et al. (2013).

Let’s have a look at how many variables can explain which part of the variance in our data. We compute the 784 by 784 covariance matrix of our training images using the cov() function, after which we execute PCA on the covariance matrix using the prcomp() function in the stats library. Looking at the results, we observe that 50 principal components in our data explain 99.902% of the variance in the data. This can be nicely shown in a plot of the cumulative proportion of variance against component indices. Note that the component indices here are sorted by their ability to explain the variance in our data, and not based on their pixel position in the 28 by 28 image.

library(stats)
cov.train = cov(train.images)                      
pca.train = prcomp(cov.train)                  
plotdf = data.frame(index = 1:(pixs^2), 
                    cumvar = summary(pca.train)$importance["Cumulative Proportion", ])
t(head(plotdf, 50))

##           PC1    PC2    PC3    PC4    PC5    PC6    PC7    PC8    PC9
## index  1.0000 2.0000 3.0000 4.0000 5.0000 6.0000 7.0000 8.0000 9.0000
## cumvar 0.6491 0.8679 0.9107 0.9421 0.9611 0.9759 0.9816 0.9862 0.9885
##           PC10    PC11    PC12    PC13    PC14    PC15   PC16    PC17
## index  10.0000 11.0000 12.0000 13.0000 14.0000 15.0000 16.000 17.0000
## cumvar  0.9906  0.9918  0.9928  0.9935  0.9941  0.9945  0.995  0.9954
##           PC18   PC19    PC20    PC21    PC22    PC23   PC24    PC25
## index  18.0000 19.000 20.0000 21.0000 22.0000 23.0000 24.000 25.0000
## cumvar  0.9957  0.996  0.9962  0.9965  0.9967  0.9969  0.997  0.9972
##           PC26    PC27    PC28    PC29    PC30   PC31   PC32    PC33
## index  26.0000 27.0000 28.0000 29.0000 30.0000 31.000 32.000 33.0000
## cumvar  0.9974  0.9975  0.9976  0.9978  0.9979  0.998  0.998  0.9981
##           PC34    PC35    PC36    PC37    PC38    PC39    PC40    PC41
## index  34.0000 35.0000 36.0000 37.0000 38.0000 39.0000 40.0000 41.0000
## cumvar  0.9982  0.9983  0.9984  0.9984  0.9985  0.9986  0.9986  0.9987
##           PC42    PC43    PC44    PC45    PC46    PC47   PC48   PC49
## index  42.0000 43.0000 44.0000 45.0000 46.0000 47.0000 48.000 49.000
## cumvar  0.9987  0.9988  0.9988  0.9989  0.9989  0.9989  0.999  0.999
##          PC50
## index  50.000
## cumvar  0.999

ggplot() + 
  geom_point(data = plotdf, aes(x = index, y = cumvar), color = "red") +
  labs(x = "Index of primary component", y = "Cumulative proportion of variance") +
  my_theme() +
  theme(strip.background = element_rect(fill = 'white', colour = 'black'))

We also observe that 99.5% of the variance is explained by only 17 principal components. As 99.5% is already a large share of the variance, and we want to reduce the number of pixels (variables) by as many as we can to reduce computation time for the models coming up, we choose to select these 17 components for further analysis. (Although this is unlikely to influence our results hugely, if you have more time I’d suggest you select the 50 components explaining 99.9% of the data, or execute the analyses on the full data set.)

We also save the relevant part of the rotation matrix created by the prcomp() function and stored in pca.train, such that its dimensions become 784 by 17. We then multiply our training and test image data by this rotation matrix called pca.rot. We further combine the transformed image data (train.images.pca and test.images.pca) with the integer labels for the clothing categories in train.data.pca and test.data.pca. We will use these reduced data in our further analyses to decrease computational time.

pca.dims = which(plotdf$cumvar >= .995)[1]
pca.rot = pca.train$rotation[, 1:pca.dims]  
train.images.pca = data.frame(as.matrix(train.images) %*% pca.rot)
test.images.pca  = data.frame(as.matrix(test.images) %*% pca.rot)
train.data.pca = cbind(train.images.pca, label = factor(train.data$label))
test.data.pca = cbind(test.images.pca, label = factor(test.data$label))

In the next post of this series, we will use the PCA reduced data to estimate and assess tree-based methods, including random forests and gradient-boosted trees.

References

James, G., Witten, D., Hastie, T., & Tibshirani, R. (2013). An introduction to statistical learning (Vol. 112, p. 18). New York: Springer.

tidyposterior's Bayesian Approach to Model Comparison

Mon, 16 Dec 2019 00:00:00 +0000

A task common to many machine learning workflows is to compare the performance of several models with respect to some metric such as accuracy or area under the ROC curve. Standard practice is to try out several different algorithms on a training data set and see which works better. Unfortunately, all to often, after this work has been done, model selection comes down to “eyeballing” several different ROC curves. If you find eyeballing a little too informal, then take a look at the tidyposterior package (part of the universe of ‘tidymodels`). The Getting Started vignette asks the question:

When looking at resampling results, are the differences between the models “real”?

and lays out a modelling approach to answering it that is grounded in Bayesian theory. This means that all of the information about the differences between two models to be compared will be summed up in a posterior distribution for the differences that will make it possible to calculate probabilities entirely based on the particular data at hand, the information encoded in the various priors, and the effect size that has been chosen because it is considered large enough to make a practical difference. Given an effect size chosen up front to represent a practical difference, the tidyposterior model will enable conclusions such as; there is a probability of .65 that, for all practical purposes, the two distributions are different.

There is no magic here. tidyposterior works through the mechanics of an Bayesian analysis with minimum input from the user (a situation that is possible because of the very constrained nature of comparison problem and the use of cross-validation statistics as input), but the result ultimately comes down to choosing an effect size that makes sense based on domain knowledge of the underlying experiment. For some studies, an effect of .05 might seem to be reasonable. In a situation where having an interpretable is worth more than a black-box prediction modelers may be willing to go higher. And, for studies where models may support life or death decisions something in the 2% range may be required.

The Getting Started guide provides end-to-end road map on using the tidyposterior functions to compare models, but it assumes quite a bit of background. Someone just getting started with Bayesian statistics or doing Bayesian statistics in R, might be more comfortable with a little more description of the landscape. For the rest of this post, I’ll be the tour guide and provide a little color commentary that you may find helpful as you walk through the vignette.

The first thing to point out is that the vignette begins after most of the heavy lifting for a model comparison study has already been done, and the information required to compare models has been wrapped up in the data frame precise_example.

As website for tidyposterior states:

precise_example contains the results of the classification analysis of a real data set using 10-fold CV. The holdout data sets contained thousands of examples and have precise performance estimates. Three models were fit to the original data and several performance metrics are included.

precise_example[,-1]

## # A tibble: 10 x 28
##    id    glm_Accuracy glm_Kappa glm_ROC glm_Sens glm_Spec glm_PRAUC
##    <chr>        <dbl>     <dbl>   <dbl>    <dbl>    <dbl>     <dbl>
##  1 Fold…        0.722     0.328   0.798    0.729    0.720     0.489
##  2 Fold…        0.696     0.290   0.778    0.720    0.691     0.456
##  3 Fold…        0.701     0.297   0.790    0.723    0.696     0.486
##  4 Fold…        0.704     0.316   0.795    0.763    0.691     0.497
##  5 Fold…        0.721     0.324   0.797    0.722    0.721     0.481
##  6 Fold…        0.711     0.303   0.780    0.706    0.712     0.484
##  7 Fold…        0.702     0.305   0.790    0.739    0.694     0.485
##  8 Fold…        0.718     0.321   0.784    0.729    0.715     0.477
##  9 Fold…        0.720     0.328   0.795    0.739    0.715     0.491
## 10 Fold…        0.719     0.324   0.796    0.728    0.717     0.488
## # … with 21 more variables: glm_Precision <dbl>, glm_Recall <dbl>,
## #   glm_F <dbl>, knn_Accuracy <dbl>, knn_Kappa <dbl>, knn_ROC <dbl>,
## #   knn_Sens <dbl>, knn_Spec <dbl>, knn_PRAUC <dbl>, knn_Precision <dbl>,
## #   knn_Recall <dbl>, knn_F <dbl>, nnet_Accuracy <dbl>, nnet_Kappa <dbl>,
## #   nnet_ROC <dbl>, nnet_Sens <dbl>, nnet_Spec <dbl>, nnet_PRAUC <dbl>,
## #   nnet_Precision <dbl>, nnet_Recall <dbl>, nnet_F <dbl>

The various statistics for the different models have been matched by setting a random number seed and using the same random sampling process for each fold. This is the kind of thing that can easily be done with the rsample or caret packages, but requires a bit of work otherwise.

The Getting Started vignette focuses on ROC, the area under the ROC Curve. A little bit of preprocessing produces “wide” and “long” (or stacked) versions of the ROC statistics. Note that information on the performance statistics contained in the data set can be found on the yardstick reference page.

This first bit of code selects the ROC for the different statistics and creates a stacked version of the data set.

rocs <- precise_example %>%
  select(id, contains("ROC")) %>%
  setNames(tolower(gsub("_ROC$", "", names(.)))) 
rocs

## # A tibble: 10 x 4
##    id       glm   knn  nnet
##    <chr>  <dbl> <dbl> <dbl>
##  1 Fold01 0.798 0.753 0.843
##  2 Fold02 0.778 0.744 0.827
##  3 Fold03 0.790 0.743 0.846
##  4 Fold04 0.795 0.755 0.852
##  5 Fold05 0.797 0.760 0.838
##  6 Fold06 0.780 0.747 0.852
##  7 Fold07 0.790 0.757 0.833
##  8 Fold08 0.784 0.754 0.832
##  9 Fold09 0.795 0.764 0.846
## 10 Fold10 0.796 0.748 0.847

rocs_stacked <- gather.rset(rocs)
head(rocs_stacked)

##       id model statistic
## 1 Fold01   glm    0.7981
## 2 Fold02   glm    0.7779
## 3 Fold03   glm    0.7901
## 4 Fold04   glm    0.7948
## 5 Fold05   glm    0.7972
## 6 Fold06   glm    0.7804

The first graph of the vignette plots the ROC cross-validation statistics for each fold. The fact that the lines are nearly all parallel indicates that there is probably a resampling effect, but it does look like there is a clear difference in the performance of the three models.

ggplot(rocs_stacked, aes(x = model, y = statistic, group = id, col = id)) + geom_line(alpha = .75) + theme(legend.position = "none")

The following plot makes the performance differences even more apparent. There is very little overlap of the kernel density estimates of the three distributions.

ggplot(rocs_stacked, aes(x = statistic, col = model, fill = model)) + 
  geom_histogram(aes(y=..density..), alpha=0.5, position="identity", bins = 35)+
  geom_density(alpha=.2) + xlim(min = .73, max = .87) +
  geom_rug()

Quantifying these differences is the point of our exercise. The strategy will be to fit a Bayesian model that explicitly accounts for the fold effects, and then compare the differences in posterior distributions to calculate the probability that the various distributions are indeed different.

Here, we fit the model with the tidyposterior function perf_mod(). Note that although the only parameter passed to perf_mod() is to set the seed, other options can be specified. A great deal of attention has been put into setting the defaults. I will explain the model perf_mod() executes below when we examine the resulting model object.

roc_model <- perf_mod(rocs, seed = 2824)

I have suppressed the voluminous output generated by fitting the model, but if you run it yourself, you will see that there was a lot going on under the covers. Four independent Markov chains were initiated for the stan Monte Carlo algorithm used to evaluate the model, each chain going through 1,000 warm up iterations and then another 1,000 to fit the model.

perf_mod()is based on the glmer() function from the rstanarm package. We can assess the rstanarm model object which is returned as part of perf_mod model object.

summary(roc_model$stan)

## 
## Model Info:
##  function:     stan_glmer
##  family:       gaussian [identity]
##  formula:      statistic ~ model + (1 | id)
##  algorithm:    sampling
##  sample:       4000 (posterior sample size)
##  priors:       see help('prior_summary')
##  observations: 30
##  groups:       id (10)
## 
## Estimates:
##                                     mean   sd   10%   50%   90%
## (Intercept)                       0.8    0.0  0.8   0.8   0.8  
## modelknn                          0.0    0.0  0.0   0.0   0.0  
## modelnnet                         0.1    0.0  0.0   0.1   0.1  
## b[(Intercept) id:Fold01]          0.0    0.0  0.0   0.0   0.0  
## b[(Intercept) id:Fold02]          0.0    0.0  0.0   0.0   0.0  
## b[(Intercept) id:Fold03]          0.0    0.0  0.0   0.0   0.0  
## b[(Intercept) id:Fold04]          0.0    0.0  0.0   0.0   0.0  
## b[(Intercept) id:Fold05]          0.0    0.0  0.0   0.0   0.0  
## b[(Intercept) id:Fold06]          0.0    0.0  0.0   0.0   0.0  
## b[(Intercept) id:Fold07]          0.0    0.0  0.0   0.0   0.0  
## b[(Intercept) id:Fold08]          0.0    0.0  0.0   0.0   0.0  
## b[(Intercept) id:Fold09]          0.0    0.0  0.0   0.0   0.0  
## b[(Intercept) id:Fold10]          0.0    0.0  0.0   0.0   0.0  
## sigma                             0.0    0.0  0.0   0.0   0.0  
## Sigma[id:(Intercept),(Intercept)] 0.0    0.0  0.0   0.0   0.0  
## 
## Fit Diagnostics:
##            mean   sd   10%   50%   90%
## mean_PPD 0.8    0.0  0.8   0.8   0.8  
## 
## The mean_ppd is the sample average posterior predictive distribution of the outcome variable (for details see help('summary.stanreg')).
## 
## MCMC diagnostics
##                                   mcse Rhat n_eff
## (Intercept)                       0.0  1.0  2691 
## modelknn                          0.0  1.0  2977 
## modelnnet                         0.0  1.0  3314 
## b[(Intercept) id:Fold01]          0.0  1.0  3389 
## b[(Intercept) id:Fold02]          0.0  1.0  1162 
## b[(Intercept) id:Fold03]          0.0  1.0  3683 
## b[(Intercept) id:Fold04]          0.0  1.0  2016 
## b[(Intercept) id:Fold05]          0.0  1.0  2888 
## b[(Intercept) id:Fold06]          0.0  1.0  3557 
## b[(Intercept) id:Fold07]          0.0  1.0  3332 
## b[(Intercept) id:Fold08]          0.0  1.0  1952 
## b[(Intercept) id:Fold09]          0.0  1.0  1929 
## b[(Intercept) id:Fold10]          0.0  1.0  3219 
## sigma                             0.0  1.0  1391 
## Sigma[id:(Intercept),(Intercept)] 0.0  1.0  1386 
## mean_PPD                          0.0  1.0  4180 
## log-posterior                     0.2  1.0   688 
## 
## For each parameter, mcse is Monte Carlo standard error, n_eff is a crude measure of effective sample size, and Rhat is the potential scale reduction factor on split chains (at convergence Rhat=1).

The default model constructed by perf_mod() specified by the R formula statistic ~ model + (1 | id) is a Bayesian, multi-level, varying intercept, linear regression model with an intercept, coefficients for the knn and nnet model effects, and an intercept for each of the cross-validation folds. This model might be written as:

Y_i = $\alpha$ + $\beta$X_i + b_[i]

in the one of the common notations used by Bayesians. (For example, see Gelman and Hill (2007).

rstanarm allows R users to build a wide range of Bayesian regression models using the stan engine without having to explicitly program in stan. That’s the good news. The bad news is that R’s formula interface takes some getting used to. A good source for learning the how to interpret formulas for the type of model we are considering here is the vignette for the lme4 package which implements Frequentist analog of this sort of model. (For an in depth discussion of the pros and cons of R formula interface see the Max Kuhn’s two posts on the subject: pros here and cons here .

You can examine the prior default prior distributions that were selected for this model as follows:

rstanarm::prior_summary(roc_model$stan)

## Priors for model 'roc_model$stan' 
## ------
## Intercept (after predictors centered)
##   Specified prior:
##     ~ normal(location = 0, scale = 10)
##   Adjusted prior:
##     ~ normal(location = 0, scale = 0.38)
## 
## Coefficients
##   Specified prior:
##     ~ normal(location = [0,0], scale = [2.5,2.5])
##   Adjusted prior:
##     ~ normal(location = [0,0], scale = [0.094,0.094])
## 
## Auxiliary (sigma)
##   Specified prior:
##     ~ exponential(rate = 1)
##   Adjusted prior:
##     ~ exponential(rate = 26)
## 
## Covariance
##  ~ decov(reg. = 1, conc. = 1, shape = 1, scale = 1)
## ------
## See help('prior_summary.stanreg') for more details

Now, that the model has been fit, we use the tidyposterior function tidy() to extract the posterior samples from the perf_mod() model object, examine the first few values and plot the posterior distributions for the three models being compared. (Note that you may also find the tidybayes package helpful in examining draws from the posterior distribution.)

roc_post <- tidy(roc_model)
glimpse(roc_post)

## Observations: 12,000
## Variables: 2
## $ model     <chr> "glm", "glm", "glm", "glm", "glm", "glm", "glm", "glm"…
## $ posterior <dbl> 0.7934, 0.7905, 0.7919, 0.7891, 0.7889, 0.7887, 0.7867…

Also, even though this is a relatively simple ANOVA type model, some model checking ought to be done to determine whether the model is good enough to be interpreted. This kind of checking can be done interactively with the shinystan application that can be launched with the command:

launch_shinystan(roc_model$stan)

The following screen capture from shinystan shows the diagnostics for the intercept for the seventh fold of the cross-validation. Note that the mixing (variability from high to low) in the top left graph which shows a trace of the Markov chain for this parameter looks quite good.

The vignette shows violin plots for each of the three models, but in order to make the comparison with the data plot above, I plot the distributions with histograms, kernel density, and rug plots.

roc_post2 <- as.data.frame(roc_post) # get object of class data.frame
ggplot(roc_post2, aes(x = posterior, col = model, fill = model)) + 
  geom_histogram(aes(y=..density..), alpha=0.5, position="identity", bins = 100)+
  geom_density(alpha=.2) + xlim(min = .74, max = .86) +
  geom_rug()

Notice that the distribution all look like pretty narrow, normal distributions. And although it sure looks like there is quite a bit of difference between the distributions of ROC values for the glm and nnet models, we can quantify the difference by setting up a contrast computing the posterior difference in RMSE for the two models as nnet - glm.

glm_v_nnet <- contrast_models(roc_model, "nnet", "glm")
head(glm_v_nnet)

##   difference model_1 model_2
## 1    0.04669    nnet     glm
## 2    0.04897    nnet     glm
## 3    0.05226    nnet     glm
## 4    0.05251    nnet     glm
## 5    0.05364    nnet     glm
## 6    0.05583    nnet     glm

Ideally, before beginning a modeling effort, one would have some idea about how different the models have to be in order to make any practical difference. Let’s suppose that there needs to be at least a 5% increase in ROC area between the two distributions for there to be a practical difference. We can compute this probability by setting the size parameter to the summary() function to 0.05.

summary(glm_v_nnet, size = 0.05)

## # A tibble: 1 x 9
##   contrast probability   mean  lower  upper  size pract_neg pract_equiv
##   <chr>          <dbl>  <dbl>  <dbl>  <dbl> <dbl>     <dbl>       <dbl>
## 1 nnet vs…           1 0.0511 0.0459 0.0563  0.05         0       0.351
## # … with 1 more variable: pract_pos <dbl>

The column labeled probability indicates that all of the density of the difference is positive. mean, lower and upper give the mean of the posterior difference distribution, and the lower and upper bounds plotted. pract_neg and prac_pos report the result of a calculation that uses the Highest Density Interval HDI, the narrowest interval containing some prespecified percentage of the probability density curve, to determine the Region of Practical Equivalence, ROPE. pract_neg indicates that none of the density is below the interval of meaningful difference and prac_pos indicates that 65% of the density is above the area of practical equivalence. The latter can be interpreted as saying that the probability that the two distributions are different for all practicable purposes is .65. Likewise, pract_equiv means that there is a 35% chance that the two distributions are practically equivalent.

ggplot(glm_v_nnet, size = .05)

The contrast_models() function is also flexible enough to perform multiple simultaneous contrasts. Here, we set up to contrast both the glm model against the nnet model and the knn model at the 5% level

models_contrast <- contrast_models(roc_model, list("knn","nnet"), list("glm", "glm"))
summary(models_contrast, size=.05)

## # A tibble: 2 x 9
##   contrast probability    mean   lower   upper  size pract_neg pract_equiv
##   <chr>          <dbl>   <dbl>   <dbl>   <dbl> <dbl>     <dbl>       <dbl>
## 1 knn vs …           0 -0.0377 -0.0430 -0.0325  0.05   0.00025       1.000
## 2 nnet vs…           1  0.0511  0.0459  0.0563  0.05   0             0.351
## # … with 1 more variable: pract_pos <dbl>

Note that first row of the table above and the following plot both indicate that there is no practical difference between the glm and knn models at the 5% level.

ggplot(models_contrast, size = .05)

Because the vignette also mentions accuracy, the fraction of correct predictions, we briefly repeat the above analysis using accuracy as the performance measure.

acc <- precise_example %>%
  select(id, contains("Accuracy")) %>%
  setNames(tolower(gsub("_Accuracy$", "", names(.)))) 
acc_model <- perf_mod(acc,seed = 2824)

The posterior distributions for accuracy are tightly clustered and indicate that the models yield different levels of performance for this measure.

acc_post <- as.data.frame(tidy(acc_model)) # get object of class data.frame
ggplot(roc_post2, aes(x = posterior, col = model, fill = model)) + 
  geom_histogram(aes(y=..density..), alpha=0.5, position="identity", bins = 50) +
  geom_density(alpha=.2) + xlim(min = .74, max = .86) +
  geom_rug()

And, the contrast_models() function that confirms the practical difference.

acc_models_contrast <- contrast_models(acc_model, list("knn","nnet"), list("glm", "glm"))
summary(acc_models_contrast, size=.05)

## # A tibble: 2 x 9
##   contrast probability    mean   lower   upper  size pract_neg pract_equiv
##   <chr>          <dbl>   <dbl>   <dbl>   <dbl> <dbl>     <dbl>       <dbl>
## 1 knn vs …           0 -0.239  -0.250  -0.229   0.05         1     0      
## 2 nnet vs…           1  0.0687  0.0583  0.0792  0.05         0     0.00175
## # … with 1 more variable: pract_pos <dbl>

ggplot(acc_models_contrast, size = .05)

Note that the nnet model comes out on top with respect to both ROC and accuracy, but there appears to be a practical differences in practical differences. A modeler who is primarily interested in accuracy as the performance metric would likely be more confident than a modeler who has selected ROC as the performance metric. This example should serve as a warning not to engage in performance measure hacking. Choose your performance measure before you compute anything.

For additional reading, look here for a short presentation by Max Kuhn on the key tidyposterior ideas, and see the the following papers for an in-depth look at the underlying theory: Benavoli et al. (2017) and Kruschke and Liddell (2017). For Bayesian analysis in general, and more on the ROPE concept see: Kruschke (2014). Doing Bayesian Data Analysis, Second Edition: A Tutorial with R, JAGS, and Stan (2 edition).

ROC Curves

Thu, 17 Jan 2019 00:00:00 +0000

I have been thinking about writing a short post on R resources for working with (ROC) curves, but first I thought it would be nice to review the basics. In contrast to the usual (usual for data scientists anyway) machine learning point of view, I’ll frame the topic closer to its historical origins as a portrait of practical decision theory.

ROC curves were invented during WWII to help radar operators decide whether the signal they were getting indicated the presence of an enemy aircraft or was just noise. (O’Hara et al. specifically refer to the Battle of Britain, but I haven’t been able to track that down.)

I am relying comes from James Egan’s classic text signal Detection Theory and ROC Analysis) for the basic setup of the problem. It goes something like this: suppose there is an observed quantity (maybe the amplitude of the radar blip), X, that could indicate either the presence of a meaningful signal (e.g. from a Messerschmitt) embedded in noise, or just noise alone (geese). When viewing X in some small interval of time, we would like to establish a threshold or cutoff value, c, such that if X > c we will we can be pretty sure we are observing a signal and not just noise. The situation is illustrated in the little animation below.

library(tidyverse)
library(gganimate)  #for animation
library(magick)     # to put animations sicde by side

We model the noise alone as random draws from a N(0,1) distribution, signal plus noise as draws from N(s_mean, S_sd), and we compute two conditional distributions. The probability of a “Hit” or P(X > c | a signal is present) and the probability of a “False Alarm”, P(X > c | noise only).

s_mean <- 2  # signal mean
s_sd <- 1.1   # signal standard deviation

x <- seq(-5,5,by=0.01) # range of signal
signal <- rnorm(100000,s_mean,s_sd)
noise <- rnorm(100000,0,1)

PX_n <- 1 - pnorm(x, mean = 0, sd = 1) # P(X > c | noise only) = False alarm rate
PX_sn <- 1 - pnorm(x, mean = s_mean, sd = s_sd) # P(X > c | signal plus noise) = Hit rate

We plot these two distributions in the left panel of the animation for different values of the cutoff threshold threshold.

threshold <- data.frame(val = seq(from = .5, to = s_mean, by = .2))

dist <- 
  data.frame(signal = signal, noise = noise) %>% 
  gather(data, value) %>% 
  ggplot(aes(x = value, fill = data)) +
  geom_density(trim = TRUE, alpha = .5) +
  ggtitle("Conditional Distributions") +
  xlab("observed signal")  + 
  scale_fill_manual(values = c("pink", "blue"))

p1 <- dist + geom_vline(data = threshold, xintercept = threshold$val, color = "red") +
            transition_manual(threshold$val)
p1 <- animate(p1)

And, we plot the ROC curve for our detection system in the right panel. Each point in this plot corresponds to one of the cutoff thresholds in the left panel.

df2 <- data.frame(x, PX_n, PX_sn)
roc <- ggplot(df2) +
  xlab("P(X | n)") + ylab("P(X | sn)") +
  geom_line(aes(PX_n, PX_sn)) +
  geom_abline(slope = 1) +
  ggtitle("ROC Curve") + 
  coord_equal()

q1 <- roc +
        geom_point(data = threshold, aes(1-pnorm(val),
                          1- pnorm(val, mean = s_mean, sd = s_sd)), 
                          color = "red") +
                          transition_manual(val)

q1 <- animate(q1)

(The slick trick of getting these two animation panels to line up in the same frame is due to a helper function from Thomas Pedersen and Patrick Touche that can be found here)

combine_gifs(p1,q1)

Notice that as the cutoff line moves further to the right, giving the decision maker a better chance of making a correct decision, the corresponding point moves down the ROC curve towards a lower Hit rate. This illustrates the fundamental tradefoff between hit rate and false alarm rate in the underlying decision problem. For any given problem, a decision algorithm or classifier will live on some ROC curve in false alarm / hit rate space. Improving the hit rate usually come at the cost of increasing the probability of more false alarms.

The simulation code also lets you vary s_mean, the mean of the signal, Setting this to a large value (maybe 5), will sufficiently separate the signal from the noise, and you will get the kind of perfect looking ROC curve you may be accustomed to seeing produced by your best classification models.

The usual practice in machine learning applications is to compute the area under the ROC curve, AUC. This has become the “gold standard” for evaluating classifiers. Given a choice between different classification algorithms, data scientists routinely select the classifier with the highest AUC. The intuition behind this is compelling: given that the ROC is always a monotone increasing, concave downward curve, the best possible curve will have an inflection point in the upper left hand corner and an AUC approaching one (All of the area in ROC space).

Unfortunately, the automatic calculation and model selection of the AUC discourages analysis of how the properties and weaknesses of ROC curves may pertain to the problem at hand. Keeping sight of the decision theory point of view may help to protect against the spell of mechanistic thinking encouraged by powerful algorithms. Although, automatically selecting a classifier based on the value of the AUC may make good sense most of the time, things can go wrong. For example, it is not uncommon for analysts to interpret AUC as a measure of the accuracy of the classifier. But, the AUC is not a measure of accuracy as a little thought about the decision problem would make clear. The irony here is that there was a time, not too long ago, when people thought it was necessary to argue that the AUC is a better measure than accuracy for evaluating machine learning algorithms. For example, have a look at the 1997 paper by Andrew Bradley where he concludes that “…AUC be used in preference to overall accuracy for ‘single number’ evaluation of machine learning algorithms”.

What does the AUC measure? For the binary classification problem of our simple signal processing example, a little calculus will show that the AUC is the probability that a randomly drawn interval with a signal present will produce a higher X value than a signal interval containing noise alone. See Hand (2009), and the very informative StackExchange discussion for the math.

Also note, that in the paper just cited, Hand examines some of the deficiencies of the AUC. His discussion provides an additional incentive for keeping the decision theory tradeoff in mind when working with ROC curves. Hand concludes:

…it [AUC] is fundamentally incoherent in terms of misclassification costs: the AUC uses different misclassification cost distributions for different classifiers. This means that using the AUC is equivalent to using different metrics to evaluate different classification rules.

and goes on to propose the H measure for ranking classifiers. (See the R package hmeasure) Following up on this will have to be an investigation for another day.

Our discussion in this post has taken us part way along just one path through the enormous literature on ROC curves which could not be totally explored in a hundred posts. I will just mention that not long after its inception, ROC analysis was used to establish a conceptual framework for problems relating to sensation and perception in the field of psychophysics (Pelli and Farell (1995)) and thereafter applied to decision problems in Medical Diagnostics, (Hajian-Tilaki (2013)), National Intelligence (McCelland (2011)) and just about any field that collects data to support decision making.

If you are interested in delving deeper into ROC curves, the references in papers mentioned above may help to guide further exploration.