Problem: Lynden, Inc. a freight and logistics company owns a number of operating companies that ship via different modes of transport (air, truck, sea), and also specialize in shipping different types of commodities. How do I, as a customer know which Lynden company to call if I want to have something shipped? Below is a table of a few of our operating companies, with the company abbreviation (referenced later in this post), and how each company moves their freight.
| Company | Abbreviation | Mode of Transport |
|---|---|---|
| Alaska Marine Lines | AML | Sea |
| Lynden International | LINT | Air |
| Lynden Air Cargo | LAC | Air |
| Alaska West Express | AWE | Truck |
| Lynden Transport | LTIA | Truck |
| LTI, Inc. | LTII | Truck |
Currently there is a single number that a customer can call to get directed to the appropriate company that can move the freight. However this has proved to be a somewhat error prone process as there are a number of exception cases that can dictate which company can move the freight, such as is it oversized, or hazmat.
I wanted to see if we could gain any insight to this problem by looking at our historical shipments and possibly use various attributes about a shipment itselfto make an accurate recommendation as to which company to call. This boils down to a classification problem, ie how do we classify the company that ships the freight based on attributes that the customer tells us about their freight? Classification problems are one of the areas where machine learning has been applied extensively over the last few years.
There are dozens and dozens of attributes related to our shipments which could be used to feed into a machine learning model, but to keep things simple for this experiment I chose to use the freight description field. If the customer could give a description of their freight to a predictive model, could it properly suggest which company should ship it? The exercise would be to see if there was any predictive power at all with the description field, and if so, additional fields could potentially be added to refine the model further.
I obtained data from 50,000 historical shipments which included a short description of the goods being shipped and the abbreviation of the company that shipped the goods. I imported this data into R Studio for analysis.
There are a number of different machine learning models to choose from for classification problems. I selected the Naive Bayes model which is the same model that most spam filters use to classify email as spam based on the words within the email.
Out of curiosity I decided to use R to create a word cloud of common terms for a few of the companies just to see what pops out. The first cloud below is common words found in the descriptions of freight shipped with Alaska Marine Lines (AML).
The word cloud below was generated for freight shipped with Lynden International (LINT).
Finally, the last cloud is for freight that was shipped with LTI, Inc. (LTII), with an interesting combination of commodities which were returned. Hopefully the same tankers that are being used to ship sulfur are also not being used to ship wine!
Next it was time to train the model. I took 40,000 of the records and submitted it to a Naive Bayes model that I had configured in R. This would give the model a chance to look at the terms in each shipment, and associate it with the company that shipped the freight, hopefully finding commonalities that it could use when it needed to predict the company based on the description.
I then took the remaining 10,000 records and had the model guess which company shipped the goods based solely on the freight description. I then tabulated the accuracy of the model’s 10,000 predictions.
The table below illustrates what percent of the time the model selected the correct company given the description of the freight.
- AML: 95%
- AWE: 94%
- LTII: 94%
- LTIA: 83%
- LAC: 52%
I was quite surprised by the accuracy of the results given that just one attribute of the shipment data was being used by the model. LAC is the big outlier, and freight that should have been classified as LAC was most commonly misclassified as LINT. Likewise freight that should have been classified as LTIA was most commonly misclassified as AML.
The next step would be to take a look at some of the other attributes of the freight and see if we can further refine the model, by possibly using fields such as origin, destination, weight, etc.
If you are curious about the R code that I wrote to perform this experiment I have included it below.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| install.packages("tm") | |
| install.packages("e1071") | |
| install.packages("gmodels") | |
| install.package"" | |
| library(tm) | |
| library(e1071) | |
| library(gmodels) | |
| library(wordcloud) | |
| set.seed(123) | |
| shipment.data.all <- read.table( "ShipmentsDescOnly.csv", sep="|", header=TRUE, stringsAsFactors = FALSE) | |
| #Shuffle the shipments up so they aren't in any particular order. | |
| shipment.data.all <- shipment.data.all[sample(nrow(shipment.data.all)),] | |
| shipment.data.all$CompanyAbbreviation <- factor(shipment.data.all$CompanyAbbreviation) | |
| # Build a word cloud for each company | |
| aml <- subset(shipment.data.train, CompanyAbbreviation == "AML") | |
| lint <- subset(shipment.data.train, CompanyAbbreviation == "LINT") | |
| ltia <- subset(shipment.data.train, CompanyAbbreviation == "LTIA") | |
| awe <- subset(shipment.data.train, CompanyAbbreviation == "AWE") | |
| ltii <- subset(shipment.data.train, CompanyAbbreviation == "LTII") | |
| lac <- subset(shipment.data.train, CompanyAbbreviation == "LAC") | |
| wordcloud(aml$ShortDescription, max.words = 40, scale = c(3,0.5)) | |
| wordcloud(lint$ShortDescription, max.words = 40, scale = c(3,0.5)) | |
| wordcloud(ltia$ShortDescription, max.words = 40, scale = c(3,0.5)) | |
| wordcloud(awe$ShortDescription, max.words = 40, scale = c(3,0.5)) | |
| wordcloud(ltii$ShortDescription, max.words = 40, scale = c(3,0.5)) | |
| wordcloud(lac$ShortDescription, max.words = 40, scale = c(3,0.5)) | |
| #Cleanup the description fields remove numbers, punctuation etc. | |
| corpus <- Corpus(VectorSource(shipment.data.all$ShortDescription)) | |
| corpus.clean <- tm_map(corpus, content_transformer(tolower)) | |
| corpus.clean <- tm_map(corpus.clean, removeNumbers) | |
| corpus.clean <- tm_map(corpus.clean, removeWords, stopwords()) | |
| corpus.clean <- tm_map(corpus.clean, removePunctuation) | |
| corpus.clean <- tm_map(corpus.clean, stripWhitespace) | |
| document.term.matrix <- DocumentTermMatrix(corpus.clean) | |
| #Break the data set into a training set containing 80% of the data, and a test set with the remaining. | |
| training.set.size <- floor(0.80 * nrow(shipment.data.all)) | |
| training.index <- sample(seq_len(nrow(shipment.data.all)), size = training.set.size) | |
| shipment.data.train <- shipment.data.all[training.index, ] | |
| shipment.data.test <- shipment.data.all[-training.index, ] | |
| #Get the data in a format the model can understand. | |
| dtm.train <- document.term.matrix[training.index,] | |
| dtm.test <- document.term.matrix[-training.index,] | |
| corpus.train <- corpus.clean[training.index] | |
| corpus.test <- corpus.clean[-training.index] | |
| shipment.dict <- c(findFreqTerms(dtm.train,5)) | |
| convert_counts <- function(x) { | |
| x <- ifelse(x > 0, 1, 0) | |
| x <- factor(x, levels = c(0,1), labels = c("No", "Yes")) | |
| return(x) | |
| } | |
| shipments.train <- DocumentTermMatrix(corpus.train, list(dictionary=shipment.dict)) | |
| shipments.test <- DocumentTermMatrix(corpus.test, list(dictionary=shipment.dict)) | |
| shipments.train <- apply(shipments.train, MARGIN = 2, convert_counts) | |
| shipments.test <- apply(shipments.test, MARGIN = 2, convert_counts) | |
| #Train the model with the training data. | |
| model <- naiveBayes(shipments.train, shipment.data.train$CompanyAbbreviation) | |
| #See how well the model predicts based on the test data. | |
| prediction <- predict(model, shipments.test) | |
| #Print the results of the prediction | |
| CrossTable(prediction, shipment.data.test$CompanyAbbreviation, prop.chisq = FALSE, prop.t = FALSE, dnn = c('predicted', 'actual')) | |