Projection Methods
The classifier we used in this vignette is k-nearest neighborhood,
knn (Altman 1992).
knn_pred <- function(trainX, trainY, testX, testY, k = c(5, 10, 20)) {
len_test <- length(testY)
vapply(k,
function(num) {
yhat <- class::knn(trainX, testX, trainY, k = num)
sum(yhat == testY)/len_test
}, numeric(1L))
}
low_dim_knn_pred <- function(dims = 2:5, fun,
trainX, trainY, testX, testY,
k = c(5, 10, 20), setNames = TRUE) {
tab <- lapply(dims,
function(d) {
knn_pred(
fun(trainX, d), trainY,
fun(testX, d), testY
)
}) %>%
as.data.frame() %>%
as_tibble()
if(setNames) {
tab <- tab %>%
setNames(nm = paste0("d = ", dims))
}
rownames(tab) <- paste0("k = ", k)
tab
}Method I: p choose k
The most basic projection is that to choose \(d\) dimensional subspace from the \(p\) dimensional space. Since we have 8 dimensions, suppose \(d = 2\), there are \({8 \choose 2} = 28\) combinations. To simplify the process, with each pair, we will only extract the highest prediction accuracy one.
# the number of k
dims <- 2:5
var_names <- colnames(scalingTrainX)
low_dim_names <- c()
K <- ncol(trainX)
pChooseD <- lapply(dims,
function(d) {
com <- combn(K, d)
pred <- apply(com, 2,
function(pair) {
knn_pred(trainX[, pair], trainY,
testX[, pair], testY)
})
mean_pred <- apply(pred, 2, mean)
id <- which.max(mean_pred)
low_dim_names <<- c(low_dim_names,
paste(var_names[com[, id]],
collapse = ":"))
pred[, id]
}) %>%
as.data.frame() %>%
as_tibble() %>%
setNames(nm = paste0("d = ", dims))
rownames(pChooseD) <- paste0("k = ", c(5, 10, 20))The best pair’s name is
names(low_dim_names) <- paste0("d = ", dims)
low_dim_names
#> d = 2
#> "linoleic:eicosenoic"
#> d = 3
#> "linoleic:arachidic:eicosenoic"
#> d = 4
#> "linoleic:linolenic:arachidic:eicosenoic"
#> d = 5
#> "stearic:linoleic:linolenic:arachidic:eicosenoic"The prediction accuracy is
| d = 2 | d = 3 | d = 4 | d = 5 | |
|---|---|---|---|---|
| 1 | 0.974 | 0.983 | 0.991 | 0.991 |
| 2 | 0.930 | 0.957 | 0.974 | 0.974 |
| 3 | 0.852 | 0.922 | 0.913 | 0.939 |
Method II: PCA
PCA is defined as an orthogonal linear transformation that transforms the data to a new coordinate system such that the greatest variance by some scalar projection of the data comes to lie on the first coordinate (called the first principal component, determined by the largest eigen value), the second greatest variance (the second largest eigen value) on the second coordinate, and so on.
The eigen values of PCA projection on our data set is
trainXPCA <- princomp(scalingTrainX)
testXPCA <- princomp(scalingTestX)
round(trainXPCA$sdev, 2)
#> Comp.1 Comp.2 Comp.3 Comp.4 Comp.5 Comp.6 Comp.7 Comp.8
#> 0.41 0.28 0.20 0.17 0.13 0.10 0.06 0.01The first 5 eigen values are picked, as the sum of them is above 85%.
PCA <- low_dim_knn_pred(2:5,
fun = function(princomp, d)
{princomp$scores[, seq(d)]},
trainXPCA,
trainY,
testXPCA,
testY)
kable(PCA, row.names = TRUE,
digits = 3)| d = 2 | d = 3 | d = 4 | d = 5 | |
|---|---|---|---|---|
| 1 | 0.678 | 0.678 | 0.687 | 0.791 |
| 2 | 0.670 | 0.696 | 0.704 | 0.800 |
| 3 | 0.670 | 0.722 | 0.722 | 0.809 |
Method III: LLE
LLE (Local Linear Embedding) (Roweis and Saul 2000) begins by finding a set of the nearest neighbors of each point, then computes a set of weights for each point that best describes the point as a linear combination of its neighbors. Finally, it uses an eigenvector-based optimization technique to find the low-dimensional embedding of points.
library(RDRToolbox)
lle <- low_dim_knn_pred(2:5,
fun = function(data, d) {
LLE(data, dim = d, k = 5)
},
scalingTrainX, trainY,
scalingTestX, testY)
kable(lle, row.names = TRUE,
digits = 3)| d = 2 | d = 3 | d = 4 | d = 5 | |
|---|---|---|---|---|
| 1 | 0.852 | 0.304 | 0.652 | 0.652 |
| 2 | 0.852 | 0.165 | 0.730 | 0.722 |
| 3 | 0.852 | 0.165 | 0.730 | 0.661 |
Method IV: Random Tour
A simple call l_tour
Here, we assign different groups different colors. Besides, a convex
hull is constructed (l_layer_hull) so that the separation
of each group is much easier to tell. As we scroll the bar, one random
projection can split the groups well (no intersections among the
hulls).
The matrix of projection vectors is
| V1 | V2 | |
|---|---|---|
| palmitic | 0.01 | -0.22 |
| palmitoleic | 0.34 | -0.31 |
| stearic | 0.27 | -0.19 |
| oleic | 0.66 | 0.15 |
| linoleic | -0.38 | -0.52 |
| linolenic | 0.15 | 0.16 |
| arachidic | -0.20 | -0.37 |
| eicosenoic | 0.40 | -0.60 |
Then, we will create 3, 4 and 5 dimension tour paths (by modifying
tour_path). The “interesting” projection could be that, on
at least one axis, the three groups are split well. For example, in this
3D projection, at the axis V1, the group “gray” is distinguished from
the team; at the axis V2, the group “pink” could be told significantly
different from the rest; at the axis V3, the “blue” group is popped
up.
p3 <- l_tour(scalingTrainX,
tour_path = tourr::grand_tour(3),
color = trainY,
axesLayout = "parallel")
proj3D <- p3["projection"]
p4 <- l_tour(scalingTrainX,
tour_path = tourr::grand_tour(4),
color = trainY,
axesLayout = "parallel")
proj4D <- p4["projection"]
p5 <- l_tour(scalingTrainX,
tour_path = tourr::grand_tour(5),
color = trainY,
axesLayout = "parallel")
proj5D <- p5["projection"]
tour <- low_dim_knn_pred(list(proj2D, proj3D,
proj4D, proj5D),
fun = function(data, proj) {
data %*% as.matrix(proj)
},
scalingTrainX, trainY,
scalingTestX, testY,
setNames = FALSE)
colnames(tour) <- paste0("d = ", 2:5)
kable(tour, row.names = TRUE,
digits = 3)| d = 2 | d = 3 | d = 4 | d = 5 | |
|---|---|---|---|---|
| 1 | 0.974 | 0.974 | 0.983 | 0.991 |
| 2 | 0.983 | 1.000 | 0.991 | 0.991 |
| 3 | 0.983 | 1.000 | 0.991 | 0.983 |
However, sometimes, it is not possible to find a matrix of projection
vectors to separate each group perfectly. We need a tool to monitor the
classification performance of each projection. A powerful function
loon::l_bind_state() could be used. It takes three
arguments, target, event and a
callback function. If changes are detected for the given
event of this target, the callback function will be fired.
In our case, suppose it is very difficult to separate the 5D
tour, a callback function could be built as
As one scrolls the bar, the accuracy rates of each projection will be displayed in the console. The performance of each projection can be visualized very straightforward. In our scenario, the most “interesting” matrix of projection vectors should be corresponding to the highest accuracy rate.
================= R console =================
> …
> k = 5: accuracy rate 0.991
> k = 10: accuracy rate 0.991
> k = 20: accuracy rate 0.991
> k = 5: accuracy rate 1
> k = 10: accuracy rate 1
> k = 20: accuracy rate 1
> …
============================================
