見つかったクラスターの中心を取り、クラスターを新しいデータセットに割り当てるRの関数はありますか


14

多次元データセットには2つの部分がtrainありtestます。それらをおよびと呼びましょう。そして、列車のデータセットに基づいてモデルを構築し、テストデータセットで検証したいと思います。クラスターの数はわかっています。

Rにk-meansクラスタリングを適用しようとしましたが、クラスターの中心を含むオブジェクトが得られました。

kClust <- kmeans(train, centers=N, nstart=M)

見つかったクラスターの中心を取り、テストデータセットにクラスターを割り当てる関数がRにありますか?

私が試すことができる他の方法/アルゴリズムは何ですか?


サイト@ user2598356へようこそ。これをより一般的な(非R固有の)方法で組み立てることができますか?R関数のみを要求している場合、この質問はCVのトピック外です(ヘルプページを参照)。さらに、再現可能な例がないため、Stack Overflowでもトピック外となります。これを編集して、ここまたはSOでトピックに合わせて編集できる場合は、編集してください。それ以外の場合、このQは閉じられます。
GUNG -復活モニカ

この質問は、R関数を見つけることに関するものであるため、トピック外のようです。
GUNG -復活モニカ

1
しかし、最後の質問についてはどうでしょうか:「私が試すことができる他の方法/アルゴリズムは何ですか?」。実際に私が得た答えは、CVのトピックであるメソッドの実装に関するものですか、それとも間違っていますか?
user2598356

1
@gungあなたは正しいかもしれません。その場合、私はuser259 ...を招待して、移行のためにこの質問にフラグを立てます。しかし、他の方法やアルゴリズムに関する質問の最後の部分は、私たちのコミュニティが有用なヘルプやアドバイスを提供できる良い立場にあることを示唆しています。
whuber

ありがとう!この関数は正常に機能しますが、5万行を超える場合は時間がかかりすぎます。軽くするためのアイデアはありますか?

回答:


11

次の関数を使用して、新しいデータセットのクラスター割り当てを計算できます。

clusters <- function(x, centers) {
  # compute squared euclidean distance from each sample to each cluster center
  tmp <- sapply(seq_len(nrow(x)),
                function(i) apply(centers, 1,
                                  function(v) sum((x[i, ]-v)^2)))
  max.col(-t(tmp))  # find index of min distance
}

# create a simple data set with two clusters
set.seed(1)
x <- rbind(matrix(rnorm(100, sd = 0.3), ncol = 2),
           matrix(rnorm(100, mean = 1, sd = 0.3), ncol = 2))
colnames(x) <- c("x", "y")
x_new <- rbind(matrix(rnorm(10, sd = 0.3), ncol = 2),
               matrix(rnorm(10, mean = 1, sd = 0.3), ncol = 2))
colnames(x_new) <- c("x", "y")

cl <- kmeans(x, centers=2)

all.equal(cl[["cluster"]], clusters(x, cl[["centers"]]))
# [1] TRUE
clusters(x_new, cl[["centers"]])
# [1] 2 2 2 2 2 1 1 1 1 1

plot(x, col=cl$cluster, pch=3)
points(x_new, col= clusters(x_new, cl[["centers"]]), pch=19)
points(cl[["centers"]], pch=4, cex=2, col="blue")

クラスターの割り当て

または、k-meansの実装メソッドを持つflexclustパッケージを使用することもできます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")

フレックスクルートプロット

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

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

どうもありがとうございました!ただ一つの質問:kccaメソッドはどのように開始数を処理しますか(開始点に関して分析を最適化しますか)?
user2598356

開始回数とはどういう意味ですか?このstepFlexclust関数は、異なる数のクラスターに対してクラスター化アルゴリズムを繰り返し実行し、それぞれのクラスター距離内の最小解を返します。
rcs

1

step1:ベクトルと行列の各行の間の距離を計算する関数

calc_vec2mat_dist = function(x, ref_mat) {
    # compute row-wise vec2vec distance 
    apply(ref_mat, 1, function(r) sum((r - x)^2))
}

ステップ2:vec2matコンピューターをinput_matrixのすべての行に適用する関数

calc_mat2mat_dist = function(input_mat, ref_mat) {

    dist_mat = apply(input_mat, 1, function(r) calc_vec2mat_dist(r, ref_mat))

    # transpose to have each row for each input datapoint
    # each column for each centroids
    cbind(t(dist_mat), max.col(-t(dist_mat)))
}

ステップ3。mat2mat関数を適用する

calc_mat2mat_dist(my_input_mat, kmeans_model$centers)

ステップ4。オプションでplyr :: ddplyとdoMCを使用して、大きなデータセットのmat2matを並列化します

library(doMC)
library(plyr)

pred_cluster_para = function(input_df, center_mat, cl_feat, id_cols, use_ncore = 8) {
    # assign cluster lables for each individual (row) in the input_df 
    # input: input_df   - dataframe with all features used in clustering, plus some id/indicator columns
    # input: center_mat - matrix of centroid, K rows by M features
    # input: cl_feat    - list of features (col names)
    # input: id_cols    - list of index cols (e.g. id) to include in output 
    # output: output_df - dataframe with same number of rows as input, 
    #         K columns of distances to each clusters
    #         1 column of cluster_labels
    #         x column of indices in idx_cols

    n_cluster = nrow(center_mat)
    n_feat = ncol(center_mat)
    n_input = nrow(input_df)

    if(!(typeof(center_mat) %in% c('double','interger') & is.matrix(center_mat))){
        stop('The argument "center_mat" must be numeric matrix')
    } else if(length(cl_feat) != n_feat) {
        stop(sprintf('cl_feat size: %d , center_mat n_col: %d, they have to match!',length(cl_feat), n_feat))
    } else {
        # register MultiCore backend through doMC and foreach package
        doMC::registerDoMC(cores = use_ncore)

        # create job_key for mapping/spliting the input data
        input_df[,'job_idx'] = sample(1:use_ncore, n_input, replace = TRUE)

        # create row_key for tracing the original row order which will be shuffled by mapreduce
        input_df[,'row_idx'] = seq(n_input)

        # use ddply (df input, df output) to split-process-combine
        output_df = ddply(
            input_df[, c('job_idx','row_idx',cl_feat,id_cols)], # input big data 
            'job_idx',                       # map/split by job_idx
            function(chunk) {                # work on each chunk
                dist = data.frame(calc_mat2mat_dist(chunk[,cl_feat], center_mat))
                names(dist) = c(paste0('dist2c_', seq(n_cluster)), 'pred_cluster')
                dist[,id_cols] = chunk[,id_cols]
                dist[,'row_idx'] = chunk[,'row_idx']
                dist                        # product of mapper
                        }, .parallel = TRUE) # end of ddply
        # sort back to original row order

        output_df = output_df[order(output_df$row_idx),]
        output_df[c('job_idx')] = NULL
        return(output_df)
    }

}
弊社のサイトを使用することにより、あなたは弊社のクッキーポリシーおよびプライバシーポリシーを読み、理解したものとみなされます。
Licensed under cc by-sa 3.0 with attribution required.