Approche simple pour attribuer des clusters aux nouvelles données après le clustering k-means
J'exécute le clustering k-means sur une trame de données df1, et je cherche une approche simple pour calculer le centre de cluster le plus proche pour chaque observation dans une nouvelle trame de données df2 (avec les mêmes noms de variables). Considérez df1 comme l'ensemble de formation et df2 sur l'ensemble de test; Je souhaite regrouper sur l'ensemble de formation et attribuer chaque point de test au cluster correct.
Je sais comment faire cela avec la fonction apply et quelques fonctions simples définies par l'utilisateur (les articles précédents sur le sujet ont généralement proposé quelque chose de similaire):
df1 <- data.frame(x=runif(100), y=runif(100))
df2 <- data.frame(x=runif(100), y=runif(100))
km <- kmeans(df1, centers=3)
closest.cluster <- function(x) {
cluster.dist <- apply(km$centers, 1, function(y) sqrt(sum((x-y)^2)))
return(which.min(cluster.dist)[1])
}
clusters2 <- apply(df2, 1, closest.cluster)
Cependant, je prépare cet exemple de clustering pour un cours dans lequel les étudiants ne seront pas familiers avec la fonction apply, donc je préférerais de beaucoup que je puisse assigner les clusters à df2 avec une fonction intégrée. Existe-t-il des fonctions intégrées pratiques pour trouver le cluster le plus proche?
Vous pouvez utiliser le package flexclust , qui a une méthode predict implémentée pour k-means:
library("flexclust")
data("Nclus")
set.seed(1)
dat <- as.data.frame(Nclus)
ind <- sample(nrow(dat), 50)
dat[["train"]] <- TRUE
dat[["train"]][ind] <- FALSE
cl1 = kcca(dat[dat[["train"]]==TRUE, 1:2], k=4, kccaFamily("kmeans"))
cl1
#
# call:
# kcca(x = dat[dat[["train"]] == TRUE, 1:2], k = 4)
#
# cluster sizes:
#
# 1 2 3 4
#130 181 98 91
pred_train <- predict(cl1)
pred_test <- predict(cl1, newdata=dat[dat[["train"]]==FALSE, 1:2])
image(cl1)
points(dat[dat[["train"]]==TRUE, 1:2], col=pred_train, pch=19, cex=0.3)
points(dat[dat[["train"]]==FALSE, 1:2], col=pred_test, pch=22, bg="orange")
Il existe également des méthodes de conversion pour convertir les résultats des fonctions de cluster comme stats::kmeans ou cluster::pam aux objets de classe kcca et vice versa:
as.kcca(cl, data=x)
# kcca object of family ‘kmeans’
#
# call:
# as.kcca(object = cl, data = x)
#
# cluster sizes:
#
# 1 2
# 50 50
Quelque chose que j'ai remarqué à la fois dans l'approche de la question et les approches flexclust est qu'elles sont plutôt lentes (comparées ici pour un ensemble de formation et de test avec 1 million d'observations avec 2 fonctionnalités chacune).
Le montage du modèle d'origine est relativement rapide:
set.seed(144)
df1 <- data.frame(x=runif(1e6), y=runif(1e6))
df2 <- data.frame(x=runif(1e6), y=runif(1e6))
system.time(km <- kmeans(df1, centers=3))
# user system elapsed
# 1.204 0.077 1.295
La solution que j'ai publiée dans la question est lente à calculer les affectations de cluster de test, car elle appelle séparément closest.cluster pour chaque point de consigne de test:
system.time(pred.test <- apply(df2, 1, closest.cluster))
# user system elapsed
# 42.064 0.251 42.586
Pendant ce temps, le package flexclust semble ajouter beaucoup de frais généraux, que nous convertissions ou non le modèle équipé avec as.kcca ou en adapter un nouveau nous-mêmes avec kcca (bien que la prédiction à la fin soit beaucoup plus rapide)
# APPROACH #1: Convert from the kmeans() output
system.time(km.flexclust <- as.kcca(km, data=df1))
# user system elapsed
# 87.562 1.216 89.495
system.time(pred.flexclust <- predict(km.flexclust, newdata=df2))
# user system elapsed
# 0.182 0.065 0.250
# Approach #2: Fit the k-means clustering model in the flexclust package
system.time(km.flexclust2 <- kcca(df1, k=3, kccaFamily("kmeans")))
# user system elapsed
# 125.193 7.182 133.519
system.time(pred.flexclust2 <- predict(km.flexclust2, newdata=df2))
# user system elapsed
# 0.198 0.084 0.302
Il semble qu'il y ait une autre approche judicieuse ici: utiliser une solution de k voisins les plus rapides comme un arbre k-d pour trouver le voisin le plus proche de chaque observation de l'ensemble de tests dans l'ensemble des centroïdes de cluster. Cela peut être écrit de manière compacte et est relativement rapide:
library(FNN)
system.time(pred.knn <- get.knnx(km$center, df2, 1)$nn.index[,1])
# user system elapsed
# 0.315 0.013 0.345
all(pred.test == pred.knn)
# [1] TRUE
Vous pouvez utiliser la fonction ClusterR::KMeans_rcpp(), utilisez RcppArmadillo. Il permet plusieurs initialisations (qui peuvent être parallélisées si Openmp est disponible). Outre les initialisations optimal_init, quantile_init, random et kmeans ++, on peut spécifier les centroïdes en utilisant le paramètre CENTROIDS. Le temps d'exécution et la convergence de l'algorithme peuvent être ajustés à l'aide des paramètres num_init, max_iters et tol.
library(scorecard)
library(ClusterR)
library(dplyr)
library(ggplot2)
## Generate data
set.seed(2019)
x = c(rnorm(200000, 0,1), rnorm(150000, 5,1), rnorm(150000,-5,1))
y = c(rnorm(200000,-1,1), rnorm(150000, 6,1), rnorm(150000, 6,1))
df <- split_df(data.frame(x,y), ratio = 0.5, seed = 123)
system.time(
kmrcpp <- KMeans_rcpp(df$train, clusters = 3, num_init = 4, max_iters = 100, initializer = 'kmeans++'))
# user system elapsed
# 0.64 0.05 0.82
system.time(pr <- predict_KMeans(df$test, kmrcpp$centroids))
# user system elapsed
# 0.01 0.00 0.02
p1 <- df$train %>% mutate(cluster = as.factor(kmrcpp$clusters)) %>%
ggplot(., aes(x,y,color = cluster)) + geom_point() +
ggtitle("train data")
p2 <- df$test %>% mutate(cluster = as.factor(pr)) %>%
ggplot(., aes(x,y,color = cluster)) + geom_point() +
ggtitle("test data")
gridExtra::grid.arrange(p1,p2,ncol = 2)
