programing

R의 군집 분석: 최적 군집 수 결정

bestprogram 2023. 6. 21. 22:50

R의 군집 분석: 최적 군집 수 결정

k-평균 분석을 수행할 최적의 군집 수를 선택하려면 어떻게 해야 합니까?아래 데이터의 부분 집합을 표시한 후에는 몇 개의 클러스터가 적합합니까?클러스터 덴드로 분석을 수행하려면 어떻게 해야 합니까?

n = 1000
kk = 10    
x1 = runif(kk)
y1 = runif(kk)
z1 = runif(kk)    
x4 = sample(x1,length(x1))
y4 = sample(y1,length(y1)) 
randObs <- function()
{
  ix = sample( 1:length(x4), 1 )
  iy = sample( 1:length(y4), 1 )
  rx = rnorm( 1, x4[ix], runif(1)/8 )
  ry = rnorm( 1, y4[ix], runif(1)/8 )
  return( c(rx,ry) )
}  
x = c()
y = c()
for ( k in 1:n )
{
  rPair  =  randObs()
  x  =  c( x, rPair[1] )
  y  =  c( y, rPair[2] )
}
z <- rnorm(n)
d <- data.frame( x, y, z )

"내 데이터의 k 평균 분석에 적합한 군집 수를 확인하려면 어떻게 해야 합니까?"라는 질문이 있으면 다음과 같은 옵션이 있습니다.클러스터 수를 결정하는 위키백과 기사는 이러한 방법 중 일부에 대해 좋은 리뷰를 제공합니다.

첫째, 일부 재현 가능한 데이터(Q의 데이터는...나에게는 불분명함):

n = 100
g = 6 
set.seed(g)
d <- data.frame(x = unlist(lapply(1:g, function(i) rnorm(n/g, runif(1)*i^2))), 
                y = unlist(lapply(1:g, function(i) rnorm(n/g, runif(1)*i^2))))
plot(d)

enter image description here

1. 제곱 오차(SSE) 화면도의 합에서 굽힘 또는 팔꿈치를 찾습니다.자세한 내용은 http://www.statmethods.net/advstats/cluster.html & http://www.mattpeeples.net/kmeans.html 을 참조하십시오.결과 그림에서 팔꿈치의 위치는 k 평균에 적합한 군집 수를 나타냅니다.

mydata <- d
wss <- (nrow(mydata)-1)*sum(apply(mydata,2,var))
  for (i in 2:15) wss[i] <- sum(kmeans(mydata,
                                       centers=i)$withinss)
plot(1:15, wss, type="b", xlab="Number of Clusters",
     ylab="Within groups sum of squares")

이 의 군집이 수 .enter image description here

2. 중간자 주변에서 파티셔닝을 수행하여 클러스터 수를 추정할 수 있습니다.pamkfpc 패키지의 함수입니다.

library(fpc)
pamk.best <- pamk(d)
cat("number of clusters estimated by optimum average silhouette width:", pamk.best$nc, "\n")
plot(pam(d, pamk.best$nc))

enter image description here enter image description here

# we could also do:
library(fpc)
asw <- numeric(20)
for (k in 2:20)
  asw[[k]] <- pam(d, k) $ silinfo $ avg.width
k.best <- which.max(asw)
cat("silhouette-optimal number of clusters:", k.best, "\n")
# still 4

3. 칼린스키 기준:데이터에 적합한 군집 수를 진단하는 또 다른 방법입니다.이 경우에는 1~10개의 그룹을 시도합니다.

require(vegan)
fit <- cascadeKM(scale(d, center = TRUE,  scale = TRUE), 1, 10, iter = 1000)
plot(fit, sortg = TRUE, grpmts.plot = TRUE)
calinski.best <- as.numeric(which.max(fit$results[2,]))
cat("Calinski criterion optimal number of clusters:", calinski.best, "\n")
# 5 clusters!

enter image description here

4. 매개 변수화된 가우스 혼합 모델에 대한 계층적 클러스터링으로 초기화된 기대 최대화를 위한 베이지안 정보 기준에 따라 최적의 모델과 클러스터 수를 결정합니다.

# See http://www.jstatsoft.org/v18/i06/paper
# http://www.stat.washington.edu/research/reports/2006/tr504.pdf
#
library(mclust)
# Run the function to see how many clusters
# it finds to be optimal, set it to search for
# at least 1 model and up 20.
d_clust <- Mclust(as.matrix(d), G=1:20)
m.best <- dim(d_clust$z)[2]
cat("model-based optimal number of clusters:", m.best, "\n")
# 4 clusters
plot(d_clust)

enter image description here enter image description here enter image description here

5. 선호도 전파(AP) 클러스터링, http://dx.doi.org/10.1126/science.1136800 참조

library(apcluster)
d.apclus <- apcluster(negDistMat(r=2), d)
cat("affinity propogation optimal number of clusters:", length(d.apclus@clusters), "\n")
# 4
heatmap(d.apclus)
plot(d.apclus, d)

enter image description here enter image description here

6. 군집 수 추정을 위한 간격 통계량입니다.그래픽 출력에 대한 자세한 내용은 일부 코드를 참조하십시오.여기서 2-10개 클러스터 시도:

library(cluster)
clusGap(d, kmeans, 10, B = 100, verbose = interactive())

Clustering k = 1,2,..., K.max (= 10): .. done
Bootstrapping, b = 1,2,..., B (= 100)  [one "." per sample]:
.................................................. 50 
.................................................. 100 
Clustering Gap statistic ["clusGap"].
B=100 simulated reference sets, k = 1..10
 --> Number of clusters (method 'firstSEmax', SE.factor=1): 4
          logW   E.logW        gap     SE.sim
 [1,] 5.991701 5.970454 -0.0212471 0.04388506
 [2,] 5.152666 5.367256  0.2145907 0.04057451
 [3,] 4.557779 5.069601  0.5118225 0.03215540
 [4,] 3.928959 4.880453  0.9514943 0.04630399
 [5,] 3.789319 4.766903  0.9775842 0.04826191
 [6,] 3.747539 4.670100  0.9225607 0.03898850
 [7,] 3.582373 4.590136  1.0077628 0.04892236
 [8,] 3.528791 4.509247  0.9804556 0.04701930
 [9,] 3.442481 4.433200  0.9907197 0.04935647
[10,] 3.445291 4.369232  0.9239414 0.05055486

통계를 입니다: 에드윈 첸의 결과입니다.enter image description here

7. 클러스터 할당을 시각화하기 위해 클러스터 프로그램으로 데이터를 탐색하는 것도 유용할 수 있습니다. 자세한 내용은 http://www.r-statistics.com/2010/06/clustergram-visualization-and-diagnostics-for-cluster-analysis-r-code/ 을 참조하십시오.

8. NbCluster 패키지는 데이터 세트의 클러스터 수를 결정하는 30개의 인덱스를 제공합니다.

library(NbClust)
nb <- NbClust(d, diss=NULL, distance = "euclidean",
        method = "kmeans", min.nc=2, max.nc=15, 
        index = "alllong", alphaBeale = 0.1)
hist(nb$Best.nc[1,], breaks = max(na.omit(nb$Best.nc[1,])))
# Looks like 3 is the most frequently determined number of clusters
# and curiously, four clusters is not in the output at all!

enter image description here

"클러스터 분석 결과를 시각화하기 위해 덴드로그램을 생성하려면 어떻게 해야 합니까?"라는 질문이 있을 경우 다음과 같이 시작해야 합니다.

http://www.statmethods.net/advstats/cluster.html

http://www.r-tutor.com/gpu-computing/clustering/hierarchical-cluster-analysis

http://gastonsanchez.wordpress.com/2012/10/03/7-ways-to-plot-dendrograms-in-r/ 보다 이국적인 방법은 여기를 참조하십시오. http://cran.r-project.org/web/views/Cluster.html

다음은 몇 가지 예입니다.

d_dist <- dist(as.matrix(d))   # find distance matrix 
plot(hclust(d_dist))           # apply hirarchical clustering and plot

enter image description here

# a Bayesian clustering method, good for high-dimension data, more details:
# http://vahid.probstat.ca/paper/2012-bclust.pdf
install.packages("bclust")
library(bclust)
x <- as.matrix(d)
d.bclus <- bclust(x, transformed.par = c(0, -50, log(16), 0, 0, 0))
viplot(imp(d.bclus)$var); plot(d.bclus); ditplot(d.bclus)
dptplot(d.bclus, scale = 20, horizbar.plot = TRUE,varimp = imp(d.bclus)$var, horizbar.distance = 0, dendrogram.lwd = 2)
# I just include the dendrogram here

enter image description here

에는 또한고데경다같습다니음과우이의차가 있습니다.pvclust다중 스케일 부트스트랩 재샘플링을 통해 계층적 클러스터링에 대한 p-값을 계산하는 라이브러리.설명서의 예는 다음과 같습니다(예와 같은 저차원 데이터에서는 작동하지 않습니다).

library(pvclust)
library(MASS)
data(Boston)
boston.pv <- pvclust(Boston)
plot(boston.pv)

enter image description here

너무 치밀한 답변을 덧붙이기는 어렵습니다.우리가 언급해야 한다고 생각하지만,identify여기, 특히 @Ben이 많은 덴드로그램 예를 보여주기 때문입니다.

d_dist <- dist(as.matrix(d))   # find distance matrix 
plot(hclust(d_dist)) 
clusters <- identify(hclust(d_dist))

identify덴드로그램에서 대화형으로 군집을 선택하고 선택한 항목을 목록에 저장할 수 있습니다.Esc를 눌러 대화형 모드를 종료하고 R 콘솔로 돌아갑니다.에는 행.cutree).

군집화 방법에서 최적의 k-클러스터를 결정하기 위해서입니다. 주로사용다니합을 사용합니다.Elbow방법은 시간 소모를 방지하기 위해 병렬 처리를 수반합니다.이 코드는 다음과 같이 샘플링될 수 있습니다.

엘보법

elbow.k <- function(mydata){
dist.obj <- dist(mydata)
hclust.obj <- hclust(dist.obj)
css.obj <- css.hclust(dist.obj,hclust.obj)
elbow.obj <- elbow.batch(css.obj)
k <- elbow.obj$k
return(k)
}

엘보우 평행 달리기

no_cores <- detectCores()
    cl<-makeCluster(no_cores)
    clusterEvalQ(cl, library(GMD))
    clusterExport(cl, list("data.clustering", "data.convert", "elbow.k", "clustering.kmeans"))
 start.time <- Sys.time()
 elbow.k.handle(data.clustering))
 k.clusters <- parSapply(cl, 1, function(x) elbow.k(data.clustering))
    end.time <- Sys.time()
    cat('Time to find k using Elbow method is',(end.time - start.time),'seconds with k value:', k.clusters)

잘 작동합니다.

입니다.factoextra최적의 그룹 수를 계산하는 군집화 방법 및 방법을 변경할 수 있습니다.예를 들어, k-평균에 대한 최적 군집 수를 알고자 하는 경우:

데이터: mtcars

library(factoextra)   
fviz_nbclust(mtcars, kmeans, method = "wss") +
      geom_vline(xintercept = 3, linetype = 2)+
      labs(subtitle = "Elbow method")

마지막으로 다음과 같은 그래프를 얻을 수 있습니다.

enter image description here

벤의 훌륭한 답변입니다.그러나 여기서 선호도 전파(AP) 방법이 일반적으로 AP가 데이터 클러스터링을 더 잘 수행하는 k-평균 방법에 대한 클러스터 수를 찾기 위해 제안되었다는 사실에 놀랐습니다.이 방법을 지원하는 과학 논문을 여기에서 참조하십시오.

프레이, 브랜든 J, 델버트 듀크입니다."데이터 포인트 간 메시지 전달을 통한 클러스터링" 과학 315.5814(2007): 972-976

따라서 k-평균에 치우치지 않은 경우에는 군집의 수를 알 필요 없이 데이터를 군집화하는 AP를 직접 사용하는 것이 좋습니다.

library(apcluster)
apclus = apcluster(negDistMat(r=2), data)
show(apclus)

음의 유클리드 거리가 적절하지 않은 경우 동일한 패키지에 제공된 다른 유사성 측도를 사용할 수 있습니다.예를 들어 Spearman 상관 관계를 기반으로 한 유사성의 경우 다음이 필요합니다.

sim = corSimMat(data, method="spearman")
apclus = apcluster(s=sim)

AP 패키지의 유사성에 대한 기능은 단순성을 위해 제공된다는 점에 유의하시기 바랍니다.실제로 R의 클러스터() 함수는 상관 행렬을 모두 허용합니다.corSimMat()에서 이전과 동일하게 다음을 수행할 수 있습니다.

sim = cor(data, method="spearman")

또는

sim = cor(t(data), method="spearman")

행렬에 군집화할 항목(행 또는 콜)에 따라 달라집니다.

이러한 방법은 훌륭하지만 훨씬 더 큰 데이터 세트에 대해 k를 찾으려 할 때 R에서 이 방법들은 엄청나게 느릴 수 있습니다.

제가 찾은 좋은 솔루션은 "RWeka" 패키지인데, 이 패키지는 X-Means 알고리즘의 효율적인 구현, 즉 확장 가능한 K-Means의 확장 버전으로, 최적의 클러스터 수를 결정합니다.

먼저 시스템에 Weka가 설치되어 있는지 확인하고 Weka의 패키지 관리자 도구를 통해 XMeans가 설치되어 있는지 확인합니다.

library(RWeka)

# Print a list of available options for the X-Means algorithm
WOW("XMeans")

# Create a Weka_control object which will specify our parameters
weka_ctrl <- Weka_control(
    I = 1000,                          # max no. of overall iterations
    M = 1000,                          # max no. of iterations in the kMeans loop
    L = 20,                            # min no. of clusters
    H = 150,                           # max no. of clusters
    D = "weka.core.EuclideanDistance", # distance metric Euclidean
    C = 0.4,                           # cutoff factor ???
    S = 12                             # random number seed (for reproducibility)
)

# Run the algorithm on your data, d
x_means <- XMeans(d, control = weka_ctrl)

# Assign cluster IDs to original data set
d$xmeans.cluster <- x_means$class_ids

답이 아주 좋습니다.다른 클러스터링 방법을 사용하려면 계층적 클러스터링을 사용하여 데이터가 어떻게 분할되는지 확인할 수 있습니다.

> set.seed(2)
> x=matrix(rnorm(50*2), ncol=2)
> hc.complete = hclust(dist(x), method="complete")
> plot(hc.complete)

enter image description here

필요한 클래스 수에 따라 덴드로그램을 자를 수 있습니다.

> cutree(hc.complete,k = 2)
 [1] 1 1 1 2 1 1 1 1 1 1 1 1 1 2 1 2 1 1 1 1 1 2 1 1 1
[26] 2 1 1 1 1 1 1 1 1 1 1 2 2 1 1 1 2 1 1 1 1 1 1 1 2

입력하는 경우?cutree정의를 볼 수 있습니다.데이터 세트에 세 개의 클래스가 있는 경우 단순하게 됩니다.cutree(hc.complete, k = 3)의 등가물cutree(hc.complete,k = 2)이라cutree(hc.complete,h = 4.9).

성능 요소를 고려하지 않고 이렇게 많은 기능을 검색하는 것은 매우 혼란스럽습니다.사용 가능한 패키지에서 최적의 클러스터 수를 찾는 것 외에 많은 일을 하는 기능은 거의 없다는 것을 알고 있습니다.다음은 자신의 프로젝트에 이러한 기능을 고려하는 모든 사용자를 위한 이러한 기능의 벤치마크 결과입니다.

n = 100
g = 6 
set.seed(g)
d <- data.frame(x = unlist(lapply(1:g, function(i) rnorm(n/g, runif(1)*i^2))), 
                y = unlist(lapply(1:g, function(i) rnorm(n/g, runif(1)*i^2))))


mydata <- d
require(cluster)
require(vegan)
require(mclust)
require(apcluster)
require(NbClust)
require(fpc)

microbenchmark::microbenchmark(
  wss = {
    wss <- (nrow(mydata)-1)*sum(apply(mydata,2,var))
    for (i in 2:15) wss[i] <- sum(kmeans(mydata, centers=i)$withinss)
  },
  
  fpc = {
    asw <- numeric(20)
    for (k in 2:20)
      asw[[k]] <- pam(d, k) $ silinfo $ avg.width
    k.best <- which.max(asw)
  },
  fpc_1 = fpc::pamk(d),
  
  vegan = {
    fit <- cascadeKM(scale(d, center = TRUE,  scale = TRUE), 1, 10, iter = 1000)
    plot(fit, sortg = TRUE, grpmts.plot = TRUE)
    calinski.best <- as.numeric(which.max(fit$results[2,]))
  },
  
  mclust = {
    d_clust <- Mclust(as.matrix(d), G=1:20)
    m.best <- dim(d_clust$z)[2]
  },
  d.apclus = apcluster(negDistMat(r=2), d),
  clusGap = clusGap(d, kmeans, 10, B = 100, verbose = interactive()),
  NbClust = NbClust(d, diss=NULL, distance = "euclidean",
                method = "kmeans", min.nc=2, max.nc=15, 
                index = "alllong", alphaBeale = 0.1),
  
  
  times = 1)
Unit: milliseconds
     expr         min          lq        mean      median          uq         max neval
      wss    16.83938    16.83938    16.83938    16.83938    16.83938    16.83938     1
      fpc   221.99490   221.99490   221.99490   221.99490   221.99490   221.99490     1
    fpc_1    43.10493    43.10493    43.10493    43.10493    43.10493    43.10493     1
    vegan  1096.08568  1096.08568  1096.08568  1096.08568  1096.08568  1096.08568     1
   mclust  1531.69475  1531.69475  1531.69475  1531.69475  1531.69475  1531.69475     1
 d.apclus    28.56100    28.56100    28.56100    28.56100    28.56100    28.56100     1
  clusGap  1096.50680  1096.50680  1096.50680  1096.50680  1096.50680  1096.50680     1
  NbClust 10940.98807 10940.98807 10940.98807 10940.98807 10940.98807 10940.98807     1

함수를 찾았습니다.pamkfpc나의 요구사항에 가장 유용한 패키지.

언급URL : https://stackoverflow.com/questions/15376075/cluster-analysis-in-r-determine-the-optimal-number-of-clusters