1

这个想法是结合 R 包ClustOfVar并ggdendro给出变量聚类的可视化总结。

当数据中的列数很少时，除了有没有覆盖的区域（如下图圈出）之外，结果都很好。使用mtcars例如：

library(plyr)
library(ggplot2)
library(gtable)
library(grid)
library(gridExtra)

library(ClustOfVar)
library(ggdendro)

fit = hclustvar(X.quanti = mtcars)

labels = cutree(fit,k = 5)

labelx = data.frame(Names=names(labels),group = paste("Group",as.vector(labels)),num=as.vector(labels))

p1 = ggdendrogram(as.dendrogram(fit), rotate=TRUE)

df2<-data.frame(cluster=cutree(fit, k =5), states=factor(fit$labels,levels=fit$labels[fit$order]))
df3<-ddply(df2,.(cluster),summarise,pos=mean(as.numeric(states)))

p2 = ggplot(df2,aes(states,y=1,fill=factor(cluster)))+geom_tile()+
  scale_y_continuous(expand=c(0,0))+
  theme(axis.title=element_blank(),
        axis.ticks=element_blank(),
        axis.text=element_blank(),
        legend.position="none")+coord_flip()+
  geom_text(data=df3,aes(x=pos,label=cluster))
gp1<-ggplotGrob(p1)
gp2<-ggplotGrob(p2)  
maxHeight = grid::unit.pmax(gp1$heights[2:5], gp2$heights[2:5])
gp1$heights[2:5] <- as.list(maxHeight)
gp2$heights[2:5] <- as.list(maxHeight)
grid.arrange(gp2, gp1, ncol=2,widths=c(1/6,5/6))

在此处输入图像描述

当有大量列时，会出现另一个问题。即，彩砖部分的高度与树状图的高度不匹配。

library(ClustOfVar)
library(ggdendro)
X = data.frame(mtcars,mtcars,mtcars,mtcars,mtcars,mtcars)

fit = hclustvar(X.quanti = X)

labels = cutree(fit,k = 5)

labelx = data.frame(Names=names(labels),group = paste("Group",as.vector(labels)),num=as.vector(labels))

p1 = ggdendrogram(as.dendrogram(fit), rotate=TRUE)

df2<-data.frame(cluster=cutree(fit, k =5), states=factor(fit$labels,levels=fit$labels[fit$order]))
df3<-ddply(df2,.(cluster),summarise,pos=mean(as.numeric(states)))

p2 = ggplot(df2,aes(states,y=1,fill=factor(cluster)))+geom_tile()+
  scale_y_continuous(expand=c(0,0))+
  theme(axis.title=element_blank(),
        axis.ticks=element_blank(),
        axis.text=element_blank(),
        legend.position="none")+coord_flip()+
  geom_text(data=df3,aes(x=pos,label=cluster))
gp1<-ggplotGrob(p1)
gp2<-ggplotGrob(p2)  
maxHeight = grid::unit.pmax(gp1$heights[2:5], gp2$heights[2:5])
gp1$heights[2:5] <- as.list(maxHeight)
gp2$heights[2:5] <- as.list(maxHeight)
grid.arrange(gp2, gp1, ncol=2,widths=c(1/6,5/6))

在此处输入图像描述

如果我们将 R 升级到 3.3.1 版， @Sandy Muspratt 实际上已经为此提供了一个很好的解决方案。R: ggplot 微调聚类总结

但由于我无法更改部署在企业服务器中的 R 版本，我想知道是否有任何其他解决方法可以使这两个部分保持一致。

4

1 回答 1

4

据我所知，您的代码并没有错。问题是您在合并两个图时试图将连续比例​​与离散比例匹配。此外，似乎ggdendrogram()为 y 轴增加了额外的空间。 

library(plyr)
library(ggplot2)
library(gtable)
library(grid)
library(gridExtra)

library(ClustOfVar)
library(ggdendro)

# Data
X = data.frame(mtcars,mtcars,mtcars,mtcars,mtcars,mtcars)

# Cluster analysis
fit = hclustvar(X.quanti = X)

# Labels data frames
df2 <- data.frame(cluster = cutree(fit, k =5), 
     states = factor(fit$labels, levels = fit$labels[fit$order]))
df3 <- ddply(df2, .(cluster), summarise, pos = mean(as.numeric(states)))

# Dendrogram
# scale_x_continuous() for p1 should match scale_x_discrete() from p2
# scale_x_continuous strips off the labels. I grab them from df2
# scale _y_continuous() puts a little space between the labels and the dendrogram
p1 <- ggdendrogram(as.dendrogram(fit), rotate = TRUE) +
     scale_x_continuous(expand = c(0, 0.5), labels = levels(df2$states), breaks = 1:length(df2$states)) +
     scale_y_continuous(expand = c(0.02, 0)) 

# Tiles and labels
p2 <- ggplot(df2,aes(states, y = 1, fill = factor(cluster))) +
  geom_tile() +
  scale_y_continuous(expand = c(0, 0)) + 
  scale_x_discrete(expand = c(0, 0)) +
  geom_text(data = df3, aes(x = pos, label = cluster)) +
  coord_flip() +
  theme(axis.title = element_blank(),
        axis.ticks = element_blank(),
        axis.text = element_blank(),
        legend.position = "none")

# Get the ggplot grobs
gp1 <- ggplotGrob(p1)
gp2 <- ggplotGrob(p2)  

# Make sure the heights match
maxHeight <- unit.pmax(gp1$heights, gp2$heights)
gp1$heights <- as.list(maxHeight)
gp2$heights <- as.list(maxHeight)

# Combine the two plots
grid.arrange(gp2, gp1, ncol = 2,widths = c(1/6, 5/6))

在此处输入图像描述

于 2016-12-12T01:57:40.120 回答