MNIST ("Modified National Institute of Standards and Technology") is computer vision dataset released in 1999. It contains data of handwritten images and it is the "de facto" benchmark for classification algorithms. The goal is to correctly identify digits from a dataset of tens of thousands of handwritten images.
The data description can be found at Kaggle:
The data files train.csv and test.csv contain gray-scale images of hand-drawn digits, from zero through nine.
Each image is 28 pixels in height and 28 pixels in width, for a total of 784 pixels in total. Each pixel has a single pixel-value associated with it, indicating the lightness or darkness of that pixel, with higher numbers meaning darker. This pixel-value is an integer between 0 and 255, inclusive.
The training data set, (train.csv), has 785 columns. The first column, called "label", is the digit that was drawn by the user. The rest of the columns contain the pixel-values of the associated image.
Each pixel column in the training set has a name like pixelx, where x is an integer between 0 and 783, inclusive. To locate this pixel on the image, suppose that we have decomposed x as x = i * 28 + j, where i and j are integers between 0 and 27, inclusive. Then pixelx is located on row i and column j of a 28 x 28 matrix, (indexing by zero).
In [29]:
library(tidyverse)
library(purrrlyr)
library(forcats) # factors munging
library(ggthemes) # visualization
library(scales) # visualization
library(caret) # ML
library(Rtsne)
library(viridis)
library(fastknn)
theme_update(plot.title = element_text(hjust = 0.5))
In [2]:
train <- read_csv("data/train.csv")
test <- read_csv("data/test.csv")
In [3]:
head(train)
In [4]:
dim(train)
In [5]:
dim(test)
In [6]:
train <- train %>%
mutate(label = factor(label))
In [7]:
train <- train %>%
mutate(intensity =
select(., starts_with("pixel")) %>%
rowMeans()
) %>%
select(intensity, everything())
In [8]:
options(repr.plot.width=7, repr.plot.height=5)
ggplot(data=train, aes(x=label)) +
geom_bar(aes(y = (..count..)/sum(..count..))) +
ylab("percentage of train data") +
xlab("digit") +
ggtitle("Distribution of digits") +
scale_y_continuous(labels = percent, limits=c(0, 0.12)) +
theme_hc()
In [9]:
options(repr.plot.width=7, repr.plot.height=5)
ggplot(train, aes(x = intensity, y = ..density..)) +
geom_density(aes(fill = label), alpha = 0.3) +
ggtitle("Distribution of intensity per digit") +
theme_hc()
In [10]:
ggplot(train, aes(x = label, y = intensity)) +
geom_boxplot(aes(fill = label), alpha = 0.5) +
xlab("digit") +
theme_hc()
In [11]:
options(repr.plot.width=5, repr.plot.height=5)
flip <- function(matrix) {
apply(matrix, 2, rev)
}
plot_digit <- function (obs) {
m <- flip(matrix(rev(as.numeric(obs[-1])), 28, 28))
image(m, axes = FALSE, col = grey(seq(0, 1, length = 256)))
title(main = obs$label)
}
train[4, ] %>%
select(-intensity) %>%
plot_digit
In [12]:
digit_groups <- train %>%
group_by(label)
In [13]:
options(repr.plot.width=7, repr.plot.height=10)
par(mfrow=c(4,3), mar=c(1.5, 1.5, 1.5, 1.5))
r <- digit_groups %>%
summarise_all(funs(mean)) %>%
select(-intensity) %>%
by_row(plot_digit)
In [14]:
par(mfrow=c(4,3), mar=c(1.5, 1.5, 1.5, 1.5))
r <- digit_groups %>%
summarise_all(funs(median)) %>%
select(-intensity) %>%
by_row(plot_digit)
In [15]:
par(mfrow=c(4,3), mar=c(1.5, 1.5, 1.5, 1.5))
r <- digit_groups %>%
summarise_all(funs(sd)) %>%
select(-intensity) %>%
by_row(plot_digit)
In [16]:
anyNA(train)
t-SNE (t-Distributed Stochastic Neighbour) allows to map high-dimensional data to a 2D or 3D plane. It is most commonly used for visualization purposes. However, the original algorithm is computationally expensive $O(N^4)$ with the number of samples in our data.
We will use Barnes-Hut-SNE algorithm which is an improvement over the standard t-SNE and runs in O(N log N) time. The algorithm is implemented in the Rtsne package.
In [17]:
nrow(train)
In [18]:
train_sample <- sample_n(train, 5000)
In [19]:
tsne_data <- as.matrix(select(train_sample, -intensity, -label))
tsne_out <- Rtsne(tsne_data, check_duplicates = FALSE, pca = TRUE, dims = 2)
In [60]:
options(repr.plot.width=7, repr.plot.height=6)
plot_data <- tibble(
x = tsne_out$Y[,1],
y = tsne_out$Y[,2],
digit = train_sample$label
)
ggplot(plot_data) +
geom_point(aes(x=x, y=y, color=digit)) +
ggtitle("t-SNE clustering of MNIST digits") +
theme_hc()
In [21]:
train_index <- createDataPartition(train$label, p=0.8, list=FALSE)
cv_train <- train[train_index, ]
cv_validation <- train[-train_index, ]
In [22]:
train_data <- select(cv_train, -label, -intensity)
train_labels <- cv_train$label
validation_data <- select(cv_validation, -label, -intensity)
validation_labels <- cv_validation$label
In [32]:
knn_model <- fastknn(
as.matrix(train_data),
train_labels,
as.matrix(validation_data),
k=10,
method = "dist"
)
In [24]:
confusion_matrix <- caret::confusionMatrix(
table(predicted=knn_model$class, actual=validation_labels)
)
In [25]:
confusion_matrix
In [49]:
confusion_data <- as.tibble(confusion_matrix$table) %>%
mutate(rate = n/sum(n)) %>%
mutate(error_rate = ifelse(actual == predicted,
0, rate))
In [61]:
options(repr.plot.width=8, repr.plot.height=6)
ggplot(confusion_data) +
geom_tile(aes(x=actual, y=predicted, fill=n)) +
ggtitle("Absolute predicted vs actual values") +
scale_x_discrete(name="Actual") +
scale_y_discrete(name="Predicted") +
scale_color_viridis() +
scale_fill_viridis(option="viridis") +
theme_hc()
In [83]:
max_scale = max(confusion_data$rate)
mid_scale = max_scale / 2
ggplot(confusion_data) +
geom_tile(aes(x=actual, y=predicted, fill=rate)) +
ggtitle("Weighted predicted vs actual values") +
scale_x_discrete(name="Actual") +
scale_y_discrete(name="Predicted") +
scale_color_viridis() +
scale_fill_viridis(
option="viridis",
breaks=c(0, mid_scale, max_scale),
labels=c(0, round(mid_scale, 5), round(max_scale, 5))
) + theme_hc()
In [82]:
max_scale = max(confusion_data$error_rate)
mid_scale = max_scale / 2
ggplot(confusion_data) +
geom_tile(aes(x=actual, y=predicted, fill=error_rate)) +
ggtitle("Error rates") +
scale_x_discrete(name="Actual") +
scale_y_discrete(name="Predicted") +
scale_fill_viridis(
option="viridis",
breaks=c(0, mid_scale, max_scale),
labels=c(0, round(mid_scale, 5), round(max_scale, 5))
) + theme_hc()
In [27]:
train_data <- select(train, -label, -intensity)
train_labels <- train$label
knn_model <- fastknn(
as.matrix(train_data),
train_labels,
as.matrix(test),
k=10,
method = "dist"
)
In [28]:
predictions <- tibble(
ImageId=1:length(knn_model$class),
Label=knn_model$class
)
write_csv(predictions, "results/knn.csv")