web-dev-qa-db-ja.com

k-meansクラスタリング後の新しいデータにクラスターを割り当てる簡単なアプローチ

データフレームdf1でk-meansクラスタリングを実行しており、新しいデータフレームdf2（同じ変数名）の各観測値に最も近いクラスター中心を計算する簡単な方法を探しています。 df1をトレーニングセット、df2をテストセットと考えてください。トレーニングセットでクラスター化し、各テストポイントを正しいクラスターに割り当てます。

apply関数といくつかの単純なユーザー定義関数を使用してこれを行う方法を知っています（トピックに関する以前の投稿は、通常、同様のことを提案しています）。

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)

ただし、学生がapply関数に不慣れなコース向けにこのクラスタリングの例を準備しているので、組み込み関数を使用してクラスターをdf2に割り当てることができれば、非常に好まれます。最も近いクラスターを見つけるための便利な組み込み関数はありますか？

rk-means
36
josliber

flexclust パッケージを使用できます。これには、k-means用のpredictメソッドが実装されています。

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")

flexclust plot

stats::kmeansやcluster::pamなどのクラスター関数からの結果をクラスkccaのオブジェクトに、またはその逆に変換する変換メソッドもあります。

as.kcca(cl, data=x)
# kcca object of family ‘kmeans’ 
#
# call:
# as.kcca(object = cl, data = x)
#
# cluster sizes:
#
#  1  2 
#  50 50
37
rcs

質問のアプローチとflexclustアプローチの両方について気づいたのは、それらがかなり遅いことです（ここでは、それぞれ2つの機能を備えた100万の観測を含むトレーニングとテストのセットについてベンチマークを行っています）。

元のモデルのフィッティングはかなり高速です：

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

私が質問で投稿した解決策は、テストセットのクラスター割り当ての計算が遅いです。テストセットポイントごとにclosest.clusterを個別に呼び出すためです。

system.time(pred.test <- apply(df2, 1, closest.cluster))
#    user  system elapsed 
#  42.064   0.251  42.586

一方、flexclustパッケージは、適合モデルをas.kccaで変換するか、新しいモデルをkccaで適合させるかに関係なく、多くのオーバーヘッドを追加するようです（ただし、最後の予測ははるかに高速です）

# 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

ここには別の賢明なアプローチがあるようです：k-dツリーのような高速k最近傍解を使用して、クラスター重心のセット内の各テストセット観測値の最近傍を見つけます。これはコンパクトに記述でき、比較的高速です。

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
15
josliber

ClusterR::KMeans_rcpp()関数を使用し、RcppArmadilloを使用できます。これにより、複数の初期化が可能になります（Openmpが使用可能な場合は並列化できます）。 optimize_init、quantile_init、randomおよびkmeans ++の初期化に加えて、CENTROIDSパラメーターを使用して重心を指定できます。アルゴリズムの実行時間と収束は、num_init、max_iters、および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)

enter image description here

2
Rafael Díaz