R中的并行k均值答案

【问题标题】：parallel k-means in RR中的并行k均值
【发布时间】：2013-12-23 09:27:02
【问题描述】：

我正在尝试了解如何使用 R 并行化我的一些代码。因此，在下面的示例中，我想使用 k-means 对使用 2、3、4、5、6 中心的数据进行聚类，同时使用 20 次迭代. 这是代码：

library(parallel)
library(BLR)

data(wheat)

parallel.function <- function(i) {
    kmeans( X[1:100,100], centers=?? , nstart=i )
}

out <- mclapply( c(5, 5, 5, 5), FUN=parallel.function )

我们如何同时并行迭代和中心？如何跟踪输出，假设我想在所有迭代和中心中保留 k-means 的所有输出，只是为了了解如何？

【问题讨论】：

另一个选项是使用 biganalytics package 在第 4 页中，您可以找到 bigkmeans() 函数。

标签： r parallel-processing parallel-foreach

【解决方案1】：

起初对我来说这看起来很简单......然后我尝试了它。然而，在我午休期间进行了大量的猴子打字和手掌拍脸之后，我得出了这个结论：

library(parallel)
library(BLR)

data(wheat)

mc = mclapply(2:6, function(x,centers)kmeans(x, centers), x=X)

虽然我没有检查集群的合理性，但它看起来是正确的。

> summary(mc)
     Length Class  Mode
[1,] 9      kmeans list
[2,] 9      kmeans list
[3,] 9      kmeans list
[4,] 9      kmeans list
[5,] 9      kmeans list

经过反思，命令语法似乎是明智的——尽管许多其他失败的东西似乎也很合理......帮助文档中的示例可能不是那么好。

希望对你有帮助。

编辑这里要求的是在两个变量nstart 和centers

(pars = expand.grid(i=1:3, cent=2:4))

  i cent
1 1    2
2 2    2
3 3    2
4 1    3
5 2    3
6 3    3
7 1    4
8 2    4
9 3    4

L=list()
# zikes horrible
pars2=apply(pars,1,append, L)
mc = mclapply(pars2, function(x,pars)kmeans(x, centers=pars$cent,nstart=pars$i ), x=X)

> summary(mc)
      Length Class  Mode
 [1,] 9      kmeans list
 [2,] 9      kmeans list
 [3,] 9      kmeans list
 [4,] 9      kmeans list
 [5,] 9      kmeans list
 [6,] 9      kmeans list
 [7,] 9      kmeans list
 [8,] 9      kmeans list
 [9,] 9      means list

你觉得他们的苹果怎么样？

【讨论】：

Stephen Henderson，非常感谢您的回答——但至少对我来说，挑战是同时并行迭代和集群数量，即“kmeans(x,centers,nstart = ?) " 再次感谢您，感谢您的帮助
@hema 挑战接受！
注意，为了实现合理的加速，您应该根据您所拥有的和一些测试来控制您实际使用的核心数量......
Stephen Henderson ：非常有趣的答案，我今天从你那里学到了一些新东西。我会将您的想法应用到我的一个需要 2 个 for 循环“永远”的函数中。今天晚些时候我会接受你的回答。
Stephen Henderson：我们可以交换电子邮件吗，我正在尝试将您刚刚所做的应用到我的“现实生活功能”中——看起来我错过了一些东西。我可以和你分享我所做的然后我们可以一起解决这个问题 - 这是我的电子邮件：ielbasyoni@gmail，如果你没有时间我会理解的。再次感谢

【解决方案2】：

有一个名为 knor 的 CRAN 包源自 research paper，它使用 Elkan 剪枝算法的内存高效变体提高了性能。它比这些答案中的所有内容都快一个数量级。

install.packages("knor")
require(knor)
iris.mat <- as.matrix(iris[,1:4])
k <- length(unique(iris[, dim(iris)[2]])) # Number of unique classes
nthread <- 4
kms <- Kmeans(iris.mat, k, nthread=nthread)

【讨论】：

感谢您指出这一点。克诺尔速度很快！我强烈推荐给任何阅读这个帖子的人。现在用更少的时间炸毁更少的 HPC 节点。

【解决方案3】：

您可以使用并行在多个内核上从不同的随机起点尝试 K-Means。

下面的代码是一个例子。（K=K，K-means，N=随机起点数，C=你想使用的核数）

suppressMessages( library("Matrix") )
suppressMessages( library("irlba") )
suppressMessages( library("stats") )
suppressMessages( library("cluster") )
suppressMessages( library("fpc") )
suppressMessages( library("parallel") )

#Calculate KMeans results
calcKMeans <- function(matrix, K, N, C){
  #Parallel running from various of random starting points (Using C cores)
  results <- mclapply(rep(N %/% C, C), FUN=function(nstart) kmeans(matrix, K, iter.max=15, nstart=nstart), mc.cores=C);
  #Find the solution with smallest total within sum of square error
  tmp <- sapply(results, function(r){r[['tot.withinss']]})
  km <- results[[which.min(tmp)]]  
  #return cluster, centers, totss, withinss, tot.withinss, betweenss, size
  return(km)
}

runKMeans <- function(fin_uf, K, N, C, 
                      #fout_center, fout_label, fout_size, 
                      fin_record=NULL, fout_prediction=NULL){
  uf = read.table(fin_uf)
  km = calcKMeans(uf, K, N, C)
  rm(uf)
  #write.table(km$cluster, file=fout_label, row.names=FALSE, col.names=FALSE)
  #write.table(km$center, file=fout_center, row.names=FALSE, col.names=FALSE)
  #write.table(km$size, file=fout_size, row.names=FALSE, col.names=FALSE)
  str(km)

  return(km$center)
}

希望对你有帮助！

【讨论】：