close_btn
?

단축키

Prev이전 문서

Next다음 문서

+ - Up Down Comment Print
?

단축키

Prev이전 문서

Next다음 문서

+ - Up Down Comment Print
# 클러스터링

setwd("C:\\Users\\Dingdu\\Documents\\투빅스")
data<-read.csv("clustdata.csv")
head(data)
data1<-data[,-1]

# 변수의 단위가 서로 같지 않은 것으로 보입니다. 특히 range가 큰 V13 등이 군집화에 지나치게 영향을 많이 줄 듯 합니다. 
# 표준화하기 전의 데이터로 임의로 클러스터팅하여 시각화해보겠습니다. 
for (k in 3:5){
  result<-kmeans(data1,k)
  plot(data1,pch=result$cluster,col=result$cluster)
}
2-2.png2-3.png2-4.png
# 예상대로 거의 V13에 의해 군집이 이루어지는 것을 볼 수 있습니다. 
# 변수의 단위가 다를 것으로 추정하고, 표준화한 데이터로 클러스터링을 진행하겠습니다.
data2<-as.data.frame(scale(data1))

library("cluster")
library("fpc")

### k(군집 개수) 결정
# 클러스터링에서는 적절한 군집 개수의 선택이 중요합니다. 
# 사전지식이 없으므로 Elbow point, Average Silhouette을 살펴보고 k를 결정하도록 하겠습니다.
result<-NULL
for (k in 1:10){
  result[[k]]<-kmeans(data2,k,nstart=10)
}

## 1) Elbow point  
# The total within-cluster sum of square(wss)이 작을수록 좋습니다. 
# wss의 그래프을 그려보고 elbowpoint를 참고하겠습니다.
wss <- numeric(10)
for(k in 1:10){
  wss[k]<-result[[k]]$tot.withinss
}
plot(wss,type="l")
abline(v=3,col="red",lty=2)
1-1.png
# wss 그래프의 Elbowpiont: k=3


## 2) Average Silhouette
# 평균 실루엣이 최대가 되도록 하는 k가 군집의 수로 적절합니다. 
avgsil<-numeric(10)
for (k in 2:10){
  si<-summary(silhouette(result[[k]]$cluster,dist(data2)))
  avgsil[k]<-si$avg.width
}
avgsil
plot(avgsil,type="l")
abline(v=3,col="red",lty=2)
1-3.png
#  평균 실루엣이 최대가 되는 점:. k=3

# +) factoextra 패키지를 이용하여 적절한 클러스터 개수를 결정하고 시각화하는 함수 fviz_nbclust를 사용해도 됩니다. 
library("factoextra")
fviz_nbclust(data2, FUN=kmeans, method = "wss") # k=3 
fviz_nbclust(data2, FUN=kmeans, method = "silhouette") # k=3 
1-2.png1-4.png


## 3) 시각화
# k=2,3,4,5일 때 클러스터링을 시각화하여 살펴보겠습니다.
for (k in 2:5){
  plot(data2, pch=result[[k]]$cluster, col=result[[k]]$cluster)
  fviz_cluster(result[[k]],data=data2,geom="point",stand=FALSE,frame.type="norm")
}
2-5.pngclusterplot2.png
2-6.pngclusterplot3.png2-7.pngclusterplot4.png2-8.pngclusterplot5.png


# 데이터를 표준화하되, 군집의 개수는 3개로 클러스터링하는 것으로 결정합니다.
### k-means clustering 
(kmeans<-kmeans(data2,3,nstart=30))

K-means clustering with 3 clusters of sizes 62, 51, 65

Cluster means:
          V1         V2         V3         V4          V5          V6          V7          V8          V9        V10        V11        V12        V13
1  0.8328826 -0.3029551  0.3636801 -0.6084749  0.57596208  0.88274724  0.97506900 -0.56050853  0.57865427  0.1705823  0.4726504  0.7770551  1.1220202
2  0.1644436  0.8690954  0.1863726  0.5228924 -0.07526047 -0.97657548 -1.21182921  0.72402116 -0.77751312  0.9388902 -1.1615122 -1.2887761 -0.4059428
3 -0.9234669 -0.3929331 -0.4931257  0.1701220 -0.49032869 -0.07576891  0.02075402 -0.03343924  0.05810161 -0.8993770  0.4605046  0.2700025 -0.7517257

Clustering vector:
  [1] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 3 3 2 3 3 3 3 3 3 3 3 3 3 3 1 3 3
 [77] 3 3 3 3 3 3 3 2 3 3 3 3 3 3 3 3 3 3 3 1 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 2 3 3 1 3 3 3 3 3 3 3 3 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
[153] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2

Within cluster sum of squares by cluster:
[1] 385.6983 326.3537 558.6971
 (between_SS / total_SS =  44.8 %)


### 평가
# 군집화에 대한 평가의 척도로 실루엣과 Dunn Index가 있습니다. 

## 1) 실루엣
plot(silhouette(kmeans$cluster,dist=dist(data2)))
sil3.png
# 평균 실루엣은 0.28으로 작으나, 가능한 k의 범위에서 가장 평균 실루엣이 높은 k였으므로 군집 수를 다시 설정하지 않습니다.  
# 1에 가까울수록 잘 클러스터화 되어 있는것이고 0 주변은 두 군집 사이에 놓여 있는 점을 말하며,
# 음수로 나타나면 잘못된 클러스터에 속해 있을 가능성이 높습니다. 음수로 나타난 점은 적은 편이라고 판단합니다. 

for (k in 2:6){
  plot(silhouette(result[[k]]$cluster,dist=dist(data2)))
}

sil2.pngsil3.png 
sil4.pngsil5.png sil6.png
# (순서대로 k=2,3,4,5,6일 때의 실루엣 plot입니다.)
# k=4일 때부터 음수인 점이 꽤 보입니다.


## 2) Dunn Index
library("clValid")
dunn.index<-numeric(10)
d <- dist(data2,method="euclidean")
for (k in 2:10){
  dunn.index[k]<-dunn(d, result[[k]]$cluster)
}
dunn.index
# [1] 0.0000000 0.1356520 0.2322567 0.1861547 0.1767514 0.1634755 0.1800025 0.2062769 0.2017504 0.2503828
# k=10인 경우 다음으로 k=3일 때가 dunn.index 값이 큽니다.


### k-medoids clustering과의 비교 
# pam 함수는 k-medoids clustering 함수입니다. 
# k-Means 알고리즘보다 특이값이 대해서 안정적인 결과를 얻게 해줍니다. 
avsil.pam<-numeric(20)
for (k in 2:20){
  avsil.pam[k]<-pam(data2,k)$silinfo$avg.width
}
avsil.pam
which.max(avsil.pam)
# 역시 k=3일 때 평균 실루엣이 가장 큽니다. 

# kmeans와 클러스터링의 결과를 비교해보겠습니다. 
pam<-pam(data2,3)
plot(pam)
pam1.pngpam2.png
table(pam$clustering,kmeans$cluster)
#      1  2  3
#  1 12 62  0
#  2 53  0  2
#  3  0  0 49
# pamcluster의 군집 1에서 차이가 꽤 납니다.
# 실루엣 plot에서 pam의 군집 1에서 0 이하인 점이 어느 정도 있었던 것을 보아, pam보다 kmeans를 신뢰하도록 하겠습니다. 


# +) 평균 실루엣이 최적화된 군집의 수로 클러스터링하는 pamk함수를 써도 됩니다. 
pamk.result <- pamk(data2)
pamk.result$nc # k=3
pamk.result$pamobject


### Hclust와의 비교 
hc<-NULL
hc[[1]] <- hclust(dist(data2),method="single") # method="single" 최단연결법
hc[[2]] <- hclust(dist(data2),method="complete") # method="complete" 최장연결법
hc[[3]] <- hclust(dist(data2),method="average") # method="average" 평균연결법 
hc[[4]] <- hclust(dist(data2),method="centroid") # method="centroid" 중심연결
hc[[5]] <- hclust(dist(data2),method="ward.D2") # method="ward.D2" 와드연결법

hcluster<-NULL
for (i in 1:5){
  hcluster[[i]] <- cutree(hc[[i]],3)
}
 
for (i in 1:5){
  plot(hc[[i]],hang=-1)
  rect.hclust(hc[[i]],k=3,border="red")
}
h1.pngh2.pngh3.pngh4.pngh5.png

## 평균 실루엣
avsil.hc<-numeric(5)
for (i in 1:5){
  si<-silhouette(cutree(hc[[i]],k=3),dist(data2))
  ssi<-summary(si)
  avsil.hc[i]<-ssi$avg.width
}
avsil.hc
# 최단연결법 최장연결법 평균연결법 중심연결법 와드연결법
#  0.1827380  0.2037869  0.1575253  0.1979518  0.2774440

## 실루엣 plot
for (i in 1:5){
  plot(silhouette(hcluster[[i]],dist=dist(data2)))
}
4-1.png4-2.png4-3.png4-4.png4-5.png

# Hclust 중 와드연결법이 가장 군집화가 잘 되었다고 판단합니다. 


## 와드연결법을 참고하여 k-means 수정
table(cluster[[5]],kmeans$cluster)
#      1  2  3
#  1 61  0  3
#  2  1  0 57
#  3  0 51  5
# 클러스터링 결과가 비슷합니다.
# k-means에서 실루엣이 0 이하인 점이 있었던 군집 3에서 차이가 보입니다.

# hclust를 참고하여 k-means의 클러스터링을 조금 수정하겠습니다.
k<-kmeans$cluster
h<-hcluster[[5]]
h[hcluster[[5]]==2]<-3
h[hcluster[[5]]==3]<-2
table(h,k)
#    k
# h  1  2  3
# 1 61  0  3
# 2  0 51  5
# 3  1  0 57

ksi<-as.vector(silhouette(kmeans$cluster,dist=dist(data2)))
ksil_width<-ksi[357:534]
hsi<-as.vector(silhouette(h,dist=dist(data2)))
hsil_width<-hsi[357:534]

# Kmeans와 Hclust의 결과가 다른 점의 군집과 실루엣 비교 
k[k!=h]
h[k!=h]
ksil_width[k!=h]
hsil_width[k!=h]

Kmeans 클러스터링을 했을 때 실루엣이 음수였던 점 6개 중, Hclust와 군집이 다른 3개 점의 군집을 Hclust의 군집으로 바꾸겠습니다. 
k[ksil_width<0]<-h[ksil_width<0]
table(h,k)
#    k
# h  1  2  3
# 1 62  0  2
# 2  0 53  3
# 3  1  0 57


### 최종 클러스터링
k
1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 3 3 2 3 3 3 3 3 3 2 3 2 1 3 1 3 3 3 3 3 3 3 3 3 2 3 3 3 3 3 3 3 3 3 3 3 1 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 2 3 3 1 3 3 3 3 3 3 3 3 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2

plot(silhouette(k,dist=dist(data2)))
final.png



# KNN
## 1. KNN 함수 만들기
simpleknn<-function(train,test,cl,k){
  d<-dist(rbind(test,train),method="euclidean")
  d<-as.matrix(d)[1:nrow(test),-(1:nrow(test))]
  nogjc<-function(x){
    d.sort<-sort(x)[1:k]
    class<-cl[rownames(train) %in% as.numeric(names(d.sort))]
   return(names(which.max(table(class))))
  }
  pre<-apply(d,1,nogjc)
  return(pre)
}

> knn<-simpleknn(train,test,train_label,3)
> table(knn,test_label)
          test_label
knn        Canadian Kama Rosa
  Canadian       13    0    0
  Kama            1   11    1
  Rosa            0    1   15
> orgknn<-knn(train,test,train_label,3)
> table(orgknn,knn)
          knn
orgknn     Canadian Kama Rosa
  Canadian       13    0    0
  Kama            0   13    0
  Rosa            0    0   16

# which.max라는 함수는 최대값이 여러개 있을 때 그 중 맨 앞의 위치를 가지고 옵니다.
# 가까운 점들을 보았을 때 최빈값이 여러개인 경우 알파벳이 앞쪽에 위치해있는 라벨만을 데리고 오는 문제가 생깁니다.
# 따라서 거리의 합을 비교하여 더 가까운 쪽의 범주를 주도록 수정하였습니다.
# R의 KNN 함수는 이러한 경우 랜덤으로 배치하는 것 같습니다.

handmadeknn<-function(train,test,cl,k){
  d<-dist(rbind(test,train),method="euclidean")
  d<-as.matrix(d)[1:nrow(test),-(1:nrow(test))]
  nogjc<-function(x){
    d.sort<-sort(x)[1:k]
    class<-cl[rownames(train) %in% as.numeric(names(d.sort))]
    cl.tb<-table(class)
    nummax<-sum(cl.tb==max(cl.tb)) # nummax: class에서 최빈값의 개수 
    if (nummax!=1){ # 최빈값이 1개가 아닐 때 
      maxname<-names(cl.tb)[cl.tb==max(cl.tb)] # maxname: 최빈값들의 이름 
      wheremax<-numeric(nummax)
      for (i in 1:nummax){wheremax[i]<-sum(d.sort[class==maxname[i]])}
      label<-maxname[which.min(wheremax)] # 거리의 합이 더 작은 점의 이름을 선택 
    } else {label<-names(which.max(cl.tb))} # 최빈값이 1개인 경우 그 점의 이름을 선택
    return(label)
  }
  pre<-apply(d,1,nogjc)
  return(pre)
}

> knn<-handmadeknn(train,test,train_label,3)
> table(knn,test_label)
          test_label
knn        Canadian Kama Rosa
  Canadian       13    0    0
  Kama            1   11    1
  Rosa            0    1   15
> orgknn<-knn(train,test,train_label,3)
> table(orgknn,knn)
          knn
orgknn     Canadian Kama Rosa
  Canadian       13    0    0
  Kama            0   13    0
  Rosa            0    0   16


# 가중치 준 함수
homemadeknn<-function(train,test,cl,k){
  d<-dist(rbind(test,train),method="euclidean")
  d<-as.matrix(d)[1:nrow(test),-(1:nrow(test))]
  gjc<-function(x){
    d.sort<-sort(x)[1:k]
    class<-cl[rownames(train)%in%as.numeric(names(d.sort))]
    if (0 %in% d.sort) {prename<-class[d.sort==0] # 거리가 0인 경우
    } else {gjc<-(1/d.sort)/sum(1/d.sort) # 가중치 
    class.gjc<-tapply(as.numeric(gjc),class,sum)
    prename<-names(which.min(class.gjc))
    }
    return(prename)
  }
  pre<-apply(d,1,gjc)
  return(pre)
}

# 거리가 0인 점이 있으면 가중치를 계산하지 못하여 에러가 뜹니다. 거리가 0이라면 가중치가 무한대인 것으로 이해하여 바로 그 점의 범주로 넣도록 하였습니다.

> knn<-homemadeknn(train,test,train_label,3)
> table(knn,test_label)
          test_label
knn        Canadian Kama Rosa
  Canadian       13    0    0
  Kama            1   12    1
  Rosa            0    0   15
> orgknn<-knn(train,test,train_label,3)
> table(orgknn,knn)
          knn
orgknn     Canadian Kama Rosa
  Canadian       12    1    0
  Kama            1   12    0
  Rosa            0    1   15


## 2. PCA와 비교

data.pca.train<-prcomp(train,center=T,scale.=T)
data.pca.test<-prcomp(test,center=T,scale.=T)
summary(data.pca.train)

pca<-data.pca.train$x
pca<-cbind(as.factor(train_label),pca)
pca<-as.data.frame(pca)

pca.test<-data.pca.test$x
pca.test<-cbind(as.factor(test_label),pca.test)
pca.test<-as.data.frame(pca.test)


test.sc<-scale(test)
train.sc<-scale(train)
scknn<-knn(train,test,train_label,5)
table(scknn,test_label)
> table(scknn,test_label)
          test_label
scknn      Canadian Kama Rosa
  Canadian       13    0    0
  Kama            1   12    1
  Rosa            0    0   15


#install.packages("devtools")
library(devtools)
#install_github("ggbiplot", "vqv")
library(ggbiplot)

g <- ggbiplot(data.pca.train, obs.scale = 1, var.scale = 1, 
              groups = train_label, ellipse = F, 
              circle = F)
g <- g + scale_color_discrete(name = '')
g <- g + theme(legend.direction = 'horizontal', 
               legend.position = 'top')
print(g)

# install.packages("nnet")
library(nnet) 

m=multinom(train_label~PC1+PC2,data=pca)
m
head(fitted(m))
n<-predict(m,newdata=pca.test,type="class") 
table(n,test_label)
> table(n,test_label)
          test_label
n          Canadian Kama Rosa
  Canadian       11    0    0
  Kama            3   12    2
  Rosa            0    0   14

# PCA보다 KNN의 예측률이 더 높았던 이유

KNN은 거리를 계산할 때 각 변수들이 동일하게 반영되고, 주성분분석은 변동을 많이 설명하는 방향으로 변수들을 조합합니다. 따라서 주성분분석은 다중공선성을 해결하고 차원을 축소할 수 있다는 장점을 가집니다. 이러한 이점이 있는 대신에, 차원을 축소하게 되면 정보의 손실을 가져올 수 밖에 없습니다. 실제로 PC4까지 분석에 사용하게 되면 KNN와 동일한 수준까지 예측률이 올라가는 것을 볼 수 있습니다.
plot0.png
그렇다면 PC1과 PC2가 KNN만큼의 예측률을 가지지 못했던 이유를 생각해보도록 하겠습니다. PCA 분석은 Canadian과 Rosa를 Kama를 분류하는 예측 오류가 있었습니다. 위 그래프에서 PC1과 PC2만 고려하면 튤립 종들이 혼재하는 구간에서 종을 구분하기 힘들어 보입니다. 주성분보다는 가까운 점의 범주를 보았을 때 더 잘 예측할 수 있는 분포의 데이터였습니다. 위 그래프에 그려진 각 변수의 축과 data.pca.test를 보면, PC1은 길이, 둘레, 크기, 너비 등을 많이 반영하고 있으며, PC2은 PC1이 설명하지 못하는 나머지를 최대한 설명할 수 있도록 비대칭도, 다짐도 등을 많이 반영하고 있습니다.
plot2.png
plot1.png
그러나 위 그래프를 보았을 때 비대칭도와 다짐도는 튤립의 종류에 대한 설명력을 그다지 많이 가지지 못함을 알 수 있습니다. 데이터의 분산이 큰 방향이 꼭 정보를 많이 갖지는 않을 수도 있습니다.(라고 조심스럽게 생각합니다. 엉엉)

List of Articles
번호 제목 글쓴이 날짜 조회 수
공지 우수 코드 게시판 이용 관련 공지사항 DataMarket 2014.05.21 124049
268 SNA(Social Network Analysis) 분석 file 바키똥 2015.04.03 69566
267 인공신경망(Artificial Neural Network) 분석 3 file 권도영 2015.04.13 53330
266 KNN (K-Nearest Neighbor) file 바키똥 2015.09.28 50289
265 크롤링 - 전국 이디야 매장정보를 중심으로 (5기 이승은) 2 file 켜져있는멀티탭 2016.03.26 47981
264 능형 회귀 분석 file 자꾸생각나 2015.05.05 47013
263 지도 만들기 file 조호 2015.04.15 45662
262 인공신경망(Aritificial Neuron Network) file 자꾸생각나 2015.09.16 44272
261 svm file 투빅3기 2015.09.08 43270
260 NBA 회귀분석 / adult 로지스틱회귀, 나이브베이즈, 의사결정나무 - 5기 최도현 3 file 알빈 2016.03.03 41355
259 상세 주소 위도 경도 변환 코드 DataMarket 2015.09.09 40772
258 R 에서 제네릭 함수(내부 알고리즘 코드가 숨겨져있는 함수) 수정 하는 법 file DataMarket 2015.04.29 40460
257 NBA data 회귀분석 / Adult data 로지스틱 회귀분석, 나이브베이즈, 의사결정나무 - 5기 정현재 2 file 정현재 2016.03.03 38861
256 이미지의 테두리만 뽑는 작업(코드 포함) file DataMarket 2015.02.27 37164
255 데이터 읽고 쓰기와 반복문 조건문 연습하기 청하 2015.10.07 36976
254 이미지의 테두리만 뽑는 작업 - 투빅스 3기 박희경 file 바키똥 2015.03.12 36973
253 투빅스 6&7기 3주차과제 로지스틱회귀분석 - 최희정(7기) 4 file 히둥 2017.02.10 36208
252 투빅스 6&7기 5주차 과제 의사결정나무&앙상블 - 7기 최희정 2 file 히둥 2017.02.23 35625
» 투빅스 5&6기 5주차 과제 KNN 함수만들기&클러스터링 -6기 임진주 6 진주 2016.08.24 35549
250 고가영_기초스터디_파일불러오기 및 Rmarkdown 지니상 2016.02.12 35313
Board Pagination ‹ Prev 1 2 3 4 5 6 7 8 9 10 ... 14 Next ›
/ 14

나눔글꼴 설치 안내


이 PC에는 나눔글꼴이 설치되어 있지 않습니다.

이 사이트를 나눔글꼴로 보기 위해서는
나눔글꼴을 설치해야 합니다.

설치 취소

Designed by sketchbooks.co.kr / sketchbook5 board skin

Sketchbook5, 스케치북5

Sketchbook5, 스케치북5

Sketchbook5, 스케치북5

Sketchbook5, 스케치북5