2014-06-18 11 views
1

난 I 일부 그룹 식별 한 단 (예. 반복적 분류 방법에 의해)별도 dendrograms 같은 데이터 세트의 서브 세트뿐만

library(cluster) 
d <- mtcars 
d[,8:11] <- lapply(d[,8:11], as.factor) 

gdist <- daisy(d, metric = c("gower"), stand = FALSE) 
dendro <- hclust(gdist, method = "average") 
plot(as.dendrogram(dendro)) 

다음과 같이 I는 Dendrogram이 플롯 수있어 같은 플롯에서로 주어진다 d

G <- c(1,2,3,3,4,4,5,5,5,5,1,2,1,1,2,4,1,3,4,5,1,7,4,3,3,2,1,1,1,3,5,6) 
d$Group <- G 

head(d) 
        mpg cyl disp hp drat wt qsec vs am gear carb Group 
Mazda RX4   21.0 6 160 110 3.90 2.620 16.46 0 1 4 4  1 
Mazda RX4 Wag  21.0 6 160 110 3.90 2.875 17.02 0 1 4 4  2 
Datsun 710  22.8 4 108 93 3.85 2.320 18.61 1 1 4 1  3 
Hornet 4 Drive 21.4 6 258 110 3.08 3.215 19.44 1 0 3 1  3 
Hornet Sportabout 18.7 8 360 175 3.15 3.440 17.02 0 0 3 2  4 
Valiant   18.1 6 225 105 2.76 3.460 20.22 1 0 3 1  4 

의 마지막 열이 나는 같은 규모와 같은 줄거리에 모두 함께 dendrograms 음모하려합니다. 단일 구성원 만 가진 그룹도 플롯되어야합니다. (그룹 6 및 7)

그룹의 구성원 수가 하나 뿐인 경우를 제외하고는 데이터의 하위 집합에 대해 개별적인 덤드로 그램을 그릴 수 있습니다. 그러나 나는 이것이 올바른 접근이라고 생각하지 않는다.

layout(matrix(1:9, 3,3,byrow=TRUE)) 

gdist <- as.matrix(gdist) 

N <- max(G) 
for (i in 1:N){ 
    rc_tokeep <- row.names(subset(d, G==i)) 
    dis <- as.dist(gdist[rc_tokeep, rc_tokeep]) 
    dend <- hclust(dis, method = "average") 
    plot(as.dendrogram(dend)) 
} 

enter image description here

루프 마지막 두 그룹이 오류를주고있다. (6 및 7)은 단일 부재만을 갖는다.

Error in hclust(dis, method = "average") : 
    must have n >= 2 objects to cluster 

본질적으로 이러한 유형의 플롯을 재현하지는 않습니다. 단일 구성원이있는 클러스터도 여기에 표시됩니다. 당신이 지난 몇 그래프를 모방하려는 경우

enter image description here enter image description here

+1

내가 루에 샘플 코드를 받고 문제를 gaving 해요 : 각 부가 적 줄거리의 높이로 엔. 'gdist <- daisy (d, metric = c ("gower"), stand = FALSE)'8 진수 변수 8, 9가 간격 계가 처리됨 '이라는 경고 메시지가 표시되면 gdist는 벡터뿐입니다. 2 차원이 아니므로 루프에서 추출이 작동하지 않습니다. – MrFlick

+0

@MrFlick 나는 서수와 명목상의 변수를'd'를 인자로하고''gdist''를 매트릭스로 강제 변경했습니다. 이제 샘플 코드가 제대로 실행되어야합니다. – Crops

답변

3

, 당신은 같은 것을 할 수 있습니다 귀하의 예제와

N <- max(G) 
layout(matrix(c(0,1:N,0),nc=1)) 

gdist <- as.matrix(gdist) 

for (i in 1:N){ 
    par(mar=c(0,3,0,7)) 
    rc_tokeep <- row.names(subset(d, G==i)) 
    if(length(rc_tokeep)>2){ #The idea is to catch the groups with one single element to plot them differently 
     dis <- as.dist(gdist[rc_tokeep, rc_tokeep]) 
     dend <- hclust(dis, method = "average") 
     plot(as.dendrogram(dend),horiz=TRUE, 
       xlim=c(.8,0),axes=FALSE) # giving the same xlim will scale all of them, here i used 0.8 to fit your data but you can change it to whatever 
     }else{ 
      plot(NA,xlim=c(.8,0),ylim=c(0,1),axes=F,ann=F) 
      segments(0,.5,.1,.5) #I don't know how you intend to compute the length of the branch in a group of 1 element, you might want to change that 
      text(0,.5, pos=4,rc_tokeep,xpd=TRUE) 
      } 
} 

을 그것을 제공합니다

enter image description here

눈금을 추가하려면 모든 그래프에 눈금과 눈금을 추가 할 수 있습니다. 마지막 :

enter image description here

그리고

N <- max(G) 
layout(matrix(c(0,1:N,0),nc=1)) 

gdist <- as.matrix(gdist) 

for (i in 1:N){ 
    par(mar=c(0,3,0,7)) 
    rc_tokeep <- row.names(subset(d, G==i)) 
    if(length(rc_tokeep)>2){ 
     dis <- as.dist(gdist[rc_tokeep, rc_tokeep]) 
     dend <- hclust(dis, method = "average") 
     plot(as.dendrogram(dend),horiz=TRUE,xlim=c(.8,0),xaxt="n",yaxt="n") 
     abline(v=seq(0,.8,.1),lty=3) #Here the grid 
     }else{ 
      plot(NA,xlim=c(.8,0),ylim=c(0,1),axes=F,ann=F) 
      segments(0,.5,.1,.5) 
      text(0,.5, pos=4,rc_tokeep,xpd=TRUE) 
      abline(v=seq(0,.8,.1),lty=3) #Here the grid 
      } 
    } 
axis(1,at=seq(0,.8,.1)) #Here the axis 
마지막으로 당신이, 당신이 각 그룹의 구성원의 수를 얻고 그것을 사용하는 table(d$Group)를 사용할 수있는 결과 플롯의 다른 지점 사이에도 공간하려는 경우

N <- max(G) 

layout(matrix(c(0,1:7,0),nc=1), height=c(3,table(d$Group),3)) #Plus the height of the empty spaces. 

gdist <- as.matrix(gdist) 

for (i in 1:N){ 
    par(mar=c(0,3,0,7)) 
    rc_tokeep <- row.names(subset(d, G==i)) 
    if(length(rc_tokeep)>2){ 
     dis <- as.dist(gdist[rc_tokeep, rc_tokeep]) 
     dend <- hclust(dis, method = "average") 
     plot(as.dendrogram(dend),horiz=TRUE,xlim=c(.8,0),xaxt="n",yaxt="n") 
     abline(v=seq(0,.8,.1),lty=3) 
     }else{ 
      plot(NA,xlim=c(.8,0),ylim=c(0,1),axes=F,ann=F) 
      segments(0,.5,.1,.5) 
      text(0,.5, pos=4,rc_tokeep,xpd=TRUE) 
      abline(v=seq(0,.8,.1),lty=3) 
      } 
    } 
axis(1,at=seq(0,.8,.1)) 

enter image description here