We will now proceed and apply Principal Component Analysis on the data, to further study it.
We start by computing its distance between each feature. We can clearly see the three species with one species very different from the other two.
x <- iris[,1:4] %>% as.matrix()
d <- dist(x)
options(repr.plot.width=7, repr.plot.height=7)
image(as.matrix(d), col = rev(RColorBrewer::brewer.pal(9, "RdBu")))
Investigating the correlations we notice that our predictors have four dimensions, but three are very correlated.
cor(x)
| Sepal.Length | Sepal.Width | Petal.Length | Petal.Width | |
|---|---|---|---|---|
| Sepal.Length | 1.0000000 | -0.1175698 | 0.8717538 | 0.8179411 |
| Sepal.Width | -0.1175698 | 1.0000000 | -0.4284401 | -0.3661259 |
| Petal.Length | 0.8717538 | -0.4284401 | 1.0000000 | 0.9628654 |
| Petal.Width | 0.8179411 | -0.3661259 | 0.9628654 | 1.0000000 |
By applying PCA, we are able to approximate this distance with just two dimensions, compressing the highly correlated dimensions. Using the summary function we can see the variability explained by each Principal Component.
pca <- prcomp(x)
summary(pca)
Importance of components:
PC1 PC2 PC3 PC4
Standard deviation 2.0563 0.49262 0.2797 0.15439
Proportion of Variance 0.9246 0.05307 0.0171 0.00521
Cumulative Proportion 0.9246 0.97769 0.9948 1.00000
The first two dimensions account for 97% of the variability. Thus we should be able to approximate the distance very well with two dimensions. We can visualize the results of the PCA and how the first two principal components are responsible for most of variance between species.
We compare the original data to the principal components, showing their variance by colors.
my_image <- function(x, zlim = range(x), title, ...){
colors = rev(RColorBrewer::brewer.pal(9, "RdBu"))
cols <- 1:ncol(x)
rows <- 1:nrow(x)
image(cols, rows, t(x[rev(rows),,drop=FALSE]), xaxt = "n", yaxt = "n",
xlab="", ylab="", col = colors, zlim = zlim, ...)
abline(h=rows + 0.5, v = cols + 0.5)
axis(side = 1, cols, colnames(x), las = 2)
title(title)
}
options(repr.plot.width=10, repr.plot.height=8)
layout(t(1:2))
my_image(x, title = "Iris Dataset")
my_image(pca$x, title = "Weights")
The first component is able to gather important informations of Sepal Length, Petal Length and Petal Width and the second component incorporates informations of Sepal Width.
PC1 drives most of the variability and is capable of separating the first third of samples (most blue), which is setosa. The second column, PC2, helps to separate the second and third thirds, versicolor and virginica.
We can see this better by plotting the first two PCs with color representing each species.
options(repr.plot.width=10, repr.plot.height=6)
data.frame(pca$x[,1:2], Species=iris$Species) %>%
ggplot(aes(PC1,PC2, fill = Species))+
geom_point(cex=3, pch=21)
Since the PCA applies orthogonal transformation, the distance over the data is preserved, as shown below.
options(repr.plot.width=7, repr.plot.height=7)
d_approx <- dist(pca$x[,1:2])
plot(dist(x), d_approx)
abline(a = 0, b = 1, col = "red", lwd = 3)
By applying PCA, we were able to reduce the number of dimensions and visualize the four-dimensional data with only two dimensions. We will now apply k-nearest neighbors (knn) technique to the first two principal components.
We apply knn to the first two principal components, representing the data.
We separate the data in training and test sets and apply PCA only to the training set.
x <- train[,1:4] %>% as.matrix()
pca <- prcomp(x)
We train the model based on the first two principal components. Here we will use the standard value for the parameter k.
x_train <- pca$x[,1:2]
y <- train$Species
fit_pca <- knn3(x_train, y)
It is necessary to apply the same transformation on the test set.
col_means <- colMeans(test[,-5])
x_test <- as.matrix(sweep(test[,-5], 2, col_means)) %*% pca$rotation
x_test <- x_test[,1:2]
y_hat <- predict(fit_pca, x_test, type = "class")
confusionMatrix(data = y_hat, reference = test$Species)
Confusion Matrix and Statistics
Reference
Prediction setosa versicolor virginica
setosa 20 0 0
versicolor 0 19 0
virginica 0 1 20
Overall Statistics
Accuracy : 0.9833
95% CI : (0.9106, 0.9996)
No Information Rate : 0.3333
P-Value [Acc > NIR] : < 2.2e-16
Kappa : 0.975
Mcnemar's Test P-Value : NA
Statistics by Class:
Class: setosa Class: versicolor Class: virginica
Sensitivity 1.0000 0.9500 1.0000
Specificity 1.0000 1.0000 0.9750
Pos Pred Value 1.0000 1.0000 0.9524
Neg Pred Value 1.0000 0.9756 1.0000
Prevalence 0.3333 0.3333 0.3333
Detection Rate 0.3333 0.3167 0.3333
Detection Prevalence 0.3333 0.3167 0.3500
Balanced Accuracy 1.0000 0.9750 0.9875
pca_acc <- confusionMatrix(data = y_hat, reference = test$Species)$overall["Accuracy"]
acc_results <- bind_rows(acc_results,
tibble(method="Knn of PCA", acc = pca_acc))
acc_results %>% knitr::kable()
|method | acc| |:----------------------------|---------:| |2 classes: LDA: 1 feature | 0.9000000| |2 classes: LDA: 2 features | 0.9000000| |2 classes: QDA: all features | 0.9750000| |3 classes: LDA | 0.9666667| |3 classes: QDA | 0.9666667| |Knn of PCA | 0.9833333|
With just 2 dimensions we achieved a very good accuracy by applying Knn.
This dataset was small, presented few number of predictors and observations, however the purpose here was for illustration. PCA is a powerfull tool and better used to reduce big dimensions and to analyze big data sets.